aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/misc/ChangeLog453
-rw-r--r--doc/misc/emacs-mime.texi55
-rw-r--r--doc/misc/gnus-coding.texi381
-rw-r--r--doc/misc/gnus-faq.texi24
-rw-r--r--doc/misc/gnus-news.el121
-rw-r--r--doc/misc/gnus-news.texi264
-rw-r--r--doc/misc/gnus.texi1513
-rw-r--r--doc/misc/message.texi112
-rw-r--r--doc/misc/pgg.texi14
-rw-r--r--doc/misc/sasl.texi270
-rw-r--r--doc/misc/sieve.texi6
-rw-r--r--etc/GNUS-NEWS563
-rw-r--r--etc/gnus/gnus-setup.ast51
-rw-r--r--etc/gnus/news-server.ast64
-rw-r--r--etc/images/gnus/mail_send.xpm39
-rw-r--r--etc/images/smilies/grayscale/blink.xpm24
-rw-r--r--etc/images/smilies/grayscale/braindamaged.xpm23
-rw-r--r--etc/images/smilies/grayscale/cry.xpm23
-rw-r--r--etc/images/smilies/grayscale/dead.xpm21
-rw-r--r--etc/images/smilies/grayscale/evil.xpm23
-rw-r--r--etc/images/smilies/grayscale/forced.xpm23
-rw-r--r--etc/images/smilies/grayscale/frown.xpm22
-rw-r--r--etc/images/smilies/grayscale/grin.xpm25
-rw-r--r--etc/images/smilies/grayscale/indifferent.xpm23
-rw-r--r--etc/images/smilies/grayscale/reverse-smile.xpm22
-rw-r--r--etc/images/smilies/grayscale/sad.xpm22
-rw-r--r--etc/images/smilies/grayscale/smile.xpm22
-rw-r--r--etc/images/smilies/grayscale/wry.xpm23
-rw-r--r--etc/images/smilies/medium/blink.xpm29
-rw-r--r--etc/images/smilies/medium/braindamaged.xpm28
-rw-r--r--etc/images/smilies/medium/cry.xpm28
-rw-r--r--etc/images/smilies/medium/dead.xpm28
-rw-r--r--etc/images/smilies/medium/evil.xpm29
-rw-r--r--etc/images/smilies/medium/forced.xpm28
-rw-r--r--etc/images/smilies/medium/frown.xpm28
-rw-r--r--etc/images/smilies/medium/grin.xpm30
-rw-r--r--etc/images/smilies/medium/indifferent.xpm28
-rw-r--r--etc/images/smilies/medium/reverse-smile.xpm29
-rw-r--r--etc/images/smilies/medium/sad.xpm28
-rw-r--r--etc/images/smilies/medium/smile.xpm29
-rw-r--r--etc/images/smilies/medium/wry.xpm28
-rw-r--r--etc/refcards/gnus-refcard.tex12
-rw-r--r--lisp/gnus/ChangeLog8734
-rw-r--r--lisp/gnus/assistant.el487
-rw-r--r--lisp/gnus/binhex.el17
-rw-r--r--lisp/gnus/deuglify.el142
-rw-r--r--lisp/gnus/dns.el93
-rw-r--r--lisp/gnus/ecomplete.el152
-rw-r--r--lisp/gnus/encrypt.el296
-rw-r--r--lisp/gnus/flow-fill.el19
-rw-r--r--lisp/gnus/format-spec.el2
-rw-r--r--lisp/gnus/gmm-utils.el13
-rw-r--r--lisp/gnus/gnus-agent.el1617
-rw-r--r--lisp/gnus/gnus-art.el2000
-rw-r--r--lisp/gnus/gnus-async.el61
-rw-r--r--lisp/gnus/gnus-bookmark.el826
-rw-r--r--lisp/gnus/gnus-cache.el247
-rw-r--r--lisp/gnus/gnus-cite.el170
-rw-r--r--lisp/gnus/gnus-cus.el2
-rw-r--r--lisp/gnus/gnus-delay.el2
-rw-r--r--lisp/gnus/gnus-demon.el6
-rw-r--r--lisp/gnus/gnus-diary.el54
-rw-r--r--lisp/gnus/gnus-dired.el2
-rw-r--r--lisp/gnus/gnus-draft.el17
-rw-r--r--lisp/gnus/gnus-dup.el22
-rw-r--r--lisp/gnus/gnus-eform.el7
-rw-r--r--lisp/gnus/gnus-ems.el59
-rw-r--r--lisp/gnus/gnus-fun.el54
-rw-r--r--lisp/gnus/gnus-gl.el860
-rw-r--r--lisp/gnus/gnus-group.el516
-rw-r--r--lisp/gnus/gnus-int.el55
-rw-r--r--lisp/gnus/gnus-kill.el14
-rw-r--r--lisp/gnus/gnus-ml.el4
-rw-r--r--lisp/gnus/gnus-mlspl.el24
-rw-r--r--lisp/gnus/gnus-move.el9
-rw-r--r--lisp/gnus/gnus-msg.el194
-rw-r--r--lisp/gnus/gnus-nocem.el63
-rw-r--r--lisp/gnus/gnus-picon.el217
-rw-r--r--lisp/gnus/gnus-range.el2
-rw-r--r--lisp/gnus/gnus-registry.el334
-rw-r--r--lisp/gnus/gnus-salt.el12
-rw-r--r--lisp/gnus/gnus-score.el194
-rw-r--r--lisp/gnus/gnus-setup.el3
-rw-r--r--lisp/gnus/gnus-soup.el2
-rw-r--r--lisp/gnus/gnus-spec.el26
-rw-r--r--lisp/gnus/gnus-srvr.el157
-rw-r--r--lisp/gnus/gnus-start.el276
-rw-r--r--lisp/gnus/gnus-sum.el1237
-rw-r--r--lisp/gnus/gnus-topic.el142
-rw-r--r--lisp/gnus/gnus-undo.el6
-rw-r--r--lisp/gnus/gnus-util.el217
-rw-r--r--lisp/gnus/gnus-uu.el98
-rw-r--r--lisp/gnus/gnus-win.el15
-rw-r--r--lisp/gnus/gnus.el296
-rw-r--r--lisp/gnus/hashcash.el370
-rw-r--r--lisp/gnus/hmac-def.el86
-rw-r--r--lisp/gnus/hmac-md5.el85
-rw-r--r--lisp/gnus/html2text.el47
-rw-r--r--lisp/gnus/ietf-drums.el41
-rw-r--r--lisp/gnus/imap.el359
-rw-r--r--lisp/gnus/legacy-gnus-agent.el31
-rw-r--r--lisp/gnus/mail-parse.el1
-rw-r--r--lisp/gnus/mail-source.el140
-rw-r--r--lisp/gnus/mailcap.el7
-rw-r--r--lisp/gnus/md4.el228
-rw-r--r--lisp/gnus/message.el1367
-rw-r--r--lisp/gnus/mm-bodies.el4
-rw-r--r--lisp/gnus/mm-decode.el117
-rw-r--r--lisp/gnus/mm-partial.el3
-rw-r--r--lisp/gnus/mm-url.el8
-rw-r--r--lisp/gnus/mm-util.el293
-rw-r--r--lisp/gnus/mm-uu.el148
-rw-r--r--lisp/gnus/mm-view.el200
-rw-r--r--lisp/gnus/mml-sec.el36
-rw-r--r--lisp/gnus/mml-smime.el348
-rw-r--r--lisp/gnus/mml.el191
-rw-r--r--lisp/gnus/mml1991.el202
-rw-r--r--lisp/gnus/mml2015.el489
-rw-r--r--lisp/gnus/nnagent.el21
-rw-r--r--lisp/gnus/nnbabyl.el7
-rw-r--r--lisp/gnus/nndb.el2
-rw-r--r--lisp/gnus/nndiary.el20
-rw-r--r--lisp/gnus/nndoc.el37
-rw-r--r--lisp/gnus/nndraft.el11
-rw-r--r--lisp/gnus/nneething.el2
-rw-r--r--lisp/gnus/nnfolder.el150
-rw-r--r--lisp/gnus/nnheader.el65
-rw-r--r--lisp/gnus/nnimap.el320
-rw-r--r--lisp/gnus/nnkiboze.el14
-rw-r--r--lisp/gnus/nnmail.el86
-rw-r--r--lisp/gnus/nnmaildir.el364
-rw-r--r--lisp/gnus/nnmbox.el2
-rw-r--r--lisp/gnus/nnmh.el28
-rw-r--r--lisp/gnus/nnml.el638
-rw-r--r--lisp/gnus/nnnil.el6
-rw-r--r--lisp/gnus/nnrss.el124
-rw-r--r--lisp/gnus/nnslashdot.el8
-rw-r--r--lisp/gnus/nnsoup.el28
-rw-r--r--lisp/gnus/nnspool.el27
-rw-r--r--lisp/gnus/nntp.el328
-rw-r--r--lisp/gnus/nnvirtual.el97
-rw-r--r--lisp/gnus/nnweb.el6
-rw-r--r--lisp/gnus/ntlm.el537
-rw-r--r--lisp/gnus/password.el140
-rw-r--r--lisp/gnus/pop3.el96
-rw-r--r--lisp/gnus/qp.el4
-rw-r--r--lisp/gnus/rfc2047.el129
-rw-r--r--lisp/gnus/rfc2231.el76
-rw-r--r--lisp/gnus/sasl-cram.el52
-rw-r--r--lisp/gnus/sasl-digest.el157
-rw-r--r--lisp/gnus/sasl-ntlm.el66
-rw-r--r--lisp/gnus/sasl.el273
-rw-r--r--lisp/gnus/score-mode.el3
-rw-r--r--lisp/gnus/sieve-manage.el246
-rw-r--r--lisp/gnus/sieve-mode.el1
-rw-r--r--lisp/gnus/sieve.el2
-rw-r--r--lisp/gnus/smiley.el55
-rw-r--r--lisp/gnus/smime-ldap.el206
-rw-r--r--lisp/gnus/smime.el102
-rw-r--r--lisp/gnus/spam-report.el158
-rw-r--r--lisp/gnus/spam-stat.el254
-rw-r--r--lisp/gnus/spam-wash.el75
-rw-r--r--lisp/gnus/spam.el2457
-rw-r--r--lisp/gnus/uudecode.el2
-rw-r--r--lisp/gnus/webmail.el7
-rw-r--r--lisp/net/netrc.el95
166 files changed, 27781 insertions, 9286 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 6c7b4b60715..f3d8feaf251 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,456 @@
12007-10-28 Miles Bader <miles@gnu.org>
2
3 * gnus-news.texi, gnus-coding.texi, sasl.texi: New files.
4
52007-10-28 Emanuele Giaquinta <e.giaquinta@glauco.it> (tiny change)
6
7 * gnus-faq.texi ([5.12]): Remove reference to discontinued service.
8
92007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
10
11 * gnus.texi (Sorting the Summary Buffer): Remove
12 gnus-article-sort-by-date-reverse.
13
142007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
15
16 * gnus.texi (Non-ASCII Group Names): New node.
17 (Misc Group Stuff): Move gnus-group-name-charset-method-alist and
18 gnus-group-name-charset-group-alist to Non-ASCII Group Names node.
19
202007-10-28 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
21
22 * gnus.texi (Mail Source Specifiers, IMAP): Add a notice on the need to
23 clean the output of the program `imap-shell-program'.
24
252007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
26
27 * gnus.texi (IMAP): Mention nnimap-logout-timeout.
28
292007-10-28 Tassilo Horn <tassilo@member.fsf.org>
30
31 * gnus.texi (Sticky Articles): Documentation for sticky article
32 buffers.
33
342007-10-28 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
35
36 * gnus.texi (RSS): Document nnrss-ignore-article-fields.
37
382007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
39
40 * gnus.texi (Various Various): Mention gnus-add-timestamp-to-message.
41
422007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
43
44 * gnus.texi (Archived Messages): Document
45 gnus-update-message-archive-method.
46
472007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
48
49 * gnus.texi (Limiting): Document gnus-summary-limit-to-address.
50
512007-10-28 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
52
53 * gnus.texi (Group Maneuvering): Document
54 `gnus-summary-next-group-on-exit'.
55
562007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
57
58 * gnus.texi (Really Various Summary Commands): Mention
59 gnus-auto-select-on-ephemeral-exit.
60
612007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
62
63 * gnus.texi, message.texi: Bump version number.
64
652007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
66
67 * gnus.texi (Group Line Specification, Misc Group Stuff)
68 (Server Commands): Parenthesize @pxref{Mail Spool}.
69
702007-10-28 Didier Verna <didier@xemacs.org>
71
72 New user option: message-signature-directory.
73 * message.texi (Insertion Variables): Document it.
74 * gnus.texi (Posting Styles): Ditto.
75
762007-10-28 Didier Verna <didier@xemacs.org>
77
78 * gnus.texi (Group Line Specification):
79 * gnus.texi (Misc Group Stuff):
80 * gnus.texi (Server Commands): Document the group compaction feature.
81
822007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
83
84 * gnus-faq.texi ([5.2]): Adjust for message-fill-column.
85
86 * message.texi (Various Message Variables): Add message-fill-column.
87
882007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
89
90 * gnus.texi: Untabify.
91
922007-10-28 Didier Verna <didier@xemacs.org>
93
94 * gnus.texi (Group Parameters): Document the posting-style merging
95 process in topic-mode.
96
972007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
98
99 * gnus.texi (Scoring On Other Headers): Add gnus-inhibit-slow-scoring.
100
1012007-10-28 Romain Francoise <romain@orebokech.com>
102
103 * gnus.texi (Mail Spool): Fix typo.
104 Update copyright.
105
1062007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
107
108 * gnus.texi (Limiting): Add gnus-summary-limit-to-singletons.
109
1102007-10-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
111
112 * gnus.texi (Summary Generation Commands):
113 Add gnus-summary-insert-ticked-articles.
114
1152007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
116
117 * gnus.texi
118 (SpamAssassin back end): Rename spam-spamassassin-path to
119 spam-spamassassin-program.
120
1212007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
122
123 * gnus.texi (Mail and Post): Add gnus-message-highlight-citation.
124
1252007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
126
127 * gnus.texi (Limiting): Add gnus-summary-limit-to-headers.
128
1292007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
130
131 * message.texi (Mail Headers): Document `opportunistic'.
132
1332007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
134
135 * emacs-mime.texi (Encoding Customization): Explain how to set
136 mm-coding-system-priorities per hierarchy.
137
1382007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
139
140 * gnus.texi (Washing Mail): Add nnmail-ignore-broken-references and
141 nnmail-broken-references-mailers instead of nnmail-fix-eudora-headers.
142
1432007-10-28 Didier Verna <didier@xemacs.org>
144
145 * message.texi (Wide Reply): Update documentation of
146 message-dont-reply-to-names (now allowing a list of regexps).
147
1482007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
149
150 * gnus.texi (Spam Package Introduction): Fix spam menu and links.
151
1522007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
153
154 * gnus.texi (SpamAssassin back end): Fix typo.
155
156 * sieve.texi (Examples): Fix grammar.
157
1582007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
159
160 * gnus.texi (Searching for Articles): Document M-S and M-R.
161 (Limiting): Document / b.
162
1632007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
164
165 * gnus.texi (Thread Commands): T M-^.
166
1672007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
168
169 * message.texi (Mail Aliases): Document ecomplete.
170 (Mail Aliases): Fix typo.
171
1722007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
173
174 * gnus.texi (Face): Restore xref to gnus-face-properties-alist;
175 fix typo.
176
1772007-10-28 Romain Francoise <romain@orebokech.com>
178
179 * gnus.texi (Mail Spool): Grammar fix.
180
1812007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
182
183 * gnus.texi (Mail Spool): nnml-use-compressed-files can be a
184 string.
185
1862007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
187
188 * gnus.texi (Group Parameters): Fix description.
189
1902007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
191
192 * gnus.texi (Gmane Spam Reporting): Fix
193 spam-report-gmane-use-article-number. Add
194 spam-report-user-mail-address.
195
1962007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
197
198 * emacs-mime.texi (Non-MIME): x-gnus-verbatim -> x-verbatim.
199
2002007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
201
202 * gnus.texi (Group Parameters): Add simplified sorting example based on
203 example for `Sorting the Summary Buffer' from Jari Aalto
204 <jari.aalto@cante.net>.
205 (Example Methods): Add example for an indirect connection.
206
2072007-10-28 Kevin Greiner <kevin.greiner@compsol.cc>
208
209 * gnus.texi (nntp-open-via-telnet-and-telnet): Fixed grammar.
210 (Agent Parameters): Updated parameter names to match code.
211 (Group Agent Commands): Corrected 'gnus-agent-fetch-series' as
212 'gnus-agent-summary-fetch-series'.
213 (Agent and flags): New section providing a generalized discussion
214 of flag handling.
215 (Agent and IMAP): Removed flag discussion.
216 (Agent Variables): Added 'gnus-agent-synchronize-flags'
217
2182007-10-28 Romain Francoise <romain@orebokech.com>
219
220 * gnus.texi (Exiting the Summary Buffer): Add new function
221 `gnus-summary-catchup-and-goto-prev-group', bound to `Z p'.
222
2232007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
224
225 * gnus.texi (Conformity): Fix typo.
226 (Customizing Articles): Document `first'.
227
2282007-10-28 Jari Aalto <jari.aalto@cante.net>
229
230 * gnus.texi (Sorting the Summary Buffer):
231 Add `gnus-thread-sort-by-date-reverse'. Add example
232 host to different sorting in NNTP and RSS groups.
233
2342007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
235
236 * message.texi (Insertion): Describe prefix for
237 message-mark-inserted-region and message-mark-insert-file.
238
2392007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
240
241 * emacs-mime.texi (Non-MIME): Add Slrn-style verbatim marks and
242 LaTeX documents. Describe "text/x-gnus-verbatim".
243
2442007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
245
246 * gnus.texi (Blacklists and Whitelists)
247 (Blacklists and Whitelists, BBDB Whitelists)
248 (Gmane Spam Reporting, Bogofilter, spam-stat spam filtering)
249 (spam-stat spam filtering, SpamOracle)
250 (Extending the Spam ELisp package): Removed extra quote symbol for
251 clarity.
252
2532007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
254
255 * gnus.texi (MIME Commands): Add gnus-article-save-part-and-strip,
256 gnus-article-delete-part and gnus-article-replace-part.
257 (Using MIME): Add gnus-mime-replace-part.
258
2592007-10-28 Romain Francoise <romain@orebokech.com>
260
261 * gnus.texi (Mail Spool): Mention that `nnml-use-compressed-files'
262 requires `auto-compression-mode' to be enabled. Add new nnml
263 variable `nnml-compressed-files-size-threshold'.
264
2652007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
266
267 * gnus.texi (Sorting the Summary Buffer): Added
268 gnus-thread-sort-by-recipient.
269
2702007-10-28 Romain Francoise <romain@orebokech.com>
271
272 * message.texi (Insertion Variables): Mention new variable
273 `message-yank-empty-prefix'. Change `message-yank-cited-prefix'
274 documentation accordingly.
275
2762007-10-28 Romain Francoise <romain@orebokech.com>
277
278 * gnus.texi (To From Newsgroups): Mention new variables
279 `gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'.
280
2812007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
282
283 * gnus.texi (Using MIME): gnus-mime-copy-part supports the charset
284 stuff; gnus-mime-inline-part does the automatic decompression.
285
2862007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
287
288 * gnus.texi (Spam ELisp Package Configuration Examples):
289 "training.ham" should be "training.spam"
290
2912007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
292
293 * message.texi (Mail Variables): Fix the default value for
294 message-send-mail-function.
295
2962007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
297
298 * gnus.texi (Optional Back End Functions): nntp-request-update-info
299 always returns nil exceptionally.
300
3012007-10-28 Simon Josefsson <jas@extundo.com>
302
303 * gnus.texi (Article Washing): Add libidn URL. Suggested by
304 Michael Cook <michael@waxrat.com>.
305
3062007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
307
308 * gnus.texi (Topic Commands): Fix next/previous.
309
3102007-10-28 Simon Josefsson <jas@extundo.com>
311
312 * gnus.texi (Article Washing): Mention `W i'.
313
3142007-10-28 Jochen K,A|(Bpper <jochen@fhi-berlin.mpg.de>
315
316 * gnus.texi (Group Parameters): Slight extension of sieve
317 parameter description.
318
3192007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
320
321 * gnus.texi (Score Decays): `gnus-decay-scores' can be a regexp
322 matching score files as well.
323 (Picons): Describe `gnus-picon-style'.
324
3252007-10-28 Romain Francoise <romain@orebokech.com>
326
327 * message.texi (Message Headers): Mention that headers are hidden
328 using narrowing, and how to expose them.
329 Update copyright.
330
3312007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
332
333 * gnusref.tex: Mention `gnus-summary-limit-to-recipient' and
334 `gnus-summary-sort-by-recipient'.
335
3362007-10-28 Romain Francoise <romain@orebokech.com>
337
338 * gnus.texi (NNTP marks): New node.
339 (NNTP): Move NNTP marks variables to the new node.
340
3412007-10-28 Jesper Harder <harder@ifa.au.dk>
342
343 * gnus.texi, gnus-news.texi, pgg.texi, sasl.texi: backend -> back
344 end.
345
346 * gnus.texi (MIME Commands, Hashcash): Markup fix.
347
3482007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
349
350 * gnus.texi: replaced @file{spam.el} with @code{spam.el}
351 everywhere for consistency.
352 (Filtering Spam Using The Spam ELisp Package): admonish again.
353 (Spam ELisp Package Sequence of Events): this is Gnus, say so.
354 Say "regular expression" instead of "regex." Admonish. Pick
355 other words to sound better (s/so/thus/).
356 (Spam ELisp Package Filtering of Incoming Mail): mention
357 statistical filters. Remove old TODO.
358 (Spam ELisp Package Sorting and Score Display in Summary Buffer):
359 new section on sorting and displaying the spam score
360 (BBDB Whitelists): mention spam-use-BBDB-exclusive is not a
361 backend but an alias to spam-use-BBDB
362 (Extending the Spam ELisp package): rewrite the example using the
363 new backend functionality.
364
3652007-10-28 Simon Josefsson <jas@extundo.com>
366
367 * gnus.texi (NNTP): Mention nntp-marks-is-evil and
368 nntp-marks-directory, from Romain Francoise
369 <romain@orebokech.com>.
370
3712007-10-28 Magnus Henoch <mange@freemail.hu>
372
373 * gnus.texi (Hashcash): New default value of
374 hashcash-default-payment.
375
3762007-10-28 Simon Josefsson <jas@extundo.com>
377
378 * gnus.texi (Hashcash): Fix URL. Add pref to spam section.
379 (Anti-spam Hashcash Payments): No need to load hashcash.el now.
380
3812007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
382
383 * gnus.texi (Adaptive Scoring): Added gnus-adaptive-pretty-print.
384
3852007-10-28 Simon Josefsson <jas@extundo.com>
386
387 * gnus.texi (documentencoding): Add, to avoid warnings.
388
3892007-10-28 Simon Josefsson <jas@extundo.com>
390
391 * message.texi (Mail Headers): Add.
392
393 * gnus.texi (Hashcash): Fix.
394
3952007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
396
397 * gnus.texi (Hashcash): changed location of library, also mention
398 that payments can be verified and fix the name of the
399 hashcash-path variable
400
4012007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
402
403 * gnus.texi
404 (Article Display): Add `gnus-picon-style'.
405
4062007-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
407
408 * gnus.texi (SpamAssassin backend): Add it to the detailmenu.
409
4102007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
411
412 * gnus.texi (Blacklists and Whitelists, BBDB Whitelists)
413 (Bogofilter, spam-stat spam filtering, SpamOracle): old incorrect
414 warning about ham processors in spam groups removed
415
4162007-10-28 Teodor Zlatanov <tzz@lifelogs.com>
417 From Hubert Chan <hubert@uhoreg.ca>
418
419 * gnus.texi (SpamAssassin backend): added new node about SpamAssassin
420
4212007-10-28 Jesper Harder <harder@ifa.au.dk>
422
423 * gnus.texi (Spam ELisp Package Sequence of Events): Index.
424 (Mailing List): Typo.
425 (Customizing Articles): Add gnus-treat-ansi-sequences.
426 (Article Washing): Index.
427
428 * message.texi: Use m-dash consistently.
429
4302007-10-28 Jesper Harder <harder@ifa.au.dk>
431
432 * gnus.texi (GroupLens): Remove.
433
4342007-10-28 Kevin Greiner <kgreiner@xpediantsolutions.com>
435
436 * gnus.texi (Outgoing Messages, Agent Variables): Add
437 gnus-agent-queue-mail and gnus-agent-prompt-send-queue.
438 Suggested by Gaute Strokkenes <gs234@srcf.ucam.org>
439
4402007-10-28 Jesper Harder <harder@ifa.au.dk>
441
442 * gnus.texi (Limiting): Add gnus-summary-limit-to-replied.
443
4442007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
445
446 * gnus.texi (Article Washing): Add `gnus-article-treat-ansi-sequences'.
447
448 * gnus.texi (No Gnus): New node. Includes `gnus-news.texi'.
449
4502007-10-28 Simon Josefsson <jas@extundo.com>
451
452 * gnus.texi (Top): Add SASL.
453
12007-10-27 Jay Belanger <jay.p.belanger@gmail.com> 4542007-10-27 Jay Belanger <jay.p.belanger@gmail.com>
2 455
3 * calc.texi (Formulas, Composition Basics): Lower the 456 * calc.texi (Formulas, Composition Basics): Lower the
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 7490c9b6bc2..d4cbf8380b6 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -180,8 +180,27 @@ Patches. This is intended for groups where diffs of committed files
180are automatically sent to. It only works in groups matching 180are automatically sent to. It only works in groups matching
181@code{mm-uu-diff-groups-regexp}. 181@code{mm-uu-diff-groups-regexp}.
182 182
183@item verbatim-marks
184@cindex verbatim-marks
185Slrn-style verbatim marks.
186
187@item LaTeX
188@cindex LaTeX
189LaTeX documents. It only works in groups matching
190@code{mm-uu-tex-groups-regexp}.
191
183@end table 192@end table
184 193
194@cindex text/x-verbatim
195@c Is @vindex suitable for a face?
196@vindex mm-uu-extract
197Some inlined non-@acronym{MIME} attachments are displayed using the face
198@code{mm-uu-extract}. By default, no @acronym{MIME} button for these
199parts is displayed. You can force displaying a button using @kbd{K b}
200(@code{gnus-summary-display-buttonized}) or add @code{text/x-verbatim}
201to @code{gnus-buttonized-mime-types}, @xref{MIME Commands, ,MIME
202Commands, gnus, Gnus Manual}.
203
185@node Handles 204@node Handles
186@section Handles 205@section Handles
187 206
@@ -849,6 +868,36 @@ ISO-8859-1 if possible, you can set this variable to
849@code{(iso-8859-1)}. You can override this setting on a per-message 868@code{(iso-8859-1)}. You can override this setting on a per-message
850basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). 869basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}).
851 870
871As different hierarchies prefer different charsets, you may want to set
872@code{mm-coding-system-priorities} according to the hierarchy in Gnus.
873Here's an example:
874
875@c Corrections about preferred charsets are welcome. de, fr and fj
876@c should be correct, I don't know about the rest (so these are only
877@c examples):
878@lisp
879(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
880(setq gnus-parameters
881 (nconc
882 ;; Some charsets are just examples!
883 '(("^cn\\." ;; Chinese
884 (mm-coding-system-priorities
885 '(iso-8859-1 cn-big5 chinese-iso-7bit utf-8)))
886 ("^cz\\.\\|^pl\\." ;; Central and Eastern European
887 (mm-coding-system-priorities '(iso-8859-2 utf-8)))
888 ("^de\\." ;; German language
889 (mm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8)))
890 ("^fr\\." ;; French
891 (mm-coding-system-priorities '(iso-8859-15 iso-8859-1 utf-8)))
892 ("^fj\\." ;; Japanese
893 (mm-coding-system-priorities
894 '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))
895 ("^ru\\." ;; Cyrillic
896 (mm-coding-system-priorities
897 '(koi8-r iso-8859-5 iso-8859-1 utf-8))))
898 gnus-parameters))
899@end lisp
900
852@item mm-content-transfer-encoding-defaults 901@item mm-content-transfer-encoding-defaults
853@vindex mm-content-transfer-encoding-defaults 902@vindex mm-content-transfer-encoding-defaults
854Mapping from @acronym{MIME} types to encoding to use. This variable is usually 903Mapping from @acronym{MIME} types to encoding to use. This variable is usually
@@ -1155,7 +1204,7 @@ Return the value of the field under point.
1155@item mail-encode-encoded-word-region 1204@item mail-encode-encoded-word-region
1156@findex mail-encode-encoded-word-region 1205@findex mail-encode-encoded-word-region
1157Encode the non-@acronym{ASCII} words in the region. For instance, 1206Encode the non-@acronym{ASCII} words in the region. For instance,
1158@samp{Naïve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}. 1207@samp{Na@"{@dotless{i}}ve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}.
1159 1208
1160@item mail-encode-encoded-word-buffer 1209@item mail-encode-encoded-word-buffer
1161@findex mail-encode-encoded-word-buffer 1210@findex mail-encode-encoded-word-buffer
@@ -1168,7 +1217,7 @@ Encode the words that need encoding in a string, and return the result.
1168 1217
1169@example 1218@example
1170(mail-encode-encoded-word-string 1219(mail-encode-encoded-word-string
1171 "This is naïve, baby") 1220 "This is na@"{@dotless{i}}ve, baby")
1172@result{} "This is =?iso-8859-1?q?na=EFve,?= baby" 1221@result{} "This is =?iso-8859-1?q?na=EFve,?= baby"
1173@end example 1222@end example
1174 1223
@@ -1183,7 +1232,7 @@ Decode the encoded words in the string and return the result.
1183@example 1232@example
1184(mail-decode-encoded-word-string 1233(mail-decode-encoded-word-string
1185 "This is =?iso-8859-1?q?na=EFve,?= baby") 1234 "This is =?iso-8859-1?q?na=EFve,?= baby")
1186@result{} "This is naïve, baby" 1235@result{} "This is na@"{@dotless{i}}ve, baby"
1187@end example 1236@end example
1188 1237
1189@end table 1238@end table
diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi
new file mode 100644
index 00000000000..1fead8c9b80
--- /dev/null
+++ b/doc/misc/gnus-coding.texi
@@ -0,0 +1,381 @@
1\input texinfo
2
3@setfilename gnus-coding
4@settitle Gnus Coding Style and Maintainance Guide
5@syncodeindex fn cp
6@syncodeindex vr cp
7@syncodeindex pg cp
8
9@copying
10Copyright (c) 2004, 2005, 2007 Free Software Foundation, Inc.
11
12@quotation
13Permission is granted to copy, distribute and/or modify this document
14under the terms of the GNU Free Documentation License, Version 1.1 or
15any later version published by the Free Software Foundation; with no
16Invariant Sections, with the Front-Cover texts being ``A GNU
17Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
18license is included in the section entitled ``GNU Free Documentation
19License'' in the Emacs manual.
20
21(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
22this GNU Manual, like GNU software. Copies published by the Free
23Software Foundation raise funds for GNU development.''
24
25This document is part of a collection distributed under the GNU Free
26Documentation License. If you want to distribute this document
27separately from the collection, you can do so by adding a copy of the
28license to the document, as described in section 6 of the license.
29@end quotation
30@end copying
31
32
33@titlepage
34@title Gnus Coding Style and Maintainance Guide
35
36@author by Reiner Steib <Reiner.Steib@@gmx.de>
37
38@insertcopying
39@end titlepage
40
41@c Obviously this is only a very rudimentary draft. We put it in CVS
42@c anyway hoping that it might annoy someone enough to fix it. ;-)
43@c Fixing only a paragraph also is appreciated.
44
45@node Top
46@top Gnus Coding Style and Maintainance Guide
47This manual describes @dots{}
48@menu
49* Gnus Coding Style:: Gnus Coding Style
50* Gnus Maintainance Guide:: Gnus Maintainance Guide
51@end menu
52
53@c @ref{Gnus Reference Guide, ,Gnus Reference Guide, gnus, The Gnus Newsreader}
54
55@node Gnus Coding Style
56@chapter Gnus Coding Style
57@section Dependencies
58
59The Gnus distribution contains a lot of libraries that have been written
60for Gnus and used intensively for Gnus. But many of those libraries are
61useful on their own. E.g. other Emacs Lisp packages might use the
62@acronym{MIME} library @xref{Top, ,Top, emacs-mime, The Emacs MIME
63Manual}.
64
65@subsection General purpose libraries
66
67@table @file
68
69@item netrc.el
70@file{.netrc} parsing functionality.
71@c As of 2005-10-21...
72There are no Gnus dependencies in this file.
73
74@item format-spec.el
75Functions for formatting arbitrary formatting strings.
76@c As of 2005-10-21...
77There are no Gnus dependencies in this file.
78
79@item hex-util.el
80Functions to encode/decode hexadecimal string.
81@c As of 2007-08-25...
82There are no Gnus dependencies in these files.
83@end table
84
85@subsection Encryption and security
86
87@table @file
88@item encrypt.el
89File encryption routines
90@c As of 2005-10-25...
91There are no Gnus dependencies in this file.
92
93@item password.el
94Read passwords from user, possibly using a password cache.
95@c As of 2005-10-21...
96There are no Gnus dependencies in this file.
97
98@item tls.el
99TLS/SSL support via wrapper around GnuTLS
100@c As of 2005-10-21...
101There are no Gnus dependencies in this file.
102
103@item pgg*.el
104Glue for the various PGP implementations.
105@c As of 2005-10-21...
106There are no Gnus dependencies in these files.
107
108@item sha1.el
109SHA1 Secure Hash Algorithm.
110@c As of 2007-08-25...
111There are no Gnus dependencies in these files.
112@end table
113
114@subsection Networking
115
116@table @file
117@item dig.el
118Domain Name System dig interface.
119@c As of 2005-10-21...
120There are no serious Gnus dependencies in this file. Uses
121@code{gnus-run-mode-hooks} (a wrapper function).
122
123@item dns.el, dns-mode.el
124Domain Name Service lookups.
125@c As of 2005-10-21...
126There are no Gnus dependencies in these files.
127@end table
128
129@subsection Mail and News related RFCs
130
131@table @file
132@item pop3.el
133Post Office Protocol (RFC 1460) interface.
134@c As of 2005-10-21...
135There are no Gnus dependencies in this file.
136
137@item imap.el
138@acronym{IMAP} library.
139@c As of 2005-10-21...
140There are no Gnus dependencies in this file.
141
142@item ietf-drums.el
143Functions for parsing RFC822bis headers.
144@c As of 2005-10-21...
145There are no Gnus dependencies in this file.
146
147@item rfc1843.el
148HZ (rfc1843) decoding. HZ is a data format for exchanging files of
149arbitrarily mixed Chinese and @acronym{ASCII} characters.
150@c As of 2005-10-21...
151@code{rfc1843-gnus-setup} seem to be useful only for Gnus. Maybe this
152function should be relocated to remove dependencies on Gnus. Other
153minor dependencies: @code{gnus-newsgroup-name} could be eliminated by
154using an optional argument to @code{rfc1843-decode-article-body}.
155
156@item rfc2045.el
157Functions for decoding rfc2045 headers
158@c As of 2007-08-25...
159There are no Gnus dependencies in these files.
160
161@item rfc2047.el
162Functions for encoding and decoding rfc2047 messages
163@c As of 2007-08-25...
164There are no Gnus dependencies in these files.
165@c
166Only a couple of tests for gnusy symbols.
167
168@item rfc2104.el
169RFC2104 Hashed Message Authentication Codes
170@c As of 2007-08-25...
171There are no Gnus dependencies in these files.
172
173@item rfc2231.el
174Functions for decoding rfc2231 headers
175@c As of 2007-08-25...
176There are no Gnus dependencies in these files.
177
178@item flow-fill.el
179Interpret RFC2646 "flowed" text.
180@c As of 2005-10-27...
181There are no Gnus dependencies in this file.
182
183@item uudecode.el
184Elisp native uudecode.
185@c As of 2005-12-06...
186There are no Gnus dependencies in this file.
187@c ... but the custom group is gnus-extract.
188
189@item canlock.el
190Functions for Cancel-Lock feature
191@c Cf. draft-ietf-usefor-cancel-lock-01.txt
192@c Although this draft has expired, Canlock-Lock revived in 2007 when
193@c major news providers (e.g. news.individual.org) started to use it.
194@c As of 2007-08-25...
195There are no Gnus dependencies in these files.
196
197@end table
198
199@subsection message
200
201All message composition from Gnus (both mail and news) takes place in
202Message mode buffers. Message mode is intended to be a replacement for
203Emacs mail mode. There should be no Gnus dependencies in
204@file{message.el}. Alas it is not anymore. Patches and suggestions to
205remove the dependencies are welcome.
206
207@c message.el requires nnheader which requires gnus-util.
208
209@subsection Emacs @acronym{MIME}
210
211The files @file{mml*.el} and @file{mm-*.el} provide @acronym{MIME}
212functionality for Emacs.
213
214@acronym{MML} (@acronym{MIME} Meta Language) is supposed to be
215independent from Gnus. Alas it is not anymore. Patches and suggestions
216to remove the dependencies are welcome.
217
218@subsection Gnus backends
219
220The files @file{nn*.el} provide functionality for accessing NNTP
221(@file{nntp.el}), IMAP (@file{nnimap.el}) and several other Mail back
222ends (probably @file{nnml.el}, @file{nnfolder.el} and
223@file{nnmaildir.el} are the most widely used mail back ends).
224
225@c mm-uu requires nnheader which requires gnus-util. message.el also
226@c requires nnheader.
227
228
229@section Compatibility
230
231No Gnus and Gnus 5.10.10 and up should work on:
232@itemize @bullet
233@item
234Emacs 21.1 and up.
235@item
236XEmacs 21.4 and up.
237@end itemize
238
239Gnus 5.10.8 and below should work on:
240@itemize @bullet
241@item
242Emacs 20.7 and up.
243@item
244XEmacs 21.1 and up.
245@end itemize
246
247@node Gnus Maintainance Guide
248@chapter Gnus Maintainance Guide
249
250@section Stable and development versions
251
252The development of Gnus normally is done on the CVS trunk, i.e. there
253are no separate branches to develop and test new features. Most of the
254time, the trunk is developed quite actively with more or less daily
255changes. Only after a new major release, e.g. 5.10.1, there's usually a
256feature period of several months. After the release of Gnus 5.10.6 the
257development of new features started again on the trunk while the 5.10
258series is continued on the stable branch (v5-10) from which more stable
259releases will be done when needed (5.10.7, @dots{}).
260@ref{Gnus Development, ,Gnus Development, gnus, The Gnus Newsreader}
261
262Stable releases of Gnus finally become part of Emacs. E.g. Gnus 5.8
263became a part of Emacs 21 (relabeled to Gnus 5.9). The 5.10 series
264became part of Emacs 22 as Gnus 5.11.
265
266@section Syncing
267
268@c Some MIDs related to this follow. Use http://thread.gmane.org/MID
269@c (and click on the subject) to get the thread on Gmane.
270
271@c Some quotes from Miles Bader follow...
272
273@c <v9eklyke6b.fsf@marauder.physik.uni-ulm.de>
274@c <buovfd71nkk.fsf@mctpc71.ucom.lsi.nec.co.jp>
275
276In the past, the inclusion of Gnus into Emacs was quite cumbersome. For
277each change made to Gnus in Emacs repository, it had to be checked that
278it was applied to the new Gnus version, too. Else, bug fixes done in
279Emacs repository might have been lost.
280
281With the inclusion of Gnus 5.10, Miles Bader has set up an Emacs-Gnus
282gateway to ensure the bug fixes from Emacs CVS are propagated to Gnus
283CVS semi-automatically. These bug fixes are installed on the stable
284branch and on the trunk. Basically the idea is that the gateway will
285cause all common files in Emacs and Gnus v5-10 to be identical except
286when there's a very good reason (e.g., the Gnus version string in Emacs
287says @samp{5.11}, but the v5-10 version string remains @samp{5.10.x}).
288Furthermore, all changes in these files in either Emacs or the v5-10
289branch will be installed into the Gnus CVS trunk, again except where
290there's a good reason.
291@c (typically so far the only exception has been that the changes
292@c already exist in the trunk in modified form).
293Because of this, when the next major version of Gnus will be included in
294Emacs, it should be very easy -- just plonk in the files from the Gnus
295trunk without worrying about lost changes from the Emacs tree.
296
297The effect of this is that as hacker, you should generally only have to
298make changes in one place:
299
300@itemize
301@item
302If it's a file which is thought of as being outside of Gnus (e.g., the
303new @file{encrypt.el}), you should probably make the change in the Emacs
304tree, and it will show up in the Gnus tree a few days later.
305
306If you don't have Emacs CVS access (or it's inconvenient), you can
307change such a file in the v5-10 branch, and it should propagate to Emacs
308CVS -- however, it will get some extra scrutiny (by Miles) to see if the
309changes are possibly controversial and need discussion on the mailing
310list. Many changes are obvious bug-fixes however, so often there won't
311be any problem.
312
313@item
314If it's to a Gnus file, and it's important enough that it should be part
315of Emacs and the v5-10 branch, then you can make the change on the v5-10
316branch, and it will go into Emacs CVS and the Gnus CVS trunk (a few days
317later). The most prominent examples for such changes are bug-fixed
318including improvements on the documentation.
319
320If you know that there will be conflicts (perhaps because the affected
321source code is different in v5-10 and the Gnus CVS trunk), then you can
322install your change in both places, and when I try to sync them, there
323will be a conflict -- however, since in most such cases there would be a
324conflict @emph{anyway}, it's often easier for me to resolve it simply if
325I see two @samp{identical} changes, and can just choose the proper one,
326rather than having to actually fix the code.
327
328@item
329For general Gnus development changes, of course you just make the
330change on the Gnus CVS trunk and it goes into Emacs a few years
331later... :-)
332@end itemize
333
334Of course in any case, if you just can't wait for me to sync your
335change, you can commit it in more than one place and probably there will
336be no problem; usually the changes are textually identical anyway, so
337can be easily resolved automatically (sometimes I notice silly things in
338such multiple commits, like whitespace differences, and unify those ;-).
339
340
341@c I do Emacs->Gnus less often (than Gnus->Emacs) because it tends to
342@c require more manual work.
343
344@c By default I sync about once a week. I also try to follow any Gnus
345@c threads on the mailing lists and make sure any changes being discussed
346@c are kept more up-to-date (so say 1-2 days delay for "topical" changes).
347
348@c <buovfd71nkk.fsf@mctpc71.ucom.lsi.nec.co.jp>
349
350@c BTW, just to add even more verbose explanation about the syncing thing:
351
352@section Miscellanea
353
354@heading @file{GNUS-NEWS}
355
356Starting from No Gnus, the @file{GNUS-NEWS} is created from
357@file{texi/gnus-news.texi}. Don't edit @file{GNUS-NEWS}. Edit
358@file{texi/gnus-news.texi}, type @command{make GNUS-NEWS} in the
359@file{texi} directory and commit @file{GNUS-NEWS} and
360@file{texi/gnus-news.texi}.
361
362@heading Conventions for version information in defcustoms
363
364For new customizable variables introduced in Oort Gnus (including the
365v5-10 branch) use @code{:version "22.1" ;; Oort Gnus} (including the
366comment) or e.g. @code{:version "22.2" ;; Gnus 5.10.10} if the feature
367was added for Emacs 22.2 and Gnus 5.10.10.
368@c
369If the variable is new in No Gnus use @code{:version "23.0" ;; No Gnus}.
370
371The same applies for customizable variables when its default value was
372changed.
373
374@c Local Variables:
375@c mode: texinfo
376@c coding: iso-8859-1
377@c End:
378
379@ignore
380 arch-tag: ab15234c-2c8a-4cbd-8111-1811bcc6f931
381@end ignore
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 6bfb3477627..53a14254aad 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1286,18 +1286,23 @@ How to enable automatic word-wrap when composing messages?
1286 1286
1287@subsubheading Answer 1287@subsubheading Answer
1288 1288
1289Say 1289Starting from No Gnus, automatic word-wrap is already enabled by
1290default, see the variable message-fill-column.
1291
1292For other versions of Gnus, say
1290 1293
1291@example 1294@example
1292(add-hook 'message-mode-hook 1295(unless (boundp 'message-fill-column)
1293 (lambda () 1296 (add-hook 'message-mode-hook
1294 (setq fill-column 72) 1297 (lambda ()
1295 (turn-on-auto-fill))) 1298 (setq fill-column 72)
1299 (turn-on-auto-fill))))
1296@end example 1300@end example
1297@noindent 1301@noindent
1298 1302
1299in ~/.gnus.el. You can reformat a paragraph by hitting 1303in ~/.gnus.el.
1300@samp{M-q} (as usual) 1304
1305You can reformat a paragraph by hitting @samp{M-q} (as usual).
1301 1306
1302@node [5.3] 1307@node [5.3]
1303@subsubheading Question 5.3 1308@subsubheading Question 5.3
@@ -1676,10 +1681,7 @@ you to use something like
1676yourUserName.userfqdn.provider.net, or you can use 1681yourUserName.userfqdn.provider.net, or you can use
1677somethingUnique.yourdomain.tld if you own the domain 1682somethingUnique.yourdomain.tld if you own the domain
1678yourdomain.tld, or you can register at a service which 1683yourdomain.tld, or you can register at a service which
1679gives private users a FQDN for free, e.g. 1684gives private users a FQDN for free.
1680@uref{http://www.stura.tu-freiberg.de/~dlx/addfqdn.html}.
1681(Sorry but this website is in German, if you know of an
1682English one offering the same, drop me a note).
1683 1685
1684Finally you can tell Gnus not to generate a Message-ID 1686Finally you can tell Gnus not to generate a Message-ID
1685for News at all (and letting the server do the job) by saying 1687for News at all (and letting the server do the job) by saying
diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el
new file mode 100644
index 00000000000..9f31513e435
--- /dev/null
+++ b/doc/misc/gnus-news.el
@@ -0,0 +1,121 @@
1;;; gnus-news.el --- a hack to create GNUS-NEWS from texinfo source
2;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
3
4;; Author: Reiner Steib <Reiner.Steib@gmx.de>
5;; Keywords: tools
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
23
24;;; Commentary:
25
26;;; Code:
27
28(defvar gnus-news-header-disclaimer
29"GNUS NEWS -- history of user-visible changes.
30
31Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
32 2006, 2007 Free Software Foundation, Inc.
33See the end of the file for license conditions.
34
35Please send Gnus bug reports to bugs@gnus.org.
36For older news, see Gnus info node \"New Features\".\n\n")
37
38(defvar gnus-news-trailer
39"
40* For older news, see Gnus info node \"New Features\".
41
42----------------------------------------------------------------------
43
44This file is part of GNU Emacs.
45
46GNU Emacs is free software; you can redistribute it and/or modify
47it under the terms of the GNU General Public License as published by
48the Free Software Foundation; either version 3, or (at your option)
49any later version.
50
51GNU Emacs is distributed in the hope that it will be useful,
52but WITHOUT ANY WARRANTY; without even the implied warranty of
53MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
54GNU General Public License for more details.
55
56You should have received a copy of the GNU General Public License
57along with GNU Emacs; see the file COPYING. If not, write to the
58Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
59Boston, MA 02110-1301, USA.
60
61 \nLocal variables:\nmode: outline
62paragraph-separate: \"[ ]*$\"\nend:\n")
63
64(defvar gnus-news-makeinfo-command "makeinfo")
65
66(defvar gnus-news-fill-column 80)
67
68(defvar gnus-news-makeinfo-switches
69 (concat " --no-headers --paragraph-indent=0"
70 " --no-validate" ;; Allow unresolved references.
71 " --fill-column=" (number-to-string
72 (+ 3 ;; will strip leading spaces later
73 (or gnus-news-fill-column 80)))))
74
75(defun batch-gnus-news ()
76 "Make GNUS-NEWS in batch mode."
77 (let (infile outfile)
78 (setq infile (car command-line-args-left)
79 command-line-args-left (cdr command-line-args-left)
80 outfile (car command-line-args-left)
81 command-line-args-left nil)
82 (if (and infile outfile)
83 (message "Creating `%s' from `%s'..." outfile infile)
84 (error "Not enough files given."))
85 (gnus-news-translate-file infile outfile)))
86
87(defun gnus-news-translate-file (infile outfile)
88 "Translate INFILE (texinfo) to OUTFILE (GNUS-NEWS)."
89 (let* ((dir (concat (or (getenv "srcdir") ".") "/"))
90 (infile (concat dir infile))
91 (buffer (find-file-noselect (concat dir outfile))))
92 (with-temp-buffer
93 ;; Could be done using `texinfmt' stuff as in `infohack.el'.
94 (insert
95 (shell-command-to-string
96 (concat gnus-news-makeinfo-command " "
97 gnus-news-makeinfo-switches " " infile)))
98 (goto-char (point-max))
99 (delete-char -1)
100 (goto-char (point-min))
101 (save-excursion
102 (while (re-search-forward "^ \\* " nil t)
103 (replace-match "\f\n* ")))
104 (save-excursion
105 (while (re-search-forward "^ \\* " nil t)
106 (replace-match "** ")))
107 (save-excursion
108 (while (re-search-forward "^ " nil t)
109 (replace-match "")))
110 ;; Avoid `*' from @ref at beginning of line:
111 (save-excursion
112 (while (re-search-forward "^\\*Note" nil t)
113 (replace-match " \\&")))
114 (goto-char (point-min))
115 (insert gnus-news-header-disclaimer)
116 (goto-char (point-max))
117 (insert gnus-news-trailer)
118 (write-region (point-min) (point-max) outfile))))
119
120;;; arch-tag: e23cdd27-eafd-4ba0-816f-98f5edb0dc29
121;;; gnus-news.el ends here
diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi
new file mode 100644
index 00000000000..821354717e2
--- /dev/null
+++ b/doc/misc/gnus-news.texi
@@ -0,0 +1,264 @@
1@c -*-texinfo-*-
2
3@c Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
4
5@c Permission is granted to anyone to make or distribute verbatim copies
6@c of this document as received, in any medium, provided that the
7@c copyright notice and this permission notice are preserved,
8@c thus giving the recipient permission to redistribute in turn.
9
10@c Permission is granted to distribute modified versions
11@c of this document, or of portions of it,
12@c under the above conditions, provided also that they
13@c carry prominent notices stating who last changed them.
14
15@c This file contains a list of news features Gnus. It is supposed to be
16@c included in `gnus.texi'. `GNUS-NEWS' is automatically generated from
17@c this file (see `gnus-news.el').
18
19@itemize @bullet
20
21@item Installation changes
22
23@itemize @bullet
24@item Upgrading from previous (stable) version if you have used No Gnus.
25
26If you have tried No Gnus (the unstable Gnus branch leading to this
27release) but went back to a stable version, be careful when upgrading
28to this version. In particular, you will probably want to remove the
29@file{~/News/marks} directory (perhaps selectively), so that flags are
30read from your @file{~/.newsrc.eld} instead of from the stale marks
31file, where this release will store flags for nntp. See a later entry
32for more information about nntp marks. Note that downgrading isn't
33safe in general.
34
35@item Lisp files are now installed in @file{.../site-lisp/gnus/} by default.
36It defaulted to @file{.../site-lisp/} formerly. In addition to this,
37the new installer issues a warning if other Gnus installations which
38will shadow the latest one are detected. You can then remove those
39shadows manually or remove them using @code{make
40remove-installed-shadows}.
41@end itemize
42
43@item New packages and libraries within Gnus
44
45@itemize @bullet
46
47@item Gnus includes the Emacs Lisp @acronym{SASL} library.
48
49This provides a clean @acronym{API} to @acronym{SASL} mechanisms from
50within Emacs. The user visible aspects of this, compared to the earlier
51situation, include support for @acronym{DIGEST}-@acronym{MD5} and
52@acronym{NTLM}. @xref{Top, ,Emacs SASL, sasl, Emacs SASL}.
53
54@item ManageSieve connections uses the @acronym{SASL} library by default.
55
56The primary change this brings is support for @acronym{DIGEST-MD5} and
57@acronym{NTLM}, when the server supports it.
58
59@item Gnus includes a password cache mechanism in password.el.
60
61It is enabled by default (see @code{password-cache}), with a short
62timeout of 16 seconds (see @code{password-cache-expiry}). If
63@acronym{PGG} is used as the @acronym{PGP} back end, the @acronym{PGP}
64passphrase is managed by this mechanism. Passwords for ManageSieve
65connections are managed by this mechanism, after querying the user
66about whether to do so.
67@end itemize
68
69@item Changes in summary and article mode
70
71@itemize @bullet
72
73@item Gnus now supports sticky article buffers. Those are article buffers
74that are not reused when you select another article. @xref{Sticky
75Articles}.
76
77@item International host names (@acronym{IDNA}) can now be decoded
78inside article bodies using @kbd{W i}
79(@code{gnus-summary-idna-message}). This requires that GNU Libidn
80(@url{http://www.gnu.org/software/libidn/}) has been installed.
81@c FIXME: Also mention @code{message-use-idna}?
82
83@item The non-@acronym{ASCII} group names handling has been much
84improved. The back ends that fully support non-@acronym{ASCII} group
85names are now @code{nntp}, @code{nnml}, and @code{nnrss}. Also the
86agent, the cache, and the marks features work with those back ends.
87@xref{Non-ASCII Group Names}.
88
89@item Gnus now displays @acronym{DNS} master files sent as text/dns
90using dns-mode.
91
92@item Gnus supports new limiting commands in the Summary buffer:
93@kbd{/ r} (@code{gnus-summary-limit-to-replied}) and @kbd{/ R}
94(@code{gnus-summary-limit-to-recipient}). @xref{Limiting}.
95
96@item You can now fetch all ticked articles from the server using
97@kbd{Y t} (@code{gnus-summary-insert-ticked-articles}). @xref{Summary
98Generation Commands}.
99
100@item Gnus supports a new sort command in the Summary buffer:
101@kbd{C-c C-s C-t} (@code{gnus-summary-sort-by-recipient}). @xref{Summary
102Sorting}.
103
104@item @acronym{S/MIME} now features @acronym{LDAP} user certificate searches.
105You need to configure the server in @code{smime-ldap-host-list}.
106
107@item URLs inside Open@acronym{PGP} headers are retrieved and imported
108to your PGP key ring when you click on them.
109
110@item
111Picons can be displayed right from the textual address, see
112@code{gnus-picon-style}. @xref{Picons}.
113
114@item @acronym{ANSI} @acronym{SGR} control sequences can be transformed
115using @kbd{W A}.
116
117@acronym{ANSI} sequences are used in some Chinese hierarchies for
118highlighting articles (@code{gnus-article-treat-ansi-sequences}).
119
120@item Gnus now MIME decodes articles even when they lack "MIME-Version" header.
121This changes the default of @code{gnus-article-loose-mime}.
122
123@item @code{gnus-decay-scores} can be a regexp matching score files.
124For example, set it to @samp{\\.ADAPT\\'} and only adaptive score files
125will be decayed. @xref{Score Decays}.
126
127@item Strings prefixing to the @code{To} and @code{Newsgroup} headers in
128summary lines when using @code{gnus-ignored-from-addresses} can be
129customized with @code{gnus-summary-to-prefix} and
130@code{gnus-summary-newsgroup-prefix}. @xref{To From Newsgroups}.
131
132@item You can replace @acronym{MIME} parts with external bodies.
133See @code{gnus-mime-replace-part} and @code{gnus-article-replace-part}.
134@xref{MIME Commands}, @ref{Using MIME}.
135
136@item
137The option @code{mm-fill-flowed} can be used to disable treatment of
138format=flowed messages. Also, flowed text is disabled when sending
139inline @acronym{PGP} signed messages. @xref{Flowed text, ,Flowed text,
140emacs-mime, The Emacs MIME Manual}. (New in Gnus 5.10.7)
141@c This entry is also present in the node "Oort Gnus".
142
143@end itemize
144
145@item Changes in Message mode
146
147@itemize @bullet
148@item Gnus now supports the ``hashcash'' client puzzle anti-spam mechanism.
149Use @code{(setq message-generate-hashcash t)} to enable.
150@xref{Hashcash}.
151
152@item You can now drag and drop attachments to the Message buffer.
153See @code{mml-dnd-protocol-alist} and @code{mml-dnd-attach-options}.
154@xref{MIME, ,MIME, message, Message Manual}.
155
156@item The option @code{message-yank-empty-prefix} now controls how
157empty lines are prefixed in cited text. @xref{Insertion Variables,
158,Insertion Variables, message, Message Manual}.
159
160@item Gnus uses narrowing to hide headers in Message buffers.
161The @code{References} header is hidden by default. To make all
162headers visible, use @code{(setq message-hidden-headers nil)}.
163@xref{Message Headers, ,Message Headers, message, Message Manual}.
164
165@item You can highlight different levels of citations like in the
166article buffer. See @code{gnus-message-highlight-citation}.
167
168@item @code{auto-fill-mode} is enabled by default in Message mode.
169See @code{message-fill-column}. @xref{Various Message Variables, ,
170Message Headers, message, Message Manual}.
171
172@item You can now store signature files in a special directory
173named @code{message-signature-directory}.
174
175@item The option @code{message-citation-line-format} controls the format
176of the "Whomever writes:" line. You need to set
177@code{message-citation-line-function} to
178@code{message-insert-formated-citation-line} as well.
179@end itemize
180
181@item Changes in back ends
182
183@itemize @bullet
184@item The nntp back end stores article marks in @file{~/News/marks}.
185
186The directory can be changed using the (customizable) variable
187@code{nntp-marks-directory}, and marks can be disabled using the
188(back end) variable @code{nntp-marks-is-evil}. The advantage of this
189is that you can copy @file{~/News/marks} (using rsync, scp or
190whatever) to another Gnus installation, and it will realize what
191articles you have read and marked. The data in @file{~/News/marks}
192has priority over the same data in @file{~/.newsrc.eld}.
193
194@item
195You can import and export your @acronym{RSS} subscriptions from
196@acronym{OPML} files. @xref{RSS}.
197
198@item @acronym{IMAP} identity (@acronym{RFC} 2971) is supported.
199
200By default, Gnus does not send any information about itself, but you can
201customize it using the variable @code{nnimap-id}.
202
203@item The @code{nnrss} back end now supports multilingual text.
204Non-@acronym{ASCII} group names for the @code{nnrss} groups are also
205supported. @xref{RSS}.
206
207@item Retrieving mail with @acronym{POP3} is supported over @acronym{SSL}/@acronym{TLS} and with StartTLS.
208
209@item The nnml back end allows other compression programs beside @file{gzip}
210for compressed message files. @xref{Mail Spool}.
211
212@item The nnml back end supports group compaction.
213
214This feature, accessible via the functions
215@code{gnus-group-compact-group} (@kbd{G z} in the group buffer) and
216@code{gnus-server-compact-server} (@kbd{z} in the server buffer)
217renumbers all articles in a group, starting from 1 and removing gaps.
218As a consequence, you get a correct total article count (until
219messages are deleted again).
220@end itemize
221
222@item Appearance
223@c Maybe it's not worth to separate this from "Miscellaneous"?
224
225@itemize @bullet
226
227@item The tool bar has been updated to use GNOME icons.
228You can also customize the tool bar. There's no documentation in the
229manual yet, but @kbd{M-x customize-apropos RET -tool-bar$} should get
230you started. (Only for Emacs, not in XEmacs.)
231@c FIXME: Document this in the manual
232
233@item The tool bar icons are now (de)activated correctly
234in the group buffer, see the variable @code{gnus-group-update-tool-bar}.
235Its default value depends on your Emacs version.
236@c FIXME: Document this in the manual
237
238@item You can change the location of XEmacs' toolbars in Gnus buffers.
239See @code{gnus-use-toolbar} and @code{message-use-toolbar}.
240
241@end itemize
242
243@item Miscellaneous changes
244
245@itemize @bullet
246@item Having edited the select-method for the foreign server in the
247server buffer is immediately reflected to the subscription of the groups
248which use the server in question. For instance, if you change
249@code{nntp-via-address} into @samp{bar.example.com} from
250@samp{foo.example.com}, Gnus will connect to the news host by way of the
251intermediate host @samp{bar.example.com} from next time.
252
253@item The @file{all.SCORE} file can be edited from the group buffer
254using @kbd{W e}.
255
256@end itemize
257
258@end itemize
259
260@c gnus-news.texi ends here.
261
262@ignore
263 arch-tag: 872c7569-4340-4d73-9d1d-7826d9f94a51
264@end ignore
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 4093b061f74..2be85ab9b30 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -6,6 +6,8 @@
6@syncodeindex vr cp 6@syncodeindex vr cp
7@syncodeindex pg cp 7@syncodeindex pg cp
8 8
9@documentencoding ISO-8859-1
10
9@copying 11@copying
10Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 12Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001,
112002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 132002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
@@ -50,7 +52,7 @@ license to the document, as described in section 6 of the license.
50\begin{document} 52\begin{document}
51 53
52% Adjust ../Makefile.in if you change the following line: 54% Adjust ../Makefile.in if you change the following line:
53\newcommand{\gnusversionname}{Gnus v5.11} 55\newcommand{\gnusversionname}{No Gnus v0.7}
54\newcommand{\gnuschaptername}{} 56\newcommand{\gnuschaptername}{}
55\newcommand{\gnussectionname}{} 57\newcommand{\gnussectionname}{}
56 58
@@ -360,7 +362,7 @@ spool or your mbox file. All at the same time, if you want to push your
360luck. 362luck.
361 363
362@c Adjust ../Makefile.in if you change the following line: 364@c Adjust ../Makefile.in if you change the following line:
363This manual corresponds to Gnus v5.11. 365This manual corresponds to No Gnus v0.7.
364 366
365@end ifinfo 367@end ifinfo
366 368
@@ -412,6 +414,7 @@ Other related manuals
412* Emacs-MIME:(emacs-mime). Composing messages; @acronym{MIME}-specific parts. 414* Emacs-MIME:(emacs-mime). Composing messages; @acronym{MIME}-specific parts.
413* Sieve:(sieve). Managing Sieve scripts in Emacs. 415* Sieve:(sieve). Managing Sieve scripts in Emacs.
414* PGG:(pgg). @acronym{PGP/MIME} with Gnus. 416* PGG:(pgg). @acronym{PGP/MIME} with Gnus.
417* SASL:(sasl). @acronym{SASL} authentication in Emacs.
415 418
416@detailmenu 419@detailmenu
417 --- The Detailed Node Listing --- 420 --- The Detailed Node Listing ---
@@ -454,6 +457,7 @@ Group Buffer
454* Browse Foreign Server:: You can browse a server. See what it has to offer. 457* Browse Foreign Server:: You can browse a server. See what it has to offer.
455* Exiting Gnus:: Stop reading news and get some work done. 458* Exiting Gnus:: Stop reading news and get some work done.
456* Group Topics:: A folding group mode divided into topics. 459* Group Topics:: A folding group mode divided into topics.
460* Non-ASCII Group Names:: Accessing groups of non-English names.
457* Misc Group Stuff:: Other stuff that you can to do. 461* Misc Group Stuff:: Other stuff that you can to do.
458 462
459Group Buffer Format 463Group Buffer Format
@@ -493,6 +497,7 @@ Summary Buffer
493* Asynchronous Fetching:: Gnus might be able to pre-fetch articles. 497* Asynchronous Fetching:: Gnus might be able to pre-fetch articles.
494* Article Caching:: You may store articles in a cache. 498* Article Caching:: You may store articles in a cache.
495* Persistent Articles:: Making articles expiry-resistant. 499* Persistent Articles:: Making articles expiry-resistant.
500* Sticky Articles:: Article buffers that are not reused.
496* Article Backlog:: Having already read articles hang around. 501* Article Backlog:: Having already read articles hang around.
497* Saving Articles:: Ways of customizing article saving. 502* Saving Articles:: Ways of customizing article saving.
498* Decoding Articles:: Gnus can treat series of (uu)encoded articles. 503* Decoding Articles:: Gnus can treat series of (uu)encoded articles.
@@ -646,6 +651,7 @@ Getting News
646* Direct Functions:: Connecting directly to the server. 651* Direct Functions:: Connecting directly to the server.
647* Indirect Functions:: Connecting indirectly to the server. 652* Indirect Functions:: Connecting indirectly to the server.
648* Common Variables:: Understood by several connection functions. 653* Common Variables:: Understood by several connection functions.
654* NNTP marks:: Storing marks for @acronym{NNTP} servers.
649 655
650Getting Mail 656Getting Mail
651 657
@@ -749,6 +755,7 @@ Gnus Unplugged
749* Agent as Cache:: The Agent is a big cache too. 755* Agent as Cache:: The Agent is a big cache too.
750* Agent Expiry:: How to make old articles go away. 756* Agent Expiry:: How to make old articles go away.
751* Agent Regeneration:: How to recover from lost connections and other accidents. 757* Agent Regeneration:: How to recover from lost connections and other accidents.
758* Agent and flags:: How the Agent maintains flags.
752* Agent and IMAP:: How to use the Agent with @acronym{IMAP}. 759* Agent and IMAP:: How to use the Agent with @acronym{IMAP}.
753* Outgoing Messages:: What happens when you post/mail something? 760* Outgoing Messages:: What happens when you post/mail something?
754* Agent Variables:: Customizing is fun. 761* Agent Variables:: Customizing is fun.
@@ -784,17 +791,9 @@ Scoring
784* Global Score Files:: Earth-spanning, ear-splitting score files. 791* Global Score Files:: Earth-spanning, ear-splitting score files.
785* Kill Files:: They are still here, but they can be ignored. 792* Kill Files:: They are still here, but they can be ignored.
786* Converting Kill Files:: Translating kill files to score files. 793* Converting Kill Files:: Translating kill files to score files.
787* GroupLens:: Getting predictions on what you like to read.
788* Advanced Scoring:: Using logical expressions to build score rules. 794* Advanced Scoring:: Using logical expressions to build score rules.
789* Score Decays:: It can be useful to let scores wither away. 795* Score Decays:: It can be useful to let scores wither away.
790 796
791GroupLens
792
793* Using GroupLens:: How to make Gnus use GroupLens.
794* Rating Articles:: Letting GroupLens know how you rate articles.
795* Displaying Predictions:: Displaying predictions given by GroupLens.
796* GroupLens Variables:: Customizing GroupLens.
797
798Advanced Scoring 797Advanced Scoring
799 798
800* Advanced Scoring Syntax:: A definition. 799* Advanced Scoring Syntax:: A definition.
@@ -901,6 +900,7 @@ New Features
901* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. 900* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
902* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. 901* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
903* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. 902* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
903* No Gnus:: Very punny.
904 904
905Customization 905Customization
906 906
@@ -1067,6 +1067,11 @@ you would typically set this variable to
1067(setq gnus-secondary-select-methods '((nnmbox ""))) 1067(setq gnus-secondary-select-methods '((nnmbox "")))
1068@end lisp 1068@end lisp
1069 1069
1070Note: the @acronym{NNTP} back end stores marks in marks files
1071(@pxref{NNTP marks}). This feature makes it easy to share marks between
1072several Gnus installations, but may slow down things a bit when fetching
1073new articles. @xref{NNTP marks}, for more information.
1074
1070 1075
1071@node The First Time 1076@node The First Time
1072@section The First Time 1077@section The First Time
@@ -1718,6 +1723,7 @@ long as Gnus is active.
1718* Browse Foreign Server:: You can browse a server. See what it has to offer. 1723* Browse Foreign Server:: You can browse a server. See what it has to offer.
1719* Exiting Gnus:: Stop reading news and get some work done. 1724* Exiting Gnus:: Stop reading news and get some work done.
1720* Group Topics:: A folding group mode divided into topics. 1725* Group Topics:: A folding group mode divided into topics.
1726* Non-ASCII Group Names:: Accessing groups of non-English names.
1721* Misc Group Stuff:: Other stuff that you can to do. 1727* Misc Group Stuff:: Other stuff that you can to do.
1722@end menu 1728@end menu
1723 1729
@@ -1819,8 +1825,15 @@ the true unread message count is not possible efficiently. For
1819hysterical raisins, even the mail back ends, where the true number of 1825hysterical raisins, even the mail back ends, where the true number of
1820unread messages might be available efficiently, use the same limited 1826unread messages might be available efficiently, use the same limited
1821interface. To remove this restriction from Gnus means that the back 1827interface. To remove this restriction from Gnus means that the back
1822end interface has to be changed, which is not an easy job. If you 1828end interface has to be changed, which is not an easy job.
1823want to work on this, please contact the Gnus mailing list. 1829
1830The nnml backend (@pxref{Mail Spool}) has a feature called ``group
1831compaction'' which circumvents this deficiency: the idea is to
1832renumber all articles from 1, removing all gaps between numbers, hence
1833getting a correct total count. Other backends may support this in the
1834future. In order to keep your total article count relatively up to
1835date, you might want to compact your groups (or even directly your
1836server) from time to time. @xref{Misc Group Stuff}, @xref{Server Commands}.
1824 1837
1825@item y 1838@item y
1826Number of unread, unticked, non-dormant articles. 1839Number of unread, unticked, non-dormant articles.
@@ -1886,6 +1899,12 @@ the group lately.
1886A string that says when you last read the group (@pxref{Group 1899A string that says when you last read the group (@pxref{Group
1887Timestamp}). 1900Timestamp}).
1888 1901
1902@item F
1903The disk space used by the articles fetched by both the cache and
1904agent. The value is automatically scaled to bytes(B), kilobytes(K),
1905megabytes(M), or gigabytes(G) to minimize the column width. A format
1906of %7F is sufficient for a fixed-width column.
1907
1889@item u 1908@item u
1890User defined specifier. The next character in the format string should 1909User defined specifier. The next character in the format string should
1891be a letter. Gnus will call the function 1910be a letter. Gnus will call the function
@@ -2071,6 +2090,11 @@ commands will move to the next group, not the next unread group. Even
2071the commands that say they move to the next unread group. The default 2090the commands that say they move to the next unread group. The default
2072is @code{t}. 2091is @code{t}.
2073 2092
2093@vindex gnus-summary-next-group-on-exit
2094If @code{gnus-summary-next-group-on-exit} is @code{t}, when a summary is
2095exited, the point in the group buffer is moved to the next unread group.
2096Otherwise, the point is set to the group just exited. The default is
2097@code{t}.
2074 2098
2075@node Selecting a Group 2099@node Selecting a Group
2076@section Selecting a Group 2100@section Selecting a Group
@@ -2988,6 +3012,15 @@ like this in the group parameters:
2988 (signature "Funky Signature")) 3012 (signature "Funky Signature"))
2989@end example 3013@end example
2990 3014
3015If you're using topics to organize your group buffer
3016(@pxref{Group Topics}), note that posting styles can also be set in
3017the topics parameters. Posting styles in topic parameters apply to all
3018groups in this topic. More precisely, the posting-style settings for a
3019group result from the hierarchical merging of all posting-style
3020entries in the parameters of this group and all the topics it belongs
3021to.
3022
3023
2991@item post-method 3024@item post-method
2992@cindex post-method 3025@cindex post-method
2993If it is set, the value is used as the method for posting message 3026If it is set, the value is used as the method for posting message
@@ -3014,11 +3047,25 @@ translating the group parameter into a Sieve script (@pxref{Sieve
3014Commands}) the following Sieve code is generated: 3047Commands}) the following Sieve code is generated:
3015 3048
3016@example 3049@example
3017if address \"sender\" \"sieve-admin@@extundo.com\" @{ 3050if address "sender" "sieve-admin@@extundo.com" @{
3018 fileinto \"INBOX.list.sieve\"; 3051 fileinto "INBOX.list.sieve";
3052@}
3053@end example
3054
3055To generate tests for multiple email-addresses use a group parameter
3056like @code{(sieve address "sender" ("name@@one.org" else@@two.org"))}.
3057When generating a sieve script (@pxref{Sieve Commands}) Sieve code
3058like the following is generated:
3059
3060@example
3061if address "sender" ["name@@one.org", "else@@two.org"] @{
3062 fileinto "INBOX.list.sieve";
3019@} 3063@}
3020@end example 3064@end example
3021 3065
3066See @pxref{Sieve Commands} for commands and variables that might be of
3067interest in relation to the sieve parameter.
3068
3022The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve, 3069The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve,
3023Top, sieve, Emacs Sieve}. 3070Top, sieve, Emacs Sieve}.
3024 3071
@@ -3132,6 +3179,33 @@ value of the @code{gnus-parameters-case-fold-search} variable to
3132@code{nil}. Otherwise, set it to @code{t} if you want to compare them 3179@code{nil}. Otherwise, set it to @code{t} if you want to compare them
3133always in a case-insensitive manner. 3180always in a case-insensitive manner.
3134 3181
3182You can define different sorting to different groups via
3183@code{gnus-parameters}. Here is an example to sort an @acronym{NNTP}
3184group by reverse date to see the latest news at the top and an
3185@acronym{RSS} group by subject. In this example, the first group is the
3186Debian daily news group @code{gmane.linux.debian.user.news} from
3187news.gmane.org. The @acronym{RSS} group corresponds to the Debian
3188weekly news RSS feed
3189@url{http://packages.debian.org/unstable/newpkg_main.en.rdf},
3190@xref{RSS}.
3191
3192@lisp
3193(setq
3194 gnus-parameters
3195 '(("nntp.*gmane\\.debian\\.user\\.news"
3196 (gnus-show-threads nil)
3197 (gnus-article-sort-functions '((not gnus-article-sort-by-date)))
3198 (gnus-use-adaptive-scoring nil)
3199 (gnus-use-scoring nil))
3200 ("nnrss.*debian"
3201 (gnus-show-threads nil)
3202 (gnus-article-sort-functions 'gnus-article-sort-by-subject)
3203 (gnus-use-adaptive-scoring nil)
3204 (gnus-use-scoring t)
3205 (gnus-score-find-score-files-function 'gnus-score-find-single)
3206 (gnus-summary-line-format "%U%R%z%d %I%(%[ %s %]%)\n"))))
3207@end lisp
3208
3135 3209
3136@node Listing Groups 3210@node Listing Groups
3137@section Listing Groups 3211@section Listing Groups
@@ -3847,7 +3921,7 @@ Go to the next topic (@code{gnus-topic-goto-next-topic}).
3847@item T M-p 3921@item T M-p
3848@kindex T M-p (Topic) 3922@kindex T M-p (Topic)
3849@findex gnus-topic-goto-previous-topic 3923@findex gnus-topic-goto-previous-topic
3850Go to the next topic (@code{gnus-topic-goto-previous-topic}). 3924Go to the previous topic (@code{gnus-topic-goto-previous-topic}).
3851 3925
3852@item G p 3926@item G p
3853@kindex G p (Topic) 3927@kindex G p (Topic)
@@ -4086,6 +4160,132 @@ happen. In fact, I hereby declare that it is @dfn{undefined} what
4086happens. You just have to be careful if you do stuff like that. 4160happens. You just have to be careful if you do stuff like that.
4087 4161
4088 4162
4163@node Non-ASCII Group Names
4164@section Accessing groups of non-English names
4165@cindex non-ascii group names
4166
4167There are some news servers that provide groups of which the names are
4168expressed with their native languages in the world. For instance, in a
4169certain news server there are some newsgroups of which the names are
4170spelled in Chinese, where people are talking in Chinese. You can, of
4171course, subscribe to such news groups using Gnus. Currently Gnus
4172supports non-@acronym{ASCII} group names not only with the @code{nntp}
4173back end but also with the @code{nnml} back end and the @code{nnrss}
4174back end.
4175
4176Every such group name is encoded by a certain charset in the server
4177side (in an @acronym{NNTP} server its administrator determines the
4178charset, but for groups in the other back ends it is determined by you).
4179Gnus has to display the decoded ones for you in the group buffer and the
4180article buffer, and needs to use the encoded ones when communicating
4181with servers. However, Gnus doesn't know what charset is used for each
4182non-@acronym{ASCII} group name. The following two variables are just
4183the ones for telling Gnus what charset should be used for each group:
4184
4185@table @code
4186@item gnus-group-name-charset-method-alist
4187@vindex gnus-group-name-charset-method-alist
4188An alist of select methods and charsets. The default value is
4189@code{nil}. The names of groups in the server specified by that select
4190method are all supposed to use the corresponding charset. For example:
4191
4192@lisp
4193(setq gnus-group-name-charset-method-alist
4194 '(((nntp "news.com.cn") . cn-gb-2312)))
4195@end lisp
4196
4197Charsets specified for groups with this variable are preferred to the
4198ones specified for the same groups with the
4199@code{gnus-group-name-charset-group-alist} variable (see below).
4200
4201A select method can be very long, like:
4202
4203@lisp
4204(nntp "gmane"
4205 (nntp-address "news.gmane.org")
4206 (nntp-end-of-line "\n")
4207 (nntp-open-connection-function
4208 nntp-open-via-rlogin-and-telnet)
4209 (nntp-via-rlogin-command "ssh")
4210 (nntp-via-rlogin-command-switches
4211 ("-C" "-t" "-e" "none"))
4212 (nntp-via-address @dots{}))
4213@end lisp
4214
4215In that case, you can truncate it into @code{(nntp "gmane")} in this
4216variable. That is, it is enough to contain only the back end name and
4217the server name.
4218
4219@item gnus-group-name-charset-group-alist
4220@cindex UTF-8 group names
4221@vindex gnus-group-name-charset-group-alist
4222An alist of regexp of group name and the charset for group names.
4223@code{((".*" . utf-8))} is the default value if UTF-8 is supported,
4224otherwise the default is @code{nil}. For example:
4225
4226@lisp
4227(setq gnus-group-name-charset-group-alist
4228 '(("\\.com\\.cn:" . cn-gb-2312)
4229 (".*" . utf-8)))
4230@end lisp
4231
4232Note that this variable is ignored if the match is made with
4233@code{gnus-group-name-charset-method-alist}.
4234@end table
4235
4236Those two variables are used also to determine the charset for encoding
4237and decoding non-@acronym{ASCII} group names that are in the back ends
4238other than @code{nntp}. It means that it is you who determine it. If
4239you do nothing, the charset used for group names in those back ends will
4240all be @code{utf-8} because of the last element of
4241@code{gnus-group-name-charset-group-alist}.
4242
4243There is one more important variable for non-@acronym{ASCII} group
4244names. @emph{XEmacs users must set this}. Emacs users necessarily need
4245not do:
4246
4247@table @code
4248@item nnmail-pathname-coding-system
4249The value of this variable should be a coding system or @code{nil}
4250(which is the default). The @code{nnml} back end, the @code{nnrss} back
4251end, the @acronym{NNTP} marks feature (@pxref{NNTP marks}), the agent,
4252and the cache use non-@acronym{ASCII} group names in those files and
4253directories. This variable overrides the value of
4254@code{file-name-coding-system} which specifies the coding system used
4255when encoding and decoding those file names and directory names.
4256
4257In XEmacs (with the @code{mule} feature), @code{file-name-coding-system}
4258is the only means to specify the coding system used to encode and decode
4259file names. Therefore, @emph{you, XEmacs users, have to set it} to the
4260coding system that is suitable to encode and decode non-@acronym{ASCII}
4261group names. On the other hand, Emacs uses the value of
4262@code{default-file-name-coding-system} if @code{file-name-coding-system}
4263is @code{nil}. Normally the value of
4264@code{default-file-name-coding-system} is initialized according to the
4265locale, so you will need to do nothing if the value is suitable to
4266encode and decode non-@acronym{ASCII} group names.
4267
4268The value of this variable (or @code{default-file-name-coding-system})
4269does not necessarily need to be the same value that is determined by
4270@code{gnus-group-name-charset-method-alist} and
4271@code{gnus-group-name-charset-group-alist}.
4272
4273If you want to subscribe to the groups spelled in Chinese but
4274@code{default-file-name-coding-system} is initialized by default to
4275@code{iso-latin-1} for example, that is the most typical case where you
4276have to set @code{nnmail-pathname-coding-system} even if you are an
4277Emacs user. The @code{utf-8} coding system is a good candidate for it.
4278Otherwise, you may change the locale in your system so that
4279@code{default-file-name-coding-system} may be initialized to an
4280appropriate value, instead of specifying this variable.
4281@end table
4282
4283Note that when you copy or move articles from a non-@acronym{ASCII}
4284group to another group, the charset used to encode and decode group
4285names should be the same in both groups. Otherwise the Newsgroups
4286header will be displayed incorrectly in the article buffer.
4287
4288
4089@node Misc Group Stuff 4289@node Misc Group Stuff
4090@section Misc Group Stuff 4290@section Misc Group Stuff
4091 4291
@@ -4152,6 +4352,15 @@ sending them over the network: they're just saved directly to the group
4152in question. The corresponding back end must have a request-post method 4352in question. The corresponding back end must have a request-post method
4153for this to work though. 4353for this to work though.
4154 4354
4355@item G z
4356@kindex G z (Group)
4357@findex gnus-group-compact-group
4358
4359Compact the group under point (@code{gnus-group-compact-group}).
4360Currently implemented only in nnml (@pxref{Mail Spool}). This removes
4361gaps between article numbers, hence getting a correct total article
4362count.
4363
4155@end table 4364@end table
4156 4365
4157Variables for the group buffer: 4366Variables for the group buffer:
@@ -4179,31 +4388,6 @@ generated. It may be used to move point around, for instance.
4179Groups matching this regexp will always be listed in the group buffer, 4388Groups matching this regexp will always be listed in the group buffer,
4180whether they are empty or not. 4389whether they are empty or not.
4181 4390
4182@item gnus-group-name-charset-method-alist
4183@vindex gnus-group-name-charset-method-alist
4184An alist of method and the charset for group names. It is used to show
4185non-@acronym{ASCII} group names.
4186
4187For example:
4188@lisp
4189(setq gnus-group-name-charset-method-alist
4190 '(((nntp "news.com.cn") . cn-gb-2312)))
4191@end lisp
4192
4193@item gnus-group-name-charset-group-alist
4194@cindex UTF-8 group names
4195@vindex gnus-group-name-charset-group-alist
4196An alist of regexp of group name and the charset for group names. It
4197is used to show non-@acronym{ASCII} group names. @code{((".*"
4198utf-8))} is the default value if UTF-8 is supported, otherwise the
4199default is @code{nil}.
4200
4201For example:
4202@lisp
4203(setq gnus-group-name-charset-group-alist
4204 '(("\\.com\\.cn:" . cn-gb-2312)))
4205@end lisp
4206
4207@end table 4391@end table
4208 4392
4209@node Scanning New Messages 4393@node Scanning New Messages
@@ -4536,6 +4720,7 @@ command or better use it as a prefix key. For example:
4536* Asynchronous Fetching:: Gnus might be able to pre-fetch articles. 4720* Asynchronous Fetching:: Gnus might be able to pre-fetch articles.
4537* Article Caching:: You may store articles in a cache. 4721* Article Caching:: You may store articles in a cache.
4538* Persistent Articles:: Making articles expiry-resistant. 4722* Persistent Articles:: Making articles expiry-resistant.
4723* Sticky Articles:: Article buffers that are not reused.
4539* Article Backlog:: Having already read articles hang around. 4724* Article Backlog:: Having already read articles hang around.
4540* Saving Articles:: Ways of customizing article saving. 4725* Saving Articles:: Ways of customizing article saving.
4541* Decoding Articles:: Gnus can treat series of (uu)encoded articles. 4726* Decoding Articles:: Gnus can treat series of (uu)encoded articles.
@@ -4838,6 +5023,13 @@ summary line spec returns the @code{To}, @code{Newsreader} or
4838@code{From} header, the value of the @code{To} or @code{Newsreader} 5023@code{From} header, the value of the @code{To} or @code{Newsreader}
4839headers are used instead. 5024headers are used instead.
4840 5025
5026To distinguish regular articles from those where the @code{From} field
5027has been swapped, a string is prefixed to the @code{To} or
5028@code{Newsgroups} header in the summary line. By default the string is
5029@samp{-> } for @code{To} and @samp{=> } for @code{Newsgroups}, you can
5030customize these strings with @code{gnus-summary-to-prefix} and
5031@code{gnus-summary-newsgroup-prefix}.
5032
4841@end enumerate 5033@end enumerate
4842 5034
4843@vindex nnmail-extra-headers 5035@vindex nnmail-extra-headers
@@ -6362,6 +6554,27 @@ Limit the summary buffer to articles that match some author
6362(@code{gnus-summary-limit-to-author}). If given a prefix, exclude 6554(@code{gnus-summary-limit-to-author}). If given a prefix, exclude
6363matching articles. 6555matching articles.
6364 6556
6557@item / R
6558@kindex / R (Summary)
6559@findex gnus-summary-limit-to-recipient
6560Limit the summary buffer to articles that match some recipient
6561(@code{gnus-summary-limit-to-recipient}). If given a prefix, exclude
6562matching articles.
6563
6564@item / A
6565@kindex / A (Summary)
6566@findex gnus-summary-limit-to-address
6567Limit the summary buffer to articles in which contents of From, To or Cc
6568header match a given address (@code{gnus-summary-limit-to-address}). If
6569given a prefix, exclude matching articles.
6570
6571@item / S
6572@kindex / S (Summary)
6573@findex gnus-summary-limit-to-singletons
6574Limit the summary buffer to articles that aren't part of any displayed
6575threads (@code{gnus-summary-limit-to-singletons}). If given a prefix,
6576limit to articles that are part of displayed threads.
6577
6365@item / x 6578@item / x
6366@kindex / x (Summary) 6579@kindex / x (Summary)
6367@findex gnus-summary-limit-to-extra 6580@findex gnus-summary-limit-to-extra
@@ -6427,6 +6640,13 @@ group parameter predicate
6427(@code{gnus-summary-limit-to-display-predicate}). @xref{Group 6640(@code{gnus-summary-limit-to-display-predicate}). @xref{Group
6428Parameters}, for more on this predicate. 6641Parameters}, for more on this predicate.
6429 6642
6643@item / r
6644@kindex / r (Summary)
6645@findex gnus-summary-limit-to-replied
6646Limit the summary buffer to replied articles
6647(@code{gnus-summary-limit-to-replied}). If given a prefix, exclude
6648replied articles.
6649
6430@item / E 6650@item / E
6431@itemx M S 6651@itemx M S
6432@kindex M S (Summary) 6652@kindex M S (Summary)
@@ -6488,6 +6708,20 @@ if @var{back-end}@code{-get-new-mail} is non-@code{nil}.
6488Insert all old articles in the summary buffer. If given a numbered 6708Insert all old articles in the summary buffer. If given a numbered
6489prefix, fetch this number of articles. 6709prefix, fetch this number of articles.
6490 6710
6711@item / b
6712@kindex / b (Summary)
6713@findex gnus-summary-limit-to-bodies
6714Limit the summary buffer to articles that have bodies that match a
6715certain regexp (@code{gnus-summary-limit-to-bodies}). If given a
6716prefix, reverse the limit. This command is quite slow since it
6717requires selecting each article to find the matches.
6718
6719@item / h
6720@kindex / h (Summary)
6721@findex gnus-summary-limit-to-headers
6722Like the previous command, only limit to headers instead
6723(@code{gnus-summary-limit-to-headers}).
6724
6491@end table 6725@end table
6492 6726
6493 6727
@@ -6988,6 +7222,12 @@ summary buffer is otherwise unthreaded.
6988Make the current article the child of the marked (or previous) article 7222Make the current article the child of the marked (or previous) article
6989(@code{gnus-summary-reparent-thread}). 7223(@code{gnus-summary-reparent-thread}).
6990 7224
7225@item T M-^
7226@kindex T M-^ (Summary)
7227@findex gnus-summary-reparent-children
7228Make the current article the parent of the marked articles
7229(@code{gnus-summary-reparent-children}).
7230
6991@end table 7231@end table
6992 7232
6993The following commands are thread movement commands. They all 7233The following commands are thread movement commands. They all
@@ -7052,6 +7292,7 @@ Matching}).
7052@findex gnus-thread-sort-by-score 7292@findex gnus-thread-sort-by-score
7053@findex gnus-thread-sort-by-subject 7293@findex gnus-thread-sort-by-subject
7054@findex gnus-thread-sort-by-author 7294@findex gnus-thread-sort-by-author
7295@findex gnus-thread-sort-by-recipient
7055@findex gnus-thread-sort-by-number 7296@findex gnus-thread-sort-by-number
7056@findex gnus-thread-sort-by-random 7297@findex gnus-thread-sort-by-random
7057@vindex gnus-thread-sort-functions 7298@vindex gnus-thread-sort-functions
@@ -7064,8 +7305,10 @@ function, a list of functions, or a list containing functions and
7064 7305
7065By default, sorting is done on article numbers. Ready-made sorting 7306By default, sorting is done on article numbers. Ready-made sorting
7066predicate functions include @code{gnus-thread-sort-by-number}, 7307predicate functions include @code{gnus-thread-sort-by-number},
7067@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, 7308@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-recipient},
7068@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, 7309@code{gnus-thread-sort-by-subject},
7310@code{gnus-thread-sort-by-date},
7311@code{gnus-thread-sort-by-score},
7069@code{gnus-thread-sort-by-most-recent-number}, 7312@code{gnus-thread-sort-by-most-recent-number},
7070@code{gnus-thread-sort-by-most-recent-date}, 7313@code{gnus-thread-sort-by-most-recent-date},
7071@code{gnus-thread-sort-by-random} and 7314@code{gnus-thread-sort-by-random} and
@@ -7103,8 +7346,7 @@ say something like:
7103 7346
7104@lisp 7347@lisp
7105(setq gnus-thread-sort-functions 7348(setq gnus-thread-sort-functions
7106 '((lambda (t1 t2) 7349 '((not gnus-thread-sort-by-number)
7107 (not (gnus-thread-sort-by-number t1 t2)))
7108 gnus-thread-sort-by-score)) 7350 gnus-thread-sort-by-score))
7109@end lisp 7351@end lisp
7110 7352
@@ -7141,6 +7383,8 @@ say something like:
7141 gnus-article-sort-by-subject)) 7383 gnus-article-sort-by-subject))
7142@end lisp 7384@end lisp
7143 7385
7386You can define group specific sorting via @code{gnus-parameters},
7387@xref{Group Parameters}.
7144 7388
7145 7389
7146@node Asynchronous Fetching 7390@node Asynchronous Fetching
@@ -7362,6 +7606,53 @@ interested in persistent articles:
7362(setq gnus-use-cache 'passive) 7606(setq gnus-use-cache 'passive)
7363@end lisp 7607@end lisp
7364 7608
7609@node Sticky Articles
7610@section Sticky Articles
7611@cindex sticky articles
7612
7613When you select an article the current article buffer will be reused
7614according to the value of the variable
7615@code{gnus-single-article-buffer}. If its value is non-@code{nil} (the
7616default) all articles reuse the same article buffer. Else each group
7617has its own article buffer.
7618
7619This implies that it's not possible to have more than one article buffer
7620in a group at a time. But sometimes you might want to display all the
7621latest emails from your mother, your father, your aunt, your uncle and
7622your 17 cousins to coordinate the next christmas party.
7623
7624That's where sticky articles come in handy. A sticky article buffer
7625basically is a normal article buffer, but it won't be reused when you
7626select another article. You can make an article sticky with:
7627
7628@table @kbd
7629@item A S
7630@kindex A S (Summary)
7631@findex gnus-sticky-article
7632Make the current article sticky. If a prefix arg is given, ask for a
7633name for this sticky article buffer.
7634@end table
7635
7636To close a sticky article buffer you can use these commands:
7637
7638@table @kbd
7639@item q
7640@kindex q (Article)
7641@findex bury-buffer
7642Puts this sticky article buffer at the end of the list of all buffers.
7643
7644@item k
7645@kindex k (Article)
7646@findex gnus-kill-sticky-article-buffer
7647Kills this sticky article buffer.
7648@end table
7649
7650To kill all sticky article buffers you can use:
7651
7652@defun gnus-kill-sticky-article-buffers ARG
7653Kill all sticky article buffers.
7654If a prefix ARG is given, ask for confirmation.
7655@end defun
7365 7656
7366@node Article Backlog 7657@node Article Backlog
7367@section Article Backlog 7658@section Article Backlog
@@ -8555,6 +8846,16 @@ is rumored to have employed this form of, uh, somewhat weak encryption.
8555@findex gnus-summary-morse-message 8846@findex gnus-summary-morse-message
8556Morse decode the article buffer (@code{gnus-summary-morse-message}). 8847Morse decode the article buffer (@code{gnus-summary-morse-message}).
8557 8848
8849@item W i
8850@kindex W i (Summary)
8851@findex gnus-summary-idna-message
8852Decode IDNA encoded domain names in the current articles. IDNA
8853encoded domain names looks like @samp{xn--bar}. If a string remain
8854unencoded after running invoking this, it is likely an invalid IDNA
8855string (@samp{xn--bar} is invalid). You must have GNU Libidn
8856(@url{http://www.gnu.org/software/libidn/}) installed for this command
8857to work.
8858
8558@item W t 8859@item W t
8559@item t 8860@item t
8560@kindex W t (Summary) 8861@kindex W t (Summary)
@@ -8657,9 +8958,9 @@ CRs into LF (this takes care of Mac line endings)
8657Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). 8958Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}).
8658Quoted-Printable is one common @acronym{MIME} encoding employed when 8959Quoted-Printable is one common @acronym{MIME} encoding employed when
8659sending non-@acronym{ASCII} (i.e., 8-bit) articles. It typically 8960sending non-@acronym{ASCII} (i.e., 8-bit) articles. It typically
8660makes strings like @samp{déjà vu} look like @samp{d=E9j=E0 vu}, which 8961makes strings like @samp{d@'ej@`a vu} look like @samp{d=E9j=E0 vu},
8661doesn't look very readable to me. Note that this is usually done 8962which doesn't look very readable to me. Note that this is usually
8662automatically by Gnus if the message in question has a 8963done automatically by Gnus if the message in question has a
8663@code{Content-Transfer-Encoding} header that says that this encoding 8964@code{Content-Transfer-Encoding} header that says that this encoding
8664has been done. If a prefix is given, a charset will be asked for. 8965has been done. If a prefix is given, a charset will be asked for.
8665 8966
@@ -8680,6 +8981,14 @@ Treat HZ or HZP (@code{gnus-article-decode-HZ}). HZ (or HZP) is one
8680common encoding employed when sending Chinese articles. It typically 8981common encoding employed when sending Chinese articles. It typically
8681makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}. 8982makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}.
8682 8983
8984@item W A
8985@kindex W A (Summary)
8986@findex gnus-article-treat-ansi-sequences
8987@cindex @acronym{ANSI} control sequences
8988Translate @acronym{ANSI} SGR control sequences into overlays or
8989extents (@code{gnus-article-treat-ansi-sequences}). @acronym{ANSI}
8990sequences are used in some Chinese hierarchies for highlighting.
8991
8683@item W u 8992@item W u
8684@kindex W u (Summary) 8993@kindex W u (Summary)
8685@findex gnus-article-unsplit-urls 8994@findex gnus-article-unsplit-urls
@@ -9307,7 +9616,7 @@ Translate the article from one language to another
9307@cindex viewing attachments 9616@cindex viewing attachments
9308 9617
9309The following commands all understand the numerical prefix. For 9618The following commands all understand the numerical prefix. For
9310instance, @kbd{3 b} means ``view the third @acronym{MIME} part''. 9619instance, @kbd{3 K v} means ``view the third @acronym{MIME} part''.
9311 9620
9312@table @kbd 9621@table @kbd
9313@item b 9622@item b
@@ -9320,6 +9629,21 @@ View the @acronym{MIME} part.
9320@kindex K o (Summary) 9629@kindex K o (Summary)
9321Save the @acronym{MIME} part. 9630Save the @acronym{MIME} part.
9322 9631
9632@item K O
9633@kindex K O (Summary)
9634Prompt for a file name, then save the @acronym{MIME} part and strip it
9635from the article. The stripped @acronym{MIME} object will be referred
9636via the message/external-body @acronym{MIME} type.
9637
9638@item K r
9639@kindex K r (Summary)
9640Replace the @acronym{MIME} part with an external body.
9641
9642@item K d
9643@kindex K d (Summary)
9644Delete the @acronym{MIME} part and add some information about the
9645removed part.
9646
9323@item K c 9647@item K c
9324@kindex K c (Summary) 9648@kindex K c (Summary)
9325Copy the @acronym{MIME} part. 9649Copy the @acronym{MIME} part.
@@ -9677,6 +10001,11 @@ Sort by article number (@code{gnus-summary-sort-by-number}).
9677@findex gnus-summary-sort-by-author 10001@findex gnus-summary-sort-by-author
9678Sort by author (@code{gnus-summary-sort-by-author}). 10002Sort by author (@code{gnus-summary-sort-by-author}).
9679 10003
10004@item C-c C-s C-t
10005@kindex C-c C-s C-t (Summary)
10006@findex gnus-summary-sort-by-recipient
10007Sort by recipient (@code{gnus-summary-sort-by-recipient}).
10008
9680@item C-c C-s C-s 10009@item C-c C-s C-s
9681@kindex C-c C-s C-s (Summary) 10010@kindex C-c C-s C-s (Summary)
9682@findex gnus-summary-sort-by-subject 10011@findex gnus-summary-sort-by-subject
@@ -10401,6 +10730,18 @@ Search through all subsequent (raw) articles for a regexp
10401Search through all previous (raw) articles for a regexp 10730Search through all previous (raw) articles for a regexp
10402(@code{gnus-summary-search-article-backward}). 10731(@code{gnus-summary-search-article-backward}).
10403 10732
10733@item M-S
10734@kindex M-S (Summary)
10735@findex gnus-summary-repeat-search-article-forward
10736Repeat the previous search forwards
10737(@code{gnus-summary-repeat-search-article-forward}).
10738
10739@item M-R
10740@kindex M-R (Summary)
10741@findex gnus-summary-repeat-search-article-backward
10742Repeat the previous search backwards
10743(@code{gnus-summary-repeat-search-article-backward}).
10744
10404@item & 10745@item &
10405@kindex & (Summary) 10746@kindex & (Summary)
10406@findex gnus-summary-execute-command 10747@findex gnus-summary-execute-command
@@ -10442,6 +10783,12 @@ Pull all cached articles (for the current group) into the summary buffer
10442Pull all dormant articles (for the current group) into the summary buffer 10783Pull all dormant articles (for the current group) into the summary buffer
10443(@code{gnus-summary-insert-dormant-articles}). 10784(@code{gnus-summary-insert-dormant-articles}).
10444 10785
10786@item Y t
10787@kindex Y t (Summary)
10788@findex gnus-summary-insert-ticked-articles
10789Pull all ticked articles (for the current group) into the summary buffer
10790(@code{gnus-summary-insert-ticked-articles}).
10791
10445@end table 10792@end table
10446 10793
10447 10794
@@ -10464,6 +10811,28 @@ whenever you see a message that is a collection of other messages of
10464some format, you @kbd{C-d} and read these messages in a more convenient 10811some format, you @kbd{C-d} and read these messages in a more convenient
10465fashion. 10812fashion.
10466 10813
10814@vindex gnus-auto-select-on-ephemeral-exit
10815The variable @code{gnus-auto-select-on-ephemeral-exit} controls what
10816article should be selected after exiting a digest group. Valid values
10817include:
10818
10819@table @code
10820@item next
10821Select the next article.
10822
10823@item next-unread
10824Select the next unread article.
10825
10826@item next-noselect
10827Move the cursor to the next article. This is the default.
10828
10829@item next-unread-noselect
10830Move the cursor to the next unread article.
10831@end table
10832
10833If it has any other value or there is no next (unread) article, the
10834article selected before entering to the digest group will appear.
10835
10467@item C-M-d 10836@item C-M-d
10468@kindex C-M-d (Summary) 10837@kindex C-M-d (Summary)
10469@findex gnus-summary-read-document 10838@findex gnus-summary-read-document
@@ -10562,6 +10931,12 @@ Mark all articles, even the ticked ones, as read and then exit
10562Mark all articles as read and go to the next group 10931Mark all articles as read and go to the next group
10563(@code{gnus-summary-catchup-and-goto-next-group}). 10932(@code{gnus-summary-catchup-and-goto-next-group}).
10564 10933
10934@item Z p
10935@kindex Z p (Summary)
10936@findex gnus-summary-catchup-and-goto-prev-group
10937Mark all articles as read and go to the previous group
10938(@code{gnus-summary-catchup-and-goto-prev-group}).
10939
10565@item Z R 10940@item Z R
10566@itemx C-x C-s 10941@itemx C-x C-s
10567@kindex Z R (Summary) 10942@kindex Z R (Summary)
@@ -10891,7 +11266,7 @@ Send a message to the mailing list owner, if List-Owner field exists.
10891 11266
10892@item C-c C-n a 11267@item C-c C-n a
10893@kindex C-c C-n a (Summary) 11268@kindex C-c C-n a (Summary)
10894@findex gnus-mailing-list-owner 11269@findex gnus-mailing-list-archive
10895Browse the mailing list archive, if List-Archive field exists. 11270Browse the mailing list archive, if List-Archive field exists.
10896 11271
10897@end table 11272@end table
@@ -11111,6 +11486,13 @@ like. The stripped @acronym{MIME} object will be referred via the
11111message/external-body @acronym{MIME} type. 11486message/external-body @acronym{MIME} type.
11112(@code{gnus-mime-save-part-and-strip}). 11487(@code{gnus-mime-save-part-and-strip}).
11113 11488
11489@findex gnus-mime-replace-part
11490@item r (Article)
11491@kindex r (Article)
11492Prompt for a file name, replace the @acronym{MIME} object with an
11493external body refering to the file via the message/external-body
11494@acronym{MIME} type. (@code{gnus-mime-replace-part}).
11495
11114@findex gnus-mime-delete-part 11496@findex gnus-mime-delete-part
11115@item d (Article) 11497@item d (Article)
11116@kindex d (Article) 11498@kindex d (Article)
@@ -11118,11 +11500,16 @@ Delete the @acronym{MIME} object from the article and replace it with some
11118information about the removed @acronym{MIME} object 11500information about the removed @acronym{MIME} object
11119(@code{gnus-mime-delete-part}). 11501(@code{gnus-mime-delete-part}).
11120 11502
11503@c FIXME: gnus-auto-select-part should be documented here
11504
11121@findex gnus-mime-copy-part 11505@findex gnus-mime-copy-part
11122@item c (Article) 11506@item c (Article)
11123@kindex c (Article) 11507@kindex c (Article)
11124Copy the @acronym{MIME} object to a fresh buffer and display this buffer 11508Copy the @acronym{MIME} object to a fresh buffer and display this buffer
11125(@code{gnus-mime-copy-part}). Compressed files like @file{.gz} and 11509(@code{gnus-mime-copy-part}). If given a prefix, copy the raw contents
11510without decoding. If given a numerical prefix, you can do semi-manual
11511charset stuff (see @code{gnus-summary-show-article-charset-alist} in
11512@ref{Paging the Article}). Compressed files like @file{.gz} and
11126@file{.bz2} are automatically decompressed if 11513@file{.bz2} are automatically decompressed if
11127@code{auto-compression-mode} is enabled (@pxref{Compressed Files,, 11514@code{auto-compression-mode} is enabled (@pxref{Compressed Files,,
11128Accessing Compressed Files, emacs, The Emacs Editor}). 11515Accessing Compressed Files, emacs, The Emacs Editor}).
@@ -11142,7 +11529,10 @@ Insert the contents of the @acronym{MIME} object into the buffer
11142the raw contents without decoding. If given a numerical prefix, you can 11529the raw contents without decoding. If given a numerical prefix, you can
11143do semi-manual charset stuff (see 11530do semi-manual charset stuff (see
11144@code{gnus-summary-show-article-charset-alist} in @ref{Paging the 11531@code{gnus-summary-show-article-charset-alist} in @ref{Paging the
11145Article}). 11532Article}). Compressed files like @file{.gz} and @file{.bz2} are
11533automatically decompressed depending on @code{jka-compr} regardless of
11534@code{auto-compression-mode} (@pxref{Compressed Files,, Accessing
11535Compressed Files, emacs, The Emacs Editor}).
11146 11536
11147@findex gnus-mime-view-part-internally 11537@findex gnus-mime-view-part-internally
11148@item E (Article) 11538@item E (Article)
@@ -11217,7 +11607,10 @@ for sensible values.
11217@code{head}: Do the treatment on the headers. 11607@code{head}: Do the treatment on the headers.
11218 11608
11219@item 11609@item
11220@code{last}: Do this treatment on the last part. 11610@code{first}: Do this treatment on the first body part.
11611
11612@item
11613@code{last}: Do this treatment on the last body part.
11221 11614
11222@item 11615@item
11223An integer: Do this treatment on all body parts that have a length less 11616An integer: Do this treatment on all body parts that have a length less
@@ -11322,7 +11715,7 @@ possible but those listed are probably sufficient for most people.
11322@item gnus-treat-overstrike (t, integer) 11715@item gnus-treat-overstrike (t, integer)
11323@item gnus-treat-strip-cr (t, integer) 11716@item gnus-treat-strip-cr (t, integer)
11324@item gnus-treat-strip-headers-in-body (t, integer) 11717@item gnus-treat-strip-headers-in-body (t, integer)
11325@item gnus-treat-strip-leading-blank-lines (t, integer) 11718@item gnus-treat-strip-leading-blank-lines (t, first, integer)
11326@item gnus-treat-strip-multiple-blank-lines (t, integer) 11719@item gnus-treat-strip-multiple-blank-lines (t, integer)
11327@item gnus-treat-strip-pem (t, last, integer) 11720@item gnus-treat-strip-pem (t, last, integer)
11328@item gnus-treat-strip-trailing-blank-lines (t, last, integer) 11721@item gnus-treat-strip-trailing-blank-lines (t, last, integer)
@@ -11403,6 +11796,7 @@ is controlled by @code{gnus-body-boundary-delimiter}.
11403@item gnus-treat-play-sounds 11796@item gnus-treat-play-sounds
11404@vindex gnus-treat-translate 11797@vindex gnus-treat-translate
11405@item gnus-treat-translate 11798@item gnus-treat-translate
11799@item gnus-treat-ansi-sequences (t)
11406@vindex gnus-treat-x-pgp-sig 11800@vindex gnus-treat-x-pgp-sig
11407@item gnus-treat-x-pgp-sig (head) 11801@item gnus-treat-x-pgp-sig (head)
11408 11802
@@ -11615,7 +12009,8 @@ This is the delimiter mentioned above. By default, it is @samp{^L}
11615@item gnus-use-idna 12009@item gnus-use-idna
11616This variable controls whether Gnus performs IDNA decoding of 12010This variable controls whether Gnus performs IDNA decoding of
11617internationalized domain names inside @samp{From}, @samp{To} and 12011internationalized domain names inside @samp{From}, @samp{To} and
11618@samp{Cc} headers. This requires 12012@samp{Cc} headers. @xref{IDNA, ,IDNA,message, The Message Manual},
12013for how to compose such messages. This requires
11619@uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this 12014@uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this
11620variable is only enabled if you have installed it. 12015variable is only enabled if you have installed it.
11621 12016
@@ -11873,6 +12268,10 @@ you're in, you could say something like the following:
11873 12268
11874Modify to suit your needs. 12269Modify to suit your needs.
11875 12270
12271@vindex gnus-message-highlight-citation
12272If @code{gnus-message-highlight-citation} is t, different levels of
12273citations are highlighted like in Gnus article buffers also in message
12274mode buffers.
11876 12275
11877@node Archived Messages 12276@node Archived Messages
11878@section Archived Messages 12277@section Archived Messages
@@ -11891,7 +12290,8 @@ Group Commands}).
11891 12290
11892@vindex gnus-message-archive-method 12291@vindex gnus-message-archive-method
11893@code{gnus-message-archive-method} says what virtual server Gnus is to 12292@code{gnus-message-archive-method} says what virtual server Gnus is to
11894use to store sent messages. The default is: 12293use to store sent messages. The default is @code{"archive"}, and when
12294actually being used it is expanded into:
11895 12295
11896@lisp 12296@lisp
11897(nnfolder "archive" 12297(nnfolder "archive"
@@ -11901,6 +12301,22 @@ use to store sent messages. The default is:
11901 (nnfolder-inhibit-expiry t)) 12301 (nnfolder-inhibit-expiry t))
11902@end lisp 12302@end lisp
11903 12303
12304@quotation
12305@vindex gnus-update-message-archive-method
12306Note: a server like this is saved in the @file{~/.newsrc.eld} file first
12307so that it may be used as a real method of the server which is named
12308@code{"archive"} (that is, for the case where
12309@code{gnus-message-archive-method} is set to @code{"archive"}) ever
12310since. If it once has been saved, it will never be updated by default
12311even if you change the value of @code{gnus-message-archive-method}
12312afterward. Therefore, the server @code{"archive"} doesn't necessarily
12313mean the @code{nnfolder} server like this at all times. If you want the
12314saved method to reflect always the value of
12315@code{gnus-message-archive-method}, set the
12316@code{gnus-update-message-archive-method} variable to a non-@code{nil}
12317value. The default value of this variable is @code{nil}.
12318@end quotation
12319
11904You can, however, use any mail select method (@code{nnml}, 12320You can, however, use any mail select method (@code{nnml},
11905@code{nnmbox}, etc.). @code{nnfolder} is a quite likable select method 12321@code{nnmbox}, etc.). @code{nnfolder} is a quite likable select method
11906for doing this sort of thing, though. If you don't like the default 12322for doing this sort of thing, though. If you don't like the default
@@ -12104,6 +12520,9 @@ name can be one of:
12104@item @code{body} 12520@item @code{body}
12105@end itemize 12521@end itemize
12106 12522
12523Note that the @code{signature-file} attribute honors the variable
12524@code{message-signature-directory}.
12525
12107The attribute name can also be a string or a symbol. In that case, 12526The attribute name can also be a string or a symbol. In that case,
12108this will be used as a header name, and the value will be inserted in 12527this will be used as a header name, and the value will be inserted in
12109the headers of the article; if the value is @code{nil}, the header 12528the headers of the article; if the value is @code{nil}, the header
@@ -12535,6 +12954,15 @@ Request that the server regenerate all its data structures
12535(@code{gnus-server-regenerate-server}). This can be useful if you have 12954(@code{gnus-server-regenerate-server}). This can be useful if you have
12536a mail back end that has gotten out of sync. 12955a mail back end that has gotten out of sync.
12537 12956
12957@item z
12958@kindex z (Server)
12959@findex gnus-server-compact-server
12960
12961Compact all groups in the server under point
12962(@code{gnus-server-compact-server}). Currently implemented only in
12963nnml (@pxref{Mail Spool}). This removes gaps between article numbers,
12964hence getting a correct total article count.
12965
12538@end table 12966@end table
12539 12967
12540 12968
@@ -12616,7 +13044,19 @@ configuration to the example above:
12616 (nntp-via-rlogin-command "ssh") 13044 (nntp-via-rlogin-command "ssh")
12617@end lisp 13045@end lisp
12618 13046
12619See also @code{nntp-via-rlogin-command-switches}. 13047See also @code{nntp-via-rlogin-command-switches}. Here's an example for
13048an indirect connection:
13049@lisp
13050(setq gnus-select-method
13051 '(nntp "indirect"
13052 (nntp-address "news.server.example")
13053 (nntp-via-user-name "intermediate_user_name")
13054 (nntp-via-address "intermediate.host.example")
13055 (nntp-via-rlogin-command "ssh")
13056 (nntp-end-of-line "\n")
13057 (nntp-via-rlogin-command-switches ("-C" "-t" "-e" "none"))
13058 (nntp-open-connection-function nntp-open-via-rlogin-and-telnet)))
13059@end lisp
12620 13060
12621If you're behind a firewall, but have direct access to the outside world 13061If you're behind a firewall, but have direct access to the outside world
12622through a wrapper command like "runsocks", you could open a socksified 13062through a wrapper command like "runsocks", you could open a socksified
@@ -13006,9 +13446,9 @@ that doesn't seem to work.
13006It is possible to customize how the connection to the nntp server will 13446It is possible to customize how the connection to the nntp server will
13007be opened. If you specify an @code{nntp-open-connection-function} 13447be opened. If you specify an @code{nntp-open-connection-function}
13008parameter, Gnus will use that function to establish the connection. 13448parameter, Gnus will use that function to establish the connection.
13009Six pre-made functions are supplied. These functions can be grouped in 13449Seven pre-made functions are supplied. These functions can be grouped
13010two categories: direct connection functions (four pre-made), and 13450in two categories: direct connection functions (four pre-made), and
13011indirect ones (two pre-made). 13451indirect ones (three pre-made).
13012 13452
13013@item nntp-never-echoes-commands 13453@item nntp-never-echoes-commands
13014@vindex nntp-never-echoes-commands 13454@vindex nntp-never-echoes-commands
@@ -13049,6 +13489,7 @@ INN versions 2.3.0 and later, for instance.
13049* Direct Functions:: Connecting directly to the server. 13489* Direct Functions:: Connecting directly to the server.
13050* Indirect Functions:: Connecting indirectly to the server. 13490* Indirect Functions:: Connecting indirectly to the server.
13051* Common Variables:: Understood by several connection functions. 13491* Common Variables:: Understood by several connection functions.
13492* NNTP marks:: Storing marks for @acronym{NNTP} servers.
13052@end menu 13493@end menu
13053 13494
13054 13495
@@ -13158,6 +13599,41 @@ the telnet command requires a pseudo-tty allocation on an intermediate
13158host. 13599host.
13159@end table 13600@end table
13160 13601
13602Note that you may want to change the value for @code{nntp-end-of-line}
13603to @samp{\n} (@pxref{Common Variables}).
13604
13605@item nntp-open-via-rlogin-and-netcat
13606@findex nntp-open-via-rlogin-and-netcat
13607Does essentially the same, but uses
13608@uref{http://netcat.sourceforge.net/, netcat} instead of @samp{telnet}
13609to connect to the real @acronym{NNTP} server from the intermediate host.
13610
13611@code{nntp-open-via-rlogin-and-netcat}-specific variables:
13612
13613@table @code
13614@item nntp-via-netcat-command
13615@vindex nntp-via-netcat-command
13616Command used to connect to the real @acronym{NNTP} server from the
13617intermediate host. The default is @samp{nc}. You can also use other
13618programs like @uref{http://www.imasy.or.jp/~gotoh/ssh/connect.html,
13619connect} instead.
13620
13621@item nntp-via-netcat-switches
13622@vindex nntp-via-netcat-switches
13623List of strings to be used as the switches to the
13624@code{nntp-via-telnet-command} command. The default is @code{nil}.
13625
13626@item nntp-via-rlogin-command
13627@vindex nntp-via-rlogin-command
13628Command used to log in on the intermediate host. The default is
13629@samp{rsh}, but @samp{ssh} is a popular alternative.
13630
13631@item nntp-via-rlogin-command-switches
13632@vindex nntp-via-rlogin-command-switches
13633List of strings to be used as the switches to
13634@code{nntp-via-rlogin-command}. The default is @code{nil}.
13635@end table
13636
13161@item nntp-open-via-telnet-and-telnet 13637@item nntp-open-via-telnet-and-telnet
13162@findex nntp-open-via-telnet-and-telnet 13638@findex nntp-open-via-telnet-and-telnet
13163Does essentially the same, but uses @samp{telnet} instead of 13639Does essentially the same, but uses @samp{telnet} instead of
@@ -13193,6 +13669,8 @@ is @samp{bash\\|\$ *\r?$\\|> *\r?}.
13193 13669
13194@end table 13670@end table
13195 13671
13672Note that you may want to change the value for @code{nntp-end-of-line}
13673to @samp{\n} (@pxref{Common Variables}).
13196@end table 13674@end table
13197 13675
13198 13676
@@ -13247,7 +13725,7 @@ not work with named ports.
13247@vindex nntp-end-of-line 13725@vindex nntp-end-of-line
13248String to use as end-of-line marker when talking to the @acronym{NNTP} 13726String to use as end-of-line marker when talking to the @acronym{NNTP}
13249server. This is @samp{\r\n} by default, but should be @samp{\n} when 13727server. This is @samp{\r\n} by default, but should be @samp{\n} when
13250using a non native connection function. 13728using a non native telnet connection function.
13251 13729
13252@item nntp-telnet-command 13730@item nntp-telnet-command
13253@vindex nntp-telnet-command 13731@vindex nntp-telnet-command
@@ -13263,6 +13741,52 @@ is @samp{("-8")}.
13263 13741
13264@end table 13742@end table
13265 13743
13744@node NNTP marks
13745@subsubsection NNTP marks
13746@cindex storing NNTP marks
13747
13748Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP}
13749servers in marks files. A marks file records what marks you have set
13750in a group and each file is specific to the corresponding server.
13751Marks files are stored in @file{~/News/marks}
13752(@code{nntp-marks-directory}) under a classic hierarchy resembling
13753that of a news server, for example marks for the group
13754@samp{gmane.discuss} on the news.gmane.org server will be stored in
13755the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}.
13756
13757Marks files are useful because you can copy the @file{~/News/marks}
13758directory (using rsync, scp or whatever) to another Gnus installation,
13759and it will realize what articles you have read and marked. The data
13760in @file{~/News/marks} has priority over the same data in
13761@file{~/.newsrc.eld}.
13762
13763Note that marks files are very much server-specific: Gnus remembers
13764the article numbers so if you don't use the same servers on both
13765installations things are most likely to break (most @acronym{NNTP}
13766servers do not use the same article numbers as any other server).
13767However, if you use servers A, B, C on one installation and servers A,
13768D, E on the other, you can sync the marks files for A and then you'll
13769get synchronization for that server between the two installations.
13770
13771Using @acronym{NNTP} marks can possibly incur a performance penalty so
13772if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil}
13773variable to @code{t}. Marks will then be stored in @file{~/.newsrc.eld}.
13774
13775Related variables:
13776
13777@table @code
13778
13779@item nntp-marks-is-evil
13780@vindex nntp-marks-is-evil
13781If non-@code{nil}, this back end will ignore any marks files. The
13782default is @code{nil}.
13783
13784@item nntp-marks-directory
13785@vindex nntp-marks-directory
13786The directory where marks for nntp groups will be stored.
13787
13788@end table
13789
13266 13790
13267@node News Spool 13791@node News Spool
13268@subsection News Spool 13792@subsection News Spool
@@ -13926,7 +14450,9 @@ mapped into the @code{imap-shell-program} variable. This should be a
13926ssh %s imapd 14450ssh %s imapd
13927@end example 14451@end example
13928 14452
13929The valid format specifier characters are: 14453Make sure nothing is interfering with the output of the program, e.g.,
14454don't forget to redirect the error output to the void. The valid format
14455specifier characters are:
13930 14456
13931@table @samp 14457@table @samp
13932@item s 14458@item s
@@ -14342,7 +14868,7 @@ body of the messages:
14342The buffer is narrowed to the message in question when @var{function} 14868The buffer is narrowed to the message in question when @var{function}
14343is run. That's why @code{(widen)} needs to be called after 14869is run. That's why @code{(widen)} needs to be called after
14344@code{save-excursion} and @code{save-restriction} in the example 14870@code{save-excursion} and @code{save-restriction} in the example
14345above. Also note that with the nnimap backend, message bodies will 14871above. Also note that with the nnimap back end, message bodies will
14346not be downloaded by default. You need to set 14872not be downloaded by default. You need to set
14347@code{nnimap-split-download-body} to @code{t} to do that 14873@code{nnimap-split-download-body} to @code{t} to do that
14348(@pxref{Splitting in IMAP}). 14874(@pxref{Splitting in IMAP}).
@@ -14956,12 +15482,16 @@ This can also be done non-destructively with
14956@findex nnmail-remove-tabs 15482@findex nnmail-remove-tabs
14957Translate all @samp{TAB} characters into @samp{SPACE} characters. 15483Translate all @samp{TAB} characters into @samp{SPACE} characters.
14958 15484
14959@item nnmail-fix-eudora-headers 15485@item nnmail-ignore-broken-references
14960@findex nnmail-fix-eudora-headers 15486@findex nnmail-ignore-broken-references
15487@c @findex nnmail-fix-eudora-headers
14961@cindex Eudora 15488@cindex Eudora
14962Eudora produces broken @code{References} headers, but OK 15489@cindex Pegasus
14963@code{In-Reply-To} headers. This function will get rid of the 15490Some mail user agents (e.g. Eudora and Pegasus) produce broken
14964@code{References} headers. 15491@code{References} headers, but correct @code{In-Reply-To} headers. This
15492function will get rid of the @code{References} header if the headers
15493contain a line matching the regular expression
15494@code{nnmail-broken-references-mailers}.
14965 15495
14966@end table 15496@end table
14967 15497
@@ -15186,7 +15716,7 @@ When the marks file is used (which it is by default), @code{nnml}
15186servers have the property that you may backup them using @code{tar} or 15716servers have the property that you may backup them using @code{tar} or
15187similar, and later be able to restore them into Gnus (by adding the 15717similar, and later be able to restore them into Gnus (by adding the
15188proper @code{nnml} server) and have all your marks be preserved. Marks 15718proper @code{nnml} server) and have all your marks be preserved. Marks
15189for a group is usually stored in the @code{.marks} file (but see 15719for a group are usually stored in the @code{.marks} file (but see
15190@code{nnml-marks-file-name}) within each @code{nnml} group's directory. 15720@code{nnml-marks-file-name}) within each @code{nnml} group's directory.
15191Individual @code{nnml} groups are also possible to backup, use @kbd{G m} 15721Individual @code{nnml} groups are also possible to backup, use @kbd{G m}
15192to restore the group (after restoring the backup into the nnml 15722to restore the group (after restoring the backup into the nnml
@@ -15245,7 +15775,18 @@ The name of the @dfn{marks} files. The default is @file{.marks}.
15245@item nnml-use-compressed-files 15775@item nnml-use-compressed-files
15246@vindex nnml-use-compressed-files 15776@vindex nnml-use-compressed-files
15247If non-@code{nil}, @code{nnml} will allow using compressed message 15777If non-@code{nil}, @code{nnml} will allow using compressed message
15248files. 15778files. This requires @code{auto-compression-mode} to be enabled
15779(@pxref{Compressed Files, ,Compressed Files, emacs, The Emacs Manual}).
15780If the value of @code{nnml-use-compressed-files} is a string, it is used
15781as the file extension specifying the compression program. You can set it
15782to @samp{.bz2} if your Emacs supports it. A value of @code{t} is
15783equivalent to @samp{.gz}.
15784
15785@item nnml-compressed-files-size-threshold
15786@vindex nnml-compressed-files-size-threshold
15787Default size threshold for compressed message files. Message files with
15788bodies larger than that many characters will be automatically compressed
15789if @code{nnml-use-compressed-files} is non-@code{nil}.
15249 15790
15250@end table 15791@end table
15251 15792
@@ -15958,7 +16499,7 @@ group as read.
15958 16499
15959If the search engine changes its output substantially, @code{nnweb} 16500If the search engine changes its output substantially, @code{nnweb}
15960won't be able to parse it and will fail. One could hardly fault the Web 16501won't be able to parse it and will fail. One could hardly fault the Web
15961providers if they were to do this---their @emph{raison d'être} is to 16502providers if they were to do this---their @emph{raison d'@^etre} is to
15962make money off of advertisements, not to provide services to the 16503make money off of advertisements, not to provide services to the
15963community. Since @code{nnweb} washes the ads off all the articles, one 16504community. Since @code{nnweb} washes the ads off all the articles, one
15964might think that the providers might be somewhat miffed. We'll see. 16505might think that the providers might be somewhat miffed. We'll see.
@@ -16238,6 +16779,15 @@ data files. The default is the value of
16238@code{mm-universal-coding-system} (which defaults to @code{emacs-mule} 16779@code{mm-universal-coding-system} (which defaults to @code{emacs-mule}
16239in Emacs or @code{escape-quoted} in XEmacs). 16780in Emacs or @code{escape-quoted} in XEmacs).
16240 16781
16782@item nnrss-ignore-article-fields
16783@vindex nnrss-ignore-article-fields
16784Some feeds update constantly article fields during their publications,
16785e.g. to indicate the number of comments. However, if there is
16786a difference between the local article and the distant one, the latter
16787is considered to be new. To avoid this and discard some fields, set this
16788variable to the list of fields to be ignored. The default is
16789@code{'(slash:comments)}.
16790
16241@item nnrss-use-local 16791@item nnrss-use-local
16242@vindex nnrss-use-local 16792@vindex nnrss-use-local
16243@findex nnrss-generate-download-script 16793@findex nnrss-generate-download-script
@@ -16275,7 +16825,7 @@ summary buffer.
16275@lisp 16825@lisp
16276(require 'browse-url) 16826(require 'browse-url)
16277 16827
16278(defun browse-nnrss-url( arg ) 16828(defun browse-nnrss-url (arg)
16279 (interactive "p") 16829 (interactive "p")
16280 (let ((url (assq nnrss-url-field 16830 (let ((url (assq nnrss-url-field
16281 (mail-header-extra 16831 (mail-header-extra
@@ -16529,8 +17079,10 @@ to OpenSSL/SSLeay.
16529 17079
16530@vindex imap-shell-program 17080@vindex imap-shell-program
16531@vindex imap-shell-host 17081@vindex imap-shell-host
16532For @acronym{IMAP} connections using the @code{shell} stream, the variable 17082For @acronym{IMAP} connections using the @code{shell} stream, the
16533@code{imap-shell-program} specify what program to call. 17083variable @code{imap-shell-program} specify what program to call. Make
17084sure nothing is interfering with the output of the program, e.g., don't
17085forget to redirect the error output to the void.
16534 17086
16535@item nnimap-authenticator 17087@item nnimap-authenticator
16536@vindex nnimap-authenticator 17088@vindex nnimap-authenticator
@@ -16709,6 +17261,30 @@ messages, you start cursing Gnus for being so slow. On the other hand,
16709if you get a lot of email within a week, setting this variable will 17261if you get a lot of email within a week, setting this variable will
16710cause a lot of network traffic between Gnus and the IMAP server. 17262cause a lot of network traffic between Gnus and the IMAP server.
16711 17263
17264@item nnimap-logout-timeout
17265@vindex nnimap-logout-timeout
17266
17267There is a case where a connection to a @acronym{IMAP} server is unable
17268to close, when connecting to the server via a certain kind of network,
17269e.g. @acronym{VPN}. In that case, it will be observed that a connection
17270between Emacs and the local network looks alive even if the server has
17271closed a connection for some reason (typically, a timeout).
17272Consequently, Emacs continues waiting for a response from the server for
17273the @code{LOGOUT} command that Emacs sent, or hangs in other words. If
17274you are in such a network, setting this variable to a number of seconds
17275will be helpful. If it is set, a hung connection will be closed
17276forcibly, after this number of seconds from the time Emacs sends the
17277@code{LOGOUT} command. It should not be too small value but too large
17278value will be inconvenient too. Perhaps the value 1.0 will be a good
17279candidate but it might be worth trying some other values.
17280
17281Example server specification:
17282
17283@lisp
17284(nnimap "mail.server.com"
17285 (nnimap-logout-timeout 1.0))
17286@end lisp
17287
16712@end table 17288@end table
16713 17289
16714@menu 17290@menu
@@ -18350,7 +18926,8 @@ functionality up to the newsreader makes sense if you're the only person
18350reading news on a machine. 18926reading news on a machine.
18351 18927
18352Setting up Gnus as an ``offline'' newsreader is quite simple. In 18928Setting up Gnus as an ``offline'' newsreader is quite simple. In
18353fact, you don't even have to configure anything. 18929fact, you don't have to configure anything as the agent is now enabled
18930by default (@pxref{Agent Variables, gnus-agent}).
18354 18931
18355Of course, to use it as such, you have to learn a few new commands. 18932Of course, to use it as such, you have to learn a few new commands.
18356 18933
@@ -18362,6 +18939,7 @@ Of course, to use it as such, you have to learn a few new commands.
18362* Agent as Cache:: The Agent is a big cache too. 18939* Agent as Cache:: The Agent is a big cache too.
18363* Agent Expiry:: How to make old articles go away. 18940* Agent Expiry:: How to make old articles go away.
18364* Agent Regeneration:: How to recover from lost connections and other accidents. 18941* Agent Regeneration:: How to recover from lost connections and other accidents.
18942* Agent and flags:: How the Agent maintains flags.
18365* Agent and IMAP:: How to use the Agent with @acronym{IMAP}. 18943* Agent and IMAP:: How to use the Agent with @acronym{IMAP}.
18366* Outgoing Messages:: What happens when you post/mail something? 18944* Outgoing Messages:: What happens when you post/mail something?
18367* Agent Variables:: Customizing is fun. 18945* Agent Variables:: Customizing is fun.
@@ -18526,55 +19104,46 @@ listed below.
18526 19104
18527@cindex Agent Parameters 19105@cindex Agent Parameters
18528@table @code 19106@table @code
18529@item gnus-agent-cat-name 19107@item agent-groups
18530The name of the category.
18531
18532@item gnus-agent-cat-groups
18533The list of groups that are in this category. 19108The list of groups that are in this category.
18534 19109
18535@item gnus-agent-cat-predicate 19110@item agent-predicate
18536A predicate which (generally) gives a rough outline of which articles 19111A predicate which (generally) gives a rough outline of which articles
18537are eligible for downloading; and 19112are eligible for downloading; and
18538 19113
18539@item gnus-agent-cat-score-file 19114@item agent-score
18540a score rule which (generally) gives you a finer granularity when 19115a score rule which (generally) gives you a finer granularity when
18541deciding what articles to download. (Note that this @dfn{download 19116deciding what articles to download. (Note that this @dfn{download
18542score} is not necessarily related to normal scores.) 19117score} is not necessarily related to normal scores.)
18543 19118
18544@item gnus-agent-cat-enable-expiration 19119@item agent-enable-expiration
18545a boolean indicating whether the agent should expire old articles in 19120a boolean indicating whether the agent should expire old articles in
18546this group. Most groups should be expired to conserve disk space. In 19121this group. Most groups should be expired to conserve disk space. In
18547fact, its probably safe to say that the gnus.* hierarchy contains the 19122fact, its probably safe to say that the gnus.* hierarchy contains the
18548only groups that should not be expired. 19123only groups that should not be expired.
18549 19124
18550@item gnus-agent-cat-days-until-old 19125@item agent-days-until-old
18551an integer indicating the number of days that the agent should wait 19126an integer indicating the number of days that the agent should wait
18552before deciding that a read article is safe to expire. 19127before deciding that a read article is safe to expire.
18553 19128
18554@item gnus-agent-cat-low-score 19129@item agent-low-score
18555an integer that overrides the value of @code{gnus-agent-low-score}. 19130an integer that overrides the value of @code{gnus-agent-low-score}.
18556 19131
18557@item gnus-agent-cat-high-score 19132@item agent-high-score
18558an integer that overrides the value of @code{gnus-agent-high-score}. 19133an integer that overrides the value of @code{gnus-agent-high-score}.
18559 19134
18560@item gnus-agent-cat-length-when-short 19135@item agent-short-article
18561an integer that overrides the value of 19136an integer that overrides the value of
18562@code{gnus-agent-short-article}. 19137@code{gnus-agent-short-article}.
18563 19138
18564@item gnus-agent-cat-length-when-long 19139@item agent-long-article
18565an integer that overrides the value of @code{gnus-agent-long-article}. 19140an integer that overrides the value of @code{gnus-agent-long-article}.
18566 19141
18567@c @item gnus-agent-cat-disable-undownloaded-faces 19142@item agent-enable-undownloaded-faces
18568@c a symbol indicating whether the summary buffer should @emph{not} display
18569@c undownloaded articles using the gnus-summary-*-undownloaded-face
18570@c faces. The symbol nil will enable the use of undownloaded faces while
18571@c all other symbols disable them.
18572
18573@item gnus-agent-cat-enable-undownloaded-faces
18574a symbol indicating whether the summary buffer should display 19143a symbol indicating whether the summary buffer should display
18575undownloaded articles using the gnus-summary-*-undownloaded-face 19144undownloaded articles using the @code{gnus-summary-*-undownloaded-face}
18576faces. The symbol nil will disable the use of undownloaded faces while 19145faces. Any symbol other than @code{nil} will enable the use of
18577all other symbols enable them. 19146undownloaded faces.
18578@end table 19147@end table
18579 19148
18580The name of a category can not be changed once the category has been 19149The name of a category can not be changed once the category has been
@@ -19079,9 +19648,9 @@ Download all eligible (@pxref{Agent Categories}) articles in this group.
19079 19648
19080@item J s 19649@item J s
19081@kindex J s (Agent Summary) 19650@kindex J s (Agent Summary)
19082@findex gnus-agent-fetch-series 19651@findex gnus-agent-summary-fetch-series
19083Download all processable articles in this group. 19652Download all processable articles in this group.
19084(@code{gnus-agent-fetch-series}). 19653(@code{gnus-agent-summary-fetch-series}).
19085 19654
19086@item J u 19655@item J u
19087@kindex J u (Agent Summary) 19656@kindex J u (Agent Summary)
@@ -19157,21 +19726,28 @@ If you use the Agent as a cache (to avoid downloading the same article
19157each time you visit it or to minimize your connection time), the 19726each time you visit it or to minimize your connection time), the
19158undownloaded face will probably seem like a good idea. The reason 19727undownloaded face will probably seem like a good idea. The reason
19159being that you do all of our work (marking, reading, deleting) with 19728being that you do all of our work (marking, reading, deleting) with
19160downloaded articles so the normal faces always appear. 19729downloaded articles so the normal faces always appear. For those
19161 19730users using the agent to improve online performance by caching the NOV
19162For occasional Agent users, the undownloaded faces may appear to be an 19731database (most users since 5.10.2), the undownloaded faces may appear
19163absolutely horrible idea. The issue being that, since most of their 19732to be an absolutely horrible idea. The issue being that, since none
19164articles have not been fetched into the Agent, most of the normal 19733of their articles have been fetched into the Agent, all of the
19165faces will be obscured by the undownloaded faces. If this is your 19734normal faces will be obscured by the undownloaded faces.
19166situation, you have two choices available. First, you can completely 19735
19167disable the undownload faces by customizing 19736If you would like to use the undownloaded faces, you must enable the
19168@code{gnus-summary-highlight} to delete the three cons-cells that 19737undownloaded faces by setting the @code{agent-enable-undownloaded-faces}
19169refer to the @code{gnus-summary-*-undownloaded-face} faces. Second, 19738group parameter to @code{t}. This parameter, like all other agent
19170if you prefer to take a more fine-grained approach, you may set the 19739parameters, may be set on an Agent Category (@pxref{Agent Categories}),
19171@code{agent-disable-undownloaded-faces} group parameter to @code{t}. 19740a Group Topic (@pxref{Topic Parameters}), or an individual group
19172This parameter, like all other agent parameters, may be set on an 19741(@pxref{Group Parameters}).
19173Agent Category (@pxref{Agent Categories}), a Group Topic (@pxref{Topic 19742
19174Parameters}), or an individual group (@pxref{Group Parameters}). 19743The one problem common to all users using the agent is how quickly it
19744can consume disk space. If you using the agent on many groups, it is
19745even more difficult to effectively recover disk space. One solution
19746is the @samp{%F} format available in @code{gnus-group-line-format}.
19747This format will display the actual disk space used by articles
19748fetched into both the agent and cache. By knowing which groups use
19749the most space, users know where to focus their efforts when ``agent
19750expiring'' articles.
19175 19751
19176@node Agent as Cache 19752@node Agent as Cache
19177@subsection Agent as Cache 19753@subsection Agent as Cache
@@ -19267,23 +19843,19 @@ then updates the internal data structures that document which articles
19267are stored locally. An optional argument will mark articles in the 19843are stored locally. An optional argument will mark articles in the
19268agent as unread. 19844agent as unread.
19269 19845
19270@node Agent and IMAP 19846@node Agent and flags
19271@subsection Agent and IMAP 19847@subsection Agent and flags
19272
19273The Agent works with any Gnus back end, including nnimap. However,
19274since there are some conceptual differences between @acronym{NNTP} and
19275@acronym{IMAP}, this section (should) provide you with some information to
19276make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client.
19277 19848
19278The first thing to keep in mind is that all flags (read, ticked, etc) 19849The Agent works with any Gnus back end including those, such as
19279are kept on the @acronym{IMAP} server, rather than in @file{.newsrc} as is the 19850nnimap, that store flags (read, ticked, etc) on the server. Sadly,
19280case for nntp. Thus Gnus need to remember flag changes when 19851the Agent does not actually know which backends keep their flags in
19281disconnected, and synchronize these flags when you plug back in. 19852the backend server rather than in @file{.newsrc}. This means that the
19853Agent, while unplugged or disconnected, will always record all changes
19854to the flags in its own files.
19282 19855
19283Gnus keeps track of flag changes when reading nnimap groups under the 19856When you plug back in, Gnus will then check to see if you have any
19284Agent. When you plug back in, Gnus will check if you have any changed 19857changed any flags and ask if you wish to synchronize these with the
19285any flags and ask if you wish to synchronize these with the server. 19858server. This behavior is customizable by @code{gnus-agent-synchronize-flags}.
19286The behavior is customizable by @code{gnus-agent-synchronize-flags}.
19287 19859
19288@vindex gnus-agent-synchronize-flags 19860@vindex gnus-agent-synchronize-flags
19289If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will 19861If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will
@@ -19297,6 +19869,23 @@ re-connect, you can do it manually with the
19297@code{gnus-agent-synchronize-flags} command that is bound to @kbd{J Y} 19869@code{gnus-agent-synchronize-flags} command that is bound to @kbd{J Y}
19298in the group buffer. 19870in the group buffer.
19299 19871
19872Technical note: the synchronization algorithm does not work by ``pushing''
19873all local flags to the server, but rather by incrementally updated the
19874server view of flags by changing only those flags that were changed by
19875the user. Thus, if you set one flag on an article, quit the group then
19876re-select the group and remove the flag; the flag will be set and
19877removed from the server when you ``synchronize''. The queued flag
19878operations can be found in the per-server @code{flags} file in the Agent
19879directory. It's emptied when you synchronize flags.
19880
19881@node Agent and IMAP
19882@subsection Agent and IMAP
19883
19884The Agent works with any Gnus back end, including nnimap. However,
19885since there are some conceptual differences between @acronym{NNTP} and
19886@acronym{IMAP}, this section (should) provide you with some information to
19887make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client.
19888
19300Some things are currently not implemented in the Agent that you'd might 19889Some things are currently not implemented in the Agent that you'd might
19301expect from a disconnected @acronym{IMAP} client, including: 19890expect from a disconnected @acronym{IMAP} client, including:
19302 19891
@@ -19310,34 +19899,43 @@ Creating/deleting nnimap groups when unplugged.
19310 19899
19311@end itemize 19900@end itemize
19312 19901
19313Technical note: the synchronization algorithm does not work by ``pushing''
19314all local flags to the server, but rather incrementally update the
19315server view of flags by changing only those flags that were changed by
19316the user. Thus, if you set one flag on an article, quit the group and
19317re-select the group and remove the flag; the flag will be set and
19318removed from the server when you ``synchronize''. The queued flag
19319operations can be found in the per-server @code{flags} file in the Agent
19320directory. It's emptied when you synchronize flags.
19321
19322
19323@node Outgoing Messages 19902@node Outgoing Messages
19324@subsection Outgoing Messages 19903@subsection Outgoing Messages
19325 19904
19326When Gnus is unplugged, all outgoing messages (both mail and news) are 19905By default, when Gnus is unplugged, all outgoing messages (both mail
19327stored in the draft group ``queue'' (@pxref{Drafts}). You can view 19906and news) are stored in the draft group ``queue'' (@pxref{Drafts}).
19328them there after posting, and edit them at will. 19907You can view them there after posting, and edit them at will.
19329 19908
19330When Gnus is plugged again, you can send the messages either from the 19909You can control the circumstances under which outgoing mail is queued
19331draft group with the special commands available there, or you can use 19910(see @code{gnus-agent-queue-mail}, @pxref{Agent Variables}). Outgoing
19332the @kbd{J S} command in the group buffer to send all the sendable 19911news is always queued when Gnus is unplugged, and never otherwise.
19333messages in the draft group.
19334 19912
19913You can send the messages either from the draft group with the special
19914commands available there, or you can use the @kbd{J S} command in the
19915group buffer to send all the sendable messages in the draft group.
19916Posting news will only work when Gnus is plugged, but you can send
19917mail at any time.
19335 19918
19919If sending mail while unplugged does not work for you and you worry
19920about hitting @kbd{J S} by accident when unplugged, you can have Gnus
19921ask you to confirm your action (see
19922@code{gnus-agent-prompt-send-queue}, @pxref{Agent Variables}).
19336 19923
19337@node Agent Variables 19924@node Agent Variables
19338@subsection Agent Variables 19925@subsection Agent Variables
19339 19926
19340@table @code 19927@table @code
19928@item gnus-agent
19929@vindex gnus-agent
19930Is the agent enabled? The default is @code{t}. When first enabled,
19931the agent will use @code{gnus-agent-auto-agentize-methods} to
19932automatically mark some back ends as agentized. You may change which
19933back ends are agentized using the agent commands in the server buffer.
19934
19935To enter the server buffer, use the @kbd{^}
19936(@code{gnus-group-enter-server-mode}) command in the group buffer.
19937
19938
19341@item gnus-agent-directory 19939@item gnus-agent-directory
19342@vindex gnus-agent-directory 19940@vindex gnus-agent-directory
19343Where the Gnus Agent will store its files. The default is 19941Where the Gnus Agent will store its files. The default is
@@ -19384,6 +19982,14 @@ mark articles as unread after downloading. This is usually a safe
19384thing to do as the newly downloaded article has obviously not been 19982thing to do as the newly downloaded article has obviously not been
19385read. The default is @code{t}. 19983read. The default is @code{t}.
19386 19984
19985@item gnus-agent-synchronize-flags
19986@vindex gnus-agent-synchronize-flags
19987If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will
19988never automatically synchronize flags. If it is @code{ask}, which is
19989the default, the Agent will check if you made any changes and if so
19990ask if you wish to synchronize these when you re-connect. If it has
19991any other value, all flags will be synchronized automatically.
19992
19387@item gnus-agent-consider-all-articles 19993@item gnus-agent-consider-all-articles
19388@vindex gnus-agent-consider-all-articles 19994@vindex gnus-agent-consider-all-articles
19389If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the 19995If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the
@@ -19432,13 +20038,26 @@ have not been fetched), @code{always-undownloaded} (maneuvering always
19432ignores articles that have not been fetched), @code{unfetched} 20038ignores articles that have not been fetched), @code{unfetched}
19433(maneuvering ignores articles whose headers have not been fetched). 20039(maneuvering ignores articles whose headers have not been fetched).
19434 20040
20041@item gnus-agent-queue-mail
20042@vindex gnus-agent-queue-mail
20043When @code{gnus-agent-queue-mail} is @code{always}, Gnus will always
20044queue mail rather than sending it straight away. When @code{t}, Gnus
20045will queue mail when unplugged only. When @code{nil}, never queue
20046mail. The default is @code{t}.
20047
20048@item gnus-agent-prompt-send-queue
20049@vindex gnus-agent-prompt-send-queue
20050When @code{gnus-agent-prompt-send-queue} is non-@code{nil} Gnus will
20051prompt you to confirm that you really wish to proceed if you hit
20052@kbd{J S} while unplugged. The default is @code{nil}.
20053
19435@item gnus-agent-auto-agentize-methods 20054@item gnus-agent-auto-agentize-methods
19436@vindex gnus-agent-auto-agentize-methods 20055@vindex gnus-agent-auto-agentize-methods
19437If you have never used the Agent before (or more technically, if 20056If you have never used the Agent before (or more technically, if
19438@file{~/News/agent/lib/servers} does not exist), Gnus will 20057@file{~/News/agent/lib/servers} does not exist), Gnus will
19439automatically agentize a few servers for you. This variable control 20058automatically agentize a few servers for you. This variable control
19440which backends should be auto-agentized. It is typically only useful 20059which back ends should be auto-agentized. It is typically only useful
19441to agentize remote backends. The auto-agentizing has the same effect 20060to agentize remote back ends. The auto-agentizing has the same effect
19442as running @kbd{J a} on the servers (@pxref{Server Agent Commands}). 20061as running @kbd{J a} on the servers (@pxref{Server Agent Commands}).
19443If the file exist, you must manage the servers manually by adding or 20062If the file exist, you must manage the servers manually by adding or
19444removing them, this variable is only applicable the first time you 20063removing them, this variable is only applicable the first time you
@@ -19578,7 +20197,6 @@ silently to help keep the sizes of the score files down.
19578* Global Score Files:: Earth-spanning, ear-splitting score files. 20197* Global Score Files:: Earth-spanning, ear-splitting score files.
19579* Kill Files:: They are still here, but they can be ignored. 20198* Kill Files:: They are still here, but they can be ignored.
19580* Converting Kill Files:: Translating kill files to score files. 20199* Converting Kill Files:: Translating kill files to score files.
19581* GroupLens:: Getting predictions on what you like to read.
19582* Advanced Scoring:: Using logical expressions to build score rules. 20200* Advanced Scoring:: Using logical expressions to build score rules.
19583* Score Decays:: It can be useful to let scores wither away. 20201* Score Decays:: It can be useful to let scores wither away.
19584@end menu 20202@end menu
@@ -19849,6 +20467,12 @@ There aren't many of these as yet, I'm afraid.
19849 20467
19850@table @kbd 20468@table @kbd
19851 20469
20470@item W e
20471@kindex W e (Group)
20472@findex gnus-score-edit-all-score
20473Edit the apply-to-all-groups all.SCORE file. You will be popped into
20474a @code{gnus-score-mode} buffer (@pxref{Score File Editing}).
20475
19852@item W f 20476@item W f
19853@kindex W f (Group) 20477@kindex W f (Group)
19854@findex gnus-score-flush-cache 20478@findex gnus-score-flush-cache
@@ -20453,6 +21077,11 @@ The adaptive score entries will be put into a file where the name is the
20453group name with @code{gnus-adaptive-file-suffix} appended. The default 21077group name with @code{gnus-adaptive-file-suffix} appended. The default
20454is @file{ADAPT}. 21078is @file{ADAPT}.
20455 21079
21080@vindex gnus-adaptive-pretty-print
21081Adaptive score files can get huge and are not meant to be edited by
21082human hands. If @code{gnus-adaptive-pretty-print} is @code{nil} (the
21083deafult) those files will not be written in a human readable way.
21084
20456@vindex gnus-score-exact-adapt-limit 21085@vindex gnus-score-exact-adapt-limit
20457When doing adaptive scoring, substring or fuzzy matching would probably 21086When doing adaptive scoring, substring or fuzzy matching would probably
20458give you the best results in most cases. However, if the header one 21087give you the best results in most cases. However, if the header one
@@ -20705,6 +21334,13 @@ so: @kbd{I e s p To RET <your name> RET}.
20705 21334
20706See? Simple. 21335See? Simple.
20707 21336
21337@vindex gnus-inhibit-slow-scoring
21338You can inhibit scoring the slow scoring on headers or body by setting
21339the variable @code{gnus-inhibit-slow-scoring}. If
21340@code{gnus-inhibit-slow-scoring} is regexp, slow scoring is inhibited if
21341the group matches the regexp. If it is t, slow scoring on it is
21342inhibited for all groups.
21343
20708 21344
20709@node Scoring Tips 21345@node Scoring Tips
20710@section Scoring Tips 21346@section Scoring Tips
@@ -20967,205 +21603,6 @@ hand. Or just let them be as they are. Gnus will still use them as
20967before. 21603before.
20968 21604
20969 21605
20970@node GroupLens
20971@section GroupLens
20972@cindex GroupLens
20973
20974@sc{Note:} Unfortunately the GroupLens system seems to have shut down,
20975so this section is mostly of historical interest.
20976
20977@uref{http://www.cs.umn.edu/Research/GroupLens/, GroupLens} is a
20978collaborative filtering system that helps you work together with other
20979people to find the quality news articles out of the huge volume of
20980news articles generated every day.
20981
20982To accomplish this the GroupLens system combines your opinions about
20983articles you have already read with the opinions of others who have done
20984likewise and gives you a personalized prediction for each unread news
20985article. Think of GroupLens as a matchmaker. GroupLens watches how you
20986rate articles, and finds other people that rate articles the same way.
20987Once it has found some people you agree with it tells you, in the form
20988of a prediction, what they thought of the article. You can use this
20989prediction to help you decide whether or not you want to read the
20990article.
20991
20992@menu
20993* Using GroupLens:: How to make Gnus use GroupLens.
20994* Rating Articles:: Letting GroupLens know how you rate articles.
20995* Displaying Predictions:: Displaying predictions given by GroupLens.
20996* GroupLens Variables:: Customizing GroupLens.
20997@end menu
20998
20999
21000@node Using GroupLens
21001@subsection Using GroupLens
21002
21003To use GroupLens you must register a pseudonym with your local
21004@uref{http://www.cs.umn.edu/Research/GroupLens/bbb.html, Better Bit
21005Bureau (BBB)} is the only better bit in town at the moment.
21006
21007Once you have registered you'll need to set a couple of variables.
21008
21009@table @code
21010
21011@item gnus-use-grouplens
21012@vindex gnus-use-grouplens
21013Setting this variable to a non-@code{nil} value will make Gnus hook into
21014all the relevant GroupLens functions.
21015
21016@item grouplens-pseudonym
21017@vindex grouplens-pseudonym
21018This variable should be set to the pseudonym you got when registering
21019with the Better Bit Bureau.
21020
21021@item grouplens-newsgroups
21022@vindex grouplens-newsgroups
21023A list of groups that you want to get GroupLens predictions for.
21024
21025@end table
21026
21027That's the minimum of what you need to get up and running with GroupLens.
21028Once you've registered, GroupLens will start giving you scores for
21029articles based on the average of what other people think. But, to get
21030the real benefit of GroupLens you need to start rating articles
21031yourself. Then the scores GroupLens gives you will be personalized for
21032you, based on how the people you usually agree with have already rated.
21033
21034
21035@node Rating Articles
21036@subsection Rating Articles
21037
21038In GroupLens, an article is rated on a scale from 1 to 5, inclusive.
21039Where 1 means something like this article is a waste of bandwidth and 5
21040means that the article was really good. The basic question to ask
21041yourself is, ``on a scale from 1 to 5 would I like to see more articles
21042like this one?''
21043
21044There are four ways to enter a rating for an article in GroupLens.
21045
21046@table @kbd
21047
21048@item r
21049@kindex r (GroupLens)
21050@findex bbb-summary-rate-article
21051This function will prompt you for a rating on a scale of one to five.
21052
21053@item k
21054@kindex k (GroupLens)
21055@findex grouplens-score-thread
21056This function will prompt you for a rating, and rate all the articles in
21057the thread. This is really useful for some of those long running giant
21058threads in rec.humor.
21059
21060@end table
21061
21062The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be
21063the score of the article you're reading.
21064
21065@table @kbd
21066
21067@item 1-5 n
21068@kindex n (GroupLens)
21069@findex grouplens-next-unread-article
21070Rate the article and go to the next unread article.
21071
21072@item 1-5 ,
21073@kindex , (GroupLens)
21074@findex grouplens-best-unread-article
21075Rate the article and go to the next unread article with the highest score.
21076
21077@end table
21078
21079If you want to give the current article a score of 4 and then go to the
21080next article, just type @kbd{4 n}.
21081
21082
21083@node Displaying Predictions
21084@subsection Displaying Predictions
21085
21086GroupLens makes a prediction for you about how much you will like a
21087news article. The predictions from GroupLens are on a scale from 1 to
210885, where 1 is the worst and 5 is the best. You can use the predictions
21089from GroupLens in one of three ways controlled by the variable
21090@code{gnus-grouplens-override-scoring}.
21091
21092@vindex gnus-grouplens-override-scoring
21093There are three ways to display predictions in grouplens. You may
21094choose to have the GroupLens scores contribute to, or override the
21095regular Gnus scoring mechanism. override is the default; however, some
21096people prefer to see the Gnus scores plus the grouplens scores. To get
21097the separate scoring behavior you need to set
21098@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the
21099GroupLens predictions combined with the grouplens scores set it to
21100@code{'override} and to combine the scores set
21101@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use
21102the combine option you will also want to set the values for
21103@code{grouplens-prediction-offset} and
21104@code{grouplens-score-scale-factor}.
21105
21106@vindex grouplens-prediction-display
21107In either case, GroupLens gives you a few choices for how you would like
21108to see your predictions displayed. The display of predictions is
21109controlled by the @code{grouplens-prediction-display} variable.
21110
21111The following are valid values for that variable.
21112
21113@table @code
21114@item prediction-spot
21115The higher the prediction, the further to the right an @samp{*} is
21116displayed.
21117
21118@item confidence-interval
21119A numeric confidence interval.
21120
21121@item prediction-bar
21122The higher the prediction, the longer the bar.
21123
21124@item confidence-bar
21125Numerical confidence.
21126
21127@item confidence-spot
21128The spot gets bigger with more confidence.
21129
21130@item prediction-num
21131Plain-old numeric value.
21132
21133@item confidence-plus-minus
21134Prediction +/- confidence.
21135
21136@end table
21137
21138
21139@node GroupLens Variables
21140@subsection GroupLens Variables
21141
21142@table @code
21143
21144@item gnus-summary-grouplens-line-format
21145The summary line format used in GroupLens-enhanced summary buffers. It
21146accepts the same specs as the normal summary line format (@pxref{Summary
21147Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-23,23n%]%)
21148%s\n}.
21149
21150@item grouplens-bbb-host
21151Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the
21152default.
21153
21154@item grouplens-bbb-port
21155Port of the host running the bbbd server. The default is 9000.
21156
21157@item grouplens-score-offset
21158Offset the prediction by this value. In other words, subtract the
21159prediction value by this number to arrive at the effective score. The
21160default is 0.
21161
21162@item grouplens-score-scale-factor
21163This variable allows the user to magnify the effect of GroupLens scores.
21164The scale factor is applied after the offset. The default is 1.
21165
21166@end table
21167
21168
21169@node Advanced Scoring 21606@node Advanced Scoring
21170@section Advanced Scoring 21607@section Advanced Scoring
21171 21608
@@ -21366,9 +21803,12 @@ Gnus provides a mechanism for decaying scores to help with this problem.
21366When score files are loaded and @code{gnus-decay-scores} is 21803When score files are loaded and @code{gnus-decay-scores} is
21367non-@code{nil}, Gnus will run the score files through the decaying 21804non-@code{nil}, Gnus will run the score files through the decaying
21368mechanism thereby lowering the scores of all non-permanent score rules. 21805mechanism thereby lowering the scores of all non-permanent score rules.
21369The decay itself if performed by the @code{gnus-decay-score-function} 21806If @code{gnus-decay-scores} is a regexp, only score files matching this
21370function, which is @code{gnus-decay-score} by default. Here's the 21807regexp are treated. E.g. you may set it to @samp{\\.ADAPT\\'} if only
21371definition of that function: 21808@emph{adaptive} score files should be decayed. The decay itself if
21809performed by the @code{gnus-decay-score-function} function, which is
21810@code{gnus-decay-score} by default. Here's the definition of that
21811function:
21372 21812
21373@lisp 21813@lisp
21374(defun gnus-decay-score (score) 21814(defun gnus-decay-score (score)
@@ -21423,6 +21863,8 @@ four days, Gnus will decay the scores four times, for instance.
21423@include sieve.texi 21863@include sieve.texi
21424@chapter PGG 21864@chapter PGG
21425@include pgg.texi 21865@include pgg.texi
21866@chapter SASL
21867@include sasl.texi
21426@end iflatex 21868@end iflatex
21427@end iftex 21869@end iftex
21428 21870
@@ -22805,6 +23247,32 @@ Face and variable:
22805Face to show X-Face. The colors from this face are used as the 23247Face to show X-Face. The colors from this face are used as the
22806foreground and background colors of the displayed X-Faces. The 23248foreground and background colors of the displayed X-Faces. The
22807default colors are black and white. 23249default colors are black and white.
23250
23251@item gnus-face-properties-alist
23252@vindex gnus-face-properties-alist
23253Alist of image types and properties applied to Face (@pxref{Face}) and
23254X-Face images. The default value is @code{((pbm . (:face gnus-x-face))
23255(png . nil))} for Emacs or @code{((xface . (:face gnus-x-face)))} for
23256XEmacs. Here are examples:
23257
23258@lisp
23259;; Specify the altitude of Face and X-Face images in the From header.
23260(setq gnus-face-properties-alist
23261 '((pbm . (:face gnus-x-face :ascent 80))
23262 (png . (:ascent 80))))
23263
23264;; Show Face and X-Face images as pressed buttons.
23265(setq gnus-face-properties-alist
23266 '((pbm . (:face gnus-x-face :relief -2))
23267 (png . (:relief -2))))
23268@end lisp
23269
23270@pxref{Image Descriptors, ,Image Descriptors, elisp, The Emacs Lisp
23271Reference Manual} for the valid properties for various image types.
23272Currently, @code{pbm} is used for X-Face images and @code{png} is used
23273for Face images in Emacs. Only the @code{:face} property is effective
23274on the @code{xface} image type in XEmacs if it is built with the
23275@samp{libcompface} library.
22808@end table 23276@end table
22809 23277
22810If you use posting styles, you can use an @code{x-face-file} entry in 23278If you use posting styles, you can use an @code{x-face-file} entry in
@@ -22871,6 +23339,9 @@ The contents of a @code{Face} header must be a base64 encoded PNG image.
22871See @uref{http://quimby.gnus.org/circus/face/} for the precise 23339See @uref{http://quimby.gnus.org/circus/face/} for the precise
22872specifications. 23340specifications.
22873 23341
23342The @code{gnus-face-properties-alist} variable affects the appearance of
23343displayed Face images. @xref{X-Face}.
23344
22874Viewing an @code{Face} header requires an Emacs that is able to display 23345Viewing an @code{Face} header requires an Emacs that is able to display
22875PNG images. 23346PNG images.
22876@c Maybe add this: 23347@c Maybe add this:
@@ -22994,6 +23465,11 @@ To enable displaying picons, simply make sure that
22994@code{gnus-picon-databases} points to the directory containing the 23465@code{gnus-picon-databases} points to the directory containing the
22995Picons databases. 23466Picons databases.
22996 23467
23468@vindex gnus-picon-style
23469The variable @code{gnus-picon-style} controls how picons are displayed.
23470If @code{inline}, the textual representation is replaced. If
23471@code{right}, picons are added right to the textual representation.
23472
22997The following variables offer control over where things are located. 23473The following variables offer control over where things are located.
22998 23474
22999@table @code 23475@table @code
@@ -23360,7 +23836,7 @@ call the external tools during splitting. Example fancy split method:
23360 "spam")))) 23836 "spam"))))
23361@end lisp 23837@end lisp
23362 23838
23363Note that with the nnimap backend, message bodies will not be 23839Note that with the nnimap back end, message bodies will not be
23364downloaded by default. You need to set 23840downloaded by default. You need to set
23365@code{nnimap-split-download-body} to @code{t} to do that 23841@code{nnimap-split-download-body} to @code{t} to do that
23366(@pxref{Splitting in IMAP}). 23842(@pxref{Splitting in IMAP}).
@@ -23383,10 +23859,10 @@ spam. And here is the nifty function:
23383@cindex hashcash 23859@cindex hashcash
23384 23860
23385A novel technique to fight spam is to require senders to do something 23861A novel technique to fight spam is to require senders to do something
23386costly for each message they send. This has the obvious drawback that 23862costly and demonstrably unique for each message they send. This has
23387you cannot rely on everyone in the world using this technique, 23863the obvious drawback that you cannot rely on everyone in the world
23388since it is not part of the Internet standards, but it may be useful 23864using this technique, since it is not part of the Internet standards,
23389in smaller communities. 23865but it may be useful in smaller communities.
23390 23866
23391While the tools in the previous section work well in practice, they 23867While the tools in the previous section work well in practice, they
23392work only because the tools are constantly maintained and updated as 23868work only because the tools are constantly maintained and updated as
@@ -23402,24 +23878,20 @@ one of them separately.
23402@cindex X-Hashcash 23878@cindex X-Hashcash
23403The ``something costly'' is to burn CPU time, more specifically to 23879The ``something costly'' is to burn CPU time, more specifically to
23404compute a hash collision up to a certain number of bits. The 23880compute a hash collision up to a certain number of bits. The
23405resulting hashcash cookie is inserted in a @samp{X-Hashcash:} 23881resulting hashcash cookie is inserted in a @samp{X-Hashcash:} header.
23406header. For more details, and for the external application 23882For more details, and for the external application @code{hashcash} you
23407@code{hashcash} you need to install to use this feature, see 23883need to install to use this feature, see
23408@uref{http://www.cypherspace.org/~adam/hashcash/}. Even more 23884@uref{http://www.hashcash.org/}. Even more information can be found
23409information can be found at @uref{http://www.camram.org/}. 23885at @uref{http://www.camram.org/}.
23410 23886
23411If you wish to call hashcash for each message you send, say something 23887If you wish to generate hashcash for each message you send, you can
23412like: 23888customize @code{message-generate-hashcash} (@pxref{Mail Headers, ,Mail
23889Headers,message, The Message Manual}), as in:
23413 23890
23414@lisp 23891@lisp
23415(require 'hashcash) 23892(setq message-generate-hashcash t)
23416(add-hook 'message-send-hook 'mail-add-payment)
23417@end lisp 23893@end lisp
23418 23894
23419The @file{hashcash.el} library can be found in the Gnus development
23420contrib directory or at
23421@uref{http://users.actrix.gen.nz/mycroft/hashcash.el}.
23422
23423You will need to set up some additional variables as well: 23895You will need to set up some additional variables as well:
23424 23896
23425@table @code 23897@table @code
@@ -23427,8 +23899,8 @@ You will need to set up some additional variables as well:
23427@item hashcash-default-payment 23899@item hashcash-default-payment
23428@vindex hashcash-default-payment 23900@vindex hashcash-default-payment
23429This variable indicates the default number of bits the hash collision 23901This variable indicates the default number of bits the hash collision
23430should consist of. By default this is 0, meaning nothing will be 23902should consist of. By default this is 20. Suggested useful values
23431done. Suggested useful values include 17 to 29. 23903include 17 to 29.
23432 23904
23433@item hashcash-payment-alist 23905@item hashcash-payment-alist
23434@vindex hashcash-payment-alist 23906@vindex hashcash-payment-alist
@@ -23440,16 +23912,23 @@ that is needed. It can also contain @samp{(@var{addr} @var{string}
23440@var{amount})} cells, where the @var{string} is the string to use 23912@var{amount})} cells, where the @var{string} is the string to use
23441(normally the email address or newsgroup name is used). 23913(normally the email address or newsgroup name is used).
23442 23914
23443@item hashcash 23915@item hashcash-path
23444@vindex hashcash 23916@vindex hashcash-path
23445Where the @code{hashcash} binary is installed. 23917Where the @code{hashcash} binary is installed. This variable should
23918be automatically set by @code{executable-find}, but if it's @code{nil}
23919(usually because the @code{hashcash} binary is not in your path)
23920you'll get a warning when you check hashcash payments and an error
23921when you generate hashcash payments.
23446 23922
23447@end table 23923@end table
23448 23924
23449Currently there is no built in functionality in Gnus to verify 23925Gnus can verify hashcash cookies, although this can also be done by
23450hashcash cookies, it is expected that this is performed by your hand 23926hand customized mail filtering scripts. To verify a hashcash cookie
23451customized mail filtering scripts. Improvements in this area would be 23927in a message, use the @code{mail-check-payment} function in the
23452a useful contribution, however. 23928@code{hashcash.el} library. You can also use the @code{spam.el}
23929package with the @code{spam-use-hashcash} back end to validate hashcash
23930cookies in incoming mail and filter mail accordingly (@pxref{Anti-spam
23931Hashcash Payments}).
23453 23932
23454@node Spam Package 23933@node Spam Package
23455@section Spam Package 23934@section Spam Package
@@ -23481,6 +23960,9 @@ name used throughout this manual to indicate non-spam messages.)
23481You must read this section to understand how the Spam package works. 23960You must read this section to understand how the Spam package works.
23482Do not skip, speed-read, or glance through this section. 23961Do not skip, speed-read, or glance through this section.
23483 23962
23963Make sure you read the section on the @code{spam.el} sequence of
23964events. See @xref{Extending the Spam package}.
23965
23484@cindex spam-initialize 23966@cindex spam-initialize
23485@vindex spam-use-stat 23967@vindex spam-use-stat
23486To use the Spam package, you @strong{must} first run the function 23968To use the Spam package, you @strong{must} first run the function
@@ -23836,7 +24318,7 @@ parameter is not set, ham articles are left in place. If the
23836@code{spam-mark-ham-unread-before-move-from-spam-group} parameter is 24318@code{spam-mark-ham-unread-before-move-from-spam-group} parameter is
23837set, the ham articles are marked as unread before being moved. 24319set, the ham articles are marked as unread before being moved.
23838 24320
23839If ham can not be moved---because of a read-only backend such as 24321If ham can not be moved---because of a read-only back end such as
23840@acronym{NNTP}, for example, it will be copied. 24322@acronym{NNTP}, for example, it will be copied.
23841 24323
23842Note that you can use multiples destinations per group or regular 24324Note that you can use multiples destinations per group or regular
@@ -23873,7 +24355,7 @@ articles are only expired. The group name is fully qualified, meaning
23873that if you see @samp{nntp:servername} before the group name in the 24355that if you see @samp{nntp:servername} before the group name in the
23874group buffer then you need it here as well. 24356group buffer then you need it here as well.
23875 24357
23876If spam can not be moved---because of a read-only backend such as 24358If spam can not be moved---because of a read-only back end such as
23877@acronym{NNTP}, for example, it will be copied. 24359@acronym{NNTP}, for example, it will be copied.
23878 24360
23879Note that you can use multiples destinations per group or regular 24361Note that you can use multiples destinations per group or regular
@@ -23992,7 +24474,7 @@ From Ted Zlatanov <tzz@@lifelogs.com>.
23992 24474
23993@end example 24475@end example
23994 24476
23995@subsubheading Using @file{spam.el} on an IMAP server with a statistical filter on the server 24477@subsubheading Using @code{spam.el} on an IMAP server with a statistical filter on the server
23996From Reiner Steib <reiner.steib@@gmx.de>. 24478From Reiner Steib <reiner.steib@@gmx.de>.
23997 24479
23998My provider has set up bogofilter (in combination with @acronym{DCC}) on 24480My provider has set up bogofilter (in combination with @acronym{DCC}) on
@@ -24046,7 +24528,7 @@ an excellent tool for filtering those unwanted mails for me.)
24046In my ham folders, I just hit @kbd{S x} 24528In my ham folders, I just hit @kbd{S x}
24047(@code{gnus-summary-mark-as-spam}) whenever I see an unrecognized spam 24529(@code{gnus-summary-mark-as-spam}) whenever I see an unrecognized spam
24048mail (false negative). On group exit, those messages are moved to 24530mail (false negative). On group exit, those messages are moved to
24049@samp{training.ham}. 24531@samp{training.spam}.
24050@end itemize 24532@end itemize
24051 24533
24052@subsubheading Reporting spam articles in Gmane groups with @code{spam-report.el} 24534@subsubheading Reporting spam articles in Gmane groups with @code{spam-report.el}
@@ -24086,6 +24568,7 @@ Processors}).
24086* Blackholes:: 24568* Blackholes::
24087* Regular Expressions Header Matching:: 24569* Regular Expressions Header Matching::
24088* Bogofilter:: 24570* Bogofilter::
24571* SpamAssassin back end::
24089* ifile spam filtering:: 24572* ifile spam filtering::
24090* Spam Statistics Filtering:: 24573* Spam Statistics Filtering::
24091* SpamOracle:: 24574* SpamOracle::
@@ -24138,7 +24621,7 @@ spam-marked articles will be added to the blacklist.
24138 24621
24139Instead of the obsolete 24622Instead of the obsolete
24140@code{gnus-group-spam-exit-processor-blacklist}, it is recommended 24623@code{gnus-group-spam-exit-processor-blacklist}, it is recommended
24141that you use @code{'(spam spam-use-blacklist)}. Everything will work 24624that you use @code{(spam spam-use-blacklist)}. Everything will work
24142the same way, we promise. 24625the same way, we promise.
24143 24626
24144@end defvar 24627@end defvar
@@ -24150,14 +24633,13 @@ customizing the group parameters or the
24150@code{gnus-spam-process-newsgroups} variable. When this symbol is 24633@code{gnus-spam-process-newsgroups} variable. When this symbol is
24151added to a group's @code{spam-process} parameter, the senders of 24634added to a group's @code{spam-process} parameter, the senders of
24152ham-marked articles in @emph{ham} groups will be added to the 24635ham-marked articles in @emph{ham} groups will be added to the
24153whitelist. Note that this ham processor has no effect in @emph{spam} 24636whitelist.
24154or @emph{unclassified} groups.
24155 24637
24156@emph{WARNING} 24638@emph{WARNING}
24157 24639
24158Instead of the obsolete 24640Instead of the obsolete
24159@code{gnus-group-ham-exit-processor-whitelist}, it is recommended 24641@code{gnus-group-ham-exit-processor-whitelist}, it is recommended
24160that you use @code{'(ham spam-use-whitelist)}. Everything will work 24642that you use @code{(ham spam-use-whitelist)}. Everything will work
24161the same way, we promise. 24643the same way, we promise.
24162 24644
24163@end defvar 24645@end defvar
@@ -24207,6 +24689,12 @@ unless the sender is in the BBDB. Use with care. Only sender
24207addresses in the BBDB will be allowed through; all others will be 24689addresses in the BBDB will be allowed through; all others will be
24208classified as spammers. 24690classified as spammers.
24209 24691
24692While @code{spam-use-BBDB-exclusive} @emph{can} be used as an alias
24693for @code{spam-use-BBDB} as far as @code{spam.el} is concerned, it is
24694@emph{not} a separate back end. If you set
24695@code{spam-use-BBDB-exclusive} to t, @emph{all} your BBDB splitting
24696will be exclusive.
24697
24210@end defvar 24698@end defvar
24211 24699
24212@defvar gnus-group-ham-exit-processor-BBDB 24700@defvar gnus-group-ham-exit-processor-BBDB
@@ -24216,14 +24704,13 @@ customizing the group parameters or the
24216@code{gnus-spam-process-newsgroups} variable. When this symbol is 24704@code{gnus-spam-process-newsgroups} variable. When this symbol is
24217added to a group's @code{spam-process} parameter, the senders of 24705added to a group's @code{spam-process} parameter, the senders of
24218ham-marked articles in @emph{ham} groups will be added to the 24706ham-marked articles in @emph{ham} groups will be added to the
24219BBDB. Note that this ham processor has no effect in @emph{spam} 24707BBDB.
24220or @emph{unclassified} groups.
24221 24708
24222@emph{WARNING} 24709@emph{WARNING}
24223 24710
24224Instead of the obsolete 24711Instead of the obsolete
24225@code{gnus-group-ham-exit-processor-BBDB}, it is recommended 24712@code{gnus-group-ham-exit-processor-BBDB}, it is recommended
24226that you use @code{'(ham spam-use-BBDB)}. Everything will work 24713that you use @code{(ham spam-use-BBDB)}. Everything will work
24227the same way, we promise. 24714the same way, we promise.
24228 24715
24229@end defvar 24716@end defvar
@@ -24250,7 +24737,7 @@ Gmane can be found at @uref{http://gmane.org}.
24250 24737
24251Instead of the obsolete 24738Instead of the obsolete
24252@code{gnus-group-spam-exit-processor-report-gmane}, it is recommended 24739@code{gnus-group-spam-exit-processor-report-gmane}, it is recommended
24253that you use @code{'(spam spam-use-gmane)}. Everything will work the 24740that you use @code{(spam spam-use-gmane)}. Everything will work the
24254same way, we promise. 24741same way, we promise.
24255 24742
24256@end defvar 24743@end defvar
@@ -24261,8 +24748,15 @@ This variable is @code{t} by default. Set it to @code{nil} if you are
24261running your own news server, for instance, and the local article 24748running your own news server, for instance, and the local article
24262numbers don't correspond to the Gmane article numbers. When 24749numbers don't correspond to the Gmane article numbers. When
24263@code{spam-report-gmane-use-article-number} is @code{nil}, 24750@code{spam-report-gmane-use-article-number} is @code{nil},
24264@code{spam-report.el} will use the @code{X-Report-Spam} header that 24751@code{spam-report.el} will fetch the number from the article headers.
24265Gmane provides. 24752
24753@end defvar
24754
24755@defvar spam-report-user-mail-address
24756
24757Mail address exposed in the User-Agent spam reports to Gmane. It allows
24758the Gmane administrators to contact you in case of misreports. The
24759default is @code{user-mail-address}.
24266 24760
24267@end defvar 24761@end defvar
24268 24762
@@ -24276,12 +24770,10 @@ Gmane provides.
24276 24770
24277Similar to @code{spam-use-whitelist} (@pxref{Blacklists and 24771Similar to @code{spam-use-whitelist} (@pxref{Blacklists and
24278Whitelists}), but uses hashcash tokens for whitelisting messages 24772Whitelists}), but uses hashcash tokens for whitelisting messages
24279instead of the sender address. You must have the @code{hashcash.el} 24773instead of the sender address. Messages without a hashcash payment
24280package loaded for @code{spam-use-hashcash} to work properly. 24774token will be sent to the next spam-split rule. This is an explicit
24281Messages without a hashcash payment token will be sent to the next 24775filter, meaning that unless a hashcash token is found, the messages
24282spam-split rule. This is an explicit filter, meaning that unless a 24776are not assumed to be spam or ham.
24283hashcash token is found, the messages are not assumed to be spam or
24284ham.
24285 24777
24286@end defvar 24778@end defvar
24287 24779
@@ -24301,7 +24793,7 @@ list is fairly comprehensive, but make sure to let us know if it
24301contains outdated servers. 24793contains outdated servers.
24302 24794
24303The blackhole check uses the @code{dig.el} package, but you can tell 24795The blackhole check uses the @code{dig.el} package, but you can tell
24304@file{spam.el} to use @code{dns.el} instead for better performance if 24796@code{spam.el} to use @code{dns.el} instead for better performance if
24305you set @code{spam-use-dig} to @code{nil}. It is not recommended at 24797you set @code{spam-use-dig} to @code{nil}. It is not recommended at
24306this time to set @code{spam-use-dig} to @code{nil} despite the 24798this time to set @code{spam-use-dig} to @code{nil} despite the
24307possible performance improvements, because some users may be unable to 24799possible performance improvements, because some users may be unable to
@@ -24428,7 +24920,7 @@ will be added to the Bogofilter spam database.
24428 24920
24429Instead of the obsolete 24921Instead of the obsolete
24430@code{gnus-group-spam-exit-processor-bogofilter}, it is recommended 24922@code{gnus-group-spam-exit-processor-bogofilter}, it is recommended
24431that you use @code{'(spam spam-use-bogofilter)}. Everything will work 24923that you use @code{(spam spam-use-bogofilter)}. Everything will work
24432the same way, we promise. 24924the same way, we promise.
24433@end defvar 24925@end defvar
24434 24926
@@ -24438,14 +24930,13 @@ customizing the group parameters or the
24438@code{gnus-spam-process-newsgroups} variable. When this symbol is 24930@code{gnus-spam-process-newsgroups} variable. When this symbol is
24439added to a group's @code{spam-process} parameter, the ham-marked 24931added to a group's @code{spam-process} parameter, the ham-marked
24440articles in @emph{ham} groups will be added to the Bogofilter database 24932articles in @emph{ham} groups will be added to the Bogofilter database
24441of non-spam messages. Note that this ham processor has no effect in 24933of non-spam messages.
24442@emph{spam} or @emph{unclassified} groups.
24443 24934
24444@emph{WARNING} 24935@emph{WARNING}
24445 24936
24446Instead of the obsolete 24937Instead of the obsolete
24447@code{gnus-group-ham-exit-processor-bogofilter}, it is recommended 24938@code{gnus-group-ham-exit-processor-bogofilter}, it is recommended
24448that you use @code{'(ham spam-use-bogofilter)}. Everything will work 24939that you use @code{(ham spam-use-bogofilter)}. Everything will work
24449the same way, we promise. 24940the same way, we promise.
24450@end defvar 24941@end defvar
24451 24942
@@ -24464,6 +24955,59 @@ variables to indicate to spam-split that Bogofilter should either be
24464used, or has already been used on the article. The 0.9.2.1 version of 24955used, or has already been used on the article. The 0.9.2.1 version of
24465Bogofilter was used to test this functionality. 24956Bogofilter was used to test this functionality.
24466 24957
24958@node SpamAssassin back end
24959@subsubsection SpamAssassin back end
24960@cindex spam filtering
24961@cindex spamassassin, spam filtering
24962@cindex spam
24963
24964@defvar spam-use-spamassassin
24965
24966Set this variable if you want @code{spam-split} to use SpamAssassin.
24967
24968SpamAssassin assigns a score to each article based on a set of rules
24969and tests, including a Bayesian filter. The Bayesian filter can be
24970trained by associating the @samp{$} mark for spam articles. The
24971spam score can be viewed by using the command @kbd{S t} in summary
24972mode.
24973
24974If you set this variable, each article will be processed by
24975SpamAssassin when @code{spam-split} is called. If your mail is
24976preprocessed by SpamAssassin, and you want to just use the
24977SpamAssassin headers, set @code{spam-use-spamassassin-headers}
24978instead.
24979
24980You should not enable this if you use
24981@code{spam-use-spamassassin-headers}.
24982
24983@end defvar
24984
24985@defvar spam-use-spamassassin-headers
24986
24987Set this variable if your mail is preprocessed by SpamAssassin and
24988want @code{spam-split} to split based on the SpamAssassin headers.
24989
24990You should not enable this if you use @code{spam-use-spamassassin}.
24991
24992@end defvar
24993
24994@defvar spam-spamassassin-program
24995
24996This variable points to the SpamAssassin executable. If you have
24997@code{spamd} running, you can set this variable to the @code{spamc}
24998executable for faster processing. See the SpamAssassin documentation
24999for more information on @code{spamd}/@code{spamc}.
25000
25001@end defvar
25002
25003SpamAssassin is a powerful and flexible spam filter that uses a wide
25004variety of tests to identify spam. A ham and a spam processors are
25005provided, plus the @code{spam-use-spamassassin} and
25006@code{spam-use-spamassassin-headers} variables to indicate to
25007spam-split that SpamAssassin should be either used, or has already
25008been used on the article. The 2.63 version of SpamAssassin was used
25009to test this functionality.
25010
24467@node ifile spam filtering 25011@node ifile spam filtering
24468@subsubsection ifile spam filtering 25012@subsubsection ifile spam filtering
24469@cindex spam filtering 25013@cindex spam filtering
@@ -24533,7 +25077,7 @@ articles will be added to the spam-stat database of spam messages.
24533 25077
24534Instead of the obsolete 25078Instead of the obsolete
24535@code{gnus-group-spam-exit-processor-stat}, it is recommended 25079@code{gnus-group-spam-exit-processor-stat}, it is recommended
24536that you use @code{'(spam spam-use-stat)}. Everything will work 25080that you use @code{(spam spam-use-stat)}. Everything will work
24537the same way, we promise. 25081the same way, we promise.
24538@end defvar 25082@end defvar
24539 25083
@@ -24543,18 +25087,17 @@ customizing the group parameters or the
24543@code{gnus-spam-process-newsgroups} variable. When this symbol is 25087@code{gnus-spam-process-newsgroups} variable. When this symbol is
24544added to a group's @code{spam-process} parameter, the ham-marked 25088added to a group's @code{spam-process} parameter, the ham-marked
24545articles in @emph{ham} groups will be added to the spam-stat database 25089articles in @emph{ham} groups will be added to the spam-stat database
24546of non-spam messages. Note that this ham processor has no effect in 25090of non-spam messages.
24547@emph{spam} or @emph{unclassified} groups.
24548 25091
24549@emph{WARNING} 25092@emph{WARNING}
24550 25093
24551Instead of the obsolete 25094Instead of the obsolete
24552@code{gnus-group-ham-exit-processor-stat}, it is recommended 25095@code{gnus-group-ham-exit-processor-stat}, it is recommended
24553that you use @code{'(ham spam-use-stat)}. Everything will work 25096that you use @code{(ham spam-use-stat)}. Everything will work
24554the same way, we promise. 25097the same way, we promise.
24555@end defvar 25098@end defvar
24556 25099
24557This enables @file{spam.el} to cooperate with @file{spam-stat.el}. 25100This enables @code{spam.el} to cooperate with @file{spam-stat.el}.
24558@file{spam-stat.el} provides an internal (Lisp-only) spam database, 25101@file{spam-stat.el} provides an internal (Lisp-only) spam database,
24559which unlike ifile or Bogofilter does not require external programs. 25102which unlike ifile or Bogofilter does not require external programs.
24560A spam and a ham processor, and the @code{spam-use-stat} variable for 25103A spam and a ham processor, and the @code{spam-use-stat} variable for
@@ -24583,7 +25126,7 @@ The easiest method is to make @file{spam.el} (@pxref{Spam Package})
24583call SpamOracle. 25126call SpamOracle.
24584 25127
24585@vindex spam-use-spamoracle 25128@vindex spam-use-spamoracle
24586To enable SpamOracle usage by @file{spam.el}, set the variable 25129To enable SpamOracle usage by @code{spam.el}, set the variable
24587@code{spam-use-spamoracle} to @code{t} and configure the 25130@code{spam-use-spamoracle} to @code{t} and configure the
24588@code{nnmail-split-fancy} or @code{nnimap-split-fancy}. @xref{Spam 25131@code{nnmail-split-fancy} or @code{nnimap-split-fancy}. @xref{Spam
24589Package}. In this example the @samp{INBOX} of an nnimap server is 25132Package}. In this example the @samp{INBOX} of an nnimap server is
@@ -24641,7 +25184,7 @@ sent to SpamOracle as spam samples.
24641 25184
24642Instead of the obsolete 25185Instead of the obsolete
24643@code{gnus-group-spam-exit-processor-spamoracle}, it is recommended 25186@code{gnus-group-spam-exit-processor-spamoracle}, it is recommended
24644that you use @code{'(spam spam-use-spamoracle)}. Everything will work 25187that you use @code{(spam spam-use-spamoracle)}. Everything will work
24645the same way, we promise. 25188the same way, we promise.
24646@end defvar 25189@end defvar
24647 25190
@@ -24651,14 +25194,13 @@ customizing the group parameter or the
24651@code{gnus-spam-process-newsgroups} variable. When this symbol is added 25194@code{gnus-spam-process-newsgroups} variable. When this symbol is added
24652to a group's @code{spam-process} parameter, the ham-marked articles in 25195to a group's @code{spam-process} parameter, the ham-marked articles in
24653@emph{ham} groups will be sent to the SpamOracle as samples of ham 25196@emph{ham} groups will be sent to the SpamOracle as samples of ham
24654messages. Note that this ham processor has no effect in @emph{spam} or 25197messages.
24655@emph{unclassified} groups.
24656 25198
24657@emph{WARNING} 25199@emph{WARNING}
24658 25200
24659Instead of the obsolete 25201Instead of the obsolete
24660@code{gnus-group-ham-exit-processor-spamoracle}, it is recommended 25202@code{gnus-group-ham-exit-processor-spamoracle}, it is recommended
24661that you use @code{'(ham spam-use-spamoracle)}. Everything will work 25203that you use @code{(ham spam-use-spamoracle)}. Everything will work
24662the same way, we promise. 25204the same way, we promise.
24663@end defvar 25205@end defvar
24664 25206
@@ -24696,45 +25238,22 @@ Code
24696 "True if blackbox should be used.") 25238 "True if blackbox should be used.")
24697@end lisp 25239@end lisp
24698 25240
24699Add 25241Write @code{spam-check-blackbox} if Blackbox can check incoming mail.
24700@lisp
24701(spam-use-blackbox . spam-check-blackbox)
24702@end lisp
24703to @code{spam-list-of-checks}.
24704
24705Add
24706@lisp
24707(gnus-group-ham-exit-processor-blackbox ham spam-use-blackbox)
24708(gnus-group-spam-exit-processor-blackbox spam spam-use-blackbox)
24709@end lisp
24710 25242
24711to @code{spam-list-of-processors}. 25243Write @code{spam-blackbox-register-routine} and
24712 25244@code{spam-blackbox-unregister-routine} using the bogofilter
24713Add 25245register/unregister routines as a start, or other restister/unregister
24714@lisp 25246routines more appropriate to Blackbox, if Blackbox can
24715(spam-use-blackbox spam-blackbox-register-routine 25247register/unregister spam and ham.
24716 nil
24717 spam-blackbox-unregister-routine
24718 nil)
24719@end lisp
24720
24721to @code{spam-registration-functions}. Write the register/unregister
24722routines using the bogofilter register/unregister routines as a
24723start, or other register/unregister routines more appropriate to
24724Blackbox.
24725 25248
24726@item 25249@item
24727Functionality 25250Functionality
24728 25251
24729Write the @code{spam-check-blackbox} function. It should return 25252The @code{spam-check-blackbox} function should return @samp{nil} or
24730@samp{nil} or @code{spam-split-group}, observing the other 25253@code{spam-split-group}, observing the other conventions. See the
24731conventions. See the existing @code{spam-check-*} functions for 25254existing @code{spam-check-*} functions for examples of what you can
24732examples of what you can do, and stick to the template unless you 25255do, and stick to the template unless you fully understand the reasons
24733fully understand the reasons why you aren't. 25256why you aren't.
24734
24735Make sure to add @code{spam-use-blackbox} to
24736@code{spam-list-of-statistical-checks} if Blackbox is a statistical
24737mail analyzer that needs the full message body to operate.
24738 25257
24739@end enumerate 25258@end enumerate
24740 25259
@@ -24749,8 +25268,8 @@ Note you don't have to provide a spam or a ham processor. Only
24749provide them if Blackbox supports spam or ham processing. 25268provide them if Blackbox supports spam or ham processing.
24750 25269
24751Also, ham and spam processors are being phased out as single 25270Also, ham and spam processors are being phased out as single
24752variables. Instead the form @code{'(spam spam-use-blackbox)} or 25271variables. Instead the form @code{(spam spam-use-blackbox)} or
24753@code{'(ham spam-use-blackbox)} is favored. For now, spam/ham 25272@code{(ham spam-use-blackbox)} is favored. For now, spam/ham
24754processor variables are still around but they won't be for long. 25273processor variables are still around but they won't be for long.
24755 25274
24756@lisp 25275@lisp
@@ -24781,7 +25300,64 @@ Add
24781(variable-item spam-use-blackbox) 25300(variable-item spam-use-blackbox)
24782@end lisp 25301@end lisp
24783to the @code{spam-autodetect-methods} group parameter in 25302to the @code{spam-autodetect-methods} group parameter in
24784@code{gnus.el}. 25303@code{gnus.el} if Blackbox can check incoming mail for spam contents.
25304
25305Finally, use the appropriate @code{spam-install-*-backend} function in
25306@code{spam.el}. Here are the available functions.
25307
25308
25309@enumerate
25310
25311@item
25312@code{spam-install-backend-alias}
25313
25314This function will simply install an alias for a back end that does
25315everything like the original back end. It is currently only used to
25316make @code{spam-use-BBDB-exclusive} act like @code{spam-use-BBDB}.
25317
25318@item
25319@code{spam-install-nocheck-backend}
25320
25321This function installs a back end that has no check function, but can
25322register/unregister ham or spam. The @code{spam-use-gmane} back end is
25323such a back end.
25324
25325@item
25326@code{spam-install-checkonly-backend}
25327
25328This function will install a back end that can only check incoming mail
25329for spam contents. It can't register or unregister messages.
25330@code{spam-use-blackholes} and @code{spam-use-hashcash} are such
25331back ends.
25332
25333@item
25334@code{spam-install-statistical-checkonly-backend}
25335
25336This function installs a statistical back end (one which requires the
25337full body of a message to check it) that can only check incoming mail
25338for contents. @code{spam-use-regex-body} is such a filter.
25339
25340@item
25341@code{spam-install-statistical-backend}
25342
25343This function install a statistical back end with incoming checks and
25344registration/unregistration routines. @code{spam-use-bogofilter} is
25345set up this way.
25346
25347@item
25348@code{spam-install-backend}
25349
25350This is the most normal back end installation, where a back end that can
25351check and register/unregister messages is set up without statistical
25352abilities. The @code{spam-use-BBDB} is such a back end.
25353
25354@item
25355@code{spam-install-mover-backend}
25356
25357Mover back ends are internal to @code{spam.el} and specifically move
25358articles around when the summary is exited. You will very probably
25359never install such a back end.
25360@end enumerate
24785 25361
24786@end enumerate 25362@end enumerate
24787 25363
@@ -25140,6 +25716,17 @@ shut up, but will flash so many messages it will make your head swim.
25140This variable works the same way as @code{gnus-verbose}, but it applies 25716This variable works the same way as @code{gnus-verbose}, but it applies
25141to the Gnus back ends instead of Gnus proper. 25717to the Gnus back ends instead of Gnus proper.
25142 25718
25719@item gnus-add-timestamp-to-message
25720@vindex gnus-add-timestamp-to-message
25721This variable controls whether to add timestamps to messages that are
25722controlled by @code{gnus-verbose} and @code{gnus-verbose-backends} and
25723are issued. The default value is @code{nil} which means never to add
25724timestamp. If it is @code{log}, add timestamps to only the messages
25725that go into the @samp{*Messages*} buffer (in XEmacs, it is the
25726@w{@samp{ *Message-Log*}} buffer). If it is neither @code{nil} nor
25727@code{log}, add timestamps not only to log messages but also to the ones
25728displayed in the echo area.
25729
25143@item nnheader-max-head-length 25730@item nnheader-max-head-length
25144@vindex nnheader-max-head-length 25731@vindex nnheader-max-head-length
25145When the back ends read straight heads of articles, they all try to read 25732When the back ends read straight heads of articles, they all try to read
@@ -25661,8 +26248,7 @@ Wes Hardaker---@file{gnus-picon.el} and the manual section on
25661Kim-Minh Kaplan---further work on the picon code. 26248Kim-Minh Kaplan---further work on the picon code.
25662 26249
25663@item 26250@item
25664Brad Miller---@file{gnus-gl.el} and the GroupLens manual section 26251Brad Miller---@file{gnus-gl.el} and the GroupLens manual section.
25665(@pxref{GroupLens}).
25666 26252
25667@item 26253@item
25668Sudish Joseph---innumerable bug fixes. 26254Sudish Joseph---innumerable bug fixes.
@@ -25703,7 +26289,7 @@ David Moore---rewrite of @file{nnvirtual.el} and many other things.
25703Kevin Davidson---came up with the name @dfn{ding}, so blame him. 26289Kevin Davidson---came up with the name @dfn{ding}, so blame him.
25704 26290
25705@item 26291@item
25706François Pinard---many, many interesting and thorough bug reports, as 26292Fran@,{c}ois Pinard---many, many interesting and thorough bug reports, as
25707well as autoconf support. 26293well as autoconf support.
25708 26294
25709@end itemize 26295@end itemize
@@ -25720,7 +26306,7 @@ Kevin Greiner,
25720Jesper Harder, 26306Jesper Harder,
25721Paul Jarc, 26307Paul Jarc,
25722Simon Josefsson, 26308Simon Josefsson,
25723David Kågedal, 26309David K@aa{}gedal,
25724Richard Pieri, 26310Richard Pieri,
25725Fabrice Popineau, 26311Fabrice Popineau,
25726Daniel Quinlan, 26312Daniel Quinlan,
@@ -25805,12 +26391,13 @@ Yoshiki Hayashi, @c Hayashi
25805P. E. Jareth Hein, 26391P. E. Jareth Hein,
25806Hisashige Kenji, @c Hisashige 26392Hisashige Kenji, @c Hisashige
25807Scott Hofmann, 26393Scott Hofmann,
26394Tassilo Horn,
25808Marc Horowitz, 26395Marc Horowitz,
25809Gunnar Horrigmo, 26396Gunnar Horrigmo,
25810Richard Hoskins, 26397Richard Hoskins,
25811Brad Howes, 26398Brad Howes,
25812Miguel de Icaza, 26399Miguel de Icaza,
25813François Felix Ingrand, 26400Fran@,{c}ois Felix Ingrand,
25814Tatsuya Ichikawa, @c Ichikawa 26401Tatsuya Ichikawa, @c Ichikawa
25815Ishikawa Ichiro, @c Ishikawa 26402Ishikawa Ichiro, @c Ishikawa
25816Lee Iverson, 26403Lee Iverson,
@@ -25950,6 +26537,7 @@ actually are people who are using Gnus. Who'd'a thunk it!
25950* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. 26537* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
25951* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. 26538* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
25952* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. 26539* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
26540* No Gnus:: Very punny.
25953@end menu 26541@end menu
25954 26542
25955These lists are, of course, just @emph{short} overviews of the 26543These lists are, of course, just @emph{short} overviews of the
@@ -26109,7 +26697,7 @@ Partial thread regeneration now happens when articles are
26109referred. 26697referred.
26110 26698
26111@item 26699@item
26112Gnus can make use of GroupLens predictions (@pxref{GroupLens}). 26700Gnus can make use of GroupLens predictions.
26113 26701
26114@item 26702@item
26115Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}). 26703Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}).
@@ -26758,7 +27346,7 @@ Gnus is now able to take out spam from your mail and news streams
26758using a wide variety of programs and filter rules. Among the supported 27346using a wide variety of programs and filter rules. Among the supported
26759methods are RBL blocklists, bogofilter and white/blacklists. Hooks 27347methods are RBL blocklists, bogofilter and white/blacklists. Hooks
26760for easy use of external packages such as SpamAssassin and Hashcash 27348for easy use of external packages such as SpamAssassin and Hashcash
26761are also new. @xref{Thwarting Email Spam}. 27349are also new. @ref{Thwarting Email Spam} and @ref{Spam Package}.
26762@c FIXME: @xref{Spam Package}?. Should this be under Misc? 27350@c FIXME: @xref{Spam Package}?. Should this be under Misc?
26763 27351
26764@item 27352@item
@@ -27325,6 +27913,15 @@ A new command which starts Gnus offline in slave mode.
27325 27913
27326@end itemize 27914@end itemize
27327 27915
27916@node No Gnus
27917@subsubsection No Gnus
27918@cindex No Gnus
27919
27920New features in No Gnus:
27921@c FIXME: Gnus 5.12?
27922
27923@include gnus-news.texi
27924
27328@iftex 27925@iftex
27329 27926
27330@page 27927@page
@@ -28416,7 +29013,9 @@ A Gnus group info (@pxref{Group Info}) is handed to the back end for
28416alterations. This comes in handy if the back end really carries all 29013alterations. This comes in handy if the back end really carries all
28417the information (as is the case with virtual and imap groups). This 29014the information (as is the case with virtual and imap groups). This
28418function should destructively alter the info to suit its needs, and 29015function should destructively alter the info to suit its needs, and
28419should return a non-@code{nil} value. 29016should return a non-@code{nil} value (exceptionally,
29017@code{nntp-request-update-info} always returns @code{nil} not to waste
29018the network resources).
28420 29019
28421There should be no result data from this function. 29020There should be no result data from this function.
28422 29021
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index 828af92fc0c..aad9cd223ea 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -71,14 +71,14 @@ Message mode buffers.
71@c Adjust ../Makefile.in if you change the following lines: 71@c Adjust ../Makefile.in if you change the following lines:
72Message is distributed with Gnus. The Gnus distribution 72Message is distributed with Gnus. The Gnus distribution
73@c 73@c
74corresponding to this manual is Gnus v5.11. 74corresponding to this manual is No Gnus v0.7.
75 75
76 76
77@node Interface 77@node Interface
78@chapter Interface 78@chapter Interface
79 79
80When a program (or a person) wants to respond to a message -- reply, 80When a program (or a person) wants to respond to a message---reply,
81follow up, forward, cancel -- the program (or person) should just put 81follow up, forward, cancel---the program (or person) should just put
82point in the buffer where the message is and call the required command. 82point in the buffer where the message is and call the required command.
83@code{Message} will then pop up a new @code{message} mode buffer with 83@code{Message} will then pop up a new @code{message} mode buffer with
84appropriate headers filled out, and the user can edit the message before 84appropriate headers filled out, and the user can edit the message before
@@ -179,7 +179,8 @@ but you can change the behavior to suit your needs by fiddling with the
179 179
180@vindex message-dont-reply-to-names 180@vindex message-dont-reply-to-names
181Addresses that match the @code{message-dont-reply-to-names} regular 181Addresses that match the @code{message-dont-reply-to-names} regular
182expression will be removed from the @code{Cc} header. 182expression (or list of regular expressions) will be removed from the
183@code{Cc} header. A value of @code{nil} means exclude your name only.
183 184
184@vindex message-wide-reply-confirm-recipients 185@vindex message-wide-reply-confirm-recipients
185If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you 186If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you
@@ -257,7 +258,7 @@ removed before popping up the new message buffer. The default is@*
257^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|@* 258^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|@*
258Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|@* 259Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|@*
259^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|@* 260^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|@*
260^X-Payment:}. 261^X-Payment:\\|^Approved:}.
261 262
262 263
263 264
@@ -797,14 +798,18 @@ Insert the message headers (@code{message-insert-headers}).
797@item C-c M-m 798@item C-c M-m
798@kindex C-c M-m 799@kindex C-c M-m
799@findex message-mark-inserted-region 800@findex message-mark-inserted-region
800Mark some region in the current article with enclosing tags. 801Mark some region in the current article with enclosing tags. See
801See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. 802@code{message-mark-insert-begin} and @code{message-mark-insert-end}.
803When called with a prefix argument, use slrn style verbatim marks
804(@samp{#v+} and @samp{#v-}).
802 805
803@item C-c M-f 806@item C-c M-f
804@kindex C-c M-f 807@kindex C-c M-f
805@findex message-mark-insert-file 808@findex message-mark-insert-file
806Insert a file in the current article with enclosing tags. 809Insert a file in the current article with enclosing tags.
807See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. 810See @code{message-mark-insert-begin} and @code{message-mark-insert-end}.
811When called with a prefix argument, use slrn style verbatim marks
812(@samp{#v+} and @samp{#v-}).
808 813
809@end table 814@end table
810 815
@@ -1159,6 +1164,11 @@ The text is killed and replaced with the contents of the variable
1159@code{message-elide-ellipsis}. The default value is to use an ellipsis 1164@code{message-elide-ellipsis}. The default value is to use an ellipsis
1160(@samp{[...]}). 1165(@samp{[...]}).
1161 1166
1167@item C-c M-k
1168@kindex C-c M-k
1169@findex message-kill-address
1170Kill the address under point.
1171
1162@item C-c C-z 1172@item C-c C-z
1163@kindex C-c C-z 1173@kindex C-c C-z
1164@findex message-kill-to-signature 1174@findex message-kill-to-signature
@@ -1244,11 +1254,13 @@ Kill the message buffer and exit (@code{message-kill-buffer}).
1244@section Mail Aliases 1254@section Mail Aliases
1245@cindex mail aliases 1255@cindex mail aliases
1246@cindex aliases 1256@cindex aliases
1257@cindex completion
1258@cindex ecomplete
1247 1259
1248@vindex message-mail-alias-type 1260@vindex message-mail-alias-type
1249The @code{message-mail-alias-type} variable controls what type of mail 1261The @code{message-mail-alias-type} variable controls what type of mail
1250alias expansion to use. Currently only one form is supported---Message 1262alias expansion to use. Currently two forms are supported:
1251uses @code{mailabbrev} to handle mail aliases. If this variable is 1263@code{mailabbrev} and @code{ecomplete}. If this variable is
1252@code{nil}, no mail alias expansion will be performed. 1264@code{nil}, no mail alias expansion will be performed.
1253 1265
1254@code{mailabbrev} works by parsing the @file{/etc/mailrc} and 1266@code{mailabbrev} works by parsing the @file{/etc/mailrc} and
@@ -1266,6 +1278,14 @@ on) headers and press @kbd{SPC} to expand the alias.
1266No expansion will be performed upon sending of the message---all 1278No expansion will be performed upon sending of the message---all
1267expansions have to be done explicitly. 1279expansions have to be done explicitly.
1268 1280
1281If you're using @code{ecomplete}, all addresses from @code{To} and
1282@code{Cc} headers will automatically be put into the
1283@file{~/.ecompleterc} file. When you enter text in the @code{To} and
1284@code{Cc} headers, @code{ecomplete} will check out the values stored
1285there and ``electrically'' say what completions are possible. To
1286choose one of these completions, use the @kbd{M-n} command to move
1287down to the list. Use @kbd{M-n} and @kbd{M-p} to move down and up the
1288list, and @kbd{RET} to choose a completion.
1269 1289
1270@node Spelling 1290@node Spelling
1271@section Spelling 1291@section Spelling
@@ -1334,7 +1354,7 @@ installed.
1334@section Message Headers 1354@section Message Headers
1335 1355
1336Message is quite aggressive on the message generation front. It has to 1356Message is quite aggressive on the message generation front. It has to
1337be -- it's a combined news and mail agent. To be able to send combined 1357be---it's a combined news and mail agent. To be able to send combined
1338messages, it has to generate all headers itself (instead of letting the 1358messages, it has to generate all headers itself (instead of letting the
1339mail/news system do it) to ensure that mail and news copies of messages 1359mail/news system do it) to ensure that mail and news copies of messages
1340look sufficiently similar. 1360look sufficiently similar.
@@ -1373,7 +1393,7 @@ values:
1373 1393
1374@table @code 1394@table @code
1375@item nil 1395@item nil
1376Just the address -- @samp{king@@grassland.com}. 1396Just the address---@samp{king@@grassland.com}.
1377 1397
1378@item parens 1398@item parens
1379@samp{king@@grassland.com (Elvis Parsley)}. 1399@samp{king@@grassland.com (Elvis Parsley)}.
@@ -1494,6 +1514,9 @@ hidden when composing a message.
1494 '(not "From" "Subject" "To" "Cc" "Newsgroups")) 1514 '(not "From" "Subject" "To" "Cc" "Newsgroups"))
1495@end lisp 1515@end lisp
1496 1516
1517Headers are hidden using narrowing, you can use @kbd{M-x widen} to
1518expose them in the buffer.
1519
1497@item message-header-synonyms 1520@item message-header-synonyms
1498@vindex message-header-synonyms 1521@vindex message-header-synonyms
1499A list of lists of header synonyms. E.g., if this list contains a 1522A list of lists of header synonyms. E.g., if this list contains a
@@ -1525,6 +1548,13 @@ Regexp of headers to be removed before mailing. The default is@*
1525This string is inserted at the end of the headers in all message 1548This string is inserted at the end of the headers in all message
1526buffers that are initialized as mail. 1549buffers that are initialized as mail.
1527 1550
1551@item message-generate-hashcash
1552@vindex message-generate-hashcash
1553Variable that indicates whether @samp{X-Hashcash} headers
1554should be computed for the message. @xref{Hashcash, ,Hashcash,gnus,
1555The Gnus Manual}. If @code{opportunistic}, only generate the headers
1556when it doesn't lead to the user having to wait.
1557
1528@end table 1558@end table
1529 1559
1530 1560
@@ -1541,10 +1571,10 @@ buffers that are initialized as mail.
1541@findex smtpmail-send-it 1571@findex smtpmail-send-it
1542@findex feedmail-send-it 1572@findex feedmail-send-it
1543Function used to send the current buffer as mail. The default is 1573Function used to send the current buffer as mail. The default is
1544@code{message-send-mail-with-sendmail}. Other valid values include 1574@code{message-send-mail-with-sendmail}, or @code{smtpmail-send-it}
1575according to the system. Other valid values include
1545@code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail}, 1576@code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail},
1546@code{message-smtpmail-send-it}, @code{smtpmail-send-it} and 1577@code{message-smtpmail-send-it} and @code{feedmail-send-it}.
1547@code{feedmail-send-it}.
1548 1578
1549@item message-mh-deletable-headers 1579@item message-mh-deletable-headers
1550@vindex message-mh-deletable-headers 1580@vindex message-mh-deletable-headers
@@ -1859,6 +1889,9 @@ that look like:
1859Hallvard B Furuseth <h.b.furuseth@@usit.uio.no> writes: 1889Hallvard B Furuseth <h.b.furuseth@@usit.uio.no> writes:
1860@end example 1890@end example
1861 1891
1892@c FIXME: Add `message-insert-formated-citation-line' and
1893@c `message-citation-line-format'
1894
1862Point will be at the beginning of the body of the message when this 1895Point will be at the beginning of the body of the message when this
1863function is called. 1896function is called.
1864 1897
@@ -1873,21 +1906,29 @@ Article Highlighting, gnus, The Gnus Manual}, for details.
1873@cindex yanking 1906@cindex yanking
1874@cindex quoting 1907@cindex quoting
1875When you are replying to or following up an article, you normally want 1908When you are replying to or following up an article, you normally want
1876to quote the person you are answering. Inserting quoted text is done 1909to quote the person you are answering. Inserting quoted text is done by
1877by @dfn{yanking}, and each line you yank will have 1910@dfn{yanking}, and each line you yank will have
1878@code{message-yank-prefix} prepended to it (except for quoted and 1911@code{message-yank-prefix} prepended to it (except for quoted lines
1879empty lines which uses @code{message-yank-cited-prefix}). The default 1912which use @code{message-yank-cited-prefix} and empty lines which use
1880is @samp{> }. 1913@code{message-yank-empty-prefix}). The default is @samp{> }.
1881 1914
1882@item message-yank-cited-prefix 1915@item message-yank-cited-prefix
1883@vindex message-yank-cited-prefix 1916@vindex message-yank-cited-prefix
1884@cindex yanking 1917@cindex yanking
1885@cindex cited 1918@cindex cited
1886@cindex quoting 1919@cindex quoting
1887When yanking text from an article which contains no text or already 1920When yanking text from an article which contains already cited text,
1888cited text, each line will be prefixed with the contents of this 1921each line will be prefixed with the contents of this variable. The
1889variable. The default is @samp{>}. See also 1922default is @samp{>}. See also @code{message-yank-prefix}.
1890@code{message-yank-prefix}. 1923
1924@item message-yank-empty-prefix
1925@vindex message-yank-empty-prefix
1926@cindex yanking
1927@cindex quoting
1928When yanking text from an article, each empty line will be prefixed with
1929the contents of this variable. The default is @samp{>}. You can set
1930this variable to an empty string to split the cited text into paragraphs
1931automatically. See also @code{message-yank-prefix}.
1891 1932
1892@item message-indentation-spaces 1933@item message-indentation-spaces
1893@vindex message-indentation-spaces 1934@vindex message-indentation-spaces
@@ -1932,8 +1973,18 @@ If this variable is @code{nil}, no signature will be inserted at all.
1932@item message-signature-file 1973@item message-signature-file
1933@vindex message-signature-file 1974@vindex message-signature-file
1934File containing the signature to be inserted at the end of the buffer. 1975File containing the signature to be inserted at the end of the buffer.
1976If a path is specified, the value of
1977@code{message-signature-directory} is ignored, even if set.
1935The default is @file{~/.signature}. 1978The default is @file{~/.signature}.
1936 1979
1980@item message-signature-directory
1981@vindex message-signature-directory
1982Name of directory containing signature files. Comes in handy if you
1983have many such files, handled via Gnus posting styles for instance.
1984If @code{nil} (the default), @code{message-signature-file} is expected
1985to specify the directory if needed.
1986
1987
1937@item message-signature-insert-empty-line 1988@item message-signature-insert-empty-line
1938@vindex message-signature-insert-empty-line 1989@vindex message-signature-insert-empty-line
1939If @code{t} (the default value) an empty line is inserted before the 1990If @code{t} (the default value) an empty line is inserted before the
@@ -1968,6 +2019,13 @@ Emacsen.) @xref{Charset Translation, , Charset Translation, emacs-mime,
1968Emacs MIME Manual}, for details on the @sc{mule}-to-@acronym{MIME} 2019Emacs MIME Manual}, for details on the @sc{mule}-to-@acronym{MIME}
1969translation process. 2020translation process.
1970 2021
2022@item message-fill-column
2023@vindex message-fill-column
2024@cindex auto-fill
2025Local value for the column beyond which automatic line-wrapping should
2026happen for message buffers. If non-nil (the default), also turn on
2027auto-fill in message buffers.
2028
1971@item message-signature-separator 2029@item message-signature-separator
1972@vindex message-signature-separator 2030@vindex message-signature-separator
1973Regexp matching the signature separator. It is @samp{^-- *$} by 2031Regexp matching the signature separator. It is @samp{^-- *$} by
@@ -2057,6 +2115,12 @@ Hook run when canceling news articles.
2057@vindex message-mode-syntax-table 2115@vindex message-mode-syntax-table
2058Syntax table used in message mode buffers. 2116Syntax table used in message mode buffers.
2059 2117
2118@item message-cite-articles-with-x-no-archive
2119@vindex message-cite-articles-with-x-no-archive
2120If non-@code{nil}, don't strip quoted text from articles that have
2121@samp{X-No-Archive} set. Even if this variable isn't set, you can
2122undo the stripping by hitting the @code{undo} keystroke.
2123
2060@item message-strip-special-text-properties 2124@item message-strip-special-text-properties
2061@vindex message-strip-special-text-properties 2125@vindex message-strip-special-text-properties
2062Emacs has a number of special text properties which can break message 2126Emacs has a number of special text properties which can break message
@@ -2089,7 +2153,7 @@ the buffer where the message is.
2089 2153
2090@item function 2154@item function
2091A function to be called if @var{predicate} returns non-@code{nil}. 2155A function to be called if @var{predicate} returns non-@code{nil}.
2092@var{function} is called with one parameter -- the prefix. 2156@var{function} is called with one parameter---the prefix.
2093@end table 2157@end table
2094 2158
2095The default is: 2159The default is:
diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi
index ca29e2184e5..3a171297740 100644
--- a/doc/misc/pgg.texi
+++ b/doc/misc/pgg.texi
@@ -345,11 +345,11 @@ singleton object wrapped with the luna object system.
345Since PGG was designed for accessing and developing PGP functionality, 345Since PGG was designed for accessing and developing PGP functionality,
346the architecture had to be designed not just for interoperability but 346the architecture had to be designed not just for interoperability but
347also for extensiblity. In this chapter we explore the architecture 347also for extensiblity. In this chapter we explore the architecture
348while finding out how to write the PGG backend. 348while finding out how to write the PGG back end.
349 349
350@menu 350@menu
351* Initializing:: 351* Initializing::
352* Backend methods:: 352* Back end methods::
353* Getting output:: 353* Getting output::
354@end menu 354@end menu
355 355
@@ -373,12 +373,12 @@ variable @code{pgg-scheme-gpg-instance} and will be reused from now on.
373@end lisp 373@end lisp
374 374
375The name of the function must follow the 375The name of the function must follow the
376regulation---@code{pgg-make-scheme-} follows the backend name. 376regulation---@code{pgg-make-scheme-} follows the back end name.
377 377
378@node Backend methods 378@node Back end methods
379@section Backend methods 379@section Back end methods
380 380
381In each backend, these methods must be present. The output of these 381In each back end, these methods must be present. The output of these
382methods is stored in special buffers (@ref{Getting output}), so that 382methods is stored in special buffers (@ref{Getting output}), so that
383these methods must tell the status of the execution. 383these methods must tell the status of the execution.
384 384
@@ -435,7 +435,7 @@ On success, it returns @code{t}, otherwise @code{nil}.
435@node Getting output 435@node Getting output
436@section Getting output 436@section Getting output
437 437
438The output of the backend methods (@ref{Backend methods}) is stored in 438The output of the back end methods (@ref{Back end methods}) is stored in
439special buffers, so that these methods must tell the status of the 439special buffers, so that these methods must tell the status of the
440execution. 440execution.
441 441
diff --git a/doc/misc/sasl.texi b/doc/misc/sasl.texi
new file mode 100644
index 00000000000..9cd465abb26
--- /dev/null
+++ b/doc/misc/sasl.texi
@@ -0,0 +1,270 @@
1\input texinfo @c -*-texinfo-*-
2
3@setfilename sasl.info
4
5@set VERSION 0.2
6
7@dircategory Emacs
8@direntry
9* SASL: (sasl). The Emacs SASL library.
10@end direntry
11
12@settitle Emacs SASL Library @value{VERSION}
13
14@ifinfo
15This file describes the Emacs SASL library.
16
17Copyright @copyright{} 2004, 2005, 2006 Free Software Foundation, Inc.
18Copyright @copyright{} 2000 Daiki Ueno.
19
20Permission is granted to copy, distribute and/or modify this document
21under the terms of the GNU Free Documentation License, Version 1.2 or
22any later version published by the Free Software Foundation; with no
23Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
24Texts. A copy of the license is included in the section entitled "GNU
25Free Documentation License".
26@end ifinfo
27
28@tex
29
30@titlepage
31@title Emacs SASL Library
32
33@author by Daiki Ueno
34@page
35
36@vskip 0pt plus 1filll
37Copyright @copyright{} 2000 Daiki Ueno.
38
39Permission is granted to copy, distribute and/or modify this document
40under the terms of the GNU Free Documentation License, Version 1.2 or
41any later version published by the Free Software Foundation; with no
42Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
43Texts. A copy of the license is included in the section entitled "GNU
44Free Documentation License".
45@end titlepage
46@page
47
48@end tex
49
50@node Top
51@top Emacs SASL
52This manual describes the Emacs SASL library.
53
54A common interface to share several authentication mechanisms between
55applications using different protocols.
56
57@menu
58* Overview:: What Emacs SASL library is.
59* How to use:: Adding authentication support to your applications.
60* Data types::
61* Back end drivers:: Writing your own drivers.
62* Index::
63* Function Index::
64* Variable Index::
65@end menu
66
67@node Overview
68@chapter Overview
69
70@sc{sasl} is short for @dfn{Simple Authentication and Security Layer}.
71This standard is documented in RFC2222. It provides a simple method for
72adding authentication support to various application protocols.
73
74The toplevel interface of this library is inspired by Java @sc{sasl}
75Application Program Interface. It defines an abstraction over a series
76of authentication mechanism drivers (@ref{Back end drivers}).
77
78Back end drivers are designed to be close as possible to the
79authentication mechanism. You can access the additional configuration
80information anywhere from the implementation.
81
82@node How to use
83@chapter How to use
84
85(Not yet written).
86
87To use Emacs SASL library, please evaluate following expression at the
88beginning of your application program.
89
90@lisp
91(require 'sasl)
92@end lisp
93
94If you want to check existence of sasl.el at runtime, instead you
95can list autoload settings for functions you want.
96
97@node Data types
98@chapter Data types
99
100There are three data types to be used for carrying a negotiated
101security layer---a mechanism, a client parameter and an authentication
102step.
103
104@menu
105* Mechanisms::
106* Clients::
107* Steps::
108@end menu
109
110@node Mechanisms
111@section Mechanisms
112
113A mechanism (@code{sasl-mechanism} object) is a schema of the @sc{sasl}
114authentication mechanism driver.
115
116@defvar sasl-mechanisms
117A list of mechanism names.
118@end defvar
119
120@defun sasl-find-mechanism mechanisms
121
122Retrieve an apropriate mechanism.
123This function compares @var{mechanisms} and @code{sasl-mechanisms} then
124returns apropriate @code{sasl-mechanism} object.
125
126@example
127(let ((sasl-mechanisms '("CRAM-MD5" "DIGEST-MD5")))
128 (setq mechanism (sasl-find-mechanism server-supported-mechanisms)))
129@end example
130
131@end defun
132
133@defun sasl-mechanism-name mechanism
134Return name of mechanism, a string.
135@end defun
136
137If you want to write an authentication mechanism driver (@ref{Back end
138drivers}), use @code{sasl-make-mechanism} and modify
139@code{sasl-mechanisms} and @code{sasl-mechanism-alist} correctly.
140
141@defun sasl-make-mechanism name steps
142Allocate a @code{sasl-mechanism} object.
143This function takes two parameters---name of the mechanism, and a list
144of authentication functions.
145
146@example
147(defconst sasl-anonymous-steps
148 '(identity ;no initial response
149 sasl-anonymous-response))
150
151(put 'sasl-anonymous 'sasl-mechanism
152 (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps))
153@end example
154
155@end defun
156
157@node Clients
158@section Clients
159
160A client (@code{sasl-client} object) initialized with four
161parameters---a mechanism, a user name, name of the service and name of
162the server.
163
164@defun sasl-make-client mechanism name service server
165Prepare a @code{sasl-client} object.
166@end defun
167
168@defun sasl-client-mechanism client
169Return the mechanism (@code{sasl-mechanism} object) of client.
170@end defun
171
172@defun sasl-client-name client
173Return the authorization name of client, a string.
174@end defun
175
176@defun sasl-client-service client
177Return the service name of client, a string.
178@end defun
179
180@defun sasl-client-server client
181Return the server name of client, a string.
182@end defun
183
184If you want to specify additional configuration properties, please use
185@code{sasl-client-set-property}.
186
187@defun sasl-client-set-property client property value
188Add the given property/value to client.
189@end defun
190
191@defun sasl-client-property client property
192Return the value of the property of client.
193@end defun
194
195@defun sasl-client-set-properties client plist
196Destructively set the properties of client.
197The second argument is the new property list.
198@end defun
199
200@defun sasl-client-properties client
201Return the whole property list of client configuration.
202@end defun
203
204@node Steps
205@section Steps
206
207A step (@code{sasl-step} object) is an abstraction of authentication
208``step'' which holds the response value and the next entry point for the
209authentication process (the latter is not accessible).
210
211@defun sasl-step-data step
212Return the data which @var{step} holds, a string.
213@end defun
214
215@defun sasl-step-set-data step data
216Store @var{data} string to @var{step}.
217@end defun
218
219To get the initial response, you should call the function
220@code{sasl-next-step} with the second argument @code{nil}.
221
222@example
223(setq name (sasl-mechanism-name mechanism))
224@end example
225
226At this point we could send the command which starts a SASL
227authentication protocol exchange. For example,
228
229@example
230(process-send-string
231 process
232 (if (sasl-step-data step) ;initial response
233 (format "AUTH %s %s\r\n" name (base64-encode-string (sasl-step-data step) t))
234 (format "AUTH %s\r\n" name)))
235@end example
236
237To go on with the authentication process, all you have to do is call
238@code{sasl-next-step} consecutively.
239
240@defun sasl-next-step client step
241Perform the authentication step.
242At the first time @var{step} should be set to @code{nil}.
243@end defun
244
245@node Back end drivers
246@chapter Back end drivers
247
248(Not yet written).
249
250@node Index
251@chapter Index
252@printindex cp
253
254@node Function Index
255@chapter Function Index
256@printindex fn
257
258@node Variable Index
259@chapter Variable Index
260@printindex vr
261
262@summarycontents
263@contents
264@bye
265
266@c End:
267
268@ignore
269 arch-tag: dc9650be-a953-40bf-bc55-24fe5f19d875
270@end ignore
diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi
index af2132e4997..9c31f77f4d8 100644
--- a/doc/misc/sieve.texi
+++ b/doc/misc/sieve.texi
@@ -236,9 +236,9 @@ if address "sender" "owner-w3-beta@@xemacs.org" @{
236@} 236@}
237@end example 237@end example
238 238
239A few mailing lists do not use the @samp{Sender:} header, but does 239A few mailing lists do not use the @samp{Sender:} header, but has a
240contain some unique identifier in some other header. The following is 240unique identifier in some other header. The following is not a
241not a complete script, it assumes that @code{fileinto} has already been 241complete script, it assumes that @code{fileinto} has already been
242required. 242required.
243 243
244@example 244@example
diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS
index f09451af805..585f62087d0 100644
--- a/etc/GNUS-NEWS
+++ b/etc/GNUS-NEWS
@@ -10,15 +10,16 @@ For older news, see Gnus info node "New Features".
10 10
11* Installation changes 11* Installation changes
12 12
13** Upgrading from previous (stable) version if you have used Oort. 13** Upgrading from previous (stable) version if you have used No Gnus.
14 14
15If you have tried Oort (the unstable Gnus branch leading to this 15If you have tried No Gnus (the unstable Gnus branch leading to this
16release) but went back to a stable version, be careful when upgrading to 16release) but went back to a stable version, be careful when upgrading to
17this version. In particular, you will probably want to remove all 17this version. In particular, you will probably want to remove the
18`.marks' (nnml) and `.mrk' (nnfolder) files, so that flags are read from 18`~/News/marks' directory (perhaps selectively), so that flags are read
19your `.newsrc.eld' instead of from the `.marks'/`.mrk' file where this 19from your `~/.newsrc.eld' instead of from the stale marks file, where
20release store flags. See a later entry for more information about 20this release will store flags for nntp. See a later entry for more
21marks. Note that downgrading isn't save in general. 21information about nntp marks. Note that downgrading isn't safe in
22general.
22 23
23** Lisp files are now installed in `.../site-lisp/gnus/' by default. It 24** Lisp files are now installed in `.../site-lisp/gnus/' by default. It
24defaulted to `.../site-lisp/' formerly. In addition to this, the new 25defaulted to `.../site-lisp/' formerly. In addition to this, the new
@@ -26,493 +27,191 @@ installer issues a warning if other Gnus installations which will shadow
26the latest one are detected. You can then remove those shadows manually 27the latest one are detected. You can then remove those shadows manually
27or remove them using `make remove-installed-shadows'. 28or remove them using `make remove-installed-shadows'.
28 29
29** New `make.bat' for compiling and installing Gnus under MS Windows
30
31Use `make.bat' if you want to install Gnus under MS Windows, the first
32argument to the batch-program should be the directory where `xemacs.exe'
33respectively `emacs.exe' is located, if you want to install Gnus after
34compiling it, give `make.bat' `/copy' as the second parameter.
35
36`make.bat' has been rewritten from scratch, it now features automatic
37recognition of XEmacs and GNU Emacs, generates `gnus-load.el', checks if
38errors occur while compilation and generation of info files and reports
39them at the end of the build process. It now uses `makeinfo' if it is
40available and falls back to `infohack.el' otherwise. `make.bat' should
41now install all files which are necessary to run Gnus and be generally a
42complete replacement for the `configure; make; make install' cycle used
43under Unix systems.
44
45The new `make.bat' makes `make-x.bat' and `xemacs.mak' superfluous, so
46they have been removed.
47
48** `~/News/overview/' not used.
49
50As a result of the following change, the `~/News/overview/' directory is
51not used any more. You can safely delete the entire hierarchy.
52
53** `(require 'gnus-load)'
54
55If you use a stand-alone Gnus distribution, you'd better add `(require
56'gnus-load)' into your `~/.emacs' after adding the Gnus lisp directory
57into load-path.
58
59File `gnus-load.el' contains autoload commands, functions and variables,
60some of which may not be included in distributions of Emacsen.
61
62
63 30
64* New packages and libraries within Gnus 31* New packages and libraries within Gnus
65 32
66** The revised Gnus FAQ is included in the manual, *Note Frequently Asked 33** Gnus includes the Emacs Lisp SASL library.
67Questions::.
68
69** TLS wrapper shipped with Gnus
70 34
71TLS/SSL is now supported in IMAP and NNTP via `tls.el' and GNUTLS. The 35This provides a clean API to SASL mechanisms from within Emacs. The
72old TLS/SSL support via (external third party) `ssl.el' and OpenSSL 36user visible aspects of this, compared to the earlier situation, include
73still works. 37support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top.
74 38
75** Improved anti-spam features. 39** ManageSieve connections uses the SASL library by default.
76 40
77Gnus is now able to take out spam from your mail and news streams using 41The primary change this brings is support for DIGEST-MD5 and NTLM, when
78a wide variety of programs and filter rules. Among the supported 42the server supports it.
79methods are RBL blocklists, bogofilter and white/blacklists. Hooks for
80easy use of external packages such as SpamAssassin and Hashcash are also
81new. *Note Thwarting Email Spam::.
82 43
83** Gnus supports server-side mail filtering using Sieve. 44** Gnus includes a password cache mechanism in password.el.
84
85Sieve rules can be added as Group Parameters for groups, and the
86complete Sieve script is generated using `D g' from the Group buffer,
87and then uploaded to the server using `C-c C-l' in the generated Sieve
88buffer. *Note Sieve Commands::, and the new Sieve manual *Note Top:
89(sieve)Top.
90
91
92
93* Changes in group mode
94
95** `gnus-group-read-ephemeral-group' can be called interactively, using `G
96M'.
97
98** Retrieval of charters and control messages
99
100There are new commands for fetching newsgroup charters (`H c') and
101control messages (`H C').
102
103** The new variable `gnus-parameters' can be used to set group parameters.
104
105Earlier this was done only via `G p' (or `G c'), which stored the
106parameters in `~/.newsrc.eld', but via this variable you can enjoy the
107powers of customize, and simplified backups since you set the variable
108in `~/.gnus.el' instead of `~/.newsrc.eld'. The variable maps regular
109expressions matching group names to group parameters, a'la:
110(setq gnus-parameters
111 '(("mail\\..*"
112 (gnus-show-threads nil)
113 (gnus-use-scoring nil))
114 ("^nnimap:\\(foo.bar\\)$"
115 (to-group . "\\1"))))
116
117** Unread count correct in nnimap groups.
118
119The estimated number of unread articles in the group buffer should now
120be correct for nnimap groups. This is achieved by calling
121`nnimap-fixup-unread-after-getting-new-news' from the
122`gnus-setup-news-hook' (called on startup) and
123`gnus-after-getting-new-news-hook'. (called after getting new mail). If
124you have modified those variables from the default, you may want to add
125`nnimap-fixup-unread-after-getting-new-news' again. If you were happy
126with the estimate and want to save some (minimal) time when getting new
127mail, remove the function.
128
129** Group names are treated as UTF-8 by default.
130
131This is supposedly what USEFOR wanted to migrate to. See
132`gnus-group-name-charset-group-alist' and
133`gnus-group-name-charset-method-alist' for customization.
134
135** `gnus-group-charset-alist' and `gnus-group-ignored-charsets-alist'.
136
137The regexps in these variables are compared with full group names
138instead of real group names in 5.8. Users who customize these variables
139should change those regexps accordingly. For example:
140("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr)
141 45
46It is enabled by default (see `password-cache'), with a short timeout of
4716 seconds (see `password-cache-expiry'). If PGG is used as the PGP
48back end, the PGP passphrase is managed by this mechanism. Passwords
49for ManageSieve connections are managed by this mechanism, after
50querying the user about whether to do so.
142 51
143 52
144* Changes in summary and article mode 53* Changes in summary and article mode
145 54
146** `F' (`gnus-article-followup-with-original') and `R' 55** Gnus now supports sticky article buffers. Those are article buffers
147(`gnus-article-reply-with-original') only yank the text in the region if 56that are not reused when you select another article. *Note Sticky
148the region is active. 57Articles::.
149
150** In draft groups, `e' is now bound to `gnus-draft-edit-message'. Use `B
151w' for `gnus-summary-edit-article' instead.
152
153** Article Buttons
154
155More buttons for URLs, mail addresses, Message-IDs, Info links, man
156pages and Emacs or Gnus related references. *Note Article Buttons::.
157The variables `gnus-button-*-level' can be used to control the
158appearance of all article buttons. *Note Article Button Levels::.
159
160** Single-part yenc encoded attachments can be decoded.
161
162** Picons
163
164The picons code has been reimplemented to work in GNU Emacs--some of the
165previous options have been removed or renamed.
166
167Picons are small "personal icons" representing users, domain and
168newsgroups, which can be displayed in the Article buffer. *Note
169Picons::.
170
171** If the new option `gnus-treat-body-boundary' is non-`nil', a boundary
172line is drawn at the end of the headers.
173
174** Signed article headers (X-PGP-Sig) can be verified with `W p'.
175
176** The Summary Buffer uses an arrow in the fringe to indicate the current
177article. Use `(setq gnus-summary-display-arrow nil)' to disable it.
178
179** Warn about email replies to news
180
181Do you often find yourself replying to news by email by mistake? Then
182the new option `gnus-confirm-mail-reply-to-news' is just the thing for
183you.
184
185** If the new option `gnus-summary-display-while-building' is non-`nil',
186the summary buffer is shown and updated as it's being built.
187
188** The new `recent' mark `.' indicates newly arrived messages (as opposed
189to old but unread messages).
190
191** Gnus supports RFC 2369 mailing list headers, and adds a number of
192related commands in mailing list groups. *Note Mailing List::.
193
194** The Date header can be displayed in a format that can be read aloud in
195English. *Note Article Date::.
196
197** diffs are automatically highlighted in groups matching
198`mm-uu-diff-groups-regexp'
199
200** Better handling of Microsoft citation styles
201
202Gnus now tries to recognize the mangled header block that some Microsoft
203mailers use to indicate that the rest of the message is a citation, even
204though it is not quoted in any way. The variable
205`gnus-cite-unsightly-citation-regexp' matches the start of these
206citations.
207
208The new command `W Y f' (`gnus-article-outlook-deuglify-article') allows
209deuglifying broken Outlook (Express) articles.
210
211** `gnus-article-skip-boring'
212
213If you set `gnus-article-skip-boring' to `t', then Gnus will not scroll
214down to show you a page that contains only boring text, which by default
215means cited text and signature. You can customize what is skippable
216using `gnus-article-boring-faces'.
217
218This feature is especially useful if you read many articles that consist
219of a little new content at the top with a long, untrimmed message cited
220below.
221
222** Smileys (`:-)', `;-)' etc) are now displayed graphically in Emacs too.
223
224Put `(setq gnus-treat-display-smileys nil)' in `~/.gnus.el' to disable
225it.
226
227** Face headers handling. *Note Face::.
228
229** In the summary buffer, the new command `/ N' inserts new messages and `/
230o' inserts old messages.
231
232** Gnus decodes morse encoded messages if you press `W m'.
233 58
234** `gnus-summary-line-format' 59** International host names (IDNA) can now be decoded inside article bodies
60using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn
61(`http://www.gnu.org/software/libidn/') has been installed.
235 62
236The default value changed to `%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n'. 63** The non-ASCII group names handling has been much improved. The back
237Moreover `gnus-extra-headers', `nnmail-extra-headers' and 64ends that fully support non-ASCII group names are now `nntp', `nnml',
238`gnus-ignored-from-addresses' changed their default so that the users 65and `nnrss'. Also the agent, the cache, and the marks features work
239name will be replaced by the recipient's name or the group name posting 66with those back ends. *Note Non-ASCII Group Names::.
240to for NNTP groups.
241 67
242** Deleting of attachments. 68** Gnus now displays DNS master files sent as text/dns using dns-mode.
243 69
244The command `gnus-mime-save-part-and-strip' (bound to `C-o' on MIME 70** Gnus supports new limiting commands in the Summary buffer: `/ r'
245buttons) saves a part and replaces the part with an external one. 71(`gnus-summary-limit-to-replied') and `/ R'
246`gnus-mime-delete-part' (bound to `d' on MIME buttons) removes a part. 72(`gnus-summary-limit-to-recipient'). *Note Limiting::.
247It works only on back ends that support editing.
248 73
249** `gnus-default-charset' 74** You can now fetch all ticked articles from the server using `Y t'
75(`gnus-summary-insert-ticked-articles'). *Note Summary Generation
76Commands::.
250 77
251The default value is determined from the `current-language-environment' 78** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t'
252variable, instead of `iso-8859-1'. Also the `.*' item in 79(`gnus-summary-sort-by-recipient'). *Note Summary Sorting::.
253`gnus-group-charset-alist' is removed.
254 80
255** Printing capabilities are enhanced. 81** S/MIME now features LDAP user certificate searches. You need to
82configure the server in `smime-ldap-host-list'.
256 83
257Gnus supports Muttprint natively with `O P' from the Summary and Article 84** URLs inside OpenPGP headers are retrieved and imported to your PGP key
258buffers. Also, each individual MIME part can be printed using `p' on 85ring when you click on them.
259the MIME button.
260 86
261** Extended format specs. 87** Picons can be displayed right from the textual address, see
88`gnus-picon-style'. *Note Picons::.
262 89
263Format spec `%&user-date;' is added into 90** ANSI SGR control sequences can be transformed using `W A'.
264`gnus-summary-line-format-alist'. Also, user defined extended format
265specs are supported. The extended format specs look like `%u&foo;',
266which invokes function `gnus-user-format-function-FOO'. Because `&' is
267used as the escape character, old user defined format `%u&' is no longer
268supported.
269 91
270** `/ *' (`gnus-summary-limit-include-cached') is rewritten. 92ANSI sequences are used in some Chinese hierarchies for highlighting
93articles (`gnus-article-treat-ansi-sequences').
271 94
272It was aliased to `Y c' (`gnus-summary-insert-cached-articles'). The 95** Gnus now MIME decodes articles even when they lack "MIME-Version" header.
273new function filters out other articles. 96This changes the default of `gnus-article-loose-mime'.
274 97
275** Some limiting commands accept a `C-u' prefix to negate the match. 98** `gnus-decay-scores' can be a regexp matching score files. For example,
99set it to `\\.ADAPT\\'' and only adaptive score files will be decayed.
100 *Note Score Decays::.
276 101
277If `C-u' is used on subject, author or extra headers, i.e., `/ s', `/ 102** Strings prefixing to the `To' and `Newsgroup' headers in summary lines
278a', and `/ x' (`gnus-summary-limit-to-{subject,author,extra}') 103when using `gnus-ignored-from-addresses' can be customized with
279respectively, the result will be to display all articles that do not 104`gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. *Note To
280match the expression. 105From Newsgroups::.
281 106
282** Gnus inlines external parts (message/external). 107** You can replace MIME parts with external bodies. See
283 108`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME
284 109Commands::, *note Using MIME::.
285
286* Changes in Message mode and related Gnus features
287
288** Delayed articles
289
290You can delay the sending of a message with `C-c C-j' in the Message
291buffer. The messages are delivered at specified time. This is useful
292for sending yourself reminders. *Note Delayed Articles::.
293
294** If the new option `nnml-use-compressed-files' is non-`nil', the nnml
295back end allows compressed message files.
296
297** The new option `gnus-gcc-mark-as-read' automatically marks Gcc articles
298as read.
299
300** Externalizing of attachments
301
302If `gnus-gcc-externalize-attachments' or
303`message-fcc-externalize-attachments' is non-`nil', attach local files
304as external parts.
305
306** The envelope sender address can be customized when using Sendmail.
307 *Note Mail Variables: (message)Mail Variables.
308
309** Gnus no longer generate the Sender: header automatically.
310
311Earlier it was generated when the user configurable email address was
312different from the Gnus guessed default user address. As the guessing
313algorithm is rarely correct these days, and (more controversially) the
314only use of the Sender: header was to check if you are entitled to
315cancel/supersede news (which is now solved by Cancel Locks instead, see
316another entry), generation of the header has been disabled by default.
317See the variables `message-required-headers',
318`message-required-news-headers', and `message-required-mail-headers'.
319
320** Features from third party `message-utils.el' added to `message.el'.
321
322Message now asks if you wish to remove `(was: <old subject>)' from
323subject lines (see `message-subject-trailing-was-query'). `C-c M-m' and
324`C-c M-f' inserts markers indicating included text. `C-c C-f a' adds a
325X-No-Archive: header. `C-c C-f x' inserts appropriate headers and a
326note in the body for cross-postings and followups (see the variables
327`message-cross-post-*').
328
329** References and X-Draft-From headers are no longer generated when you
330start composing messages and `message-generate-headers-first' is `nil'.
331
332** Easy inclusion of X-Faces headers. *Note X-Face::.
333
334** Group Carbon Copy (GCC) quoting
335
336To support groups that contains SPC and other weird characters, groups
337are quoted before they are placed in the Gcc: header. This means
338variables such as `gnus-message-archive-group' should no longer contain
339quote characters to make groups containing SPC work. Also, if you are
340using the string `nnml:foo, nnml:bar' (indicating Gcc into two groups)
341you must change it to return the list `("nnml:foo" "nnml:bar")',
342otherwise the Gcc: line will be quoted incorrectly. Note that returning
343the string `nnml:foo, nnml:bar' was incorrect earlier, it just didn't
344generate any problems since it was inserted directly.
345
346** `message-insinuate-rmail'
347
348Adding `(message-insinuate-rmail)' and `(setq mail-user-agent
349'gnus-user-agent)' in `.emacs' convinces Rmail to compose, reply and
350forward messages in message-mode, where you can enjoy the power of MML.
351
352** `message-minibuffer-local-map'
353
354The line below enables BBDB in resending a message:
355(define-key message-minibuffer-local-map [(tab)]
356 'bbdb-complete-name)
357
358** `gnus-posting-styles'
359
360Add a new format of match like
361((header "to" "larsi.*org")
362 (Organization "Somewhere, Inc."))
363The old format like the lines below is obsolete, but still accepted.
364(header "to" "larsi.*org"
365 (Organization "Somewhere, Inc."))
366
367** `message-ignored-news-headers' and `message-ignored-mail-headers'
368
369`X-Draft-From' and `X-Gnus-Agent-Meta-Information' have been added into
370these two variables. If you customized those, perhaps you need add
371those two headers too.
372
373** Gnus supports the "format=flowed" (RFC 2646) parameter. On composing
374messages, it is enabled by `use-hard-newlines'. Decoding format=flowed
375was present but not documented in earlier versions.
376 110
377** The option `mm-fill-flowed' can be used to disable treatment of 111** The option `mm-fill-flowed' can be used to disable treatment of
378"format=flowed" messages. Also, flowed text is disabled when sending 112format=flowed messages. Also, flowed text is disabled when sending
379inline PGP signed messages. (New in Gnus 5.10.7) 113inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text.
114(New in Gnus 5.10.7)
380 115
381** Gnus supports the generation of RFC 2298 Disposition Notification
382requests.
383 116
384This is invoked with the `C-c M-n' key binding from message mode. 117
385 118* Changes in Message mode
386** Message supports the Importance: (RFC 2156) header.
387
388In the message buffer, `C-c C-f C-i' or `C-c C-u' cycles through the
389valid values.
390
391** Gnus supports Cancel Locks in News.
392
393This means a header `Cancel-Lock' is inserted in news posting. It is
394used to determine if you wrote an article or not (for canceling and
395superseding). Gnus generates a random password string the first time
396you post a message, and saves it in your `~/.emacs' using the Custom
397system. While the variable is called `canlock-password', it is not
398security sensitive data. Publishing your canlock string on the web will
399not allow anyone to be able to anything she could not already do. The
400behavior can be changed by customizing `message-insert-canlock'.
401 119
402** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and S/MIME 120** Gnus now supports the "hashcash" client puzzle anti-spam mechanism. Use
403(RFC 2630-2633). 121`(setq message-generate-hashcash t)' to enable. *Note Hashcash::.
404 122
405It needs an external S/MIME and OpenPGP implementation, but no 123** You can now drag and drop attachments to the Message buffer. See
406additional Lisp libraries. This add several menu items to the 124`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME:
407Attachments menu, and `C-c RET' key bindings, when composing messages. 125(message)MIME.
408This also obsoletes `gnus-article-hide-pgp-hook'.
409 126
410** MML (Mime compose) prefix changed from `M-m' to `C-c C-m'. 127** The option `message-yank-empty-prefix' now controls how empty lines are
128prefixed in cited text. *Note Insertion Variables: (message)Insertion
129Variables.
411 130
412This change was made to avoid conflict with the standard binding of 131** Gnus uses narrowing to hide headers in Message buffers. The
413`back-to-indentation', which is also useful in message mode. 132`References' header is hidden by default. To make all headers visible,
133use `(setq message-hidden-headers nil)'. *Note Message Headers:
134(message)Message Headers.
414 135
415** The default for `message-forward-show-mml' changed to the symbol `best'. 136** You can highlight different levels of citations like in the article
137buffer. See `gnus-message-highlight-citation'.
416 138
417The behavior for the `best' value is to show MML (i.e., convert to MIME) 139** `auto-fill-mode' is enabled by default in Message mode. See
418when appropriate. MML will not be used when forwarding signed or 140`message-fill-column'. *Note Message Headers: (message)Various Message
419encrypted messages, as the conversion invalidate the digital signature. 141Variables.
420 142
421** If `auto-compression-mode' is enabled, attachments are automatically 143** You can now store signature files in a special directory named
422decompressed when activated. 144`message-signature-directory'.
423 145
424** Support for non-ASCII domain names 146** The option `message-citation-line-format' controls the format of the
147"Whomever writes:" line. You need to set
148`message-citation-line-function' to
149`message-insert-formated-citation-line' as well.
425 150
426Message supports non-ASCII domain names in From:, To: and Cc: and will 151
427query you whether to perform encoding when you try to send a message. 152* Changes in back ends
428The variable `message-use-idna' controls this. Gnus will also decode
429non-ASCII domain names in From:, To: and Cc: when you view a message.
430The variable `gnus-use-idna' controls this.
431 153
432** You can now drag and drop attachments to the Message buffer. See 154** The nntp back end stores article marks in `~/News/marks'.
433`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME:
434(message)MIME.
435 155
156The directory can be changed using the (customizable) variable
157`nntp-marks-directory', and marks can be disabled using the (back end)
158variable `nntp-marks-is-evil'. The advantage of this is that you can
159copy `~/News/marks' (using rsync, scp or whatever) to another Gnus
160installation, and it will realize what articles you have read and
161marked. The data in `~/News/marks' has priority over the same data in
162`~/.newsrc.eld'.
436 163
437 164** You can import and export your RSS subscriptions from OPML files. *Note
438* Changes in back ends 165RSS::.
439 166
440** Gnus can display RSS newsfeeds as a newsgroup. *Note RSS::. 167** IMAP identity (RFC 2971) is supported.
441 168
442** The nndoc back end now supports mailman digests and exim bounces. 169By default, Gnus does not send any information about itself, but you can
170customize it using the variable `nnimap-id'.
443 171
444** Gnus supports Maildir groups. 172** The `nnrss' back end now supports multilingual text. Non-ASCII group
173names for the `nnrss' groups are also supported. *Note RSS::.
445 174
446Gnus includes a new back end `nnmaildir.el'. *Note Maildir::. 175** Retrieving mail with POP3 is supported over SSL/TLS and with StartTLS.
447 176
448** The nnml and nnfolder back ends store marks for each groups. 177** The nnml back end allows other compression programs beside `gzip' for
178compressed message files. *Note Mail Spool::.
449 179
450This makes it possible to take backup of nnml/nnfolder servers/groups 180** The nnml back end supports group compaction.
451separately of `~/.newsrc.eld', while preserving marks. It also makes it
452possible to share articles and marks between users (without sharing the
453`~/.newsrc.eld' file) within e.g. a department. It works by storing the
454marks stored in `~/.newsrc.eld' in a per-group file `.marks' (for nnml)
455and `GROUPNAME.mrk' (for nnfolder, named GROUPNAME). If the
456nnml/nnfolder is moved to another machine, Gnus will automatically use
457the `.marks' or `.mrk' file instead of the information in
458`~/.newsrc.eld'. The new server variables `nnml-marks-is-evil' and
459`nnfolder-marks-is-evil' can be used to disable this feature.
460 181
182This feature, accessible via the functions `gnus-group-compact-group'
183(`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the
184server buffer) renumbers all articles in a group, starting from 1 and
185removing gaps. As a consequence, you get a correct total article count
186(until messages are deleted again).
461 187
462 188
463* Appearance 189* Appearance
464 190
465** The menu bar item (in Group and Summary buffer) named "Misc" has been 191** The tool bar has been updated to use GNOME icons. You can also
466renamed to "Gnus". 192customize the tool bar. There's no documentation in the manual yet, but
467 193`M-x customize-apropos RET -tool-bar$' should get you started. (Only
468** The menu bar item (in Message mode) named "MML" has been renamed to 194for Emacs, not in XEmacs.)
469"Attachments". Note that this menu also contains security related
470stuff, like signing and encryption (*note Security: (message)Security.).
471
472** The tool bars have been updated to use GNOME icons in Group, Summary and
473Message mode. You can also customize the tool bars. This is a new
474feature in Gnus 5.10.9. (Only for Emacs, not in XEmacs.)
475 195
476** The tool bar icons are now (de)activated correctly in the group buffer, 196** The tool bar icons are now (de)activated correctly in the group buffer,
477see the variable `gnus-group-update-tool-bar'. Its default value 197see the variable `gnus-group-update-tool-bar'. Its default value
478depends on your Emacs version. This is a new feature in Gnus 5.10.9. 198depends on your Emacs version.
479
480
481* Miscellaneous changes
482 199
483** `gnus-agent' 200** You can change the location of XEmacs' toolbars in Gnus buffers. See
201`gnus-use-toolbar' and `message-use-toolbar'.
484 202
485The Gnus Agent has seen a major updated and is now enabled by default,
486and all nntp and nnimap servers from `gnus-select-method' and
487`gnus-secondary-select-method' are agentized by default. Earlier only
488the server in `gnus-select-method' was agentized by the default, and the
489agent was disabled by default. When the agent is enabled, headers are
490now also retrieved from the Agent cache instead of the back ends when
491possible. Earlier this only happened in the unplugged state. You can
492enroll or remove servers with `J a' and `J r' in the server buffer.
493Gnus will not download articles into the Agent cache, unless you
494instruct it to do so, though, by using `J u' or `J s' from the Group
495buffer. You revert to the old behavior of having the Agent disabled
496with `(setq gnus-agent nil)'. Note that putting `(gnus-agentize)' in
497`~/.gnus.el' is not needed any more.
498 203
499** Gnus reads the NOV and articles in the Agent if plugged. 204
500 205* Miscellaneous changes
501If one reads an article while plugged, and the article already exists in
502the Agent, it won't get downloaded once more. `(setq gnus-agent-cache
503nil)' reverts to the old behavior.
504
505** Dired integration
506
507`gnus-dired-minor-mode' (see *Note Other modes::) installs key bindings
508in dired buffers to send a file as an attachment, open a file using the
509appropriate mailcap entry, and print a file using the mailcap entry.
510
511** The format spec `%C' for positioning point has changed to `%*'.
512 206
513** `gnus-slave-unplugged' 207** Having edited the select-method for the foreign server in the server
208buffer is immediately reflected to the subscription of the groups which
209use the server in question. For instance, if you change
210`nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus
211will connect to the news host by way of the intermediate host
212`bar.example.com' from next time.
514 213
515A new command which starts Gnus offline in slave mode. 214** The `all.SCORE' file can be edited from the group buffer using `W e'.
516 215
517 216
518 217
diff --git a/etc/gnus/gnus-setup.ast b/etc/gnus/gnus-setup.ast
new file mode 100644
index 00000000000..2893c40b245
--- /dev/null
+++ b/etc/gnus/gnus-setup.ast
@@ -0,0 +1,51 @@
1@title Configuring Gnus for the first time
2
3@node What do you want to do with Gnus?
4
5@variable outbound (:radio ((item :tag "Send mail via sendmail" "sendmail") (item :tag "Send mail via SMTP" "smtp"))) "sendmail"
6
7@variable backends (:set ((item :tag "Read news via NNTP" "nntp") (item :tag "Read mail, store it locally" "nnml") (item :tag "Read mail and store it on an IMAP server" "nnimap"))) (list "nnml")
8@result primary-mail-selections (list backends outbound)
9
10@text
11Welcome to Gnus. You need to tell us what you want to do with Gnus
12before we go on to specific configurations.
13
14Choose the tasks you want to set up:
15@variable{backends}
16
17Choose the method Gnus will use to send mail:
18@variable{outbound}
19
20@end text
21
22@next (member "nnml" backends) "Setting up local mail storage (nnml)"
23@next (member "nntp" backends) "Setting up a NNTP server"
24
25@node Setting up local mail storage (nnml)
26@variable mechanism (:radio ((item :tag "Get mail from your Unix mbox" "mbox") (item :tag "Use POP3 to retrieve mail" "pop3"))) "mbox"
27@result nnml-mechanism (list mechanism)
28@text
29You are setting up local mail storage, using the nnml backend in Gnus terms.
30
31Your mail can be downloaded into Gnus in several ways, choose one:
32@variable{mechanism}
33
34@end text
35
36@node Setting up a NNTP server
37
38@text
39TODO: this will be a real link.
40Run M-x assistant and use the news-server.ast file as input.
41@end text
42
43
44@c Local variables:
45@c mode: texinfo
46@c End:
47
48@ignore
49 arch-tag: 6b7b200b-9169-4b44-8b32-b73773fa71af
50@end ignore
51
diff --git a/etc/gnus/news-server.ast b/etc/gnus/news-server.ast
new file mode 100644
index 00000000000..294f92382d9
--- /dev/null
+++ b/etc/gnus/news-server.ast
@@ -0,0 +1,64 @@
1@title Configuring Gnus for reading news
2
3
4@node Setting up the news server name and port number
5@variable server :string (gnus-getenv-nntpserver)
6@variable port :number 119
7@validate (assistant-validate-connect-to-server server port)
8@result gnus-select-method (list 'nntp server (list 'nntp-server port))
9@text
10Usenet news is usually read from your Internet service prodider's news
11server. If you don't know the name of this server, contact your ISP.
12
13As a guess, the name of the server might be news.yourisp.com.
14
15Server name: @variable{server}
16Port number: @variable{port}
17@end text
18@next t "User name and password"
19
20
21@node User name and password
22@type interstitial
23@next
24(if (assistant-password-required-p)
25 "Enter user name and password"
26 "Want user name and password?")
27@end next
28
29
30@node Want user name and password?
31@variable passwordp (:radio ((item "Yes") (item "No"))) "No"
32@text
33Some news servers require that you enter a user name and a password.
34It doesn't look like your news server is one of them.
35
36Do you want to enter user name and password anyway?
37
38@variable{passwordp}
39
40@end text
41
42@next (equal passwordp "No") finish
43@next (not (equal passwordp "No")) "Enter user name and password"
44
45
46@node Enter user name and password
47@variable user-name :string (user-login-name)
48@variable password :password (or (assistant-authinfo-data server port 'password) "")
49@text
50
51It looks like your news server requires you to enter a user name
52and a password:
53
54User name: @variable{user-name}
55Password: @variable{user-name}
56
57@end text
58
59@c Local variables:
60@c mode: texinfo
61@c End:
62
63@c arch tag is missing
64
diff --git a/etc/images/gnus/mail_send.xpm b/etc/images/gnus/mail_send.xpm
new file mode 100644
index 00000000000..f1d2282ec8a
--- /dev/null
+++ b/etc/images/gnus/mail_send.xpm
@@ -0,0 +1,39 @@
1/* XPM */
2static char *magick[] = {
3/* columns rows colors chars-per-pixel */
4"24 24 9 1",
5" c Gray0",
6". c #675e6580613e",
7"X c #8c8c7c7c6969",
8"o c #9b458d377822",
9"O c #a941a6459f3e",
10"+ c #c8c8b2b29898",
11"@ c #dadac2c2a5a5",
12"# c #eb4dea2fe4ad",
13"$ c None",
14/* pixels */
15"$$$$$$$$$$$$$$$$$$$$$$$$",
16"$$$$$$$$$$$$$$$$$$$$$$$$",
17"$$$$$$$$$$$$$ $$$$$$$",
18"$$$$$$$$ .@#+ $$$$$$",
19"$$$ .+#####@O $$$$$$",
20"$$ .+##########.+O $$$$$",
21"$$ @..########O.+# $$$$$",
22"$$ O@O..@#####.+## $$$$$",
23"$$$ ###+O.O##...##O $$$$",
24"$$$ @####@+..O#O.+# $$$$",
25"$$$ O####.#######.O $$$$",
26"$$$$ ###+O########.O $$$",
27"$$$$ ###.########@O $$$",
28"$$$$ +#+O#####@O $$$$$",
29"$$$$$ #.###@O $$$$$$",
30"$$$$$ .O@O $$ .. $$$$$",
31"$$$$$ .. $$$$ .oo. $$$$",
32"$$$$$$ $$$$$ oo $$$",
33"$$$$$$$$$$$$$$$ Oo $$$$$",
34"$$$$$$$$$$$$$$ oOOX $$$$",
35"$$$$$$$$$$$$$$ ++++ $$$$",
36"$$$$$$$$$$$$$ O@@@@O $$$",
37"$$$$$$$$$$$$$ $$$",
38"$$$$$$$$$$$$$$$$$$$$$$$$"
39};
diff --git a/etc/images/smilies/grayscale/blink.xpm b/etc/images/smilies/grayscale/blink.xpm
new file mode 100644
index 00000000000..eec7209f38b
--- /dev/null
+++ b/etc/images/smilies/grayscale/blink.xpm
@@ -0,0 +1,24 @@
1/* XPM */
2static char * blink_xpm[] = {
3"14 14 7 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #6E6E6E",
8"# c #515151",
9"$ c #ABABAB",
10"% c #737373",
11" ",
12" ",
13" . ",
14" + ",
15" @#$$# + ",
16" ++ + ",
17" ",
18" + + ",
19" $+ +$ ",
20" %+ +% ",
21" %++++% ",
22" $$$$ ",
23" ",
24" "};
diff --git a/etc/images/smilies/grayscale/braindamaged.xpm b/etc/images/smilies/grayscale/braindamaged.xpm
new file mode 100644
index 00000000000..cd47b32824a
--- /dev/null
+++ b/etc/images/smilies/grayscale/braindamaged.xpm
@@ -0,0 +1,23 @@
1/* XPM */
2static char * braindamaged_xpm[] = {
3"14 14 6 1",
4" c None",
5". c #ABABAB",
6"+ c #000000",
7"@ c #515151",
8"# c #171717",
9"$ c #737373",
10" ",
11" ",
12" .++..++. ",
13" +@.++.@+ ",
14" +.@#@@.+ ",
15" +@.#@.@+ ",
16" .++. ++. ",
17" + + ",
18" .+ +. ",
19" $+ +$ ",
20" $++++$ ",
21" .... ",
22" ",
23" "};
diff --git a/etc/images/smilies/grayscale/cry.xpm b/etc/images/smilies/grayscale/cry.xpm
new file mode 100644
index 00000000000..78bf6662d6b
--- /dev/null
+++ b/etc/images/smilies/grayscale/cry.xpm
@@ -0,0 +1,23 @@
1/* XPM */
2static char * cry_xpm[] = {
3"14 14 6 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #ABABAB",
8"# c #515151",
9"$ c #6E6E6E",
10" ",
11" ",
12" . ",
13" .. .+. ",
14" +++. +.+ ",
15" +@+ ",
16" @+# ",
17" @@ ",
18" $++++$ ",
19" .+@ @+. ",
20" @+@ @+@ ",
21" @ @ ",
22" ",
23" "};
diff --git a/etc/images/smilies/grayscale/dead.xpm b/etc/images/smilies/grayscale/dead.xpm
new file mode 100644
index 00000000000..9be9883c077
--- /dev/null
+++ b/etc/images/smilies/grayscale/dead.xpm
@@ -0,0 +1,21 @@
1/* XPM */
2static char * dead_xpm[] = {
3"14 14 4 1",
4" c None",
5". c #737373",
6"+ c #ABABAB",
7"@ c #000000",
8" ",
9" ",
10" .+ +. + +. ",
11" +@+@++@+@+ ",
12" +@ @+ ",
13" +@+@ @+@+ ",
14" + +. + + ",
15" ",
16" +@ @+ ",
17" .@ @. ",
18" .@@@@. ",
19" ++++ ",
20" ",
21" "};
diff --git a/etc/images/smilies/grayscale/evil.xpm b/etc/images/smilies/grayscale/evil.xpm
new file mode 100644
index 00000000000..e358cf89454
--- /dev/null
+++ b/etc/images/smilies/grayscale/evil.xpm
@@ -0,0 +1,23 @@
1/* XPM */
2static char * evil_xpm[] = {
3"14 14 6 1",
4" c None",
5". c #6E6E6E",
6"+ c #484848",
7"@ c #ABABAB",
8"# c #000000",
9"$ c #737373",
10" ",
11" ",
12" .+ +. ",
13" @# #@ ",
14" #+ @+# ",
15" #+ @+# ",
16" ",
17" # # ",
18" @# #@ ",
19" $# #$ ",
20" $####$ ",
21" @@@@ ",
22" ",
23" "};
diff --git a/etc/images/smilies/grayscale/forced.xpm b/etc/images/smilies/grayscale/forced.xpm
new file mode 100644
index 00000000000..095084569c4
--- /dev/null
+++ b/etc/images/smilies/grayscale/forced.xpm
@@ -0,0 +1,23 @@
1/* XPM */
2static char * forced_xpm[] = {
3"14 14 6 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #6E6E6E",
8"# c #ABABAB",
9"$ c #171717",
10" ",
11" ",
12" . . ",
13" + + ",
14" + + ",
15" + + ",
16" ",
17" @ @ ",
18" +# #+ ",
19" @@# #@@ ",
20" #$++++++$# ",
21" ######## ",
22" ",
23" "};
diff --git a/etc/images/smilies/grayscale/frown.xpm b/etc/images/smilies/grayscale/frown.xpm
new file mode 100644
index 00000000000..b513f4c92fd
--- /dev/null
+++ b/etc/images/smilies/grayscale/frown.xpm
@@ -0,0 +1,22 @@
1/* XPM */
2static char * frown_xpm[] = {
3"14 14 5 1",
4" c None",
5". c #6E6E6E",
6"+ c #484848",
7"@ c #ABABAB",
8"# c #000000",
9" ",
10" ",
11" .+ +. ",
12" @# #@ ",
13" #+ @+# ",
14" #+@@+# ",
15" ",
16" @@ ",
17" .####. ",
18" +#@ @#+ ",
19" @#@ @#@ ",
20" + + ",
21" ",
22" "};
diff --git a/etc/images/smilies/grayscale/grin.xpm b/etc/images/smilies/grayscale/grin.xpm
new file mode 100644
index 00000000000..f6e45882a46
--- /dev/null
+++ b/etc/images/smilies/grayscale/grin.xpm
@@ -0,0 +1,25 @@
1/* XPM */
2static char * grin_xpm[] = {
3"14 14 8 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #515151",
8"# c #6E6E6E",
9"$ c #ABABAB",
10"% c #FFFFFF",
11"& c #737373",
12" ",
13" ",
14" . . ",
15" + + ",
16" + + ",
17" + + ",
18" ",
19" ++@@##@@++ ",
20" $+%%%%%%+$ ",
21" &+%%%%+& ",
22" &++++& ",
23" $$$$ ",
24" ",
25" "};
diff --git a/etc/images/smilies/grayscale/indifferent.xpm b/etc/images/smilies/grayscale/indifferent.xpm
new file mode 100644
index 00000000000..1e4f69e0f4f
--- /dev/null
+++ b/etc/images/smilies/grayscale/indifferent.xpm
@@ -0,0 +1,23 @@
1/* XPM */
2static char * indifferent_xpm[] = {
3"14 14 6 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #515151",
8"# c #ABABAB",
9"$ c #6E6E6E",
10" ",
11" ",
12" . . ",
13" + + ",
14" + + ",
15" + + ",
16" ",
17" @ #@ ",
18"#+$+$ $ + ",
19"$ +#+$#++$+$ ",
20" $ ++# ++ ",
21" + ",
22" ",
23" "};
diff --git a/etc/images/smilies/grayscale/reverse-smile.xpm b/etc/images/smilies/grayscale/reverse-smile.xpm
new file mode 100644
index 00000000000..a62eab0481c
--- /dev/null
+++ b/etc/images/smilies/grayscale/reverse-smile.xpm
@@ -0,0 +1,22 @@
1/* XPM */
2static char * reverse_smile_xpm[] = {
3"14 14 5 1",
4" c None",
5". c #ABABAB",
6"+ c #737373",
7"@ c #000000",
8"# c #484848",
9" ",
10" ",
11" .... ",
12" +@@@@+ ",
13" +@ @+ ",
14" .@ @. ",
15" @ @ ",
16" ",
17" @ @ ",
18" @ @ ",
19" @ @ ",
20" # # ",
21" ",
22" "};
diff --git a/etc/images/smilies/grayscale/sad.xpm b/etc/images/smilies/grayscale/sad.xpm
new file mode 100644
index 00000000000..3addb6b6b5a
--- /dev/null
+++ b/etc/images/smilies/grayscale/sad.xpm
@@ -0,0 +1,22 @@
1/* XPM */
2static char * sad_xpm[] = {
3"14 14 5 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #ABABAB",
8"# c #6E6E6E",
9" ",
10" ",
11" . . ",
12" + + ",
13" + + ",
14" + + ",
15" ",
16" @@@@ ",
17" #++++# ",
18" .+@ @+. ",
19" @+@ @+@ ",
20" . . ",
21" ",
22" "};
diff --git a/etc/images/smilies/grayscale/smile.xpm b/etc/images/smilies/grayscale/smile.xpm
new file mode 100644
index 00000000000..463785e6d4c
--- /dev/null
+++ b/etc/images/smilies/grayscale/smile.xpm
@@ -0,0 +1,22 @@
1/* XPM */
2static char * smile_xpm[] = {
3"14 14 5 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #ABABAB",
8"# c #737373",
9" ",
10" ",
11" . . ",
12" + + ",
13" + + ",
14" + + ",
15" ",
16" + + ",
17" @+ +@ ",
18" #+ +# ",
19" #++++# ",
20" @@@@ ",
21" ",
22" "};
diff --git a/etc/images/smilies/grayscale/wry.xpm b/etc/images/smilies/grayscale/wry.xpm
new file mode 100644
index 00000000000..79e29792ef0
--- /dev/null
+++ b/etc/images/smilies/grayscale/wry.xpm
@@ -0,0 +1,23 @@
1/* XPM */
2static char * wry_xpm[] = {
3"14 14 6 1",
4" c None",
5". c #484848",
6"+ c #000000",
7"@ c #515151",
8"# c #ABABAB",
9"$ c #6E6E6E",
10" ",
11" ",
12" . . ",
13" + + ",
14" + + ",
15" + + ",
16" ",
17" @ ",
18" ## $@ ",
19" #++++++# ",
20" @$ ## ",
21" @ ",
22" ",
23" "};
diff --git a/etc/images/smilies/medium/blink.xpm b/etc/images/smilies/medium/blink.xpm
new file mode 100644
index 00000000000..9bd48f7874b
--- /dev/null
+++ b/etc/images/smilies/medium/blink.xpm
@@ -0,0 +1,29 @@
1/* XPM */
2static char * blink_xpm[] = {
3"16 16 10 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13"= c #8F7B00",
14" ...... ",
15" .+@#$$#@+. ",
16" .%$&&&&&&$%. ",
17" .%&&&&&&&*&&%. ",
18" +$&&&&&&&.&&$+ ",
19".@&@%##%&&.&&&@.",
20".#&&&..&&&.&&&#.",
21".$&&&&&&&&&&&&$.",
22".$&.&&&&&&&&.&$.",
23".#&#.&&&&&&.#&#.",
24".@&&=.&&&&.=&&@.",
25" +$&&=....=&&$+ ",
26" .%&&&&&&&&&&%. ",
27" .%$&&&&&&$%. ",
28" .+@#$$#@+. ",
29" ...... "};
diff --git a/etc/images/smilies/medium/braindamaged.xpm b/etc/images/smilies/medium/braindamaged.xpm
new file mode 100644
index 00000000000..e42259de920
--- /dev/null
+++ b/etc/images/smilies/medium/braindamaged.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * braindamaged_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #8F7B00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&#..##..#&%. ",
17" +$&.%#..#%.&$+ ",
18".@&&.#%+%%#.&&@.",
19".#&&.%#+%#%.&&#.",
20".$&&#..#&..#&&$.",
21".$&.&&&&&&&&.&$.",
22".#&#.&&&&&&.#&#.",
23".@&&*.&&&&.*&&@.",
24" +$&&*....*&&$+ ",
25" .%&&&&&&&&&&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/cry.xpm b/etc/images/smilies/medium/cry.xpm
new file mode 100644
index 00000000000..e7358ad11f2
--- /dev/null
+++ b/etc/images/smilies/medium/cry.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * cry_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&&&&&&&*&&%. ",
17" +$&&**&&*.*&$+ ",
18".@&&...*&.*.&&@.",
19".#&&&&&&&.#.&&#.",
20".$&&&&&&&#.%&&$.",
21".$&&&&&&&&&&&&$.",
22".#&&&@....@&&&#.",
23".@&&*.#&&#.*&&@.",
24" +$#.#&&&&#.#$+ ",
25" .%&*&&&&&&*&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/dead.xpm b/etc/images/smilies/medium/dead.xpm
new file mode 100644
index 00000000000..1d8fe12d2fa
--- /dev/null
+++ b/etc/images/smilies/medium/dead.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * dead_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #8F7B00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%*#&#*$#&#*%. ",
17" +$#.#.##.#.#$+ ",
18".@&&#.$&&$.#&&@.",
19".#&#.#.$$.#.#&#.",
20".$&*#&#*$#&#*&$.",
21".$&.&&&&&&&&.&$.",
22".#&#.&&&&&&.#&#.",
23".@&&*.&&&&.*&&@.",
24" +$&&*....*&&$+ ",
25" .%&&&&&&&&&&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/evil.xpm b/etc/images/smilies/medium/evil.xpm
new file mode 100644
index 00000000000..b7a18f8cd62
--- /dev/null
+++ b/etc/images/smilies/medium/evil.xpm
@@ -0,0 +1,29 @@
1/* XPM */
2static char * evil_xpm[] = {
3"16 16 10 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13"= c #8F7B00",
14" ...... ",
15" .+@#$$#@+. ",
16" .%$&&&&&&$%. ",
17" .%&@*&&&&*@&%. ",
18" +$&#.&&&&.#&$+ ",
19".@&&&.*&#*.&&&@.",
20".#&&&.*##*.&&&#.",
21".$&&&&&&&&&&&&$.",
22".$&.&&&&&&&&.&$.",
23".#&#.&&&&&&.#&#.",
24".@&&=.&&&&.=&&@.",
25" +$&&=....=&&$+ ",
26" .%&&&&&&&&&&%. ",
27" .%$&&&&&&$%. ",
28" .+@#$$#@+. ",
29" ...... "};
diff --git a/etc/images/smilies/medium/forced.xpm b/etc/images/smilies/medium/forced.xpm
new file mode 100644
index 00000000000..df52a7eb862
--- /dev/null
+++ b/etc/images/smilies/medium/forced.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * forced_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&&*&&&&*&&%. ",
17" +$&&.&&&&.&&$+ ",
18".@&&&.&&&&.&&&@.",
19".#&&&.&&&&.&&&#.",
20".$&&&&&&&&&&&&$.",
21".$&@&&&&&&&&@&$.",
22".#&.#&&&&&&#.&#.",
23".@&@@#&&&&#@@&@.",
24" +$#+......+#$+ ",
25" .%&&&&&&&&&&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/frown.xpm b/etc/images/smilies/medium/frown.xpm
new file mode 100644
index 00000000000..e4573ed5a37
--- /dev/null
+++ b/etc/images/smilies/medium/frown.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * frown_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&@*&&&&*@&%. ",
17" +$&#.&&&&.#&$+ ",
18".@&&&.*&#*.&&&@.",
19".#&&&.*##*.&&&#.",
20".$&&&&&&&&&&&&$.",
21".$&&&&&&&&&&&&$.",
22".#&&&@....@&&&#.",
23".@&&*.#&&#.*&&@.",
24" +$#.#&&&&#.#$+ ",
25" .%&*&&&&&&*&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/grin.xpm b/etc/images/smilies/medium/grin.xpm
new file mode 100644
index 00000000000..d8db415a14f
--- /dev/null
+++ b/etc/images/smilies/medium/grin.xpm
@@ -0,0 +1,30 @@
1/* XPM */
2static char * grin_xpm[] = {
3"16 16 11 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13"= c #FFFFFF",
14"- c #8F7B00",
15" ...... ",
16" .+@#$$#@+. ",
17" .%$&&&&&&$%. ",
18" .%&&*&&&&*&&%. ",
19" +$&&.&&&&.&&$+ ",
20".@&&&.&&&&.&&&@.",
21".#&&&.&&&&.&&&#.",
22".$&&&&&&&&&&&&$.",
23".$&..%%@@%%..&$.",
24".#&#.======.#&#.",
25".@&&-.====.-&&@.",
26" +$&&-....-&&$+ ",
27" .%&&&&&&&&&&%. ",
28" .%$&&&&&&$%. ",
29" .+@#$$#@+. ",
30" ...... "};
diff --git a/etc/images/smilies/medium/indifferent.xpm b/etc/images/smilies/medium/indifferent.xpm
new file mode 100644
index 00000000000..98519c3bdd2
--- /dev/null
+++ b/etc/images/smilies/medium/indifferent.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * indifferent_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&&*&&&&*&&%. ",
17" +$&&.&&&&.&&$+ ",
18".@&&&.&&&&.&&&@.",
19".#&&&.&&&&.&&&#.",
20".$&&&&&&&&&&&&$.",
21".$%&&&&&&&&&#%$.",
22".#.@.@&&&@&&.&#.",
23".@&.#.@#..@.@&@.",
24" +$@&&..#&..&$+ ",
25" .%&&&&.&&&&&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/reverse-smile.xpm b/etc/images/smilies/medium/reverse-smile.xpm
new file mode 100644
index 00000000000..9641c333033
--- /dev/null
+++ b/etc/images/smilies/medium/reverse-smile.xpm
@@ -0,0 +1,29 @@
1/* XPM */
2static char * reverse_smile_xpm[] = {
3"16 16 10 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #8F7B00",
13"= c #594D00",
14" ...... ",
15" .+@#$$#@+. ",
16" .%$&&&&&&$%. ",
17" .%&&&&&&&&&&%. ",
18" +$&&*....*&&$+ ",
19".@&&*.&&&&.*&&@.",
20".#&#.&&&&&&.#&#.",
21".$&.&&&&&&&&.&$.",
22".$&&&&&&&&&&&&$.",
23".#&&&.&&&&.&&&#.",
24".@&&&.&&&&.&&&@.",
25" +$&&.&&&&.&&$+ ",
26" .%&&=&&&&=&&%. ",
27" .%$&&&&&&$%. ",
28" .+@#$$#@+. ",
29" ...... "};
diff --git a/etc/images/smilies/medium/sad.xpm b/etc/images/smilies/medium/sad.xpm
new file mode 100644
index 00000000000..bc635c12dbe
--- /dev/null
+++ b/etc/images/smilies/medium/sad.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * sad_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&&*&&&&*&&%. ",
17" +$&&.&&&&.&&$+ ",
18".@&&&.&&&&.&&&@.",
19".#&&&.&&&&.&&&#.",
20".$&&&&&&&&&&&&$.",
21".$&&&&&&&&&&&&$.",
22".#&&&@....@&&&#.",
23".@&&*.#&&#.*&&@.",
24" +$#.#&&&&#.#$+ ",
25" .%&*&&&&&&*&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/images/smilies/medium/smile.xpm b/etc/images/smilies/medium/smile.xpm
new file mode 100644
index 00000000000..b08129b8ed0
--- /dev/null
+++ b/etc/images/smilies/medium/smile.xpm
@@ -0,0 +1,29 @@
1/* XPM */
2static char * smile_xpm[] = {
3"16 16 10 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13"= c #8F7B00",
14" ...... ",
15" .+@#$$#@+. ",
16" .%$&&&&&&$%. ",
17" .%&&*&&&&*&&%. ",
18" +$&&.&&&&.&&$+ ",
19".@&&&.&&&&.&&&@.",
20".#&&&.&&&&.&&&#.",
21".$&&&&&&&&&&&&$.",
22".$&.&&&&&&&&.&$.",
23".#&#.&&&&&&.#&#.",
24".@&&=.&&&&.=&&@.",
25" +$&&=....=&&$+ ",
26" .%&&&&&&&&&&%. ",
27" .%$&&&&&&$%. ",
28" .+@#$$#@+. ",
29" ...... "};
diff --git a/etc/images/smilies/medium/wry.xpm b/etc/images/smilies/medium/wry.xpm
new file mode 100644
index 00000000000..3bc841b49ce
--- /dev/null
+++ b/etc/images/smilies/medium/wry.xpm
@@ -0,0 +1,28 @@
1/* XPM */
2static char * wry_xpm[] = {
3"16 16 9 1",
4" c None",
5". c #000000",
6"+ c #1D1900",
7"@ c #887500",
8"# c #D3B600",
9"$ c #FAD800",
10"% c #645600",
11"& c #FFDD00",
12"* c #594D00",
13" ...... ",
14" .+@#$$#@+. ",
15" .%$&&&&&&$%. ",
16" .%&&*&&&&*&&%. ",
17" +$&&.&&&&.&&$+ ",
18".@&&&.&&&&.&&&@.",
19".#&&&.&&&&.&&&#.",
20".$&&&&&&&&&&&&$.",
21".$&&&&&&&&&%&&$.",
22".#&&&&&&&&@%&&#.",
23".@&&#......#&&@.",
24" +$&%@&&&&&&&$+ ",
25" .%&%&&&&&&&&%. ",
26" .%$&&&&&&$%. ",
27" .+@#$$#@+. ",
28" ...... "};
diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex
index 4bd03ad4f77..3f6ecabd33e 100644
--- a/etc/refcards/gnus-refcard.tex
+++ b/etc/refcards/gnus-refcard.tex
@@ -121,7 +121,12 @@
121\newcommand{\Copyright}{% 121\newcommand{\Copyright}{%
122 \begin{center} 122 \begin{center}
123 Copyright \copyright\ 1995, 2000, 2002, 2003, 2004, 123 Copyright \copyright\ 1995, 2000, 2002, 2003, 2004,
124 2005, 2006, 2007 Free Software Foundation, Inc. 124 2005, 2006, 2007 Free Software Foundation, Inc.\\*
125 Copyright \copyright\ 2001, 2002, 2003, 2004, 2005 \author.\\*
126 Created from the Gnus manual Copyright \copyright\ 1994 Lars Magne
127 Ingebrigtsen.\\*
128 and the Emacs Help Bindings feature (C-h b).\\*
129 Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\*
125 \end{center} 130 \end{center}
126 131
127 Permission is granted to make and distribute copies of this reference 132 Permission is granted to make and distribute copies of this reference
@@ -566,7 +571,7 @@
566 {\esamepage 571 {\esamepage
567 \begin{keys}{C-c C-s C-a} 572 \begin{keys}{C-c C-s C-a}
568 C-c C-s C-a & Sort the summary-buffer by {\bf author}.\\ 573 C-c C-s C-a & Sort the summary-buffer by {\bf author}.\\
569 % C-c C-s C-t & Sort the summary-buffer by {\bf recipient}.\\ % No Gnus 574 C-c C-s C-t & Sort the summary-buffer by {\bf recipient}.\\
570 C-c C-s C-d & Sort the summary-buffer by {\bf date}.\\ 575 C-c C-s C-d & Sort the summary-buffer by {\bf date}.\\
571 C-c C-s C-i & Sort the summary-buffer by article score.\\ 576 C-c C-s C-i & Sort the summary-buffer by article score.\\
572 C-c C-s C-l & Sort the summary-buffer by amount of {\bf lines}.\\ 577 C-c C-s C-l & Sort the summary-buffer by amount of {\bf lines}.\\
@@ -876,6 +881,7 @@
876 \begin{keys}{/M} 881 \begin{keys}{/M}
877 // & (/s) Limit the summary-buffer to articles matching {\bf subject}.\\ 882 // & (/s) Limit the summary-buffer to articles matching {\bf subject}.\\
878 /a & Limit the summary-buffer to articles matching {\bf author}.\\ 883 /a & Limit the summary-buffer to articles matching {\bf author}.\\
884 /R & Limit the summary-buffer to articles matching {\bf recipient}.\\
879 /x & Limit depending on ``extra'' headers.\\ 885 /x & Limit depending on ``extra'' headers.\\
880 /u & (x) Limit to {\bf unread} articles. 886 /u & (x) Limit to {\bf unread} articles.
881 [Prefix: also exclude ticked and dormant articles]\\ 887 [Prefix: also exclude ticked and dormant articles]\\
@@ -900,7 +906,7 @@
900 /o & Insert all {\bf old} articles. [Prefix: how many]\\ 906 /o & Insert all {\bf old} articles. [Prefix: how many]\\
901 /N & Insert all {\bf new} articles.\\ 907 /N & Insert all {\bf new} articles.\\
902 /p & Limit to articles {\bf predicated} in the `display' group parameter.\\ 908 /p & Limit to articles {\bf predicated} in the `display' group parameter.\\
903 % /r & Limit to {\bf replied} articles. [Prefix: unreplied]\\ % No Gnus 909 /r & Limit to {\bf replied} articles. [Prefix: unreplied]\\
904 \end{keys} 910 \end{keys}
905 } 911 }
906 } 912 }
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index de0af040849..1759e8ccfce 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,98 @@
12007-10-28 Miles Bader <miles@gnu.org>
2
3 * nnheader.el (nnheader-uniquify-message-id): Make sure this is defined
4 at compile-time too.
5
62007-10-26 Reiner Steib <Reiner.Steib@gmx.de>
7
8 * message.el (message-remove-blank-cited-lines): New function.
9 Suggested by Karl Pl,Ad(Bsterer.
10
112007-10-25 Katsumi Yamaoka <yamaoka@jpl.org>
12
13 * hashcash.el (mail-add-payment): Replace mapcar called for effect with
14 mapc.
15
16 * imap.el (imap-open): Replace mapcar called for effect with mapc.
17 (top-level): Use mapc to set functions to be traced for debugging.
18
19 * legacy-gnus-agent.el (gnus-agent-convert-agentview): Replace mapcar
20 called for effect with while loop.
21
22 * message.el (message-talkative-question): Replace mapcar called for
23 effect with mapc.
24
25 * mm-util.el: Use mapc instead of mapcar to make compatible functions.
26 (mm-find-mime-charset-region, mm-find-charset-region): Replace mapcar
27 called for effect with dolist.
28
29 * mml.el (mml-insert-mime): Replace mapcar called for effect with mapc.
30
31 * nndiary.el: Use dolist instead of mapcar to add diary headers to
32 gnus-extra-headers and nnmail-extra-headers.
33
34 * nnimap.el (nnimap-request-update-info-internal): Replace mapcar
35 called for effect with dolist.
36 (top-level): Use mapc to set functions to be traced for debugging.
37
38 * nnmail.el (nnmail-read-incoming-hook): Doc fix.
39 (nnmail-split-fancy-with-parent): Replace mapcar called for effect with
40 dolist.
41
42 * nnmaildir.el (nnmaildir--delete-dir-files, nnmaildir-request-close):
43 Replace mapcar called for effect with mapc.
44 (nnmaildir--scan, nnmaildir-request-scan, nnmaildir-retrieve-groups)
45 (nnmaildir-request-update-info, nnmaildir-request-delete-group)
46 (nnmaildir-retrieve-headers, nnmaildir-request-set-mark)
47 (nnmaildir-close-group): Replace mapcar called for effect with dolist.
48
49 * nnrss.el (nnrss-make-hash-index): Use gnus-remove-if instead of
50 remove-if that's a cl function.
51
52 * webmail.el (webmail-debug): Replace mapcar called for effect with
53 dolist.
54
55 * gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect
56 with mapc.
57
582007-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
59
60 * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist)
61 (gnus-agent-expire-unagentized-dirs): Replace mapcar called for effect
62 with while loop.
63
64 * gnus-art.el: Use mapc instead of mapcar to make gnus-article-*
65 functions from article-* functions.
66 (gnus-multi-decode-header): Replace mapcar called for effect with
67 dolist.
68
69 * gnus-bookmark.el (gnus-bookmark-bmenu-list)
70 (gnus-bookmark-show-details): Replace mapcar called for effect with
71 while loop.
72
73 * gnus-diary.el (gnus-diary-update-group-parameters): Replace mapcar
74 called for effect with while loop.
75
76 * gnus-group.el (gnus-group-suspend): Replace mapcar called for effect
77 with dolist.
78
79 * gnus-registry.el (gnus-registry-split-fancy-with-parent): Replace
80 mapcar called for effect with dolist.
81
82 * gnus-spec.el (gnus-correct-length): Make it simple and fast.
83
84 * gnus-sum.el (gnus-multi-decode-encoded-word-string)
85 (gnus-build-sparse-threads, gnus-summary-limit-include-expunged):
86 Replace mapcar called for effect with dolist.
87 (gnus-simplify-buffer-fuzzy): Replace mapcar called for effect with
88 mapc.
89
90 * gnus-topic.el (gnus-topic-find-groups, gnus-topic-move-group):
91 Replace mapcar called for effect with dolist.
92 (gnus-topic-list): Replace mapcar called for effect with mapc.
93
94 * gnus.el: Use mapc instead of mapcar to add autoloads.
95
12007-10-23 Richard Stallman <rms@gnu.org> 962007-10-23 Richard Stallman <rms@gnu.org>
2 97
3 * gnus-group.el (gnus-group-highlight): Mark as risky. 98 * gnus-group.el (gnus-group-highlight): Mark as risky.
@@ -7,6 +102,17 @@
7 * gnus.el (gnus-server-to-method): Return method found first in 102 * gnus.el (gnus-server-to-method): Return method found first in
8 gnus-newsrc-alist. 103 gnus-newsrc-alist.
9 104
105 * gnus-art.el (gnus-article-highlight-signature)
106 (gnus-insert-prev-page-button, gnus-insert-next-page-button): Make a
107 button overlay without the front stickiness.
108
1092007-10-22 Kevin Greiner <kevin.greiner@compsol.cc>
110
111 * gnus-agent.el (gnus-agent-expire-group-1): The check for an unsorted
112 overview buffer needed a catch to receive its throw.
113 (gnus-agent-flush-cache): Declared as interactive to make this function
114 easier to use.
115
102007-10-20 Reiner Steib <Reiner.Steib@gmx.de> 1162007-10-20 Reiner Steib <Reiner.Steib@gmx.de>
11 117
12 * html2text.el (html2text-fix-paragraph): Use `forward-line' instead of 118 * html2text.el (html2text-fix-paragraph): Use `forward-line' instead of
@@ -22,13 +128,26 @@
22 * gnus-util.el (gnus-string<): New function. 128 * gnus-util.el (gnus-string<): New function.
23 129
24 * gnus-sum.el (gnus-article-sort-by-author) 130 * gnus-sum.el (gnus-article-sort-by-author)
25 (gnus-article-sort-by-subject): Use it. 131 (gnus-article-sort-by-recipient, gnus-article-sort-by-subject): Use it.
26 132
272007-10-15 Katsumi Yamaoka <yamaoka@jpl.org> 1332007-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
28 134
29 * gnus-win.el (gnus-configure-windows): Focus on the frame for which 135 * gnus-win.el (gnus-configure-windows): Focus on the frame for which
30 the frame-focus tag is set in gnus-buffer-configuration. 136 the frame-focus tag is set in gnus-buffer-configuration.
31 137
1382007-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
139
140 * gnus-art.el (gnus-article-add-button): Make a button overlay without
141 the front stickiness.
142
1432007-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
144
145 * gnus-art.el (gnus-button-alist): Exclude newline in RFC2396-compliant
146 url pattern; remove duplicate one.
147 (gnus-article-extend-url-button): New function.
148 (gnus-article-add-buttons): Use it.
149 (gnus-button-push): Use concatenated url that it makes.
150
322007-10-04 Juanma Barranquero <lekktu@gmail.com> 1512007-10-04 Juanma Barranquero <lekktu@gmail.com>
33 152
34 * sieve-manage.el (sieve-manage-interactive-login): Doc fix. 153 * sieve-manage.el (sieve-manage-interactive-login): Doc fix.
@@ -48,11 +167,50 @@
482007-10-08 Reiner Steib <Reiner.Steib@gmx.de> 1672007-10-08 Reiner Steib <Reiner.Steib@gmx.de>
49 168
50 * mm-util.el (mm-charset-synonym-alist): Alias gbk to cp936. 169 * mm-util.el (mm-charset-synonym-alist): Alias gbk to cp936.
170 Fix comment about "iso8859-1".
171
1722007-10-08 Daiki Ueno <ueno@unixuser.org>
173
174 * mm-decode.el (mm-possibly-verify-or-decrypt): Replace PARTS with the
175 ones returned from the verify-function.
176
177 * mm-uu.el (mm-uu-pgp-signed-extract-1): Call
178 mml2015-extract-cleartext-signature if extraction failed.
179
1802007-10-07 Daiki Ueno <ueno@unixuser.org>
181
182 * mm-uu.el (mm-uu-pgp-signed-extract-1): Delete the first line
183 beginning with "-----BEGIN PGP SIGNED MESSAGE-----" if extraction
184 failed.
51 185
522007-10-04 Reiner Steib <Reiner.Steib@gmx.de> 1862007-10-04 Reiner Steib <Reiner.Steib@gmx.de>
53 187
54 * Relicense "GPLv2 or later" files to "GPLv3 or later". 188 * Relicense "GPLv2 or later" files to "GPLv3 or later".
55 189
1902007-09-27 Teodor Zlatanov <tzz@lifelogs.com>
191
192 * gnus-sum.el (gnus-summary-kill-thread): Allow universal prefix zero
193 to mark a thread as expirable. Add variable `hide' to handle hiding of
194 thread for both the null and zero (kill/expire thread) universal prefix
195 cases.
196 (gnus-summary-expire-thread): Add new function to expire a thread,
197 using gnus-summary-kill-thread.
198 (gnus-summary-mode-map, gnus-summary-thread-map): Add 'M-C-e' and 'T e'
199 shortcuts for gnus-summary-expire-thread.
200 (gnus-summary-mode-map, gnus-summary-thread-map): Remove `M-C-e' and `T
201 e' bindings for gnus-summary-expire-thread. Add `T E' binding.
202
2032007-09-25 Teodor Zlatanov <tzz@lifelogs.com>
204
205 * gnus-registry.el (gnus-registry-store-extra-entry): Allow for nil
206 extras value, so an extras entry can be deleted.
207 (gnus-registry-delete-extra-entry): Use it.
208 (gnus-registry-fetch-extra-flags, gnus-registry-has-extra-flag)
209 (gnus-registry-store-extra-flags, gnus-registry-delete-extra-flags)
210 (gnus-registry-delete-all-extra-flags): Allow for arbitrary flag symbol
211 storage through the gnus-registry, and provide an appropriate API for
212 it.
213
562007-09-13 Katsumi Yamaoka <yamaoka@jpl.org> 2142007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
57 215
58 * gnus-sum.el (gnus-newsgroup-maximum-articles): Move from gnus.el. 216 * gnus-sum.el (gnus-newsgroup-maximum-articles): Move from gnus.el.
@@ -84,14 +242,73 @@
84 (nnmbox-save-mail): Quote lines looking like delimiters at the right 242 (nnmbox-save-mail): Quote lines looking like delimiters at the right
85 positions; make sure article ends with newline. 243 positions; make sure article ends with newline.
86 244
245 * message.el (message-display-abbrev): Don't infloop when a user
246 inserts SPC in the beginning of header.
247
2482007-09-12 Teodor Zlatanov <tzz@lifelogs.com>
249
250 * gnus-registry.el (gnus-registry-unfollowed-groups): Add INBOX to the
251 list of groups not followed by default. Fix type to be regexp.
252 (gnus-registry-grep-in-list): Fix inverted parameters to string-match.
253
2542007-09-06 Tassilo Horn <tassilo@member.fsf.org>
255
256 * hmac-def.el (define-hmac-function): Switch from old-style to
257 new-style backquotes.
258
259 * md4.el (md4-make-step): likewise.
260
2612007-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
262
263 * gnus-start.el (gnus-gnus-to-newsrc-format): Use a unibyte buffer and
264 raw-text coding system when saving .newsrc file, which may contain
265 non-ASCII group names.
266
872007-09-05 Katsumi Yamaoka <yamaoka@jpl.org> 2672007-09-05 Katsumi Yamaoka <yamaoka@jpl.org>
88 268
89 * gnus-cus.el (gnus-score-extra): New widget. 269 * gnus-cus.el (gnus-score-extra): New widget.
90 (gnus-score-extra-convert): New function. 270 (gnus-score-extra-convert): New function.
91 (gnus-score-customize): Use it for Extra. 271 (gnus-score-customize): Use it for Extra.
92 272
2732007-08-31 Daiki Ueno <ueno@unixuser.org>
274
275 * mml2015.el (mml2015-extract-cleartext-signature): New function.
276 (mml2015-mailcrypt-clear-verify): Use it.
277 (mml2015-gpg-clear-verify): Use it.
278 (mml2015-pgg-clear-verify): Use it.
279 (mml2015-epg-clear-verify): Replace the current part with the output
280 from GnuPG; don't extract the plaintext by itself.
281
282 * mm-uu.el (mm-uu-pgp-beginning-signature): Abolish.
283 (mm-uu-pgp-signed-extract-1): Bind coding-system-for-read when calling
284 mml2015-clear-verify-function; don't touch the armor headers or
285 dash-escaped text here.
286
2872007-08-24 Katsumi Yamaoka <yamaoka@jpl.org>
288
289 * gnus-art.el (gnus-article-edit-part): Don't jump to nonexistent part.
290 (gnus-mime-view-part-as-type-internal): Default to text/plain for text
291 parts, or application/octet-stream as a last resort.
292 (gnus-mime-view-part-as-type): Don't toggle display.
293 (gnus-mime-view-part-as-charset): Don't turn off display before
294 querying charset.
295
296 * mm-view.el (mm-inline-text-html-render-with-w3): Don't add XEmacs
297 stuff to undisplayer function in Emacs.
298 (mm-inline-text-html-render-with-w3m): Remove Emacs/W3 stuff.
299
300 * mml.el (mml-generate-mime-1): Prefer utf-8 when encoding
301 text/calendar parts.
302
932007-08-23 Katsumi Yamaoka <yamaoka@jpl.org> 3032007-08-23 Katsumi Yamaoka <yamaoka@jpl.org>
94 304
305 * gnus-art.el (gnus-mime-display-single): Use utf-8 by default for
306 decoding text/calendar parts.
307
308 * message.el (message-forward-make-body-mime): Always mark body as
309 having no illegible text; remove signed-or-encrypted argument.
310 (message-forward-make-body): Don't pass signed-or-encrypted arg to it.
311
95 * mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer. 312 * mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer.
96 (mml-generate-mime-1): Don't encode body if it is specified to be in 313 (mml-generate-mime-1): Don't encode body if it is specified to be in
97 raw form; don't make buffer be unibyte when inserting multibyte string. 314 raw form; don't make buffer be unibyte when inserting multibyte string.
@@ -110,6 +327,14 @@
110 327
1112007-08-17 Katsumi Yamaoka <yamaoka@jpl.org> 3282007-08-17 Katsumi Yamaoka <yamaoka@jpl.org>
112 329
330 * imap.el (imap-logout-timeout): New variable.
331 (imap-logout, imap-logout-wait): New functions.
332 (imap-kerberos4-open, imap-gssapi-open, imap-close): Use them.
333
334 * nnimap.el (nnimap-logout-timeout): New server variable.
335 (nnimap-open-server, nnimap-close-server): Bind imap-logout-timeout to
336 nnimap-logout-timeout.
337
113 * gnus-art.el (gnus-article-summary-command-nosave) 338 * gnus-art.el (gnus-article-summary-command-nosave)
114 (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer. 339 (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer.
115 340
@@ -124,20 +349,118 @@
124 (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): 349 (gnus-list-of-read-articles, gnus-sequence-of-unread-articles):
125 Limit the range of articles according to gnus-maximum-newsgroup. 350 Limit the range of articles according to gnus-maximum-newsgroup.
126 351
3522007-08-14 Tassilo Horn <tassilo@member.fsf.org>
353
354 * gnus-art.el (gnus-sticky-article): Fixed problems described in
355 <b4mps1qitio.fsf@jpl.org> on ding. Thanks to Katsumi.
356 Don't perform gnus-configure-windows here; reuse existing sticky
357 article buffer.
358
359 * gnus-sum.el (gnus-summary-display-article): Setup article buffer if
360 it doesn't exist in gnus-article-mode.
361
3622007-08-13 Katsumi Yamaoka <yamaoka@jpl.org>
363
364 * gnus-agent.el (gnus-agent-decoded-group-names): New variable.
365 (gnus-agent-decoded-group-name): New function.
366 (gnus-agent-group-path, gnus-agent-group-pathname): Use it.
367 (gnus-agent-expire-group-1): Use it; decode group name in messages.
368
3692007-08-12 Tassilo Horn <tassilo@member.fsf.org>
370
371 * gnus-sum.el (gnus-summary-article-map, gnus-summary-make-menu-bar):
372 Add binding for gnus-sticky-article.
373 (gnus-summary-exit): Don't kill sticky article buffers.
374
375 * gnus-art.el (gnus-sticky-article-mode): New mode to generate a sticky
376 article buffer.
377 (gnus-sticky-article, gnus-kill-sticky-article-buffer)
378 (gnus-kill-sticky-article-buffers): New commands.
379
1272007-08-10 Katsumi Yamaoka <yamaoka@jpl.org> 3802007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
128 381
129 * nntp.el (nntp-xref-number-is-evil): New server variable. 382 * nntp.el (nntp-xref-number-is-evil): New server variable.
130 (nntp-find-group-and-number): If it is non-nil, don't trust article 383 (nntp-find-group-and-number): If it is non-nil, don't trust article
131 numbers in the Xref header. 384 numbers in the Xref header.
132 385
3862007-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
387
388 * gnus-agent.el (gnus-agent-read-group): New function.
389 (gnus-agent-flush-group, gnus-agent-expire-group)
390 (gnus-agent-regenerate-group): Use it.
391 (gnus-agent-expire-unagentized-dirs): Bind file-name-coding-system to
392 nnmail-pathname-coding-system.
393
1332007-08-06 Katsumi Yamaoka <yamaoka@jpl.org> 3942007-08-06 Katsumi Yamaoka <yamaoka@jpl.org>
134 395
135 * gnus-ems.el (gnus-x-splash): Bind inhibit-read-only to t. 396 * gnus-ems.el (gnus-x-splash): Bind inhibit-read-only to t.
136 397
398 * gnus-sum.el (gnus-summary-insert-articles): Mark inserted articles
399 that are unread as unread, and also as selected so that information of
400 marks having been changed by a user may be updated when exiting group.
401
1372007-08-04 Reiner Steib <Reiner.Steib@gmx.de> 4022007-08-04 Reiner Steib <Reiner.Steib@gmx.de>
138 403
139 * gnus-art.el (article-hide-headers): Bind inhibit-read-only to t. 404 * gnus-art.el (article-hide-headers): Bind inhibit-read-only to t.
140 405
4062007-08-03 Katsumi Yamaoka <yamaoka@jpl.org>
407
408 * gnus-art.el (gnus-mime-display-single): Pass part number that is
409 calculated ignoring signature parts to gnus-treat-article.
410
4112007-08-02 Katsumi Yamaoka <yamaoka@jpl.org>
412
413 * gnus-art.el (gnus-mime-security-verify-or-decrypt): Don't narrow to
414 a point here in order to keep the window start.
415 (gnus-insert-mime-security-button): Make a button overlay without the
416 front stickiness.
417 (gnus-mime-display-security): Goto the end of a button.
418
419 * gnus-group.el (gnus-group-name-at-point): Fix regexps.
420
4212007-08-01 Katsumi Yamaoka <yamaoka@jpl.org>
422
423 * gnus-group.el (gnus-group-name-at-point): Rewrite; rename from
424 group-name-at-point.
425 (gnus-group-completing-read): New function that offers decoded
426 non-ASCII group names for completion.
427 (gnus-fetch-group, gnus-group-read-ephemeral-group)
428 (gnus-group-jump-to-group, gnus-group-make-group-simple)
429 (gnus-group-unsubscribe-group, gnus-group-fetch-charter)
430 (gnus-group-fetch-control): Use it.
431 (gnus-fetch-group): Use group-name-at-point for the initial value
432 rather than the default value; use gnus-alive-p.
433
434 * gnus-msg.el (gnus-group-mail, gnus-group-news, gnus-group-post-news)
435 (gnus-summary-mail-other-window, gnus-summary-news-other-window)
436 (gnus-summary-post-news): Use gnus-group-completing-read.
437
438 * gnus-sum.el (gnus-select-newsgroup): Decode group name in error msg.
439 (gnus-read-move-group-name): Decode group name for completion.
440
4412007-07-31 Ted Zlatanov <tzz@lifelogs.com>
442
443 * gnus-srvr.el (gnus-server-close-all-servers): Close servers not only
444 in gnus-inserted-opened-servers but also in gnus-server-alist (Katsumi
445 Yamaoka slightly modified the code).
446
4472007-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
448
449 * nnmail.el (nnmail-group-names-not-encoded-p): New variable.
450 (nnmail-split-incoming): Bind it.
451
452 * nnml.el (nnml-group-name-charset): New function.
453 (nnml-decoded-group-name): Use it; don't decode group name if
454 nnmail-group-names-not-encoded-p is non-nil.
455 (nnml-encoded-group-name): New function.
456 (nnml-group-pathname): Inline nnml-decoded-group-name.
457 (nnml-request-expire-articles): Decode group name in message.
458 (nnml-request-delete-group): Ditto; bind file-name-coding-system to
459 nnmail-pathname-coding-system.
460 (nnml-save-mail, nnml-active-number): Work with decoded group names and
461 not decoded ones according to nnmail-group-names-not-encoded-p.
462 (nnml-generate-active-info): Use nnml-encoded-group-name.
463
1412007-08-08 Glenn Morris <rgm@gnu.org> 4642007-08-08 Glenn Morris <rgm@gnu.org>
142 465
143 * gmm-utils.el, gnus-async.el, gnus-msg.el, gnus-score.el 466 * gmm-utils.el, gnus-async.el, gnus-msg.el, gnus-score.el
@@ -148,20 +471,125 @@
148 471
149 * Relicense all FSF files to GPLv3 or later. 472 * Relicense all FSF files to GPLv3 or later.
150 473
1512007-07-24 Katsumi Yamaoka <yamaoka@jpl.org> 4742007-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
152
153 * gnus-msg.el (gnus-summary-supersede-article)
154 (gnus-summary-resend-message-edit): Add Gcc header.
155 (gnus-summary-resend-bounced-mail): Ditto; search whole body for parent
156 article's Message-ID; refer parent article in summary buffer.
157 475
158 * message.el (message-bounce): Call mime-to-mml. 476 * gnus-sum.el (gnus-summary-move-article): Make
477 gnus-summary-respool-article work.
159 478
1602007-07-21 Reiner Steib <Reiner.Steib@gmx.de> 4792007-07-21 Reiner Steib <Reiner.Steib@gmx.de>
161 480
162 * mm-uu.el (mm-uu-type-alist): Refer to mm-uu-configure-list in doc 481 * mm-uu.el (mm-uu-type-alist): Refer to mm-uu-configure-list in doc
163 string. 482 string.
164 483
4842007-07-20 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
485
486 * nnrss.el (nnrss-ignore-article-fields): New variable. List of fields
487 that should be ignored when comparing distant RSS articles with local
488 ones.
489 (nnrss-make-hash-index): New function. Create a hash index according
490 to the ignored fields.
491 (nnrss-check-group): Use it.
492
4932007-07-20 Katsumi Yamaoka <yamaoka@jpl.org>
494
495 * gnus-agent.el (gnus-agent-group-pathname): Take notice of the method.
496
497 * gnus-art.el (article-decode-group-name): Decode Xref header too.
498
499 * gnus-group.el (gnus-group-make-group): Encode group name here unless
500 the new optional argument ENCODED is non-nil.
501 (gnus-group-make-doc-group): Use gnus-group-name-charset to determine
502 coding system for encoding group name.
503 (gnus-group-make-rss-group): Pass un-encoded group name to
504 gnus-group-make-group.
505 (gnus-group-set-info): Tell gnus-group-make-group that group name is
506 encoded.
507
508 * gnus-sum.el (gnus-summary-move-article, gnus-read-move-group-name):
509 Encode group name to which articles are moved or copied.
510 (gnus-summary-edit-article): Use gnus-group-name-charset to determine
511 coding system for encoding Newsgroup, Followup-To and Xref headers.
512
513 * nnagent.el (nnagent-request-set-mark): Use unibyte buffer to compose
514 marks; use nnheader-file-coding-system to write a file.
515 (nnagent-retrieve-headers): Bind file-name-coding-system to
516 nnmail-pathname-coding-system.
517
518 * nnmail.el (nnmail-insert-xref): Don't break non-ASCII group name.
519
520 * nnml.el (nnml-decoded-group-name, nnml-group-pathname): New functions.
521 (nnml-request-article, nnml-request-create-group)
522 (nnml-request-rename-group, nnml-find-id)
523 (nnml-possibly-change-directory, nnml-possibly-create-directory)
524 (nnml-save-mail, nnml-active-number, nnml-marks-changed-p)
525 (nnml-save-marks): Use nnml-group-pathname instead of
526 nnmail-group-pathname.
527
528 (nnml-request-create-group, nnml-request-expire-articles)
529 (nnml-request-move-article, nnml-request-delete-group)
530 (nnml-deletable-article-p, nnml-possibly-create-directory)
531 (nnml-get-nov-buffer, nnml-generate-nov-databases-directory)
532 (nnml-open-marks): Bind file-name-coding-system to
533 nnmail-pathname-coding-system.
534
535 (nnml-request-article): Pass server argument to nnml-find-group-number.
536 (nnml-request-create-group, nnml-active-number, nnml-save-marks): Pass
537 server argument to nnml-possibly-create-directory.
538 (nnml-request-accept-article): Pass server argument to
539 nnml-active-number and nnml-save-mail.
540 (nnml-find-group-number): Pass server argument to nnml-find-id.
541 (nnml-request-update-info): Pass server argument to
542 nnml-marks-changed-p.
543
544 (nnml-find-id, nnml-find-group-number, nnml-possibly-create-directory)
545 (nnml-save-mail, nnml-active-number): Add server argument.
546
547 (nnml-request-delete-group): Warn if group is missing.
548 (nnml-get-nov-buffer): Decode group name.
549 (nnml-generate-active-info): Encode group name.
550 (nnml-open-marks): Decode group name in messages.
551
5522007-07-19 Katsumi Yamaoka <yamaoka@jpl.org>
553
554 * gnus-art.el (gnus-article-part-wrapper): Work with the nearest part
555 if it is not specified.
556 (gnus-article-pipe-part, gnus-article-save-part)
557 (gnus-article-interactively-view-part, gnus-article-copy-part)
558 (gnus-article-view-part-as-charset, gnus-article-view-part-externally)
559 (gnus-article-inline-part, gnus-article-save-part-and-strip)
560 (gnus-article-replace-part, gnus-article-delete-part)
561 (gnus-article-view-part-as-type): Pass raw prefix argument to
562 gnus-article-part-wrapper.
563
5642007-07-18 Katsumi Yamaoka <yamaoka@jpl.org>
565
566 * gnus-agent.el (gnus-agent-save-active): Bind
567 nnheader-file-coding-system to gnus-agent-file-coding-system.
568
569 * gnus-cache.el (gnus-cache-save-buffers)
570 (gnus-cache-possibly-enter-article, gnus-cache-request-article)
571 (gnus-cache-retrieve-headers, gnus-cache-change-buffer)
572 (gnus-cache-possibly-remove-article, gnus-cache-articles-in-group)
573 (gnus-cache-braid-nov, gnus-cache-braid-heads)
574 (gnus-cache-generate-active, gnus-cache-rename-group)
575 (gnus-cache-delete-group, gnus-cache-update-file-total-fetched-for)
576 (gnus-cache-update-overview-total-fetched-for): Bind
577 file-name-coding-system to nnmail-pathname-coding-system.
578 (gnus-cache-decoded-group-names, gnus-cache-unified-group-names): New
579 variables.
580 (gnus-cache-decoded-group-name): New function.
581 (gnus-cache-file-name): Use it.
582 (gnus-cache-generate-active): Use non-decoded group name for active.
583
584 * gnus-util.el (gnus-write-buffer): Bind file-name-coding-system at the
585 right place.
586 (gnus-write-active-file): Don't break non-ASCII group names.
587
588 * nntp.el (nntp-marks-changed-p): Bind file-name-coding-system to
589 nnmail-pathname-coding-system.
590
591 * gnus-uu.el (gnus-uu-decode-save): Typo.
592
1652007-07-16 Katsumi Yamaoka <yamaoka@jpl.org> 5932007-07-16 Katsumi Yamaoka <yamaoka@jpl.org>
166 594
167 * gnus-srvr.el (gnus-server-font-lock-keywords): Quote faces. 595 * gnus-srvr.el (gnus-server-font-lock-keywords): Quote faces.
@@ -173,11 +601,63 @@
173 601
1742007-07-13 Katsumi Yamaoka <yamaoka@jpl.org> 6022007-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
175 603
604 * gnus-agent.el (gnus-agent-rename-group, gnus-agent-delete-group)
605 (gnus-agent-fetch-articles, gnus-agent-unfetch-articles)
606 (gnus-agent-crosspost, gnus-agent-backup-overview-buffer)
607 (gnus-agent-flush-group, gnus-agent-flush-cache)
608 (gnus-agent-fetch-headers, gnus-agent-load-alist)
609 (gnus-agent-read-agentview, gnus-agent-expire-group-1)
610 (gnus-agent-retrieve-headers, gnus-agent-request-article)
611 (gnus-agent-regenerate-group)
612 (gnus-agent-update-files-total-fetched-for)
613 (gnus-agent-update-view-total-fetched-for): Bind
614 file-name-coding-system to nnmail-pathname-coding-system.
615 (gnus-agent-group-pathname): Don't encode file names by
616 nnmail-pathname-coding-system.
617 (gnus-agent-save-local): Bind file-name-coding-system correctly; bind
618 coding-system-for-write instead of buffer-file-coding-system to
619 gnus-agent-file-coding-system.
620
621 * gnus-msg.el (gnus-inews-make-draft, gnus-inews-insert-archive-gcc):
622 Decode group name.
623
624 * gnus-srvr.el (gnus-browse-foreign-server): Make group names unibyte.
625
626 * gnus-start.el (gnus-update-active-hashtb-from-killed)
627 (gnus-read-newsrc-el-file): Make group names unibyte.
628
629 * nnmail.el (nnmail-group-pathname): Don't encode file names by
630 nnmail-pathname-coding-system.
631
632 * nnrss.el (nnrss-file-coding-system): Doc fix; make it begin with *.
633 (nnrss-request-delete-group): Bind file-name-coding-system to
634 nnmail-pathname-coding-system.
635 (nnrss-read-server-data, nnrss-read-group-data): Bind
636 file-name-coding-system correctly.
637 (nnrss-check-group): Pass nnrss-file-coding-system to md5.
638
639 * nntp.el: Require gnus-group for the function gnus-group-name-charset.
640 (nntp-server-to-method-cache): New variable.
641 (nntp-group-pathname): New function that decodes non-ASCII group names.
642 (nntp-possibly-create-directory, nntp-marks-changed-p)
643 (nntp-save-marks, nntp-open-marks): Use it.
644 (nntp-possibly-create-directory, nntp-open-marks):
645 Bind file-name-coding-system to nnmail-pathname-coding-system.
646 (nntp-open-marks): Decode group names when bootstrapping marks.
647
648 * rfc2047.el (rfc2047-encode-message-header): Make XEmacs decode
649 Newsgroups and Folowup-To headers.
650
6512007-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
652
176 * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) 653 * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
177 (gnus-server-closed-face, gnus-server-denied-face) 654 (gnus-server-closed-face, gnus-server-denied-face)
178 (gnus-server-offline-face): Remove variable. 655 (gnus-server-offline-face): Remove variable.
179 (gnus-server-font-lock-keywords): Use faces that are not aliases. 656 (gnus-server-font-lock-keywords): Use faces that are not aliases.
180 657
658 * gnus-util.el (gnus-message-with-timestamp-1): Use log-message instead
659 of modifying message-stack directly for XEmacs.
660
181 * mm-util.el (mm-decode-coding-string, mm-encode-coding-string) 661 * mm-util.el (mm-decode-coding-string, mm-encode-coding-string)
182 (mm-decode-coding-region, mm-encode-coding-region): Don't modify string 662 (mm-decode-coding-region, mm-encode-coding-region): Don't modify string
183 if the coding-system argument is nil for XEmacs. 663 if the coding-system argument is nil for XEmacs.
@@ -190,6 +670,18 @@
190 (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not 670 (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not
191 to quote the parameter value. 671 to quote the parameter value.
192 672
6732007-07-06 Katsumi Yamaoka <yamaoka@jpl.org>
674
675 * gnus-group.el (gnus-group-name-charset): Allow a method of the short
676 form in gnus-group-name-charset-method-alist.
677
678 * gnus-eform.el (gnus-edit-form): Add optional argument layout which
679 overrides the default layout edit-form.
680
681 * gnus-win.el (gnus-buffer-configuration): Add edit-server.
682
683 * gnus-srvr.el (gnus-server-edit-server): Use edit-server layout.
684
1932007-07-04 Katsumi Yamaoka <yamaoka@jpl.org> 6852007-07-04 Katsumi Yamaoka <yamaoka@jpl.org>
194 686
195 * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles 687 * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles
@@ -199,11 +691,39 @@
199 691
200 * gnus-start.el (gnus-level-unsubscribed): Improve doc string. 692 * gnus-start.el (gnus-level-unsubscribed): Improve doc string.
201 693
6942007-07-02 Katsumi Yamaoka <yamaoka@jpl.org>
695
696 * nnagent.el (nnagent-request-set-mark): Also set the marks for the
697 original back end that keeps marks in the local system.
698
2022007-06-26 Katsumi Yamaoka <yamaoka@jpl.org> 6992007-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
203 700
204 * gnus-art.el (gnus-article-summary-command-nosave) 701 * gnus-art.el (gnus-article-summary-command-nosave): Don't set the 3rd
205 (gnus-article-read-summary-keys): Don't set the 3rd arg of 702 arg of pop-to-buffer for XEmacs.
206 pop-to-buffer for XEmacs. 703 (gnus-article-read-summary-keys): Ditto; don't restore window
704 configuration if summary command ends up with neither article buffer
705 nor summary buffer; describe bindings if summary keys end with C-h.
706
7072007-06-22 Katsumi Yamaoka <yamaoka@jpl.org>
708
709 * message.el (message-fix-before-sending): Skip raw message part to be
710 forwarded while checking illegible text.
711 (message-forward-make-body-mime, message-forward-make-body): Mark
712 signed or encrypted raw message as having no illegible text.
713
7142007-06-19 Katsumi Yamaoka <yamaoka@jpl.org>
715
716 * gnus-util.el (gnus-add-timestamp-to-message): New user option.
717 (gnus-message-with-timestamp-1): New macro.
718 (gnus-message-with-timestamp): New function.
719 (gnus-message): Use them.
720
721 * nnheader.el (nnheader-message): Use them.
722
7232007-06-16 Reiner Steib <Reiner.Steib@gmx.de>
724
725 * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Add newlines to
726 .newsrc.eld file.
207 727
2082007-06-14 Katsumi Yamaoka <yamaoka@jpl.org> 7282007-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
209 729
@@ -218,14 +738,26 @@
218 738
2192007-06-08 Katsumi Yamaoka <yamaoka@jpl.org> 7392007-06-08 Katsumi Yamaoka <yamaoka@jpl.org>
220 740
741 * gnus-ems.el (gnus-x-splash): Fix calculation; error in tty.
742
7432007-06-07 Katsumi Yamaoka <yamaoka@jpl.org>
744
221 * gnus-ems.el (gnus-x-splash): Make it work. 745 * gnus-ems.el (gnus-x-splash): Make it work.
222 746
223 * gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash 747 * gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash
224 from being used. 748 from being used.
225 749
226 * gnus-art.el (gnus-article-summary-command-nosave): Correct the order 7502007-06-05 Katsumi Yamaoka <yamaoka@jpl.org>
227 of the arguments passed to pop-to-buffer. 751
228 (gnus-article-read-summary-keys): Ditto. 752 * gnus-art.el (gnus-insert-mime-button): Make a button overlay without
753 the front stickiness.
754 (gnus-article-summary-command-nosave): Correct the order of the
755 arguments passed to pop-to-buffer.
756 (gnus-article-read-summary-keys): Ditto; make it work properly when the
757 summary command ends up with the article buffer.
758
759 * mm-decode.el (mm-insert-part): Separate the extracted parts that have
760 the same faces.
229 761
2302007-06-07 Juanma Barranquero <lekktu@gmail.com> 7622007-06-07 Juanma Barranquero <lekktu@gmail.com>
231 763
@@ -244,29 +776,182 @@
244 (gnus-mime-view-part-internally): Fix predicate function passed to 776 (gnus-mime-view-part-internally): Fix predicate function passed to
245 completing-read. 777 completing-read.
246 778
247 * mm-decode.el (mm-image-fit-p): Return t if argument is not an image; 779 * mm-decode.el (mm-image-fit-p): Return t if argument is not an image.
248 return t if image size is just the same as window size. 780
781 * gnus.el (gnus-update-message-archive-method): Add :version.
782
7832007-06-01 Katsumi Yamaoka <yamaoka@jpl.org>
784
785 * gnus.el (gnus-update-message-archive-method): New variable.
786
787 * gnus-start.el (gnus-setup-news): Update saved "archive" method
788 according to gnus-message-archive-method if
789 gnus-update-message-archive-method is non-nil.
790
7912007-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
792
793 * gnus-sum.el (gnus-summary-limit-to-address): New function. Suggested
794 by Loic Dachary <loic@dachary.org>.
795 (gnus-summary-limit-map, gnus-summary-make-menu-bar): Add it.
249 796
2502007-05-28 Katsumi Yamaoka <yamaoka@jpl.org> 7972007-05-28 Katsumi Yamaoka <yamaoka@jpl.org>
251 798
252 * message.el (message-pop-to-buffer): Add switch-function argument. 799 * message.el (message-pop-to-buffer): Add switch-function argument.
253 (message-mail): Pass switch-function argument to it. 800 (message-mail): Pass switch-function argument to it.
254 801
8022007-05-25 Reiner Steib <Reiner.Steib@gmx.de>
803
804 * mm-decode.el (mm-file-name-rewrite-functions): Make it customizable.
805 Improve doc string.
806
8072007-05-25 Katsumi Yamaoka <yamaoka@jpl.org>
808
809 * gnus-art.el (gnus-header-from, gnus-header-subject, gnus-header-name)
810 (gnus-header-content)
811 * gnus-cite.el (gnus-cite-10)
812 * gnus-srvr.el (gnus-server-closed)
813 * gnus.el (gnus-group-mail-1, gnus-group-mail-1-empty)
814 (gnus-group-mail-2, gnus-group-mail-2-empty, gnus-group-mail-3)
815 (gnus-group-mail-3-empty, gnus-group-mail-low)
816 (gnus-group-mail-low-empty, gnus-splash)
817 * message.el (message-header-to, message-header-cc)
818 (message-header-subject, message-header-other, message-header-name)
819 (message-header-xheader, message-separator, message-cited-text)
820 (message-mml): Lighten colors of faces used for dark background.
821
8222007-05-24 Simon Josefsson <simon@josefsson.org>
823
824 * nnimap.el (nnimap-need-unselect-to-notice-new-mail): Change default
825 to t as an experiment. Suggested by Greg Troxel <gdt@work.lexort.com>.
826
2552007-05-24 Katsumi Yamaoka <yamaoka@jpl.org> 8272007-05-24 Katsumi Yamaoka <yamaoka@jpl.org>
256 828
257 * message.el (message-narrow-to-headers-or-head): Ignore 829 * message.el (message-narrow-to-headers-or-head): Ignore
258 mail-header-separator in the body. 830 mail-header-separator in the body.
259 831
8322007-05-23 Katsumi Yamaoka <yamaoka@jpl.org>
833
834 * mm-decode.el (mm-image-fit-p): Return t if image size is just the
835 same as window size.
836
8372007-05-22 Kevin Ryde <user42@zip.com.au>
838
839 * message.el (message-font-lock-keywords): Use message-header-xheader
840 face for "X-Foo", its apparent intended purpose. Move "X-" pattern
841 ahead of the anything pattern, to get it recognised.
842
8432007-05-12 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
844
845 * gnus-sum.el (gnus-articles-to-read)
846 (gnus-summary-insert-old-articles): Don't truncate group name for
847 `read-string'.
848
849 * gnus-util.el (gnus-limit-string): Delete this function.
850
851 * gnus-sum.el (gnus-simplify-subject-fully): Use
852 `truncate-string-to-width' instead.
853
8542007-05-11 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
855
856 * gnus-sum.el (gnus-summary-next-group-on-exit): New variable. Tell
857 if, on summary exit, the next group has to be selected.
858 (gnus-summary-exit): Use it.
859
2602007-05-10 Reiner Steib <Reiner.Steib@gmx.de> 8602007-05-10 Reiner Steib <Reiner.Steib@gmx.de>
261 861
262 * gnus-art.el (gnus-article-mode): Fix comment about displaying 862 * gnus-art.el (gnus-article-mode): Fix comment about displaying
263 non-break space. 863 non-break space.
264 864
2652007-05-09 Didier Verna <didier@xemacs.org> 8652007-05-10 Katsumi Yamaoka <yamaoka@jpl.org>
866
867 * nnfolder.el (nnfolder-request-group, nnfolder-request-create-group):
868 Check if group is not a directory.
869 (nnfolder-request-expire-articles): Don't delete articles if the target
870 group is not available.
871
872 * nnml.el (nnml-request-create-group): Properly check if group is not a
873 file.
874 (nnml-request-expire-articles): Don't delete articles if the target
875 group is not available.
876
877 * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
878 Don't quote characters that are within parentheses.
879
8802007-05-09 Katsumi Yamaoka <yamaoka@jpl.org>
881
882 * gnus-sum.el (gnus-auto-select-on-ephemeral-exit): New variable.
883 (gnus-handle-ephemeral-exit): Select article according to it.
884
8852007-05-08 Reiner Steib <Reiner.Steib@gmx.de>
886
887 * message.el (message-insert-formated-citation-line): Remove newline.
888 (message-citation-line-format): Add final \n here so that the user can
889 avoid a blank line.
890
8912007-05-03 Dan Christensen <jdc@uwo.ca>
892
893 * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p)
894 (nndoc-transform-lanl-gov-announce, nndoc-generate-lanl-gov-head):
895 Update lanl/arXiv support.
896
8972007-05-02 Reiner Steib <Reiner.Steib@gmx.de>
898
899 * gnus.el: Bump version number.
900
9012007-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
266 902
267 * gnus-diary.el, nndiary.el: Remove the description comment (nndiary is 903 * gnus.el (gnus-version-number): Bump version.
268 now properly documented in the Gnus manual). Fix the spelling of "Back 904
269 End". 9052007-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
906
907 * gnus.el: No Gnus v0.6 is released.
908
9092007-04-27 Didier Verna <didier@xemacs.org>
910
911 * gnus-util.el (gnus-orify-regexp): Moved and renamed to ...
912 * gmm-utils.el (gmm-regexp-concat): here.
913 * message.el: Don't require 'gnus-util.
914 (message-dont-reply-to-names): Handle name change above.
915 * gnus-sum.el (gnus-ignored-from-addresses): Ditto.
916
9172007-04-26 Katsumi Yamaoka <yamaoka@jpl.org>
918
919 * mm-util.el (mm-charset-synonym-alist): Don't make it a user option
920 since the initial value varies according to the system.
921
9222007-04-25 Katsumi Yamaoka <yamaoka@jpl.org>
923
924 * mm-util.el (mm-charset-synonym-alist): Defcustom.
925
9262007-04-25 NAKAJI Hiroyuki <nakaji@jp.freebsd.org> (tiny change)
927
928 * mm-util.el (mm-charset-synonym-alist): Map iso8859-1 to iso-8859-1.
929
9302007-04-24 Didier Verna <didier@xemacs.org>
931
932 Improve the type of gnus-ignored-from-addresses.
933 * gnus-util.el (gnus-orify-regexp): New function.
934 * message.el (gnus-util): Require it.
935 * message.el (message-dont-reply-to-names): Use gnus-orify-regexp.
936 * gnus-sum.el (gnus-ignored-from-addresses): New function.
937 * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use it.
938
9392007-04-24 Didier Verna <didier@xemacs.org>
940
941 * gnus-sum.el:
942 * gnus-utils.el: Fix some trailing whitespaces.
943
9442007-04-23 Katsumi Yamaoka <yamaoka@jpl.org>
945
946 * gnus-msg.el (gnus-summary-resend-message-edit): Add Gcc header.
947 (gnus-summary-resend-bounced-mail): Ditto; search whole body for parent
948 article's Message-ID; refer parent article in summary buffer.
949
950 * message.el (message-bounce): Call mime-to-mml.
951
9522007-04-20 Katsumi Yamaoka <yamaoka@jpl.org>
953
954 * gnus-msg.el (gnus-summary-supersede-article): Add Gcc header.
270 955
2712007-04-19 Katsumi Yamaoka <yamaoka@jpl.org> 9562007-04-19 Katsumi Yamaoka <yamaoka@jpl.org>
272 957
@@ -274,12 +959,35 @@
274 (gnus-mime-view-part-as-charset): Use it; redisplay subpart currently 959 (gnus-mime-view-part-as-charset): Use it; redisplay subpart currently
275 displayed of multipart/alternative part if it is invoked from summary 960 displayed of multipart/alternative part if it is invoked from summary
276 buffer. 961 buffer.
277 (gnus-article-part-wrapper): Select article window.
278 962
279 * mm-view.el (mm-inline-text-html-render-with-w3m) 963 * mm-view.el (mm-inline-text-html-render-with-w3m)
280 (mm-inline-text-html-render-with-w3m-standalone) 964 (mm-inline-text-html-render-with-w3m-standalone)
281 (mm-inline-render-with-function): Use mail-parse-charset by default. 965 (mm-inline-render-with-function): Use mail-parse-charset by default.
282 966
9672007-04-18 Levin Du <zslevin@gmail.com> (tiny change)
968
969 * parse-time.el (parse-time-string-chars): Check if CHAR
970 is less than the length of parse-time-syntax.
971
9722007-04-17 Katsumi Yamaoka <yamaoka@jpl.org>
973
974 * gnus-uu.el (gnus-uu-digest-mail-forward): Pull articles processed
975 from gnus-newsgroup-processable.
976
9772007-04-16 Didier Verna <didier@xemacs.org>
978
979 * gnus-msg.el (gnus-configure-posting-styles): Handle
980 message-signature-directory properly with :file syntax. Reported by
981 "Leo".
982
9832007-04-11 Didier Verna <didier@xemacs.org>
984
985 New user option: message-signature-directory.
986 * gnus-msg.el (gnus-configure-posting-styles): Support it.
987 * message.el (message-insert-signature): Ditto.
988 * message.el (message-signature-file): Doc update.
989 * message.el (message-signature-directory): New.
990
2832007-04-10 Katsumi Yamaoka <yamaoka@jpl.org> 9912007-04-10 Katsumi Yamaoka <yamaoka@jpl.org>
284 992
285 * gnus-msg.el (gnus-inews-yank-articles): Use 993 * gnus-msg.el (gnus-inews-yank-articles): Use
@@ -302,6 +1010,9 @@
302 1010
3032007-03-31 Reiner Steib <Reiner.Steib@gmx.de> 10112007-03-31 Reiner Steib <Reiner.Steib@gmx.de>
304 1012
1013 * message.el (message-fill-column): New variable.
1014 (message-mode): Use it. Add comment on a possible new hook.
1015
305 * nnmail.el (nnmail-spool-file): Mark as obsolete. 1016 * nnmail.el (nnmail-spool-file): Mark as obsolete.
306 (nnmail-get-new-mail): Reformat. 1017 (nnmail-get-new-mail): Reformat.
307 1018
@@ -312,8 +1023,37 @@
312 1023
3132007-03-27 Thien-Thi Nguyen <ttn@gnu.org> 10242007-03-27 Thien-Thi Nguyen <ttn@gnu.org>
314 1025
315 * message.el (message-yank-original): Fix bug: 1026 * message.el (message-yank-original): Don't switch point and mark
316 Don't switch point and mark unnecessarily. 1027 unnecessarily to put point and mark as documented.
1028
10292007-03-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
1030
1031 * message.el (message-put-addresses-in-ecomplete): Only fetch headers
1032 from the message heads.
1033
10342007-03-25 Kevin Greiner <kevin.greiner@compsol.cc>
1035
1036 * gnus-art.el (gnus-article-set-window-start): Do nothing when the
1037 article buffer does not have a window. This may not be the best
1038 solution but is certainly better than setting the start of the null,
1039 that is the current, window.
1040
10412007-03-24 Reiner Steib <Reiner.Steib@gmx.de>
1042
1043 * gnus-draft.el (gnus-draft-setup-hook): New hook.
1044 (gnus-draft-setup): Run it.
1045
1046 * gnus-score.el (gnus-inhibit-slow-scoring): New variable, renamed from
1047 gnus-score-fast-scoring. Allow regexp.
1048 (gnus-score-headers): Use it.
1049
1050 * gnus-util.el (gnus-emacs-version): Include "no MULE" in no-MULE
1051 XEmacs.
1052
1053 * gnus-art.el (gnus-article-browse-html-article): Fix typo in doc
1054 string.
1055 (gnus-button-alist): Also catch `<f1> k ...'.
1056 (gnus-treat-display-x-face): Fix doc string.
317 1057
3182007-03-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 10582007-03-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
319 1059
@@ -321,10 +1061,11 @@
321 evaluation of gnus-extended-version to ensure correct generation of the 1061 evaluation of gnus-extended-version to ensure correct generation of the
322 User-Agent header when message-generate-headers-first is used. 1062 User-Agent header when message-generate-headers-first is used.
323 1063
3242007-03-24 Reiner Steib <Reiner.Steib@gmx.de> 10642007-03-24 Simon Josefsson <simon@josefsson.org>
325 1065
326 * gnus-art.el (gnus-button-alist): Also catch `<f1> k ...'. 1066 * hashcash.el (hashcash-generate-payment-async): Don't crash if
327 (gnus-treat-display-x-face): Fix doc string. 1067 hashcash-path is nil. Don't call callback with incorrect number of
1068 parameters if val is 0.
328 1069
3292007-03-20 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 10702007-03-20 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
330 1071
@@ -350,6 +1091,43 @@
350 (message-mail-other-window): Adjust argument of message-setup. 1091 (message-mail-other-window): Adjust argument of message-setup.
351 (message-mail-other-frame): Ditto. 1092 (message-mail-other-frame): Ditto.
352 1093
10942007-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
1095
1096 * gnus-cite.el (font-lock-set-defaults): Autoload it for Emacs.
1097 (gnus-message-citation-mode): Require font-lock for XEmacs; make sure
1098 to turn font-lock on when turning gnus-message-citation-mode on.
1099
11002007-03-06 Daiki Ueno <ueno@unixuser.org>
1101
1102 * mml-smime.el (mml-smime-use): New variable; default to use openssl.
1103 (mml-smime-function-alist): New variable; add epg as the backend.
1104 * mml-sec.el (mml-smime-sign): Don't require mml-smime, autoload
1105 mml-smime- functions instead.
1106 * mm-view.el: Require smime.
1107
11082007-03-05 Didier Verna <didier@xemacs.org>
1109
1110 * gnus-topic.el (gnus-topic-hierarchical-parameters): Perform merging
1111 instead of just inheritance for posting styles.
1112 * gnus.el (gnus-group-fast-parameter): Fix typo in comment.
1113
11142007-02-24 John Paul Wallington <jpw@pobox.com>
1115
1116 * tls.el (tls-certtool-program): Fix custom type.
1117
11182007-02-28 Katsumi Yamaoka <yamaoka@jpl.org>
1119
1120 * gnus-cite.el (gnus-message-search-citation-line): Use point-at-bol
1121 and point-at-eol instead of line-(beginning|end)-position.
1122
1123 * assistant.el (assistant-parse-buffer): Ditto.
1124
11252007-02-28 Daiki Ueno <ueno@unixuser.org>
1126
1127 * mml2015.el (mml2015-epg-find-usable-key): New function.
1128 (mml2015-epg-sign): Use it.
1129 (mml2015-epg-encrypt): Use it.
1130
3532007-02-28 Katsumi Yamaoka <yamaoka@jpl.org> 11312007-02-28 Katsumi Yamaoka <yamaoka@jpl.org>
354 1132
355 * message.el (message-make-in-reply-to): Quote name containing 1133 * message.el (message-make-in-reply-to): Quote name containing
@@ -357,12 +1135,36 @@
357 if there are special characters. Reported by NAKAJI Hiroyuki 1135 if there are special characters. Reported by NAKAJI Hiroyuki
358 <nakaji@jp.freebsd.org>. 1136 <nakaji@jp.freebsd.org>.
359 1137
11382007-02-27 Didier Verna <didier@xemacs.org>
1139
1140 Include the group parameters as well as the topic ones in the
1141 inheritance filter process.
1142 * gnus-topic.el (gnus-topic-hierarchical-parameters): New optional
1143 argument GROUP-PARAMS-LIST.
1144 * gnus-topic.el (gnus-group-topic-parameters): Use it.
1145
3602007-02-27 Katsumi Yamaoka <yamaoka@jpl.org> 11462007-02-27 Katsumi Yamaoka <yamaoka@jpl.org>
361 1147
362 * nntp.el (nntp-never-echoes-commands) 1148 * nntp.el (nntp-never-echoes-commands)
363 (nntp-open-connection-functions-never-echo-commands): New variables. 1149 (nntp-open-connection-functions-never-echo-commands): New variables.
364 (nntp-send-command): Use them. 1150 (nntp-send-command): Use them.
365 1151
11522007-02-20 Daiki Ueno <ueno@unixuser.org>
1153
1154 * mml2015.el (mml2015-epg-verify): Simplified.
1155
11562007-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
1157
1158 * mml.el (mml-content-disposition-alist): New user option.
1159 (mml-content-disposition): New function.
1160 (mml-insert-mime-headers, mml-minibuffer-read-disposition): Use it.
1161 (mml-attach-file, mml-dnd-attach-file): Pass file name to it.
1162
11632007-02-19 Daiki Ueno <ueno@unixuser.org>
1164
1165 * mml2015.el (mml2015-epg-verify): Convert LF to CRLF before signature
1166 verification.
1167
3662007-02-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 11682007-02-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
367 1169
368 * nnweb.el (nnweb-google-parse-1): Fix date parsing to also match on 1170 * nnweb.el (nnweb-google-parse-1): Fix date parsing to also match on
@@ -372,6 +1174,57 @@
372 1174
373 * smiley.el (smiley-regexp-alist): Add "dead" smiley. 1175 * smiley.el (smiley-regexp-alist): Add "dead" smiley.
374 1176
11772007-02-14 Micha,Ak(Bl Cadilhac <michael@cadilhac.name>
1178
1179 * nntp.el (nntp-send-command): Don't wait for echoes when
1180 nntp-open-ssl-stream is used.
1181
11822007-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
1183
1184 * gnus-cite.el (gnus-test-font-lock-add-keywords)
1185 (gnus-message-add-citation-keywords)
1186 (gnus-message-remove-citation-keywords): Remove.
1187 (gnus-message-citation-mode): Instead of modifying font-lock-keywords
1188 directly, make the variables in font-lock-defaults buffer-local, add
1189 gnus-message-citation-keywords to them and then update the value of
1190 font-lock-keywords.
1191
11922007-02-09 Katsumi Yamaoka <yamaoka@jpl.org>
1193
1194 * message.el (message-cite-original-1): Don't call
1195 gnus-article-highlight-citation.
1196
1197 * gnus-cite.el (gnus-cite-parse): Work with two or more MS-type
1198 citations; fix line count.
1199
12002007-02-08 Katsumi Yamaoka <yamaoka@jpl.org>
1201
1202 * gnus-cite.el (gnus-test-font-lock-add-keywords): New function.
1203 (gnus-message-add-citation-keywords)
1204 (gnus-message-remove-citation-keywords): Use it; fix the emulating
1205 versions of font-lock-add-keywords and font-lock-remove-keywords to
1206 work with XEmacs correctly.
1207
12082007-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
1209
1210 * gnus-cite.el (gnus-cite-face-list): Set the values of
1211 gnus-message-max-citation-depth and gnus-message-citation-keywords.
1212 (gnus-message-max-citation-depth): Use defvar rather than defconst.
1213 (gnus-message-cite-prefix-regexp): New variable.
1214 (gnus-message-search-citation-line): Use it; protect against long
1215 citation prefix; fill match data with nil rather than 0 for XEmacs; set
1216 the 0th match data for Emacs.
1217 (gnus-message-citation-keywords): Set LAXMATCH flag in every HIGHLIGHT.
1218 (gnus-message-add-citation-keywords): Append keywords rather than
1219 prepending; emulate font-lock-add-keywords if it is not available.
1220 (gnus-message-remove-citation-keywords): Emulate
1221 font-lock-remove-keywords if it is not available.
1222
1223 * gnus-msg.el (gnus-message-highlight-citation): Default to t.
1224
1225 * message.el (message-cite-prefix-regexp): Set the value of
1226 gnus-message-cite-prefix-regexp.
1227
3752007-02-01 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 12282007-02-01 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
376 1229
377 * nnweb.el (nnweb-google-parse-1): Update parser. 1230 * nnweb.el (nnweb-google-parse-1): Update parser.
@@ -398,11 +1251,32 @@
398 1251
399 * gnus-art.el (gnus-signature-limit): Fix custom choice. 1252 * gnus-art.el (gnus-signature-limit): Fix custom choice.
400 1253
12542007-01-22 Daiki Ueno <ueno@unixuser.org>
1255
1256 * mm-util.el (mm-inhibit-file-name-handlers): Add epa-file-handler.
1257
1258 * mm-decode.el (mm-save-part-to-file): Use `mm-write-region' instead of
1259 `write-region' to respect `mm-inhibit-file-name-handlers'.
1260
4012007-01-19 Reiner Steib <Reiner.Steib@gmx.de> 12612007-01-19 Reiner Steib <Reiner.Steib@gmx.de>
402 1262
403 * nnsoup.el (nnsoup-directory, nnsoup-packer, nnsoup-packet-directory): 1263 * nnsoup.el (nnsoup-directory, nnsoup-packer, nnsoup-packet-directory):
404 Use gnus-home-directory instead of "~/" or "$HOME". 1264 Use gnus-home-directory instead of "~/" or "$HOME".
405 1265
12662007-01-17 Teodor Zlatanov <tzz@lifelogs.com>
1267
1268 * encrypt.el (encrypt-insert-file-contents): Add better prompt
1269 to mention filename.
1270 Add comments at beginning regarding usage.
1271 (encrypt-write-file-contents): Change interactive so a string is
1272 acceptable. If the file has no associated model, show an error instead
1273 of a nonsense prompt.
1274
12752007-01-16 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
1276
1277 * spam.el (spam-bsfilter-ham-switch): Fix typo.
1278 Thanks to Yoshihiko Yamada for kind notification of this typo.
1279
4062007-01-12 Kenichi Handa <handa@m17n.org> 12802007-01-12 Kenichi Handa <handa@m17n.org>
407 1281
408 * uudecode.el (uudecode-decode-region-internal): Make it work in a 1282 * uudecode.el (uudecode-decode-region-internal): Make it work in a
@@ -410,34 +1284,75 @@
410 1284
4112007-01-14 Reiner Steib <Reiner.Steib@gmx.de> 12852007-01-14 Reiner Steib <Reiner.Steib@gmx.de>
412 1286
1287 * gnus-score.el (gnus-score-fast-scoring): New variable.
1288 (gnus-score-headers): Use it.
1289
413 * gnus-sum.el (gnus-auto-select-first): Improve doc string. 1290 * gnus-sum.el (gnus-auto-select-first): Improve doc string.
414 1291
4152007-01-07 Reiner Steib <Reiner.Steib@gmx.de> 1292 * message.el (message-cite-original-1): Call
1293 gnus-article-highlight-citation if requested.
1294
1295 * gnus-cite.el (gnus-article-highlight-citation): Add SAME-BUFFER arg.
1296
1297 * gnus-art.el (gnus-article-browse-html-article): Add warning about web
1298 bugs to doc string.
1299 (gnus-button-alist): Add mid\\|message-id.
1300 (gnus-button-fetch-group): Extend for use in
1301 `browse-url-browser-function'.
1302 (gnus-button-url-regexp): Try to catch paired parentheses like in
1303 Wikipedia URLs.
416 1304
417 * gnus-soup.el: Add missing :group in previous change. 1305 * gnus-sum.el (gnus-summary-reparent-children): Another doc string fix.
1306 Suggested by Simon Krahnke <overlord@gmx.li>.
1307
13082007-01-13 Romain Francoise <romain@orebokech.com>
1309
1310 * nnml.el (nnml-use-compressed-files): Fix typo in docstring.
1311 Update copyright.
418 1312
4192007-01-05 Reiner Steib <Reiner.Steib@gmx.de> 13132007-01-13 Patric Mueller <bhaak@bigfoot.com> (tiny change)
1314
1315 * gnus-sum.el (gnus-summary-reparent-children): Fix typo in doc string.
1316
13172007-01-09 Teodor Zlatanov <tzz@lifelogs.com>
1318
1319 * gnus-registry.el (gnus-registry-unfollowed-groups)
1320 (gnus-registry-split-fancy-with-parent): Fix documentation.
1321
13222007-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
1323
1324 * spam-report.el (spam-report-gmane-internal): Speed up spam reporting
1325 from nnweb groups.
1326
13272006-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
1328
1329 * spam-report.el (spam-report-gmane-internal): Add necessary "/" to
1330 Xref urls. Erase buffer before requesting head.
1331
1332 * mm-decode.el (mm-display-external): Use itimer function for XEmacs.
1333
13342007-01-07 Reiner Steib <Reiner.Steib@gmx.de>
420 1335
421 * gnus-soup.el (gnus-soup): New custom group. Make user variables 1336 * gnus-soup.el (gnus-soup): New custom group. Make user variables
422 customizable. 1337 customizable.
423 1338
4242007-01-03 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 13392007-01-05 Daiki Ueno <ueno@unixuser.org>
425 1340
426 * nnweb.el (nnweb-gmane-create-mapping): Put back code to merge the 1341 * mml2015.el (mml2015-epg-sign): Ask user whether to skip or abort if
427 headers read from disk with the ones newly found in the current search. 1342 no signing key is found.
428 This should no longer cause problems, because the article numbers in 1343 (mml2015-epg-encrypt): Ask user whether to skip or abort if
429 Gmane's `nov.php' output are ignored since the previous change. 1344 no encrypting and/or signing key is found.
430 1345
4312006-01-03 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 13462007-01-03 Reiner Steib <Reiner.Steib@gmx.de>
432 1347
433 * nnweb.el (nnweb-gmane-create-mapping): Keep the mapping stable for 1348 * spam-report.el (spam-report-gmane-spam): Remove redundant message.
434 solid groups.
435 1349
4362006-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org> 13502007-01-01 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
437 1351
438 * nnweb.el (nnweb-gmane-create-mapping): Use the article number from 1352 * nnweb.el (nnweb-gmane-create-mapping): Put back code to merge the
439 the headers when creating the mapping to avoid mismappings. 1353 headers read from disk with the ones newly found in the current search.
440 (nnweb-gmane-create-mapping): Always nix out old mapping. 1354 This should no longer cause problems, because the article numbers in
1355 Gmane's `nov.php' output are ignored since the previous change.
441 1356
4422007-01-02 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 13572007-01-02 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
443 1358
@@ -447,10 +1362,48 @@
447 1362
448 * mm-decode.el (mm-display-external): Use itimer function for XEmacs. 1363 * mm-decode.el (mm-display-external): Use itimer function for XEmacs.
449 1364
13652007-01-01 Romain Francoise <romain@orebokech.com>
1366
1367 * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo.
1368
13692006-12-31 Steve Youngs <steve@sxemacs.org>
1370
1371 * gnus-cite.el: Load easy-mmode at compile time for (S)XEmacs to get
1372 `define-minor-mode' macro definition expanded properly.
1373 (gnus-message-citation-mode): This is now OK for (S)XEmacs so don't
1374 exclude it there.
1375
1376 * gnus-msg.el (gnus-message-highlight-citation): Revert Reiner's patch
1377 of 2006-12-30. The default is nil on (S)XEmacs already because of the
1378 `fboundp' test.
1379 (gnus-message-citation-mode): Revert Reiner's patch of 2006-12-30.
1380 This is OK to autoload in (S)XEmacs now.
1381
13822006-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
1383
1384 * gnus-sum.el (gnus-summary-limit-to-singletons): New command and
1385 keystroke.
1386 (gnus-summary-limit-to-singletons): Fix typo.
1387
1388 * spam-report.el (spam-report-gmane-internal): Fall back on Xref if all
1389 else fails.
1390
4502006-12-30 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 13912006-12-30 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
451 1392
452 * gnus-sum.el (gnus-summary-insert-dormant-articles): Fix typo in 1393 * gnus-cite.el (turn-off-gnus-message-citation-mode): Fix typo in
453 message. 1394 docstring.
1395
1396 * gnus-sum.el (gnus-summary-insert-ticked-articles): New command.
1397 (gnus-summary-make-menu-bar, gnus-summary-buffer-map): Bind it.
1398 (gnus-summary-insert-dormant-articles): Fix typo in message.
1399
14002006-12-30 Reiner Steib <Reiner.Steib@gmx.de>
1401
1402 * gnus-msg.el (gnus-message-highlight-citation): Ensure default to be
1403 nil for XEmacs.
1404 (gnus-message-citation-mode): Don't autoload in XEmacs.
1405
1406 * gnus-cite.el (gnus-message-citation-mode): Don't define in XEmacs.
454 1407
4552006-12-29 Jouni K. Sepp,Ad(Bnen <jks@iki.fi> 14082006-12-29 Jouni K. Sepp,Ad(Bnen <jks@iki.fi>
456 1409
@@ -462,16 +1415,51 @@
462 * spam.el: Revert to make-obsolete-variable because 1415 * spam.el: Revert to make-obsolete-variable because
463 define-obsolete-variable-alias is not supported in Emacs 21. 1416 define-obsolete-variable-alias is not supported in Emacs 21.
464 1417
1418 * spam.el (spam-ifile-path, spam-ifile-database-path)
1419 (spam-bogofilter-path): Use define-obsolete-variable-alias instead of
1420 make-obsolete-variable.
1421 (spam-bsfilter-path, spam-bsfilter-program)
1422 (spam-spamassassin-path, spam-spamassassin-program)
1423 (spam-sa-learn-path, spam-sa-learn-program): Rename variables. Don't
1424 use "path" inappropriately.
1425 (spam-check-spamassassin, spam-spamassassin-register-with-sa-learn)
1426 (spam-check-bsfilter, spam-bsfilter-register-with-bsfilter): Use new
1427 variable names.
1428
4652006-12-28 Daiki Ueno <ueno@unixuser.org> 14292006-12-28 Daiki Ueno <ueno@unixuser.org>
466 1430
467 * gnus-sum.el (gnus-summary-next-article): Make sure we are in the 1431 * gnus-sum.el (gnus-summary-next-article): Make sure we are in the
468 summary buffer. 1432 summary buffer.
469 1433
4702006-12-27 Reiner Steib <Reiner.Steib@gmx.de> 1434 * password.el (password-cache-remove): Use clear-string to burn
1435 password, if available.
471 1436
472 * spam.el (spam-ifile-path, spam-ifile-database-path) 14372006-12-26 Reiner Steib <Reiner.Steib@gmx.de>
473 (spam-bogofilter-path): Use define-obsolete-variable-alias instead of 1438
474 make-obsolete-variable. 1439 * gnus-msg.el (gnus-message-citation-mode): Fix autoload.
1440
1441 * gnus-cite.el (gnus-message-highlight-citation): Move to gnus-msg.el.
1442
1443 * gnus-msg.el (gnus-setup-message): Add gnus-message-citation-mode.
1444 (gnus-message-highlight-citation): Move defcustom here from
1445 gnus-cite.el.
1446 (gnus-message-citation-mode): Autoload.
1447
1448 * gnus-cite.el: Adjust Oliver's code to Gnus namespace. Add some
1449 checks to make it compile with XEmacs.
1450 (gnus-message-citation-mode): New minor mode.
1451 (gnus-message-max-citation-depth, gnus-message-citation-keywords)
1452 (gnus-message-highlight-citation): New variables.
1453 (gnus-message-search-citation-line)
1454 (gnus-message-add-citation-keywords)
1455 (gnus-message-remove-citation-keywords)
1456 (turn-on-gnus-message-citation-mode)
1457 (turn-off-gnus-message-citation-mode): New functions.
1458
14592006-12-26 Oliver Scholz <epameinondas@gmx.de>
1460
1461 * gnus-cite.el: Enable highlighting of different citation levels in
1462 message-mode.
475 1463
4762006-12-26 Reiner Steib <Reiner.Steib@gmx.de> 14642006-12-26 Reiner Steib <Reiner.Steib@gmx.de>
477 1465
@@ -502,11 +1490,42 @@
502 them directly in the unibyte buffer that causes unexpected conversion 1490 them directly in the unibyte buffer that causes unexpected conversion
503 in Emacs 23 (unicode). 1491 in Emacs 23 (unicode).
504 1492
14932006-12-21 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
1494
1495 * message.el (message-generate-hashcash): Fix custom type.
1496
14972006-12-20 Reiner Steib <Reiner.Steib@gmx.de>
1498
1499 * gnus-sum.el (gnus-summary-recenter): Remove debug messages.
1500
5052006-12-20 Reiner Steib <Reiner.Steib@gmx.de> 15012006-12-20 Reiner Steib <Reiner.Steib@gmx.de>
506 1502
507 * gnus-group.el (gnus-group-tool-bar-gnome): Exchange connect and 1503 * gnus-group.el (gnus-group-tool-bar-gnome): Exchange connect and
508 disconnect icons. Add help text. 1504 disconnect icons. Add help text.
509 1505
15062006-12-20 Teodor Zlatanov <tzz@lifelogs.com>
1507
1508 * spam.el (spam-extra-header-to-number): CRM114 spam score is
1509 negated to be consistent with the others we handle.
1510
15112006-12-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
1512
1513 * gnus-art.el (gnus-article-setup-buffer): Actually set the local
1514 version of gnus-summary-buffer to something, so that we can use two
1515 article buffers at the same time.
1516
15172006-12-18 Teodor Zlatanov <tzz@lifelogs.com>
1518
1519 * spam.el (spam-necessary-extra-headers): Make spam-use-regex-headers
1520 trigger all the extra headers.
1521 (spam-extra-header-to-number): Don't require spam-use-crm114 for header
1522 sorting.
1523
15242006-12-14 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
1525
1526 * nnweb.el (nnweb-gmane-create-mapping): Keep the mapping stable for
1527 solid groups.
1528
5102006-12-13 Reiner Steib <Reiner.Steib@gmx.de> 15292006-12-13 Reiner Steib <Reiner.Steib@gmx.de>
511 1530
512 * legacy-gnus-agent.el: Add Copyright notice. 1531 * legacy-gnus-agent.el: Add Copyright notice.
@@ -515,6 +1534,15 @@
515 1534
516 * gnus-sum.el (gnus-make-thread-indent-array): Fix last change. 1535 * gnus-sum.el (gnus-make-thread-indent-array): Fix last change.
517 1536
15372006-12-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
1538
1539 * nnweb.el (nnweb-gmane-search): Placeholder TOPDOC setting.
1540
1541 * gnus-sum.el (gnus-summary-recenter): Force setting the window start
1542 to make it work reliably in CVS Emacs.
1543 (gnus-summary-limit-strange-charsets-predicate)
1544 (gnus-summary-limit-to-predicate): New functions.
1545
5182006-12-08 Chong Yidong <cyd@stupidchicken.com> 15462006-12-08 Chong Yidong <cyd@stupidchicken.com>
519 1547
520 * gnus-sum.el (gnus-make-thread-indent-array): New optional arg 1548 * gnus-sum.el (gnus-make-thread-indent-array): New optional arg
@@ -534,16 +1562,35 @@
534 * mm-url.el (mm-url-predefined-programs): Call curl with correct 1562 * mm-url.el (mm-url-predefined-programs): Call curl with correct
535 options. 1563 options.
536 1564
15652006-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
1566
1567 * spam-report.el (spam-report-url-ping-plain): Wait for output to avoid
1568 DOS-ing the recipient.
1569
1570 * nnweb.el (nnweb-gmane-create-mapping): Use the article number from
1571 the headers when creating the mapping to avoid mismappings.
1572 (nnweb-gmane-create-mapping): Always nix out old mapping.
1573
15742006-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
1575
1576 * message.el (message-signed-or-encrypted-p): Bind mm-decrypt-option
1577 and mm-verify-option to never.
1578
5372006-11-30 Katsumi Yamaoka <yamaoka@jpl.org> 15792006-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
538 1580
539 * mml2015.el (mml2015-pgg-clear-verify): Replace encode-coding-string 1581 * message.el (message-signed-or-encrypted-p): New function.
540 with mm-encode-coding-string. 1582 (message-forward-make-body): Use it.
1583
1584 * mml2015.el (mml2015-pgg-clear-verify, mml2015-epg-clear-verify):
1585 Replace encode-coding-string with mm-encode-coding-string.
541 1586
5422006-11-29 Katsumi Yamaoka <yamaoka@jpl.org> 15872006-11-29 Katsumi Yamaoka <yamaoka@jpl.org>
543 1588
544 * nneething.el (nneething-decode-file-name): Replace 1589 * nneething.el (nneething-decode-file-name): Replace
545 decode-coding-string with mm-decode-coding-string. 1590 decode-coding-string with mm-decode-coding-string.
546 1591
1592 * gnus-int.el (gnus-open-server): Say failed server's name.
1593
5472006-11-24 Juanma Barranquero <lekktu@gmail.com> 15942006-11-24 Juanma Barranquero <lekktu@gmail.com>
548 1595
549 * gnus-agent.el (gnus-agent-expire-unagentized-dirs) 1596 * gnus-agent.el (gnus-agent-expire-unagentized-dirs)
@@ -560,10 +1607,26 @@
560 (gnus-valid-select-methods, total-expire, gnus-summary-line-format) 1607 (gnus-valid-select-methods, total-expire, gnus-summary-line-format)
561 (gnus-group-read-only-p): Fix space/tab mixup in docstrings. 1608 (gnus-group-read-only-p): Fix space/tab mixup in docstrings.
562 1609
16102006-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
1611
1612 * gnus-sum.el (gnus-summary-limit-to-headers): New command and
1613 keystroke.
1614 (gnus-summary-limit-to-bodies): Implement headersp.
1615
16162006-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
1617
1618 * dns.el (query-dns): Protect against "Process dns deleted" strings.
1619
5632006-11-21 Katsumi Yamaoka <yamaoka@jpl.org> 16202006-11-21 Katsumi Yamaoka <yamaoka@jpl.org>
564 1621
565 * mm-util.el (mm-string-to-multibyte): Alias to identity in XEmacs. 1622 * mm-util.el (mm-string-to-multibyte): Alias to identity in XEmacs.
566 1623
16242006-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
1625
1626 * message.el (message-generate-hashcash): Expand range of values to
1627 include `opportunistic'.
1628 (message-send-mail): Use it.
1629
5672006-11-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 16302006-11-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
568 1631
569 * mm-uu.el (mm-uu-pgp-signed-extract-1): Make last fix more thorough 1632 * mm-uu.el (mm-uu-pgp-signed-extract-1): Make last fix more thorough
@@ -587,6 +1650,15 @@
587 `customize-variable'. 1650 `customize-variable'.
588 (gnus-getenv-nntpserver): Don't autoload. 1651 (gnus-getenv-nntpserver): Don't autoload.
589 1652
16532006-11-14 Teodor Zlatanov <tzz@lifelogs.com>
1654
1655 * spam.el: Revert to 7.82 (removed changes since 2006-10-16).
1656
16572006-11-14 Reiner Steib <Reiner.Steib@gmx.de>
1658
1659 * message.el (message-sendmail-extra-arguments): New variable.
1660 (message-send-mail-with-sendmail): Use it.
1661
5902006-11-14 Katsumi Yamaoka <yamaoka@jpl.org> 16622006-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
591 1663
592 * mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of 1664 * mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of
@@ -595,16 +1667,39 @@
595 * mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of 1667 * mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of
596 mm-string-as-multibyte. 1668 mm-string-as-multibyte.
597 1669
16702006-11-14 Daiki Ueno <ueno@unixuser.org>
1671
1672 * mml2015.el (mml2015-epg-sign): Prefix "pgp-" to a micalg value.
1673 Reported by Werner Koch <wk@gnupg.org>.
1674
16752006-11-14 Daiki Ueno <ueno@p360>
1676
1677 * mml2015.el: Autoload epa-select-keys when compiling.
1678
16792006-11-13 Daiki Ueno <ueno@unixuser.org>
1680
1681 * mml2015.el (mml2015-epg-sign): Save the signing keys in
1682 message-options.
1683 (mml2015-epg-encrypt): Save the recipient keys in message-options.
1684
16852006-11-13 Daiki Ueno <ueno@unixuser.org>
1686
1687 * mml2015.el (mml2015-epg-encrypt): Removed backward compatibility for
1688 EasyPG (< 0.0.6).
1689 (mml2015-always-trust): New user option.
1690 (mml2015-epg-passphrase-callback): Display key ID on the passphrase
1691 prompt.
1692
16932006-11-10 Katsumi Yamaoka <yamaoka@jpl.org>
1694
1695 * nntp.el (nntp-authinfo-force): New variable.
1696 (nntp-send-authinfo): Use it.
1697
5982006-11-09 Reiner Steib <Reiner.Steib@gmx.de> 16982006-11-09 Reiner Steib <Reiner.Steib@gmx.de>
599 1699
600 * message.el: Merge from the trunk to fix the bug WRT double encoded 1700 * message.el (message-strip-subject-encoded-words): Allow _not_ to
601 subjects. 1701 decode encoded words. Improve prompt. Add comment about forwarding.
602 (message-replacement-char): New variable. 1702 (message-replacement-char): Move up.
603 (message-fix-before-sending): Use it.
604 (message-simplify-subject): New function to remove duplicate code.
605 (message-reply, message-followup): Use it.
606 (message-simplify-subject-functions): New variable.
607 (message-strip-subject-encoded-words): New function.
608 1703
6092006-11-08 Wolfgang Jenkner <wjenkner@inode.at> (tiny change) 17042006-11-08 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
610 1705
@@ -612,6 +1707,19 @@
612 instead of gnus-intersection because arguments of gnus-sorted-nunion 1707 instead of gnus-intersection because arguments of gnus-sorted-nunion
613 must be sorted. This avoids corruption of gnus-newsgroup-unreads. 1708 must be sorted. This avoids corruption of gnus-newsgroup-unreads.
614 1709
17102006-11-07 Reiner Steib <Reiner.Steib@gmx.de>
1711
1712 * message.el (message-strip-subject-encoded-words): Reformat prompt.
1713 (message-simplify-subject-functions): Enable
1714 message-strip-subject-encoded-words by default.
1715
17162006-11-06 Reiner Steib <Reiner.Steib@gmx.de>
1717
1718 * message.el (message-strip-subject-encoded-words): New function
1719 (message-simplify-subject-functions): New variable.
1720 (message-simplify-subject): Use it. Fix typo in doc string.
1721 Support message-strip-subject-encoded-words.
1722
6152006-11-03 Juanma Barranquero <lekktu@gmail.com> 17232006-11-03 Juanma Barranquero <lekktu@gmail.com>
616 1724
617 * gnus-diary.el (gnus-diary-delay-format-function): 1725 * gnus-diary.el (gnus-diary-delay-format-function):
@@ -647,6 +1755,12 @@
647 * gnus-agent.el (gnus-agent-make-mode-line-string): Make it compatible 1755 * gnus-agent.el (gnus-agent-make-mode-line-string): Make it compatible
648 with Emacs 21 and XEmacs. 1756 with Emacs 21 and XEmacs.
649 1757
17582006-10-27 Teodor Zlatanov <tzz@lifelogs.com>
1759
1760 * spam.el (spam-parse-address): New function for better parsing,
1761 catching errors, etc.
1762 (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use it.
1763
6502006-10-26 Reiner Steib <Reiner.Steib@gmx.de> 17642006-10-26 Reiner Steib <Reiner.Steib@gmx.de>
651 1765
652 * mm-view.el: Add interactive arg to html2text autoload. 1766 * mm-view.el: Add interactive arg to html2text autoload.
@@ -655,6 +1769,27 @@
655 1769
656 * gnus-sum.el (gnus-summary-move-article): Use no-encode for `B B'. 1770 * gnus-sum.el (gnus-summary-move-article): Use no-encode for `B B'.
657 1771
17722006-10-24 Reiner Steib <Reiner.Steib@gmx.de>
1773
1774 * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): New
1775 variables.
1776 (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions.
1777 (mm-charset-synonym-alist): Move some entries to
1778 mm-codepage-iso-8859-list.
1779
1780 * gnus.el (gnus-getenv-nntpserver, gnus-select-method): Autoload.
1781
17822006-10-23 Reiner Steib <Reiner.Steib@gmx.de>
1783
1784 * message.el (message-citation-line-format)
1785 (message-insert-formated-citation-line): Fix implementation of %E, %N
1786 and %n according to the doc string.
1787
17882006-10-20 Teodor Zlatanov <tzz@lifelogs.com>
1789
1790 * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use
1791 car-safe to avoid bad parses.
1792
6582006-10-20 Katsumi Yamaoka <yamaoka@jpl.org> 17932006-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
659 1794
660 * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group 1795 * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group
@@ -664,12 +1799,32 @@
664 1799
6652006-10-19 Katsumi Yamaoka <yamaoka@jpl.org> 18002006-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
666 1801
667 * message.el (message-headers-to-generate): Fix typo in docstring. 1802 * gnus-draft.el (gnus-draft-edit-message): Make sure to remove Date
1803 header.
1804
1805 * message.el (message-draft-headers): Add Date.
1806 (message-headers-to-generate): Fix typo in docstring.
1807
1808 * nndraft.el (nndraft-required-headers): New variable.
1809 (nndraft-generate-headers): Use it.
1810
1811 * gnus-registry.el (gnus-registry-wash-for-keywords): Bind `word'.
1812
18132006-10-16 Teodor Zlatanov <tzz@lifelogs.com>
1814
1815 * gnus-registry.el (gnus-registry-wash-for-keywords)
1816 (gnus-registry-find-keywords): New functions to allow easy searching of
1817 articles that are in the registry.
1818
18192006-10-16 Teodor Zlatanov <tzz@lifelogs.com>
1820
1821 * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use
1822 ietf-drums-parse-address instead of gnus-extract-address-components.
1823 Reported by Damien Elmes <damien@repose.cx>.
668 1824
6692006-10-19 Reiner Steib <Reiner.Steib@gmx.de> 18252006-10-19 Reiner Steib <Reiner.Steib@gmx.de>
670 1826
671 * gnus.el (gnus-mime): Remove unused custom group. 1827 * gnus.el (gnus-mime): Remove unused custom group.
672 (gnus-getenv-nntpserver, gnus-select-method): Autoload.
673 1828
6742006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 18292006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
675 1830
@@ -693,36 +1848,50 @@
693 1848
6942006-10-04 Reiner Steib <Reiner.Steib@gmx.de> 18492006-10-04 Reiner Steib <Reiner.Steib@gmx.de>
695 1850
1851 * mm-util.el (mm-charset-synonym-alist, mm-charset-override-alist): Add
1852 iso-8859-8/windows-1255 and iso-8859-9/windows-1254.
1853
1854 * nnheader.el (nnheader-find-file-noselect): Inhibit version-control.
1855
1856 * message.el (message-replacement-char): New variable.
1857 (message-fix-before-sending): Use it.
1858 (message-simplify-subject): New function to remove duplicate code.
1859 (message-reply, message-followup): Use it.
1860
696 * gnus-sum.el (gnus-summary-make-menu-bar): Clarify 1861 * gnus-sum.el (gnus-summary-make-menu-bar): Clarify
697 gnus-summary-limit-to-articles. 1862 gnus-summary-limit-to-articles.
698 1863
6992006-10-04 Romain Francoise <romain@orebokech.com> 18642006-10-03 Katsumi Yamaoka <yamaoka@jpl.org>
700
701 * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist):
702 Moved here (and renamed) from gnus-registry.el.
703 1865
704 * gnus-registry.el: Require gnus-util. 1866 * gnus-util.el (gnus-with-local-quit): New macro.
705 Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'.
706 1867
7072006-10-04 Reiner Steib <Reiner.Steib@gmx.de> 1868 * gnus-demon.el (gnus-demon): Replace with-local-quit with it.
708 1869
709 * pop3.el (pop3-authentication-scheme): Clarify doc. 18702006-10-02 Teodor Zlatanov <tzz@lifelogs.com>
710 (pop3-movemail): Warn about pop3-leave-mail-on-server.
711 1871
7122006-10-04 Dave Love <fx@gnu.org> 1872 * gnus-util.el (gnus-string-remove-all-properties): Another fix to
1873 ignore non-string data.
713 1874
714 * pop3.el (pop3-authentication-scheme): Add custom version. 18752006-09-29 Teodor Zlatanov <tzz@lifelogs.com>
715 1876
7162006-10-04 Jesper Harder <harder@ifa.au.dk> 1877 * gnus-util.el (gnus-string-remove-all-properties): Fix to ignore
1878 non-string data (needs to be done in the registry too).
717 1879
718 * pop3.el (pop3-leave-mail-on-server): Don't quote nil in 18802006-09-28 Teodor Zlatanov <tzz@lifelogs.com>
719 doc string. Improve doc string.
720 1881
7212006-10-03 Katsumi Yamaoka <yamaoka@jpl.org> 1882 * gnus-registry.el (gnus-registry-save, gnus-registry-cache-save)
1883 (gnus-registry-remove-alist-text-properties, gnus-registry-action)
1884 (gnus-registry-split-fancy-with-parent)
1885 (gnus-registry-fetch-simplified-message-subject-fast)
1886 (gnus-registry-fetch-sender-fast, gnus-registry-store-extra-entry):
1887 Remove text properties on ingress into the registry and when it's saved.
1888 (gnus-registry-clean-empty-function): Fix bug with cleaning the
1889 registry from entries with no groups.
722 1890
723 * gnus-util.el (gnus-with-local-quit): New macro. 18912006-09-28 Teodor Zlatanov <tzz@lifelogs.com>
724 1892
725 * gnus-demon.el (gnus-demon): Replace with-local-quit with it. 1893 * gnus-util.el (gnus-string-remove-all-properties): Add utility
1894 function to remove string properties.
726 1895
7272006-09-28 Reiner Steib <Reiner.Steib@gmx.de> 18962006-09-28 Reiner Steib <Reiner.Steib@gmx.de>
728 1897
@@ -733,10 +1902,35 @@
733 1902
734 * gnus-draft.el (gnus-draft-mode): Don't call `mml-mode'. 1903 * gnus-draft.el (gnus-draft-mode): Don't call `mml-mode'.
735 1904
19052006-09-27 Reiner Steib <Reiner.Steib@gmx.de>
1906
1907 * gnus-art.el (gnus-insert-prev-page-button)
1908 (gnus-insert-next-page-button): Simplify. Reformat.
1909
19102006-09-27 Maxime Edouard Robert Froumentin <max@lapin-bleu.net>
1911
1912 * gnus-art.el (gnus-insert-prev-page-button)
1913 (gnus-insert-next-page-button): Apply gnus-article-button-face.
1914
7362006-09-25 Chong Yidong <cyd@stupidchicken.com> 19152006-09-25 Chong Yidong <cyd@stupidchicken.com>
737 1916
738 * gnus-demon.el (gnus-demon): Use with-local-quit to avoid hangs. 1917 * gnus-demon.el (gnus-demon): Use with-local-quit to avoid hangs.
739 1918
19192006-09-20 Maxime Edouard Robert Froumentin <max@lapin-bleu.net>
1920
1921 (gnus-insert-mime-button, gnus-insert-mime-security-button): Apply
1922 gnus-article-button-face to MIME and security buttons.
1923
19242006-09-20 Reiner Steib <Reiner.Steib@gmx.de>
1925
1926 * gnus-art.el (gnus-button-url-regexp): Try to make the value more
1927 readable.
1928
19292006-09-20 Steve Youngs <steve@sxemacs.org>
1930
1931 * gnus-art.el (gnus-article-browse-html-parts): They're files, so use
1932 `browse-url-of-file' instead of `browse-url'.
1933
7402006-09-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 19342006-09-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
741 1935
742 * nnslashdot.el (nnslashdot-request-article): Update end-of-article 1936 * nnslashdot.el (nnslashdot-request-article): Update end-of-article
@@ -744,31 +1938,67 @@
744 1938
7452006-09-16 Katsumi Yamaoka <yamaoka@jpl.org> 19392006-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
746 1940
747 * message.el (message-cite-original-without-signature): Use nobody by 1941 * message.el (message-cite-original-1): Use nobody by default for the
748 default for the value of From header. 1942 value of From header.
749 (message-cite-original): Ditto.
750 (message-reply): Ditto. 1943 (message-reply): Ditto.
751 1944
19452006-09-11 Daiki Ueno <ueno@unixuser.org>
1946
1947 * mml2015.el (mml2015-epg-clear-decrypt): Don't append verify results
1948 to the gnus-info. This fixes a bug of inline-PGP message verification.
1949 Reported by Michael Piotrowski <mxp@dynalabs.de>.
1950
7522006-09-09 Reiner Steib <Reiner.Steib@gmx.de> 19512006-09-09 Reiner Steib <Reiner.Steib@gmx.de>
753 1952
754 * pop3.el (pop3-leave-mail-on-server): Mention problem of duplicate 1953 * pop3.el (pop3-leave-mail-on-server): Mention problem of duplicate
755 mails in the doc string. Add some URLs in comment. 1954 mails in the doc string. Add some URLs in comment.
1955 (pop3-movemail): Warn about pop3-leave-mail-on-server.
756 1956
7572006-09-07 Katsumi Yamaoka <yamaoka@jpl.org> 19572006-09-07 Katsumi Yamaoka <yamaoka@jpl.org>
758 1958
759 * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): Fix 1959 * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): Fix
760 backslashes handling and the way to find boundaries of quoted strings. 1960 backslashes handling and the way to find boundaries of quoted strings.
761 1961
19622006-09-07 Daiki Ueno <ueno@unixuser.org>
1963
1964 * mml1991.el (mml1991-epg-encrypt): Simply throw an error if
1965 mml1991-encrypt-to-self is set and mml1991-signers is not set.
1966 * mml2015.el (mml2015-epg-encrypt): Simply throw an error if
1967 mml2015-encrypt-to-self is set and mml2015-signers is not set.
1968
7622006-09-06 Reiner Steib <Reiner.Steib@gmx.de> 19692006-09-06 Reiner Steib <Reiner.Steib@gmx.de>
763 1970
764 * gnus-art.el (gnus-button-regexp, gnus-button-marker-list) 1971 * gnus-art.el (gnus-button-marker-list): Move up. Convert comment into
765 (gnus-button-last): Move up. Convert comments into doc strings. 1972 doc string.
1973 (gnus-button-regexp, gnus-button-last): Remove unused variables.
1974
19752006-09-06 Simon Josefsson <jas@extundo.com>
1976
1977 * mml2015.el (mml2015-use): Doc fix, mention epg.
1978
19792006-09-06 Daiki Ueno <ueno@unixuser.org>
1980
1981 * mml2015.el (mml2015-use): Default to epg, if available.
1982
19832006-09-06 Daiki Ueno <ueno@unixuser.org>
1984
1985 * mml1991.el (mml1991-epg-sign): Don't lookup a private key by
1986 message-sender.
1987 (mml1991-epg-encrypt): Ditto.
1988 * mml2015.el (mml2015-epg-sign): Don't lookup a private key by
1989 message-sender.
1990 (mml2015-epg-encrypt): Ditto.
766 1991
7672006-09-04 Chong Yidong <cyd@stupidchicken.com> 19922006-09-04 Chong Yidong <cyd@stupidchicken.com>
768 1993
769 * message.el (message-send-mail-with-sendmail): Look for sendmail in 1994 * message.el (message-send-mail-with-sendmail): Look for sendmail in
770 several common directories. 1995 several common directories.
771 1996
19972006-09-05 Daiki Ueno <ueno@unixuser.org>
1998
1999 * mml2015.el (mml2015-epg-encrypt): Expand group configuration.
2000 * mml1991.el (mml1991-epg-encrypt): Expand group configuration.
2001
7722006-09-04 Katsumi Yamaoka <yamaoka@jpl.org> 20022006-09-04 Katsumi Yamaoka <yamaoka@jpl.org>
773 2003
774 * gnus-art.el (article-decode-encoded-words): Make it fast. 2004 * gnus-art.el (article-decode-encoded-words): Make it fast.
@@ -810,16 +2040,36 @@
810 (rfc2047-decode-address-region): New function. 2040 (rfc2047-decode-address-region): New function.
811 (rfc2047-decode-address-string): New function. 2041 (rfc2047-decode-address-string): New function.
812 2042
8132006-08-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 20432006-08-31 Reiner Steib <Reiner.Steib@gmx.de>
814 2044
815 [ Backported bug fix from No Gnus. ] 2045 * message.el (message-caesar-buffer-body): Allow rotating headers.
816 2046
817 * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try 2047 * gnus-sum.el (gnus-summary-caesar-message): Allow rotating headers.
818 looking up the method using GROUP's prefix before inventing a new one. 2048
819 It is used on killed/unknown groups in various places where returning 2049 * message.el (message-insert-formated-citation-line): Fix %f.
820 an all-new method isn't expected by the caller. 2050 Reported by Torsten Bronger <bronger@physik.rwth-aachen.de> .
821 2051
822 * gnus-util.el (gnus-group-server): Copy required macro from No Gnus. 20522006-08-18 Katsumi Yamaoka <yamaoka@jpl.org>
2053
2054 * gnus-bookmark.el (gnus-bookmark-file-coding-system): New variable.
2055 (gnus-bookmark-mouse-available-p): New macro.
2056 (gnus-bookmark-bmenu-list): Use it; use gnus-mouse-2.
2057 (gnus-bookmark-bmenu-show-infos): Use it.
2058 (gnus-bookmark-insert-details): Use it; use gnus-mouse-2.
2059 (gnus-bookmark-bmenu-hide-infos): Ditto.
2060 (gnus-bookmark-remove-properties): New function.
2061 (gnus-bookmark-set, gnus-bookmark-make-cell): Use it.
2062 (gnus-bookmark-set-bookmark-name): Don't use 2nd arg of split-string.
2063 (gnus-bookmark-write-file): Bind coding-system-for-write.
2064 (gnus-bookmark-insert-file-format-version-stamp): Add coding cookie.
2065 (gnus-bookmark-jump): Make completing-read work with XEmacs; activate
2066 group before selecting it.
2067 (gnus-bookmark-get-bookmark): Use assoc instead of assoc-string.
2068 (gnus-bookmark-bmenu-mode-map): Bind `q' to bury-buffer instead of
2069 quit-window if it is not available; use gnus-mouse-2 and bind it to
2070 gnus-bookmark-bmenu-select-by-mouse.
2071 (gnus-bookmark-show-details): Remove unused variable `details-list'.
2072 (gnus-bookmark-bmenu-select-by-mouse): New function.
823 2073
8242006-08-13 Romain Francoise <romain@orebokech.com> 20742006-08-13 Romain Francoise <romain@orebokech.com>
825 2075
@@ -849,11 +2099,66 @@
849 2099
850 * nnheader.el (nnheader-insert-head): Make it work with Mac as well. 2100 * nnheader.el (nnheader-insert-head): Make it work with Mac as well.
851 2101
21022006-07-28 Daiki Ueno <ueno@unixuser.org>
2103
2104 * mml2015.el (mml2015-epg-sign): If mml2015-signers is not set, use the
2105 first matching secret key.
2106 (mml2015-epg-encrypt): Ditto.
2107
2108 * mml1991.el (mml1991-epg-sign): If mml1991-signers is not set, use the
2109 first matching secret key.
2110 (mml1991-epg-encrypt): Ditto.
2111
2112 * mml2015.el (mml2015-encrypt-to-self): New user option.
2113 (mml2015-epg-encrypt): Append mml2015-signers to recipients list if
2114 mml2015-epg-encrypt-to-self is set.
2115
2116 * mml1991.el (mml1991-encrypt-to-self): New variable.
2117 (mml1991-epg-encrypt): Append mml1991-signers to recipients list if
2118 mml1991-epg-encrypt-to-self is set.
2119
2120 * mml2015.el (mml2015-signers): New user option.
2121 (mml2015-epg-sign): Reflect the value of mml2015-signers.
2122 (mml2015-epg-encrypt): Allow to select signing keys.
2123
2124 * mml1991.el (mml1991-signers): New variable.
2125 (mml1991-epg-sign): Reflect the value of mml1991-signers.
2126 (mml1991-epg-encrypt): Allow to select signing keys.
2127
8522006-07-27 Katsumi Yamaoka <yamaoka@jpl.org> 21282006-07-27 Katsumi Yamaoka <yamaoka@jpl.org>
853 2129
854 * nnheader.el (nnheader-insert-head): Make it work even if the file 2130 * nnheader.el (nnheader-insert-head): Make it work even if the file
855 uses CRLF for the line-break code. 2131 uses CRLF for the line-break code.
856 2132
21332006-07-25 Daiki Ueno <ueno@unixuser.org>
2134
2135 * mml2015.el: Require mml-sec instead of password.
2136 (mml2015-verbose): Inherit the default value from mml-secure-verbose.
2137 (mml2015-cache-passphrase): Inherit the default value from
2138 mml-secure-cache-passphrase.
2139 (mml2015-passphrase-cache-expiry): Inherit the default value from
2140 mml-secure-passphrase-cache-expiry.
2141
2142 * mml1991.el: Require mml-sec instead of password.
2143 (mml1991-verbose): Inherit the default value from mml-secure-verbose.
2144 (mml1991-cache-passphrase): Inherit the default value from
2145 mml-secure-cache-passphrase.
2146 (mml1991-passphrase-cache-expiry): Inherit the default value from
2147 mml-secure-passphrase-cache-expiry.
2148
2149 * mml-sec.el: Require password.
2150 (mml-secure-verbose): New user option.
2151 (mml-secure-cache-passphrase): New user option.
2152 (mml-secure-passphrase-cache-expiry): New user option.
2153
21542006-07-24 Daiki Ueno <ueno@unixuser.org>
2155
2156 * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8
2157 letters from the end. Thanks to "David Smith" <davidsmith@acm.org> and
2158 andreas@altroot.de (Andreas V,Av(Bgele)
2159
2160 FIXME: Use `tiny change'?
2161
8572006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 21622006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
858 2163
859 * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close 2164 * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close
@@ -861,25 +2166,17 @@
861 2166
862 * nnweb.el (nnweb-google-create-mapping): Update regexp. 2167 * nnweb.el (nnweb-google-create-mapping): Update regexp.
863 2168
21692006-07-19 Katsumi Yamaoka <yamaoka@jpl.org>
2170
2171 * gnus-sum.el (gnus-select-newsgroup): Setup the article buffer
2172 correctly. This fixes a bug caused by the 2006-05-12 change.
2173
8642006-07-18 Karl Fogel <kfogel@red-bean.com> 21742006-07-18 Karl Fogel <kfogel@red-bean.com>
865 2175
866 * nnmail.el (nnmail-article-group): If splitting raises an error, give 2176 * nnmail.el (nnmail-article-group): If splitting raises an error, give
867 some information about the error when saying that the `bogus' mail 2177 some information about the error when saying that the `bogus' mail
868 group will be used. 2178 group will be used.
869 2179
8702006-07-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
871
872 [ Backported bug fixes from No Gnus. ]
873
874 * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
875 (nnweb-google-search): Respect nnweb-max-hits as upper bound.
876 (nnweb-request-article): Do proper xwfu encoding when fetching articles
877 by message-id.
878
879 * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe
880 unsubscribed groups as if they were killed ones. It causes duplicate
881 entries in gnus-newsrc-alist.
882
8832006-07-17 Reiner Steib <Reiner.Steib@gmx.de> 21802006-07-17 Reiner Steib <Reiner.Steib@gmx.de>
884 2181
885 * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc 2182 * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc
@@ -893,24 +2190,133 @@
893 2190
894 * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix. 2191 * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix.
895 2192
21932006-07-10 Daiki Ueno <ueno@unixuser.org>
2194
2195 * mml1991.el (mml1991-function-alist): Add epg.
2196 (mml1991-epg-passphrase-callback, mml1991-epg-sign)
2197 (mml1991-epg-encrypt): New functions.
2198
21992006-07-10 Daiki Ueno <ueno@unixuser.org>
2200
2201 * mml2015.el (mml2015-verbose): New variable.
2202 (mml2015-cache-passphrase): Ditto.
2203 (mml2015-passphrase-cache-expiry): Ditto.
2204 (mml2015-function-alist): Add epg.
2205 (mml2015-epg-passphrase-callback, mml2015-epg-decrypt)
2206 (mml2015-epg-clear-decrypt, mml2015-epg-verify)
2207 (mml2015-epg-clear-verify, mml2015-epg-sign, mml2015-epg-encrypt): New
2208 functions.
2209
22102006-07-08 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2211
2212 * message.el (message-cite-original-1): Preserve region when removing
2213 quoted text due to X-No-Archive in order to avoid bogus attribution
2214 when citing multiple messages.
2215
22162006-06-27 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2217
2218 * gnus-group.el (gnus-group-sort-by-unread): Fix typo. Reported by
2219 Kenneth Jacker <khj@be.cs.appstate.edu>.
2220
8962006-06-26 Reiner Steib <Reiner.Steib@gmx.de> 22212006-06-26 Reiner Steib <Reiner.Steib@gmx.de>
897 2222
898 * gnus-diary.el (gnus-user-format-function-d) 2223 * gnus-diary.el (gnus-user-format-function-d)
899 (gnus-user-format-function-D): Autoload. 2224 (gnus-user-format-function-D): Autoload.
900 2225
9012006-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> 2226 * imap.el (Commentary): Fix typo.
902 2227
903 * gnus-group.el (gnus-group-select-group): Doc fix. 2228 * gnus-util.el (kill-empty-logs, gnus-byte-compile): Remove anonymous
904 [ See 2004-05-19 change on the trunk. ] 2229 2006-04-22 contribution.
2230
22312006-06-26 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2232
2233 * gnus.el (gnus-valid-select-methods): Revert last change for nnweb.
2234 It didn't really fix the bogosity I'm seeing with solid web groups.
2235
22362006-06-26 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2237
2238 * gnus.el (gnus-valid-select-methods): Declare nnweb with 'address.
2239 Since revision 6.95 (2003-01-05) of gnus-group.el, solid web groups are
2240 created using server names. If we use the feature without declaring
2241 it, Gnus does not properly manage server and group state.
2242
2243 * nnweb.el (nnweb-google-search): Respect nnweb-max-hits as upper
2244 bound.
2245
22462006-06-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2247
2248 * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try
2249 looking up the method using GROUP's prefix before inventing a new one.
2250 It is used on killed/unknown groups in various places where returning
2251 an all-new method isn't expected by the caller.
2252
2253 * gnus-util.el (gnus-group-server): Fix for empty virtual server names
2254 and match semantics of gnus-group-real-prefix.
2255
22562006-06-22 Reiner Steib <Reiner.Steib@gmx.de>
2257
2258 * nnmail.el (nnmail-broken-references-mailers): New variable.
2259 (nnmail-ignore-broken-references): New function generalizing
2260 nnmail-fix-eudora-headers.
2261 (nnmail-fix-eudora-headers): Now obsolete.
2262
2263 * gnus-art.el (gnus-button-handle-custom): Support
2264 `customize-apropos*'.
2265
22662006-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
2267
2268 * gnus-art.el (article-hide-headers): Inhibit read-only stuff.
2269
2270 * gnus-group.el (gnus-fetch-group): Document ARTICLES and select those
2271 articles.
2272
22732006-06-21 Reiner Steib <Reiner.Steib@gmx.de>
2274
2275 * message.el (message-cite-reply-above): New variable.
2276 (message-yank-original): Use it.
905 2277
9062006-06-20 Katsumi Yamaoka <yamaoka@jpl.org> 22782006-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
907 2279
908 * rfc2231.el (rfc2231-parse-string): Allow `*'s in parameter values. 2280 * rfc2231.el (rfc2231-parse-string): Allow `*'s in parameter values.
909 2281
22822006-06-20 Reiner Steib <Reiner.Steib@gmx.de>
2283
2284 * gnus-bookmark.el (gnus-bookmark-jump): Don't mark unrelated articles
2285 as read.
2286
2287 * gnus-group.el (gnus-group-quick-select-group): Add GROUP argument.
2288
22892006-06-19 Reiner Steib <Reiner.Steib@gmx.de>
2290
2291 * gnus-bookmark.el: Fix Copyright, keywords, whitespace, etc.
2292 (gnus-bookmark-default-file): Use gnus-directory.
2293 (gnus-bookmark-bmenu-file-column, gnus-bookmark-use-annotations):
2294 Remove "*" in doc string.
2295 (gnus-bookmark-write-file): Simplify.
2296 (gnus-bookmark-maybe-sort-alist): Use `when'.
2297 (gnus-bookmark-get-bookmark): Fix typo in doc string.
2298 (gnus-bookmark-set-bookmark-name, gnus-bookmark-get-bookmark): Add
2299 FIXME about Emacs 21 and XEmacs compatibility.
2300 (gnus-bookmark-set-bookmark-name): Use `gnus-replace-in-string' for
2301 compatibility.
2302 (gnus-bookmark-bmenu-mode): Use `gnus-run-mode-hooks' for
2303 compatibility.
2304 (gnus-bookmark-menu-heading): Fix version.
2305
23062006-06-19 Bastien Guerry <bzg@altern.org>
2307
2308 * gnus-bookmark.el: New file.
2309
9102006-06-19 Katsumi Yamaoka <yamaoka@jpl.org> 23102006-06-19 Katsumi Yamaoka <yamaoka@jpl.org>
911 2311
912 * message.el (message-syntax-checks): Doc fix. 2312 * message.el (message-syntax-checks): Doc fix.
913 2313
23142006-06-17 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2315
2316 * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe
2317 unsubscribed groups as if they were killed ones. It causes duplicate
2318 entries in gnus-newsrc-alist.
2319
9142006-06-16 Katsumi Yamaoka <yamaoka@jpl.org> 23202006-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
915 2321
916 * message.el (message-syntax-checks): Doc fix. 2322 * message.el (message-syntax-checks): Doc fix.
@@ -922,18 +2328,42 @@
922 2328
923 * gnus-art.el (gnus-display-mime): Make sure body ends with newline. 2329 * gnus-art.el (gnus-display-mime): Make sure body ends with newline.
924 2330
23312006-06-11 Reiner Steib <Reiner.Steib@gmx.de>
2332
2333 * gnus-art.el (gnus-article-toggle-truncate-lines): Fix code.
2334
23352006-06-11 Katsumi Yamaoka <yamaoka@jpl.org>
2336
2337 * gnus-art.el (gnus-article-truncate-lines): Default to the value of
2338 default-truncate-lines.
2339
9252006-06-06 Katsumi Yamaoka <yamaoka@jpl.org> 23402006-06-06 Katsumi Yamaoka <yamaoka@jpl.org>
926 2341
927 * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list 2342 * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list
928 to fill the utf-8 entry. 2343 to fill the utf-8 entry.
929 2344
9302006-06-05 Dan Christensen <jdc@uwo.ca> 23452006-06-01 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
931 2346
932 * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded, 2347 * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
933 respect display group parameter and gnus-summary-expunge-below. 2348
934 (gnus-articles-to-read): Remove unused reference to display group 23492006-05-30 Kevin Greiner <kevin.greiner@compsol.cc>
935 parameter. 2350
936 [ Merge 2004-07-06 change from the trunk. ] 2351 * gnus-agent.el (directory-files-and-attributes): Move all the way
2352 forward (the third and final move).
2353 (gnus-agent-read-agentview): Trap reconstruction errors due to
2354 nonexistant directory. Handle by returning nil.
2355
23562006-05-30 Didier Verna <didier@xemacs.org>
2357
2358 * message.el (message-dont-reply-to-names): Update the custom type.
2359 * message.el (message-dont-reply-to-names): New defsubst: potentially
2360 convert a list of regexps into a single one.
2361 * message.el (message-get-reply-headers): Use it.
2362 * nnmail.el (nnmail-fancy-expiry-target): Ditto.
2363
23642006-05-30 Katsumi Yamaoka <yamaoka@jpl.org>
2365
2366 * gnus-agent.el (directory-files-and-attributes): Move forward.
937 2367
9382006-05-29 Reiner Steib <Reiner.Steib@gmx.de> 23682006-05-29 Reiner Steib <Reiner.Steib@gmx.de>
939 2369
@@ -946,64 +2376,162 @@
946 * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead 2376 * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead
947 of doing it manually. 2377 of doing it manually.
948 2378
23792006-05-29 Reiner Steib <Reiner.Steib@gmx.de>
2380
2381 * gnus-art.el (gnus-article-toggle-truncate-lines): Fix typo in
2382 comment.
2383
9492006-05-29 Kevin Greiner <kevin.greiner@compsol.cc> 23842006-05-29 Kevin Greiner <kevin.greiner@compsol.cc>
950 2385
951 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server 2386 * gnus-agent.el (Added gnus-agent-flush*) to purge agent info.
952 must be explicitly online rather than "not explicitly offline" for 2387 (gnus-agent-read-agentview): Fixed handling of end-of-file error.
953 its flags to be synchronized.
954 (gnus-agent-read-local): All symbols allocated in my-obarray 2388 (gnus-agent-read-local): All symbols allocated in my-obarray
955 (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). 2389 (gnus-agent-set-local): Skip invalid entries (min and/or max is nil).
956 (gnus-agent-regenerate-group): Check numeric names to see if they are 2390 (gnus-agent-regenerate-group): Check numeric names to see if they are
957 messages or groups. 2391 messages or groups.
2392 (gnus-agent-total-fetched-for): Ignore 'dummy.group' (there should be a
2393 better way of do this...)
2394
2395 * gnus-cache.el (gnus-agent-total-fetched-for): Ignore
2396 'dummy.group' (there should be a better way of do this...)
958 2397
9592006-05-29 Katsumi Yamaoka <yamaoka@jpl.org> 23982006-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
960 2399
961 * gnus-art.el (gnus-save-all-headers): Mention it might be overridden. 2400 * gnus-art.el (gnus-save-all-headers): Mention it might be overridden.
962 (gnus-saved-headers): Ditto. 2401 (gnus-saved-headers): Ditto.
963 (gnus-default-article-saver): Doc fix; add 2402 (gnus-default-article-saver): Mention functions may have properties.
964 gnus-summary-write-body-to-file; mention functions may have properties.
965 (gnus-article-save-coding-system): New variable.
966 (gnus-article-save): Override gnus-save-all-headers and 2403 (gnus-article-save): Override gnus-save-all-headers and
967 gnus-saved-headers by :headers property which saver function may have. 2404 gnus-saved-headers by :headers property which saver function may have.
2405 (gnus-summary-save-in-file): Add :headers property.
2406 (gnus-summary-write-to-file): Ditto.
2407
2408 * gnus-sum.el (gnus-summary-save-article): Bind
2409 gnus-prompt-before-saving to t when saving many articles in a file;
2410 always show all headers.
2411
24122006-05-26 Reiner Steib <Reiner.Steib@gmx.de>
2413
2414 * deuglify.el (gnus-outlook-rearrange-article): Add missing citation
2415 marks.
2416
2417 * message.el (message-indent-citation): Add optional arguments to allow
2418 using it outside of message buffers.
2419
2420 * gnus-art.el (gnus-article-unfold-long-headers): New variable.
2421 (gnus-article-treat-unfold-headers): Use it.
2422 (gnus-article-truncate-lines): New variable.
2423 (gnus-article-mode): Use it.
2424 (gnus-article-toggle-truncate-lines): New function.
2425
2426 * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar): Add
2427 gnus-article-toggle-truncate-lines.
2428
2429 * uudecode.el (uudecode-decode-region-external): nil isn't a valid
2430 coding system in XEmacs, use binary.
2431
24322006-05-26 Katsumi Yamaoka <yamaoka@jpl.org>
2433
2434 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit
2435 after-load-alist.
2436
2437 * gnus-art.el (gnus-summary-save-in-file): Use property to specify
2438 this function should save decoded articles.
2439 (gnus-summary-write-to-file): Use property to specify this function
2440 should save decoded articles and specify gnus-summary-save-in-file
2441 should be used to save articles other than the first one when saving
2442 many articles.
2443 (gnus-summary-save-body-in-file): Use property to specify this
2444 function should save decoded articles.
2445 (gnus-summary-write-body-to-file): Use property to specify this
2446 function should save decoded articles and specify
2447 gnus-summary-save-body-in-file should be used to save articles other
2448 than the first one when saving many articles.
2449
2450 * gnus-sum.el (gnus-summary-save-article): Simplify.
2451
24522006-05-25 Katsumi Yamaoka <yamaoka@jpl.org>
2453
2454 * gnus-art.el (gnus-default-article-saver): Add
2455 gnus-summary-write-body-to-file.
2456 (gnus-article-save-coding-system): Don't use coding system object
2457 in XEmacs.
968 (gnus-read-save-file-name): Add optional `dir-var' argument which 2458 (gnus-read-save-file-name): Add optional `dir-var' argument which
969 specifies directory in which files are saved; work even if optional 2459 specifies directory in which files are saved; work even if optional
970 `variable' argument is not specified. 2460 `variable' argument is not specified.
971 (gnus-summary-save-in-file): Add properties :decode and :headers. 2461 (gnus-summary-write-to-file): Read file name.
972 (gnus-summary-write-to-file): Add properties :decode, :function, and 2462 (gnus-summary-save-body-in-file): Add optional `overwrite' argument.
973 :headers; read file name. 2463 (gnus-summary-write-body-to-file): New function.
974 (gnus-summary-save-body-in-file): Add :decode property; add optional
975 `overwrite' argument.
976 (gnus-summary-write-body-to-file): New function; add properties
977 :decode and :function.
978 (gnus-output-to-file): Add coding cookie and encode text according
979 to gnus-article-save-coding-system; don't use mm-append-to-file.
980 2464
981 * gnus-sum.el (gnus-newsgroup-last-directory): New variable. 2465 * gnus-sum.el (gnus-newsgroup-last-directory): New variable.
982 (gnus-summary-local-variables): Add it. 2466 (gnus-summary-local-variables): Add it.
983 (gnus-summary-save-map): Add gnus-summary-write-article-body-file. 2467 (gnus-summary-save-map): Add gnus-summary-write-article-body-file.
984 (gnus-summary-save-article): Require gnus-art; save decoded articles 2468 (gnus-summary-save-article): Remove optional `decode' argument;
985 if function that gnus-default-article-saver specifies has `:decode' 2469 determine whether to decode articles by the value of
986 property; bind gnus-prompt-before-saving to t when saving many 2470 gnus-default-article-saver; when saving many files using
987 articles in a file; move point to article which will be saved. 2471 gnus-summary-write-to-file or gnus-summary-write-body-to-file, use
2472 it first and use gnus-summary-save-in-file or
2473 gnus-summary-save-body-in-file thereafter unless
2474 gnus-prompt-before-saving is always; move point to article which
2475 will be saved.
2476 (gnus-summary-save-article-file): Revert.
2477 (gnus-summary-write-article-file): Revert.
2478 (gnus-summary-save-article-body-file): Revert.
988 (gnus-summary-write-article-body-file): New function. 2479 (gnus-summary-write-article-body-file): New function.
989 2480
9902006-05-26 Reiner Steib <Reiner.Steib@gmx.de> 24812006-05-26 Reiner Steib <Reiner.Steib@gmx.de>
991 2482
992 * uudecode.el (uudecode-decode-region-external): Fix previous commit. 2483 * gnus-art.el (gnus-article-browse-html-article): Remove comment.
993 2484
9942006-05-26 Katsumi Yamaoka <yamaoka@jpl.org> 24852006-05-24 Katsumi Yamaoka <yamaoka@jpl.org>
995 2486
996 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit 2487 * gnus-art.el (gnus-default-article-saver): Doc fix.
997 after-load-alist. 2488 (gnus-article-save-coding-system): Move from gnus-sum.el, rename
2489 from gnus-summary-save-article-coding-system, and default to a
2490 certain coding system.
2491 (gnus-output-to-file): Add coding cookie and encode text according
2492 to gnus-article-save-coding-system; don't use mm-append-to-file.
998 2493
9992006-05-22 Reiner Steib <Reiner.Steib@gmx.de> 2494 * gnus-sum.el (gnus-summary-save-article-coding-system): Move to
2495 gnus-art.el and rename to gnus-article-save-coding-system.
2496 (gnus-summary-save-article): Require gnus-art; don't show all
2497 headers if it decodes articles; don't add coding cookie here;
2498 don't bind mm-text-coding-system-for-write.
2499 (gnus-summary-save-article-file): Save decoded articles.
2500 (gnus-summary-write-article-file): When saving many files, use
2501 gnus-summary-write-to-file first and gnus-summary-save-in-file
2502 thereafter unless gnus-prompt-before-saving is always.
2503 (gnus-summary-save-article-body-file): Save decoded articles.
1000 2504
1001 * uudecode.el (uudecode-decode-region-external): nil isn't a valid 25052006-05-23 Reiner Steib <Reiner.Steib@gmx.de>
1002 coding system in XEmacs, use binary.
1003 2506
1004 * mail-source.el (mail-sources): Fix custom type. 2507 * nnrss.el (nnrss-check-group): Bind hash-index.
1005 2508
1006 * imap.el (Commentary): Fix typo. 25092006-05-23 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org>
2510
2511 * nnrss.el (nnrss-check-group): Use the md5sum of the whole RSS item as
2512 its hash index. Store this hash in `nnrss-group-data'.
2513 (nnrss-read-group-data): Update accordingly.
2514
25152006-05-23 Reiner Steib <Reiner.Steib@gmx.de>
2516
2517 * gnus-art.el (gnus-button-alist): Improve gnus-button-handle-symbol
2518 entry.
2519
2520 * gnus-sum.el (gnus-summary-make-menu-bar): Add
2521 gnus-article-browse-html-article.
2522
25232006-05-23 Hynek Schlawack <hynek@ularx.de>
2524
2525 * gnus-sum.el (gnus-summary-mime-map): Add
2526 gnus-article-browse-html-article.
25272006-05-23 Reiner Steib <Reiner.Steib@gmx.de>
2528
2529 * gnus-sum.el (gnus-summary-save-article-coding-system): Offer some
2530 suitable coding systems in customize.
2531
25322006-05-22 Reiner Steib <Reiner.Steib@gmx.de>
2533
2534 * mail-source.el (mail-sources): Fix custom type.
1007 2535
10082006-05-18 Reiner Steib <Reiner.Steib@gmx.de> 25362006-05-18 Reiner Steib <Reiner.Steib@gmx.de>
1009 2537
@@ -1015,6 +2543,41 @@
1015 (gmm-image-search-load-path): Use it. 2543 (gmm-image-search-load-path): Use it.
1016 (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'. 2544 (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'.
1017 2545
25462006-05-17 Katsumi Yamaoka <yamaoka@jpl.org>
2547
2548 * gnus-sum.el (gnus-summary-save-article-coding-system): New
2549 variable.
2550 (gnus-summary-save-article): Add optional `decode' argument. If
2551 it is set and gnus-summary-save-article-coding-system is non-nil,
2552 save decoded article.
2553 (gnus-summary-write-article-file): Save decoded article if
2554 gnus-summary-save-article-coding-system is non-nil.
2555
2556 * ecomplete.el (ecomplete-database-file-coding-system): Fix custom
2557 type.
2558
25592006-05-16 Katsumi Yamaoka <yamaoka@jpl.org>
2560
2561 * gnus-art.el (easy-menu-define): Use :active instead of :enable.
2562
25632006-05-12 Katsumi Yamaoka <yamaoka@jpl.org>
2564
2565 * gnus-art.el (gnus-article-setup-buffer): Go to summary buffer
2566 first to test gnus-single-article-buffer which may be buffer-local.
2567
2568 * gnus-sum.el (gnus-summary-setup-buffer): Make
2569 gnus-single-article-buffer buffer-local and nil in ephemeral
2570 group; make gnus-article-buffer, gnus-article-current, and
2571 gnus-original-article-buffer always buffer-local.
2572 (gnus-summary-exit): Kill article buffer belonging to ephemeral
2573 group.
2574 (gnus-handle-ephemeral-exit): Don't move to next summary line.
2575
25762006-05-08 Reiner Steib <Reiner.Steib@gmx.de>
2577
2578 * nnml.el (nnml-request-compact-group): Compressed files might not
2579 have .gz extension.
2580
10182006-05-04 Stefan Monnier <monnier@iro.umontreal.ca> 25812006-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
1019 2582
1020 * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment. 2583 * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment.
@@ -1022,17 +2585,63 @@
1022 (mm-display-part): Simplify. 2585 (mm-display-part): Simplify.
1023 (mm-inlinable-p): Add optional arg `type'. 2586 (mm-inlinable-p): Add optional arg `type'.
1024 2587
25882006-05-03 Stefan Monnier <monnier@iro.umontreal.ca>
2589
1025 * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg. 2590 * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg.
1026 (gnus-mime-view-part-externally, gnus-mime-view-part-internally): 2591 (gnus-mime-view-part-externally, gnus-mime-view-part-internally):
1027 Try harder to show the attachment internally or externally using 2592 Try harder to show the attachment internally or externally using
1028 gnus-mime-view-part-as-type. 2593 gnus-mime-view-part-as-type.
1029 2594
10302006-05-04 Reiner Steib <Reiner.Steib@gmx.de> 25952006-05-02 Reiner Steib <Reiner.Steib@gmx.de>
1031 2596
1032 * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch 2597 * message.el (message-from-style, message-signature-separator)
1033 `filename' from Content-Disposition if Content-Type doesn't 2598 (message-user-organization-file, message-send-mail-function)
1034 provide `name'. 2599 (message-citation-line-function, message-yank-prefix)
1035 (gnus-mime-view-part-as-type): Set default instead of initial-input. 2600 (message-indent-citation-function, message-signature)
2601 (message-signature-file, message-signature-insert-empty-line):
2602 Remove autoloads.
2603
2604 * gnus-art.el (gnus-buttonized-mime-types): Remove
2605 "multipart/signed". Revert 2006-04-26 change.
2606
26072006-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
2608
2609 * gnus.el (gnus-version-number): Bump version.
2610
26112006-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
2612
2613 * gnus.el: No Gnus v0.5 is released.
2614
26152006-04-30 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2616
2617 * nnweb.el (nnweb-request-article): Do proper xwfu encoding when
2618 fetching articles by message-id.
2619
26202006-04-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
2621
2622 * message.el (hashcash): Require hashcash as normal.
2623
2624 * ecomplete.el (ecomplete-highlight-match-line): Use
2625 point-at-eol.
2626 (ecomplete-highlight-match-line): Use `highlight', because that
2627 face exists in both Emacs and XEmacs.
2628
2629 * message.el (message-display-abbrev): Use point-at-bol.
2630
2631 * mail-source.el: Don't require timer/timer-funcs.
2632
2633 * gnus-async.el: Ditto.
2634
2635 * password.el: Ditto.
2636
2637 * mm-url.el: Ditto.
2638
2639 * mm-util.el: Require timer/timer-funcs.
2640
26412006-04-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2642
2643 * mm-url.el (mm-url-insert-file-contents): Don't set Connection:
2644 Close.
1036 2645
10372006-04-28 Katsumi Yamaoka <yamaoka@jpl.org> 26462006-04-28 Katsumi Yamaoka <yamaoka@jpl.org>
1038 2647
@@ -1050,26 +2659,34 @@
1050 2659
10512006-04-26 Reiner Steib <Reiner.Steib@gmx.de> 26602006-04-26 Reiner Steib <Reiner.Steib@gmx.de>
1052 2661
1053 * deuglify.el (gnus-outlook-deuglify-unwrap-min) 2662 * message.el (message-user-organization-file): Check several
1054 (gnus-outlook-deuglify-unwrap-max): Remove autoload. 2663 locations of the organization file.
1055 2664
1056 * mml-sec.el (mml-secure-method): New internal variable. 2665 * gnus-sum.el (gnus-summary-mime-map, gnus-summary-make-menu-bar):
1057 (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) 2666 Add gnus-article-view-part-as-type.
1058 (mml-secure-message-sign-encrypt, mml-secure-message-encrypt):
1059 New functions using mml-secure-method. Sync from the trunk.
1060 2667
1061 * mml.el (mml-mode-map): Add key bindings for those functions. 2668 * gnus-art.el (gnus-article-view-part-as-type): New function.
1062 (mml-menu): Simplify security menu entries. Suggested by Jesper
1063 Harder <harder@myrealbox.com>. Sync from the trunk.
1064 2669
1065 * message.el (message-valid-fqdn-regexp): Add TLDs .cat, jobs, 2670 * message.el (message-valid-fqdn-regexp): Add TLDs .cat, jobs,
1066 .mobi and .travel. Remove .nato, .bitnet and .uucp. 2671 .mobi and .travel. Remove .nato, .bitnet and .uucp.
1067 (message-in-body-p): New function. Sync from the trunk.
1068 2672
1069 * mml.el (mml-mode, mml-dnd-protocol-alist) 2673 * mml.el: Simplify autoload.
1070 (mml-dnd-attach-options, mml-dnd-attach-file) 2674 (mml-mode): defvar dnd-protocol-alist instead of using
1071 (mml-attach-file, mml-attach-buffer, mml-attach-external): 2675 symbol-value.
1072 Sync DND support and use of message-in-body-p from the trunk. 2676 (mml-default-directory): New variable.
2677 (mml-minibuffer-read-file): Use it.
2678 (mml-dnd-protocol-alist, mml-dnd-attach-options): Adjust :version.
2679
2680 * message.el (message-citation-line-format): New variable.
2681 (message-insert-formated-citation-line): New function.
2682 (message-citation-line-function): Add
2683 `message-insert-formated-citation-line' to custom type.
2684
2685 * mm-decode.el (mm-verify-option): Add gnus-buttonized-mime-types
2686 to doc string.
2687
2688 * gnus-art.el (gnus-buttonized-mime-types): Add "multipart/signed"
2689 depending on mm-verify-option.
1073 2690
10742006-04-26 Katsumi Yamaoka <yamaoka@jpl.org> 26912006-04-26 Katsumi Yamaoka <yamaoka@jpl.org>
1075 2692
@@ -1083,12 +2700,10 @@
1083 lines at the top of body; use gnus-newsgroup-charset if there's no 2700 lines at the top of body; use gnus-newsgroup-charset if there's no
1084 Charset header. 2701 Charset header.
1085 2702
10862006-04-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
1087
1088 * nnweb.el (nnweb-google-wash-article): Sync up to new Google HTML.
1089
10902006-04-25 Katsumi Yamaoka <yamaoka@jpl.org> 27032006-04-25 Katsumi Yamaoka <yamaoka@jpl.org>
1091 2704
2705 * message.el (message-self-insert-commands): Doc fix.
2706
1092 * mm-uu.el (mm-uu-pgp-signed-test): Erase prompt. 2707 * mm-uu.el (mm-uu-pgp-signed-test): Erase prompt.
1093 (mm-uu-pgp-encrypted-test): Ditto. 2708 (mm-uu-pgp-encrypted-test): Ditto.
1094 (mm-uu-pgp-encrypted-extract-1): Make sure there's a blank line 2709 (mm-uu-pgp-encrypted-extract-1): Make sure there's a blank line
@@ -1098,6 +2713,47 @@
1098 * mm-decode.el (mm-automatic-display): Don't make application/pgp 2713 * mm-decode.el (mm-automatic-display): Don't make application/pgp
1099 element match to application/pgp-*. 2714 element match to application/pgp-*.
1100 2715
27162006-04-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2717
2718 * nnweb.el (nnweb-google-wash-article): Sync up to new Google
2719 HTML.
2720
27212006-04-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
2722
2723 * mail-source.el (mail-source-call-script): Message the error
2724 string.
2725
27262006-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
2727
2728 * gnus-util.el (gnus-byte-compile): Use it.
2729
27302006-04-22 xyblor <fake@invalid.email> (Tiny change.)
2731
2732 * gnus-util.el (kill-empty-logs): New function.
2733
27342006-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
2735
2736 * message.el (message-mail-alias-type): Doc fix.
2737 (message-mail-alias-type-p): New function.
2738 (message-send): Use it.
2739 (message-mode): Ditto.
2740 (message-strip-forbidden-properties): Ditto.
2741
2742 * ecomplete.el (ecomplete-database-file-coding-system): New
2743 variable.
2744 (ecomplete-save): Use it.
2745 (ecomplete-setup): Use it.
2746
27472006-04-22 Katsumi Yamaoka <yamaoka@jpl.org>
2748
2749 * message.el (message-self-insert-commands): New variable.
2750 (message-strip-forbidden-properties): Use it.
2751
27522006-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
2753
2754 * message.el (message-put-addresses-in-ecomplete): Use a regexp
2755 that doesn't make XEmacs choke.
2756
11012006-04-20 Reiner Steib <Reiner.Steib@gmx.de> 27572006-04-20 Reiner Steib <Reiner.Steib@gmx.de>
1102 2758
1103 * gnus-util.el (gnus-replace-in-string): 2759 * gnus-util.el (gnus-replace-in-string):
@@ -1105,67 +2761,299 @@
1105 2761
11062006-04-20 Katsumi Yamaoka <yamaoka@jpl.org> 27622006-04-20 Katsumi Yamaoka <yamaoka@jpl.org>
1107 2763
1108 * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map.
1109
1110 * gnus-sum.el: Ditto.
1111
1112 * gnus-util.el (gnus-select-frame-set-input-focus): 2764 * gnus-util.el (gnus-select-frame-set-input-focus):
1113 Use select-frame-set-input-focus if it is available in XEmacs; use 2765 Use select-frame-set-input-focus if it is available in XEmacs; use
1114 definition defined in Emacs 22 for old Emacsen. 2766 definition defined in Emacs 22 for old Emacsen.
1115 2767
27682006-04-19 Katsumi Yamaoka <yamaoka@jpl.org>
2769
2770 * mm-view.el (mm-inline-text): Use equal instead of equalp.
2771
27722006-04-18 Teodor Zlatanov <tzz@lifelogs.com>
2773
2774 * gnus-registry.el (gnus-registry-cache-save): Remove text
2775 properties when saving via the temp buffer.
2776
27772006-04-18 Reiner Steib <Reiner.Steib@gmx.de>
2778
2779 * message.el (message-generate-hashcash): Honor custom type.
2780
27812006-04-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
2782
2783 * message.el (message-generate-hashcash): Default to non-nil when
2784 hashcash is found.
2785
2786 * gnus-sum.el (gnus-summary-expire-articles-now): Clarify prompt.
2787 (gnus-refer-thread-limit): Increase default to 500.
2788
2789 * mm-view.el (mm-inline-text): Supply delsp to flow-fill.
2790
2791 * flow-fill.el (fill-flowed): Allow delete-space.
2792
27932006-04-18 Reiner Steib <Reiner.Steib@gmx.de>
2794
2795 * deuglify.el (gnus-outlook-deuglify-unwrap-min)
2796 (gnus-outlook-deuglify-unwrap-max, gnus-outlook-display-hook):
2797 Remove autoloads.
2798
27992006-04-18 Simon Josefsson <jas@extundo.com>
2800
2801 * message.el (message-generate-hashcash): Default to.
2802
28032006-04-18 Katsumi Yamaoka <yamaoka@jpl.org>
2804
2805 * rfc2231.el (rfc2231-parse-string): Decode encoded value after
2806 concatenating segments rather than before concatenating them.
2807
11162006-04-17 Reiner Steib <Reiner.Steib@gmx.de> 28082006-04-17 Reiner Steib <Reiner.Steib@gmx.de>
1117 2809
1118 [ Merge from Gnus trunk. ] 2810 * gnus-group.el: Move comment to gnus-group-update-tool-bar.
1119 2811
1120 * mm-util.el (mm-charset-synonym-alist): Improve doc string. 2812 * imap.el (imap-quote-specials): New function.
1121 (mm-charset-override-alist): New variable. 2813 (imap-login-auth): Quote specials.
1122 (mm-charset-to-coding-system): Use it.
1123 (mm-codepage-setup): New helper function.
1124 (mm-charset-eval-alist): New variable.
1125 (mm-charset-to-coding-system): Use mm-charset-eval-alist.
1126 Warn about unknown charsets. Add allow-override.
1127 Use `mm-charset-override-alist' only when decoding.
1128 (mm-detect-mime-charset-region): Use :mime-charset.
1129 2814
1130 * mm-bodies.el (mm-decode-body, mm-decode-string): 28152006-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
1131 Call `mm-charset-to-coding-system' with allow-override argument.
1132 2816
1133 * message.el (message-tool-bar-zap-list, message-tool-bar) 2817 * rfc2231.el (rfc2231-parse-string): Sort the parameters first.
1134 (message-tool-bar-gnome, message-tool-bar-retro): New variables.
1135 (message-tool-bar-local-item-from-menu): Remove.
1136 (message-tool-bar-map): Replace by `message-make-tool-bar'.
1137 (message-make-tool-bar): New function.
1138 (message-mode): Use `message-make-tool-bar'.
1139 2818
1140 * gnus-sum.el (gnus-summary-tool-bar) 2819 * message.el (message-forward-make-body-plain): Allow
1141 (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) 2820 message-forward-ignored-headers to be a list.
1142 (gnus-summary-tool-bar-zap-list): New variables. 2821 (message-remove-ignored-headers): Factor out into function.
1143 (gnus-summary-make-tool-bar): Complete rewrite using 2822 (message-forward-make-body-mml): Use it.
1144 `gmm-tool-bar-from-list'. 2823 * rfc2231.el (rfc2231-parse-string): Remove dead code.
2824 (rfc2231-parse-string): Allow concatanation of parameters that
2825 aren't contiguous. The test case is
2826 (mail-header-parse-content-type "message/external-body;
2827 name*0*=us-ascii''~%2ffoo%2fbar%2fbaz%2fxyzzy%2f;
2828 access-type=LOCAL-FILE;
2829 name*1*=plugh%2fhello-sailor%2fbing.pdf")
1145 2830
1146 * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) 28312006-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
1147 (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list):
1148 New variables.
1149 (gnus-group-make-tool-bar): Complete rewrite using
1150 `gmm-tool-bar-from-list'.
1151 (gnus-group-tool-bar-update): New function.
1152 2832
1153 * gmm-utils.el: New file. 2833 * nntp.el (nntp-accept-process-output): Return the value of
2834 `nnheader-accept-process-output'.
2835
28362006-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
2837
2838 * gnus-art.el (gnus-article-treat-types): Add text/x-patch.
2839 (gnus-button-alist): Recognize more diff formats.
2840 (gnus-button-patch): Strip directory.
2841
28422006-04-17 Reiner Steib <Reiner.Steib@gmx.de>
2843
2844 * gnus-util.el (gnus-select-frame-set-input-focus): Check for
2845 Emacs 22 when setting focus.
2846
28472006-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
2848
2849 * gnus-art.el (gnus-article-treat-types): Do treatment of
2850 text/x-verbatim parts.
2851 (gnus-button-patch): New command.
2852
2853 * ietf-drums.el (ietf-drums-parse-address): Attempt parsing
2854 addresses that contain invalid characters.
2855
28562006-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
2857
2858 * message.el (message-put-addresses-in-ecomplete): Use
2859 gnus-replace-in-string.
2860 (message-is-yours-p): Use the more correct
2861 mail-header-parse-address instead of
2862 mail-extract-address-components.
2863 (message-put-addresses-in-ecomplete): Fix typo.
2864
2865 * gnus-sum.el (gnus-summary-limit-to-bodies): New command and
2866 keystroke.
2867
2868 * gnus-art.el (gnus-treatment-function-alist): Change order of
2869 newsgroups/generic header folding to avoid double-folding.
2870
2871 * message.el (message-hidden-headers): Add X-Draft-From.
2872
2873 * gnus-sum.el (gnus-summary-repeat-search-article-forward): New
2874 command.
2875 (gnus-summary-repeat-search-article-backward): New command.
2876
2877 * gnus-topic.el (gnus-topic-display-missing-topic): Skip past
2878 groups in the parent topic.
2879
28802006-04-16 Jo,Ac(Bo Cachopo <joao.cachopo@inesc-id.pt> (tiny change)
2881
2882 * spam.el (spam-necessary-extra-headers): Add X-CRM114-Status.
2883 (spam-extra-header-to-number): Return the CRM114 number as a
2884 number instead of a string.
2885
28862006-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
2887
2888 * gnus-art.el (gnus-face-properties-alist): Moved here from
2889 gnus-fun.
2890
2891 * gnus-fun.el (gnus-face-properties-alist): Move to gnus-art.
2892
28932006-04-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
2894
2895 * message.el (message-strip-forbidden-properties): Only display on
2896 self-insert-command.
2897
2898 * hashcash.el (hashcash-insert-payment-async): Remove dead code;
2899 reindent.
2900 (hashcash-insert-payment-async-2): Make sure the buffer is alive.
2901
29022006-04-15 NAKAJI Hiroyuki <nakaji@takamatsu-nct.ac.jp> (tiny change)
2903
2904 * smiley.el (smiley-style): Fix typo.
2905
29062006-03-23 Kenichi Handa <handa@m17n.org>
2907
2908 * rfc2231.el (rfc2231-encode-string): Use mm-disable-multibyte
2909 instead of set-buffer-multibyte.
2910
29112006-03-23 Kenichi Handa <handa@m17n.org>
2912
2913 * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte
2914 buffer and then decode the buffer text if necessary.
2915 (rfc2231-encode-string): Be sure to work on multibyte buffer at
2916 first, and after mm-encode-body, change the buffer to unibyte.
2917
29182006-04-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
2919
2920 * hashcash.el (hashcash-insert-payment-async-2): Use
2921 message-goto-eoh instead of doing it manually.
2922 (mail-add-payment): Use message-narrow-to-header instead of trying
2923 to do the same itself.
2924
2925 * message.el (message-hidden-headers): Add Face.
2926
2927 * gnus-sum.el (gnus-summary-reparent-thread): Factor out
2928 reparenting code.
2929 (gnus-summary-reparent-children): Refactored out code.
2930 (gnus-summary-thread-map): New keystroke.
2931 (gnus-summary-reparent-children): Make into command.
2932
2933 * smiley.el (smiley-style): Default to `medium' if using a large
2934 font.
2935
2936 * gnus-sum.el (unmorse-region): Remove autoload, because morse.el
2937 does it itself.
2938
2939 * message.el (message-point-in-header-p): Simplify definition.
2940
29412006-04-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
2942
2943 * nnagent.el (nnagent-request-set-mark): Silence log file
2944 writing.
2945 (nnagent-request-set-mark): Use write-region instead of
2946 append-to-file.
2947
2948 * gnus-sum.el (gnus-read-header): Fudge article number if using a
2949 strange select method.
2950
2951 * ecomplete.el (ecomplete-display-matches): Get highlightling
2952 right.
2953 (ecomplete-display-matches): Use literals.
2954 (ecomplete-display-matches): Disable message logging.
2955
2956 * message.el (message-display-abbrev): Small optimization.
2957
2958 * ecomplete.el (ecomplete-display-matches): Allow automatic
2959 display.
2960
2961 * message.el (message-strip-forbidden-properties): Display
2962 abbrevs.
2963 (message-display-abbrev): Get automatic display right.
2964
2965 * ecomplete.el (ecomplete-display-matches): Use M-n/M-p
2966 keystrokes.
2967
29682006-04-13 Romain Francoise <romain@orebokech.com>
2969
2970 TODO: Backport to v5-10!
2971
2972 * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist):
2973 Moved here (and renamed) from gnus-registry.el.
2974
2975 * gnus-registry.el: Require gnus-util.
2976 Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'.
2977
29782006-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
2979
2980 * gnus-group.el (gnus-group-catchup-current): Change
2981 if-then-else-if-then-else into cond.
2982 (gnus-group-catchup): Indent.
2983 (group-name-at-point): New function.
2984 (gnus-fetch-group): Provide default from thing at point.
2985
29862006-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
2987
2988 * message.el (message-display-abbrev): Fix regexp.
2989
2990 * ecomplete.el (ecomplete-highlight-match-line): Reimplement
2991 choosing.
2992 (ecomplete-highlight-match-line): Fix up code rewrite, remove
2993 dead variables.
2994
2995 * message.el (message-newline-and-indent): Remove debugging.
2996 (message-display-abbrev): Use new implementation.
2997
29982006-04-12 Reiner Steib <Reiner.Steib@gmx.de>
2999
3000 * gnus-art.el (gnus-article-mode): Set
3001 cursor-in-non-selected-windows to nil.
3002
3003 * smiley.el: Revert previous change.
3004 (smiley-data-directory): defvar it before using it in the
3005 defcustom of `smiley-style'.
3006
30072006-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
3008
3009 * message.el (message-newline-and-indent): New function.
3010
3011 * ecomplete.el: Implement more bits.
3012
3013 * message.el (message-put-addresses-in-ecomplete): Clean up the
3014 string.
3015
3016 * ecomplete.el (ecomplete-add-item): Chop off decimals.
3017
3018 * gnus-sum.el (gnus-summary-save-parts): Bind
3019 gnus-summary-save-parts-counter and use it to make unique file
3020 names.
3021
3022 * gnus-art.el (gnus-ignored-headers): Add some more headers.
3023
3024 * ietf-drums.el (ietf-drums-parse-addresses): Take a RAWP
3025 parameter to say whether to actually parse the individual
3026 addresses.
3027
3028 * message.el (message-put-addresses-in-ecomplete): New function.
3029 (ecomplete): Require.
3030 (message-mail-alias-type): Add ecomplete as an option.
1154 3031
11552006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de> 30322006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de>
1156 3033
1157 * flow-fill.el (fill-flowed): Remove trailing space from blank 3034 * flow-fill.el (fill-flowed): Remove trailing space from blank
1158 quoted lines. 3035 quoted lines.
1159 3036
11602006-04-12 Reiner Steib <Reiner.Steib@gmx.de> 30372006-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
3038
3039 * smiley.el (smiley-style): Move definition later to avoid a
3040 compilation warning.
1161 3041
1162 * gnus-art.el (gnus-article-mode): 30422006-04-12 Kenichi Handa <handa@m17n.org>
1163 Set cursor-in-non-selected-windows to nil. 3043
3044 * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte
3045 buffer and then decode the buffer text if necessary.
3046 (rfc2231-encode-string): Be sure to work on multibyte buffer at
3047 first, and after mm-encode-body, change the buffer to unibyte.
3048 Use mm-disable-multibyte instead of set-buffer-multibyte.
1164 3049
11652006-04-12 Katsumi Yamaoka <yamaoka@jpl.org> 30502006-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
1166 3051
1167 * gnus-art.el (gnus-mime-view-part-as-charset): Ignore charset 3052 * gnus-art.el (gnus-mime-copy-part): Find name parameter in
1168 that the part specifies. 3053 Content-Type header instead of Content-Disposition header.
3054 (gnus-mime-inline-part): Ditto.
3055 (gnus-mime-view-part-as-charset): Ignore charset that the part
3056 specifies.
1169 3057
1170 * mm-decode.el (mm-display-part): Work with external parts and 3058 * mm-decode.el (mm-display-part): Work with external parts and
1171 usual parts similarly. 3059 usual parts similarly.
@@ -1173,48 +3061,149 @@
1173 * mm-extern.el (mm-inline-external-body): Use mm-display-part 3061 * mm-extern.el (mm-inline-external-body): Use mm-display-part
1174 instead of gnus-display-mime. 3062 instead of gnus-display-mime.
1175 3063
3064 * mm-util.el (mm-decompress-buffer): Use mm-with-unibyte-buffer
3065 instead of with-temp-buffer.
3066
1176 * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part 3067 * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part
1177 tag to summarized topics part in order to encode non-ASCII text. 3068 tag to summarized topics part in order to encode non-ASCII text.
1178 3069
11792006-04-11 Reiner Steib <Reiner.Steib@gmx.de> 30702006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
1180 3071
3072 * smiley.el (smiley-style): New variable.
3073 (smiley-directory): New function.
3074 (smiley-data-directory): Derive from `smiley-style' using
3075 `smiley-directory'.
3076 (smiley-regexp-alist): Add new entries.
3077
1181 * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'. 3078 * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'.
3079 (gnus-article-browse-delete-temp): Add :version.
1182 3080
11832006-04-11 Arne J,Ax(Brgensen <arne@arnested.dk> 30812006-04-11 Arne J,Ax(Brgensen <arne@arnested.dk>
1184 3082
1185 * gnus-sieve.el (gnus-sieve-generate): Delete from the start of 3083 * gnus-sieve.el (gnus-sieve-generate): Delete from the start of
1186 the sieve region. 3084 the sieve region.
1187 3085
30862006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
3087
3088 * gnus.el (gnus-version-number): Bump version.
3089
11882006-04-11 Reiner Steib <Reiner.Steib@gmx.de> 30902006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
1189 3091
1190 * gnus.el: Gnus v5.10.8 is released. 3092 * gnus.el: No Gnus v0.4 is released.
1191 3093
11922006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> 30942006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
1193 3095
1194 * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new layout. 3096 * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new
3097 layout.
1195 3098
1196 * rfc2047.el (rfc2047-decode-encoded-words): Don't message about 3099 * rfc2047.el (rfc2047-decode-encoded-words): Don't message about
1197 unknown charset. 3100 unknown charset.
1198 3101
1199 * message.el (message-header-synonyms): Add Original-To to the default. 3102 * message.el (message-header-synonyms): Add Original-To to the
3103 default.
1200 3104
1201 * gnus-sum.el (gnus-get-newsgroup-headers-xover): Group is an 3105 * gnus-sum.el (gnus-get-newsgroup-headers-xover): group is an
1202 optional parameter. 3106 optional parameter.
1203 3107
12042006-04-06 Reiner Steib <Reiner.Steib@gmx.de> 31082006-04-06 Reiner Steib <Reiner.Steib@gmx.de>
1205 3109
1206 * gnus-fun.el (gnus): Require it for gnus-directory. 3110 * gnus-fun.el (gnus): Require it for gnus-directory.
1207 3111
31122006-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
3113
3114 * gnus-fun.el (gnus-face-properties-alist): Add :version.
3115
31162006-04-05 Daiki Ueno <ueno@unixuser.org>
3117
3118 * pgg-gpg.el (pgg-gpg-process-filter): Fix.
3119
31202006-04-05 Simon Josefsson <jas@extundo.com>
3121
3122 * password.el (password-reset): New function.
3123
31242006-04-05 Daiki Ueno <ueno@unixuser.org>
3125
3126 * pgg-gpg.el (pgg-gpg-encrypt-region, pgg-gpg-sign-region): Wait
3127 for BEGIN_SIGNING too, new in GnuPG 1.4.3.
3128
12082006-04-04 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 31292006-04-04 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
1209 3130
1210 * nnweb.el (nnweb-google-create-mapping): Update regexp. 3131 * nnweb.el (nnweb-google-create-mapping): Update regexp.
1211 Some whitespace was matched into the url, which broke browsing hits 3132 Some whitespace was matched into the url, which broke browsing hits
1212 > 100 when mm-url-use-external was nil. 3133 > 100 when mm-url-use-external was nil.
1213 3134
31352006-04-04 Reiner Steib <Reiner.Steib@gmx.de>
3136
3137 * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Check
3138 gnus-extra-headers for 'Newsgroups.
3139
3140 * message.el (message-tool-bar-gnome): Check if `flyspell-mode' is
3141 bound.
3142
31432006-04-04 Daiki Ueno <ueno@unixuser.org>
3144
3145 * pgg-gpg.el: Clean up process buffers every time gpg processes
3146 complete.
3147
31482006-04-03 Reiner Steib <Reiner.Steib@gmx.de>
3149
3150 * gnus-fun.el (gnus-convert-image-to-face-command): Fix typo in
3151 doc string.
3152
31532006-04-03 Daiki Ueno <ueno@unixuser.org>
3154
3155 * pgg-gpg.el (pgg-gpg-process-filter)
3156 (pgg-gpg-wait-for-completion): Check if buffer is alive.
3157
3158 * pgg-gpg.el (pgg-gpg-process-sentinel): Don't remove GNUPG:
3159 lines, temporary fix.
3160
12142006-03-31 Reiner Steib <Reiner.Steib@gmx.de> 31612006-03-31 Reiner Steib <Reiner.Steib@gmx.de>
1215 3162
1216 * gnus-group.el (gnus-group-update-tool-bar): Add :initialize and :set. 3163 * gnus-group.el (gnus-group-update-tool-bar): Add :initialize and :set.
1217 3164
31652006-03-29 Daiki Ueno <ueno@unixuser.org>
3166
3167 * pgg-gpg.el (pgg-gpg-start-process): Don't bind
3168 default-enable-multibyte-characters. This reverts the change from
3169 revision 6.17 which is no longer necessary because the passphrase
3170 is sent separately now. GnuPG messages are unreadable under
3171 multibyte locales with default-enable-multibyte-characters set to
3172 nil.
3173
31742006-03-28 Reiner Steib <Reiner.Steib@gmx.de>
3175
3176 * message.el (message-tool-bar-gnome): Move "spell".
3177
31782006-03-27 Reiner Steib <Reiner.Steib@gmx.de>
3179
3180 * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Don't use
3181 XEmacs-only `replace-in-string'. Use `gnus-group-real-name'
3182 instead.
3183
31842006-03-27 Karl Kleinpaste <karl@charcoal.com>
3185
3186 * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Improve
3187 newsgroups handling for NNTP overviews which don't include
3188 Newsgroups.
3189
31902006-03-26 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
3191
3192 * message.el (message-resend): Bind message-generate-hashcash to nil.
3193
31942006-03-26 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
3195
3196 * hashcash.el (hashcash-already-paid-p): Bind case-fold-search
3197 when searching for already-paid recipients.
3198
31992006-03-27 Daiki Ueno <ueno@unixuser.org>
3200
3201 * pgg-gpg.el: Invoke gpg asynchronous, to avoid querying for
3202 passphrases when it is not needed.
3203 (pgg-gpg-use-agent): Add, to hard code that pgg shouldn't wait for
3204 passphrase stuff from gpg, should only be necessary when you use
3205 gpg with a smartcard.
3206
12182006-03-23 Katsumi Yamaoka <yamaoka@jpl.org> 32072006-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
1219 3208
1220 * mml.el (mml-insert-mime): Ignore cached contents of 3209 * mml.el (mml-insert-mime): Ignore cached contents of
@@ -1223,44 +3212,55 @@
1223 * mm-decode.el (mm-get-part): Add optional 'no-cache' argument. 3212 * mm-decode.el (mm-get-part): Add optional 'no-cache' argument.
1224 (mm-insert-part): Ditto. 3213 (mm-insert-part): Ditto.
1225 3214
12262006-03-22 Katsumi Yamaoka <yamaoka@jpl.org> 32152006-03-23 Simon Josefsson <jas@extundo.com>
1227 3216
1228 * gnus-sum.el (gnus-map-articles): Don't funcall symbol macro. 3217 * pgg-gpg.el (pgg-gpg-update-agent): Add again, with fixes from
1229 Reported by Ralf Wachinger <rwachinger@gmx.de>. 3218 Reiner.
3219 (pgg-gpg-use-agent-p): Use it again.
1230 3220
12312006-03-23 Kenichi Handa <handa@m17n.org> 32212006-03-23 Simon Josefsson <jas@extundo.com>
1232 3222
1233 * rfc2231.el (rfc2231-encode-string): Use mm-disable-multibyte 3223 * pgg-gpg.el (pgg-gpg-update-agent): Remove, doesn't work with
1234 instead of set-buffer-multibyte. 3224 older emacsen.
3225 (pgg-gpg-use-agent-p): Don't use it.
1235 3226
12362006-03-23 Kenichi Handa <handa@m17n.org> 32272006-03-23 Reiner Steib <Reiner.Steib@gmx.de>
1237 3228
1238 * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte 3229 * pgg-gpg.el (pgg-gpg-update-agent): Only use make-network-process
1239 buffer and then decode the buffer text if necessary. 3230 if we can.
1240 (rfc2231-encode-string): Be sure to work on multibyte buffer at
1241 first, and after mm-encode-body, change the buffer to unibyte.
1242 3231
12432006-03-21 Daniel Pittman <daniel@rimspace.net> 32322006-03-22 Sascha Wilde <wilde@sha-bang.de>
1244 3233
1245 * nnimap.el (nnimap-request-update-info-internal): Optimize. 3234 * pgg-gpg.el (pgg-gpg-use-agent): Disable by default.
1246 Don't `gnus-uncompress-range' to avoid excessive memory usage. 3235 (pgg-gpg-update-agent): New function.
3236 (pgg-gpg-use-agent-p): New function.
3237 (pgg-gpg-process-region, pgg-gpg-encrypt-region)
3238 (pgg-gpg-encrypt-symmetric-region, pgg-gpg-decrypt-region)
3239 (pgg-gpg-sign-region): Use it.
1247 3240
12482006-03-21 Reiner Steib <Reiner.Steib@gmx.de> 32412006-03-22 Katsumi Yamaoka <yamaoka@jpl.org>
1249 3242
1250 * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'. 3243 * gnus-sum.el (gnus-map-articles): Don't funcall symbol macro.
3244 Reported by Ralf Wachinger <rwachinger@gmx.de>.
1251 3245
1252 * spam.el (spam-mark-new-messages-in-spam-group-as-spam): 32462006-03-21 Simon Josefsson <jas@extundo.com>
1253 Add comment on version.
1254 3247
12552006-03-20 Teodor Zlatanov <tzz@lifelogs.com> 3248 * pgg-gpg.el: Ideas below based on patch from Sascha Wilde
3249 <wilde@sha-bang.de>.
3250 (pgg-gpg-use-agent): New variable.
3251 (pgg-gpg-process-region): Use it.
3252 (pgg-gpg-encrypt-region): Likewise.
3253 (pgg-gpg-encrypt-symmetric-region): Likewise.
3254 (pgg-gpg-decrypt-region): Likewise.
3255 (pgg-gpg-sign-region): Likewise.
3256 (pgg-gpg-possibly-cache-passphrase): Don't cache a nil password.
1256 3257
1257 * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New variable. 32582006-03-21 Reiner Steib <Reiner.Steib@gmx.de>
1258 (spam-mark-junk-as-spam-routine): Use it. Allow to disable
1259 assigning the spam-mark to new messages.
1260 3259
12612006-03-20 Adam Sj,Ax(Bgren <asjo@koldfront.dk> 3260 * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'.
1262 3261
1263 (spam-ham-copy-or-move-routine): Don't declare `todo' twice. 3262 * spam.el (spam-mark-new-messages-in-spam-group-as-spam):
3263 Add comment on version.
1264 3264
12652006-03-20 Reiner Steib <Reiner.Steib@gmx.de> 32652006-03-20 Reiner Steib <Reiner.Steib@gmx.de>
1266 3266
@@ -1281,6 +3281,26 @@
1281 3281
1282 * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode. 3282 * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode.
1283 3283
32842006-03-16 Reiner Steib <Reiner.Steib@gmx.de>
3285
3286 * gmm-utils.el (gmm-image-load-path-for-library): Prefer user's
3287 images in image-load-path. [Sync with image.el at 2006-03-16T16:55:26Z!wohler@newt.com, in
3288 Emacs.]
3289
32902006-03-15 Reiner Steib <Reiner.Steib@gmx.de>
3291
3292 * gmm-utils.el (gmm-image-load-path-for-library): Pass value of
3293 path rather than symbol. Always return list of directories.
3294 Guarantee that image directory comes first. [Sync with image.el,
3295 , in Emacs2006-03-15T17:06:16Z!wohler@newt.com.]
3296
3297 * message.el (message-make-tool-bar): Adjust to new API of
3298 `gmm-image-load-path-for-library'.
3299
3300 * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
3301
3302 * gnus-group.el (gnus-group-make-tool-bar): Ditto.
3303
12842006-03-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 33042006-03-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
1285 3305
1286 * gnus-art.el (gnus-article-only-boring-p): 3306 * gnus-art.el (gnus-article-only-boring-p):
@@ -1288,6 +3308,11 @@
1288 intangible text. 3308 intangible text.
1289 Reported by Ralf Wachinger <rwnewsmampfer@geekmail.de>. 3309 Reported by Ralf Wachinger <rwnewsmampfer@geekmail.de>.
1290 3310
33112006-03-14 Reiner Steib <Reiner.Steib@gmx.de>
3312
3313 * gmm-utils.el (gmm-image-load-path-for-library): Fix typo. Use
3314 `defun' instead of `gmm-defun-compat'.
3315
12912006-03-14 Simon Josefsson <jas@extundo.com> 33162006-03-14 Simon Josefsson <jas@extundo.com>
1292 3317
1293 * message.el (message-unique-id): Don't use message-number-base36 3318 * message.el (message-unique-id): Don't use message-number-base36
@@ -1334,17 +3359,70 @@
1334 3359
1335 * gnus-topic.el (gnus-topic-prepare-topic): Add gnus-tool-bar-update. 3360 * gnus-topic.el (gnus-topic-prepare-topic): Add gnus-tool-bar-update.
1336 3361
3362 * gnus-group.el (gnus-group-redraw-when-idle)
3363 (gnus-group-redraw-check): Remove.
3364 (gnus-group-make-tool-bar): Remove gnus-group-redraw-check.
3365
13372006-03-08 Katsumi Yamaoka <yamaoka@jpl.org> 33662006-03-08 Katsumi Yamaoka <yamaoka@jpl.org>
1338 3367
1339 * nnmail.el (nnmail-split-it): Invert match-partial-words behavior 3368 * nnmail.el (nnmail-split-it): Invert match-partial-words behavior
1340 if optional last element is specified in splits (FIELD VALUE...). 3369 if optional last element is specified in splits (FIELD VALUE...).
1341 3370
33712006-03-07 Reiner Steib <Reiner.Steib@gmx.de>
3372
3373 * message.el (message-make-tool-bar): Rename gmm-image-load-path
3374 to gmm-image-load-path-for-library. Call with no-error argument.
3375 (message-tool-bar-gnome): Rename "mail/attach" to "attach".
3376
3377 * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
3378
3379 * gnus-group.el (gnus-group-make-tool-bar): Ditto.
3380
3381 * gmm-utils.el (gmm-image-load-path): Remove alias.
3382
33832006-03-06 Reiner Steib <Reiner.Steib@gmx.de>
3384
3385 * gmm-utils.el (gmm-image-load-path): Add alias.
3386
3387 * nnml.el (nnml-generate-nov-databases-directory): Rename from
3388 nnml-generate-nov-databases-1.
3389 (nnml-generate-nov-databases): Use it.
3390 (nnml-generate-nov-databases-directory): Document no-active
3391 argument.
3392
3393 * gmm-utils.el (gmm-image-load-path-for-library): Return single
3394 directory if path is t. Add no-error.
3395
3396 * gnus-group.el (gnus-group-make-tool-bar): Use add-hook.
3397 Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
3398
3399 * gnus-art.el (gnus-article-browse-delete-temp-files): Simplify
3400 resetting gnus-article-browse-html-temp-list.
3401
3402 * gmm-utils.el (gmm-image-load-path-for-library): Sync with
3403 mh-compat.el at 2006-03-04T21:23:21Z!wohler@newt.com in Emacs. Rename `gmm-image-load-path'.
3404 Add example to docstring. Rename local variables. Move error
3405 checks to default case in cond and simplify.
3406
13422006-03-06 Katsumi Yamaoka <yamaoka@jpl.org> 34072006-03-06 Katsumi Yamaoka <yamaoka@jpl.org>
1343 3408
1344 * mm-view.el (mm-w3m-cid-retrieve-1): Check carefully whether 3409 * mm-view.el (mm-w3m-cid-retrieve-1): Check carefully whether
1345 handle is multipart when calling it recursively. 3410 handle is multipart when calling it recursively.
1346 (mm-w3m-cid-retrieve): Display warning if retrieving fails. 3411 (mm-w3m-cid-retrieve): Display warning if retrieving fails.
1347 3412
34132006-03-03 Daniel Pittman <daniel@rimspace.net>
3414
3415 * nnimap.el (nnimap-request-update-info-internal): Optimize.
3416 Don't `gnus-uncompress-range' to avoid excessive memory usage.
3417
34182006-03-03 Katsumi Yamaoka <yamaoka@jpl.org>
3419
3420 * gnus-group.el (gnus-group-tool-bar-gnome): Check if gnus-topic.el
3421 is loaded.
3422
3423 * gnus-sum.el (gnus-summary-tool-bar-gnome): Check if spam.el is
3424 loaded.
3425
13482006-03-03 Reiner Steib <Reiner.Steib@gmx.de> 34262006-03-03 Reiner Steib <Reiner.Steib@gmx.de>
1349 3427
1350 * mm-util.el (mm-with-unibyte-current-buffer): Change "Emacs 23" 3428 * mm-util.el (mm-with-unibyte-current-buffer): Change "Emacs 23"
@@ -1360,69 +3438,154 @@
1360 * gnus-sum.el (gnus-summary-set-display-table): Don't nix out 3438 * gnus-sum.el (gnus-summary-set-display-table): Don't nix out
1361 characters 160 through 255 in Emacs 23. 3439 characters 160 through 255 in Emacs 23.
1362 3440
34412006-03-02 Reiner Steib <Reiner.Steib@gmx.de>
3442
3443 * gnus-art.el (gnus-article-browse-html-temp-list): Rename from
3444 gnus-article-browse-html-temp.
3445 (gnus-article-browse-delete-temp): Make it customizable. Add
3446 `file'. Adjust doc string.
3447 (gnus-article-browse-delete-temp-files): Add argument. Allow
3448 query for each file. Adjust doc string.
3449 (gnus-article-browse-html-parts): Add
3450 `gnus-article-browse-delete-temp-files' to
3451 `gnus-summary-prepare-exit-hook' and `gnus-exit-gnus-hook'.
3452
34532006-03-02 Hynek Schlawack <hynek@ularx.de>
3454
3455 * gnus-art.el (gnus-article-browse-html-temp)
3456 (gnus-article-browse-delete-temp): New variables.
3457 (gnus-article-browse-delete-temp-files): New function.
3458 (gnus-article-browse-html-parts): Use it.
3459
34602006-03-02 Reiner Steib <Reiner.Steib@gmx.de>
3461
3462 * gnus-group.el (gnus-group-redraw-check): Remove redundant tests.
3463
3464 * gmm-utils.el (gmm-image-load-path): Mention ../etc search in doc
3465 string.
3466
3467 * gnus-sum.el (gnus-summary-tool-bar-gnome): Don't use
3468 gnus-summary-insert-new-articles when unplugged. Remove
3469 gnus-summary-search-article-forward.
3470
3471 * gmm-utils.el (gmm-tool-bar-style): Test tool-bar-mode and
3472 display-visual-class instead of display-color-cells.
3473
13632006-03-02 Katsumi Yamaoka <yamaoka@jpl.org> 34742006-03-02 Katsumi Yamaoka <yamaoka@jpl.org>
1364 3475
1365 * mml.el (mml-generate-mime-1): Encode parts other than text/* or 3476 * mml.el (mml-generate-mime-1): Encode parts other than text/* or
1366 message/* containing non-ASCII text properly. 3477 message/* containing non-ASCII text properly.
1367 3478
34792006-03-01 Reiner Steib <Reiner.Steib@gmx.de>
3480
3481 * message.el: Require gmm-utils, remove autoloads.
3482 (message-tool-bar): Set default based on
3483 gmm-tool-bar-style.
3484 (message-tool-bar-gnome): Add gmm-customize-mode.
3485
3486 * gnus-sum.el (gnus-summary-tool-bar): Set default based on
3487 gmm-tool-bar-style.
3488 (gnus-summary-tool-bar-gnome): Add gmm-customize-mode.
3489
3490 * gnus-group.el (gnus-group-tool-bar): Set default based on
3491 gmm-tool-bar-style.
3492 (gnus-group-tool-bar-gnome): Add gmm-customize-mode.
3493
3494 * gmm-utils.el (gmm-image-directory): Rename variable from
3495 gmm-image-load-path.
3496 (gmm-image-load-path): Use gmm-image-directory.
3497 (gmm-customize-mode): New function.
3498 (gmm-tool-bar-style): New variable.
3499
3500 * gnus-group.el (gnus-group-redraw-when-idle): Rename from
3501 gnus-group-redraw-line-number.
3502 (gnus-group-redraw-check): Simplify.
3503 (gnus-group-tool-bar-update): Remove redraw check.
3504 (gnus-group-make-tool-bar): Add redraw check.
3505
35062006-03-01 Michael Piotrowski <mxp@dynalabs.de> (tiny change)
3507
3508 * gnus-art.el (gnus-button): Add missing parentheses.
3509
13682006-02-28 Katsumi Yamaoka <yamaoka@jpl.org> 35102006-02-28 Katsumi Yamaoka <yamaoka@jpl.org>
1369 3511
1370 * mm-util.el (mm-with-unibyte-current-buffer): Add note. 3512 * mm-util.el (mm-with-unibyte-current-buffer): Add note.
1371 3513
13722006-02-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 35142006-02-28 Reiner Steib <Reiner.Steib@gmx.de>
1373 3515
1374 * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M. 3516 * gnus-art.el (gnus-button): New face.
3517 (gnus-article-button-face): Use it.
1375 3518
13762006-02-28 Reiner Steib <Reiner.Steib@gmx.de> 3519 * gnus-sum.el (gnus-summary-tool-bar-gnome): Add
3520 gnus-summary-next-page. Re-order.
1377 3521
1378 * nnweb.el (nnweb-type-definition, nnweb-gmane-search): 3522 * gnus-group.el (gnus-group-tool-bar-gnome): prev-node and
1379 Use new nov.php. 3523 next-node are now included.
3524 (gnus-group-redraw-line-number): New internal variable.
3525 (gnus-group-redraw-check): Helper function for updating the tool
3526 bar.
3527 (gnus-group-tool-bar-update): Add gnus-group-redraw-check.
1380 3528
13812006-02-28 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de> 3529 * gmm-utils.el (gmm-tool-bar-item): Add TODO about modifiers.
1382 3530
1383 * nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping) 3531 * spam.el (spam-spamassassin-score-regexp): New internal variable.
1384 (nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web 3532 (spam-extra-header-to-number, spam-check-spamassassin-headers):
1385 groups. Kudos to Olly Betts <olly@survex.com> for providing NOV 3533 Use it to match format of Spamassassin 3.0 and later. Reported by
1386 output on the server side. 3534 IRIE Tetsuya <irie@t.email.ne.jp>.
1387 (nnweb-google-create-mapping): Update regexps and add some 3535 (spam-check-bogofilter)
1388 progress indication. 3536 (spam-bogofilter-register-with-bogofilter): Fix args of
3537 `gnus-error' calls.
1389 3538
13902006-02-28 Reiner Steib <Reiner.Steib@gmx.de> 35392006-02-28 Reiner Steib <Reiner.Steib@gmx.de>
1391 3540
1392 * message.el (message-user-fqdn): Remove useless * in doc string.
1393
1394 * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid 3541 * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid
1395 unnecessary interaction when sending queued mails. Reported by 3542 unnecessary interaction when sending queued mails. Reported by
1396 TAKAHASHI Yoshio <tkh@jp.fujitsu.com>. 3543 TAKAHASHI Yoshio <tkh@jp.fujitsu.com>.
1397 3544
13982006-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org> 35452006-02-27 Reiner Steib <Reiner.Steib@gmx.de>
3546
3547 * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if
3548 first or last are nil.
3549
35502006-02-24 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
3551
3552 * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M.
3553
35542006-02-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
1399 3555
1400 * gnus-int.el (gnus-open-server): Respect gnus-batch-mode. 3556 * gnus-int.el (gnus-open-server): Respect gnus-batch-mode.
1401 Merge of 2006-02-20 change from the trunk.
1402 3557
14032006-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org> 35582006-02-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
1404 3559
1405 * dns.el (query-dns): Protect more against buggy tcp output. 3560 * dns.el (query-dns): Protect more against buggy tcp output.
1406 Merge of 2006-02-20 change from the trunk.
1407 3561
14082006-02-27 Reiner Steib <Reiner.Steib@gmx.de> 35622006-02-24 Reiner Steib <Reiner.Steib@gmx.de>
1409 3563
1410 * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if 3564 * nnweb.el (nnweb-type-definition, nnweb-gmane-search): Use new
1411 first or last are nil. 3565 nov.php.
1412 3566
14132006-02-24 Simon Josefsson <jas@extundo.com> 35672006-02-24 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
1414 3568
1415 * flow-fill.el (fill-flowed): Flow-fill unquoted lines too. 3569 * nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping)
1416 Merge of 2005-10-26 change from the trunk. 3570 (nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web
3571 groups. Kudos to Olly Betts <olly@survex.com> for providing NOV
3572 output on the server side.
3573 (nnweb-google-create-mapping): Update regexps and add some
3574 progress indication.
1417 3575
14182006-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org> 35762006-02-23 Reiner Steib <Reiner.Steib@gmx.de>
1419 3577
1420 * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil. 3578 * gnus-group.el (gnus-group-tool-bar-gnome): Fix
1421 Remove space stuffing, and only do quotes that actually start with 3579 gnus-agent-toggle-plugged. Re-order icons.
1422 ">" at the beginning of the lines. 3580 (gnus-group-tool-bar-gnome): Add
1423 Merge of 2005-11-17 and 2004-07-25 from the trunk. 3581 gnus-group-{prev,next}-unread-group.
3582 (gnus-group-tool-bar-gnome): Re-order icons.
1424 3583
14252006-02-23 Reiner Steib <Reiner.Steib@gmx.de> 3584 * gnus-sum.el (gnus-summary-tool-bar-gnome): Move
3585 gnus-summary-insert-new-articles.
3586
3587 * message.el (message-tool-bar-gnome, message-tool-bar-retro): Fix
3588 comments.
1426 3589
1427 * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is 3590 * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is
1428 also available in Emacs 21.3. 3591 also available in Emacs 21.3.
@@ -1439,16 +3602,78 @@
1439 3602
1440 * mm-view.el (mm-fill-flowed): Add :version. 3603 * mm-view.el (mm-fill-flowed): Add :version.
1441 3604
14422006-02-23 Ralf Angeli <angeli@iwi.uni-sb.de> 36052006-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
1443 3606
1444 * mm-view.el (mm-fill-flowed): New variable. 3607 * gmm-utils.el (gmm-image-load-path): Don't modify image-load-path
1445 (mm-inline-text): Use it. 3608 and load-path.
3609
36102006-02-22 Reiner Steib <Reiner.Steib@gmx.de>
3611
3612 * message.el: Autoload gmm-image-load-path.
3613 (message-tool-bar-retro): Prepend "gnus/" subdirectory to some
3614 icon file names. Use old Emacs 21 "mail_send.xpm" icon for
3615 consitency.
3616
3617 * gmm-utils.el (gmm-image-load-path): Also search in
3618 "../etc/images". Don't set gmm-image-load-path if we don't find
3619 the image.
3620
36212006-02-22 Katsumi Yamaoka <yamaoka@jpl.org>
3622
3623 * gmm-utils.el (gmm-image-load-path): Don't make
3624 `gmm-image-load-path' include subdirectories which the second arg
3625 `image' might specify.
3626
3627 * gnus-group.el (gnus-group-tool-bar-retro): Prepend the "gnus/"
3628 subdirectory to icon file names.
3629
3630 * gnus-sum.el (gnus-summary-tool-bar-retro): Ditto.
3631
36322006-02-21 Reiner Steib <Reiner.Steib@gmx.de>
3633
3634 * gnus-group.el (gnus-group-make-tool-bar): Add IMAGE argument to
3635 gmm-image-load-path calls.
3636
3637 * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
3638
3639 * message.el (message-make-tool-bar): Ditto.
3640
3641 * mml.el (mml-preview): Added comment concerning tool bar icons.
3642
3643 * gnus-group.el (gnus-group-tool-bar-gnome): Use new icon names.
3644 (gnus-group-make-tool-bar): Use `gmm-image-load-path'.
3645
3646 * gnus-sum.el (gnus-summary-tool-bar-gnome): Use new icon names.
3647 (gnus-summary-make-tool-bar): Use `gmm-image-load-path'.
3648
3649 * message.el (message-tool-bar-gnome): Use new icon names.
3650 (message-make-tool-bar): Use `gmm-image-load-path'.
3651
3652 * gmm-utils.el (gmm-defun-compat, gmm-image-search-load-path): New
3653 functions from MH-E.
3654 (gmm-image-load-path): New variable from MH-E.
3655 (gmm-image-load-path): New function from MH-E. Added arguments
3656 LIBRARY, IMAGE and PATH. Don't modify paths. Don't use
3657 *-image-load-path-called-flag.
3658
36592006-02-21 Milan Zamazal <pdm@brailcom.org>
3660
3661 * mm-view.el (mm-view-pkcs7-verify): Implement using smime.el.
1446 3662
14472006-02-21 Wolfram Fenske <wolfram.fenske@student.uni-magdeburg.de> (tiny change) 36632006-02-21 Wolfram Fenske <wolfram.fenske@student.uni-magdeburg.de> (tiny change)
1448 3664
1449 * nnimap.el (nnimap-request-move-article): Change folder back to 3665 * nnimap.el (nnimap-request-move-article): Change folder back to
1450 source group before deleting. 3666 source group before deleting.
1451 3667
36682006-02-20 Reiner Steib <Reiner.Steib@gmx.de>
3669
3670 * mm-util.el (mm-charset-override-alist): Fix type in doc string.
3671
3672 * gnus-art.el (mm-url-insert-file-contents-external): Autoload
3673 mm-url.
3674
3675 * mm-uu.el (mm-uu-type-alist): Improve `LaTeX'.
3676
14522006-02-20 Katsumi Yamaoka <yamaoka@jpl.org> 36772006-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
1453 3678
1454 * rfc2047.el (rfc2047-charset-to-coding-system): Don't check the 3679 * rfc2047.el (rfc2047-charset-to-coding-system): Don't check the
@@ -1473,17 +3698,37 @@
1473 3698
1474 * gnus-art.el (article-strip-banner): Use 3699 * gnus-art.el (article-strip-banner): Use
1475 gnus-extract-address-components instead of 3700 gnus-extract-address-components instead of
1476 mail-header-parse-addresses to make it work with non-ASCII text. 3701 mail-header-parse-addresses to make it work with non-ASCII text;
3702 remove mail-encode-encoded-word-string.
1477 3703
1478 * rfc2231.el (rfc2231-parse-string): Attempt to parse parameter 3704 * rfc2231.el (rfc2231-parse-string): Attempt to parse parameter
1479 values which are surrounded with \"...\"; make it never cause a 3705 values which are surrounded with \"...\"; make it never cause a
1480 Lisp error; give up parsing of parameters if it failed in 3706 Lisp error; give up parsing of parameters if it failed in
1481 extracting type. 3707 extracting type.
1482 3708
37092006-02-14 Arne J,Ax(Brgensen <arne@arnested.dk>
3710
3711 * smime.el (smime-cert-by-ldap-1): Fix bug where
3712 `smime-ldap-search' returns results without userCertificates.
3713
14832006-02-15 Katsumi Yamaoka <yamaoka@jpl.org> 37142006-02-15 Katsumi Yamaoka <yamaoka@jpl.org>
1484 3715
3716 * mm-util.el (mm-make-temp-file): Don't catch file-error in Emacs.
3717
37182006-02-14 Reiner Steib <Reiner.Steib@gmx.de>
3719
3720 * spam.el (spam-check-spamassassin-headers): Adapt format for
3721 Spamassassin 3.0 or later. Reported by ARISAWA Akihiro
3722 <ari@mbf.ocn.ne.jp>.
3723 (spam-list-of-processors): Add spam-use-gmane.
3724
37252006-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
3726
1485 * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of 3727 * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of
1486 make-temp-file; make it work with Emacs 20 and XEmacs as well. 3728 make-temp-file; make it work with XEmacs as well.
3729
3730 * gnus-art.el (gnus-article-browse-html-parts): Use the 3rd arg of
3731 mm-make-temp-file.
1487 3732
1488 * mm-decode.el (mm-display-external): Use the 3rd arg of 3733 * mm-decode.el (mm-display-external): Use the 3rd arg of
1489 mm-make-temp-file. 3734 mm-make-temp-file.
@@ -1497,6 +3742,18 @@
1497 (gnus-draft-check-draft-articles): New function. 3742 (gnus-draft-check-draft-articles): New function.
1498 (gnus-draft-edit-message, gnus-draft-send-message): Use it. 3743 (gnus-draft-edit-message, gnus-draft-send-message): Use it.
1499 3744
37452006-02-13 Reiner Steib <Reiner.Steib@gmx.de>
3746
3747 * gnus-art.el (gnus-article-browse-html-parts):
3748 `hs-show-html-list' should read `gnus-article-browse-html-parts'.
3749 Don't use suffix argument for mm-make-temp-file for Emacs 21
3750 compatibility. Remove useless `format'.
3751
37522006-02-13 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
3753
3754 * nnweb.el (nnweb-google-wash-article): Update regexps.
3755 (nnweb-group-alist): Use defvoo instead of defvar.
3756
15002006-02-13 Katsumi Yamaoka <yamaoka@jpl.org> 37572006-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
1501 3758
1502 * nnoo.el (nnoo-declare): Don't generate duplicate entries when 3759 * nnoo.el (nnoo-declare): Don't generate duplicate entries when
@@ -1504,8 +3761,24 @@
1504 3761
15052006-02-10 Reiner Steib <Reiner.Steib@gmx.de> 37622006-02-10 Reiner Steib <Reiner.Steib@gmx.de>
1506 3763
3764 * gnus-group.el (gnus-group-make-tool-bar): Remove duplicate check
3765 for `tool-bar-mode' and don't check it's default-value.
3766
3767 * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
3768
3769 * message.el (message-make-tool-bar): Ditto.
3770
3771 * gnus-art.el (gnus-article-browse-html-parts): Remove useless
3772 `substring'. Shorten tmp-file name.
3773
1507 * gnus.el: Remove bogus comment. 3774 * gnus.el: Remove bogus comment.
1508 3775
37762006-02-10 Hynek Schlawack <hynek@ularx.de>
3777
3778 * gnus-art.el (gnus-article-browse-html-parts): New function.
3779 (gnus-article-browse-html-article): New function for viewing html
3780 articles with a browser.
3781
15092006-02-09 Daiki Ueno <ueno@unixuser.org> 37822006-02-09 Daiki Ueno <ueno@unixuser.org>
1510 3783
1511 * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode. 3784 * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode.
@@ -1581,10 +3854,6 @@
1581 3854
1582 Update copyright notices of all files in the gnus directory. 3855 Update copyright notices of all files in the gnus directory.
1583 3856
15842006-02-03 Reiner Steib <Reiner.Steib@gmx.de>
1585
1586 * gnus-util.el (gnus-error): Describe `args'.
1587
15882006-02-03 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de> 38572006-02-03 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
1589 3858
1590 * nnweb.el (nnweb-request-group): Avoid growing overview files. 3859 * nnweb.el (nnweb-request-group): Avoid growing overview files.
@@ -1615,20 +3884,13 @@
1615 (nnweb-possibly-change-server, nnweb-request-group): Remove some 3884 (nnweb-possibly-change-server, nnweb-request-group): Remove some
1616 initialisations. Let nnoo do the work. 3885 initialisations. Let nnoo do the work.
1617 3886
16182006-01-31 Romain Francoise <romain@orebokech.com>
1619
1620 * message.el (message-alternative-emails): Improve docstring.
1621 (message-setup-1): Call `message-use-alternative-email-as-from'
1622 after `message-setup-hook' to give it precedence over posting
1623 styles, etc.
1624 (message-use-alternative-email-as-from): Add docstring.
1625 Remove the original From header if present.
1626
16272006-01-31 Katsumi Yamaoka <yamaoka@jpl.org> 38872006-01-31 Katsumi Yamaoka <yamaoka@jpl.org>
1628 3888
1629 * mm-uu.el (mm-uu-emacs-sources-extract, mm-uu-diff-extract): 3889 * mm-uu.el (mm-uu-emacs-sources-extract, mm-uu-diff-extract):
1630 Say the part has been decoded. 3890 Say the part has been decoded.
1631 3891
3892 * mm-view.el (mm-display-inline-fontify): Get decoded part rightly.
3893
16322006-01-31 Kevin Ryde <user42@zip.com.au> 38942006-01-31 Kevin Ryde <user42@zip.com.au>
1633 3895
1634 * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into 3896 * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into
@@ -1636,6 +3898,15 @@
1636 will invert the meaning of a "nil" test previously determined by 3898 will invert the meaning of a "nil" test previously determined by
1637 mailcap-mailcap-entry-passes-test. 3899 mailcap-mailcap-entry-passes-test.
1638 3900
39012006-01-30 Katsumi Yamaoka <yamaoka@jpl.org>
3902
3903 * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map when
3904 compiling.
3905
3906 * gnus-sum.el: Ditto.
3907
3908 * message.el: Don't bind tool-bar-map when compiling.
3909
16392006-01-30 Reiner Steib <Reiner.Steib@gmx.de> 39102006-01-30 Reiner Steib <Reiner.Steib@gmx.de>
1640 3911
1641 * nnweb.el (nnweb-google-parse-1): Clarify some comments. 3912 * nnweb.el (nnweb-google-parse-1): Clarify some comments.
@@ -1646,11 +3917,57 @@
1646 (nnweb-google-create-mapping, nnweb-google-search): Adapt to 3917 (nnweb-google-create-mapping, nnweb-google-search): Adapt to
1647 current Google Groups. 3918 current Google Groups.
1648 3919
39202006-01-26 Reiner Steib <Reiner.Steib@gmx.de>
3921
3922 * gnus-sum.el (gnus-summary-make-tool-bar): Add checks for XEmacs
3923 and tool-bar-mode.
3924
3925 * gnus-group.el (gnus-group-make-tool-bar): Add checks for XEmacs
3926 and tool-bar-mode.
3927
3928 * message.el (message-tool-bar-update): Simplify.
3929 (message-make-tool-bar): Add checks for XEmacs and tool-bar-mode.
3930
3931 * gnus-sum.el (gnus-summary-tool-bar-update): Check for
3932 gnus-summary-buffer.
3933 (gnus-summary-tool-bar-gnome): Use "reply-author" icon for
3934 gnus-summary-reply.
3935
3936 * gmm-utils.el (gmm): Add :version.
3937
16492006-01-26 Katsumi Yamaoka <yamaoka@jpl.org> 39382006-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
1650 3939
1651 * Makefile.in (clean): New rule. 3940 * Makefile.in (clean): New rule.
1652 (distclean): Use it. 3941 (distclean): Use it.
1653 3942
39432006-01-26 Steve Youngs <steve@sxemacs.org>
3944
3945 * gmm-utils.el (gmm-tool-bar-item, gmm-tool-bar-zap-list): Don't
3946 autoload.
3947
39482006-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
3949
3950 * gmm-utils.el (gmm-verbose): Add :group.
3951
39522006-01-25 Reiner Steib <Reiner.Steib@gmx.de>
3953
3954 * message.el: Change some comments WRT tool-bars.
3955
3956 * gnus-sum.el (gnus-summary-tool-bar)
3957 (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro)
3958 (gnus-summary-tool-bar-zap-list): New variables.
3959 (gnus-summary-make-tool-bar): Complete rewrite using
3960 `gmm-tool-bar-from-list'.
3961
3962 * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome)
3963 (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New
3964 variables.
3965 (gnus-group-make-tool-bar): Complete rewrite using
3966 `gmm-tool-bar-from-list'.
3967 (gnus-group-tool-bar-update): New function.
3968
3969 * message.el (message-mode-field-menu): Add "Show hidden Headers".
3970
16542006-01-25 Katsumi Yamaoka <yamaoka@jpl.org> 39712006-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
1655 3972
1656 * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part 3973 * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part
@@ -1664,10 +3981,28 @@
1664 mailcap-viewer-passes-test and mailcap-mailcap-entry-passes-test 3981 mailcap-viewer-passes-test and mailcap-mailcap-entry-passes-test
1665 look for. 3982 look for.
1666 3983
39842006-01-24 Reiner Steib <Reiner.Steib@gmx.de>
3985
3986 * gmm-utils.el (gmm-tool-bar-item): Add "Separator".
3987 (gmm-tool-bar-from-list): Suppress tooltip for `gmm-ignore'.
3988
3989 * message.el (message-tool-bar-gnome): Use gmm-ignore.
3990
16672006-01-24 Katsumi Yamaoka <yamaoka@jpl.org> 39912006-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
1668 3992
1669 * mm-uu.el (mm-uu-dissect-text-parts): Reduce the number of 3993 * gnus-art.el (gnus-mime-security-button-commands): New variable.
1670 recursive calls. 3994 (gnus-mime-security-button-menu): New definition.
3995 (gnus-mime-security-button-map): Use them.
3996 (gnus-mime-security-button-menu): New function.
3997 (gnus-insert-mime-security-button): Addition to help echo.
3998 (gnus-mime-security-run-function, gnus-mime-security-save-part)
3999 (gnus-mime-security-pipe-part): New functions.
4000
4001 * mm-uu.el (mm-uu-buttonize-original-text-parts): Remove.
4002 (mm-uu-dissect-text-parts): Revert a part of 2006-01-23 change.
4003
4004 * mm-decode.el (mm-handle-set-disposition): Remove.
4005 (mm-handle-set-description): Remove.
1671 4006
16722006-01-24 Katsumi Yamaoka <yamaoka@jpl.org> 40072006-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
1673 4008
@@ -1679,6 +4014,30 @@
1679 * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use 4014 * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use
1680 mm-w3m-standalone-supports-m17n-p to alter w3m usage. 4015 mm-w3m-standalone-supports-m17n-p to alter w3m usage.
1681 4016
40172006-01-23 Reiner Steib <Reiner.Steib@gmx.de>
4018
4019 * message.el (message-tool-bar-zap-list): Use
4020 gmm-tool-bar-zap-list as custom type.
4021 (message-tool-bar-update): New function.
4022 (message-tool-bar, message-tool-bar-gnome)
4023 (message-tool-bar-retro): Add message-tool-bar-update.
4024 (message-tool-bar-gnome): Add flyspell-buffer.
4025
4026 * gnus-util.el (gnus-error): Describe `args'.
4027
4028 * gmm-utils.el (gmm-error): Describe `args'.
4029 (gmm-tool-bar-zap-list): New widget.
4030 (gmm-tool-bar-from-list): Improve description of `zap-list'.
4031
40322006-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
4033
4034 * mm-uu.el (mm-uu-buttonize-original-text-parts): New variable.
4035 (mm-uu-dissect-text-parts): Buttonize original text parts; reduce
4036 the number of recursive calls.
4037
4038 * mm-decode.el (mm-handle-set-disposition): New macro.
4039 (mm-handle-set-description): New macro.
4040
16822006-01-23 Katsumi Yamaoka <yamaoka@jpl.org> 40412006-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
1683 4042
1684 * mm-uu.el (mm-uu-dissect-text-parts): Decode content transfer 4043 * mm-uu.el (mm-uu-dissect-text-parts): Decode content transfer
@@ -1686,15 +4045,53 @@
1686 4045
16872006-01-20 Reiner Steib <Reiner.Steib@gmx.de> 40462006-01-20 Reiner Steib <Reiner.Steib@gmx.de>
1688 4047
4048 * message.el (message-tool-bar-zap-list, message-tool-bar)
4049 (message-tool-bar-gnome, message-tool-bar-retro): New variables.
4050 (message-tool-bar-local-item-from-menu): Remove.
4051 (message-tool-bar-map): Replace by `message-make-tool-bar'.
4052 (message-make-tool-bar): New function.
4053 (message-mode): Use `message-make-tool-bar'.
4054
4055 * gmm-utils.el: New file.
4056 (gmm-verbose, gmm-message, gmm-error): From gnus-utils.el.
4057 (gmm-lazy): New widget copied from `nnmail.el'.
4058 (gmm-tool-bar-from-list): New function for creating customizable
4059 tool bars.
4060 (gmm-tool-bar-from-list): Fix typos in doc string. Remove debug
4061 output.
4062 (gmm): Add :prefix to defgroup.
4063
40642006-01-20 Per Abrahamsen <abraham@dina.kvl.dk>
4065
4066 * gmm-utils.el (gmm-widget-p): New function.
4067
40682006-01-20 Reiner Steib <Reiner.Steib@gmx.de>
4069
1689 * mml.el (mml-attach-file): Describe `description' in doc string. 4070 * mml.el (mml-attach-file): Describe `description' in doc string.
1690 (mml-menu): Add Emacs MIME manual and PGG manual. 4071 (mml-menu): Add Emacs MIME manual and PGG manual.
1691 4072
16922006-01-19 Reiner Steib <Reiner.Steib@gmx.de> 40732006-01-20 Richard M. Stallman <rms@gnu.org>
4074
4075 * mm-url.el (mm-url-load-url): Require url-parse and url-vars.
4076
40772006-01-20 Kevin Greiner <kevin.greiner@compsol.cc>
1693 4078
1694 * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) 4079 * nntp.el (nntp-end-of-line): Doc fix.
1695 (spam-group-spam-marks, spam-list-articles, spam-group-ham-marks): 4080
1696 Revert 2006-01-08 change because the functions will be used in No 40812006-01-20 Chong Yidong <cyd@stupidchicken.com>
1697 Gnus. 4082
4083 * imap.el (imap-open): Handle case where buffer is a buffer
4084 object.
4085
40862005-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
4087
4088 * gnus-delay.el (gnus-delay): Don't autoload.
4089 It's useless and could trigger a bug in cus-dep.el causing ldefs-boot
4090 to be re-loaded when customizing the `gnus-delay' group.
4091
40922005-01-20 Chong Yidong <cyd@stupidchicken.com>
4093
4094 * message.el (message-insert-citation-line): Use newlines.
1698 4095
16992006-01-19 Katsumi Yamaoka <yamaoka@jpl.org> 40962006-01-19 Katsumi Yamaoka <yamaoka@jpl.org>
1700 4097
@@ -1702,6 +4099,10 @@
1702 4099
1703 * mm-uu.el (mm-uu-dissect-text-parts): Dissect dissected parts. 4100 * mm-uu.el (mm-uu-dissect-text-parts): Dissect dissected parts.
1704 4101
41022006-01-19 Mark D. Baushke <mdb@gnu.org>
4103
4104 * pgg-gpg.el (pgg-gpg-encrypt-region): Add --textmode to gpg args.
4105
17052006-01-17 Katsumi Yamaoka <yamaoka@jpl.org> 41062006-01-17 Katsumi Yamaoka <yamaoka@jpl.org>
1706 4107
1707 * mm-decode.el (mm-inlined-types): Add application/pgp. 4108 * mm-decode.el (mm-inlined-types): Add application/pgp.
@@ -1716,9 +4117,6 @@
1716 (nnrss-opml-import): Query whether to subscribe to each entry. 4117 (nnrss-opml-import): Query whether to subscribe to each entry.
1717 4118
1718 * gnus-art.el: 4119 * gnus-art.el:
1719 * gnus-cus.el:
1720 * gnus-group.el:
1721 * gnus-start.el:
1722 * gnus-sum.el: 4120 * gnus-sum.el:
1723 * mm-uu.el: 4121 * mm-uu.el:
1724 * mm-view.el: Update copyright. 4122 * mm-view.el: Update copyright.
@@ -1731,19 +4129,11 @@
1731 4129
1732 * ChangeLog: Fix and update copyright. 4130 * ChangeLog: Fix and update copyright.
1733 4131
17342006-01-16 Katsumi Yamaoka <yamaoka@jpl.org> 41322006-01-13 Romain Francoise <romain@orebokech.com>
1735 4133
1736 * mm-uu.el (mm-uu-text-plain-type): New variable. 4134 * message.el (message-forward-subject-name-subject): Prefer the
1737 (mm-uu-pgp-signed-extract-1): Use it. 4135 address to 'nowhere' if the sender has no name.
1738 (mm-uu-pgp-encrypted-extract-1): Use it. 4136 Fix typo. Update copyright year.
1739 (mm-uu-dissect): Use it; allow two optional arguments; one is a
1740 flag specifying whether there's no message header; the other is
1741 for a MIME type and parameters; bind mm-uu-text-plain-type with
1742 the later one.
1743 (mm-uu-dissect-text-parts): New function.
1744
1745 * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to
1746 dissect text parts.
1747 4137
17482006-01-13 Katsumi Yamaoka <yamaoka@jpl.org> 41382006-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
1749 4139
@@ -1757,6 +4147,11 @@
1757 gnus-article-wash-html-with-w3m-standalone. 4147 gnus-article-wash-html-with-w3m-standalone.
1758 (mm-inline-text-html-render-with-w3m-standalone): New function. 4148 (mm-inline-text-html-render-with-w3m-standalone): New function.
1759 4149
41502006-01-12 Reiner Steib <Reiner.Steib@gmx.de>
4151
4152 * mm-uu.el (mm-uu-type-alist): Fix previous message-marks commit.
4153 Improve LaTeX.
4154
17602006-01-10 Katsumi Yamaoka <yamaoka@jpl.org> 41552006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
1761 4156
1762 * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable. 4157 * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable.
@@ -1794,6 +4189,12 @@
1794 fetch a feed. Suggested by Mark Plaksin <happy@mcplaksin.org>. 4189 fetch a feed. Suggested by Mark Plaksin <happy@mcplaksin.org>.
1795 (nnrss-insert-w3): Ditto. 4190 (nnrss-insert-w3): Ditto.
1796 4191
41922005-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
4193
4194 * gnus-uu.el (gnus-uu-digest-mail-forward): Reverse the order of
4195 the articles to be forwarded including the case where neither a
4196 number of articles nor a region is specified.
4197
17972005-12-21 Katsumi Yamaoka <yamaoka@jpl.org> 41982005-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
1798 4199
1799 * nnrss.el (nnrss-request-article): Fix last change; fill 4200 * nnrss.el (nnrss-request-article): Fix last change; fill
@@ -1805,34 +4206,31 @@
1805 in text/plain part. 4206 in text/plain part.
1806 (nnrss-check-group): Don't add excessive newline to dc:subject. 4207 (nnrss-check-group): Don't add excessive newline to dc:subject.
1807 4208
18082005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
1809
1810 * gnus-art.el (gnus-article-delete-text-of-type): Enable it to
1811 remove MIME buttons associated with multipart/alternative parts.
1812 (gnus-mime-display-alternative): Tag buttons using `article-type'
1813 text property.
1814
1815 * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons
1816 associated with multipart/alternative parts.
1817
18182005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change) 42092005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change)
1819 4210
1820 * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the 4211 * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the
1821 article. 4212 article.
1822 4213
18232005-12-18 Lars Magne Ingebrigtsen <larsi@gnus.org> 42142005-12-18 Reiner Steib <Reiner.Steib@gmx.de>
4215
4216 * nnml.el: Don't require gnus-bcklg. Autoload it.
4217 (nnml-use-compressed-files, nnml-save-mail): Support other
4218 comression programs such as bzip2.
4219
42202005-12-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
1824 4221
1825 * dns.el (query-dns): Make sure we check the buffer size before 4222 * dns.el (query-dns): Make sure we check the buffer size before
1826 removing tcp headers. 4223 removing tcp headers.
1827 4224
18282006-01-08 Chong Yidong <cyd@stupidchicken.com> 42252005-12-16 Katsumi Yamaoka <yamaoka@jpl.org>
1829 4226
1830 * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) 4227 * gnus-art.el (gnus-article-delete-text-of-type): Enable it to
1831 (spam-group-spam-marks): Delete functions. 4228 remove MIME buttons associated with multipart/alternative parts.
1832 (spam-list-articles): Just call spam-group-ham-marks directly. 4229 (gnus-mime-display-alternative): Tag buttons using `article-type'
1833 (spam-group-ham-marks): Simplify. 4230 text property.
1834 4231
18352005-12-16 Katsumi Yamaoka <yamaoka@jpl.org> 4232 * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons
4233 associated with multipart/alternative parts.
1836 4234
1837 * gnus-art.el (gnus-signature-separator): Fix custom type. 4235 * gnus-art.el (gnus-signature-separator): Fix custom type.
1838 4236
@@ -1843,6 +4241,22 @@
1843 (mm-inline-override-types): Ditto. 4241 (mm-inline-override-types): Ditto.
1844 (mm-automatic-external-display): Ditto. 4242 (mm-automatic-external-display): Ditto.
1845 4243
42442005-12-15 Reiner Steib <Reiner.Steib@gmx.de>
4245
4246 * spam-report.el (spam-report-user-mail-address)
4247 (spam-report-user-agent): New variables.
4248 (spam-report-url-ping-plain): Use spam-report-user-agent.
4249
42502005-12-14 Ralf Angeli <angeli@iwi.uni-sb.de>
4251
4252 * gnus-art.el (gnus-button-handle-custom): Do not just use
4253 `customize-apropos' for any "M-x customize-*" button but the
4254 function called for. Accept both the function name and its
4255 argument in order to achieve this.
4256 (gnus-button-alist): Remove support for "custom:" URL's. Pass
4257 function name to `gnus-button-handle-custom' in case of "M-x
4258 customize-*" buttons.
4259
18462005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> 42602005-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
1847 4261
1848 * gnus-art.el (gnus-buttonized-mime-types): Mention addition of 4262 * gnus-art.el (gnus-buttonized-mime-types): Mention addition of
@@ -1852,6 +4266,21 @@
1852 * mm-decode.el (mm-discouraged-alternatives): Add xref to 4266 * mm-decode.el (mm-discouraged-alternatives): Add xref to
1853 gnus-buttonized-mime-types in doc string. 4267 gnus-buttonized-mime-types in doc string.
1854 4268
42692005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
4270
4271 * mm-decode.el (mm-discouraged-alternatives): Fix custom type.
4272 Suggest image/.* in the doc string.
4273
42742005-12-12 Reiner Steib <Reiner.Steib@gmx.de>
4275
4276 * mm-uu.el (mm-uu-type-alist): Don't depend on message.el for
4277 message-marks (Debian bug #342521).
4278
42792005-12-12 Simon Josefsson <jas@extundo.com>
4280
4281 * password.el (password-read-from-cache): Add.
4282 (password-read): Use it.
4283
18552005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> 42842005-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
1856 4285
1857 * rfc2047.el (rfc2047-charset-to-coding-system): Recognize 4286 * rfc2047.el (rfc2047-charset-to-coding-system): Recognize
@@ -1862,34 +4291,14 @@
1862 4291
18632005-12-09 Reiner Steib <Reiner.Steib@gmx.de> 42922005-12-09 Reiner Steib <Reiner.Steib@gmx.de>
1864 4293
1865 * gnus-start.el (gnus-no-server-1): Mention 4294 * pop3.el (pop3-stream-type): Fix custom version.
1866 `gnus-level-default-subscribed' in doc string.
1867
18682005-12-09 Reiner Steib <Reiner.Steib@gmx.de>
1869
1870 * gnus-start.el (gnus-start-draft-setup): Enforce
1871 `gnus-draft-mode' for nndraft:drafts at startup.
1872 4295
1873 * gnus.el (gnus-splash): Change custom group. 4296 * mm-uu.el (mm-uu-type-alist): Simplify uu regexp.
1874 (gnus-group-get-parameter, gnus-group-parameter-value): Describe
1875 allow-list argument.
1876
1877 * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc
1878 string.
1879 4297
18802005-12-09 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) 42982005-12-09 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
1881 4299
1882 * mm-decode.el (mm-display-external): Add missing cdr. 4300 * mm-decode.el (mm-display-external): Add missing cdr.
1883 4301
18842005-12-12 Richard M. Stallman <rms@gnu.org>
1885
1886 * mm-url.el (mm-url-load-url): Require url-parse and url-vars.
1887
18882005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
1889
1890 * mm-decode.el (mm-discouraged-alternatives): Fix custom type.
1891 Suggest image/.* in the doc string.
1892
18932005-12-07 Katsumi Yamaoka <yamaoka@jpl.org> 43022005-12-07 Katsumi Yamaoka <yamaoka@jpl.org>
1894 4303
1895 * mm-decode.el (mm-display-external): Use nametemplate (defined in 4304 * mm-decode.el (mm-display-external): Use nametemplate (defined in
@@ -1901,27 +4310,58 @@
1901 4310
19022005-12-06 Reiner Steib <Reiner.Steib@gmx.de> 43112005-12-06 Reiner Steib <Reiner.Steib@gmx.de>
1903 4312
1904 * gnus-art.el (gnus-default-article-saver): Add user-defined 4313 * nntp.el (nntp-marks-directory): Fix custom group.
1905 `function' to custom type. 4314
4315 * gnus-fun.el (gnus-face-from-file): Decrease quant in smaller
4316 steps when < 10.
4317
4318 * gnus-start.el (gnus-no-server-1): Mention
4319 `gnus-level-default-subscribed' in doc string.
1906 4320
19072005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) 43212005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
1908 4322
1909 * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced 4323 * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced
1910 parens. 4324 parens.
1911 4325
19122005-11-29 Reiner Steib <Reiner.Steib@gmx.de> 43262005-11-26 Dave Love <fx@gnu.org>
1913 4327
1914 * gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and 4328 * tls.el (open-tls-stream): Rename arg SERVICE to PORT.
1915 long lines. 4329 (tls-program, tls-success): Provide openssl alternative.
1916 (gnus-cache-delete-group): Wrap doc strings.
1917 4330
1918 * gnus-agent.el (gnus-agent-rename-group) 4331 * starttls.el: Doc fixes.
1919 (gnus-agent-delete-group): Wrap doc strings. 4332 (starttls-open-stream-gnutls, starttls-open-stream): Rename arg
4333 SERVICE to PORT.
4334
4335 * pop3.el (pop3-open-server) <ssl>: Clarify a loop. Deal with
4336 port null or service name.
4337 (starttls-negotiate): Autoload.
4338
43392005-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
4340
4341 * message.el (message-kill-to-signature): Fix interactive spec.
4342
43432005-11-24 Katsumi Yamaoka <yamaoka@jpl.org>
4344
4345 * pop3.el (pop3-open-server): Recognize a string as a service name.
1920 4346
19212005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change) 43472005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change)
1922 4348
1923 * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. 4349 * rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
1924 4350
43512005-11-23 Dave Love <fx@gnu.org>
4352
4353 Add pop3s, pop3/starttls.
4354
4355 * pop3.el (pop3-authentication-scheme): Clarify doc.
4356 (open-tls-stream, starttls-open-stream): Autoload.
4357 (pop3-stream-type): New.
4358 (pop3-open-server): Use it.
4359
4360 * mail-source.el (mail-sources): Fix some :types. Add stream type
4361 for POP.
4362 (mail-source-keyword-map): Add :stream for POP.
4363 (mail-source-fetch-pop): Use pop3-stream-type.
4364
19252005-11-22 Katsumi Yamaoka <yamaoka@jpl.org> 43652005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
1926 4366
1927 * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead 4367 * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
@@ -1932,154 +4372,116 @@
1932 * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid 4372 * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
1933 date header. 4373 date header.
1934 4374
43752005-11-19 Kevin Greiner <kevin.greiner@compsol.cc>
4376
4377 * gnus-sum.el (gnus-fetch-old-headers): Updated docs to warn that
4378 it can seriously impact performance as it bypasses the agent's
4379 local caches.
4380
43812005-11-19 Kevin Greiner <kevin.greiner@compsol.cc>
4382
4383 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server
4384 must be explicitly online rather than "not explicitly offline" for
4385 its flags to be synchronized.
4386
4387 * gnus-sum.el (gnus-summary-remove-process-mark): Always return t so
4388 that gnus-uu-unmark-thread will function correctly.
4389
4390 * gnus-group.el (gnus-total-fetched-for): Reduced cutoff so that
4391 1024K is instead displayed as 1M.
4392
43932005-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
4394
4395 * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil.
4396
19352005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny change) 43972005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny change)
1936 4398
1937 * imap.el (imap-kerberos4-open): Ignore SSL stuff. 4399 * imap.el (imap-kerberos4-open): Ignore SSL stuff.
1938 4400
19392005-11-14 Kevin Greiner <kevin.greiner@compsol.cc> 44012005-11-13 Kevin Greiner <kevin.greiner@compsol.cc>
1940 4402
1941 * gnus-agent.el (gnus-agent-article-alist-save-format): Changed 4403 * gnus-agent.el (gnus-agent-read-local): Trivial fix to format of
1942 internal variable to a custom variable. Changed default value
1943 from compressed(2) to uncompressed(1).
1944 (gnus-agent-read-agentview): Reversed revision 7.8 to restore
1945 support for uncompressed agentview files. Taken together, reading
1946 the agentview file should now be 6-7 times faster.
1947 (gnus-agent-long-article,
1948 gnus-agent-short-article, gnus-agent-score): Renamed category
1949 keywords to match gnus-cus.
1950 (gnus-agent-summary-fetch-series): Modified to protect against
1951 gnus-agent-summary-fetch-group clearing processable flags.
1952 (gnus-agent-synchronize-group-flags): Update live group buffer as
1953 synchronization may occur due to the user toggling the plugged
1954 status.
1955 (gnus-agent-braid-nov): Now tests new nov entries
1956 for duplicates which are removed. The invalid sort check then
1957 triggers a rescan after the sort as sorting may have moved
1958 duplicate entries such that they can be cheaply detected.
1959 (gnus-agent-read-local): Trivial fix to format of
1960 error message to display actual error condition. 4404 error message to display actual error condition.
1961 (gnus-agent-save-local): Avoid saving symbols that are bound to 4405 (gnus-agent-save-local): Avoid saving symbols that are bound to
1962 nil as they simply result in a warning message in 4406 nil as they simply result in a warning message in
1963 gnus-agent-read-local. 4407 gnus-agent-read-local.
1964 (gnus-agent-fetch-group-1): Clear downloadable flag when article
1965 successfully downloaded.
1966 (gnus-agent-regenerate-group): Use
1967 gnus-agent-synchronize-group-flags to reset read status in both
1968 gnus and server.
1969
1970 * nntp.el (nntp-end-of-line): Doc fix.
1971 (nntp-authinfo-rejected): New error condition.
1972 (nntp-wait-for): Use new error condition to signal authentication
1973 error.
1974 (nntp-retrieve-data): Rethrow new error condition to break out of
1975 recursive call to nntp-send-authinfo.
1976 4408
19772005-11-13 Katsumi Yamaoka <yamaoka@jpl.org> 44092005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
1978 4410
1979 * gnus-start.el (gnus-dribble-read-file): Use make-local-variable 4411 * gnus-start.el (gnus-dribble-read-file): Use make-local-variable
1980 rather than make-variable-buffer-local for file-precious-flag. 4412 rather than make-variable-buffer-local for file-precious-flag.
1981 4413
44142005-11-12 Kevin Greiner <kevin.greiner@compsol.cc>
4415
4416 * gnus-agent.el (gnus-agent-braid-nov): Now tests new nov entries
4417 for duplicates which are removed. The invalid sort check then
4418 triggers a rescan after the sort as sorting may have moved
4419 duplicate entries such that they can be cheaply detected.
4420
19822005-11-13 Katsumi Yamaoka <yamaoka@jpl.org> 44212005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
1983 4422
1984 * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag. 4423 * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag.
1985 4424
44252005-11-12 Kevin Greiner <kevin.greiner@compsol.cc>
4426
4427 * gnus-agent.el (gnus-agent-article-alist-save-format): Changed
4428 internal variable to a custom variable. Changed default value
4429 from compressed(2) to uncompressed(1).
4430 (gnus-agent-read-agentview): Reversed revision 7.8 to restore
4431 support for uncompressed agentview files. Taken together, reading
4432 the agentview file should now be 6-7 times faster.
4433
19862005-11-11 Jan Nieuwenhuizen <janneke@gnu.org> 44342005-11-11 Jan Nieuwenhuizen <janneke@gnu.org>
1987 4435
1988 * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag, 4436 * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag,
1989 as a buffer-local variable. This avoids creating truncated 4437 as a buffer-local variable. This avoids creating truncated
1990 dribble files as a result of a hang up, eg. 4438 dribble files as a result of a hang up, eg.
1991 4439
19922005-11-04 Ken Manheimer <ken.manheimer@gmail.com> 44402005-12-09 Reiner Steib <Reiner.Steib@gmx.de>
1993 4441
1994 * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) 4442 * gnus-start.el (gnus-start-draft-setup): Enforce
1995 (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) 4443 `gnus-draft-mode' for nndraft:drafts at startup.
1996 (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) 4444
1997 (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' 4445 * gnus.el (gnus-splash): Change custom group.
1998 argument to all these routines, so the passphrase can be managed 4446 (gnus-group-get-parameter, gnus-group-parameter-value): Describe
1999 externally and passed in to the system. 4447 allow-list argument.
2000 (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for 4448
2001 pgg-add-passphrase-to-cache function. 4449 * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc
2002 4450 string.
2003 * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region) 4451
2004 (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric) 44522005-12-06 Reiner Steib <Reiner.Steib@gmx.de>
2005 (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt) 4453
2006 (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase' 4454 * gnus-art.el (gnus-default-article-saver): Add user-defined
2007 argument to all these routines, so the passphrase can be managed 4455 `function' to custom type.
2008 externally and passed in to the system. 4456
2009 (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache 44572005-10-30 Chong Yidong <cyd@stupidchicken.com>
2010 function.
2011 4458
20122005-10-29 Ken Manheimer <ken.manheimer@gmail.com> 4459 * imap.el (imap-open): Handle case where buffer is a buffer
2013 4460 object.
2014 * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right 4461
2015 part of the decoded armor to find the key-identifier. 44622005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
2016 (pgg-gpg-lookup-key-owner): New function to return the 4463
2017 human-readable identifier of a key owner. 4464 * gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and
2018 (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the 4465 long lines.
2019 key itself. 4466 (gnus-cache-delete-group): Wrap doc strings.
2020 (pgg-gpg-decrypt-region): Prompt with the key owner (rather than 4467
2021 the key value) if we have a key and can match it against a secret 4468 * gnus-agent.el (gnus-agent-rename-group)
2022 key. Also, added a note pointing out fact that the prompt only 4469 (gnus-agent-delete-group): Wrap doc strings.
2023 indicates the first matching key. 4470
2024 4471
2025 * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to 44722005-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
2026 pgg-decrypt-region. 4473
2027 (pgg-pending-timers): A new hash for tracking the passphrase cache 4474 * gnus-start.el (gnus-1): Add "native" to
2028 timers, so that new ones supercede old ones. 4475 gnus-predefined-server-alist.
2029 (pgg-add-passphrase-to-cache): Rename from 4476
2030 `pgg-add-passphrase-cache' to reduce confusion (all callers 4477 * gnus.el (gnus-method-to-server): Don't add "native" to the
2031 changed). Modified to cancel old timers when new ones are added. 4478 lists here, because that leads to problems when
2032 (pgg-remove-passphrase-from-cache): Rename from 4479 gnus-select-method is bound.
2033 `pgg-remove-passphrase-cache' to reduce confusion (all callers 4480
2034 changed). Modified to cancel old timers when their keys are 44812005-11-09 Simon Josefsson <jas@extundo.com>
2035 removed from the cache. 4482
2036 (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in 4483 * gnus-sum.el (gnus-article-sort-by-date-reverse): Remove,
2037 XEmacs, an indirection to delete-itimer. 4484 use (not sort-by-date) instead.
2038 (pgg-read-passphrase-from-cache, pgg-read-passphrase):
2039 Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so
2040 users can only check cache without risk of prompting. Correct bug in
2041 notruncate behavior.
2042 (pgg-read-passphrase-from-cache, pgg-read-passphrase)
2043 (pgg-add-passphrase-cache, pgg-remove-passphrase-cache):
2044 Add informative docstrings.
2045 (pgg-decrypt): Convey provided passphrase in subordinate call to
2046 pgg-decrypt-region.
2047
20482005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com>
2049
2050 * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region)
2051 (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region)
2052 (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional
2053 'passphrase' argument, so the passphrase can be managed externally
2054 and then passed in to the system.
2055
2056 * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache)
2057 (pgg-remove-passphrase-cache): Add optional 'notruncate' argument,
2058 so the passphrase cache can be used reliably with identifiers
2059 besides a pgp packet's key id.
2060
2061 * pgg-gpg.el (pgg-pgp-encrypt-region)
2062 (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
2063 (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
2064 (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
2065 argument to all these routines, so the passphrase can be managed
2066 externally and passed in to the system.
2067
2068 * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional
2069 'notruncate' argument, so the passphrase cache can be used
2070 reliably with identifiers besides a pgp packet's key id.
2071
20722005-10-29 Sascha Wilde <swilde@sha-bang.de>
2073
2074 * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for
2075 symmetric encryption.
2076 (pgg-gpg-symmetric-key-p): New function to check for an symmetric
2077 encrypted session key.
2078 (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted
2079 message ask for the passphrase in a proper way.
2080
2081 * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
2082 New user commands for symmetric encryption.
2083 4485
20842005-11-30 Stefan Monnier <monnier@iro.umontreal.ca> 44862005-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
2085 4487
@@ -2127,6 +4529,27 @@
2127 * message.el (message-generate-headers): Downcase the argument 4529 * message.el (message-generate-headers): Downcase the argument
2128 given to message-check-element. 4530 given to message-check-element.
2129 4531
45322005-11-08 Kevin Greiner <kevin.greiner@compsol.cc>
4533
4534 * nntp.el (nntp-authinfo-rejected): New error condition.
4535 (nntp-wait-for): Use new error condition to signal authentication
4536 error.
4537 (nntp-retrieve-data): Rethrow new error condition to break out of
4538 recursive call to nntp-send-authinfo.
4539
45402005-11-08 Romain Francoise <romain@orebokech.com>
4541
4542 * gnus-sum.el (gnus-summary-catchup-and-goto-prev-group): New function.
4543 (gnus-summary-exit-map): Bind to `Z p'.
4544 (gnus-summary-make-menu-bar): Add menu item.
4545
45462005-11-02 Reiner Steib <Reiner.Steib@gmx.de>
4547
4548 * gnus-art.el (gnus-article-treat-custom): Add `first'.
4549 (gnus-treat-*): Add `first' in all doc strings.
4550
4551 * gnus-group.el (gnus-group-compact-group): Fix typo.
4552
21302005-11-01 Katsumi Yamaoka <yamaoka@jpl.org> 45532005-11-01 Katsumi Yamaoka <yamaoka@jpl.org>
2131 4554
2132 * gnus.el (gnus-parameters-case-fold-search): New variable. 4555 * gnus.el (gnus-parameters-case-fold-search): New variable.
@@ -2140,7 +4563,26 @@
2140 4563
21412005-10-31 Katsumi Yamaoka <yamaoka@jpl.org> 45642005-10-31 Katsumi Yamaoka <yamaoka@jpl.org>
2142 4565
2143 * mml.el (mml-preview): Doc fix. 4566 * mm-util.el (mm-special-display-p): New function.
4567
4568 * mml.el (mml-preview): Use it; doc fix.
4569
45702005-10-29 Romain Francoise <romain@orebokech.com>
4571
4572 * message.el (message-fix-before-sending): Fix comment.
4573
45742005-10-29 Jari Aalto <jari.aalto@cante.net>
4575
4576 * gnus-sum.el (gnus-article-sort-by-date-reverse): New function.
4577
45782005-10-29 Jari Aalto <jari.aalto@cante.net>
4579
4580 * score-mode.el (gnus-score-edit-done-hook): Introduce variable.
4581 Used in gnus-score.el.
4582
45832005-10-28 Reiner Steib <Reiner.Steib@gmx.de>
4584
4585 * mm-util.el (mm-codepage-setup): Remove bogus alias test.
2144 4586
21452005-10-27 Reiner Steib <Reiner.Steib@gmx.de> 45872005-10-27 Reiner Steib <Reiner.Steib@gmx.de>
2146 4588
@@ -2156,6 +4598,24 @@
2156 Courier IMAP ("some version from 2004"). Mostly based on similar 4598 Courier IMAP ("some version from 2004"). Mostly based on similar
2157 code in the same function. 4599 code in the same function.
2158 4600
46012005-10-26 Didier Verna <didier@xemacs.org>
4602
4603 * gnus-group.el (gnus-group-compact-group): invalidate original
4604 article buffer.
4605 * gnus-srvr.el (gnus-server-compact-server): ditto.
4606 * nnml.el (nnml-request-compact-group): handle self Xref: field in
4607 NOV database and in article itself.
4608 Invalidate article backlog.
4609
46102005-10-26 Reiner Steib <Reiner.Steib@gmx.de>
4611
4612 * mm-uu.el (mm-uu-hide-markers): Fix XEmacs case.
4613
46142005-10-26 Simon Josefsson <jas@extundo.com>
4615
4616 * flow-fill.el (fill-flowed): Flow-fill unquoted lines too, revert
4617 part of 2004-07-25 change.
4618
21592005-10-26 Katsumi Yamaoka <yamaoka@jpl.org> 46192005-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
2160 4620
2161 * message.el (message-display-completion-list): New function. 4621 * message.el (message-display-completion-list): New function.
@@ -2186,10 +4646,21 @@
2186 * gnus-score.el (gnus-default-adaptive-score-alist): Set defaults 4646 * gnus-score.el (gnus-default-adaptive-score-alist): Set defaults
2187 depending on gnus-score-decay-constant. 4647 depending on gnus-score-decay-constant.
2188 4648
21892005-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org> 4649 * encrypt.el (encrypt-insert-file-contents)
4650 (encrypt-write-file-contents): Don't use `gnus-message'.
2190 4651
2191 * nnslashdot.el (nnslashdot-request-article) 4652 * mm-uu.el (mm-uu-verbatim-marks-extract): Add four start and end
2192 (nnslashdot-retrieve-headers-1): Update to new HTML. 4653 arguments.
4654 (mm-uu-type-alist): Add message-marks and insert-marks. Pass
4655 arguments to mm-uu-verbatim-marks-extract.
4656 (mm-uu-hide-markers): New variable.
4657 (mm-uu-extract): Use face similar to `gnus-cite-3'.
4658
4659 * gnus-fun.el (gnus-convert-image-to-x-face-command)
4660 (gnus-convert-image-to-face-command): Use "convert" by default to
4661 allow other input image formats.
4662 (gnus-x-face-from-file, gnus-face-from-file): Adjust doc strings
4663 accordingly.
2193 4664
21942005-10-23 Simon Josefsson <jas@extundo.com> 46652005-10-23 Simon Josefsson <jas@extundo.com>
2195 4666
@@ -2197,6 +4668,12 @@
2197 with latest GNU SASL. 4668 with latest GNU SASL.
2198 (imap-gssapi-open): Ignore 'Trying ...' messages from GNU SASL. 4669 (imap-gssapi-open): Ignore 'Trying ...' messages from GNU SASL.
2199 4670
46712005-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
4672
4673 * nnslashdot.el (nnslashdot-retrieve-headers-1): Update to new
4674 HTML.
4675 (nnslashdot-request-article): Ditto.
4676
22002005-10-20 Hiroshi Fujishima <hiroshi.fujishima@gmail.com> (tiny change) 46772005-10-20 Hiroshi Fujishima <hiroshi.fujishima@gmail.com> (tiny change)
2201 4678
2202 * mail-source.el (mail-source-fetch-pop): Require pop3. 4679 * mail-source.el (mail-source-fetch-pop): Require pop3.
@@ -2214,6 +4691,9 @@
2214 4691
2215 * message.el (message-tool-bar-local-item-from-menu): Fix comment. 4692 * message.el (message-tool-bar-local-item-from-menu): Fix comment.
2216 4693
4694 * mm-bodies.el (mm-decode-string): Call
4695 `mm-charset-to-coding-system' with allow-override argument.
4696
22172005-10-19 Katsumi Yamaoka <yamaoka@jpl.org> 46972005-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
2218 4698
2219 * rfc2047.el (rfc2047-allow-incomplete-encoded-text): New variable. 4699 * rfc2047.el (rfc2047-allow-incomplete-encoded-text): New variable.
@@ -2247,27 +4727,52 @@
2247 * message.el (message-expand-group): Pass the common 4727 * message.el (message-expand-group): Pass the common
2248 prefix substring of completion to `display-completion-list'. 4728 prefix substring of completion to `display-completion-list'.
2249 4729
22502005-10-09 Daniel Brockman <daniel@brockman.se> 47302005-10-13 Reiner Steib <Reiner.Steib@gmx.de>
2251 4731
2252 * format-spec.el (format-spec): Propagate text properties of % spec. 4732 * mml-sec.el (mml-secure-method): New internal variable.
4733 (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign)
4734 (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): New
4735 functions using mml-secure-method.
2253 4736
22542005-01-21 Derek Atkins <warlord@MIT.EDU> (tiny change) 4737 * mml.el (mml-mode-map): Add key bindings for those functions.
4738 (mml-menu): Simplify security menu entries. Suggested by Jesper
4739 Harder <harder@myrealbox.com>.
4740 (mml-attach-file, mml-attach-buffer, mml-attach-external): Goto
4741 end of message if point is the headers of the message.
2255 4742
2256 * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache. 4743 * message.el (message-in-body-p): New function.
2257 4744
22582005-10-08 Simon Josefsson <jas@extundo.com> 4745 * assistant.el: Autoload gnus-util and netrc.
2259 4746
2260 * pgg-parse.el (top-level): Don't require custom, it is 4747 * mm-util.el (mm-charset-to-coding-system): Add allow-override.
2261 autoloaded. (To sync with No Gnus.) 4748 Use `mm-charset-override-alist' only when decoding.
2262 4749
22632005-05-09 Georg C. F. Greve <greve@gnu.org> (tiny change) 4750 * mm-bodies.el (mm-decode-body): Call
4751 `mm-charset-to-coding-system' with allow-override argument.
2264 4752
2265 * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching. 4753 * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch
4754 `filename' from Content-Disposition if Content-Type doesn't
4755 provide `name'.
4756 (gnus-mime-view-part-as-type): Set default instead of
4757 initial-input.
4758
47592005-10-09 Daniel Brockman <daniel@brockman.se>
2266 4760
22672005-10-08 Simon Josefsson <jas@extundo.com> 4761 * format-spec.el (format-spec): Propagate text properties of % spec.
2268 4762
2269 * pgg-def.el (top-level): Don't require custom, it is 47632005-10-12 Reiner Steib <Reiner.Steib@gmx.de>
2270 autoloaded. (To sync with No Gnus.) 4764
4765 * gnus-art.el (gnus-treat-predicate): Add `first'.
4766
47672005-10-11 Reiner Steib <Reiner.Steib@gmx.de>
4768
4769 * mm-util.el (mm-charset-synonym-alist): Improve doc string.
4770 (mm-charset-override-alist): New variable.
4771 (mm-charset-to-coding-system): Use it.
4772 (mm-codepage-setup): New helper function.
4773 (mm-charset-eval-alist): New variable.
4774 (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn
4775 about unknown charsets.
2271 4776
22722005-10-04 David Hansen <david.hansen@gmx.net> 47772005-10-04 David Hansen <david.hansen@gmx.net>
2273 4778
@@ -2276,6 +4781,13 @@
2276 4781
22772005-10-04 Reiner Steib <Reiner.Steib@gmx.de> 47822005-10-04 Reiner Steib <Reiner.Steib@gmx.de>
2278 4783
4784 * mm-uu.el (mm-uu-verbatim-marks-extract, mm-uu-latex-extract):
4785 Rename x-gnus-verbatim to x-verbatim.
4786 (mm-uu-type-alist): Fix regexp for verbatim-marks.
4787
4788 * mm-decode.el (mm-automatic-display): Rename x-gnus-verbatim to
4789 x-verbatim.
4790
2279 * mm-url.el (mm-url-predefined-programs): Add switches for curl. 4791 * mm-url.el (mm-url-predefined-programs): Add switches for curl.
2280 4792
2281 * gnus-util.el (gnus-remove-duplicates): Remove. 4793 * gnus-util.el (gnus-remove-duplicates): Remove.
@@ -2290,6 +4802,22 @@
2290 * mm-util.el (mm-delete-duplicates): Use `delete-dups' if 4802 * mm-util.el (mm-delete-duplicates): Use `delete-dups' if
2291 available, else use implementation from `delete-dups'. 4803 available, else use implementation from `delete-dups'.
2292 4804
4805 * message.el (message-insert-expires): New function.
4806 (message-mode-map): Add key binding.
4807 (message-mode-field-menu): Add menu entry.
4808 (message-mode): Document it.
4809 (message-make-expires-date): Use `message-make-date'.
4810
48112005-10-04 Josh Huber <huber@alum.wpi.edu>
4812
4813 * message.el (message-make-expires-date): New function.
4814
48152005-10-04 Katsumi Yamaoka <yamaoka@jpl.org>
4816
4817 * Makefile.in (list-installed-shadows): New entry.
4818 (install): Use it.
4819 (remove-installed-shadows): New entry.
4820
22932005-10-02 Katsumi Yamaoka <yamaoka@jpl.org> 48212005-10-02 Katsumi Yamaoka <yamaoka@jpl.org>
2294 4822
2295 * time-date.el: Autoload parse-time-string, XEmacs needs it. 4823 * time-date.el: Autoload parse-time-string, XEmacs needs it.
@@ -2302,8 +4830,18 @@
2302 (mm-viewer-completion-map, mm-viewer-completion-map): 4830 (mm-viewer-completion-map, mm-viewer-completion-map):
2303 Move initialization inside declaration. 4831 Move initialization inside declaration.
2304 4832
48332005-09-29 Simon Josefsson <jas@extundo.com>
4834
4835 * spam.el: Load hashcash when compiling, to avoid warnings. Don't
4836 autoload mail-check-payment.
4837 (spam-check-hashcash): Define unconditionally, since hashcash.el
4838 is part of Gnus now. Ignore errors from payment checking.
4839
23052005-09-28 Reiner Steib <Reiner.Steib@gmx.de> 48402005-09-28 Reiner Steib <Reiner.Steib@gmx.de>
2306 4841
4842 * message.el (message-bold-region, message-unbold-region): Rename
4843 from `bold-region' and `unbold-region'.
4844
2307 * message.el: Remove useless autoloads. 4845 * message.el: Remove useless autoloads.
2308 4846
23092005-09-28 Simon Josefsson <jas@extundo.com> 48472005-09-28 Simon Josefsson <jas@extundo.com>
@@ -2322,8 +4860,20 @@
2322 (mm-uu-diff-groups-regexp): Change default value. 4860 (mm-uu-diff-groups-regexp): Change default value.
2323 (mm-uu-type-alist): Add doc string. 4861 (mm-uu-type-alist): Add doc string.
2324 (mm-uu-configure): Add doc string. Make it interactive. 4862 (mm-uu-configure): Add doc string. Make it interactive.
4863 (mm-uu-tex-groups-regexp): New variable.
4864 (mm-uu-latex-extract, mm-uu-latex-test): New functions.
4865 (mm-uu-type-alist): Add LaTeX documents.
4866 (mm-uu-verbatim-marks-extract): Use "text/x-gnus-verbatim" instead
4867 of "text/verbatim".
2325 (mm-uu-diff-groups-regexp): Fix missing quotes from previous commit. 4868 (mm-uu-diff-groups-regexp): Fix missing quotes from previous commit.
2326 4869
4870 * mm-decode.el (mm-automatic-display): Use "text/x-gnus-verbatim"
4871 instead of "text/verbatim".
4872
4873 * message.el (message-mark-inserted-region)
4874 (message-mark-insert-file): Use slrn style marks when called with
4875 prefix argument.
4876
23272005-09-27 Simon Josefsson <jas@extundo.com> 48772005-09-27 Simon Josefsson <jas@extundo.com>
2328 4878
2329 * message.el (message-idna-to-ascii-rhs-1): Reformat. 4879 * message.el (message-idna-to-ascii-rhs-1): Reformat.
@@ -2348,7 +4898,10 @@
2348 * gnus-art.el (gnus-mime-display-single): Don't modify text if it 4898 * gnus-art.el (gnus-mime-display-single): Don't modify text if it
2349 has been decoded. 4899 has been decoded.
2350 4900
2351 * mm-decode.el (mm-insert-part): Don't modify text if it has been 4901 * mm-decode.el (mm-automatic-display): Add text/verbatim.
4902 (mm-insert-part): Don't modify text if it has been decoded.
4903
4904 * mm-uu.el (mm-uu-verbatim-marks-extract): Say text has been
2352 decoded. 4905 decoded.
2353 4906
2354 * mm-view.el (mm-inline-text): Don't strip text props unless 4907 * mm-view.el (mm-inline-text): Don't strip text props unless
@@ -2384,6 +4937,36 @@
2384 * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the 4937 * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the
2385 default value is nil. 4938 default value is nil.
2386 4939
4940 * mm-uu.el (mm-uu-type-alist): Added slrn style verbatim-marks.
4941 (mm-uu-verbatim-marks-extract): New function.
4942 (mm-uu-extract): New face.
4943 (mm-uu-copy-to-buffer): Use it.
4944
4945 * spam-report.el (spam-report-gmane-ham): Renamed from
4946 `spam-report-gmane-unspam'.
4947 (spam-report-gmane-internal): Renamed from `spam-report-gmane'.
4948 Simplify use of UNSPAM argument. Fetch "X-Report-Unspam" header.
4949
4950 * spam.el (spam-report-gmane-spam, spam-report-gmane-ham):
4951 Autoload.
4952 (spam-report-gmane-unregister-routine): Renamed
4953 `spam-report-gmane-unspam' to `spam-report-gmane-ham'.
4954
49552005-09-21 Teodor Zlatanov <tzz@lifelogs.com>
4956
4957 * spam.el (spam-use-gmane, spam-report-gmane-register-routine)
4958 (spam-report-gmane-unregister-routine): Add support for gmane
4959 unregistration.
4960
4961 * spam-report.el (spam-report-gmane-unspam)
4962 (spam-report-gmane-spam): Add new wrappers around spam-report-gmane.
4963 (spam-report-gmane): Change to take a single article and do unspam
4964 registration.
4965
49662005-09-19 Reiner Steib <Reiner.Steib@gmx.de>
4967
4968 * mm-url.el (mm-url-decode-entities): Fix regexp.
4969
23872005-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org> 49702005-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
2388 4971
2389 * gnus-agent.el (gnus-agent-synchronize-flags): Switch the 4972 * gnus-agent.el (gnus-agent-synchronize-flags): Switch the
@@ -2391,9 +4974,39 @@
2391 switches to something else, then the function should be fixed not 4974 switches to something else, then the function should be fixed not
2392 be exceedingly slow. 4975 be exceedingly slow.
2393 4976
49772005-09-20 Teodor Zlatanov <tzz@lifelogs.com>
4978
4979 * gnus-start.el (gnus-activate-group): If the server is nil, don't
4980 fail hard.
4981
4982 * spam-report.el: Add better Keywords line.
4983
4984 * spam.el: Add Maintainer and better Keywords line.
4985
23942005-09-19 Reiner Steib <Reiner.Steib@gmx.de> 49862005-09-19 Reiner Steib <Reiner.Steib@gmx.de>
2395 4987
2396 * mm-url.el (mm-url-decode-entities): Fix regexp. 4988 * gnus-art.el (gnus-article-replace-part)
4989 (gnus-mime-replace-part): New functions.
4990 (gnus-mime-action-alist, gnus-mime-button-commands)
4991 (gnus-mime-save-part-and-strip): Added file argument.
4992 (gnus-article-part-wrapper): Added interactive argument.
4993
4994 * gnus-sum.el (gnus-summary-mime-map): Add
4995 `gnus-article-replace-part'.
4996
49972005-09-19 Didier Verna <didier@xemacs.org>
4998
4999 The nnml compaction feature:
5000 * nnml.el (nnml-request-compact-group): New function.
5001 * nnml.el (nnml-request-compact): New function.
5002 * gnus-int.el (gnus-request-compact-group): New function.
5003 * gnus-int.el (gnus-request-compact): New function.
5004 * gnus-group.el (gnus-group-compact-group): New function.
5005 * gnus-group.el (gnus-group-group-map): Bind it to 'G z'.
5006 * gnus-group.el (gnus-group-make-menu-bar): Add an entry for it.
5007 * gnus-srvr.el (gnus-server-compact-server): New function.
5008 * gnus-srvr.el (gnus-server-mode-map): Bind it to 'z'.
5009 * gnus-srvr.el (gnus-server-make-menu-bar): Add an entry for it.
2397 5010
23982005-09-18 Deepak Goel <deego@gnufans.org> 50112005-09-18 Deepak Goel <deego@gnufans.org>
2399 5012
@@ -2404,6 +5017,10 @@
2404 5017
2405 * gnus.el (gnus-group-startup-message): Bind image-load-path. 5018 * gnus.el (gnus-group-startup-message): Bind image-load-path.
2406 5019
50202005-09-15 Romain Francoise <romain@orebokech.com>
5021
5022 * message.el (message-fill-paragraph): Clarify docstring.
5023
24072005-09-14 Katsumi Yamaoka <yamaoka@jpl.org> 50242005-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
2408 5025
2409 * gnus-art.el (gnus-mime-display-part): Protect against broken 5026 * gnus-art.el (gnus-mime-display-part): Protect against broken
@@ -2414,6 +5031,31 @@
2414 * gnus-sum.el (gnus-summary-edit-article-done): Remove text props 5031 * gnus-sum.el (gnus-summary-edit-article-done): Remove text props
2415 before parsing header. 5032 before parsing header.
2416 5033
50342005-09-11 Jari Aalto <jari.aalto@cante.net>
5035
5036 * html2text.el: (html2text-replace-list): Add new entities.
5037
50382005-09-11 Romain Francoise <romain@orebokech.com>
5039
5040 * message.el (message-alternative-emails): Improve docstring.
5041 (message-setup-1): Call `message-use-alternative-email-as-from'
5042 after `message-setup-hook' to give it precedence over posting
5043 styles, etc.
5044 (message-use-alternative-email-as-from): Add docstring. Remove
5045 the original From header if present.
5046
5047 * nnml.el (nnml-compressed-files-size-threshold): New variable.
5048 (nnml-save-mail): Use it.
5049
5050 * gnus-uu.el (gnus-uu-mark-series): Return number of marked
5051 articles. Add new argument `silent'.
5052 (gnus-uu-mark-all): Report the total number of marked articles.
5053
50542005-09-10 Romain Francoise <romain@orebokech.com>
5055
5056 * gnus-uu.el (gnus-message-process-mark): Use gnus-message.
5057 (gnus-uu-mark-series): Likewise.
5058
24172005-09-10 Reiner Steib <Reiner.Steib@gmx.de> 50592005-09-10 Reiner Steib <Reiner.Steib@gmx.de>
2418 5060
2419 * spam-report.el (spam-report-gmane): Fix generation of spam 5061 * spam-report.el (spam-report-gmane): Fix generation of spam
@@ -2432,13 +5074,16 @@
2432 This is only used if `spam-report-gmane-use-article-number' is nil. 5074 This is only used if `spam-report-gmane-use-article-number' is nil.
2433 (spam-report-gmane-spam-header): Remove. Not used anymore. 5075 (spam-report-gmane-spam-header): Remove. Not used anymore.
2434 5076
5077 * gnus-sum.el (gnus-thread-sort-by-recipient): New function to
5078 make `gnus-summary-sort-by-recipient' work with threading.
5079
2435 * nnweb.el (nnweb-google-wash-article): Print a message if article 5080 * nnweb.el (nnweb-google-wash-article): Print a message if article
2436 is not available. 5081 is not available.
2437 5082
24382005-09-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org> 50832005-09-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
2439 5084
2440 * gnus-art.el (gnus-mime-display-single): Decode text/* parts 5085 * gnus-art.el (gnus-mime-display-single): Revert 2004-10-07
2441 content before displaying. 5086 change. Decode text/* parts content before displaying.
2442 5087
24432005-09-06 Reiner Steib <Reiner.Steib@gmx.de> 50882005-09-06 Reiner Steib <Reiner.Steib@gmx.de>
2444 5089
@@ -2460,8 +5105,22 @@
2460 * gnus-art.el (gnus-signature-limit) 5105 * gnus-art.el (gnus-signature-limit)
2461 (gnus-article-mime-part-function): Ditto. 5106 (gnus-article-mime-part-function): Ditto.
2462 5107
51082005-09-05 Katsumi Yamaoka <yamaoka@jpl.org>
5109
5110 * mml.el (mml-mode): Silence the byte compiler.
5111
5112 * gnus-art.el (gnus-article-jump-to-part): Redisplay the article
5113 using `(sit-for 0)' before moving the point to the specified part;
5114 skip unbuttonized parts.
5115 (gnus-article-part-wrapper): Don't use save-window-excursion; don't
5116 return to the summary window if gnus-auto-select-part is non-nil.
5117
24632005-09-04 Reiner Steib <Reiner.Steib@gmx.de> 51182005-09-04 Reiner Steib <Reiner.Steib@gmx.de>
2464 5119
5120 * mml.el (mml-dnd-protocol-alist, mml-dnd-attach-options): New
5121 variables.
5122 (mml-dnd-attach-file, mml-mode): Use them.
5123
2465 * nnweb.el (nnweb-type-definition, nnweb-google-wash-article): 5124 * nnweb.el (nnweb-type-definition, nnweb-google-wash-article):
2466 Make fetching article by MID work again for Google Groups. Added 5125 Make fetching article by MID work again for Google Groups. Added
2467 FIXME concerning gnus-group-make-web-group. 5126 FIXME concerning gnus-group-make-web-group.
@@ -2470,15 +5129,17 @@
2470 Don't depend on Gnus by using mail-extract-address-components if 5129 Don't depend on Gnus by using mail-extract-address-components if
2471 gnus-extract-address-components is not bound. 5130 gnus-extract-address-components is not bound.
2472 5131
2473 * gnus.el (gnus-user-agent): Use list of symbols instead of 51322005-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
2474 symbols. Display full version number for (S)XEmacs. Optionally
2475 display (S)XEmacs codename.
2476 5133
2477 * gnus-util.el (gnus-emacs-version): Update for new 5134 * gnus-art.el (gnus-mime-display-security): Don't display the
2478 `gnus-user-agent'. 5135 signature, but only the signed part.
2479 5136
2480 * gnus-msg.el (gnus-extended-version): Make it possible to omit 51372005-09-02 Katsumi Yamaoka <yamaoka@jpl.org>
2481 Gnus version. 5138
5139 * gnus-sum.el (gnus-thread-hide-subtree): Doc fix.
5140
5141 * gnus-msg.el (gnus-inews-insert-gcc): Fix the mistake of using
5142 list, not listp.
2482 5143
24832005-09-02 Hrvoje Niksic <hniksic@xemacs.org> 51442005-09-02 Hrvoje Niksic <hniksic@xemacs.org>
2484 5145
@@ -2489,12 +5150,34 @@
2489 De-canonicalize CRLF for all text content types, not just 5150 De-canonicalize CRLF for all text content types, not just
2490 text/plain. 5151 text/plain.
2491 5152
24922005-09-02 Katsumi Yamaoka <yamaoka@jpl.org> 51532005-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
2493 5154
2494 * gnus-sum.el (gnus-thread-hide-subtree): Doc fix. 5155 * gnus-art.el (gnus-article-part-wrapper): Error if there's no
5156 valid article; point arrow and cursor at the MIME button.
2495 5157
2496 * gnus-msg.el (gnus-inews-insert-gcc): Fix the mistake of using 51582005-08-30 Katsumi Yamaoka <yamaoka@jpl.org>
2497 list, not listp. 5159
5160 * gnus-art.el (gnus-mime-save-part-and-strip): Clarify prompt.
5161 Suggested by Dan Christensen <jdc@uwo.ca>.
5162
5163 * mm-decode.el (mm-save-part): Enable change of prompt.
5164
51652005-08-29 Jari Aalto <jari.aalto@cante.net>
5166
5167 * gnus-msg.el (gnus-inews-add-send-actions): Made
5168 `message-post-method' lambda parameter ARG `&optional'.
5169
51702005-08-29 Reiner Steib <Reiner.Steib@gmx.de>
5171
5172 * gnus-sum.el (gnus-summary-mime-map): Added
5173 gnus-article-save-part-and-strip, gnus-article-delete-part and
5174 gnus-article-jump-to-part.
5175
5176 * gnus-art.el (gnus-article-edit-article): Added quiet argument.
5177 (gnus-article-edit-part): Use it.
5178 (gnus-article-part-wrapper): Added no-handle argument.
5179 (gnus-article-save-part-and-strip, gnus-article-delete-part): New
5180 functions.
2498 5181
24992005-08-29 Romain Francoise <romain@orebokech.com> 51822005-08-29 Romain Francoise <romain@orebokech.com>
2500 5183
@@ -2502,6 +5185,19 @@
2502 docstring. 5185 docstring.
2503 (gnus-face-from-file): Likewise. 5186 (gnus-face-from-file): Likewise.
2504 5187
51882005-08-29 Reiner Steib <Reiner.Steib@gmx.de>
5189
5190 * gnus-art.el (gnus-mime-save-part-and-strip): Don't prompt.
5191 (gnus-mime-delete-part): Don't prompt if `gnus-expert-user' is
5192 non-nil.
5193 (gnus-auto-select-part): New variable.
5194 (gnus-article-jump-to-part): New function.
5195 (gnus-article-edit-part, gnus-mime-save-part-and-strip)
5196 (gnus-mime-delete-part): Allow selecting specified part after
5197 deleting or stripping parts.
5198 (gnus-article-jump-to-part): Don't use `read-number'. Use last
5199 part if argument is bogus.
5200
25052005-08-31 Juanma Barranquero <lekktu@gmail.com> 52012005-08-31 Juanma Barranquero <lekktu@gmail.com>
2506 5202
2507 * gnus-art.el (w3m-minor-mode-map): 5203 * gnus-art.el (w3m-minor-mode-map):
@@ -2548,22 +5244,40 @@
2548 (pgg-insert-url-with-w3): Require url, to get 5244 (pgg-insert-url-with-w3): Require url, to get
2549 url-insert-file-contents regardless of where it is defined. 5245 url-insert-file-contents regardless of where it is defined.
2550 5246
52472005-08-13 Romain Francoise <romain@orebokech.com>
5248
5249 * message.el (message-cite-original-1): New function.
5250 (message-cite-original): Use it.
5251 (message-cite-original-without-signature): Ditto.
5252
52532005-08-08 Romain Francoise <romain@orebokech.com>
5254
5255 * message.el (message-yank-empty-prefix): New variable.
5256 (message-indent-citation): Use it.
5257 (message-cite-original-without-signature): Respect X-No-Archive.
5258
25512005-08-08 Simon Josefsson <jas@extundo.com> 52592005-08-08 Simon Josefsson <jas@extundo.com>
2552 5260
2553 * pgg.el: Autoload url-insert-file-contents instead of loading 5261 * pgg.el: Autoload url-insert-file-contents instead of loading
2554 w3/url. 5262 w3/url.
2555 (pgg-insert-url-with-w3): Don't load url here. 5263 (pgg-insert-url-with-w3): Don't load url here.
2556 5264
52652005-08-07 Jesper Harder <harder@phys.au.dk>
5266
5267 * message.el (message-kill-to-signature): Don't insert newline at
5268 bol.
5269 (message-newline-and-reformat): Bind fill-paragraph-function to nil.
5270
52712005-08-06 Romain Francoise <romain@orebokech.com>
5272
5273 * message.el (message-user-fqdn): Fix typo in docstring.
5274
25572005-08-05 Daiki Ueno <ueno@unixuser.org> 52752005-08-05 Daiki Ueno <ueno@unixuser.org>
2558 5276
2559 * mml2015.el (mml2015-pgg-sign): Make sure micalg is correct. 5277 * mml2015.el (mml2015-pgg-sign): Make sure micalg is correct.
2560 5278
2561 * pgg-parse.el (pgg-parse-hash-algorithm-alist): Add SHA-2. 5279 * pgg-parse.el (pgg-parse-hash-algorithm-alist): Add SHA-2.
2562 5280
25632005-08-06 Romain Francoise <romain@orebokech.com>
2564
2565 * message.el: Fix typo in docstring.
2566
25672005-08-05 Katsumi Yamaoka <yamaoka@jpl.org> 52812005-08-05 Katsumi Yamaoka <yamaoka@jpl.org>
2568 5282
2569 * mm-bodies.el (mm-encode-body): Use coding system rather than 5283 * mm-bodies.el (mm-encode-body): Use coding system rather than
@@ -2572,12 +5286,6 @@
2572 * mm-util.el (mm-find-mime-charset-region): Attempt to reduce the 5286 * mm-util.el (mm-find-mime-charset-region): Attempt to reduce the
2573 number of charsets if utf-8 is available (XEmacs). 5287 number of charsets if utf-8 is available (XEmacs).
2574 5288
25752005-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
2576
2577 * gnus-art.el (article-unsplit-urls): Don't anchor urls to the
2578 start of the lines.
2579 (gnus-picon-databases): Add /usr/share/picons.
2580
25812005-08-04 Reiner Steib <Reiner.Steib@gmx.de> 52892005-08-04 Reiner Steib <Reiner.Steib@gmx.de>
2582 5290
2583 * gnus-art.el (gnus-button-valid-localpart-regexp): New variable 5291 * gnus-art.el (gnus-button-valid-localpart-regexp): New variable
@@ -2587,9 +5295,6 @@
2587 for news:localpart@domain buttons. 5295 for news:localpart@domain buttons.
2588 (gnus-button-ctan-directory-regexp): Update. 5296 (gnus-button-ctan-directory-regexp): Update.
2589 5297
2590 * message.el (message-kill-buffer): Raise the current frame.
2591 (message-bury): Use `window-dedicated-p'.
2592
25932005-08-02 Katsumi Yamaoka <yamaoka@jpl.org> 52982005-08-02 Katsumi Yamaoka <yamaoka@jpl.org>
2594 5299
2595 * sieve-manage.el (sieve-manage-interactive-login): Use 5300 * sieve-manage.el (sieve-manage-interactive-login): Use
@@ -2647,9 +5352,8 @@
2647 (gnus-article-beginning-of-window): New macro. 5352 (gnus-article-beginning-of-window): New macro.
2648 (gnus-article-next-page-1): Use it. 5353 (gnus-article-next-page-1): Use it.
2649 (gnus-article-prev-page): Ditto. 5354 (gnus-article-prev-page): Ditto.
2650 (gnus-mime-save-part-and-strip): Use insert-buffer-substring 5355 (gnus-article-edit-part): Use insert-buffer-substring instead of
2651 instead of insert-buffer. 5356 insert-buffer.
2652 (gnus-mime-delete-part): Ditto.
2653 (gnus-article-edit-exit): Ditto. 5357 (gnus-article-edit-exit): Ditto.
2654 5358
2655 * gnus-util.el (gnus-beginning-of-window): Remove. 5359 * gnus-util.el (gnus-beginning-of-window): Remove.
@@ -2661,18 +5365,44 @@
2661 to have the url package without w3. Reported by Daiki Ueno 5365 to have the url package without w3. Reported by Daiki Ueno
2662 <ueno@unixuser.org> and Luigi Panzeri <matley@muppetslab.org>. 5366 <ueno@unixuser.org> and Luigi Panzeri <matley@muppetslab.org>.
2663 5367
26642005-07-21 Stefan Monnier <monnier@iro.umontreal.ca> 53682005-07-20 Didier Verna <didier@xemacs.org>
2665 5369
2666 * mml.el (mml-minibuffer-read-disposition): Don't use inline by default 5370 * gnus-diary.el: Remove the description comment (nndiary is now
2667 for text/rtf. Display default in prompt. Pass default for M-n. 5371 properly documented in the Gnus manual).
5372 Fix the spelling of "Back End".
5373 * nndiary.el: Ditto.
5374 Fix the copyright notice.
2668 5375
2669 * mm-uu.el (mm-uu-copy-to-buffer): Use with-current-buffer. 53762005-07-18 Romain Francoise <romain@orebokech.com>
5377
5378 * gnus-sum.el (gnus-summary-to-prefix,
5379 gnus-summary-newsgroup-prefix): New variables.
5380 (gnus-summary-from-or-to-or-newsgroups): Use them.
5381
53822005-07-17 Romain Francoise <romain@orebokech.com>
5383
5384 * mml2015.el (mml2015-clean-buffer): Prefix buffer name with a
5385 space as it's generally not especially interesting to the user.
2670 5386
26712005-07-16 Romain Francoise <romain@orebokech.com> 53872005-07-16 Romain Francoise <romain@orebokech.com>
2672 5388
5389 * nnfolder.el (nnfolder-save-buffer): Bind `copyright-update' to
5390 nil to avoid prompting and file modification if one of the
5391 messages at the top of the nnfolder file contains a copyright
5392 notice.
5393 Update copyright notice.
5394
2673 * gnus-uu.el (gnus-uu-save-article): Use `message-make-date' 5395 * gnus-uu.el (gnus-uu-save-article): Use `message-make-date'
2674 instead of `current-time-string' as the latter creates a time 5396 instead of `current-time-string' as the latter creates a time
2675 string that is not RFC 2822 compliant (it lacks the zone). 5397 string that is not RFC 2822 compliant (it lacks the zone).
5398 Update copyright notice.
5399
54002005-07-21 Stefan Monnier <monnier@iro.umontreal.ca>
5401
5402 * mml.el (mml-minibuffer-read-disposition): Don't use inline by default
5403 for text/rtf. Display default in prompt. Pass default for M-n.
5404
5405 * mm-uu.el (mm-uu-copy-to-buffer): Use with-current-buffer.
2676 5406
26772005-07-16 Lars Magne Ingebrigtsen <larsi@gnus.org> 54072005-07-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
2678 5408
@@ -2689,10 +5419,22 @@
2689 * gnus-util.el (gnus-beginning-of-window): New function. 5419 * gnus-util.el (gnus-beginning-of-window): New function.
2690 (gnus-end-of-window): New function. 5420 (gnus-end-of-window): New function.
2691 5421
54222005-07-14 Hiroshi Fujishima <hiroshi.fujishima@gmail.com> (tiny change)
5423
5424 * gnus-score.el (gnus-score-edit-all-score): Set
5425 gnus-score-edit-exit-function to gnus-score-edit-done and call
5426 gnus-message.
5427
54282005-07-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
5429
5430 * gnus-msg.el (gnus-button-mailto): Remove
5431 save-selected-window-window hackery because it relies on
5432 save-selected-window internals.
5433
26922005-07-13 Katsumi Yamaoka <yamaoka@jpl.org> 54342005-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
2693 5435
2694 * gnus-salt.el (gnus-pick-mode): Remove the 5th arg of 5436 * gnus-salt.el (gnus-pick-mode): Remove the 5th arg of
2695 gnus-add-minor-mode. 5437 add-minor-mode.
2696 (gnus-binary-mode): Ditto. 5438 (gnus-binary-mode): Ditto.
2697 5439
2698 * gnus-topic.el (gnus-topic-mode): Ditto. 5440 * gnus-topic.el (gnus-topic-mode): Ditto.
@@ -2730,7 +5472,7 @@
27302005-06-30 Katsumi Yamaoka <yamaoka@jpl.org> 54722005-06-30 Katsumi Yamaoka <yamaoka@jpl.org>
2731 5473
2732 * gnus-art.el (article-display-face): Correct the position in 5474 * gnus-art.el (article-display-face): Correct the position in
2733 which Faces are inserted; use dolist. 5475 which Faces are inserted.
2734 5476
27352005-06-29 Didier Verna <didier@xemacs.org> 54772005-06-29 Didier Verna <didier@xemacs.org>
2736 5478
@@ -2740,13 +5482,22 @@
27402005-06-29 Katsumi Yamaoka <yamaoka@jpl.org> 54822005-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
2741 5483
2742 * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify. 5484 * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify.
5485 (gnus-fill-real-hashtb): Use hash table instead of obarray.
2743 (gnus-nocem-check-article): Fetch the Type header. 5486 (gnus-nocem-check-article): Fetch the Type header.
2744 (gnus-nocem-message-wanted-p): Fix the way to examine types. 5487 (gnus-nocem-message-wanted-p): Fix the way to examine types.
2745 (gnus-nocem-verify-issuer): Use functionp instead of fboundp. 5488 (gnus-nocem-verify-issuer): Use functionp instead of fboundp.
2746 (gnus-nocem-enter-article): Make sure gnus-nocem-hashtb is initialized. 5489 (gnus-nocem-enter-article): Use hash tables rather than obarrays;
5490 make sure gnus-nocem-hashtb is initialized.
5491 (gnus-nocem-alist-to-hashtb): Use hash table instead of obarray.
5492 (gnus-nocem-unwanted-article-p): Ditto.
2747 5493
2748 * pgg.el (pgg-verify): Return the verification result. 5494 * pgg.el (pgg-verify): Return the verification result.
2749 5495
54962005-06-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
5497
5498 * gnus-art.el (gnus-mime-copy-part): Check whether coding-system
5499 is ascii.
5500
27502005-06-24 Juanma Barranquero <lekktu@gmail.com> 55012005-06-24 Juanma Barranquero <lekktu@gmail.com>
2751 5502
2752 * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not 5503 * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not
@@ -2770,8 +5521,18 @@
2770 * mm-extern.el (mm-extern-local-file, mm-inline-external-body): 5521 * mm-extern.el (mm-extern-local-file, mm-inline-external-body):
2771 * pop3.el (pop3-user): Don't use `format' on `error' arguments. 5522 * pop3.el (pop3-user): Don't use `format' on `error' arguments.
2772 5523
55242005-06-16 Arne J,Ax(Brgensen <arne@arnested.dk>
5525
5526 * smime.el (smime-cert-by-ldap-1): Detect PEM format without
5527 header by looking for magic "MII" at the beginnig.
5528
27732005-06-16 Miles Bader <miles@gnu.org> 55292005-06-16 Miles Bader <miles@gnu.org>
2774 5530
5531 * assistant.el (assistant-field): Remove "-face" suffix from face name.
5532 (assistant-field-face): New backward-compatibility alias for renamed
5533 face.
5534 (assistant-render-text): Use renamed assistant-field face.
5535
2775 * spam.el (spam): Remove "-face" suffix from face name. 5536 * spam.el (spam): Remove "-face" suffix from face name.
2776 (spam-face): New backward-compatibility alias for renamed face. 5537 (spam-face): New backward-compatibility alias for renamed face.
2777 (spam-face, spam-initialize): Use renamed spam face. 5538 (spam-face, spam-initialize): Use renamed spam face.
@@ -2906,6 +5667,11 @@
2906 * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while 5667 * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while
2907 executing enriched-decode. 5668 executing enriched-decode.
2908 5669
56702005-06-07 Katsumi Yamaoka <yamaoka@jpl.org>
5671
5672 * mm-util.el (mm-find-buffer-file-coding-system): Don't examine
5673 charset of tar files.
5674
29092005-06-04 Luc Teirlinck <teirllm@auburn.edu> 56752005-06-04 Luc Teirlinck <teirllm@auburn.edu>
2910 5676
2911 * gnus-art.el (article-update-date-lapsed): Use `save-match-data'. 5677 * gnus-art.el (article-update-date-lapsed): Use `save-match-data'.
@@ -2919,13 +5685,23 @@
2919 5685
2920 * gnus-art.el (gnus-emphasis-alist): Disable the strikethru thingy. 5686 * gnus-art.el (gnus-emphasis-alist): Disable the strikethru thingy.
2921 5687
56882005-06-02 Katsumi Yamaoka <yamaoka@jpl.org>
5689
5690 * pop3.el (pop3-apop): Run md5 in the binary mode.
5691
5692 * starttls.el (starttls-set-process-query-on-exit-flag):
5693 Use eval-and-compile.
5694
56952005-05-31 Simon Josefsson <jas@extundo.com>
5696
5697 * smime.el (smime-replace-in-string): Define.
5698 (smime-cert-by-ldap-1): Use it.
5699
29222005-05-31 Katsumi Yamaoka <yamaoka@jpl.org> 57002005-05-31 Katsumi Yamaoka <yamaoka@jpl.org>
2923 5701
2924 * gnus-art.el (article-display-x-face): Replace 5702 * gnus-art.el (article-display-x-face): Replace
2925 process-kill-without-query by gnus-set-process-query-on-exit-flag. 5703 process-kill-without-query by gnus-set-process-query-on-exit-flag.
2926 5704
2927 * gnus-group.el: Bind gnus-cache-active-hashtb when compiling.
2928
2929 * gnus-util.el (gnus-set-process-query-on-exit-flag): Alias to 5705 * gnus-util.el (gnus-set-process-query-on-exit-flag): Alias to
2930 set-process-query-on-exit-flag or process-kill-without-query. 5706 set-process-query-on-exit-flag or process-kill-without-query.
2931 5707
@@ -2954,21 +5730,30 @@
2954 (nntp-open-ssl-stream): Ditto. 5730 (nntp-open-ssl-stream): Ditto.
2955 (nntp-open-tls-stream): Ditto. 5731 (nntp-open-tls-stream): Ditto.
2956 5732
29572005-05-31 Simon Josefsson <jas@extundo.com> 5733 * starttls.el (starttls-set-process-query-on-exit-flag): Alias to
5734 set-process-query-on-exit-flag or process-kill-without-query.
5735 (starttls-open-stream-gnutls): Use it instead of
5736 process-kill-without-query.
5737 (starttls-open-stream): Ditto.
2958 5738
2959 * imap.el (imap-ssl-open): Use imap-process-connection-type, 57392005-05-31 Ulf Stegemann <ulf@zeitform.de> (tiny change)
2960 instead of hard coding to nil.
2961 5740
29622005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com> 5741 * smime.el (smime-cert-by-ldap-1): Don't use
5742 replace-regexp-in-string.
2963 5743
2964 * gnus-group.el: Require gnus-sum and autoload functions to 57442005-05-31 Arne J,Ax(Brgensen <arne@arnested.dk>
2965 resolve warnings when gnus-group.el compiled alone. 5745
5746 * smime-ldap.el (smime-ldap-search): Add compatibility for XEmacs.
5747
5748 * smime.el (smime-cert-by-ldap-1): Handle certificates distributed
5749 in PEM format. Adjust to the XEmacs compability.
2966 5750
29672005-05-30 Reiner Steib <Reiner.Steib@gmx.de> 57512005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
2968 5752
5753 * encrypt.el (encrypt-xor-process-buffer): Replace `string-to-int'
5754 by `string-to-number'.
2969 * gnus-agent.el (gnus-agent-regenerate-group) 5755 * gnus-agent.el (gnus-agent-regenerate-group)
2970 (gnus-agent-fetch-articles): Replace `string-to-int' by 5756 (gnus-agent-fetch-articles): Ditto.
2971 `string-to-number'.
2972 * gnus-art.el (gnus-button-fetch-group): Ditto. 5757 * gnus-art.el (gnus-button-fetch-group): Ditto.
2973 * gnus-cache.el (gnus-cache-generate-active) 5758 * gnus-cache.el (gnus-cache-generate-active)
2974 (gnus-cache-articles-in-group): Ditto. 5759 (gnus-cache-articles-in-group): Ditto.
@@ -3063,7 +5848,9 @@
3063 5848
3064 * dig.el (dig): Add :group. 5849 * dig.el (dig): Add :group.
3065 5850
3066 * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Add :group. 5851 * dns-mode.el (dns-mode): Add :group.
5852
5853 * encrypt.el (encrypt): Add :group.
3067 5854
3068 * gnus-cite.el (gnus-cite-attribution-face): Add :group. 5855 * gnus-cite.el (gnus-cite-attribution-face): Add :group.
3069 (gnus-cite-face-1, gnus-cite-face-2, gnus-cite-face-3): Ditto. 5856 (gnus-cite-face-1, gnus-cite-face-2, gnus-cite-face-3): Ditto.
@@ -3101,8 +5888,20 @@
3101 (gnus-summary-high-read-face, gnus-summary-low-read-face): Ditto. 5888 (gnus-summary-high-read-face, gnus-summary-low-read-face): Ditto.
3102 (gnus-summary-normal-read-face, gnus-splash-face): Ditto. 5889 (gnus-summary-normal-read-face, gnus-splash-face): Ditto.
3103 5890
5891 * hashcash.el (hashcash): New custom group.
5892 (hashcash-default-payment): Add :group.
5893 (hashcash-payment-alist): Ditto.
5894 (hashcash-default-accept-payment): Ditto.
5895 (hashcash-accept-resources): Ditto.
5896 (hashcash-path): Ditto.
5897 (hashcash-extra-generate-parameters): Ditto.
5898 (hashcash-double-spend-database): Ditto.
5899 (hashcash-in-news): Ditto.
5900
3104 * message.el (message-minibuffer-local-map): Add :group. 5901 * message.el (message-minibuffer-local-map): Add :group.
3105 5902
5903 * netrc.el (netrc): Add :group.
5904
3106 * sieve-manage.el (sieve-manage-log): Add :group. 5905 * sieve-manage.el (sieve-manage-log): Add :group.
3107 (sieve-manage-default-user): Diito. 5906 (sieve-manage-default-user): Diito.
3108 (sieve-manage-server-eol, sieve-manage-client-eol): Ditto. 5907 (sieve-manage-server-eol, sieve-manage-client-eol): Ditto.
@@ -3122,6 +5921,17 @@
3122 5921
3123 * spam.el (spam, spam-face): Add :group. 5922 * spam.el (spam, spam-face): Add :group.
3124 5923
59242005-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
5925
5926 * nntp.el (nntp-next-result-arrived-p): Some news servers may
5927 return \n.\n.\n at the end of articles. Protect against that.
5928 (nntp-with-open-group): Allow debugging.
5929
5930 * nnheader.el (mail-header-set-extra): Make into a function
5931 because I just could't understand how to quote the list properly.
5932
5933 * dns.el (query-dns-cached): New function.
5934
31252005-05-26 Lute Kamstra <lute@gnu.org> 59352005-05-26 Lute Kamstra <lute@gnu.org>
3126 5936
3127 * score-mode.el (gnus-score-mode): Use run-mode-hooks. 5937 * score-mode.el (gnus-score-mode): Use run-mode-hooks.
@@ -3130,7 +5940,10 @@
3130 5940
3131 * gnus-art.el: Don't autoload mail-extract-address-components. 5941 * gnus-art.el: Don't autoload mail-extract-address-components.
3132 5942
3133 * gnus.el: Use eval-and-compile to autoload message-y-or-n-p. 5943 * gnus.el: Remove duplicated autoload for message-y-or-n-p; use
5944 eval-and-compile to evaluate it.
5945
5946 * hashcash.el: Don't autoload executable-find.
3134 5947
3135 * nndb.el: Don't declare the nndb back end two or more times; don't 5948 * nndb.el: Don't declare the nndb back end two or more times; don't
3136 autoload news-reply-mode, news-setup, cancel-timer and telnet. 5949 autoload news-reply-mode, news-setup, cancel-timer and telnet.
@@ -3138,54 +5951,76 @@
3138 * nntp.el: Autoload format-spec instead of format; use 5951 * nntp.el: Autoload format-spec instead of format; use
3139 eval-and-compile to evaluate autoload forms. 5952 eval-and-compile to evaluate autoload forms.
3140 5953
3141 * spam-report.el (spam-report-process-queue): Use gnus-point-at-eol. 59542005-05-09 Georg C. F. Greve <greve@gnu.org> (tiny change)
5955
5956 * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching.
5957
59582005-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
5959
5960 * gnus.el (gnus-version-number): Bump version.
5961
59622005-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
5963
5964 * gnus.el: No Gnus v0.3 is released.
3142 5965
31432005-04-28 Katsumi Yamaoka <yamaoka@jpl.org> 59662005-04-28 Katsumi Yamaoka <yamaoka@jpl.org>
3144 5967
5968 * gnus-art.el (gnus-article-edit-part): Disable undo.
5969
59702005-04-25 Katsumi Yamaoka <yamaoka@jpl.org>
5971
5972 * gnus-art.el (article-date-ut): Don't delete X-Sent header when
5973 gnus-article-date-lapsed-new-header is t if date timer is active;
5974 skip headers in which the original date value is empty.
5975 (gnus-article-save-original-date): Redefine it as a macro.
5976 (gnus-display-mime): Use it.
5977
59782005-04-22 Katsumi Yamaoka <yamaoka@jpl.org>
5979
3145 * gnus-art.el (article-date-ut): Support converting date in 5980 * gnus-art.el (article-date-ut): Support converting date in
3146 forwarded parts as well. 5981 forwarded parts as well.
3147 (gnus-article-save-original-date): New macro. 5982 (gnus-article-save-original-date): New function.
3148 (gnus-display-mime): Use it. 5983 (gnus-display-mime): Use it.
3149 5984
31502005-04-28 David Hansen <david.hansen@physik.fu-berlin.de> 59852005-04-22 David Hansen <david.hansen@physik.fu-berlin.de>
3151 5986
3152 * nnrss.el (nnrss-check-group, nnrss-request-article): Support the 5987 * nnrss.el (nnrss-check-group, nnrss-request-article): Support the
3153 enclosure element of <item>. 5988 enclosure element of <item>.
3154 5989
31552005-04-24 Teodor Zlatanov <tzz@lifelogs.com> 59902005-04-21 Reiner Steib <Reiner.Steib@gmx.de>
3156 5991
3157 * spam-report.el (spam-report-unplug-agent) 5992 * message.el (message-kill-buffer-query): Renamed from
3158 (spam-report-plug-agent, spam-report-deagentize) 5993 `message-kill-buffer-query-if-modified'. Added :version.
3159 (spam-report-agentize, spam-report-url-ping-temp-agent-function):
3160 support for the Agent in spam-report: when unplugged, report to a
3161 file; when plugged, submit all the requests.
3162 [Added missing offline functionality from trunk.]
3163 5994
31642005-04-24 Reiner Steib <Reiner.Steib@gmx.de> 59952005-04-19 Katsumi Yamaoka <yamaoka@jpl.org>
3165 5996
3166 * spam-report.el (spam-report-url-to-file) 5997 * mml.el (mml-preview): Bind gnus-message-buffer while setting the
3167 (spam-report-requests-file): New function and variable for offline 5998 window layout.
3168 reporting. 5999
3169 (spam-report-url-ping-function): Add `spam-report-url-to-file' 60002005-04-18 Katsumi Yamaoka <yamaoka@jpl.org>
3170 and user defined function. 6001
3171 (spam-report-process-queue): New function. 6002 * mml.el: Autoload dnd when compiling.
3172 Process requests from `spam-report-requests-file'. 6003
3173 (spam-report-url-ping-mm-url): Autoload. 60042005-04-18 Reiner Steib <Reiner.Steib@gmx.de>
3174 [Added missing offline functionality from trunk.] 6005
6006 * mml.el (mml-mode, mml-dnd-attach-file): Use dnd-* instead of
6007 x-dnd-*.
3175 6008
31762005-04-18 Katsumi Yamaoka <yamaoka@jpl.org> 60092005-04-18 Katsumi Yamaoka <yamaoka@jpl.org>
3177 6010
3178 * qp.el (quoted-printable-encode-region): Save excursion. 6011 * qp.el (quoted-printable-encode-region): Save excursion.
3179 6012
60132005-04-14 Teodor Zlatanov <tzz@lifelogs.com>
6014
6015 * message.el (message-kill-buffer-query-if-modified): Add new variable
6016 so the user can kill a modified message buffer quickly.
6017 (message-kill-buffer): Use it.
6018
31802005-04-13 Katsumi Yamaoka <yamaoka@jpl.org> 60192005-04-13 Katsumi Yamaoka <yamaoka@jpl.org>
3181 6020
3182 * gnus-art.el (gnus-mime-inline-part): Use mm-string-to-multibyte. 6021 * gnus-art.el (gnus-mime-inline-part): Use mm-string-to-multibyte.
3183 * qp.el (quoted-printable-encode-region): Use mm-string-to-multibyte. 6022 * qp.el (quoted-printable-encode-region): Use mm-string-to-multibyte.
3184 6023
31852005-04-13 Miles Bader <miles@gnu.org>
3186
3187 * mm-util.el (mm-string-to-multibyte): Use Gnus trunk definition.
3188
31892005-04-12 Katsumi Yamaoka <yamaoka@jpl.org> 60242005-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
3190 6025
3191 * nnrss.el (nnrss-node-text): Replace CRLFs (which might be 6026 * nnrss.el (nnrss-node-text): Replace CRLFs (which might be
@@ -3193,19 +6028,43 @@
3193 6028
31942005-04-11 Lute Kamstra <lute@gnu.org> 60292005-04-11 Lute Kamstra <lute@gnu.org>
3195 6030
3196 * message.el (message-make-date): Handle byte-compiler warnings 6031 * nnimap.el (nnimap-date-days-ago): Handle byte-compiler warnings
3197 differently. 6032 differently.
3198 * nnimap.el (nnimap-date-days-ago): Ditto.
3199 6033
32002005-04-10 Stefan Monnier <monnier@iro.umontreal.ca> 60342005-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
3201 6035
3202 * mm-util.el (mm-string-to-multibyte): New function. 6036 * mm-util.el (mm-detect-coding-region): Typo.
3203 (mm-detect-coding-region): Typo.
3204 6037
32052005-04-11 Katsumi Yamaoka <yamaoka@jpl.org> 60382005-04-11 Katsumi Yamaoka <yamaoka@jpl.org>
3206 6039
3207 * gnus-art.el (gnus-article-read-summary-keys): Fix misplaced parens. 6040 * gnus-art.el (gnus-article-read-summary-keys): Fix misplaced parens.
3208 6041
60422005-04-06 D Goel <deego@gnufans.org>
6043
6044 * spam-stat.el (spam-stat-score-buffer): Add a call to a
6045 user-function allow user modifications of the scores.
6046 (spam-stat-score-buffer-user): New function, to allow
6047 user-computed modifications to the score.
6048 (spam-stat-score-buffer-user-functions): list of additional
6049 scoring functions
6050 (spam-stat-error-holder): global temporary error holder
6051 (spam-stat-split-fancy): use the new `spam-stat-error-holder'
6052 variable
6053
60542005-04-06 Teodor Zlatanov <tzz@lifelogs.com>
6055
6056 * gnus-registry.el (gnus-registry-clean-empty-function)
6057 (gnus-registry-trim, gnus-registry-fetch-groups)
6058 (gnus-registry-delete-group): Groups that match
6059 `gnus-registry-ignored-groups' are removed from the registry
6060 entries, not just ignored for splitting. This helps clean up the
6061 registry. Also, `gnus-registry-fetch-groups' is a convenient way
6062 to get all the groups a message ID is in.
6063
6064 * spam-stat.el (spam-stat-split-fancy-spam-threshold)
6065 (spam-stat-split-fancy): Change "threshhold" to "threshold"
6066 (spam-stat-score-buffer-user-functions): Add :number custom type.
6067
32092005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> 60682005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
3210 6069
3211 * mm-util.el (mm-coding-system-p): Don't return binary for the nil 6070 * mm-util.el (mm-coding-system-p): Don't return binary for the nil
@@ -3217,132 +6076,19 @@
3217 failed. 6076 failed.
3218 (nnrss-get-encoding): Return a compatible encoding according to 6077 (nnrss-get-encoding): Return a compatible encoding according to
3219 nnrss-compatible-encoding-alist. 6078 nnrss-compatible-encoding-alist.
3220 (nnrss-opml-export): Use dolist.
3221 (nnrss-find-el): Use consp instead of listp. 6079 (nnrss-find-el): Use consp instead of listp.
3222 (nnrss-order-hrefs): Use dolist. 6080 (nnrss-opml-export, nnrss-order-hrefs, nnrss-find-el): Use dolist.
3223
32242005-04-06 Arne J,Ax(Brgensen <arne@arnested.dk>
3225
3226 * nnrss.el (nnrss-verbose): Remove.
3227 (nnrss-request-group): Use `nnheader-message' instead.
3228
32292005-04-06 Mark Plaksin <happy@usg.edu> (tiny change)
3230
3231 * nnrss.el (nnrss-verbose): New variable.
3232 (nnrss-request-group): Make it say nnrss is requesting a group.
3233 6081
32342005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> 60822005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
3235 6083
3236 * gnus-agent.el (gnus-agent-group-path): Decode group name. 6084 * time-date.el (time-to-seconds): Don't use the #xhhhh syntax
3237 (gnus-agent-group-pathname): Ditto. 6085 which Emacs 20 doesn't support.
3238 6086 (seconds-to-time, days-to-time, time-subtract, time-add): Ditto.
3239 * gnus-cache.el (gnus-cache-file-name): Decode group name.
3240
3241 * gnus-group.el (gnus-group-line-format-alist): Use decoded group
3242 name for only %g and %c.
3243 (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group
3244 instead of gnus-tmp-group to decoded group name.
3245 (gnus-group-make-group): Decode group name.
3246 (gnus-group-delete-group): Ditto.
3247 (gnus-group-make-rss-group): Exclude `/'s from group names;
3248 register the group data after opening the nnrss group; unify
3249 non-ASCII group names; encode group name.
3250 (gnus-group-catchup-current): Decode group name.
3251 (gnus-group-expire-articles-1): Ditto.
3252 (gnus-group-set-current-level): Ditto.
3253 (gnus-group-kill-group): Ditto.
3254
3255 * gnus-spec.el (gnus-update-format-specifications): Flush the
3256 group format spec cache if it doesn't support decoded group names.
3257
3258 * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl.
3259
3260 * nnrss.el: Require rfc2047 and mml.
3261 (nnrss-file-coding-system): New variable.
3262 (nnrss-format-string): Redefine it as an inline function.
3263 (nnrss-decode-group-name): New function.
3264 (nnrss-string-as-multibyte): Remove.
3265 (nnrss-retrieve-headers): Decode group name; don't use
3266 nnrss-format-string.
3267 (nnrss-request-group): Decode group name.
3268 (nnrss-request-article): Decode group name; allow a Message-ID as
3269 well as an article number; don't use nnrss-format-string; encode a
3270 Message-ID string which may contain non-ASCII characters; use
3271 mml-to-mime to compose a MIME article; use search-forward instead
3272 of re-search-forward.
3273 (nnrss-request-expire-articles): Decode group name.
3274 (nnrss-request-delete-group): Delete entries in nnrss-group-alist
3275 as well; decode group name.
3276 (nnrss-get-encoding): Fix regexp.
3277 (nnrss-fetch): Clarify error message.
3278 (nnrss-read-server-data): Use insert-file-contents instead of load;
3279 bind file-name-coding-system; use multibyte buffer.
3280 (nnrss-save-server-data): Insert newline; bind
3281 coding-system-for-write to the value of nnrss-file-coding-system;
3282 bind file-name-coding-system; add coding cookie.
3283 (nnrss-read-group-data): Use insert-file-contents instead of load;
3284 bind file-name-coding-system; use multibyte buffer.
3285 (nnrss-save-group-data): Bind coding-system-for-write to the
3286 value of nnrss-file-coding-system; bind file-name-coding-system.
3287 (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string;
3288 make it work with non-ASCII text.
3289 (nnrss-opml-export): Use mm-set-buffer-file-coding-system instead
3290 of set-buffer-file-coding-system.
3291 (nnrss-find-el): Check carefully whether there's a list of string
3292 which old xml.el may return rather than a string; make it work
3293 with old xml.el as well.
3294
32952005-04-06 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp>
3296
3297 * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name.
3298
3299 * nnrss.el (nnrss-get-encoding): New function.
3300 (nnrss-fetch): Use unibyte buffer initially; bind
3301 coding-system-for-read while performing mm-url-insert; remove ^Ms;
3302 decode contents according to the encoding attribute.
3303 (nnrss-save-group-data): Add coding cookie.
3304 (nnrss-mime-encode-string): New function.
3305 (nnrss-check-group): Use it to encode subject and author.
3306
33072005-04-06 Maciek Pasternacki <maciekp@japhy.fnord.org> (tiny change)
3308
3309 * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also
3310 failed.
3311
33122005-04-06 Joakim Verona <joakim@verona.se> (tiny change)
3313
3314 * nnrss.el (nnrss-read-group-data): Fix off-by-one error.
3315
33162005-04-06 Jesper Harder <harder@ifa.au.dk>
3317
3318 * mm-util.el (mm-subst-char-in-string): Support inplace.
3319
3320 * nnrss.el: Pedantic docstring and whitespace fixes (courtesy of
3321 checkdoc.el).
3322 (nnrss-request-article): Cleanup.
3323 (nnrss-request-delete-group): Use nnrss-make-filename.
3324 (nnrss-read-server-data): Use nnrss-make-filename; use load.
3325 (nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1.
3326 (nnrss-read-group-data): hash on description if link is missing;
3327 use nnrss-make-filename; use load.
3328 (nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1.
3329 (nnrss-make-filename): New function.
3330 (nnrss-close): New function.
3331 (nnrss-check-group): Hash on description if link is missing.
3332 (nnrss-get-namespace-prefix): Use string= to compare strings!
3333 Reported by David D. Smith <davidsmith@acm.org>.
3334 (nnrss-opml-export): Turn on sgml-mode.
3335
33362005-04-06 Mark A. Hershberger <mah@everybody.org>
3337
3338 * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions.
3339 6087
33402005-04-04 Reiner Steib <Reiner.Steib@gmx.de> 60882005-04-04 Reiner Steib <Reiner.Steib@gmx.de>
3341 6089
3342 * message.el (message-make-date): Add defvars in order to silence 6090 * nnimap.el (nnimap-date-days-ago): Add defvars in order to
3343 the byte compiler inside the defun. 6091 silence the byte compiler inside the defun
3344
3345 * nnimap.el (nnimap-date-days-ago): Ditto.
3346 6092
3347 * gnus-demon.el (parse-time-string): Add autoload. 6093 * gnus-demon.el (parse-time-string): Add autoload.
3348 6094
@@ -3352,84 +6098,13 @@
3352 6098
3353 * nnultimate.el (parse-time): Require for `parse-time-string'. 6099 * nnultimate.el (parse-time): Require for `parse-time-string'.
3354 6100
33552005-04-03 Katsumi Yamaoka <yamaoka@jpl.org> 61012005-03-31 Reiner Steib <Reiner.Steib@gmx.de>
3356
3357 * gnus-sum.el (gnus-summary-make-menu-bar): Avoid the
3358 "Unrecognized menu descriptor" error in XEmacs.
3359
33602005-03-25 Katsumi Yamaoka <yamaoka@jpl.org>
3361
3362 * message.el (message-resend): Bind rfc2047-encode-encoded-words.
3363
3364 * mm-util.el (mm-replace-in-string): New function.
3365 (mm-xemacs-find-mime-charset-1): Ignore errors while loading
3366 latin-unity, which cannot be used with XEmacs 21.1.
3367
3368 * rfc2047.el (rfc2047-encode-function-alist): Rename from
3369 rfc2047-encoding-function-alist in order to avoid conflicting with
3370 the old version.
3371 (rfc2047-encode-message-header): Remove useless goto-char.
3372 (rfc2047-encodable-p): Don't move point.
3373 (rfc2047-syntax-table): Treat `(' and `)' as is.
3374 (rfc2047-encode-region): Concatenate words containing non-ASCII
3375 characters in structured fields; don't encode space-delimited
3376 ASCII words even in unstructured fields; don't break words at
3377 char-category boundaries; encode encoded words in structured
3378 fields; treat text within parentheses as special; show the
3379 original text when error has occurred; move point to the end of
3380 the region after encoding, suggested by IRIE Tetsuya
3381 <irie@t.email.ne.jp>; treat backslash-quoted characters as
3382 non-special; check carefully whether to encode special characters;
3383 fix some kind of misconfigured headers; signal a real error if
3384 debug-on-quit or debug-on-error is non-nil; don't infloop,
3385 suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>; assume
3386 the close parenthesis may be included in the encoded word; encode
3387 bogus delimiters.
3388 (rfc2047-encode-string): Use mm-with-multibyte-buffer.
3389 (rfc2047-encode-max-chars): New variable.
3390 (rfc2047-encode-1): New function.
3391 (rfc2047-encode): Use it; encode text so that it occupies the
3392 maximum width within 76-column; work correctly on Q encoding for
3393 iso-2022-* charsets; fold the line before encoding; don't append a
3394 space if the encoded word includes close parenthesis.
3395 (rfc2047-fold-region): Use existing whitespace for LWSP; make it
3396 sure not to break a line just after the header name.
3397 (rfc2047-b-encode-region): Remove.
3398 (rfc2047-b-encode-string): New function.
3399 (rfc2047-q-encode-region): Remove.
3400 (rfc2047-q-encode-string): New function.
3401 (rfc2047-encode-parameter): New function.
3402 (rfc2047-encoded-word-regexp): Don't use shy group.
3403 (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change.
3404 (rfc2047-parse-and-decode): Ditto.
3405 (rfc2047-decode): Treat the ascii coding-system as raw-text by default.
3406
34072005-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
3408
3409 * rfc2047.el (rfc2047-encode-encoded-words): New variable.
3410 (rfc2047-field-value): Strip props.
3411 (rfc2047-encode-message-header): Disable header folding -- not
3412 all headers can be folded, and this should be done by the message
3413 composition mode. Probably. I think.
3414 (rfc2047-encodable-p): Say that =? needs encoding.
3415 (rfc2047-encode-region): Encode =? strings.
3416
34172005-03-25 Jesper Harder <harder@ifa.au.dk>
3418 6102
3419 * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231 6103 * gnus-art.el (gnus-copy-article-ignored-headers): Update :version.
3420 language tags; remove unnecessary '+'. Reported by Stefan Wiens
3421 <s.wi@gmx.net>.
3422 (rfc2047-decode-string): Don't cons a string unnecessarily.
3423 (rfc2047-parse-and-decode, rfc2047-decode): Use a character for
3424 the encoding to avoid consing a string.
3425 (rfc2047-decode): Use mm-subst-char-in-string instead of
3426 mm-replace-chars-in-string.
3427 6104
34282005-03-25 TSUCHIYA Masatoshi <tsuchiya@namazu.org> 6105 * gnus-score.el (gnus-adaptive-pretty-print): Ditto.
3429 6106
3430 * rfc2047.el (rfc2047-encode): Use uppercase letters to specify 6107 * smime.el (smime-ldap-host-list): Add :version.
3431 encodings of MIME-encoded words, in order to improve
3432 interoperability with several broken MUAs.
3433 6108
34342005-03-21 Reiner Steib <Reiner.Steib@gmx.de> 61092005-03-21 Reiner Steib <Reiner.Steib@gmx.de>
3435 6110
@@ -3475,22 +6150,13 @@
3475 6150
34762005-03-13 Andrey Slusar <anrays@gmail.com> (tiny change) 61512005-03-13 Andrey Slusar <anrays@gmail.com> (tiny change)
3477 6152
3478 * gnus.el: Don't try and mark `gnus-agent-save-groups' as an 6153 * gnus-async.el: Require timer-funcs at compile time when in
3479 autoloaded function.
3480
34812005-03-13 Steve Youngs <steve@sxemacs.org>
3482
3483 * mm-url.el: Require timer-funcs at compile time when in XEmacs
3484 for `with-timeout'.
3485
3486 * mail-source.el: Require timer-funcs at compile time when in
3487 XEmacs for `run-with-idle-timer'. 6154 XEmacs for `run-with-idle-timer'.
3488 6155
3489 * gnus-async.el: Ditto. 61562005-03-13 Andrey Slusar <anrays@gmail.com> (tiny change)
3490
34912005-03-16 Lute Kamstra <lute@gnu.org>
3492 6157
3493 * message.el (message-make-date): Require parse-time. 6158 * gnus.el: Don't try and mark `gnus-agent-save-groups' as an
6159 autoloaded function.
3494 6160
34952005-03-10 Stefan Monnier <monnier@iro.umontreal.ca> 61612005-03-10 Stefan Monnier <monnier@iro.umontreal.ca>
3496 6162
@@ -3500,12 +6166,45 @@
3500 6166
3501 * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one flaw. 6167 * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one flaw.
3502 6168
61692005-03-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
6170
6171 * gnus-msg.el (gnus-confirm-mail-reply-to-news): Add
6172 gnus-expert-user to default.
6173
61742005-03-08 Juergen Kreileder <jk@blackdown.de> (tiny change)
6175
6176 * nnimap.el (nnimap-open-server): Ditto.
6177
6178 * imap.el (imap-authenticate): Fix typo.
6179
35032005-03-08 Bjorn Solberg <bjorn_ding@hekneby.org> (tiny change) 61802005-03-08 Bjorn Solberg <bjorn_ding@hekneby.org> (tiny change)
3504 6181
3505 * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV 6182 * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV
3506 buffer (since IMAP server might return FETCH response out of 6183 buffer (since IMAP server might return FETCH response out of
3507 order, and the nntp buffer must be sorted). 6184 order, and the nntp buffer must be sorted).
3508 6185
61862005-03-06 Kevin Greiner <kevin.greiner@compsol.cc>
6187
6188 * gnus-start.el (gnus-convert-old-newsrc): Fixed numeric
6189 comparison on string.
6190
6191 * gnus-agent.el (gnus-agent-long-article,
6192 gnus-agent-short-article, gnus-agent-score): Renamed category
6193 keywords to match gnus-cus.
6194 (gnus-agent-summary-fetch-series): Modified to protect against
6195 gnus-agent-summary-fetch-group clearing processable flags.
6196 (gnus-agent-synchronize-group-flags): Update live group buffer as
6197 synchronization may occur due to the user toggle the plugged
6198 status.
6199 (gnus-agent-fetch-group-1): Clear downloadable flag when article
6200 successfully downloaded.
6201 (gnus-agent-expire-group-1): Avoid using markers when the overview
6202 is in ascending order; greatly improves performance.
6203 (gnus-agent-regenerate-group): Use
6204 gnus-agent-synchronize-group-flags to reset read status in both
6205 gnus and server.
6206 (gnus-agent-update-files-total-fetched-for): Fixed initial size.
6207
35092005-03-04 Reiner Steib <Reiner.Steib@gmx.de> 62082005-03-04 Reiner Steib <Reiner.Steib@gmx.de>
3510 6209
3511 * message.el: Don't autoload former message-utils variables. 6210 * message.el: Don't autoload former message-utils variables.
@@ -3526,12 +6225,59 @@
3526 * nnweb.el (nnweb-type-definition): Use groups.google.de instead 6225 * nnweb.el (nnweb-type-definition): Use groups.google.de instead
3527 of broken groups(-beta).google.com. 6226 of broken groups(-beta).google.com.
3528 6227
62282005-03-03 Teodor Zlatanov <tzz@lifelogs.com>
6229
6230 * gnus-sum.el (gnus-summary-move-article): Pass move-is-internal
6231 parameter to invoked gnus-request-move-article; remove the
6232 redundant gnus-sum-hint-move-is-internal variable; apply the marks
6233 all at once instead of once per article.
6234 (gnus-summary-remove-process-mark): Accept a list of articles as
6235 well as a single article for processing.
6236
6237 * gnus-int.el (gnus-request-move-article): Add move-is-internal
6238 parameter.
6239
6240 * nnml.el (nnml-request-move-article): Add move-is-internal parameter.
6241
6242 * nnmh.el (nnmh-request-move-article): Add move-is-internal parameter.
6243
6244 * nnmbox.el (nnmbox-request-move-article): Add move-is-internal
6245 parameter.
6246
6247 * nnmaildir.el (nnmaildir-request-move-article): Add move-is-internal
6248 parameter.
6249
6250 * nnimap.el (nnimap-request-move-article): Add move-is-internal
6251 parameter and remove the gnus-sum-hint-move-is-internal variable.
6252
6253 * nnfolder.el (nnfolder-request-move-article): Add move-is-internal
6254 parameter.
6255
6256 * nndraft.el (nndraft-request-move-article): Add move-is-internal
6257 parameter.
6258
6259 * nndiary.el (nndiary-request-move-article): Add move-is-internal
6260 parameter.
6261
6262 * nndb.el (nndb-request-move-article): Add move-is-internal parameter.
6263
6264 * nnbabyl.el (nnbabyl-request-move-article): Add move-is-internal
6265 parameter.
6266
6267 * nnagent.el (nnagent-request-move-article): Add move-is-internal
6268 parameter.
6269
35292005-03-01 Stefan Monnier <monnier@iro.umontreal.ca> 62702005-03-01 Stefan Monnier <monnier@iro.umontreal.ca>
3530 6271
3531 * gnus-sum.el (gnus-summary-exit): Undo last change and fix it in 6272 * gnus-sum.el (gnus-summary-exit): Undo last change and fix it in
3532 a more conservative way. 6273 a more conservative way.
3533 6274
35342005-02-27 Arne J,Ax(Brgensen <arne@arnested.dk> 62752005-02-26 Stefan Monnier <monnier@iro.umontreal.ca>
6276
6277 * gnus-sum.el (gnus-summary-exit): Move point after displaying the
6278 buffer, so it moves the window's cursor.
6279
62802005-02-26 Arne J,Ax(Brgensen <arne@arnested.dk>
3535 6281
3536 * mm-decode.el (mm-dissect-buffer): Pass the from field on to 6282 * mm-decode.el (mm-dissect-buffer): Pass the from field on to
3537 `mm-dissect-multipart' and receive the from field as an (optional) 6283 `mm-dissect-multipart' and receive the from field as an (optional)
@@ -3540,10 +6286,16 @@
3540 pass it on when we call `mm-dissect-buffer' on MIME parts. 6286 pass it on when we call `mm-dissect-buffer' on MIME parts.
3541 Fixes verification/decryption of signed/encrypted MIME parts. 6287 Fixes verification/decryption of signed/encrypted MIME parts.
3542 6288
35432005-02-26 Stefan Monnier <monnier@iro.umontreal.ca> 62892005-02-25 Teodor Zlatanov <tzz@lifelogs.com>
3544 6290
3545 * gnus-sum.el (gnus-summary-exit): Move point after displaying the 6291 * gnus-sum.el (gnus-summary-move-article): Set
3546 buffer, so it moves the window's cursor. 6292 gnus-sum-hint-move-is-internal for gnus-request-move-article and
6293 whatever it calls (right now, only nnimap-request-move article
6294 respects it).
6295
6296 * nnimap.el (nnimap-request-move-article): When
6297 gnus-sum-hint-move-is-internal is set, don't do the extra
6298 nnimap-request-article.
3547 6299
35482005-02-24 Reiner Steib <Reiner.Steib@gmx.de> 63002005-02-24 Reiner Steib <Reiner.Steib@gmx.de>
3549 6301
@@ -3558,12 +6310,43 @@
3558 * gnus-group.el (gnus-group-clear-data): Mention process/prefix in 6310 * gnus-group.el (gnus-group-clear-data): Mention process/prefix in
3559 doc string. 6311 doc string.
3560 6312
63132005-02-22 Simon Josefsson <jas@extundo.com>
6314
6315 * encrypt.el (encrypt-password-cache-expiry): Remove (use
6316 `password-cache-expiry' instead). Reported by Arne J,Ax(Brgensen
6317 <arne@arnested.dk>.
6318 (encrypt): Add password-cache and password-cache-expiry as group
6319 members.
6320
35612005-02-22 Arne J,Ax(Brgensen <arne@arnested.dk> 63212005-02-22 Arne J,Ax(Brgensen <arne@arnested.dk>
3562 6322
3563 * smime.el (smime-sign-buffer): Signal an error if 6323 * smime.el (smime-ldap-host-list): Doc fix.
3564 `smime-sign-region' fails. 6324 (smime-ask-passphrase): Use `password-read-and-add' to read (and
6325 cache) password.
6326 (smime-sign-region): Use it.
6327 (smime-decrypt-region): Use it.
6328 (smime-sign-buffer): Signal an error if `smime-sign-region' fails.
3565 (smime-encrypt-buffer): Signal an error if `smime-encrypt-region' 6329 (smime-encrypt-buffer): Signal an error if `smime-encrypt-region'
3566 fails. 6330 fails.
6331 (smime-cert-by-ldap-1): Use `base64-encode-string' to convert
6332 certificate from DER to PEM format rather than calling openssl.
6333
6334 * mml-smime.el (mml-smime-encrypt-query): Remove obsolete comment.
6335
6336 * mml-sec.el (mml-secure-message): Insert keyfile/certfile tags
6337 for signing/encryption.
6338
6339 * mml.el (mml-parse-1): Use them.
6340
63412005-02-21 Arne J,Ax(Brgensen <arne@arnested.dk>
6342
6343 * nnrss.el (nnrss-verbose): Removed.
6344 (nnrss-request-group): Use `nnheader-message' instead.
6345
63462005-02-19 Mark Plaksin <happy@usg.edu> (tiny change)
6347
6348 * nnrss.el (nnrss-verbose): New variable.
6349 (nnrss-request-group): Make it say nnrss is requesting a group.
3567 6350
35682005-02-21 Reiner Steib <Reiner.Steib@gmx.de> 63512005-02-21 Reiner Steib <Reiner.Steib@gmx.de>
3569 6352
@@ -3579,17 +6362,17 @@
3579 6362
3580 * mml.el (mime-to-mml): Ditto. 6363 * mml.el (mime-to-mml): Ditto.
3581 6364
3582 * rfc2047.el (rfc2047-quote-decoded-words-containing-tspecials): 6365 * rfc2047.el (rfc2047-encode-parameter): Use ietf-drums-tspecials.
3583 New variable. 6366 (rfc2047-quote-decoded-words-containing-tspecials): New variable.
3584 (rfc2047-decode-region): Quote decoded words containing special 6367 (rfc2047-decode-region): Quote decoded words containing special
3585 characters when rfc2047-quote-decoded-words-containing-tspecials 6368 characters when rfc2047-quote-decoded-words-containing-tspecials
3586 is non-nil. 6369 is non-nil.
3587 6370
35882005-02-16 Teodor Zlatanov <tzz@lifelogs.com> 63712005-02-16 Teodor Zlatanov <tzz@lifelogs.com>
3589 6372
3590 * gnus-registry.el (gnus-registry-delete-group): Minor bug fix. 6373 * gnus-registry.el (gnus-registry-delete-group): Add minor bug fix.
3591 6374
3592 * gnus.el (gnus-install-group-spam-parameters): Doc fix. 6375 * gnus.el (gnus-install-group-spam-parameters): Add minor doc fix.
3593 6376
35942005-02-15 Simon Josefsson <jas@extundo.com> 63772005-02-15 Simon Josefsson <jas@extundo.com>
3595 6378
@@ -3597,6 +6380,43 @@
3597 6380
3598 * imap.el (imap-debug): Doc fix. 6381 * imap.el (imap-debug): Doc fix.
3599 6382
63832005-02-15 Katsumi Yamaoka <yamaoka@jpl.org>
6384
6385 * gnus-art.el: Avoid "Recursive load suspected" error in Emacs 21.1.
6386
63872005-02-14 Teodor Zlatanov <tzz@lifelogs.com>
6388
6389 * gnus.el (spam-contents): Improve docs for spam-contents
6390 parameter in its variable incarnation.
6391
63922005-02-14 Simon Josefsson <jas@extundo.com>
6393
6394 * smime-ldap.el: Use require instead of load-library for ldap.
6395 (smime-ldap-search): Indent.
6396 (smime-ldap-search-internal): Shorten line.
6397
6398 * smime.el (smime-cert-by-dns): Add doc-string.
6399 (smime-cert-by-ldap-1): Indent.
6400
6401 * mml-smime.el (mml-smime-get-ldap-cert): Renamed from
6402 mml-smime-get-dns-ldap.
6403 (mml-smime-encrypt-query): Use new function. Default to ldap.
6404
64052005-02-14 Arne J,Ax(Brgensen <arne@arnested.dk>
6406
6407 * smime.el: Require smime-ldap.
6408 (smime-ldap-host-list): New variable.
6409 (smime-cert-by-ldap, smime-cert-by-ldap-1): New functions.
6410
6411 * mml-smime.el (mml-smime-encrypt-query): New function.
6412 (mml-smime-encrypt-query): Use it.
6413
6414 * smime-ldap.el: New file.
6415
64162005-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
6417
6418 * gnus-agent.el: Remove garbage made while merging the Emacs trunk.
6419
36002005-02-14 Reiner Steib <Reiner.Steib@gmx.de> 64202005-02-14 Reiner Steib <Reiner.Steib@gmx.de>
3601 6421
3602 * gnus-group.el (gnus-group-make-doc-group): Mention prefix 6422 * gnus-group.el (gnus-group-make-doc-group): Mention prefix
@@ -3615,15 +6435,95 @@
3615 Change Emacs release version from 21.4 to 22.1 throughout. 6435 Change Emacs release version from 21.4 to 22.1 throughout.
3616 Change Emacs development version from 21.3.50 to 22.0.50. 6436 Change Emacs development version from 21.3.50 to 22.0.50.
3617 6437
64382005-02-12 Katsumi Yamaoka <yamaoka@jpl.org>
6439
6440 * gnus-art.el (gnus-mime-copy-part): Don't decode compressed parts.
6441
6442 * mm-util.el (mm-coding-system-to-mime-charset): Make it work with
6443 non-Mule XEmacs as well.
6444 (mm-decompress-buffer): Signal an error intentionally if it does
6445 not decompress compressed data because auto-compression-mode is
6446 disabled.
6447
64482005-02-11 Teodor Zlatanov <tzz@lifelogs.com>
6449
6450 * gnus-registry.el (gnus-registry-delete-group): Fix bug: leaves
6451 an ID in the registry even if it has no groups.
6452
64532005-02-10 Katsumi Yamaoka <yamaoka@jpl.org>
6454
6455 * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): Remove;
6456 merge it into mm-decompress-buffer.
6457 (gnus-mime-copy-part): Use the MIME part charset, the value which
6458 a user specified or gnus-newsgroup-charset for decoding, like
6459 gnus-mime-inline-part does; set buffer-file-coding-system to tell
6460 save-buffer what was used. Suggested by Kevin Ryde
6461 <user42@zip.com.au>.
6462 (gnus-mime-inline-part): Allow the name parameter as well as the
6463 filename parameter; force decompressing of compressed data; always
6464 display contents being not decoded as unibyte.
6465
6466 * mm-view.el (mm-display-inline-fontify): Allow the name parameter
6467 as well as the filename parameter.
6468
6469 * mm-util.el (mm-decompress-buffer): Merge
6470 gnus-mime-jka-compr-maybe-uncompress.
6471 (mm-find-buffer-file-coding-system): Doc fix; force decompressing
6472 of compressed data.
6473
36182005-02-08 Simon Josefsson <jas@extundo.com> 64742005-02-08 Simon Josefsson <jas@extundo.com>
3619 6475
3620 * imap.el (imap-log): Doc fix. 6476 * imap.el (imap-log): Doc fix.
3621 6477
64782005-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
6479
6480 * gnus-art.el (gnus-mime-inline-part): Decode parts according to
6481 the coding cookies; decompress compressed parts.
6482
6483 * mml.el (mml-generate-mime-1): Add the charaset parameter according
6484 to the value which a user specified manually or the coding cookie.
6485
6486 * mm-util.el (mm-string-to-multibyte): New function.
6487 (mm-detect-mime-charset-region): Work with Emacs 22 as well.
6488 (mm-coding-system-to-mime-charset): New function.
6489 (mm-decompress-buffer): New function.
6490 (mm-find-buffer-file-coding-system): New function.
6491
6492 * mm-view.el (mm-insert-inline): Make sure a part ends with a newline.
6493 (mm-display-inline-fontify): Rewrite for decoding and decompressing
6494 parts.
6495
64962005-02-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
6497
6498 * mm-view.el (mm-display-inline-fontify): Decode a part according
6499 to the charset parameter.
6500
36222005-02-03 Katsumi Yamaoka <yamaoka@jpl.org> 65012005-02-03 Katsumi Yamaoka <yamaoka@jpl.org>
3623 6502
3624 * gnus-art.el (gnus-mime-inline-part): Show the raw contents if a 6503 * gnus-art.el (gnus-mime-inline-part): Show the raw contents if a
3625 prefix arg is neither nil nor a number, as info specifies. 6504 prefix arg is neither nil nor a number, as info specifies.
3626 6505
65062005-02-02 Katsumi Yamaoka <yamaoka@jpl.org>
6507
6508 * nntp.el (nntp-marks-changed-p): Use time-less-p to compare the
6509 timestamps.
6510
65112005-02-02 Jari Aalto <jari.aalto@cante.net>
6512
6513 * gnus-sum.el (gnus-list-of-unread-articles): Improve active
6514 groups error checking and notify user.
6515
65162005-02-02 Jari Aalto <jari.aalto@poboxes.com>
6517
6518 * message.el (message-send-mail-function): Check existence of
6519 sendmail-program first before using default value
6520 `message-send-mail-with-sendmail'. Otherwise use more generic
6521 `smtpmail-send-it'.
6522
65232005-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
6524
6525 * nntp.el (nntp-request-update-info): Always return nil.
6526
36272005-01-30 Stefan Monnier <monnier@iro.umontreal.ca> 65272005-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
3628 6528
3629 * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space. 6529 * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space.
@@ -3644,11 +6544,46 @@
3644 * gnus-art.el (gnus-article-prepare): 6544 * gnus-art.el (gnus-article-prepare):
3645 Remove message-strip-forbidden-properties from the local hook. 6545 Remove message-strip-forbidden-properties from the local hook.
3646 6546
65472005-01-27 Simon Josefsson <jas@extundo.com>
6548
6549 * password.el (password-cache-add): Only start one timer per key.
6550 Reported by Derek Atkins <warlord@MIT.EDU>.
6551
65522005-01-26 Steve Youngs <steve@sxemacs.org>
6553
6554 * run-at-time.el: Removed. It is no longer needed as
6555 timer-funcs.el in the xemacs-base package has a working version of
6556 `run-at-time'.
6557
6558 * password.el: Require timer-funcs instead of run-at-time in
6559 XEmacs.
6560 Remove `password-run-at-time' macro.
6561 (password-cache-add): Use `run-at-time' instead of
6562 `password-run-at-time'.
6563
6564 * mail-source.el: Require timer-funcs instead of itimer in XEmacs
6565 for `run-with-idle-timer'.
6566
6567 * gnus-demon.el: Require timer-funcs instead of itimer in XEmacs
6568 for `run-at-time'.
6569
6570 * mm-url.el: Require timer-funcs at compile time when in XEmacs
6571 for `with-timeout'.
6572
36472005-01-24 Katsumi Yamaoka <yamaoka@jpl.org> 65732005-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
3648 6574
3649 * mml.el (mml-generate-mime-1): Convert string into unibyte when 6575 * mml.el (mml-generate-mime-1): Convert string into unibyte when
3650 inserting " *mml*" buffer's contents into a unibyte temp buffer. 6576 inserting " *mml*" buffer's contents into a unibyte temp buffer.
3651 6577
65782005-01-24 Harald Meland <harald.meland@usit.uio.no> (tiny change)
6579
6580 * mail-source.el (mail-source-fetch-imap): Search for ^From case
6581 sensitively.
6582
65832005-01-21 Derek Atkins <warlord@MIT.EDU> (tiny change)
6584
6585 * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache.
6586
36522005-01-20 Katsumi Yamaoka <yamaoka@jpl.org> 65872005-01-20 Katsumi Yamaoka <yamaoka@jpl.org>
3653 6588
3654 * mm-decode.el (mm-insert-part): Switch the multibyteness of data 6589 * mm-decode.el (mm-insert-part): Switch the multibyteness of data
@@ -3656,11 +6591,91 @@
3656 rather than the type of contents. Suggested by ARISAWA Akihiro 6591 rather than the type of contents. Suggested by ARISAWA Akihiro
3657 <ari@mbf.ocn.ne.jp>. 6592 <ari@mbf.ocn.ne.jp>.
3658 6593
6594 * nnrss.el (nnrss-find-el): Check carefully whether there's a list
6595 of string which old xml.el may return rather than a string.
6596
65972005-01-17 Katsumi Yamaoka <yamaoka@jpl.org>
6598
6599 * gnus-sum.el (gnus-summary-idna-message): Silence byte compiler.
6600
66012005-01-16 Simon Josefsson <jas@extundo.com>
6602
6603 * gnus-sum.el (gnus-summary-idna-message): Fail gracefully if
6604 idn/idna.el isn't available.
6605 (gnus-summary-idna-message): Doc fix. Suggested by Michael Cook
6606 <michael@waxrat.com>.
6607
6608 * hashcash.el: Remove non-FSF copyright header.
6609
6610 * hashcash.el (hashcash-extra-generate-parameters): New variable.
6611 (hashcash-generate-payment): Use it.
6612 (hashcash-generate-payment-async): Use it.
6613
66142005-01-15 Simon Josefsson <jas@extundo.com>
6615
6616 * message.el (message-idna-to-ascii-rhs): Decode Reply-To too.
6617 Suggested by Raymond Scholz <ray-2005@zonix.de>.
6618
6619 * gnus-sum.el (gnus-summary-wash-map): Bind "W i" to
6620 gnus-summary-idna-message.
6621 (gnus-summary-make-menu-bar): Add De-IDNA menu entry.
6622 (gnus-summary-idna-message): New function.
6623
66242005-01-13 Reiner Steib <Reiner.Steib@gmx.de>
6625
6626 * gnus-msg.el (gnus-confirm-mail-reply-to-news): Change default to
6627 gnus-novice-user.
6628
66292005-01-12 Katsumi Yamaoka <yamaoka@jpl.org>
6630
6631 * nnrss.el (nnrss-request-delete-group): Delete entries in
6632 nnrss-group-alist as well.
6633 (nnrss-save-server-data): Insert newline.
6634
66352005-01-10 Reiner Steib <Reiner.Steib@gmx.de>
6636
6637 * gnus.el (gnus-user-agent): Use list of symbols instead of
6638 symbols. Display full version number for (S)XEmacs. Optionally
6639 display (S)XEmacs codename.
6640
6641 * gnus-util.el (gnus-emacs-version): Update for new
6642 `gnus-user-agent'.
6643
6644 * gnus-msg.el (gnus-extended-version): Make it possible to omit
6645 Gnus version.
6646
36592005-01-05 Reiner Steib <Reiner.Steib@gmx.de> 66472005-01-05 Reiner Steib <Reiner.Steib@gmx.de>
3660 6648
3661 * spam.el (spam-face): New face. Don't use `gnus-splash-face' 6649 * spam.el (spam-face): New face. Don't use `gnus-splash-face'
3662 which is unreadable in some setups. 6650 which is unreadable in some setups.
3663 6651
66522005-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
6653
6654 * gnus-spec.el (gnus-update-format-specifications): Flush the
6655 group format spec cache if it doesn't support decoded group names.
6656
66572005-01-03 Reiner Steib <Reiner.Steib@gmx.de>
6658
6659 * gnus-score.el (gnus-decay-scores, gnus-score-load-file): Allow
6660 to apply decay on score files matching a regexp.
6661
66622004-12-30 Katsumi Yamaoka <yamaoka@jpl.org>
6663
6664 * gnus-group.el (gnus-group-line-format-alist): Keep the forward
6665 compatibility in %g and %c.
6666
66672004-12-29 Katsumi Yamaoka <yamaoka@jpl.org>
6668
6669 * gnus-group.el (gnus-group-line-format-alist): Use decoded group
6670 name for only %g and %c.
6671 (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group instead
6672 of gnus-tmp-group to decoded group name.
6673 (gnus-group-make-rss-group): Exclude `/'s from group names.
6674
66752004-12-28 Katsumi Yamaoka <yamaoka@jpl.org>
6676
6677 * nnrss.el (nnrss-get-encoding): Fix regexp.
6678
36642004-12-27 Simon Josefsson <jas@extundo.com> 66792004-12-27 Simon Josefsson <jas@extundo.com>
3665 6680
3666 * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when 6681 * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when
@@ -3673,17 +6688,95 @@
3673 6688
3674 * gnus-sum.el (gnus-summary-mode-map): Likewise. 6689 * gnus-sum.el (gnus-summary-mode-map): Likewise.
3675 6690
66912004-12-26 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp>
6692
6693 * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name.
6694
66952004-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
6696
6697 * nnrss.el: Require rfc2047 and mml.
6698 (nnrss-file-coding-system): New variable.
6699 (nnrss-format-string): Redefine it as an inline function.
6700 (nnrss-decode-group-name): New function.
6701 (nnrss-string-as-multibyte): Remove.
6702 (nnrss-retrieve-headers): Decode group name; don't use
6703 nnrss-format-string.
6704 (nnrss-request-group): Decode group name.
6705 (nnrss-request-article): Decode group name; allow a Message-ID as
6706 well as an article number; don't use nnrss-format-string; encode a
6707 Message-ID string which may contain non-ASCII characters; use
6708 mml-to-mime to compose a MIME article.
6709 (nnrss-request-expire-articles): Decode group name.
6710 (nnrss-request-delete-group): Decode group name.
6711 (nnrss-fetch): Clarify error message.
6712 (nnrss-read-server-data): Use insert-file-contents instead of load;
6713 bind file-name-coding-system; use multibyte buffer.
6714 (nnrss-save-server-data): Bind coding-system-for-write to the
6715 value of nnrss-file-coding-system; bind file-name-coding-system;
6716 add coding cookie.
6717 (nnrss-read-group-data): Use insert-file-contents instead of load;
6718 bind file-name-coding-system; use multibyte buffer.
6719 (nnrss-save-group-data): Bind coding-system-for-write to the
6720 value of nnrss-file-coding-system; bind file-name-coding-system.
6721 (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string;
6722 make it work with non-ASCII text.
6723 (nnrss-find-el): Make it work with old xml.el as well.
6724
67252004-12-26 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp>
6726
6727 * nnrss.el (nnrss-get-encoding): New function.
6728 (nnrss-fetch): Use unibyte buffer initially; bind
6729 coding-system-for-read while performing mm-url-insert; remove ^Ms;
6730 decode contents according to the encoding attribute.
6731 (nnrss-save-group-data): Add coding cookie.
6732 (nnrss-mime-encode-string): New function.
6733 (nnrss-check-group): Use it to encode subject and author.
6734
67352004-12-23 Teodor Zlatanov <tzz@lifelogs.com>
6736
6737 * spam.el (spam-check-BBDB): Don't get the symbol-value of an
6738 imaginary variable.
6739
36762004-12-22 Katsumi Yamaoka <yamaoka@jpl.org> 67402004-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
3677 6741
3678 * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works 6742 * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works
3679 correctly even if there are wide characters. 6743 correctly even if there are wide characters.
3680 6744
67452004-12-21 Teodor Zlatanov <tzz@lifelogs.com>
6746
6747 * spam.el (spam-check-BBDB): Fix the BBDB caching code to use
6748 downcased symbol names; make a new cache instead of reusing
6749 bbdb-hashtable.
6750
36812004-12-21 Katsumi Yamaoka <yamaoka@jpl.org> 67512004-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
3682 6752
3683 * rfc2231.el (rfc2231-parse-string): Decode encoded value after 6753 * rfc2231.el (rfc2231-parse-string): Decode encoded value after
3684 concatenating segments rather than before concatenating them. 6754 concatenating segments rather than before concatenating them.
3685 Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. 6755 Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
3686 6756
6757 * message.el (message-get-reply-headers): Bind `extra'.
6758
67592004-12-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
6760
6761 * message.el (message-extra-wide-headers): New variable.
6762 (message-get-reply-headers): Use it.
6763
67642004-12-20 Katsumi Yamaoka <yamaoka@jpl.org>
6765
6766 * gnus-agent.el (gnus-agent-group-path): Decode group name.
6767 (gnus-agent-group-pathname): Ditto.
6768
6769 * gnus-cache.el (gnus-cache-file-name): Decode group name.
6770
6771 * gnus-group.el (gnus-group-make-group): Decode group name.
6772 (gnus-group-make-rss-group): Register the group data after opening
6773 the nnrss group.
6774
67752004-12-17 Paul Jarc <prj@po.cwru.edu>
6776
6777 * nnmaildir.el (nnmaildir-request-expire-articles): Articles moved
6778 by expiry now get marked as read.
6779
36872004-12-17 Katsumi Yamaoka <yamaoka@jpl.org> 67802004-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
3688 6781
3689 * mm-util.el (mm-xemacs-find-mime-charset): New macro. 6782 * mm-util.el (mm-xemacs-find-mime-charset): New macro.
@@ -3702,6 +6795,34 @@
3702 6795
3703 * gnus-cache.el (gnus-cache-delete-group): Use it. 6796 * gnus-cache.el (gnus-cache-delete-group): Use it.
3704 6797
67982004-12-16 Katsumi Yamaoka <yamaoka@jpl.org>
6799
6800 * gnus-group.el (gnus-group-make-rss-group): Unify non-ASCII group
6801 names.
6802
68032004-12-16 Simon Josefsson <jas@extundo.com>
6804
6805 * hashcash.el (hashcash-payment-alist): Fix custom :type.
6806
68072004-12-15 Katsumi Yamaoka <yamaoka@jpl.org>
6808
6809 * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl.
6810
6811 * gnus-group.el (gnus-group-expire-articles-1): Decode group name.
6812 (gnus-group-set-current-level): Decode group name.
6813
68142004-12-15 Maciek Pasternacki <maciekp@japhy.fnord.org> (tiny change)
6815
6816 * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also
6817 failed.
6818
68192004-12-14 Katsumi Yamaoka <yamaoka@jpl.org>
6820
6821 * gnus-group.el (gnus-group-delete-group): Decode group name.
6822 (gnus-group-make-rss-group): Encode group name.
6823 (gnus-group-catchup-current): Decode group name.
6824 (gnus-group-kill-group): Decode group name.
6825
37052004-12-08 Stefan Monnier <monnier@iro.umontreal.ca> 68262004-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
3706 6827
3707 * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min. 6828 * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min.
@@ -3715,6 +6836,53 @@
3715 gnus-message-archive-method. Suggested by Lute Kamstra 6836 gnus-message-archive-method. Suggested by Lute Kamstra
3716 <lute@gnu.org>. 6837 <lute@gnu.org>.
3717 6838
68392004-12-10 Arnaud Giersch <arnaud.giersch@free.fr> (tiny change)
6840
6841 * gnus-sum.el (gnus-summary-exit-no-update): Don't clear the
6842 global counterparts of the buffer-local variables.
6843
68442004-11-16 Romain Francoise <romain@orebokech.com>
6845
6846 * gnus-sum.el (gnus-summary-exit): Don't clear the global
6847 counterparts of the buffer-local variables.
6848
68492004-11-25 Reiner Steib <Reiner.Steib@gmx.de>
6850
6851 * message.el (message-forbidden-properties): Fixed typo in doc
6852 string.
6853
68542004-11-25 Reiner Steib <Reiner.Steib@gmx.de>
6855
6856 * gnus-util.el (gnus-replace-in-string): Added doc string.
6857
6858 * nnmail.el (nnmail-split-header-length-limit): Increase to 2048
6859 to avoid problems when splitting mails with many recipients.
6860
68612004-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
6862
6863 * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful
6864 pop-to-buffer, covered by the subsequent gnus-configure-windows.
6865
68662004-12-05 Nelson Ferreira <nelson.ferreira@ieee.org>
6867
6868 * spam-stat.el (spam-stat-save): Load the hashtable from disk only
6869 if there is no hashtable in memory or file modification time is
6870 newer than cached timestamp.
6871
68722004-12-03 Reiner Steib <Reiner.Steib@gmx.de>
6873
6874 * gnus-sum.el (gnus-summary-limit-to-recipient): Implement
6875 not-matching option.
6876
68772004-12-02 Reiner Steib <Reiner.Steib@gmx.de>
6878
6879 * gnus-sum.el (gnus-summary-limit-to-recipient): New function.
6880 Suggested David Mazieres in analogy to rmail-summary-by-recipients.
6881 (gnus-summary-limit-map, gnus-summary-make-menu-bar): Add it.
6882 (gnus-article-sort-by-recipient, gnus-summary-sort-by-recipient):
6883 New functions. Suggested by Uwe Brauer <oub@mat.ucm.es>.
6884 (gnus-summary-mode-map, gnus-summary-make-menu-bar): Add it.
6885
37182004-12-02 Katsumi Yamaoka <yamaoka@jpl.org> 68862004-12-02 Katsumi Yamaoka <yamaoka@jpl.org>
3719 6887
3720 * message.el (message-forward-make-body-mml): Remove headers 6888 * message.el (message-forward-make-body-mml): Remove headers
@@ -3725,16 +6893,36 @@
3725 * message.el (message-forward-make-body-plain): Always remove 6893 * message.el (message-forward-make-body-plain): Always remove
3726 headers according to message-forward-ignored-headers. 6894 headers according to message-forward-ignored-headers.
3727 6895
68962004-12-01 Teodor Zlatanov <tzz@lifelogs.com>
6897
6898 * spam.el (spam-summary-prepare-exit): Remove the
6899 gnus-summary-limit pop for now, it has problems with ham marks for
6900 me.
6901
69022004-11-29 Teodor Zlatanov <tzz@lifelogs.com>
6903
6904 * spam.el (spam-summary-prepare-exit): Use gnus-summary-limit
6905 correctly.
6906
69072004-11-28 Carl Henrik Lunde <chlunde+bugs+@ping.uio.no> (tiny change)
6908
6909 * format-spec.el (format-spec): Message the char.
6910
69112004-11-26 Teodor Zlatanov <tzz@lifelogs.com>
6912
6913 * gnus-art.el (gnus-split-methods): Reformat comments.
6914
6915 * spam.el (spam-summary-prepare-exit): Remove article limits
6916 before exiting the summary buffer.
6917
37282004-11-26 Katsumi Yamaoka <yamaoka@jpl.org> 69182004-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
3729 6919
3730 * nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in 6920 * nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in
3731 order to silence the byte compiler. 6921 order to silence the byte compiler.
3732 6922
3733 * pop3.el (pop3-md5): Define it before being used.
3734
3735 * spam.el: Fix the way to silence the byte compiler, which 6923 * spam.el: Fix the way to silence the byte compiler, which
3736 complained about bbdb-buffer, bbdb-create-internal, 6924 complained about bbdb-buffer, bbdb-create-internal, bbdb-records,
3737 bbdb-search-simple, mail-check-payment, spam-BBDB-register-routine, 6925 bbdb-search-simple, spam-BBDB-register-routine,
3738 spam-enter-ham-BBDB, spam-stat-buffer-change-to-non-spam, 6926 spam-enter-ham-BBDB, spam-stat-buffer-change-to-non-spam,
3739 spam-stat-buffer-change-to-spam, spam-stat-buffer-is-non-spam, 6927 spam-stat-buffer-change-to-spam, spam-stat-buffer-is-non-spam,
3740 spam-stat-buffer-is-spam, spam-stat-load, 6928 spam-stat-buffer-is-spam, spam-stat-load,
@@ -3771,21 +6959,40 @@
3771 6959
3772 * spam.el (spam-blackhole-good-server-regex): Ditto. 6960 * spam.el (spam-blackhole-good-server-regex): Ditto.
3773 6961
37742004-11-25 Reiner Steib <Reiner.Steib@gmx.de> 69622004-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
3775 6963
3776 * message.el (message-forbidden-properties): Fix typo in doc string. 6964 * mml.el (mml-preview): Widen the message buffer before copying
6965 the contents to the preview buffer; sort headers before previewing.
3777 6966
37782004-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org> 6967 * message.el (message-hidden-headers): Fix the way to avoid a bug
6968 in the `repeat' widget in Emacs 21.3 or earlier.
3779 6969
3780 * message.el (message-strip-forbidden-properties): 69702004-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
3781 Bind buffer-read-only (etc) to nil.
3782 6971
37832004-11-25 Reiner Steib <Reiner.Steib@gmx.de> 6972 * message.el (message-hidden-headers): Default to "^References:".
6973 Improve customization type. Suggested by Reiner Steib
6974 <Reiner.Steib@gmx.de>.
3784 6975
3785 * gnus-util.el (gnus-replace-in-string): Add doc string. 69762004-11-25 Romain Francoise <romain@orebokech.com>
3786 6977
3787 * nnmail.el (nnmail-split-header-length-limit): Increase to 2048 6978 * message.el (message-strip-forbidden-properties): Remove check for
3788 to avoid problems when splitting mails with many recipients. 6979 obsolete `message-hidden' text property, hidden headers are not
6980 accessible in the buffer anymore.
6981
69822004-11-22 Romain Francoise <romain@orebokech.com>
6983
6984 * message.el (message-header-format-alist): Add `From' in list
6985 so that it can be sorted.
6986 (message-fix-before-sending): Widen and sort headers before
6987 sending.
6988 (message-hide-headers): Use narrowing to hide headers by moving
6989 them to the top of the buffer and narrowing to the region
6990 underneath.
6991
69922004-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
6993
6994 * message.el (message-strip-forbidden-properties): Bind
6995 buffer-read-only (etc) to nil.
3789 6996
37902004-11-23 Katsumi Yamaoka <yamaoka@jpl.org> 69972004-11-23 Katsumi Yamaoka <yamaoka@jpl.org>
3791 6998
@@ -3796,22 +7003,77 @@
3796 7003
3797 * nnfolder.el (nnfolder-request-create-group): Save current buffer. 7004 * nnfolder.el (nnfolder-request-create-group): Save current buffer.
3798 7005
37992004-11-22 Stefan Monnier <monnier@iro.umontreal.ca> 70062004-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
3800 7007
3801 * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful 7008 * dns.el (query-dns): Use sit-for to time instead of
3802 pop-to-buffer, covered by the subsequent gnus-configure-windows. 7009 accept-process-output, since that doesn't seem to work on udp
7010 sockets.
7011
70122004-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
7013
7014 * rfc2047.el (rfc2047-encode-region): Encode bogus delimiters.
7015
70162004-11-15 Jesper Harder <harder@ifa.au.dk>
7017
7018 * pop3.el (pop3-leave-mail-on-server): Don't quote nil in
7019 doc string. Improve doc string.
7020
70212004-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
7022
7023 * nntp.el (nntp-request-update-info): Return nil if
7024 nntp-marks-is-evil is true so that gnus-get-unread-articles-in-group
7025 may not call gnus-activate-group which uselessly issues the GROUP
7026 commands for all nntp groups and wastes time. Reported by Romain
7027 Francoise <romain@orebokech.com>.
7028
7029 * gnus-start.el (gnus-get-unread-articles): Remove redundant test.
3803 7030
38042004-11-14 Luc Teirlinck <teirllm@auburn.edu> 70312004-11-15 Simon Josefsson <jas@extundo.com>
3805 7032
3806 * nnfolder.el (nnfolder-save-marks): Add missing format field in 7033 * gnus-art.el (gnus-header-button-alist): Handle URLs in OpenPGP:
3807 call to `error'. 7034 headers separately.
3808 * nnml.el (nnml-save-marks): Ditto. 7035 (gnus-button-openpgp): New function, inspired by Jochen K,A|(Bpper
7036 <jochen-+It19tn3Rl9sbm7dSapR3bNAH6kLmebB@public.gmane.org>.
3809 7037
38102004-11-14 Reiner Steib <Reiner.Steib@gmx.de> 70382004-11-14 Reiner Steib <Reiner.Steib@gmx.de>
3811 7039
3812 * gnus-start.el (gnus-convert-old-newsrc): 7040 * gnus-start.el (gnus-convert-old-newsrc):
3813 Assign legacy-gnus-agent to 5.10.7. 7041 Assign legacy-gnus-agent to 5.10.7.
3814 7042
70432004-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
7044
7045 * gnus-art.el (article-unsplit-urls): Don't anchor urls to the
7046 start of the lines.
7047
70482004-11-14 Magnus Henoch <mange@freemail.hu>
7049
7050 * hashcash.el (hashcash-default-payment): Change default to 20
7051 (hashcash-default-accept-payment): Change default to 20
7052 (hashcash-process-alist): New variable
7053 (hashcash-generate-payment-async): Add
7054 (hashcash-already-paid-p): Add
7055 (hashcash-insert-payment): Don't generate payments twice
7056 (hashcash-insert-payment-async): Add
7057 (hashcash-insert-payment-async-2): Add
7058 (hashcash-cancel-async): Add
7059 (hashcash-wait-async): Add
7060 (hashcash-processes-running-p): Add
7061 (hashcash-wait-or-cancel): Add
7062 (mail-add-payment): New optional argument. Conditionally start
7063 asynchronous calculation.
7064 (mail-add-payment-async): Add
7065
7066 * message.el (message-send-mail): Wait for asynchronous hashcash
7067 results. Don't clobber existing X-Hashcash headers.
7068 (message-setup-1): Call mail-add-payment-async when
7069 message-generate-hashcash is non-nil.
7070
70712004-11-11 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
7072
7073 * message.el (message-use-alternative-email-as-from): Examine the
7074 From header as well; use message-make-from in order to include a
7075 user's full name.
7076
38152004-11-10 Katsumi Yamaoka <yamaoka@jpl.org> 70772004-11-10 Katsumi Yamaoka <yamaoka@jpl.org>
3816 7078
3817 * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by 7079 * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by
@@ -3820,12 +7082,26 @@
3820 (gnus-emphasis-custom-value-to-external): New function. 7082 (gnus-emphasis-custom-value-to-external): New function.
3821 (gnus-emphasis-custom-value-to-internal): New function. 7083 (gnus-emphasis-custom-value-to-internal): New function.
3822 7084
70852004-11-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
7086
7087 * dns.el (query-dns): Resolve reverse addresses.
7088
70892004-10-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
7090
7091 * gnus-group.el (gnus-group-get-new-news): Use it.
7092
7093 * gnus-start.el (gnus-check-reasonable-setup): New function.
7094
38232004-11-07 Katsumi Yamaoka <yamaoka@jpl.org> 70952004-11-07 Katsumi Yamaoka <yamaoka@jpl.org>
3824 7096
3825 * gnus-msg.el (gnus-configure-posting-styles): Don't cause the 7097 * gnus-msg.el (gnus-configure-posting-styles): Don't cause the
3826 "Args out of range" error. Reported by Arnaud Giersch 7098 "Args out of range" error. Reported by Arnaud Giersch
3827 <arnaud.giersch@free.fr>. 7099 <arnaud.giersch@free.fr>.
3828 7100
71012004-11-07 Stefan Wiens <s.wi@gmx.net> (tiny change)
7102
7103 * gnus-sum.el (gnus-summary-clear-local-variables): Use symbolp.
7104
38292004-11-04 Richard M. Stallman <rms@gnu.org> 71052004-11-04 Richard M. Stallman <rms@gnu.org>
3830 7106
3831 * spam.el (spam group): Add :version. 7107 * spam.el (spam group): Add :version.
@@ -3838,35 +7114,11 @@
3838 article buffer with a draft file. This is a temporary measure 7114 article buffer with a draft file. This is a temporary measure
3839 against the 2004-08-22 change to gnus-article-edit-mode. 7115 against the 2004-08-22 change to gnus-article-edit-mode.
3840 7116
38412004-11-02 Ilya N. Golubev <gin@mo.msk.ru>.
3842
3843 * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
3844 entry.
3845
38462004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> 71172004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
3847 7118
3848 * html2text.el (html2text-get-attr): Remove unused argument `tag'. 7119 * html2text.el (html2text-get-attr): Remove unused argument `tag'.
3849 (html2text-format-tags): Remove unused variable `attr'. 7120 (html2text-format-tags): Remove unused variable `attr'.
3850 7121
3851 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of
3852 after-load-alist.
3853
3854 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): New function run when
3855 Mule-UCS is loaded under XEmacs.
3856 (mm-mime-mule-charset-alist): Avoid duplicated entries.
3857
3858 * mm-util.el (mm-coding-system-p): Return a coding-system.
3859 (mm-mime-mule-charset-alist): Use shift_jis instead of
3860 iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new
3861 entries for the mime charsets iso-2022-jp-3 and shift_jis.
3862 (mm-coding-system-priorities): Use shift_jis and iso-8859-1
3863 instead of japanese-shift-jis and iso-latin-1 respectively in
3864 order to share the default value with both Emacs and XEmacs-mule.
3865 (mm-mule-charset-to-mime-charset):
3866 Make mm-coding-system-priorities effective.
3867 (mm-sort-coding-systems-predicate): Canonicalize coding-systems
3868 while predicating of candidates upon the priorities.
3869
38702004-11-01 Reiner Steib <Reiner.Steib@gmx.de> 71222004-11-01 Reiner Steib <Reiner.Steib@gmx.de>
3871 7123
3872 * gnus-msg.el (gnus-summary-resend-default-address): Add :version. 7124 * gnus-msg.el (gnus-summary-resend-default-address): Add :version.
@@ -3955,6 +7207,20 @@
3955 7207
3956 * html2text.el (html2text-format-tag-list): Add "strong" and "em". 7208 * html2text.el (html2text-format-tag-list): Add "strong" and "em".
3957 7209
72102004-10-29 Teodor Zlatanov <tzz@lifelogs.com>
7211
7212 * gnus-registry.el (gnus-registry-hashtb): Create the registry
7213 when package is loaded.
7214
7215 * spam.el (spam-summary-score-preferred-header): Add global preference
7216 for people who want to override the default SpamAssassin over
7217 Bogofilter preference (when both are set).
7218 (spam-necessary-extra-headers): Add spam-use-bogofilter as an option.
7219 (spam-user-format-function-S): Check
7220 spam-summary-score-preferred-header.
7221 (spam-extra-header-to-number): Add X-Bogosity header parsing.
7222 (spam-user-format-function-S): Format the score correctly.
7223
39582004-10-29 Katsumi Yamaoka <yamaoka@jpl.org> 72242004-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
3959 7225
3960 * gnus-msg.el (gnus-configure-posting-styles): Work with empty 7226 * gnus-msg.el (gnus-configure-posting-styles): Work with empty
@@ -3976,526 +7242,523 @@
3976 * gnus-spec.el (gnus-update-format-specifications): Return a list 7242 * gnus-spec.el (gnus-update-format-specifications): Return a list
3977 of updated types. 7243 of updated types.
3978 7244
72452004-10-27 Katsumi Yamaoka <yamaoka@jpl.org>
7246
7247 * gnus-start.el (gnus-check-reasonable-setup): Use fboundp instead
7248 of boundp to check if display-warning is available.
7249
72502004-10-26 Teodor Zlatanov <tzz@lifelogs.com>
7251
7252 * nnimap.el (nnimap-open-connection): Fix prog1/prog2 bug.
7253
39792004-10-26 Katsumi Yamaoka <yamaoka@jpl.org> 72542004-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
3980 7255
3981 * nnspool.el (nnspool-spool-directory): Use news-path if the 7256 * nnspool.el (nnspool-spool-directory): Use news-path if the
3982 news-directory variable is not bound. 7257 news-directory variable is not bound.
3983 7258
3984 * gnus-group.el (gnus-group-line-format-alist): Convert the value 7259 * gnus-start.el (gnus-check-reasonable-setup): Use an alternative
3985 of gnus-tmp-news-method into string if it may be passed to 7260 function instead of display-warning if it is not available.
3986 gnus-correct-length which takes only a string argument. 7261
72622004-10-26 Reiner Steib <Reiner.Steib@gmx.de>
7263
7264 * gnus-agent.el (gnus-agent-expire-group-1): Fix last merge from
7265 v5-10: Use `point-at-bol'.
7266
72672004-10-26 Simon Josefsson <jas@extundo.com>
7268
7269 * hashcash.el: Fix URL in comment, reported by Cheng Gao
7270 <chenggao@gmail.com>.
3987 7271
39882004-10-25 Reiner Steib <Reiner.Steib@gmx.de> 72722004-10-25 Reiner Steib <Reiner.Steib@gmx.de>
3989 7273
3990 * html2text.el (html2text-buffer-head): Remove. Use `goto-char' 7274 * html2text.el (html2text-buffer-head): Remove. Use `goto-char'
3991 instead. 7275 instead.
3992 7276
39932004-10-24 Kevin Greiner <kevin.greiner@compsol.cc> 72772004-10-25 Teodor Zlatanov <tzz@lifelogs.com>
3994 7278
3995 * gnus-start.el (gnus-convert-old-newsrc): Fix numeric 7279 * nnimap.el (nnimap-remove-server-from-buffer-alist): Add function
3996 comparison on string. 7280 to remove a server from the nnimap-server-buffer-alist.
7281 (nnimap-open-connection, nnimap-close-server): Use it.
7282
7283 * gnus-encrypt.el: Remove file in favor of encrypt.el.
3997 7284
39982004-10-21 Katsumi Yamaoka <yamaoka@jpl.org> 72852004-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
3999 7286
4000 * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when 7287 * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when
4001 running the major-mode function. 7288 running the major-mode function.
4002 7289
40032004-10-21 Kevin Greiner <kevin.greiner@compsol.cc>
4004
4005 * gnus-start.el (gnus-convert-old-newsrc): Two of the converters
4006 have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a
4007 boolean check to not apply converters that apply to future
4008 versions of gnus.
4009
40102004-10-19 Katsumi Yamaoka <yamaoka@jpl.org> 72902004-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
4011 7291
4012 * gnus-sum.el (gnus-update-summary-mark-positions): Search for 7292 * gnus-sum.el (gnus-update-summary-mark-positions): Search for
4013 dummy marks in the right way. 7293 dummy marks in the right way.
4014 7294
40152004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 72952004-10-18 David Edmondson <dme@dme.org>
4016 7296
4017 * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to 7297 * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call
4018 avoid infinite recursion via gnus-get-function. 7298 excessively.
4019 7299
40202004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 73002004-10-18 Teodor Zlatanov <tzz@lifelogs.com>
4021 7301
4022 * gnus-agent.el (gnus-agent-synchronize-group-flags): 7302 * gnus-util.el (gnus-split-references): Accept a nil references
4023 When necessary, pass full group name to gnus-request-set-marks. 7303 string and go on blissfully.
4024 (gnus-agent-synchronize-group-flags): Add support for sync'ing
4025 tick marks.
4026 (gnus-agent-synchronize-flags-server): Be silent when writing file.
4027 7304
40282004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7305 * gnus-registry.el (gnus-registry-split-fancy-with-parent): Catch
7306 cases where the references string is non-nil but has no references.
4029 7307
4030 * gnus-agent.el (gnus-agent-synchronize-group-flags): 7308 * encrypt.el: Add autoload tags.
4031 Replace gnus-request-update-info with explicit code to sync the
4032 in-memory info read flags with the marks being sync'd to the backend.
4033 7309
40342004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7310 * spam.el (spam-resolve-registrations-routine): Remove article
7311 from unregistration list too. Reported by David Hanak
7312 <dhanak@isis.vanderbilt.edu>
4035 7313
4036 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers 73142004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
4037 that are offline. Avoids having gnus-agent-toggle-plugged first ask if
4038 you want to open a server and then, even when you responded with no,
4039 asking if you want to synchronize the server's flags.
4040 (gnus-agent-synchronize-flags-server): Rewrite read loop to handle
4041 multi-line expressions.
4042 (gnus-agent-synchronize-group-flags): New internal function.
4043 Updates marks in memory (in the info structure) AND in the backend.
4044 (gnus-agent-check-overview-buffer): Fix range of
4045 deletion to remove entire duplicate line. Fixes merged article
4046 number bug.
4047 7315
4048 * gnus-util.el (gnus-remassoc): Fix typo in documentation. 7316 * gnus-art.el (gnus-copy-article-ignored-headers): Default to
7317 nil. Changed custom type.
4049 7318
4050 * nnagent.el (nnagent-request-set-mark): 73192004-10-17 Reiner Steib <Reiner.Steib@gmx.de>
4051 Use gnus-agent-synchronize-group-flags, not backend's request-set-mark
4052 method, to ensure that synchronization updates marks in the
4053 backend and in the info (in memory) structure.
4054 7320
40552004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7321 * gnus-art.el (gnus-copy-article-ignored-headers): New variable.
4056 7322
4057 * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing 7323 * gnus-sum.el (gnus-summary-move-article): Use it.
4058 unless plugged. Disable the agent so that an open failure causes
4059 an error.
4060 7324
40612004-10-18 Reiner Steib <Reiner.Steib@gmx.de> 73252004-10-15 Teodor Zlatanov <tzz@lifelogs.com>
4062 7326
4063 * gnus-agent.el (gnus-agent-fetched-hook): Add :version. 7327 * encrypt.el: Add autoload cookies.
4064 (gnus-agent-go-online): Change :version.
4065 (gnus-agent-expire-unagentized-dirs)
4066 (gnus-agent-auto-agentize-methods): Add :version.
4067 7328
40682004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7329 * spam.el (spam-backend-article-list-property)
7330 (spam-backend-get-article-todo-list)
7331 (spam-backend-put-article-todo-list, )
7332 (spam-summary-prepare-exit, spam-resolve-registrations-routine):
7333 Resolve registrations separately.
7334 (spam-register-routine): Format comments.
7335 (spam-unregister-routine, spam-register-routine): Always call with
7336 specific-articles, no default list.
7337 (spam-summary-prepare-exit): Use the spam-classifications function.
4069 7338
4070 * legacy-gnus-agent.el 7339 * netrc.el (autoload, netrc-parse): Use encrypt.el instead of
4071 (gnus-agent-convert-to-compressed-agentview-prompt): 7340 gnus-encrypt.el.
4072 New function. Used internally to only display 'gnus converting
4073 files' message when actually necessary.
4074 7341
4075 * gnus-sum.el: Remove (require 'gnus-agent) as required 7342 * encrypt.el: copied from gnus-encrypt.el
4076 methods now autoloaded.
4077 7343
4078 * gnus-int.el (gnus-request-move-article): 7344 * gnus-encrypt.el: commented that it's obsolete
4079 Use gnus-agent-unfetch-articles in place of gnus-agent-expire to
4080 improve performance.
4081 7345
40822004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 73462004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
4083 7347
4084 * gnus-agent.el (gnus-agent-cat-groups): Rewrite avoiding defsetf 7348 * gnus-score.el (gnus-adaptive-pretty-print): New variable.
4085 to avoid run-time CL dependencies. 7349 (gnus-score-save): Use it.
4086 (gnus-agent-unfetch-articles): New function.
4087 (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate
4088 article numbers even when local .overview file is missing.
4089 (gnus-agent-read-article-number): New function. Only accepts
4090 27-bit article numbers.
4091 (gnus-agent-copy-nov-line, gnus-agent-uncached-articles):
4092 Use gnus-agent-read-article-number.
4093 (gnus-agent-braid-nov): Rewrote to validate article numbers coming
4094 from backend while recognizing that article numbers in .overview
4095 must be valid.
4096 7350
4097 * gnus-start.el (gnus-convert-old-newsrc): Change message text as 7351 * message.el (message-bury): Use `window-dedicated-p'.
4098 some users confused by references to .newsrc when they only have a
4099 .newsrc.eld file.
4100 (gnus-convert-mark-converter-prompt)
4101 (gnus-convert-converter-needs-prompt): Fix use of property list.
4102 7352
41032004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> 73532004-10-15 Simon Josefsson <jas@extundo.com>
4104 7354
4105 * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. 7355 * pop3.el (top-level): Don't require nnheader.
7356 (pop3-read-timeout): Add.
7357 (pop3-accept-process-output): Add.
7358 (pop3-read-response, pop3-retr): Use it.
4106 7359
41072004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> 73602004-10-14 Teodor Zlatanov <tzz@lifelogs.com>
4108 7361
4109 * gnus-start.el (gnus-get-unread-articles-in-group): Don't do 7362 * spam.el (spam-register-routine): Move comment.
4110 stuff for non-living groups. 7363 (spam-verify-bogofilter): Use 'unknown for the initial
7364 spam-bogofilter-valid state, not 'never.
4111 7365
41122004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> 7366 * netrc.el (netrc-machine-user-or-password): Add convenience wrapper
7367 for netrc-machine.
4113 7368
4114 * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. 7369 * nnimap.el (nnimap-open-connection): Use
4115 (gnus-agent-regenerate-group): Using nil messages aren't valid. 7370 netrc-machine-user-or-password.
4116 7371
41172004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> 73722004-10-17 Richard M. Stallman <rms@gnu.org>
4118 7373
4119 * gnus-agent.el (gnus-agent-read-agentview): 7374 * gnus-registry.el (gnus-registry-unload-hook):
4120 Inline gnus-uncompress-range. 7375 Set as a variable with add-hook.
4121 7376
41222004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> 7377 * nnspool.el (nnspool-spool-directory): Use news-directory instead
7378 of news-path.
4123 7379
4124 * legacy-gnus-agent.el 7380 * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook.
4125 (gnus-agent-convert-to-compressed-agentview): Fix typos with
4126 help from Florian Weimer <fw@deneb.enyo.de>
4127 7381
4128 * gnus-agent.el (gnus-agentize): 7382 * spam.el: Delete duplicate `provide'.
4129 gnus-agent-send-mail-real-function no longer set to current value 7383 (spam-unload-hook): Set as a variable with add-hook.
4130 of message-send-mail-function but rather a lambda that calls
4131 message-send-mail-function. The change makes the agent real-time
4132 responsive to user changes to message-send-mail-function.
4133 7384
41342004-10-18 Reiner Steib <Reiner.Steib@gmx.de> 73852004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
4135 7386
4136 * gnus-start.el (gnus-get-unread-articles): Fix last commit. 7387 * pop3.el (pop3-leave-mail-on-server): Describe possible problems
7388 in the doc string.
4137 7389
41382004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> 7390 * message.el (message-ignored-news-headers)
7391 (message-ignored-supersedes-headers)
7392 (message-ignored-resent-headers)
7393 (message-forward-ignored-headers): Improve custom type.
4139 7394
4140 * gnus-cache.el (gnus-cache-rename-group): New function. 73952004-10-13 Katsumi Yamaoka <yamaoka@jpl.org>
4141 (gnus-cache-delete-group): New function.
4142 7396
4143 * gnus-agent.el (gnus-agent-rename-group): New function. 7397 * message.el (message-tokenize-header): Fix 2004-09-06 change
4144 (gnus-agent-delete-group): New function. 7398 which used point-min in the wrong place.
4145 (gnus-agent-save-group-info): Use gnus-command-method when
4146 `method' parameter is nil. Don't write nil entries into the
4147 active file.
4148 (gnus-agent-get-group-info): New function.
4149 (gnus-agent-get-local): Add optional parameters to avoid calling
4150 gnus-group-real-name and gnus-find-method-for-group.
4151 (gnus-agent-set-local): Delete stored entry if either min, or max,
4152 are nil.
4153 (gnus-agent-fetch-session): Reword error/quit messages.
4154 On quit, use gnus-agent-regenerate-group to record existance of any
4155 articles fetched to disk before the quit occurred.
4156 7399
4157 * gnus-int.el (gnus-request-delete-group): 74002004-10-12 Simon Josefsson <jas@extundo.com>
4158 Use gnus-cache-delete-group and gnus-agent-delete-group to keep the
4159 local disk in sync with the server.
4160 (gnus-request-rename-group):
4161 Use gnus-cache-rename-group and gnus-agent-rename-group to keep the
4162 local disk in sync with the server.
4163 7401
4164 * gnus-start.el (gnus-get-unread-articles): 7402 * tls.el (tls-certtool-program): New variable.
4165 Cosmetic simplification to logic. 7403 (tls-certificate-information): New function, based on
7404 ssl-certificate-information.
4166 7405
4167 * gnus-group.el (gnus-group-delete-group): No longer update 74062004-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
4168 gnus-cache-active-altered as gnus-request-delete-group now keeps
4169 the cache in sync.
4170 (gnus-group-list-active): Let the agent store a server's active
4171 list if currently plugged.
4172 7407
4173 * gnus-util.el (gnus-rename-file): New function. 7408 * compface.el: Move the version of ELisp-based uncompface program
7409 to the contrib directory because of the copyright problem.
4174 7410
41752004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> 74112004-10-12 Reiner Steib <Reiner.Steib@gmx.de>
4176 7412
4177 * gnus-agent.el (gnus-agent-regenerate-group): Activate the group 7413 * message.el (message-kill-buffer): Raise the current frame.
4178 when the group's active is not available.
4179 7414
41802004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> 74152004-10-10 Reiner Steib <Reiner.Steib@gmx.de>
4181 7416
4182 * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to 7417 * gnus-sum.el: Mention that multibyte characters don't work as marks.
4183 error.
4184 7418
41852004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7419 * gnus.el (message-y-or-n-p): Autoload.
4186 7420
4187 * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion 7421 * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port)
4188 message to newsrc-dribble when an actual conversion is performed. 7422 (pop3-password-required, pop3-authentication-scheme)
7423 (pop3-leave-mail-on-server): Made customizable.
7424 (pop3): New custom group.
7425 (pop3-retr): Remove `sleep-for' statements.
7426 Suggested by Dave Love <fx@gnu.org>.
4189 7427
41902004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7428 * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for
7429 Windows/DOS.
4191 7430
4192 * gnus-agent.el (gnus-agent-read-local): 7431 * imap.el (imap-parse-flag-list, imap-parse-body-extension)
4193 Bind nnheader-file-coding-system to gnus-agent-file-coding-system to 7432 (imap-parse-body): Fix incorrect use of `assert'. Suggested by
4194 avoid the implicit assumption that they will always be equal. 7433 Dave Love <fx@gnu.org>.
4195 (gnus-agent-save-local): Bind buffer-file-coding-system, not
4196 coding-system-for-write, as the with-temp-file macro first prints
4197 to a buffer then saves the buffer.
4198 7434
41992004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> 7435 * mml.el (mml-minibuffer-read-disposition): Require match.
7436 Suggested by Dave Love <fx@gnu.org>.
4200 7437
4201 * legacy-gnus-agent.el (): New. Provides converters that are only 74382004-10-11 Reiner Steib <Reiner.Steib@gmx.de>
4202 loaded when gnus-convert-old-newsrc needs to call them.
4203 7439
4204 * gnus-agent.el (gnus-agent-read-agentview): Remove support for 7440 * gnus-group.el (gnus-group-delete-group): Change "\t." to " " in
4205 old file versions. 7441 doc string.
4206 (gnus-group-prepare-hook): Remove function that converted list
4207 form of gnus-agent-expire-days to group properties.
4208 7442
4209 * gnus-start.el (gnus-convert-old-newsrc): Register new 74432004-10-08 Katsumi Yamaoka <yamaoka@jpl.org>
4210 converters to handle old agent file formats. Added logic for a
4211 "backup before upgrading warning".
4212 (gnus-convert-mark-converter-prompt): Developers can mark
4213 functions as needing (default), or not needing,
4214 gnus-convert-old-newsrc's "backup before upgrading warning".
4215 (gnus-convert-converter-needs-prompt): Tests whether the user
4216 should be protected from potentially irreversable changes by the
4217 function.
4218 7444
42192004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> 7445 * mm-uu.el (mm-uu-dissect-text-parts): Support all text/* types.
4220 7446
4221 * gnus-int.el (gnus-request-accept-article): Inform the agent that 74472004-10-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
4222 articles are being added to a group.
4223 (gnus-request-replace-article): Inform the agent that articles
4224 need to be uncached as the cached contents are no longer valid.
4225 7448
4226 * gnus-agent.el (gnus-agent-file-header-cache): Remove. 7449 * gnus-art.el (gnus-mime-display-single): Call `mm-display-inline'
4227 (gnus-agent-possibly-alter-active): Avoid null in numeric comparison. 7450 instead of calling `mm-insert-inline', to decode text/* parts
4228 (gnus-agent-set-local): Refuse to save null in local object table. 7451 before displaying them.
4229 (gnus-agent-regenerate-group): The REREAD parameter can now be a
4230 list of articles that will be marked as unread.
4231 7452
42322004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 74532004-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
4233 7454
4234 * gnus-range.el (gnus-sorted-range-intersection): Now accepts 7455 * mm-uu.el (mm-uu-text-plain-type): New variable.
4235 single-interval range of the form (min . max). Previously the 7456 (mm-uu-pgp-signed-extract-1): Use it.
4236 range had to look like ((min . max)). Likewise, return 7457 (mm-uu-pgp-encrypted-extract-1): Use it.
4237 (min . max) rather than ((min . max)). 7458 (mm-uu-dissect): Allow MIME type and parameters as an optional arg;
4238 (gnus-range-map): Use gnus-range-normalize to accept 7459 bind mm-uu-text-plain-type with that value.
4239 single-interval range. 7460 (mm-uu-dissect-text-parts): Pass MIME type and parameters to
7461 mm-uu-dissect.
4240 7462
4241 * gnus-sum.el (gnus-summary-highlight-line): Articles stored in 74632004-10-06 Katsumi Yamaoka <yamaoka@jpl.org>
4242 the cache, but not the agent, now appear with their usual face.
4243 7464
42442004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7465 * gnus-group.el (gnus-update-group-mark-positions):
7466 * gnus-sum.el (gnus-update-summary-mark-positions):
7467 * message.el (message-check-news-body-syntax):
7468 * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead
7469 of string-as-multibyte.
4245 7470
4246 * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of 74712004-10-05 Juri Linkov <juri@jurta.org>
4247 marks consisting of a single range {for example, (3 . 5)} rather
4248 than a list of a single range { ((3 . 5)) }.
4249 7472
42502004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7473 * gnus-group.el (gnus-update-group-mark-positions):
7474 * gnus-sum.el (gnus-update-summary-mark-positions):
7475 * message.el (message-check-news-body-syntax):
7476 * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert
7477 8-bit unibyte values to a multibyte string for search functions.
4251 7478
4252 * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the 74792004-10-06 Katsumi Yamaoka <yamaoka@jpl.org>
4253 uncompressed list.
4254 7480
42552004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> 7481 * mm-uu.el (mm-uu-dissect): Allow optional arg.
7482 (mm-uu-dissect-text-parts): New function.
4256 7483
4257 * gnus-draft.el (gnus-group-send-queue): Pass the group name 7484 * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to
4258 "nndraft:queue" along to gnus-draft-send. 7485 dissect text parts.
4259 Use gnus-agent-prompt-send-queue.
4260 (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group
4261 is "nndraft:queue". Suggested by Gaute Strokkenes
4262 <gs234@srcf.ucam.org>
4263 7486
4264 * gnus-group.el (gnus-group-catchup): Use new 7487 * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq.
4265 gnus-sequence-of-unread-articles, not 7488 (gnus-summary-force-verify-and-decrypt): Revert 2004-08-18 change.
4266 gnus-list-of-unread-articles, to avoid exhausting memory with huge
4267 numbers of articles. Use gnus-range-map to avoid having to
4268 uncompress the unread list.
4269 (gnus-group-archive-directory)
4270 (gnus-group-recent-archive-directory): Fix invalid ange-ftp reference.
4271 7489
4272 * gnus-range.el (gnus-range-map): Iterate over list or sequence. 7490 * mm-decode.el (mm-dissect-singlepart): Revert 2004-08-18 change.
4273 (gnus-sorted-range-intersection): Intersection of two ranges
4274 without requiring that they first be uncompressed.
4275 7491
4276 * gnus-start.el (gnus-activate-group): Unless blocked by the 7492 * gnus-topic.el (gnus-topic-hierarchical-parameters): Use
4277 caller, possibly expand the active range to include both cached 7493 gnus-current-topics instead of gnus-current-topic.
4278 and agentized articles.
4279 (gnus-convert-old-newsrc): Rewrote in anticipation of having
4280 multiple version-dependent converters.
4281 (gnus-groups-to-gnus-format): Replace gnus-agent-save-groups with
4282 gnus-agent-save-active.
4283 (gnus-save-newsrc-file): Save dirty agent range limits.
4284 7494
4285 * gnus-sum.el (gnus-select-newgroup): Replace inline code with 74952004-10-06 Jesper Harder <harder@ifa.au.dk>
4286 gnus-agent-possibly-alter-active.
4287 (gnus-adjust-marked-articles): Faster handling of simple lists.
4288 7496
42892004-10-18 David Edmondson <dme@dme.org> 7497 * gnus-sum.el (gnus-summary-show-article): Use with-current-buffer.
4290 7498
4291 * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call 74992004-10-05 Jesper Harder <harder@ifa.au.dk>
4292 excessively.
4293 7500
42942004-10-18 Reiner Steib <Reiner.Steib@gmx.de> 7501 * nnsoup.el (nnsoup-read-active-file): Use dolist, mapc or last
7502 where approriate.
4295 7503
4296 * mml.el (mml-preview): Use `pop-to-buffer'. 7504 * nnml.el (nnml-generate-active-info): do.
4297 7505
4298 * message.el (message-goto-mail-followup-to): Insert after "To". 7506 * nndiary.el (nndiary-generate-active-info): do.
4299 (message-carefully-insert-headers): Add comment.
4300 7507
4301 * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. 7508 * gnus-topic.el (gnus-topic-hierarchical-parameters): do.
7509 (gnus-topic-move): do.
4302 7510
4303 * gnus-art.el (gnus-button-alist): 7511 * gnus-sum.el (gnus-data-enter-list, gnus-summary-process-mark-set)
4304 Improve `gnus-button-handle-library' entry. 7512 (gnus-summary-set-local-parameters, gnus-summary-read-document): do.
4305 7513
4306 * gnus-art.el (gnus-button-alist): Fix regexp for manual links. 7514 * gnus-srvr.el (gnus-server-prepare)
7515 (gnus-server-open-all-servers): do.
4307 7516
4308 * gnus-group.el (gnus-group-get-new-news-this-group): Add doc-string. 7517 * gnus-msg.el (gnus-summary-cancel-article)
7518 (gnus-summary-resend-message)
7519 (gnus-summary-mail-crosspost-complaint): do.
4309 7520
4310 * gnus-start.el (gnus-activate-group): Add doc-string. 7521 * gnus-move.el (gnus-change-server): do.
4311 7522
4312 * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to 7523 * gnus-group.el (gnus-group-unmark-all-groups)
4313 handle manual section. 7524 (gnus-group-set-current-level): do.
4314 7525
4315 * imap.el (imap-store-password): New variable. 75262004-10-04 Simon Josefsson <jas@extundo.com>
4316 (imap-interactive-login): Use it.
4317 Suggested by Mark Plaksin <happy@mcplaksin.org>.
4318 7527
4319 * gnus-art.el (gnus-button-alist, gnus-header-button-alist): 7528 * message.el (message-generate-hashcash): Doc fix.
4320 Allow / in mailto URLs.
4321 7529
4322 * spam.el (spam-directory): Derive from `gnus-directory'. 75302004-10-02 Kevin Greiner <kgreiner@compsol.cc>
4323 7531
4324 * gnus-sum.el (gnus-pick-line-number): Add autoload. 7532 * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to
7533 avoid infinite recursion via gnus-get-function.
4325 7534
43262004-10-17 Richard M. Stallman <rms@gnu.org> 75352004-10-02 Jesper Harder <harder@ifa.au.dk>
4327 7536
4328 * gnus-registry.el (gnus-registry-unload-hook): 7537 * mm-partial.el (mm-partial-find-parts): Use with-current-buffer.
4329 Set as a variable with add-hook.
4330 7538
4331 * nnspool.el (nnspool-spool-directory): Use news-directory instead 7539 * nnfolder.el (nnfolder-generate-active-file): Use dolist.
4332 of news-path.
4333 7540
4334 * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook. 7541 * nnmail.el (nnmail-split-history): do.
4335 7542
4336 * spam.el: Delete duplicate `provide'. 7543 * nnml.el (nnml-generate-nov-databases-1, nnml-request-rename-group)
4337 (spam-unload-hook): Set as a variable with add-hook. 7544 (nnml-request-delete-group): do.
4338 7545
43392004-10-15 Reiner Steib <Reiner.Steib@gmx.de> 7546 * nnslashdot.el (nnslashdot-read-groups): do.
4340 7547
4341 * pop3.el (pop3-leave-mail-on-server): Describe possible problems 7548 * nnsoup.el (nnsoup-delete-unreferenced-message-files): do.
4342 in the doc string. 7549 (nnsoup-unpack-packets, nnsoup-make-active): Simplify.
4343 7550
4344 * message.el (message-ignored-news-headers) 7551 * nnspool.el (nnspool-find-id): Use with-temp-buffer.
4345 (message-ignored-supersedes-headers) 7552 (nnspool-sift-nov-with-sed): Use last
4346 (message-ignored-resent-headers) 7553 (nnspool-retrieve-headers-with-nov): Use mapc.
4347 (message-forward-ignored-headers): Improve custom type. 7554 (nnspool-request-newgroups): Use dolist.
7555 (nnspool-request-group): Use last.
4348 7556
43492004-10-15 Simon Josefsson <jas@extundo.com> 7557 * nntp.el (nntp-read-server-type): Use dolist.
4350 7558
4351 * pop3.el (top-level): Don't require nnheader. 7559 * nnvirtual.el (nnvirtual-create-mapping)
4352 (pop3-read-timeout): Add. 7560 (nnvirtual-update-read-and-marked): Use dolist.
4353 (pop3-accept-process-output): Add. 7561 (nnvirtual-convert-headers): Simplify.
4354 (pop3-read-response, pop3-retr): Use it.
4355 7562
43562004-10-13 Katsumi Yamaoka <yamaoka@jpl.org> 75632004-10-01 Kevin Greiner <kgreiner@compsol.cc>
4357 7564
4358 * message.el (message-tokenize-header): Fix 2004-09-06 change 7565 * gnus-agent.el (gnus-agent-synchronize-group-flags): Added
4359 which used point-min in the wrong place. 7566 support for sync'ing tick marks.
4360 7567
43612004-10-11 Reiner Steib <Reiner.Steib@gmx.de> 75682004-10-01 Katsumi Yamaoka <yamaoka@jpl.org>
4362 7569
4363 * message.el (message-bury): Use `window-dedicated-p'. 7570 * gnus-sum.el (gnus-summary-toggle-header): Make it work even if
7571 there's no visible header.
4364 7572
43652004-10-10 Reiner Steib <Reiner.Steib@gmx.de> 75732004-10-01 Kevin Greiner <kgreiner@compsol.cc>
4366 7574
4367 * gnus-sum.el: Mention that multibyte characters don't work as marks. 7575 * gnus-agent.el (gnus-agent-synchronize-group-flags): When
7576 necessary, pass full group name to gnus-request-set-marks.
4368 7577
4369 * gnus.el (message-y-or-n-p): Autoload. 75782004-10-01 Simon Josefsson <jas@extundo.com>
4370 7579
4371 * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port) 7580 * mailcap.el (mailcap-mime-data): Add pdf. Remove non-free
4372 (pop3-password-required, pop3-authentication-scheme) 7581 acroread.
4373 (pop3-leave-mail-on-server): Made customizable.
4374 (pop3): New custom group.
4375 (pop3-retr): Remove `sleep-for' statements.
4376 Suggested by Dave Love <fx@gnu.org>.
4377 7582
4378 * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for 75832004-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
4379 Windows/DOS.
4380 7584
4381 * imap.el (imap-parse-flag-list, imap-parse-body-extension) 7585 * spam-report.el (spam-report-gmane): Fix interactive.
4382 (imap-parse-body): Fix incorrect use of `assert'. Suggested by
4383 Dave Love <fx@gnu.org>.
4384 7586
4385 * mml.el (mml-minibuffer-read-disposition): Require match. 7587 * gnus-art.el (gnus-treat-body-boundary): Only do stuff under X.
4386 Suggested by Dave Love <fx@gnu.org>.
4387 7588
43882004-10-06 Katsumi Yamaoka <yamaoka@jpl.org> 7589 * gnus-agent.el (gnus-agent-synchronize-flags-server): Be silent
7590 when writing file.
7591 (gnus-agent-synchronize-flags): Don't default to being
7592 interactive.
4389 7593
4390 * gnus-group.el (gnus-update-group-mark-positions): 75942004-09-30 Simon Josefsson <jas@extundo.com>
4391 * gnus-sum.el (gnus-update-summary-mark-positions):
4392 * message.el (message-check-news-body-syntax):
4393 * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead
4394 of string-as-multibyte.
4395 7595
4396 * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq. 7596 * message.el (message-generate-hashcash): Add.
7597 (message-send-mail): Use it, call mail-add-payment.
4397 7598
43982004-10-05 Juri Linkov <juri@jurta.org> 75992004-09-29 Teodor Zlatanov <tzz@lifelogs.com>
4399 7600
4400 * gnus-group.el (gnus-update-group-mark-positions): 7601 * spam.el (spam-verify-bogofilter): Use -V, not -sV option.
4401 * gnus-sum.el (gnus-update-summary-mark-positions):
4402 * message.el (message-check-news-body-syntax):
4403 * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert
4404 8-bit unibyte values to a multibyte string for search functions.
4405 7602
44062004-10-01 Katsumi Yamaoka <yamaoka@jpl.org> 76032004-09-28 Kevin Greiner <kgreiner@compsol.cc>
4407 7604
4408 * gnus-sum.el (gnus-summary-toggle-header): Make it work even if 7605 * gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced
4409 there's no visible header. 7606 gnus-requst-update-info with explicit code to sync the in-memory
7607 info read flags with the marks being sync'd to the backend.
4410 7608
44112004-10-01 Simon Josefsson <jas@extundo.com> 7609 *gnus-util.el (gnus-pp): Added optional stream to match pp API.
4412 7610
4413 * mailcap.el (mailcap-mime-data): Add pdf. Remove non-free 76112004-09-28 Teodor Zlatanov <tzz@lifelogs.com>
4414 acroread.
4415 7612
44162004-09-29 Jesper Harder <harder@ifa.au.dk> 7613 * spam.el (spam-verify-bogofilter): Add new function.
7614 (spam-check-bogofilter)
7615 (spam-bogofilter-register-with-bogofilter): Use it.
7616 (spam-verify-bogofilter): Add small fixes.
4417 7617
4418 * gnus.el (gnus-method-to-server): Oops, move it don't delete it. 76182004-09-28 Simon Josefsson <jas@extundo.com>
4419 7619
44202004-09-28 Jesper Harder <harder@ifa.au.dk> 7620 * hashcash.el (hashcash-generate-payment): Revert.
4421 7621
4422 * gnus-picon.el: Require cl. 76222004-09-28 Teodor Zlatanov <tzz@lifelogs.com>
4423 7623
4424 * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus. 7624 * gnus-registry.el (gnus-registry-split-fancy-with-parent): Use
7625 gnus-extract-references instead of gnus-split-references.
4425 7626
4426 * mml-smime.el: Require cl. Autoload message-fetch-field. 7627 * gnus-util.el (gnus-extract-references): Add new function, analogous
7628 to gnus-split-references but extracts only the message-ID without
7629 anything extra.
4427 7630
4428 * gnus-fun.el: Require gnus-ems and gnus-util. 7631 * hashcash.el (hashcash-generate-payment)
7632 (hashcash-check-payment): Do the right thing if hashcash-path is
7633 nil (because the hashcash program could not be found).
4429 7634
4430 * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr). 7635 * spam.el (spam-use-hashcash): Remove comment.
4431 7636
4432 * gnus-art.el (gnus-article-edit-mode): Define before first reference. 76372004-09-27 Jesper Harder <harder@ifa.au.dk>
4433 7638
4434 * gnus.el (gnus-method-to-server): Move defsubst before first use. 7639 * gnus-cache.el (gnus-cache-possibly-remove-articles-1)
7640 (gnus-cache-enter-article, gnus-cache-remove-article)
7641 (gnus-cache-braid-heads, gnus-cache-generate-active): Use dolist.
7642
7643 * gnus-async.el (gnus-async-prefetch-remove-group): do.
4435 7644
4436 * spam.el (spam-check-spamoracle, spam-spamoracle-learn): 7645 * gnus-art.el (article-hide-boring-headers)
4437 Fix format string mismatch. 7646 (article-translate-strings, article-display-face)
4438 * nnml.el (nnml-request-set-mark, nnml-save-marks): Do. 7647 (gnus-article-mime-match-handle-first)
4439 * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): Do. 7648 (gnus-article-highlight-headers)
7649 (gnus-article-add-buttons-to-head): do.
4440 7650
44412004-09-27 Reiner Steib <Reiner.Steib@gmx.de> 76512004-09-27 Simon Josefsson <jas@extundo.com>
4442 7652
4443 * gnus.el (gnus-version-number): Set to 5.11. 7653 * hashcash.el: New version, from
7654 http://users.actrix.co.nz/mycroft/hashcash.el. Previously in
7655 ../contrib/.
4444 7656
44452004-09-27 Katsumi Yamaoka <yamaoka@jpl.org> 76572004-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
4446 7658
4447 * mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte. 7659 * mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte.
4448 7660
44492004-09-26 Christian Neukirchen <chneukirchen@yahoo.de> (tiny change) 76612004-09-26 Jesper Harder <harder@ifa.au.dk>
4450 7662
4451 * mm-util.el (mm-image-load-path): Handle nil in load-path. 7663 * gnus-dup.el (gnus-dup-open): Use mapc.
7664 (gnus-dup-enter-articles, gnus-dup-suppress-articles): Use dolist.
4452 7665
44532004-09-26 Jesper Harder <harder@ifa.au.dk> 7666 (gnus-dup-enter-articles): Remove excess ID's from gnus-dup-hashtb.
7667 Reported by Stefan Wiens <s.wi@gmx.net>.
4454 7668
4455 * gnus-msg.el (gnus-post-news): Use blank Newsgroups line if 7669 * gnus.el (gnus-shutdown): Use dolist.
4456 GROUP is a virtual group.
4457 7670
4458 * mm-util.el (mm-charset-synonym-alist): Remove obsolete entries 7671 * gnus-undo.el (gnus-undo): Use mapc.
4459 for big5 and gb2312.
4460 7672
4461 * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid 7673 * nnrss.el (nnrss-generate-active): do.
4462 padding.
4463 7674
4464 * mm-bodies.el (mm-7bit-chars): Don't include \r. 7675 * message.el (message-cite-original-without-signature)
7676 (message-cite-original): Use mapc.
7677 (message-do-actions, message-make-forward-subject): Use dolist.
4465 7678
4466 * mml.el (mml-compute-boundary-1): Don't uncompress files. 76792004-09-25 Kevin Greiner <kgreiner@compsol.cc>
4467 7680
4468 * rfc2047.el (rfc2047-qp-or-base64): New function to reduce 7681 * gnus-agent.el (gnus-agent-check-overview-buffer): Fixed range of
4469 dependencies. 7682 deletion to remove entire duplicate line. Fixes merged article
4470 (rfc2047-encode): Use it. 7683 number bug.
4471 7684
4472 * flow-fill.el: Typo. 76852004-09-25 Kevin Greiner <kgreiner@compsol.cc>
4473 7686
4474 * mml.el (mml-generate-mime-1): Don't use format=flowed with 7687 * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore
4475 inline PGP. 7688 servers that are offline. Avoids having gnus-agent-toggle-plugged
7689 first ask if you want to open a server and then, even when you
7690 responded with no, asking if you want to synchronize the server's
7691 flags.
7692 (gnus-agent-synchronize-flags-server): Rewrote read loop to handle
7693 multi-line expressions.
7694 (gnus-agent-synchronize-group-flags): New internal function.
7695 Updates marks in memory (in the info structure) AND in the
7696 backend.
4476 7697
4477 * gnus.el (gnus-getenv-nntpserver): Strip whitespace. 7698 * gnus-util.el (gnus-remassoc): Fixed typo in documentation.
4478 7699
4479 * gnus-cache.el (gnus-cache-save-buffers): Check if buffer is 7700 * nnagent.el (nnagent-request-set-mark): Use
4480 alive. Reported by Laurent Martelli <laurent@aopsys.com>. 7701 gnus-agent-synchronize-group-flags, not backend's request-set-mark
7702 method, to ensure that synchronization updates marks in the
7703 backend and in the info (in memory) structure.
4481 7704
4482 * html2text.el (html2text-replace-list): Add &amp; and &apos;. 77052004-09-24 Katsumi Yamaoka <yamaoka@jpl.org>
4483 7706
4484 * nnheader.el (nnheader-max-head-length): Increase to 8192. 7707 * gnus-uu.el (gnus-uu-digest-mail-forward): Obey the process/prefix
7708 convention fully; don't miss the root article of a thread; make
7709 the X-Draft-From header with correct article numbers.
4485 7710
4486 * message.el (message-clone-locals): Clone sendmail and smtp 77112004-09-23 Kevin Greiner <kgreiner@compsol.cc>
4487 variables. 7712
7713 * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing
7714 unless plugged. Disable the agent so that an open failure causes
7715 an error.
7716
7717 * gnus-int.el (gnus-request-set-mark, gnus-request-update-mark):
7718 Reverted 2004-09-21 change. The backend must be opened while
7719 synchronizing flags even when the backend stores the flags
7720 locally.
4488 7721
44892004-09-23 Reiner Steib <Reiner.Steib@gmx.de> 77222004-09-23 Reiner Steib <Reiner.Steib@gmx.de>
4490 7723
4491 * gnus-msg.el (gnus-configure-posting-styles): Narrow to headers 7724 * gnus-msg.el (gnus-configure-posting-styles): Narrow to headers
4492 in `header' match. Reported by Svend Tollak Munkejord. 7725 in `header' match. Reported by Svend Tollak Munkejord.
4493 7726
7727 * message.el (message-cite-original): Fix use of
7728 `message-cite-articles-with-x-no-archive'.
7729
77302004-09-22 Katsumi Yamaoka <yamaoka@jpl.org>
7731
7732 * gnus-win.el (gnus-buffer-configuration): Add mml-preview.
7733 (gnus-window-to-buffer): Ditto.
7734
7735 * mml.el (mml-preview-buffer): New variable.
7736 (mml-preview): Manage window layout with gnus-buffer-configuration.
7737
7738 * gnus-msg.el (gnus-setup-message): Put article numbers into the
7739 X-Draft-From header even if those articles aren't quoted.
7740
77412004-09-21 Kevin Greiner <kgreiner@compsol.cc>
7742
7743 * gnus-int.el (gnus-servers-that-use-local-marks): New variable.
7744 (gnus-request-set-mark, gnus-request-update-mark): Use new
7745 g-s-t-u-l-m to decide to use backend even when unplugged.
7746
77472004-09-21 Katsumi Yamaoka <yamaoka@jpl.org>
7748
7749 * gnus-msg.el (gnus-inews-make-draft-meta-information): Don't add
7750 a trailing whitespace. Suggested by Cheng Gao <chenggao@gmail.com>.
7751
77522004-09-20 Simon Josefsson <jas@extundo.com>
7753
7754 * mm-util.el (mm-charset-synonym-alist): Map "unicode" to
7755 "utf-16-le".
7756
44942004-09-20 Stefan Monnier <monnier@iro.umontreal.ca> 77572004-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
4495 7758
4496 * mm-decode.el (mm-copy-to-buffer): Preserve the data's unibyteness. 7759 * mm-decode.el (mm-copy-to-buffer): Preserve the data's unibyteness.
4497 7760
44982004-09-20 Reiner Steib <Reiner.Steib@gmx.de> 77612004-09-19 Reiner Steib <Reiner.Steib@gmx.de>
4499 7762
4500 * uudecode.el (uudecode-use-external): Add :version. 7763 * uudecode.el (uudecode-use-external): Add :version.
4501 7764
@@ -4647,29 +7910,48 @@
4647 * gnus-sum.el (gnus-fetch-old-headers): Add custom choices `t' 7910 * gnus-sum.el (gnus-fetch-old-headers): Add custom choices `t'
4648 and `invisible'. 7911 and `invisible'.
4649 7912
79132004-09-10 Teodor Zlatanov <tzz@lifelogs.com>
7914
7915 * gnus-registry.el (gnus-registry-trim): Watch out for negatives
7916 in gnus-registry-trim.
7917
46502004-09-13 Simon Josefsson <jas@extundo.com> 79182004-09-13 Simon Josefsson <jas@extundo.com>
4651 7919
7920 * dns-mode.el: Add XEmacs auto-mode-alist autoload cookie.
7921
4652 * nnimap.el (nnimap-demule): Revert 2004-08-30 change. 7922 * nnimap.el (nnimap-demule): Revert 2004-08-30 change.
4653 7923
7924 * dns-mode.el (dns-mode): Fix menu for XEmacs, reported by Steve
7925 Youngs <steve@youngs.au.com> and suggested by Katsumi Yamaoka
7926 <yamaoka@jpl.org>.
7927 (dns-mode-font-lock-keywords): Fix faces, reported by Steve Youngs
7928 <steve@youngs.au.com> and suggested by Katsumi Yamaoka
7929 <yamaoka@jpl.org>.
7930
7931 * sieve.el (sieve-manage-mode): Ditto.
7932
46542004-09-13 Reiner Steib <Reiner.Steib@gmx.de> 79332004-09-13 Reiner Steib <Reiner.Steib@gmx.de>
4655 7934
4656 * gnus-sum.el (gnus-summary-copy-article): Fix doc string. 7935 * gnus-sum.el (gnus-summary-copy-article): Fix doc string.
4657 7936
46582004-09-10 Miles Bader <miles@gnu.ai.mit.edu> 79372004-09-11 Simon Josefsson <jas@extundo.com>
4659 7938
4660 * nnimap.el (nnimap-open-connection): Remove extraneous end-paren. 7939 * dns-mode.el: Add.
4661 7940
46622004-09-10 Teodor Zlatanov <tzz@lifelogs.com> 7941 * mm-view.el (mm-display-dns-inline): Add.
4663 7942
4664 * nnimap.el (nnimap-open-connection): Allow 'imaps' as a synonym 7943 * mm-decode.el (mm-inline-media-tests): Add text/dns.
4665 for the 'imap' port in netrc files. 7944 (mm-automatic-display): Ditto.
4666 7945
4667 * gnus-registry.el (gnus-registry-trim): Watch out for negatives 7946 * mailcap.el (mailcap-mime-data): Add text/dns.
4668 in gnus-registry-trim. 7947 (mailcap-mime-extensions): Map .soa to text/dns.
4669 7948
46702004-09-10 Simon Josefsson <jas@extundo.com> 79492004-09-10 Miles Bader <miles@gnu.ai.mit.edu>
4671 7950
4672 * nndb.el (require): Remove tcp and duplicate cl. 7951 * gnus-art.el (article-decode-mime-words, article-babel)
7952 (gnus-article-highlight-signature, gnus-article-add-buttons)
7953 (gnus-signature-toggle): Remove unnecessary bindings of
7954 `inhibit-read-only' inherited from v5.10 merge.
4673 7955
46742004-09-08 Reiner Steib <Reiner.Steib@gmx.de> 79562004-09-08 Reiner Steib <Reiner.Steib@gmx.de>
4675 7957
@@ -4686,7 +7968,7 @@
4686 * flow-fill.el (fill-flowed-display-column) 7968 * flow-fill.el (fill-flowed-display-column)
4687 (fill-flowed-encode-column): Ditto. 7969 (fill-flowed-encode-column): Ditto.
4688 7970
46892004-09-06 Stefan Monnier <monnier@iro.umontreal.ca> 79712004-09-06 Stefan <monnier@iro.umontreal.ca>
4690 7972
4691 * message.el (message-tokenize-header, message-send-mail-with-qmail): 7973 * message.el (message-tokenize-header, message-send-mail-with-qmail):
4692 Use point-min rather than 1. 7974 Use point-min rather than 1.
@@ -4699,14 +7981,59 @@
4699 (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1. 7981 (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1.
4700 (gnus-highlight-selected-tree): Use point-min rather than 1 and 2. 7982 (gnus-highlight-selected-tree): Use point-min rather than 1 and 2.
4701 7983
79842004-09-10 Simon Josefsson <jas@extundo.com>
7985
7986 * nndb.el (require): Remove tcp and duplicate cl.
7987
79882004-09-10 Katsumi Yamaoka <yamaoka@jpl.org>
7989
7990 * gnus-agent.el (directory-files-and-attributes): Move forward.
7991
79922004-09-09 Kevin Greiner <kgreiner@compsol.cc>
7993
7994 * gnus-agent.el (directory-files-and-attributes): Optionally
7995 defined to support XEmacs.
7996
79972004-09-09 Kevin Greiner <kgreiner@compsol.cc>
7998
7999 * gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf
8000 to avoid run-time CL dependencies.
8001 (gnus-agent-unfetch-articles): New function.
8002 (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate
8003 article numbers even when local .overview file is missing.
8004 (gnus-agent-read-article-number): New function. Only accepts
8005 27-bit article numbers.
8006 (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use
8007 gnus-agent-read-article-number.
8008 (gnus-agent-braid-nov): Rewrote to validate article numbers coming
8009 from backend while recognizing that article numbers in .overview
8010 must be valid.
8011 (gnus-agent-update-files-total-fetched-for): Use
8012 directory-files-and-attributes to improve performance.
8013 * gnus-int.el (gnus-request-move-article): Use
8014 gnus-agent-unfetch-articles in place of gnus-agent-expire to
8015 improve performance.
8016
8017 * gnus-start.el (gnus-convert-old-newsrc): Changed message text as
8018 some users confused by references to .newsrc when they only have a
8019 .newsrc.eld file.
8020 (gnus-convert-mark-converter-prompt,
8021 gnus-convert-converter-needs-prompt): Fixed use of property list.
8022 * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt):
8023 New function. Used internally to only display 'gnus converting
8024 files' message when actually necessary.
8025
8026 * gnus-sum.el (): Removed (require 'gnus-agent) as required
8027 methods now autoloaded.
8028
47022004-09-03 Katsumi Yamaoka <yamaoka@jpl.org> 80292004-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
4703 8030
4704 * gnus-sum.el (gnus-summary-insert-subject): Remove list identifiers. 8031 * gnus-sum.el (gnus-summary-insert-subject): Remove list
8032 identifiers.
4705 8033
47062004-09-03 Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp> (tiny change) 80342004-09-02 Reiner Steib <Reiner.Steib@gmx.de>
4707 8035
4708 * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty. 8036 * gnus-picon.el: Fix indentation and closing parenthesis.
4709 (spam-stat-save): Accept prefix argument.
4710 8037
47112004-09-01 Simon Josefsson <jas@extundo.com> 80382004-09-01 Simon Josefsson <jas@extundo.com>
4712 8039
@@ -4723,43 +8050,2659 @@
4723 8050
4724 * sha1-el.el: Renamed to sha1.el. 8051 * sha1-el.el: Renamed to sha1.el.
4725 8052
80532004-08-30 Juanma Barranquero <lektu@terra.es>
8054
8055 * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant.
8056
80572004-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
8058
8059 * nnimap.el (nnimap-demule): Avoid string-as-multibyte.
8060
80612004-08-30 Kim F. Storm <storm@cua.dk>
8062
8063 * nntp.el (nntp-authinfo-file): Add :group 'nntp.
8064
8065 * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache):
8066 Add :group 'nnimap.
8067
80682004-08-30 Andreas Schwab <schwab@suse.de>
8069
8070 * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for
8071 ?* and ?\;.
8072
8073 * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\;
8074 and ?\' to symbol instead of whitespace.
8075
80762004-08-30 Katsumi Yamaoka <yamaoka@jpl.org>
8077
8078 * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
8079
8080 * gnus-sum.el (gnus-summary-morse-message): Use search-forward
8081 instead of re-search-forward.
8082
8083 * gnus-uu.el (gnus-uu-save-article): Ditto.
8084 (gnus-uu-post-encode-uuencode): Ditto.
8085
8086 * html2text.el (html2text-clean-list-items): Ditto.
8087 (html2text-clean-dtdd): Ditto.
8088 (html2text-format-tags): Ditto.
8089
8090 * message.el (message-send-mail-with-sendmail): Fix regexp.
8091 (message-fill-field-general): Use search-forward instead of
8092 re-search-forward.
8093 (unbold-region): Ditto.
8094
8095 * nnrss.el (nnrss-request-article): Ditto.
8096
8097 * nnslashdot.el (nnslashdot-request-article): Ditto.
8098
8099 * nnweb.el (nnweb-gmane-wash-article): Ditto.
8100
8101 * gnus-sum.el (gnus-summary-make-menu-bar): Avoid the
8102 "Unrecognized menu descriptor" error in XEmacs.
8103
81042004-08-26 Stefan Wiens <s.wi@gmx.net> (tiny change)
8105
8106 * gnus-sum.el (gnus-read-header): Don't remove a header for the
8107 parent article of a sparse article in the thread hashtb.
8108
81092004-08-26 David Hedbor <dhedbor@real.com> (tiny change)
8110
8111 * nnmail.el (nnmail-split-lowercase-expanded): New user option.
8112 (nnmail-expand-newtext): Lowercase expanded entries if
8113 nnmail-split-lowercase-expanded is non-nil.
8114
81152004-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
8116
8117 * nndoc.el (nndoc-type-alist): Fix regexp in the rfc822-forward
8118 entry.
8119
8120 * gnus-group.el (gnus-group-line-format-alist): Convert the value
8121 of gnus-tmp-news-method into string under XEmacs. It will be
8122 passed to gnus-correct-length which takes only a string argument.
8123
81242004-08-24 Katsumi Yamaoka <yamaoka@jpl.org>
8125
8126 * gnus-util.el (gnus-bind-print-variables): New macro.
8127 (gnus-prin1): Use it.
8128 (gnus-prin1-to-string): Use it.
8129 (gnus-pp): New function.
8130 (gnus-pp-to-string): New function.
8131
8132 * gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace
8133 pp-to-string with gnus-pp-to-string.
8134 * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp.
8135 * gnus-group.el (gnus-group-make-kiboze-group): Ditto.
8136 * gnus-msg.el (gnus-debug): Ditto.
8137 * gnus-score.el (gnus-score-save): Ditto.
8138 * gnus-spec.el (gnus-update-format): Replace pp-to-string with
8139 gnus-pp-to-string.
8140 * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): Replace pp
8141 with gnus-pp.
8142 * score-mode.el (gnus-score-pretty-print): Ditto.
8143 * webmail.el (webmail-debug): Ditto.
8144
81452004-08-23 Katsumi Yamaoka <yamaoka@jpl.org>
8146
8147 * gnus-art.el (article-display-face, article-display-x-face): Use
8148 buffer-read-only.
8149
81502004-08-22 Katsumi Yamaoka <yamaoka@jpl.org>
8151
8152 * gnus-art.el (article-hide-list-identifiers): Bind
8153 inhibit-read-only as t.
8154
81552004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
8156
8157 * gnus-mlspl.el (gnus-group-split-update): Fix docstring.
8158
81592004-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
8160
8161 * gnus-art.el: Use inhibit-read-only instead of buffer-read-only.
8162 (gnus-narrow-to-page): Don't assume point-min == 1.
8163 (gnus-article-edit-mode): Derive from message-mode.
8164
8165 * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume
8166 point-min == 1.
8167
8168 * imap.el (imap-parse-address-list, imap-parse-body-ext):
8169 Disable incorrect use of `assert'.
8170
8171 * message.el (message-mode): Set comment-start-skip.
8172
8173
81742004-08-22 Sam Steingold <sds@gnu.org>
8175
8176 * pop3.el (pop3-leave-mail-on-server): New user variable.
8177 (pop3-movemail): Delete mail only when it is nil.
8178
81792004-08-21 Reiner Steib <Reiner.Steib@gmx.de>
8180
8181 * nntp.el (nntp-marks-is-evil): Fix typo in docstring.
8182
8183 * mml.el (mml-preview): Use `pop-to-buffer'.
8184
8185 * message.el (message-goto-mail-followup-to): Insert after "To".
8186 (message-carefully-insert-headers): Add comment.
8187
8188 * gnus.el: Remove unused variable `gnus-article-check-size'.
8189
8190 * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts.
8191
8192 * gnus-art.el (gnus-button-alist): Improve
8193 `gnus-button-handle-library' entry.
8194
81952004-08-19 Sebastian Freundt <hroptatyr@gna.org> (tiny change)
8196
8197 * nnmaildir.el (nnmaildir--emlink-p, nnmaildir--enoent-p): Use
8198 downcase, since XEmacs capitalizes error messages differently.
8199
82002004-08-18 Jesper Harder <harder@ifa.au.dk>
8201
8202 * nntp.el: Add (require 'gnus) due to reference to
8203 `gnus-directory'. Reported by Matt Swift <swift@alum.mit.edu>.
8204
82052004-08-18 Florian Weimer <fw@deneb.enyo.de>
8206
8207 * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind
8208 `mm-fill-flowed'.
8209
8210 * mm-decode.el (mm-dissect-singlepart): Check it.
8211
82122004-08-17 Teodor Zlatanov <tzz@lifelogs.com>
8213
8214 * nnimap.el (nnimap-open-connection): Add 'imaps' synonym to
8215 'imap' for netrc parsing.
8216
82172004-08-16 Reiner Steib <Reiner.Steib@gmx.de>
8218
8219 * mailcap.el (mailcap-mime-data): Mark as risky.
8220
82212004-08-15 Katsumi Yamaoka <yamaoka@jpl.org>
8222
8223 * rfc2047.el (rfc2047-encode-region): Assume the close parenthesis
8224 may be included in the encoded word.
8225 (rfc2047-encode): Don't append a space if the encoded word
8226 includes close parenthesis.
8227
82282004-08-12 Katsumi Yamaoka <yamaoka@jpl.org>
8229
8230 * rfc2047.el (rfc2047-encode-1, rfc2047-encode): Improve encoding
8231 of text within parentheses.
8232
82332004-08-06 Teodor Zlatanov <tzz@lifelogs.com>
8234
8235 * gnus-encrypt.el (gnus-encrypt-insert-file-contents)
8236 (gnus-encrypt-write-file-contents): Make the password key the file
8237 name PLUS the cipher, not just the cipher. Also remove failed
8238 passwords from the cache.
8239
82402004-08-06 Simon Josefsson <jas@extundo.com>
8241
8242 * gnus-sum.el (gnus-article-loose-mime): Change default to t. Doc
8243 fix.
8244
82452004-08-05 Katsumi Yamaoka <yamaoka@jpl.org>
8246
8247 * rfc2047.el (rfc2047-fold-region): Use trailing whitespace as
8248 LWSP.
8249
82502004-08-04 Teodor Zlatanov <tzz@lifelogs.com>
8251
8252 * gnus-registry.el (gnus-registry-split-fancy-with-parent): Try
8253 to append in-reply-to: data to the references: header.
8254
8255 * netrc.el: Remove old encryption support, autoload gnus-encrypt.el
8256 (netrc-parse): Use gnus-encrypt.el functions.
8257
8258 * gnus-encrypt.el: Add new file for encryption support; currently
8259 does only a few GPG ciphers and an internal XOR cipher.
8260
8261 * password.el: Add comments on using password-read-and-add.
8262 (password-read-and-add): Add function to read and add the
8263 password to the cache at once.
8264
82652004-07-28 Simon Josefsson <jas@extundo.com>
8266
8267 * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign
8268 parameter (but don't use it, for now).
8269
8270 * imap.el (imap-ssl-open): Use imap-process-connection-type,
8271 instead of hard coding to nil.
8272
82732004-07-28 Katsumi Yamaoka <yamaoka@jpl.org>
8274
8275 * mm-view.el (mm-inline-image-emacs): Open lines under an image
8276 as mm-inline-image-xemacs does.
8277
82782004-07-26 Simon Josefsson <jas@extundo.com>
8279
8280 * gnus-group.el (gnus-group-group-map, gnus-group-make-menu-bar):
8281 Revert part of 2004-07-17 change below.
8282
82832004-07-25 Katsumi Yamaoka <yamaoka@jpl.org>
8284
8285 * rfc2047.el (rfc2047-encode-region): Don't infloop. Suggested by
8286 Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
8287
82882004-07-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
8289
8290 * flow-fill.el (fill-flowed): Remove space stuffing, and only do
8291 quotes that actually start with ">" at the beginning of the
8292 lines.
8293
82942004-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
8295
8296 * rfc2047.el (rfc2047-encode-region): Fix last change.
8297 (rfc2047-encode-parameter): Remove useless concat.
8298
82992004-07-22 Katsumi Yamaoka <yamaoka@jpl.org>
8300
8301 * rfc2047.el (rfc2047-encode-region): Check carefully whether to
8302 encode special characters; fix some kind of misconfigured headers;
8303 signal a real error if debug-on-quit or debug-on-error is non-nil.
8304 (rfc2047-encode-max-chars): New variable.
8305 (rfc2047-encode-1): Use it.
8306 (rfc2047-encode-parameter): New function.
8307
8308 * mml.el (mml-insert-parameter): Remove an excessive space.
8309
83102004-07-17 Simon Josefsson <jas@extundo.com>
8311
8312 * gnus-group.el (gnus-group-make-group-simple): Add, suggested by
8313 Kai Grossjohann <kai@emptydomain.de>.
8314 (gnus-group-group-map): Use it, instead of gnus-group-make-group.
8315 (gnus-group-make-menu-bar): Ditto.
8316
8317 * gnus-util.el (gnus-group-server): Add.
8318
83192004-07-16 Jesper Harder <harder@ifa.au.dk>
8320
8321 * message.el (message-clone-locals): Clone sendmail and smtp
8322 variables.
8323
83242004-07-12 Katsumi Yamaoka <yamaoka@jpl.org>
8325
8326 * rfc2047.el (rfc2047-encode-region): Fix last change.
8327
83282004-07-12 Katsumi Yamaoka <yamaoka@jpl.org>
8329
8330 * rfc2047.el (rfc2047-encode-region): Treat backslash-quoted
8331 characters as non-special.
8332
83332004-07-09 Simon Josefsson <jas@extundo.com>
8334
8335 * gnus-agent.el (gnus-agent-synchronize-flags): Revert to ask.
8336 Users will lose all flag changes made while unplugged with
8337 e.g. nntp unless flag synchronization happens, thus `nil' is not a
8338 good default. See numerous reports on ding mailing list.
8339
83402004-07-09 Katsumi Yamaoka <yamaoka@jpl.org>
8341
8342 * nndoc.el (nndoc-type-alist): Improve regexp for article-begin,
8343 add generate-head-function and generate-article-function to the
8344 rfc822-forward entry.
8345 (nndoc-rfc822-forward-generate-article): New function.
8346 (nndoc-rfc822-forward-generate-head): New function.
8347
8348 * mm-decode.el (mm-dissect-buffer): Simplify cleaning of CTE.
8349
83502004-07-06 Dan Christensen <jdc@uwo.ca>
8351
8352 * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded,
8353 respect display group parameter and gnus-summary-expunge-below.
8354 (gnus-articles-to-read): Remove unused reference to display group
8355 parameter.
8356
83572004-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
8358
8359 * nnheader.el (nnheader-uniquify-message-id): New experimental
8360 variable.
8361 (nnheader-nov-read-message-id): Use it.
8362
8363 * spam-report.el (spam-report-gmane): Add interactive.
8364
83652004-07-02 Katsumi Yamaoka <yamaoka@jpl.org>
8366
8367 * mm-encode.el (mm-content-transfer-encoding-defaults): Use
8368 qp-or-base64 for the application/* types.
8369
83702004-07-02 Joakim Verona <joakim@verona.se> (tiny change)
8371
8372 * nnrss.el (nnrss-read-group-data): Fix off-by-one error.
8373
83742004-06-30 Teodor Zlatanov <tzz@lifelogs.com>
8375
8376 * gnus-registry.el (gnus-registry-trim): Don't allow a negative
8377 trim value.
8378
83792004-01-25 Paul Jarc <prj@po.cwru.edu>
8380
8381 * nnmaildir.el (nnmaildir--condcase, nnmaildir--enoent-p):
8382 New macro and function.
8383 (nnmaildir--new-number, nnmaildir-request-set-mark): Use them.
8384
83852004-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
8386
8387 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of
8388 after-load-alist.
8389
83902004-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
8391
8392 * gnus-group.el (gnus-group-get-new-news-this-group): Don't
8393 update info that isn't there.
8394
83952004-06-29 Ilya N. Golubev <gin@mo.msk.ru>.
8396
8397 * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
8398 entry.
8399
84002004-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
8401
8402 * mm-view.el (mm-inline-render-with-function): Use multibyte
8403 buffer; decode html source by charset.
8404
8405 * mm-encode.el (mm-content-transfer-encoding-defaults): Doc fix.
8406
8407 * mm-util.el (mm-enrich-utf-8-by-mule-ucs): New function run when
8408 Mule-UCS is loaded under XEmacs.
8409 (mm-mime-mule-charset-alist): Avoid duplicated entries.
8410
84112004-06-28 Jesper Harder <harder@ifa.au.dk>
8412
8413 * nnheader.el (nnheader-max-head-length): Increase to 8192.
8414
84152004-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
8416
8417 * mm-util.el (mm-coding-system-p): Return a coding-system.
8418 (mm-mime-mule-charset-alist): Use shift_jis instead of
8419 iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new
8420 entries for the mime charsets iso-2022-jp-3 and shift_jis.
8421 (mm-coding-system-priorities): Use shift_jis and iso-8859-1
8422 instead of japanese-shift-jis and iso-latin-1 respectively in
8423 order to share the default value with both Emacs and XEmacs-mule.
8424 (mm-mule-charset-to-mime-charset): Make
8425 mm-coding-system-priorities effective.
8426 (mm-sort-coding-systems-predicate): Canonicalize coding-systems
8427 while predicating of candidates upon the priorities.
8428
84292004-06-27 Jesper Harder <harder@ifa.au.dk>
8430
8431 * gnus-sum.el (gnus-summary-make-menu-bar): Add
8432 gnus-uu-invert-processable.
8433
8434 * gnus.el: Autoload gnus-uu-invert-processable.
8435
84362004-06-24 Katsumi Yamaoka <yamaoka@jpl.org>
8437
8438 * mm-util.el (mm-with-multibyte-buffer): New macro.
8439
8440 * rfc2047.el (rfc2047-encode-string): Use it.
8441 (rfc2047-encode-region): Move point to the end of the region after
8442 encoding. Suggested by IRIE Tetsuya <irie@t.email.ne.jp>.
8443
84442004-06-23 Katsumi Yamaoka <yamaoka@jpl.org>
8445
8446 * gnus-cite.el (gnus-cite-parse): Don't ignore case when finding
8447 ">From ". Thanks to Reiner Steib <Reiner.Steib@gmx.de>.
8448
84492004-06-23 Katsumi Yamaoka <yamaoka@jpl.org>
8450
8451 * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option.
8452 (gnus-cite-parse): Ignore quoted envelope From_. Suggested by
8453 Karl Chen <quarl@nospam.quarl.org>.
8454
84552004-06-23 Jesper Harder <harder@ifa.au.dk>
8456
8457 * message.el (message-idna-to-ascii-rhs-1): Don't choke on
8458 invalid addresses.
8459
84602004-06-21 Teodor Zlatanov <tzz@lifelogs.com>
8461
8462 * spam.el: Change section markers, revise TODO list.
8463 (spam-backends): Make new master list of all installed backends.
8464 (spam-summary-exit-behavior): Add new variable to determine how
8465 messages moves are done at summary exit.
8466 (spam-move-spam-nonspam-groups-only)
8467 (spam-process-ham-in-nonham-groups)
8468 (spam-process-ham-in-spam-groups): Remove variables, the
8469 spam-summary-exit-behavior variable should be used to manage this
8470 behavior.
8471 (spam-old-ham-articles, spam-old-spam-articles): Remove.
8472 (spam-old-articles): Add variable, replacing spam-old-ham-articles
8473 and spam-old-spam-articles.
8474 (spam-use-copy, spam-use-move, spam-use-gmane, spam-use-resend):
8475 Add empty variables, placeholders for the backends they represent.
8476 (spam-set-difference): Move, unchanged.
8477 (spam-list-of-processors): Declare OBSOLETE, not used anymore
8478 unless the user has a processor variable.
8479 (spam-classifications, spam-classification-valid-p)
8480 (spam-backend-properties, spam-backend-property-valid-p)
8481 (spam-backend-function-type-valid-p)
8482 (spam-process-type-valid-p, spam-list-articles): Add helper functions.
8483 (spam-report-articles-gmane, spam-report-articles-resend):
8484 Remove functions, they are not needed.
8485 (spam-install-backend-super, spam-backend-list)
8486 (spam-backend-check, spam-backend-valid-p, spam-backend-info)
8487 (spam-backend-function, spam-backend-ham-registration-function)
8488 (spam-backend-spam-registration-function)
8489 (spam-backend-ham-unregistration-function)
8490 (spam-backend-spam-unregistration-function)
8491 (spam-backend-statistical-p, spam-backend-mover-p)
8492 (spam-install-backend-alias, spam-install-checkonly-backend)
8493 (spam-install-mover-backend, spam-install-nocheck-backend)
8494 (spam-install-backend, spam-install-statistical-backend)
8495 (spam-install-statistical-checkonly-backend): Add backend installation
8496 support.
8497 (spam-summary-prepare-exit): Rewrite to use the new backend code.
8498 (spam-group-processor-p): Use the new backend code and respect the
8499 summary exit behavior.
8500 (spam-mark-spam-as-expired-and-move-routine): Remove.
8501 (spam-summary-prepare): Change to use the new spam-old-articles
8502 variable.
8503 (spam-copy-or-move-routine, spam-copy-spam-routine)
8504 (spam-move-spam-routine, spam-copy-ham-routine)
8505 (spam-move-ham-routine): Add code to copy/move ham or spam.
8506 (spam-fetch-field-fast): Improve doc and code, plus allow the
8507 'number request.
8508 (spam-list-of-checks, spam-list-of-statistical-checks): Remove
8509 variables.
8510 (spam-split, spam-find-spam): Use the new backend code.
8511 (spam-registration-functions): Remove variable.
8512 (spam-unregister-routine): Add convenience wrapper.
8513 (spam-log-undo-registration, spam-register-routine)
8514 (spam-log-processing-to-registry)
8515 (spam-log-unregistration-needed-p): Rename "check" to "backend"
8516 where possible.
8517 (spam-check-gmane-xref, spam-check-regex-headers)
8518 (spam-check-blackholes, spam-check-stat, spam-check-ifile)
8519 (spam-check-BBDB, spam-check-whitelist, spam-check-blacklist)
8520 (spam-check-bogofilter-headers, spam-check-spamoracle)
8521 (spam-check-spamassassin-headers, spam-check-bsfilter-headers)
8522 (spam-check-crm114-headers): Use the spam-split-group that
8523 spam-split prepares, no need to determine it every time.
8524
8525 * nnimap.el (nnimap-retrieve-headers-progress): Add the message number
8526 to the nnheader-parse-naked-head call.
8527
8528 * nnheader.el (nnheader-generate-fake-message-id): Fix indentation.
8529
8530 * gnus-sum.el (gnus-nov-parse-line): Add the message number to
8531 the nnheader-nov-read-message-id call.
8532
85332004-06-21 Katsumi Yamaoka <yamaoka@jpl.org>
8534
8535 * gnus-group.el (gnus-group-get-new-news-this-group): Don't call
8536 gnus-activate-group twice. Suggested by Markus Peter
8537 <warp@spin.de>.
8538
85392004-06-18 Katsumi Yamaoka <yamaoka@jpl.org>
8540
8541 * gnus-art.el (gnus-article-time-format): Exchange the order of
8542 day and month in the default value; fix customization type.
8543 (article-date-ut): Use add-text-properties.
8544 (article-make-date-line): Use message-make-date instead of
8545 current-time-string.
8546
8547 * message.el (message-fetch-field): Don't use set-text-properties.
8548 (message-make-date): Simplify.
8549
85502004-06-17 Katsumi Yamaoka <yamaoka@jpl.org>
8551
8552 * rfc2047.el (rfc2047-syntax-table): Treat `(' and `)' as is.
8553 (rfc2047-encode-region): Treat text within parentheses as special;
8554 show the original text when error has occurred.
8555
8556 * gnus-group.el (gnus-group-get-new-news-this-group): Pass the
8557 already-computed method to gnus-activate-group.
8558
8559 * gnus-start.el (gnus-make-hashtable-from-newsrc-alist): Make the
8560 same select-methods identical Lisp objects.
8561
8562 * gnus-srvr.el (gnus-server-set-info): Don't make a new Lisp
8563 object when modifying the info.
8564
85652004-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
8566
8567 * gnus-srvr.el (gnus-server-set-info): Remove the server from
8568 gnus-opened-servers since it has never been opened with the new
8569 configuration yet.
8570
85712004-06-15 Katsumi Yamaoka <yamaoka@jpl.org>
8572
8573 * nnheader.el (nnheader-nov-read-message-id): Pass the optional
8574 arg to nnheader-generate-fake-message-id.
8575
85762004-06-14 Teodor Zlatanov <tzz@lifelogs.com>
8577
8578 * nnheader.el (nnheader-generate-fake-message-id): Accept a
8579 number and build a fake message ID localized to a group and
8580 article number (so it's repeatable from that point on).
8581 (nnheader-fake-message-id-p): Change regex to accomodate new fake
8582 ID format.
8583
8584 * gnus-sum.el (gnus-get-newsgroup-headers): Call
8585 nnheader-generate-fake-message-id with the article number.
8586
85872004-06-12 YAGI Tatsuya <ynyaaa@ybb.ne.jp> (tiny change)
8588
8589 * gnus-art.el (gnus-article-next-page): Fix the way to find a real
8590 end-of-buffer.
8591
85922004-06-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
8593
8594 * message.el (message-ignored-supersedes-headers): Add Approved.
8595
85962004-06-11 Katsumi Yamaoka <yamaoka@jpl.org>
8597
8598 * rfc2047.el (rfc2047-encode-message-header): Remove useless
8599 goto-char.
8600 (rfc2047-encode): Fold the line before encoding.
8601
86022004-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
8603
8604 * rfc2047.el (rfc2047-encode-message-header): Disabled header
8605 folding -- not all headers can be folded, and this should be done
8606 by the message composition mode. Probably. I think.
8607
86082004-06-10 Katsumi Yamaoka <yamaoka@jpl.org>
8609
8610 * gnus-util.el (gnus-remove-text-with-property): Make it slightly
8611 fast.
8612
8613 * gnus-ems.el (gnus-remove-image): Don't use
8614 message-text-with-property; remove only the image found first.
8615
86162004-06-09 Jesper Harder <harder@ifa.au.dk>
8617
8618 * message.el (message-send-mail-with-sendmail): Use with-current-buffer.
8619
86202004-06-09 Katsumi Yamaoka <yamaoka@jpl.org>
8621
8622 * message.el (message-text-with-property): Make it fast and accept
8623 optional arguments.
8624 (message-strip-forbidden-properties): Use it.
8625 (message-fix-before-sending): Follow the m-t-w-p change.
8626
8627 * gnus-ems.el (gnus-remove-image): Follow the m-t-w-p change.
8628
86292004-06-08 Katsumi Yamaoka <yamaoka@jpl.org>
8630
8631 * gnus-art.el (article-hide-headers): Don't change the buffer
8632 mistakenly when performing mml-preview even if
8633 gnus-single-article-buffer is nil.
8634
86352004-06-08 Kai Grossjohann <kgrossjo@eu.uu.net>
8636
8637 * message.el (message-expand-name-databases): New user option.
8638 (message-expand-name): Use it.
8639
86402004-06-07 Teodor Zlatanov <tzz@lifelogs.com>
8641
8642 * spam.el (spam-report-articles-resend)
8643 (spam-report-resend-register-routine): Allow ham reporting.
8644 (spam-report-resend-register-ham-routine): Add wrapper.
8645 (spam-registration-functions): Add ham resending functions.
8646 (spam-list-of-processors): Add ham resend processor.
8647
8648 * gnus.el (ham-resend-to): Add new group parameter.
8649 (spam-process): Add ham resend option.
8650
8651 * spam-report.el (spam-report-resend): Allow reporting ham.
8652 (spam-report-resend-ham): Add wrapper.
8653
86542004-06-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
8655
8656 * message.el (message-cite-articles-with-x-no-archive): New
8657 variable.
8658 (message-cite-original): Use it.
8659
86602004-06-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
8661
8662 * message.el (message-cite-original): Respect X-No-Archive.
8663
86642004-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
8665
8666 * gnus-art.el (article-hide-headers): Refer to the values for
8667 gnus-ignored-headers and gnus-visible-headers in the summary
8668 buffer since a user may have set them as group parameters.
8669
86702004-06-03 Teodor Zlatanov <tzz@lifelogs.com>
8671
8672 * assistant.el (assistant-node-name): Add convenience function.
8673 (assistant-render-text, assistant-render-node): Add error handling,
8674 plus handle multiple next nodes.
8675 (assistant-find-next-node): Comment out for now.
8676 (assistant-find-next-nodes): Add function, returns list of next
8677 nodes.
8678
86792004-06-02 Reiner Steib <Reiner.Steib@gmx.de>
8680
8681 * mail-source.el (mail-source-directory): Fix doc-string.
8682
86832004-05-29 Teodor Zlatanov <tzz@lifelogs.com>
8684
8685 * assistant.el (assistant-render-text, assistant-eval): Add :set
8686 widget type, which is different because it takes and returns a
8687 list. Much hilarity ensues.
8688
86892004-05-28 Reiner Steib <Reiner.Steib@gmx.de>
8690
8691 * gnus-art.el (gnus-button-alist): Fixed regexp for manual links.
8692
8693 * gnus-group.el (gnus-group-get-new-news-this-group): Added
8694 doc-string.
8695
8696 * gnus-start.el (gnus-activate-group): Added doc-string.
8697
86982004-05-28 Katsumi Yamaoka <yamaoka@jpl.org>
8699
8700 * mm-encode.el (mm-safer-encoding): Consider 7bit is safe.
8701
87022004-05-27 Teodor Zlatanov <tzz@lifelogs.com>
8703
8704 * assistant.el (assistant-render-text): Try to add a :set
8705 widget, more to come.
8706
8707 * spam.el (spam-group-spam-contents-p): Handle empty groupname
8708 strings.
8709 (spam-report-articles-resend)
8710 (spam-register-routine): Do registration iff any articles warrant
8711 it.
8712 (spam-summary-prepare-exit): Change log message for nil group
8713 destinations.
8714
87152004-05-27 Daniel Pittman <daniel@rimspace.net>
8716
8717 * spam.el (spam-report-resend-register-routine): Allow
8718 spam-report-resend-to to be a group parameter or a global value.
8719
87202004-05-26 Simon Josefsson <jas@extundo.com>
8721
8722 * starttls.el: Merge with my GNUTLS based starttls.el.
8723 (starttls-gnutls-program, starttls-use-gnutls)
8724 (starttls-extra-arguments, starttls-process-connection-type)
8725 (starttls-connect, starttls-failure, starttls-success): New
8726 variables.
8727 (starttls-program, starttls-extra-args): Doc fix.
8728 (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New
8729 functions.
8730 (starttls-negotiate, starttls-open-stream): Check
8731 `starttls-use-gnutls' and pass on to corresponding *-gnutls
8732 function if it is set.
8733
87342004-05-27 Katsumi Yamaoka <yamaoka@jpl.org>
8735
8736 * rfc2047.el (rfc2047-encode-region): Encode encoded words in
8737 structured fields.
8738
87392004-05-26 Katsumi Yamaoka <yamaoka@jpl.org>
8740
8741 * message.el (message-resend): Bind rfc2047-encode-encoded-words.
8742
87432004-05-26 Teodor Zlatanov <tzz@lifelogs.com>
8744
8745 * spam.el (spam-mark-new-messages-in-spam-group-as-spam): Add
8746 variable.
8747 (spam-mark-junk-as-spam-routine): Use it. Allow to disable
8748 assigning the spam-mark to new messages.
8749
87502004-05-26 Adam Sj,Ax(Bgren <asjo@koldfront.dk> (tiny change)
8751
8752 (spam-ham-copy-or-move-routine): Don't declare `todo' twice.
8753
87542004-05-26 Katsumi Yamaoka <yamaoka@jpl.org>
8755
8756 * rfc2047.el (rfc2047-encodable-p): Don't move point.
8757 (rfc2047-decode): Treat the ascii coding-system as raw-text by
8758 default.
8759
87602004-05-25 Anand Mitra <mitramc@yahoo.com> (tiny change)
8761
8762 * gnus-sum.el (gnus-summary-delete-article): invoke hook with
8763 correct data.
8764
87652004-05-24 Teodor Zlatanov <tzz@lifelogs.com>
8766
8767 * spam.el (spam-list-of-processors): Use nil for nonexistent processors.
8768 (spam-group-processor-p): Fix function.
8769 (spam-group-processor-multiple-p)
8770 (spam-group-spam-processor-report-gmane-p)
8771 (spam-group-spam-processor-report-resend-p)
8772 (spam-group-spam-processor-bogofilter-p)
8773 (spam-group-spam-processor-blacklist-p)
8774 (spam-group-spam-processor-ifile-p)
8775 (spam-group-ham-processor-ifile-p)
8776 (spam-group-spam-processor-spamoracle-p)
8777 (spam-group-spam-processor-crm114-p)
8778 (spam-group-ham-processor-bogofilter-p)
8779 (spam-group-spam-processor-stat-p)
8780 (spam-group-ham-processor-stat-p)
8781 (spam-group-ham-processor-whitelist-p)
8782 (spam-group-ham-processor-BBDB-p)
8783 (spam-group-ham-processor-spamoracle-p)
8784 (spam-group-ham-processor-copy-p): Remove functions with some
8785 prejudice against unneeded code.
8786 (spam-report-articles-resend)
8787 (spam-report-resend-register-routine): Allow the group/topic
8788 spam-resend-to value to override spam-report-resend-to.
8789 (spam-summary-prepare-exit): Invoke spam-group-processor-p
8790 properly now.
8791
8792 * gnus.el (spam-resend-to): Add group/topic parameter.
8793 (spam-process): Move the OBSOLETE processors to the end of the
8794 choices.
8795
87962004-05-24 Daniel Pittman <daniel@rimspace.net>
8797
8798 * spam-report.el (spam-report-resend-to, spam-report-resend): Start
8799 with resend-to set to nil, and then ask the user if necessary.
8800 (spam-report-resend): spam-report-resend takes a list of articles, not
8801 separate article numbers.
8802
88032004-05-23 Katsumi Yamaoka <yamaoka@jpl.org>
8804
8805 * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in
8806 addition to emacs-w3m.
8807
88082004-05-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
8809
8810 * assistant.el (assistant-authinfo-data): New function.
8811 (assistant-eval): Eval for entire assistant.
8812
8813 * netrc.el (netrc-services-file): New variable.
8814 (netrc-parse-services): New function.
8815 (netrc-find-service-name): New function.
8816 (netrc-find-service-number): New function.
8817 (netrc-port-equal): New function.
8818 (netrc-machine): Use it.
8819
8820 * nnimap.el (nnimap-open-connection): Use netrc.
8821
8822 * gnus-util.el (gnus-netrc-get): Remove aliases.
8823
8824 * gnus-sum.el (gnus-auto-center-summary): Change default to 2.
8825
8826 * assistant.el (wid-edit): Fix compilation.
8827
8828 * gnus-util.el (gnus-set-file-modes): Just ignore errors.
8829
88302004-05-23 Paul Stodghill <stodghil@cs.cornell.edu>
8831
8832 * gnus-util.el (gnus-set-file-modes): New function. (small
8833 patch).
8834
88352004-05-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
8836
8837 * gnus-topic.el (gnus-topic-jump-to-topic): Goto missing topic.
8838
8839 * assistant.el (assistant-render-node): Fix up rendering and
8840 read-only text.
8841 (assistant-render-node): Reset.
8842 (assistant-make-read-only): Not sticky.
8843
88442004-05-20 Danny Siu <dsiu@adobe.com>
8845
8846 * gnus-sum.el (gnus-summary-recenter): Summery buffer was not auto
8847 centered even when gnus-auto-center-summary is t
8848
88492004-05-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
8850
8851 * dns.el (dns-get-txt-answer): New function.
8852 (dns-read-txt): Ditto.
8853 (query-dns): Use it.
8854
88552004-05-21 Katsumi Yamaoka <yamaoka@jpl.org>
8856
8857 * gnus-start.el (gnus-get-unread-articles): Don't invalidate
8858 active for foreign groups even if the group level is higher than
8859 the specified value.
8860
88612004-05-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
8862
8863 * gnus-group.el (gnus-group-jump-to-group): Don't prompt for
8864 non-active groups.
8865
8866 * gnus-art.el (gnus-picon-databases): Add /usr/share/picons.
8867
88682004-05-20 Magnus Henoch <mange@freemail.hu>
8869
8870 * dns.el (dns-read-type): Add support for SVR. (small patch)
8871
88722004-05-20 Teodor Zlatanov <tzz@lifelogs.com>
8873
8874 * spam.el (spam-use-crm114, spam-crm114, spam-crm114-program)
8875 (spam-crm114-header, spam-crm114-spam-switch)
8876 (spam-crm114-spam-strong-switch, spam-crm114-ham-strong-switch)
8877 (spam-crm114-positive-spam-header)
8878 (spam-crm114-database-directory, spam-list-of-processors)
8879 (spam-group-spam-processor-crm114-p)
8880 (spam-group-ham-processor-crm114-p, spam-extra-header-to-number)
8881 (spam-generic-score, spam-list-of-checks)
8882 (spam-list-of-statistical-checks, spam-registration-functions)
8883 (spam-check-crm114-headers, spam-crm114-score)
8884 (spam-check-crm114, spam-crm114-register-with-crm114)
8885 (spam-crm114-register-spam-routine)
8886 (spam-crm114-unregister-spam-routine)
8887 (spam-crm114-register-ham-routine)
8888 (spam-crm114-unregister-ham-routine): Add CRM114 support. From
8889 asjo@koldfront.dk (Adam Sj,Ax(Bgren).
8890
8891 * gnus.el: Add spam-use-crm114.
8892
8893 * spam.el (spam-list-of-processors, spam-registration-functions):
8894 Add spam-use-resend.
8895 (spam-group-spam-processor-report-resend-p): Add utility wrapper.
8896 (spam-report-articles-gmane): Add doc fix.
8897 (spam-report-articles-resend,
8898 spam-report-resend-register-routine): Add wrappers around
8899 spam-report-resend-to.
8900
8901 * spam-report.el (spam-report-resend-to, spam-report-resend):
8902 Add support for resending spam.
8903 (spam-report-gmane): Fix line length >80.
8904
8905 * gnus.el (spam-process): Add spam-use-resend.
8906
89072004-05-20 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
8908
8909 * spam.el (spam-mark-spam-as-expired-and-move-routine): Return the
8910 number of processed spam messages.
8911 (spam-ham-copy-or-move-routine): Return the number of processed
8912 ham messages.
8913 (spam-summary-prepare-exit): Use the above values to decide
8914 whether status messages shouled be displayed.
8915
89162004-05-20 Katsumi Yamaoka <yamaoka@jpl.org>
8917
8918 * rfc2047.el (rfc2047-encode-function-alist): Renamed from
8919 `rfc2047-encoding-function-alist' in order to avoid conflicting
8920 with the old version.
8921 (rfc2047-encode-region): Concatenate words containing non-ASCII
8922 characters in structured fields; don't encode space-delimited
8923 ASCII words even in unstructured fields; don't break words at
8924 char-category boundaries.
8925 (rfc2047-encode-1): New function.
8926 (rfc2047-encode): Use it; encode text so that it occupies the
8927 maximum width within 76-column; work correctly on Q encoding for
8928 iso-2022-* charsets.
8929 (rfc2047-fold-region): Use existing whitespace for LWSP; make it
8930 sure not to break a line just after the header name.
8931 (rfc2047-b-encode-region): Removed.
8932 (rfc2047-b-encode-string): New function.
8933 (rfc2047-q-encode-region): Removed.
8934 (rfc2047-q-encode-string): New function.
8935
8936 * mm-util.el (mm-replace-in-string): New function.
8937
89382004-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
8939
8940 * gnus-msg.el (gnus-inews-make-draft-meta-information): Really
8941 get it right.
8942 (gnus-inews-make-draft): Really.
8943
89442004-05-19 Ben Menasha <bmenasha@benmenasha.net>
8945
8946 * nnmh.el (nnmh-request-list-1): Don't check the link count
8947 before descending. (small patch)
8948
47262004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org> 89492004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
4727 8950
4728 * pgg-pgp.el (pgg-pgp-verify-region): Clean up. 8951 * gnus-msg.el (gnus-inews-make-draft-meta-information): Fix quote
8952 stuff.
8953
8954 * gnus-start.el (gnus-subscribe-hierarchical-interactive): Match
8955 on real group name.
8956
8957 * gnus-art.el (gnus-signature-limit): Doc fix.
8958
8959 * gnus-msg.el (gnus-inews-make-draft): Quote list.
8960
89612004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
8962
8963 * gnus-draft.el (gnus-draft-send): Bind
8964 rfc2047-encode-encoded-words.
8965
8966 * rfc2047.el (rfc2047-encode-region): Encode =? strings.
8967 (rfc2047-encodable-p): Say that =? needs encoding.
8968 (rfc2047-encode-encoded-words): New variable.
8969
8970 * gnus-group.el (gnus-group-select-group): Doc fix.
8971
8972 * gnus-draft.el (gnus-draft-setup): Mark all replied as replied.
8973
8974 * gnus-group.el (gnus-group-mode): Set show-trailing-whitespace
8975 to nil.
8976
8977 * gnus-cache.el (gnus-cache-possibly-enter-article): Use it.
8978
8979 * nnheader.el (nnheader-get-lines-and-char): New function.
8980
89812004-05-19 Reiner Steib <Reiner.Steib@gmx.de>
8982
8983 * gnus-msg.el (gnus-summary-followup-with-original): Document
8984 yanking of region when active.
8985
89862004-05-19 Katsumi Yamaoka <yamaoka@jpl.org>
8987
8988 * gnus-start.el (gnus-get-unread-articles): Do nothing for foreign
8989 groups if the group level is higher than the specified value.
8990
89912004-05-18 Reiner Steib <Reiner.Steib@gmx.de>
8992
8993 * gnus-group.el (gnus-group-jump-to-group-prompt): Allow an alist.
8994 (gnus-group-jump-to-group): Added prefix argument using
8995 `gnus-group-jump-to-group-prompt'. Query before jumping to
8996 non-active group.
8997
8998 * compface.el (uncompface): Be verbose when changing
8999 `uncompface-use-external'.
9000
9001 * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to
9002 handle manual section.
9003
90042004-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
9005
9006 * gnus-art.el (gnus-button-alist): Revert previous change.
9007
90082004-05-18 Reiner Steib <Reiner.Steib@gmx.de>
9009
9010 * message.el (message-idna-to-ascii-rhs-1): Fix typo.
9011
90122004-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
9013
9014 * gnus-msg.el (gnus-inews-do-gcc): Don't use read-only-p to see
9015 whether backend can accept message.
9016
9017 * message.el (message-idna-to-ascii-rhs-1): Don't use equalp.
9018
90192004-05-18 Kai Grossjohann <kgrossjo@eu.uu.net>
9020
9021 * nntp.el (nntp-request-set-mark, nntp-request-update-info):
9022 Avoid creating directory when nntp-marks-is-evil is true.
9023 Reported by Reiner Steib.
9024
90252004-05-18 Reiner Steib <Reiner.Steib@gmx.de>
9026
9027 * gnus-picon.el (gnus-picon-style): New variable.
9028 (gnus-picon-insert-glyph): Added optional `nostring' argument.
9029 (gnus-picon-transform-address): Support `gnus-picon-style'. From
9030 Jesper Harder <harder@ifa.au.dk>.
9031
90322004-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
9033
9034 * message.el (message-fill-field): Return point.
9035 (message-generate-headers): Go to end of field.
9036
9037 * gnus-start.el (gnus-get-unread-articles-in-group): Don't do
9038 stuff for non-living groups.
9039
90402004-05-18 Jesper Harder <harder@ifa.au.dk>
9041
9042 * gnus-art.el (gnus-article-followup-with-original)
9043 (gnus-article-reply-with-original): gnus-mark-active-p ->
9044 gnus-region-active-p.
9045
90462004-05-17 Teodor Zlatanov <tzz@lifelogs.com>
9047
9048 * spam.el (spam-summary-prepare-exit): Fix messages, so they show
9049 only when there is spam or ham to be processed.
9050
90512004-05-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
9052
9053 * mail-source.el (mail-source-delete-crash-box): Refactor.
9054 (mail-source-fetch): Use it.
9055 (mail-source-fetch-file): Ditto.
9056 (mail-source-fetch-directory): Run postscript in loop.
9057 (mail-source-fetch-pop): Delete.
9058 (mail-source-fetch-maildir): Ditto.
9059 (mail-source-fetch-imap): Ditto.
9060
9061 * imap.el (imap-authenticators): Comment out sasl.
9062
9063 * message.el (message-skip-to-next-address): New function.
9064 (message-fill-header-address): Refactor.
9065 (message-fill-address): Use it.
9066 (message-delete-address): Use it.
9067 (message-fill-header-general): Refactor.
9068 (message-fill-field-address): Rename.
9069 (message-narrow-to-field): Find the start of the header.
9070 (message-header-format-alist): Don't pre-fill.
9071 (message-fill-header): Removed.
9072 (message-insert-header): New function.
9073 (message-shorten-references): Use it.
9074
9075 * rfc2047.el (rfc2047-field-value): Strip props.
9076
9077 * mail-parse.el (mail-header-make-address): New alias.
9078
9079 * ietf-drums.el (ietf-drums-make-address): New function.
9080
9081 * imap.el: Add compiler directives.
9082
9083 * gnus-score.el (gnus-score-edit-done): run-hook->run-hooks.
9084
9085 * gnus-art.el (article-decode-idna-rhs): Don't use
9086 message-idna-inside-rhs-p.
9087
90882004-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
9089
9090 * message.el (message-idna-inside-rhs-p): Removed.
9091 (message-idna-to-ascii-rhs-1): Use proper address parsing.
9092
9093 * gnus-art.el (gnus-emphasis-alist): Removed strikethru; too many
9094 false positives.
9095
90962004-05-16 Kim Minh Kaplan <kmkaplan-AwwS6Bc0PDVoiYX5Tdu9fQ@public.gmane.org>
9097
9098 * imap.el (imap-sasl-make-mechanisms): Use sasl.
9099
91002004-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
9101
9102 * nneething.el (nneething-file-name): Don't create spurions
9103 files.
9104
9105 * gnus-msg.el (gnus-inews-do-gcc): Ignore read-only groups.
9106 (gnus-inews-do-gcc): Remove sleep.
9107
9108 * gnus-art.el (gnus-mime-delete-part): Error message when no MIME
9109 part under point.
9110
9111 * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil.
9112 (gnus-agent-regenerate-group): Using nil messages aren't valid.
9113
91142004-05-15 Teodor Zlatanov <tzz@lifelogs.com>
9115
9116 * spam.el (spam-summary-prepare-exit): Fixed (length).
9117
91182004-05-14 Teodor Zlatanov <tzz@lifelogs.com>
9119
9120 * spam.el (spam-summary-prepare-exit): Fix to produce "marking spam
9121 as expired without moving it" message when there are spam
9122 messages left.
9123
91242004-05-14 Nelson Ferreira <nelson.ferreira@verizon.net> (tiny change)
9125
9126 * gnus-dup.el (gnus-dup-unsuppress-article): don't assume the mail
9127 header is not nil.
9128
91292004-05-14 Kai Grossjohann <kgrossjo@eu.uu.net>
9130
9131 * nntp.el (nntp-request-set-mark, nntp-request-update-info): Call
9132 nntp-possibly-create-directory, not nntp-possibly-change-group.
9133 (nntp-marks-changed-p): New arg SERVER.
9134 (nntp-request-update-info): Adjust caller.
9135
91362004-05-14 Kai Grossjohann <kai@emptydomain.de>
9137
9138 * nntp.el (nntp-save-marks): Pass missing arg.
9139
91402004-05-13 Kai Grossjohann <kai.grossjohann@gmx.net>
9141
9142 * nntp.el: Support marks.
9143 (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks)
9144 (nntp-marks-modtime, nntp-marks-directory): New variables.
9145 (nntp-request-set-mark, nntp-request-update-info)
9146 (nntp-possibly-create-directory, nntp-marks-changed-p)
9147 (nntp-save-marks, nntp-open-marks, nntp-marks-directory): New
9148 functions.
9149
91502004-05-12 Jesper Harder <harder@ifa.au.dk>
9151
9152 * gnus-score.el (gnus-score-insert-help): Use
9153 gnus-select-lowest-window.
9154
9155 * gnus-ems.el (gnus-select-lowest-window): Copy definition of
9156 appt-select-lowest-window and rename to gnus-select-lowest-window.
9157
9158 * gnus.el: do.
9159
91602004-05-12 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
9161
9162 * rfc2047.el (rfc2047-encode): Use uppercase letters to specify
9163 encodings of MIME-encoded words, in order to improve
9164 interoperability with several broken MUAs.
9165
91662004-05-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
9167
9168 * mm-view.el (mm-inline-text-html-render-with-w3): Check META
9169 tags, only when charsets are not specified in headers.
9170 (mm-inline-text-html-render-with-w3m): Ditto.
9171
91722004-05-06 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
9173
9174 * gnus-art.el (article-strip-banner): Use MIME-encoded from fields
9175 instead of MIME-decoded from fields when checking
9176 `gnus-article-address-banner-alist'.
9177
91782004-05-03 Jesper Harder <harder@ifa.au.dk>
9179
9180 * nnrss.el (nnrss-check-group, nnrss-read-group-data): Hash on
9181 description rather than subject.
9182
91832004-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
9184
9185 * gnus.el (gnus-version-number): Bump.
9186
91872004-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
9188
9189 * gnus.el: No Gnus v0.2 is released.
9190
91912004-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
9192
9193 * gnus-agent.el (gnus-agent-read-agentview): Inline
9194 gnus-uncompress-range.
9195
91962004-05-01 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
9197
9198 * spam.el (spam-bsfilter-path): Use `executable-find' instead of
9199 `exec-installed-p'.
9200
92012004-04-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
9202
9203 * gnus.el (spam-process, spam-autodetect-methods): Add
9204 bsfilter and bsfilter-headers.
9205
9206 * spam.el (spam-bsfilter): New customize group.
9207 (spam-use-bsfilter, spam-use-bsfilter-headers, spam-bsfilter-path)
9208 (spam-bsfilter-header, spam-bsfilter-probability-header)
9209 (spam-bsfilter-spam-switch, spam-bsfilter-ham-switch)
9210 (spam-bsfilter-spam-strong-switch, spam-bsfilter-ham-strong-switch)
9211 (spam-bsfilter-database-directory): New options.
9212 (spam-install-hooks, spam-list-of-processors, spam-list-of-checks)
9213 (spam-list-of-statistical-checks, spam-registration-functions):
9214 Add `spam-use-bsfilter' and `spam-use-bsfilter-headers'.
9215 (spam-bsfilter-score): New command.
9216 (spam-check-bsfilter-headers, spam-check-bsfilter)
9217 (spam-bsfilter-register-with-bsfilter)
9218 (spam-bsfilter-register-spam-routine)
9219 (spam-bsfilter-unregister-spam-routine)
9220 (spam-bsfilter-register-ham-routine)
9221 (spam-bsfilter-unregister-ham-routine): New functions.
9222 (spam-generic-score): Support bsfilter; Accept an optional argument
9223 to recalcurate spam score even if scoring header has already been
9224 added.
9225 (spam-bogofilter-score, spam-spamassassin-score): Accept an
9226 optional argument to recalcurate spam score even if scoring header
9227 has already been added.
9228
92292004-04-29 Jesper Harder <harder@ifa.au.dk>
9230
9231 * nnrss.el (nnrss-get-namespace-prefix): Use string= to compare
9232 strings! Reported by David D. Smith <davidsmith@acm.org>.
9233 (nnrss-check-group, nnrss-read-group-data): Hash on Subject if
9234 link is missing.
9235
92362004-04-28 Jesper Harder <harder@ifa.au.dk>
9237
9238 * html2text.el (html2text-replace-list): Add &amp; and &apos;.
9239 (html2text-get-attr): Rewrite.
9240
9241 * message.el (message-setup-1): Remove redundant put-text-property
9242 on mail-header-separator.
9243
92442004-04-27 Teodor Zlatanov <tzz@lifelogs.com>
9245
9246 * gnus-registry.el (gnus-registry-cache-whitespace)
9247 (gnus-registry-action, gnus-registry-spool-action)
9248 (gnus-registry-split-fancy-with-parent): Change message levels
9249 from 5 to 3 or 7, as needed.
9250
9251 * spam.el (spam-summary-prepare-exit)
9252 (spam-mark-junk-as-spam-routine, spam-fetch-field-fast)
9253 (spam-split, spam-find-spam, spam-log-undo-registration)
9254 (spam-check-blackholes, spam-enter-ham-BBDB): Changed message
9255 level from 5 to 6.
9256
92572004-04-26 Katsumi Yamaoka <yamaoka@jpl.org>
9258
9259 * gnus-ems.el: Autoload appt-select-lowest-window (revert
9260 2004-03-04 change).
9261
92622004-04-25 Jesper Harder <harder@ifa.au.dk>
9263
9264 * spam-stat.el (spam-stat-score-buffer): Simplify mapcar usage.
9265 Use mapc when appropriate.
9266
9267 * sieve-manage.el (sieve-manage-open): do.
9268
9269 * nnweb.el (nnweb-insert-html): do.
9270
9271 * nnvirtual.el (nnvirtual-catchup-group, nnvirtual-partition-sequence)
9272 (nnvirtual-partition-sequence, nnvirtual-create-mapping): do.
9273
9274 * nnspool.el (nnspool-request-group): do.
9275
9276 * nnrss.el (nnrss-opml-export, nnrss-find-el, nnrss-order-hrefs):
9277 do.
9278
9279 * nnml.el (nnml-request-update-info): do.
9280
9281 * nnmh.el (nnmh-request-group, nnmh-request-list-1, nnmh-active-number)
9282 (nnmh-request-create-group, nnmh-update-gnus-unreads): do.
9283
9284 * nnimap.el (nnimap-request-close, nnimap-acl-edit)
9285 (nnimap-request-set-mark): do.
9286
9287 * nnfolder.el (nnfolder-request-update-info): do.
9288
9289 * mm-view.el (mm-pkcs7-signed-magic, mm-pkcs7-enveloped-magic):
9290 do.
9291
9292 * mml.el (mml-destroy-buffers, mml-compute-boundary-1): do.
9293
9294 * gnus-uu.el (gnus-uu-find-articles-matching): do.
9295
9296 * gnus-topic.el (gnus-topic-check-topology, gnus-topic-remove-group):
9297 do.
9298
9299 * gnus-sum.el (gnus-summary-fetch-faq, gnus-read-move-group-name):
9300 do.
9301
9302 * gnus-score.el (gnus-score-load-file, gnus-sort-score-files): do.
9303
9304 * gnus-nocem.el (gnus-nocem-scan-groups): do.
9305
9306 * gnus-int.el (gnus-start-news-server): do.
9307
9308 * gnus-group.el (gnus-group-make-kiboze-group)
9309 (gnus-group-browse-foreign-server): do.
9310
93112004-04-22 Teodor Zlatanov <tzz@lifelogs.com>
9312
9313 FIXME: Make separate entries for each person.
9314
9315 From Dan Christensen <jdc@uwo.ca>, asjo@koldfront.dk (Adam
9316 Sj,Ax(Bgren), Wes Hardaker <wes@hardakers.net>, and Michael Shields
9317 <shields@msrl.com>:
9318
9319 * spam.el (spam-necessary-extra-headers): Get the extra headers we
9320 may need for spam sorting and scoring.
9321 (spam-user-format-function-S): Add user format function suitable for
9322 general use.
9323 (spam-article-sort-by-spam-status): Add sorting function for summary
9324 sorting.
9325 (spam-extra-header-to-number): Add function to get a score from a
9326 header.
9327 (spam-summary-score): Add function to get a numeric score from the
9328 headers.
9329 (spam-generic-score): Fixed function doc, was in wrong place.
9330 (spam-initialize): Take symbols when it's run, and install the
9331 extra headers that spam-necessary-extra-headers thinks we need.
9332
93332004-04-21 Teodor Zlatanov <tzz@lifelogs.com>
9334
9335 * spam.el (spam-summary-prepare-exit): Add logic and message fix.
9336 Reported by bojohan+news@dd.chalmers.se (Johan Bockg,Ae(Brd).
9337
93382004-04-17 Jesper Harder <harder@ifa.au.dk>
9339
9340 * gnus-sum.el (gnus-set-global-variables)
9341 (gnus-build-all-threads, gnus-get-newsgroup-headers)
9342 (gnus-article-get-xrefs, gnus-summary-best-group)
9343 (gnus-summary-next-article, gnus-summary-enter-digest-group)
9344 (gnus-summary-set-bookmark, gnus-offer-save-summaries)
9345 (gnus-summary-update-info, gnus-kill-or-deaden-summary): Use
9346 with-current-buffer.
9347
93482004-04-16 Teodor Zlatanov <tzz@lifelogs.com>
9349
9350 * spam.el (spam-summary-prepare-exit): Simplify logic.
9351 (spam-fetch-article-header): Read the article header if it's not
9352 available.
9353 (spam-list-articles): Simplify logic.
9354 (spam-filelist-register-routine): Fix bug with unregister-list.
9355
9356 * gnus-registry.el: Fix comments at beginning.
9357
93582004-04-16 Jesper Harder <harder@ifa.au.dk>
9359
9360 * message.el (message-cater-to-broken-inn): Remove.
9361 (message-shorten-references): Make sure the total folded length of
9362 References is shorter than 998 characters to cater to a bug in INN
9363 2.3. Also, don't pretend that references aren't folded -- this
9364 hasn't worked for a while.
9365
93662004-04-15 Kevin Greiner <kgreiner@xpediantsolutions.com>
9367
9368 * gnus-agent.el (gnus-agentize):
9369 gnus-agent-send-mail-real-function no longer set to current value
9370 of message-send-mail-function but rather a lambda that calls
9371 message-send-mail-function. The change makes the agent real-time
9372 responsive to user changes to message-send-mail-function.
9373
93742004-04-15 Kevin Greiner <kgreiner@xpediantsolutions.com>
9375
9376 * legacy-gnus-agent.el
9377 (gnus-agent-convert-to-compressed-agentview): Fixed typos with
9378 help from Florian Weimer <fw@deneb.enyo.de>
9379
93802004-04-15 Katsumi Yamaoka <yamaoka@jpl.org>
9381
9382 * nnmail.el (nnmail-cache-insert): Revert last change.
9383
93842004-04-14 Katsumi Yamaoka <yamaoka@jpl.org>
9385
9386 * nnmail.el (nnmail-cache-insert): Always check whether
9387 nnmail-cache-ignore-groups matches a group name.
4729 9388
47302004-05-19 Michael Schierl <schierlm-usenet@gmx.de> (tiny change) 93892004-04-13 Teodor Zlatanov <tzz@lifelogs.com>
4731 9390
4732 * pgg-pgp.el (pgg-pgp-verify-region): Default when signature 9391 * spam.el (spam-fetch-field-fast, spam-generate-fake-headers)
4733 isn't a string. 9392 (spam-find-spam, spam-log-processing-to-registry)
9393 (spam-log-registered-p, spam-log-unregistration-needed-p)
9394 (spam-log-undo-registration): Use gnus-message instead of
9395 gnus-error, none of these errors are fatal.
9396
9397 * gnus-registry.el (gnus-registry-clean-empty-function)
9398 (gnus-registry-clean-empty): Remove only empty entries without
9399 extra data.
9400
94012004-04-12 Teodor Zlatanov <tzz@lifelogs.com>
9402
9403 * spam-stat.el (spam-stat-buffer-change-to-spam)
9404 (spam-stat-buffer-change-to-non-spam): Change (error) to
9405 (gnus-message 8) invocation.
9406
94072004-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
9408
9409 * nntp.el (nntp-via-netcat-command): New variable.
9410 (nntp-via-netcat-switches): New variable.
9411 (nntp-open-via-rlogin-and-netcat): New function.
9412 (nntp-open-connection-function): Doc fix.
9413 (nntp-telnet-command): Doc fix.
9414 (nntp-end-of-line): Doc fix.
9415 (nntp-via-rlogin-command): Doc fix.
9416 (nntp-via-user-name): Doc fix.
9417 (nntp-via-address): Doc fix.
9418
94192004-04-09 Katsumi Yamaoka <yamaoka@jpl.org>
9420
9421 * mml2015.el (mml2015-use): Avoid the "Recursive load suspected"
9422 error in Emacs 21.1.
9423
94242004-04-08 Reiner Steib <Reiner.Steib@gmx.de>
9425
9426 * gnus-start.el (gnus-get-unread-articles): Fix last commit.
9427
94282004-04-07 Kevin Greiner <kgreiner@xpediantsolutions.com>
9429 * gnus-agent.el (gnus-agent-total-fetched-hashtb): New variable.
9430 (gnus-agent-with-refreshed-group): New macro.
9431 (gnus-agent-rename-group): New function.
9432 (gnus-agent-delete-group): New function.
9433 (gnus-agent-save-group-info): Use gnus-command-method when
9434 `method' parameter is nil. Don't write nil entries into the
9435 active file.
9436 (gnus-agent-get-group-info): New function.
9437 (gnus-agent-fetch-articles): Use
9438 gnus-agent-update-files-total-fetched-for to increment disk space
9439 used.
9440 (gnus-agent-fetch-headers, gnus-agent-save-alist): Use
9441 gnus-agent-update-view-total-fetched-for to increment disk space
9442 used.
9443 (gnus-agent-get-local): Added optional parameters to avoid calling
9444 gnus-group-real-name and gnus-find-method-for-group.
9445 (gnus-agent-set-local): Delete stored entry if either min, or max,
9446 are nil.
9447 (gnus-agent-fetch-session): Reworded error/quit messages. On
9448 quit, use gnus-agent-regenerate-group to record existance of any
9449 articles fetched to disk before the quit occurred.
9450 (gnus-agent-expire-group-1): Use gnus-agent-with-refreshed-group,
9451 gnus-agent-update-view-total-fetched-for, and
9452 gnus-agent-update-files-total-fetched-for to decrement disk space
9453 used.
9454 (gnus-agent-retrieve-headers): Use
9455 gnus-agent-update-view-total-fetched-for to increment disk space
9456 used.
9457 (gnus-agent-regenerate-group): Replace gnus-group-update-group
9458 with gnus-agent-update-files-total-fetched-for to decrement disk
9459 space and fresh group buffer.
9460 (gnus-agent-inhibit-update-total-fetched-for): New variable.
9461 (gnus-agent-need-update-total-fetched-for): New variable.
9462 (gnus-agent-update-files-total-fetched-for): New function.
9463 (gnus-agent-update-view-total-fetched-for): New function.
9464 (gnus-agent-total-fetched-for): New function.
9465
9466 * gnus-cache.el (gnus-cache-save-buffers): Use
9467 gnus-cache-update-overview-total-fetched-for to change disk space
9468 used by this group.
9469 (gnus-cache-possibly-enter-article): Use
9470 gnus-cache-update-file-total-fetched-for to increment disk space
9471 used by this group.
9472 (gnus-cache-possibly-remove-article): Use
9473 gnus-cache-update-file-total-fetched-for to decrement disk space
9474 used by this group.
9475 (gnus-cache-generate-nov-databases): Purge total fetched cache.
9476 (gnus-cache-rename-group): New function.
9477 (gnus-cache-delete-group): New function.
9478 (gnus-cache-inhibit-update-total-fetched-for): New variable.
9479 (gnus-cache-need-update-total-fetched-for): New variable.
9480 (gnus-cache-with-refreshed-group): New macro.
9481 (gnus-cache-update-file-total-fetched-for): New function.
9482 (gnus-cache-update-overview-total-fetched-for): New function.
9483 (gnus-cache-rename-group-total-fetched-for): New function.
9484 (gnus-cache-delete-group-total-fetched-for): New function.
9485 (gnus-cache-total-fetched-for): New function.
9486
9487 * gnus-group.el: Require gnus-sum and autoload functions to
9488 resolve warnings when gnus-group.el compiled alone.
9489 (gnus-group-line-format): Documented new %F
9490 (size of Fetched data) group line format; identifies disk space
9491 used by agent and cache.
9492 (gnus-group-line-format-alist): Defined new F format.
9493 (gnus-total-fetched-for): New function.
9494 (gnus-group-delete-group): No longer update
9495 gnus-cache-active-altered as gnus-request-delete-group now keeps
9496 the cache in sync.
9497 (gnus-group-list-active): Let the agent store a server's active
9498 list if currently plugged.
9499
9500 * gnus-int.el (gnus-request-delete-group): Use
9501 gnus-cache-delete-group and gnus-agent-delete-group to keep the
9502 local disk in sync with the server.
9503 (gnus-request-rename-group): Use
9504 gnus-cache-rename-group and gnus-agent-rename-group to keep the
9505 local disk in sync with the server.
9506
9507 * gnus-start.el (gnus-get-unread-articles): Cosmetic
9508 simplification to logic.
9509
9510 * gnus-util.el (gnus-rename-file): New function.
9511
95122004-04-07 Christian Neukirchen <chneukirchen@yahoo.de> (tiny change)
9513
9514 * mm-util.el (mm-image-load-path): Handle nil in load-path.
9515
95162004-04-07 Jesper Harder <harder@ifa.au.dk>
9517
9518 * rfc2047.el (rfc2047-encoded-word-regexp): Remove unnecessary
9519 '+'. Reported by Stefan Wiens <s.wi@gmx.net>.
9520
95212004-04-06 Jesper Harder <harder@ifa.au.dk>
9522
9523 * gnus-cache.el (gnus-cache-save-buffers): Check if buffer is
9524 alive. Reported by Laurent Martelli <laurent@aopsys.com>.
9525
95262004-04-03 Jesper Harder <harder@ifa.au.dk>
9527
9528 * gnus.el (gnus-getenv-nntpserver): Strip whitespace.
9529
95302004-04-02 Teodor Zlatanov <tzz@lifelogs.com>
9531
9532 * spam.el (spam-set-difference): Add function to replace
9533 gnus-set-difference in spam.el.
9534 (spam-summary-prepare-exit): Use spam-set-difference.
9535
95362004-03-29 Teodor Zlatanov <tzz@lifelogs.com>
9537
9538 * gnus-registry.el (gnus-registry-cache-file): Update to use
9539 gnus-dribble-directory OR gnus-home-directory OR ~.
9540 (gnus-registry-split-fancy-with-parent): Fix doc.
9541
95422004-03-27 Katsumi Yamaoka <yamaoka@jpl.org>
9543
9544 * message.el (message-exchange-point-and-mark): Use
9545 message-mark-active-p. Suggested by Jesper Harder
9546 <harder@ifa.au.dk>.
9547
95482004-03-26 Katsumi Yamaoka <yamaoka@jpl.org>
9549
9550 * message.el (message-exchange-point-and-mark): Don't activate
9551 region if it was inactive. Suggested by Hiroshi Fujishima
9552 <pooh@nature.tsukuba.ac.jp>.
9553
95542004-03-25 Katsumi Yamaoka <yamaoka@jpl.org>
9555
9556 * gnus-art.el (article-display-face): Display Faces in the same
9557 order as X-Faces.
9558
95592004-03-24 Katsumi Yamaoka <yamaoka@jpl.org>
9560
9561 * nndoc.el (nndoc-forward-type-p): Recognize envelope From_.
9562
95632004-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
9564
9565 * gnus-art.el (gnus-mime-recompute-hierarchical-structure): Remove.
9566 (gnus-mime-multipart-functions): Revert 2004-03-19 change.
9567 (gnus-article-mime-hierarchy): Remove.
9568 (gnus-article-mime-hierarchy-next): Remove.
9569 (gnus-article-mode): Revert 2004-03-19 change.
9570 (gnus-article-setup-buffer): Revert 2004-03-19 change.
9571 (gnus-insert-mime-button): Revert 2004-03-19 change.
9572 (gnus-mime-accumulate-hierarchy): Remove.
9573 (gnus-mime-enter-multipart): Remove.
9574 (gnus-mime-leave-multipart): Remove,
9575 (gnus-mime-display-part): Revert 2004-03-19 change.
9576 (gnus-mime-display-alternative): Revert 2004-03-19 change.
9577
9578 * mml.el (mml-preview): Revert 2004-03-19 change.
9579
95802004-03-18 Helmut Waitzmann <Helmut.Waitzmann@web.de> (tiny change)
9581
9582 * gnus-sum.el (gnus-newsgroup-variables): Doc fix.
9583
95842004-03-22 Katsumi Yamaoka <yamaoka@jpl.org>
9585
9586 * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to
9587 t while entering a file name using the mm-with-multibyte macro.
9588 Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
9589
9590 * mm-util.el (mm-with-multibyte): New macro.
9591
95922004-03-19 Katsumi Yamaoka <yamaoka@jpl.org>
9593
9594 * gnus-art.el (gnus-mime-recompute-hierarchical-structure): New
9595 user option.
9596 (gnus-mime-multipart-functions): Doc and customization fix.
9597 (gnus-article-mime-hierarchy): New variable.
9598 (gnus-article-mime-hierarchy-next): New variable.
9599 (gnus-article-mode): Make gnus-article-mime-hierarchy buffer-local.
9600 (gnus-article-setup-buffer): Set gnus-article-mime-hierarchy and
9601 gnus-article-mime-hierarchy-next to nil.
9602 (gnus-insert-mime-button): Show hierarchy numbers.
9603 (gnus-mime-accumulate-hierarchy): New function.
9604 (gnus-mime-enter-multipart): New function.
9605 (gnus-mime-leave-multipart): New function.
9606 (gnus-mime-display-part): Recompute hierarchical MIME structure.
9607 (gnus-mime-display-alternative): Show hierarchy numbers.
9608
9609 * mml.el (mml-preview): Set gnus-article-mime-hierarchy and
9610 gnus-article-mime-hierarchy-next to nil.
9611
96122004-03-19 Steve Youngs <sryoungs@bigpond.net.au>
9613
9614 * dns.el: Don't require gnus-xmas.
9615
96162004-03-17 Jesper Harder <harder@ifa.au.dk>
9617
9618 * mml.el (mml-generate-mime-1): Don't use format=flowed with
9619 inline PGP.
9620 (mml-menu): Disable mml-quote-region if mark is inactive.
9621
96222004-03-17 Katsumi Yamaoka <yamaoka@jpl.org>
9623
9624 * gnus-agent.el (gnus-agent-regenerate-group): Activate the group
9625 when the group's active is not available.
9626
96272004-03-15 Katsumi Yamaoka <yamaoka@jpl.org>
9628
9629 * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to
9630 error.
9631
96322004-03-12 Reiner Steib <Reiner.Steib@gmx.de>
9633
9634 * imap.el (imap-store-password): New variable.
9635 (imap-interactive-login): Use it.
9636 Suggested by Mark Plaksin <happy@mcplaksin.org>.
9637
96382004-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
9639
9640 * gnus-art.el (gnus-article-read-summary-keys): Restore new
9641 window-start and hscroll to summary window.
9642
96432004-03-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
9644
9645 * gnus-start.el (gnus-convert-old-newsrc): Only write the
9646 conversion message to newsrc-dribble when an actual conversion is
9647 performed.
9648
96492004-03-10 Malcolm Purvis <malcolmpurvis@optushome.com.au> (tiny change)
9650
9651 * spam-stat.el (spam-stat-coding-system): Use mm-coding-system-p.
9652
96532004-03-10 Katsumi Yamaoka <yamaoka@jpl.org>
9654
9655 * mm-decode.el (mm-complicated-handles): New function reviving
9656 former definition of mm-multiple-handles.
9657
9658 * gnus-art.el (gnus-mime-save-part-and-strip): Use it.
9659 (gnus-mime-delete-part): Use it.
9660
96612004-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
9662
9663 * gnus-agent.el (gnus-agent-read-local): Bind
9664 nnheader-file-coding-system to gnus-agent-file-coding-system to
9665 avoid the implicit assumption that they will always be equal.
9666 (gnus-agent-save-local): Bind buffer-file-coding-system, not
9667 coding-system-for-write, as the with-temp-file macro first prints
9668 to a buffer then saves the buffer.
9669
96702004-03-09 Katsumi Yamaoka <yamaoka@jpl.org>
9671
9672 * gnus-art.el (gnus-article-edit-part): New function.
9673 (gnus-mime-save-part-and-strip): Use it; do query instead of
9674 signaling an error; don't use mm-multiple-handles.
9675 (gnus-mime-delete-part): Ditto.
9676
96772004-03-08 Kevin Greiner <kgreiner@xpediantsolutions.com>
9678
9679 * gnus-agent.el (gnus-agent-read-agentview): Removed support for
9680 old file versions.
9681 (gnus-group-prepare-hook): Removed function that converted list
9682 form of gnus-agent-expire-days to group properties.
9683
9684 * gnus-int.el: Autoload gnus-agent-regenerate-group.
9685 (gnus-request-accept-article): Re-indented.
9686
9687 * gnus-start.el (gnus-convert-old-newsrc): Registered new
9688 converters to handle old agent file formats. Added logic for a
9689 "backup before upgrading warning".
9690 (gnus-convert-mark-converter-prompt): Developers can mark
9691 functions as needing (default), or not needing,
9692 gnus-convert-old-newsrc's "backup before upgrading warning".
9693 (gnus-convert-converter-needs-prompt): Tests whether the user
9694 should be protected from potentially irreversable changes by the
9695 function.
9696
9697 * legacy-gnus-agent.el (): New. Provides converters that are only
9698 loaded when gnus-convert-old-newsrc needs to call them.
9699
97002004-03-08 Katsumi Yamaoka <yamaoka@jpl.org>
9701
9702 * mail-source.el (mail-source-touch-pop): Doc fix.
9703
9704 * message.el (message-smtpmail-send-it): Doc fix.
4734 9705
47352004-03-05 Jesper Harder <harder@ifa.au.dk> 97062004-03-05 Jesper Harder <harder@ifa.au.dk>
4736 9707
4737 * sha1-el.el (sha1-maximum-internal-length): Doc fix. 9708 * sha1-el.el (sha1-maximum-internal-length): Doc fix.
4738 9709
9710 * nnmail.el (nnmail-split-fancy): do.
9711
9712 * gnus-kill.el (gnus-kill, gnus-execute): do.
9713
97142004-03-05 Per Abrahamsen <abraham@dina.kvl.dk>
9715
9716 * gnus-sum.el (gnus-widget-reversible-match)
9717 (gnus-widget-reversible-to-internal)
9718 (gnus-widget-reversible-to-external): New functions.
9719 (gnus-widget-reversible): New widget.
9720 (gnus-article-sort-functions, gnus-thread-sort-functions): Use it.
9721
97222004-03-05 Kai Grossjohann <kgrossjo@eu.uu.net>
9723
9724 * gnus-sum.el (gnus-thread-sort-functions)
9725 (gnus-article-sort-functions): Document `(not F)' items.
9726
97272004-03-04 Teodor Zlatanov <tzz@lifelogs.com>
9728
9729 * spam.el (spam-use-gmane-xref): Add new backend.
9730 (spam-gmane-xref-spam-group): Add variable to control the name of the
9731 Gmane spam group.
9732 (spam-blackhole-servers, spam-blackhole-good-server-regex)
9733 (spam-regex-headers-spam, spam-regex-headers-ham)
9734 (spam-regex-body-spam, spam-regex-body-ham): Clarify docs.
9735 (spam-list-of-checks): Add spam-use-gmane-xref to list of
9736 backends and checks.
9737 (spam-check-gmane-xref): Add function for spam-use-gmane-xref.
9738
9739 * gnus.el (spam-autodetect-methods): Add spam-use-gmane-xref as
9740 an autodetect method.
9741
97422004-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
9743
9744 * gnus-int.el (gnus-request-accept-article): Inform the agent that
9745 articles are being added to a group.
9746 (gnus-request-replace-article): Inform the agent that articles
9747 need to be uncached as the cached contents are no longer valid.
9748
47392004-03-04 Katsumi Yamaoka <yamaoka@jpl.org> 97492004-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
4740 9750
9751 * binhex.el: Don't autoload executable-find.
9752
4741 * canlock.el: Don't autoload mail-fetch-field. 9753 * canlock.el: Don't autoload mail-fetch-field.
4742 9754
9755 * gnus-ems.el: Don't autoload appt-select-lowest-window.
9756
9757 * gnus-msg.el: Don't autoload news-reply-mode, news-setup,
9758 rmail-dont-reply-to and rmail-output.
9759
9760 * gnus-score.el: Don't autoload ffap-string-at-point.
9761
9762 * gnus-setup.el: Don't autoload sc-cite-original.
9763
9764 * imap.el: Don't autoload base64-decode-string,
9765 base64-encode-string and md5.
9766
9767 * message.el: Autoload rmail-dont-reply-to, rmail-msg-is-pruned
9768 and rmail-msg-restore-non-pruned-header.
9769
9770 * mm-decode.el: Don't autoload executable-find.
9771
9772 * mm-url.el: Don't autoload executable-find.
9773
9774 * mm-view.el: Don't autoload diff-mode.
9775
9776 * nndb.el: Don't autoload news-reply-mode, news-setup,
9777 cancel-timer and telnet.
9778
9779 * password.el: Don't autoload run-at-time for Emacs.
9780
9781 * sha1-el.el: Don't autoload executable-find.
9782
9783 * sieve-mode.el: Don't autoload c-mode.
9784
9785 * uudecode.el: Don't autoload executable-find.
9786
97872004-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
9788
9789 * gnus-agent.el (gnus-agent-file-header-cache): Removed.
9790 (gnus-agent-possibly-alter-active): Avoid null in numeric
9791 comparison.
9792 (gnus-agent-set-local): Refuse to save null in local object table.
9793 (gnus-agent-regenerate-group): The REREAD parameter can now be a
9794 list of articles that will be marked as unread.
9795
97962004-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
9797
9798 * rfc2047.el (rfc2047-encoded-word-regexp): Mismatched paren.
9799
98002004-03-04 Jesper Harder <harder@ifa.au.dk>
9801
9802 * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231
9803 language tags.
9804
98052004-03-03 Per Abrahamsen <abraham@dina.kvl.dk>
9806
9807 * gnus-agent.el (gnus-agent-read-local, gnus-agent-save-local):
9808 Don't bind "obarray".
9809
9810 * gnus-sum.el (gnus-thread-sort-functions): Added
9811 `gnus-thread-sort-by-most-recent-number' and
9812 `gnus-thread-sort-by-most-recent-date'.
9813 Reported by Kai Grossjohann <kai@emptydomain.de>.
9814
98152004-03-03 Katsumi Yamaoka <yamaoka@jpl.org>
9816
9817 * gnus-cus.el (gnus-agent-customize-category): Mismatched paren.
9818
98192004-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
9820
9821 * gnus-cus.el (gnus-agent-customize-category): Removed
9822 ignore-errors macro reference that required cl to be loaded at
9823 run-time.
9824
9825 * gnus-range.el (gnus-sorted-range-intersection): Now accepts
9826 single-interval range of the form (min . max). Previously the
9827 range had to look like ((min . max)). Likewise, return
9828 (min . max) rather than ((min . max)).
9829 (gnus-range-map): Use gnus-range-normalize to accept
9830 single-interval range.
9831
9832 * gnus-sum.el (gnus-summary-highlight-line): Articles stored in
9833 the cache, but not the agent, now appear with their usual face.
9834
98352004-03-01 Katsumi Yamaoka <yamaoka@jpl.org>
9836
9837 * gnus-art.el (gnus-article-wash-html-with-w3m): Don't make the
9838 w3m-safe-url-regexp variable buffer-local.
9839
9840 * mm-view.el (mm-inline-text-html-render-with-w3m): Ditto.
9841
98422004-02-27 Simon Josefsson <jas@extundo.com>
9843
9844 * gnus-sum.el (gnus-move-group-prefix-function): Add, default to
9845 gnus-group-real-prefix.
9846 (gnus-summary-move-article): Use it, instead of
9847 gnus-group-real-prefix.
9848
98492004-02-27 Katsumi Yamaoka <yamaoka@jpl.org>
9850
9851 * gnus-art.el (gnus-article-wash-html-with-w3m): Make the
9852 w3m-safe-url-regexp variable buffer-local and set it as the value
9853 of mm-w3m-safe-url-regexp.
9854
9855 * mm-view.el (mm-inline-text-html-render-with-w3m): Ditto.
9856
9857 * gnus-msg.el (gnus-setup-message): Ignore an article copy while
9858 parsing gnus-posting-styles when the message is not for replying.
9859
9860 * nnrss.el (nnrss-opml-export): Use
9861 mm-set-buffer-file-coding-system instead of
9862 set-buffer-file-coding-system.
9863
98642004-02-27 Jesper Harder <harder@ifa.au.dk>
9865
9866 * spam-stat.el: Pedantic docstring and whitespace fixes (courtesy
9867 of checkdoc.el).
9868 * nnrss.el: do.
9869 * gnus-mlspl.el: do.
9870 * gnus-ml.el: do.
9871 * gnus-srvr.el: do.
9872
9873 * nnrss.el (nnrss-opml-export): Turn on sgml-mode.
9874
98752004-02-27 Kevin Ryde <user42@zip.com.au> (tiny change)
9876
9877 * gnus.el (gnus-group, gnus-summary, gnus-summary-sort):
9878 Corrections to custom-manual links.
9879
9880 * gnus-art.el (gnus-article): Ditto.
9881
9882 * mm-decode.el (mime-display, mime-security): Ditto.
9883
98842004-02-26 Jesper Harder <harder@ifa.au.dk>
9885
9886 * flow-fill.el: Typo.
9887
98882004-02-26 Andrew Cohen <cohen@andy.bu.edu>
9889
9890 * spam-wash.el: New file.
9891
98922004-02-26 Mark A. Hershberger <mah@everybody.org>
9893
9894 * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions.
9895
98962004-02-26 Teodor Zlatanov <tzz@lifelogs.com>
9897
9898 * spam.el (spam-summary-prepare-exit): Fix gnus-set-difference: needs
9899 to be run with new-articles as LIST1, not LIST2.
9900 (spam-registration-functions): Add spam-use-ham-copy as a nil
9901 registration backend.
9902
99032004-02-26 Jesper Harder <harder@ifa.au.dk>
9904
9905 * spam-stat.el (spam-stat-washing-hook): New option.
9906 (spam-stat-buffer-words): Use it.
9907 (spam-stat-process-directory, spam-stat-test-directory): Use
9908 insert-file-contents-literally.
9909 (spam-stat-coding-system): New variable.
9910 (spam-stat-load, spam-stat-save): Use it.
9911
99122004-02-25 Katsumi Yamaoka <yamaoka@jpl.org>
9913
9914 * spam-report.el (spam-report-plug-agent): Quote
9915 spam-report-url-to-file and spam-report-url-ping-plain.
9916
99172004-02-25 Reiner Steib <Reiner.Steib@gmx.de>
9918
9919 * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Allow
9920 / in mailto URLs.
9921
99222004-02-24 Reiner Steib <Reiner.Steib@gmx.de>
9923
9924 * spam-report.el (spam-report-process-queue): Fix interactive use.
9925 (spam-report-url-ping-temp-agent-function, spam-report-plug-agent)
9926 (spam-report-unplug-agent): Doc fixes.
9927 (spam-report-url-ping-mm-url, spam-report-url-to-file)
9928 (spam-report-agentize, spam-report-deagentize): Autoload
9929
99302004-02-24 Katsumi Yamaoka <yamaoka@jpl.org>
9931
9932 * message.el (message-setup-fill-variables): Add mml tags to
9933 paragraph-start and paragraph-separate. Suggested by Andrew Korty
9934 <ajk@iu.edu>.
9935 (message-mode): Don't modify paragraph-separate there.
9936
99372004-02-17 Katsumi Yamaoka <yamaoka@jpl.org>
9938
9939 * compface.el (uncompface-use-external): Default to undecided.
9940 (uncompface-use-external-threshold): New variable.
9941 (uncompface-float-time): New macro.
9942 (uncompface): Determine whether to use the external decoder if
9943 uncompface-use-external is undecided.
9944
99452004-02-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
9946
9947 * mm-view.el (mm-inline-image-emacs): Don't insert blank lines
9948 after images.
9949
9950 * gnus-art.el (gnus-mime-display-single): Remove dead code.
9951
99522004-02-14 Jesper Harder <harder@ifa.au.dk>
9953
9954 * nnrss.el (nnrss-request-article, nnrss-find-el): Cleanup.
9955
9956 * html2text.el (html2text-get-attr, html2text-fix-paragraph): do
9957
9958 * gnus-sum.el (gnus-summary-limit-to-age)
9959 (gnus-summary-limit-children): do.
9960
9961 * gnus-int.el (gnus-request-scan): do.
9962
9963 * gnus-group.el (gnus-group-suspend): do.
9964
9965 * gnus-cus.el (gnus-agent-cat-prepare-category-field): do.
9966
9967 * gnus-cite.el (gnus-cite-parse-attributions): do.
9968
9969 * gnus-agent.el (gnus-summary-set-agent-mark)
9970 (gnus-agent-regenerate-group): do.
9971
9972 * deuglify.el (gnus-article-outlook-unwrap-lines): do.
9973
9974 * binhex.el (binhex-decode-region-internal): do.
9975
99762004-02-12 Katsumi Yamaoka <yamaoka@jpl.org>
9977
9978 * gnus-fun.el (gnus-face-properties-alist): New user option.
9979 (gnus-display-x-face-in-from): Use it.
9980
9981 * gnus-art.el (article-display-face): Ditto.
9982
9983 * compface.el (uncompface-use-external): Default to nil.
9984
99852004-02-12 Jesper Harder <harder@ifa.au.dk>
9986
9987 * nntp.el (nntp-erase-buffer): New function.
9988 (nntp-retrieve-data, nntp-send-command)
9989 (nntp-send-buffer, nntp-retrieve-groups, nntp-handle-authinfo)
9990 (nntp-possibly-change-group): Use it.
9991
9992 * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Use
9993 with-current-buffer.
9994
99952004-02-12 TAKAI Kousuke <tak@kmc.gr.jp>
9996
9997 * compface.el: Merge the ELisp-based uncompface program.
9998 (compface): New customization group.
9999 (uncompface-use-external): New user option.
10000 (uncompface): Call uncompface-internal if uncompface-use-external
10001 is nil.
10002 (uncompface-internal): New function. Note that there are also
10003 some other functions and variables added for this function.
10004
100052004-02-10 Jesper Harder <harder@ifa.au.dk>
10006
10007 * nnrss.el (nnrss-read-group-data): Initialize nnrss-group-hashtb
10008 if necessary.
10009
100102004-02-09 Teodor Zlatanov <tzz@lifelogs.com>
10011
10012 * spam-report.el (spam-report-unplug-agent)
10013 (spam-report-plug-agent, spam-report-deagentize)
10014 (spam-report-agentize, spam-report-url-ping-temp-agent-function):
10015 Add support for the Agent in spam-report: when unplugged, report to a
10016 file; when plugged, submit all the requests.
10017
10018 * spam.el (spam-register-routine): Fix message about
10019 registration.
10020
100212004-02-09 Jesper Harder <harder@ifa.au.dk>
10022
10023 * rfc2047.el (rfc2047-qp-or-base64): New function to reduce
10024 dependencies.
10025 (rfc2047-encode): Use it.
10026
10027 * gnus-art.el (gnus-button-marker-list): Move before first
10028 reference.
10029
10030 * imap.el (imap-parse-flag-list, imap-parse-body-extension)
10031 (imap-parse-body): Fix format string mismatch.
10032
10033 * gnus-score.el (gnus-summary-increase-score): do.
10034
10035 * nnrss.el (nnrss-close): New function.
10036
100372004-02-08 Jesper Harder <harder@ifa.au.dk>
10038
10039 * nnrss.el (nnrss-make-filename): New function.
10040 (nnrss-request-delete-group, nnrss-read-server-data)
10041 (nnrss-save-server-data, nnrss-read-group-data)
10042 (nnrss-save-group-data): Use it.
10043 (nnrss-save-server-data, nnrss-save-group-data): Use gnus-prin1.
10044 (nnrss-read-server-data, nnrss-read-group-data): Use load.
10045 (nnrss-group-hashtb): Make it a hash table rather than an obarray.
10046
100472004-02-07 Jesper Harder <harder@ifa.au.dk>
10048
10049 * mml.el (mml-compute-boundary-1): Don't uncompress files.
10050
100512004-02-06 Jesper Harder <harder@ifa.au.dk>
10052
10053 * mml.el (mml-mode, mml-x-dnd-attach-file): Attach drop and drag
10054 files.
10055
10056 * message.el (message-generate-headers-first): Don't quote nil
10057 and t in docstrings.
10058
10059 * imap.el (imap-id): do.
10060
10061 * gnus-agent.el (gnus-agent-consider-all-articles)
10062 (gnus-agent-queue-mail): do.
10063
100642004-02-05 Reiner Steib <Reiner.Steib@gmx.de>
10065
10066 * spam-report.el (spam-report-process-queue): New function.
10067 Process requests from `spam-report-requests-file'.
10068 (spam-report-process-queue): Doc fix.
10069
100702004-02-05 Teodor Zlatanov <tzz@lifelogs.com>
10071
10072 * spam.el (spam-register-routine)
10073 (spam-log-processing-to-registry, spam-log-registered-p)
10074 (spam-log-unregistration-needed-p, spam-log-undo-registration):
10075 Change "check" to "spam-check" for semi-clarity.
10076
100772004-02-05 Jesper Harder <harder@ifa.au.dk>
10078
10079 * pop3.el: Require nnheader.
10080
10081 * mml-smime.el: Require cl. Autoload message-fetch-field.
10082
10083 * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus.
10084
10085 * gnus-picon.el: Require cl.
10086
10087 * gnus-fun.el: Require gnus-ems and gnus-util.
10088
10089 * gnus.el (gnus-method-to-server): Move defsubst before first use.
10090
10091 * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr
10092
10093 * gnus-art.el (gnus-article-edit-mode): Define before first
10094 reference.
10095
100962004-02-04 Jesper Harder <harder@ifa.au.dk>
10097
10098 * gnus-uu.el (gnus-uu-check-correct-stripped-uucode): Simplify.
10099 (gnus-uu-post-encoded): Use point-at-bol.
10100
10101 * gnus-topic.el (gnus-group-active-topic-p): do.
10102
10103 * gnus-start.el (gnus-newsrc-to-gnus-format): do.
10104
10105 * gnus-group.el (gnus-group-kill-region): do.
10106
10107 * gnus-art.el (article-date-ut): do.
10108
10109 * message.el (message-fetch-field): Remove redundant
10110 case-fold-search binding.
10111 (message-narrow-to-field): Simplify.
10112
101132004-02-03 Reiner Steib <Reiner.Steib@gmx.de>
10114
10115 * spam.el (spam-directory): Derive from `gnus-directory'.
10116
10117 * spam-report.el (spam-report-url-to-file)
10118 (spam-report-requests-file): New function and variable for offline
10119 reporting.
10120 (spam-report-url-ping-function): Add `spam-report-url-to-file'
10121 and user defined function.
10122 (spam-report-url-ping-mm-url): Remove doubled slash.
10123
101242004-02-03 Teodor Zlatanov <tzz@lifelogs.com>
10125
10126 * spam.el (spam-list-of-processors): Fix spamassassin variable names.
10127
101282004-02-03 Jesper Harder <harder@ifa.au.dk>
10129
10130 * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Fix
10131 format string mismatch.
10132
10133 * sieve.el (sieve-deactivate-all): do.
10134
10135 * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): do.
10136
10137 * nnlistserv.el (nnlistserv-kk-wash-article): do.
10138
10139 * nnml.el (nnml-request-set-mark, nnml-save-marks): do.
10140
10141 * mm-bodies.el (mm-7bit-chars): Don't include \r.
10142
101432004-02-02 Teodor Zlatanov <tzz@lifelogs.com>
10144
10145 * spam.el (spam-list-of-checks): Add spam-use-BBDB-eclusive to
10146 the list of checks.
10147
101482004-01-31 Jesper Harder <harder@ifa.au.dk>
10149
10150 * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid
10151 padding.
10152
101532004-01-27 Ralf Angeli <angeli@iwi.uni-sb.de>
10154
10155 * mm-view.el (mm-fill-flowed): New variable.
10156 (mm-inline-text): Use it.
10157
101582004-01-27 Teodor Zlatanov <tzz@lifelogs.com>
10159
10160 * spam.el (spam-spamassassin-register-ham-routine)
10161 (spam-spamassassin-register-spam-routine): Fix function names.
10162
101632004-01-27 Katsumi Yamaoka <yamaoka@jpl.org>
10164
10165 * gnus.el (gnus-tmp-grouplens): Remove.
10166 (gnus-summary-line-format): Remove grouplens.
10167
10168 * gnus-group.el (gnus-group-line-format): Ditto.
10169
10170 * gnus-spec.el (gnus-format-specs): Ditto.
10171 (gnus-update-format-specifications): Flush the group format spec
10172 cache if there's the grouplens stuff.
10173 (gnus-parse-simple-format): Replace %l with the empty string.
10174
101752004-01-27 Jerry James <james@xemacs.org> (tiny change)
10176
10177 * gnus-spec.el (gnus-parse-simple-format): Fix setq value
10178 omission.
10179
101802004-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
10181
10182 * gnus-msg.el (gnus-summary-resend-message-edit): Call mime-to-mml.
10183 Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
10184
101852004-01-25 Paul Jarc <prj@po.cwru.edu>
10186
10187 * nnmaildir.el (nnmaildir--num-file, nnmaildir--mkfile,
10188 nnmaildir--emlink-p, nnmaildir--eexist-p, nnmaildir--new-number):
10189 New macros and functions.
10190 * nnmaildir.el (nnmaildir--group-maxnum, nnmaildir--update-nov):
10191 Handle > NLINK_MAX messages.
10192 * nnmaildir.el (nnmaildir-request-set-mark): Use
10193 nnmaildir--emlink-p and nnmaildir--eexist-p.
10194
101952004-01-25 Alex Schroeder <alex@gnu.org>
10196
10197 * spam-stat.el (spam-stat-process-directory-age): New option.
10198 (spam-stat-process-directory): Use it.
10199
102002004-01-24 Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp> (tiny change)
10201
10202 * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty.
10203 (spam-stat-save): Accept prefix argument.
10204
102052004-01-23 Paul Jarc <prj@po.cwru.edu>
10206
10207 * nnmaildir.el (nnmaildir-request-set-mark): Handle the "too many
10208 links" error.
10209
102102004-01-23 Jesper Harder <harder@ifa.au.dk>
10211
10212 * gnus.el (gnus-tmp-grouplens): Define for the sake of backward
10213 compatibility with old .newsrc.eld files.
10214
10215 * gnus-sum.el (gnus-summary-line-format-alist): Remove grouplens.
10216
10217 * gnus-start.el (gnus-1): do.
10218
10219 * gnus-group.el (gnus-group-line-format-alist): do.
10220
10221 * gnus.el (gnus-use-grouplens, gnus-visual): do.
10222
10223 * gnus-gl.el: Remove.
10224
102252004-01-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
10226
10227 * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of
10228 marks consisting of a single range {for example, (3 . 5)} rather
10229 than a list of a single range { ((3 . 5)) }.
10230
102312004-01-23 Jesper Harder <harder@ifa.au.dk>
10232
10233 * spam-stat.el (spam-stat-store-gnus-article-buffer): Use
10234 with-current-buffer.
10235 (spam-stat-store-current-buffer): Use insert-buffer-substring to
10236 avoid consing a string.
10237
10238 * mm-util.el (mm-charset-synonym-alist): Add ks_c_5601-1987.
10239 Remove obsolete entries for big5 and gb2312.
10240
102412004-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
10242
10243 * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the
10244 uncompressed list.
10245
102462004-01-22 Jesper Harder <harder@ifa.au.dk>
10247
10248 * spam-stat.el (spam-stat-strip-xref): New function.
10249 (spam-stat-process-directory): Use it.
10250
10251 * gnus-util.el (gnus-fetch-field): Don't bind case-fold-search
10252 here -- it's done in message-fetch-field.
10253
102542004-01-21 Kevin Greiner <kgreiner@xpediantsolutions.com>
10255
10256 * gnus-agent.el (gnus-agent-queue-mail,
10257 gnus-agent-prompt-send-queue): New variables.
10258 (gnus-agent-send-mail): Use gnus-agent-queue-mail.
10259 * gnus-draft.el (gnus-group-send-queue): Pass the group name
10260 "nndraft:queue" along to gnus-draft-send. Use
10261 gnus-agent-prompt-send-queue.
10262 (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group
10263 is "nndraft:queue". Suggested by Gaute Strokkenes
10264 <gs234@srcf.ucam.org>
10265
10266 * gnus-agent.el (agent-disable-undownloaded-faces): Removed
10267 (agent-enable-undownloaded-faces): Added
10268 (gnus-agent-cat-groups): Use eval-and-compile, not
10269 eval-when-compile, to define gnus-agent-set-cat-groups as the setf
10270 method of gnus-agent-cat-groups even when the buffer has been
10271 evaled.
10272 (gnus-agent-save-active,gnus-agent-save-active-1): Merged to
10273 delete gnus-agent-save-active-1.
10274 (gnus-agent-save-groups): Deleted. Identical to
10275 gnus-agent-save-active.
10276 (gnus-agent-write-active): No longer adjust agent's copy of active
10277 file as agent's adjustments are now stored in their own
10278 file. Removed optional parameter.
10279 (gnus-agent-possibly-alter-active): Ignore groups of unagentized
10280 servers. Add use of min/max range limits from server's local
10281 file.
10282 (gnus-agent-save-alist): Removed unused optional argument.
10283 (gnus-agent-load-local,gnus-agent-read-and-cache-local),
10284 (gnus-agent-read-local,gnus-agent-save-local,gnus-agent-get-local),
10285 (gnus-agent-set-local): A per-server file that keeps min/max range
10286 limits for articles known to the agent. Provides a fast mechanism
10287 for altering many active ranges.
10288 (gnus-agent-expire-group,gnus-agent-expire): No longer save the
10289 active file (local makes it unnecessary).
10290 (gnus-agent-regenerate-group): Fixed XEmacs compatibility.
10291
10292 * gnus-cus.el (agent-disable-undownloaded-faces): Removed
10293 (agent-enable-undownloaded-faces): Added
10294
10295 * gnus-draft.el (gnus-draft-send): Bind gnus-agent-queue-mail to
10296 disable it when sending to "nndraft:queue".
10297 (gnus-group-send-queue): Add safety check to avoid sending queue
10298 when unplugged.
10299
10300 * gnus-group.el (gnus-group-catchup): Use new
10301 gnus-sequence-of-unread-articles, not
10302 gnus-list-of-unread-articles, to avoid exhausting memory with huge
10303 numbers of articles. Use gnus-range-map to avoid having to
10304 uncompress the unread list.
10305 (gnus-group-archive-directory,
10306 gnus-group-recent-archive-directory): Fixed invalid ange-ftp
10307 reference.
10308
10309 * gnus-range.el (gnus-range-map): Iterate over list or sequence.
10310 (gnus-sorted-range-intersection): Intersection of two ranges
10311 without requiring that they first be uncompressed.
10312
10313 * gnus-start.el (gnus-activate-group): Unless blocked by the
10314 caller, possibly expand the active range to include both cached
10315 and agentized articles.
10316 (gnus-convert-old-newsrc): Rewrote in anticipation of having
10317 multiple version-dependent converters.
10318 (gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with
10319 gnus-agent-save-active.
10320 (gnus-save-newsrc-file): Save dirty agent range limits.
10321
10322 * gnus-sum.el (gnus-select-newgroup): Replaced inline code with
10323 gnus-agent-possibly-alter-active.
10324 (gnus-adjust-marked-articles): Faster handling of simple lists
10325
103262004-01-21 Jesper Harder <harder@ifa.au.dk>
10327
10328 * spam-stat.el (spam-stat-test-directory): New optional argument
10329 displays a list of files detected. Suggested by Andrew Cohen
10330 <cohen@andy.bu.edu>.
10331 (spam-stat-buffer-words-with-scores): Don't narrow and change
10332 syntax table here. Reported by Andrew Cohen <cohen@andy.bu.edu>.
10333
103342004-01-20 Hubert Chan <hubert@uhoreg.ca>:
10335
10336 * spam.el (spam-use-spamassassin, spam-use-spamassassin-headers)
10337 (spam-install-hooks, spam-spamassassin, spam-spamassassin-path)
10338 (spam-spamassassin-arguments)
10339 (spam-spamassassin-spam-flag-header)
10340 (spam-spamassassin-positive-spam-flag-header)
10341 (spam-spamassassin-spam-status-header, spam-sa-learn-path)
10342 (spam-sa-learn-rebuild, spam-sa-learn-spam-switch)
10343 (spam-sa-learn-ham-switch, spam-sa-learn-unregister-switch)
10344 (spam-list-of-processors, spam-list-of-checks)
10345 (spam-list-of-statistical-checks, spam-registration-functions)
10346 (spam-check-spamassassin-headers, spam-check-spamassassin)
10347 (spam-spamassassin-score)
10348 (spam-spamassassin-register-with-sa-learn)
10349 (spam-spamassassin-register-spam-routine)
10350 (spam-spamassassin-register-ham-routine)
10351 (spam-assassin-register-spam-routine)
10352 (spam-assassin-register-ham-routine): add SpamAssassin support
10353 (spam-bogofilter-score): fix to show article before scoring
10354
103552004-01-20 Teodor Zlatanov <tzz@lifelogs.com>
10356
10357 * spam.el (gnus-summary-mode-map): Make spam-generic-score the
10358 default scoring function.
10359 (spam-generic-score): Call spam-spamassassin-score if
10360 spam-use-spamassassin or spam-use-spamassassin-headers is on;
10361 spam-bogofilter-score otherwise.
10362
10363 * gnus.el (spam-process, spam-autodetect-methods): Add
10364 spamassassin and spamassassin-headers.
10365
103662004-01-20 Nevin Kapur <nkapur@cs.caltech.edu>
10367
10368 * gnus-registry.el (gnus-registry-split-fancy-with-parent):
10369 Suppress unnecessary messages.
10370
103712004-01-20 Jesper Harder <harder@ifa.au.dk>
10372
10373 * spam-stat.el (spam-stat-to-hash-table): Use :size keyword in
10374 make-hash-table.
10375
47432004-01-19 Katsumi Yamaoka <yamaoka@jpl.org> 103762004-01-19 Katsumi Yamaoka <yamaoka@jpl.org>
4744 10377
4745 * canlock.el (base64-encode-string): Don't autoload it. 10378 * canlock.el (base64-encode-string): Don't autoload it.
4746 10379
103802004-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
10381
10382 * run-at-time.el: Remove useless (require 'itimer),
10383 eval-and-compile and (featurep 'xemacs).
10384
103852004-01-16 Jesper Harder <harder@ifa.au.dk>
10386
10387 * gnus-msg.el (gnus-post-news): Use blank Newsgroups line if
10388 GROUP is a virtual group.
10389
103902004-01-16 Steve Youngs <sryoungs@bigpond.net.au>
10391
10392 * gnus.el: Autoload `message-y-or-n-p'.
10393
103942004-01-15 Jesper Harder <harder@ifa.au.dk>
10395
10396 * pgg-parse.el: Remove unnecessary (require 'custom).
10397
10398 * pgg-def.el: do.
10399
10400 * nnmail.el: do.
10401
10402 * gnus-undo.el: do.
10403
10404 * gnus-picon.el: do.
10405
10406 * gnus-util.el: do.
10407
104082004-01-15 Reiner Steib <Reiner.Steib@gmx.de>
10409
10410 * gnus-sum.el (gnus-pick-line-number): Add autoload.
10411
104122004-01-15 Katsumi Yamaoka <yamaoka@jpl.org>
10413
10414 * mm-decode.el (mm-multiple-handles): Recognize a string as a mime
10415 handle, as well as a list.
10416
10417 * mm-view.el (mm-w3m-cid-retrieve-1): Call itself recursively.
10418 Suggested by ARISAWA Akihiro <ari@mbf.sphere.ne.jp>.
10419 (mm-w3m-cid-retrieve): Simplify.
10420
104212004-01-14 Vasily Korytov <deskpot@myrealbox.com>
10422
10423 * message.el (message-kill-to-signature): Allow prefix arg to
10424 specify number of lines to keep before signature.
10425
104262004-01-14 Kai Grossjohann <kai@emptydomain.de>
10427
10428 (message-kill-to-signature): Change docstring.
10429
47472004-01-14 Katsumi Yamaoka <yamaoka@jpl.org> 104302004-01-14 Katsumi Yamaoka <yamaoka@jpl.org>
4748 10431
4749 * canlock.el: Always require sha1-el. 10432 * canlock.el: Always require sha1-el.
4750 (canlock-sha1): Bind sha1-maximum-internal-length to nil. 10433 (canlock-sha1): Bind sha1-maximum-internal-length to nil.
4751 10434
10435 * message.el: Autoload sha1 only when compiling.
10436
47522004-01-13 Katsumi Yamaoka <yamaoka@jpl.org> 104372004-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
4753 10438
4754 * message.el (message-canlock-generate): Require sha1-el. 10439 * message.el (message-canlock-generate): Require sha1-el.
4755 10440
104412004-01-13 Jesper Harder <harder@ifa.au.dk>
10442
10443 * message.el (message-expand-name): Silence the byte compiler.
10444
104452004-01-13 Simon Josefsson <jas@extundo.com>
10446
10447 * gnus-score.el (gnus-score-edit-all-score): Fix prototype.
10448 Invoke gnus-score-mode. Reported by
10449 bojohan+news@dd.chalmers.se (Johan Bockg,Ae(Brd).
10450
10451 * gnus-range.el (gnus-compress-sequence): Doc fix. Suggested by
10452 Jim Blandy <jimb@redhat.com> (tiny change).
10453
104542004-01-12 Jesper Harder <harder@ifa.au.dk>
10455
10456 * gnus-srvr.el (gnus-browse-foreign-server): Reduce consing.
10457
104582004-01-12 Teodor Zlatanov <tzz@lifelogs.com>
10459
10460 * spam.el (spam-get-article-as-string): Update to use
10461 gnus-request-article-this-buffer, much simpler.
10462 (spam-get-article-as-buffer): Remove.
10463
104642004-01-12 Kai Grossjohann <kai.grossjohann@mci.com>
10465
10466 * message.el (message-expand-name): Use EUDC if the user uses
10467 that.
10468
104692004-01-12 Jesper Harder <harder@ifa.au.dk>
10470
10471 * rfc2047.el (rfc2047-parse-and-decode, rfc2047-decode): Use a
10472 character for the encoding to avoid consing a string.
10473
10474 * rfc2047.el (rfc2047-decode-string): Don't cons a string
10475 unnecessarily.
10476
10477 * mm-util.el (mm-replace-chars-in-string): Remove.
10478
10479 * rfc2047.el (rfc2047-decode): Use mm-subst-char-in-string instead
10480 of mm-replace-chars-in-string.
10481
104822004-01-11 Jesper Harder <harder@ifa.au.dk>
10483
10484 * gnus.sum.el (gnus-remove-odd-characters): Don't cons two new
10485 strings.
10486
10487 * mm-util.el (mm-subst-char-in-string): Support inplace.
10488
10489 * gnus-sum.el (gnus-summary-remove-list-identifiers): Don't cons
10490 a new string in every iteration. Use shy groups.
10491
104922004-01-10 Jesper Harder <harder@ifa.au.dk>
10493
10494 * gnus-start.el (gnus-subscribe-newsgroup, gnus-start-draft-setup)
10495 (gnus-group-change-level, gnus-kill-newsgroup)
10496 (gnus-check-bogus-newsgroups, gnus-get-unread-articles-in-group)
10497 (gnus-get-unread-articles, gnus-make-articles-unread)
10498 (gnus-make-ascending-articles-unread): Use accessor
10499 macros (gnus-group-entry, gnus-group-unread, gnus-info-marks etc.)
10500 to get group information for improved readability.
10501
10502 * gnus-srvr.el (gnus-browse-unsubscribe-group): do.
10503
10504 * gnus-soup.el (gnus-soup-group-brew): do.
10505
10506 * gnus-msg.el (gnus-put-message): do.
10507
10508 * gnus-move.el (gnus-group-move-group-to-server): do.
10509
10510 * gnus-kill.el (gnus-batch-score): do.
10511
10512 * gnus-group.el (gnus-group-prepare-flat, gnus-group-delete-group)
10513 (gnus-group-update-group-line, gnus-group-insert-group-line-info)
10514 (gnus-group-update-group, gnus-group-read-group)
10515 (gnus-group-make-group, gnus-group-make-help-group)
10516 (gnus-group-make-archive-group, gnus-group-make-directory-group)
10517 (gnus-group-make-empty-virtual, gnus-group-sort-selected-flat)
10518 (gnus-group-sort-by-unread, gnus-group-catchup)
10519 (gnus-group-unsubscribe-group, gnus-group-kill-group)
10520 (gnus-group-yank-group, gnus-group-set-info)
10521 (gnus-group-list-groups): do.
10522
10523 * gnus.el (gnus-generate-new-group-name): do.
10524
10525 * gnus-delay.el (gnus-delay-send-queue): do.
10526
10527 * nnvirtual.el (nnvirtual-catchup-group): do.
10528
10529 * nnkiboze.el (nnkiboze-generate-group, nnkiboze-generate-group):
10530 do.
10531
10532 * gnus-topic.el (gnus-topic-find-groups, gnus-topic-clean-alist)
10533 (gnus-group-prepare-topics, gnus-topic-check-topology): do.
10534
10535 * gnus-sum.el (gnus-update-read-articles, gnus-select-newsgroup)
10536 (gnus-mark-xrefs-as-read, gnus-compute-read-articles)
10537 (gnus-summary-walk-group-buffer, gnus-summary-move-article)
10538 (gnus-group-make-articles-read): do.
10539
105402004-01-09 Jesper Harder <harder@ifa.au.dk>
10541
10542 * gnus-art.el (article-decode-mime-words, article-babel)
10543 (gnus-article-highlight-signature, gnus-article-add-buttons)
10544 (gnus-signature-toggle): Use gnus-with-article-buffer.
10545
10546 * gnus-art.el (gnus-article-highlight-headers)
10547 (gnus-article-add-buttons-to-head): Use gnus-with-article-headers.
10548
10549 * gnus-art.el (gnus-mm-display-part, gnus-article-wash-status)
10550 (gnus-article-set-globals, gnus-request-article-this-buffer)
10551 (gnus-button-message-id, gnus-article-maybe-hide-headers)
10552 (gnus-mime-view-part-externally, gnus-mime-view-part-internally)
10553 (gnus-mime-display-alternative): Use with-current-buffer.
10554
105552004-01-09 Teodor Zlatanov <tzz@lifelogs.com>
10556
10557 * spam.el (spam-generate-fake-headers): Rewrite to be simpler,
10558 also under 80 char limit, and call gnus-error if needed.
10559 (spam-fetch-article-header): Fix - it was a
10560 buffer-local variable (gnus-newsgroup-data).
10561 (spam-find-spam): Use spam-generate-fake-headers, forget about
10562 spam-insert-fake-headers.
10563 (spam-insert-fake-headers): Remove.
10564
105652004-01-09 Jesper Harder <harder@ifa.au.dk>
10566
10567 * deuglify.el (gnus-article-outlook-unwrap-lines)
10568 (gnus-outlook-rearrange-article)
10569 (gnus-outlook-repair-attribution-outlook)
10570 (gnus-outlook-repair-attribution-block)
10571 (gnus-outlook-repair-attribution-other): Remove redundant
10572 save-excursion.
10573
105742004-01-09 Teodor Zlatanov <tzz@lifelogs.com>
10575
10576 * spam.el (spam-fetch-field-fast, spam-fetch-field-from-fast)
10577 (spam-fetch-field-subject-fast)
10578 (spam-fetch-field-message-id-fast, spam-generate-fake-headers)
10579 (spam-fetch-article-header): Add functions to deal with Gnus
10580 internals for fast retrieval of article header data.
10581 (spam-initialize): Put spam-find-spam in the gnus-summary-prepared-hook.
10582
105832004-01-09 Jesper Harder <harder@ifa.au.dk>
10584
10585 * pop3.el (pop3-md5): Remove.
10586 (pop3-apop): Replace pop3-md5 with md5.
10587
10588 * mm-bodies.el: base64 is always built-in.
10589
10590 * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use
10591 with-current-buffer.
10592
47562004-01-08 Katsumi Yamaoka <yamaoka@jpl.org> 105932004-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
4757 10594
4758 * canlock.el (canlock-insert-header): Remove excessive grouping in 10595 * canlock.el (canlock-insert-header): Remove excessive grouping in
4759 regexp. 10596 regexp.
4760 10597
10598 * gnus-sum.el (gnus-summary-read-document): Ditto.
10599
10600 * gnus-uu.el (gnus-uu-part-number): Ditto.
10601
10602 * html2text.el (html2text-remove-tags): Ditto.
10603 (html2text-format-tags): Ditto.
10604 (html2text-format-single-elements): Ditto.
10605
10606 * mml.el (mml-parse-1): Ditto.
10607
106082004-01-08 Jesper Harder <harder@ifa.au.dk>
10609
10610 * gnus-sum.el (gnus-summary-update-mark): Revert previous change.
10611
10612 * gnus-group.el (gnus-group-mark-group): Fix for multibyte marks.
10613
10614 * gnus-sum.el (gnus-summary-update-mark): Fix for multibyte marks.
10615
10616 * gnus-util.el (gnus-replace-in-string): Remove Emacs 20 code.
10617
106182003-11-15 Simon Josefsson <jas@extundo.com>
10619
10620 * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys)
10621 (pgg-gpg-lookup-key): Use regexp match instead of
10622 split-string (split-string is different between emacs 21.2 and
10623 22.1). Reported by ultrasoul@ultrasoul.com (David D. Smith).
10624
106252004-01-08 Jesper Harder <harder@ifa.au.dk>
10626
10627 * gnus-art.el (gnus-mime-view-all-parts)
10628 (gnus-article-part-wrapper, gnus-article-view-part): Use
10629 with-current-buffer.
10630
106312004-01-07 Teodor Zlatanov <tzz@lifelogs.com>
10632
10633 * spam.el (spam-disable-spam-split-during-ham-respool)
10634 (spam-spamoracle-database, spam-cache-lookups)
10635 (spam-split-last-successful-check, spam-clear-cache, spam-xor)
10636 (spam-group-ham-mark-p, spam-group-spam-mark-p)
10637 (spam-group-ham-marks, spam-group-spam-marks)
10638 (spam-group-spam-contents-p, spam-group-ham-contents-p)
10639 (spam-list-of-processors, spam-list-of-statistical-checks): Fix doc,
10640 also add spam-use-blackholes to the statistical checks.
10641 (spam-fetch-field-fast): Add interface to fetching fields, may
10642 become a macro.
10643 (spam-fetch-field-from-fast, spam-fetch-field-subject-fast)
10644 (spam-fetch-field-message-id-fast): Use spam-fetch-field-fast.
10645 (spam-insert-fake-headers): Fake an article when needed.
10646 (spam-find-spam): Fake article when possible.
10647 (spam-check-blackholes, spam-check-BBDB, spam-from-listed-p)
10648 (spam-check-bogofilter-headers): Use message-fetch-field instead
10649 of nnmail-fetch-field.
10650
106512004-01-07 Reiner Steib <Reiner.Steib@gmx.de>
10652
10653 * gnus-score.el (gnus-score-find-trace): Add `k' (kill-buffer).
10654
106552004-01-07 Teodor Zlatanov <tzz@lifelogs.com>
10656
10657 * spam.el (spam-split): Do not require spam-use-CHECK to be
10658 enabled if that check is passed to spam-split explicitly; also
10659 fix so 'spam doesn't get converted to spam-split-group when
10660 spam-split-symbolic-return is t.
10661 (spam-find-spam): Find registrations of the article and use those
10662 instead of re-running spam-split to find the spam/ham
10663 classification of the article.
10664 (spam-log-processing-to-registry, spam-log-registered-p)
10665 (spam-log-unregistration-needed-p, spam-log-undo-registration):
10666 Use gnus-error instead of gnus-message.
10667 (spam-log-registration-type): Add function to determine the
10668 classification of a message based on registry entries; will
10669 return nil if both 'spam and 'ham are found.
10670 (spam-check-BBDB): Expand all the BBDB macros here so we can have
10671 a reasonably fast local cache without the loading errors.
10672 (spam-cache-lookups): Set to t by default.
10673 (spam-find-spam): Don't try to guess spam-cache-lookups.
10674 (spam-enter-whitelist, spam-enter-blacklist): Clear the
10675 spam-caches entry.
10676 (spam-filelist-build-cache, spam-filelist-check-cache): Fix
10677 caching of whitelist/blacklist entries.
10678 (spam-check-whitelist, spam-check-blacklist): Invoke
10679 spam-from-listed-p with a type, not a cache variable.
10680 (spam-from-listed-p): Wrap around spam-filelist-check-cache.
10681
106822004-01-07 Jesper Harder <harder@ifa.au.dk>
10683
10684 * message.el (message-cite-prefix-regexp): Use with-syntax-table.
10685
10686 * nnmail.el (nnmail-split-fancy): do.
10687
10688 * mml.el (mml-parse): do.
10689
10690 * gnus-score.el (gnus-enter-score-words-into-hashtb)
10691 (gnus-score-adaptive): do.
10692
47612004-01-07 Katsumi Yamaoka <yamaoka@jpl.org> 106932004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
4762 10694
10695 * gnus-art.el (gnus-treat-emphasize): Ignore Emacs version number.
10696 (gnus-mime-button-map): Don't set keymap parent.
10697 (gnus-button-ctan-directory-regexp): Use shy grouping.
10698 (gnus-prev-page-map): Don't set keymap parent.
10699 (gnus-prev-page-map): Remove duplicated one.
10700 (gnus-next-page-map): Don't set keymap parent.
10701 (gnus-mime-security-button-map): Ditto.
10702
10703 * nnheader.el (nnheader-directory-files-is-safe): Ignore Emacs
10704 version number.
10705
4763 * sha1-el.el (sha1-string-external): Use with-temp-buffer. 10706 * sha1-el.el (sha1-string-external): Use with-temp-buffer.
4764 10707
47652004-01-07 Katsumi Yamaoka <yamaoka@jpl.org> 107082004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -4782,275 +10725,346 @@
4782 (sha1-string): Ditto. 10725 (sha1-string): Ditto.
4783 (sha1): Ditto. 10726 (sha1): Ditto.
4784 10727
47852003-11-15 Simon Josefsson <jas@extundo.com> 107282004-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
4786 10729
4787 * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys) 10730 * spam.el (spam-report-articles-gmane): New command.
4788 (pgg-gpg-lookup-key): Use regexp match instead of
4789 split-string (split-string is different between emacs 21.2 and
4790 22.1). Reported by ultrasoul@ultrasoul.com (David D. Smith).
4791 10731
47922004-07-28 Simon Josefsson <jas@extundo.com> 107322004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
4793 10733
4794 * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign 10734 * gnus.el: Don't make unnecessary *Group* buffer when loading.
4795 parameter (but don't use it, for now).
4796 10735
47972004-02-03 Jesper Harder <harder@ifa.au.dk> 10736 * run-at-time.el (run-at-time-saved): Remove.
10737 (run-at-time): Doc fix.
4798 10738
4799 * sieve.el (sieve-deactivate-all): Fix format string mismatch. 107392004-01-07 Jesper Harder <harder@ifa.au.dk>
4800 10740
48012004-08-30 Andreas Schwab <schwab@suse.de> 10741 * gnus-sum.el (gnus-summary-limit-to-replied): New command.
10742 (gnus-summary-limit-map): Add it.
10743 (gnus-summary-make-menu-bar): do.
4802 10744
4803 * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for 107452004-01-06 Teodor Zlatanov <tzz@lifelogs.com>
4804 ?* and ?\;.
4805 10746
4806 * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; 10747 * spam.el (spam-cache-lookups, spam-caches, spam-clear-cache):
4807 and ?\' to symbol instead of whitespace. 10748 Make attempt at some caching support (done for BBDB only now).
10749 (spam-find-spam): Set spam-cache-lookups if there are more than 2
10750 addresses to be checked.
10751 (spam-clear-cache-BBDB): Add function, to be invoked by
10752 bbdb-change-hook, and triggering spam-clear-cache of 'spam-use-BBDB.
10753 (spam-check-BBDB): Check and use the caches, if
10754 spam-cache-lookups is on, remove superfluous (provide).
4808 10755
48092004-08-31 Jesper Harder <harder@ifa.au.dk> 107562004-01-06 Reiner Steib <Reiner.Steib@gmx.de>
4810 10757
4811 * message.el (message-idna-to-ascii-rhs-1): Don't choke on 10758 * gnus-art.el (gnus-treat-ansi-sequences): Changed default.
4812 invalid addresses.
4813 10759
48142004-08-31 Reiner Steib <Reiner.Steib@gmx.de> 107602004-01-07 Steve Youngs <sryoungs@bigpond.net.au>
4815 10761
4816 * message.el (message-idna-to-ascii-rhs-1): Fix typo. 10762 * run-at-time.el (run-at-time-saved): Move to after the definition
10763 of `run-at-time'.
4817 10764
48182004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> 107652004-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
4819 10766
4820 * message.el (message-idna-to-ascii-rhs-1): Don't use equalp. 10767 * gnus-art.el (gnus-article-wash-html-with-w3m): Don't use
10768 mm-w3m-local-map-property.
4821 10769
48222004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> 10770 * mm-view.el (mm-w3m-mode-map): Remove.
10771 (mm-w3m-local-map-property): Remove.
10772 (mm-inline-text-html-render-with-w3m): Don't use
10773 mm-w3m-local-map-property.
4823 10774
4824 * gnus-art.el (article-decode-idna-rhs): Don't use 107752004-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
4825 message-idna-inside-rhs-p.
4826 10776
48272004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> 10777 * run-at-time.el: New file.
4828 10778
4829 * message.el (message-idna-inside-rhs-p): Remove. 10779 * gnus.el ((fboundp 'gnus-set-text-properties)): Remove definition
4830 (message-idna-to-ascii-rhs-1): Use proper address parsing. 10780 of gnus-set-text-properties.
4831 10781
48322004-08-31 Katsumi Yamaoka <yamaoka@jpl.org> 10782 * gnus-uu.el (gnus-uu-save-article): Ditto.
4833 10783
4834 * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. 10784 * gnus-salt.el (gnus-carpal-setup-buffer): Ditto.
4835 10785
48362004-08-30 Helmut Waitzmann <Helmut.Waitzmann@web.de> (tiny change) 10786 * gnus-cite.el (gnus-cite-parse): Ditto.
4837 10787
4838 * gnus-sum.el (gnus-newsgroup-variables): Doc fix. 10788 * gnus-art.el (gnus-button-push): Use set-text-properties instead
10789 of gnus-.
4839 10790
48402004-08-26 YAGI Tatsuya <ynyaaa@ybb.ne.jp> (tiny change) 10791 * gnus.el: Changed calls to nnheader-run-at-time and
10792 password-run-at-time throughout to use run-at-time directly.
4841 10793
4842 * gnus-art.el (gnus-article-next-page): Fix the way to find a real 10794 * password.el: Removed definition of run-at-time.
4843 end-of-buffer.
4844 10795
48452004-08-26 Stefan Wiens <s.wi@gmx.net> (tiny change) 107962004-01-05 Karl Pfl,Ad(Bsterer <sigurd@12move.de> (tiny change)
4846 10797
4847 * gnus-sum.el (gnus-read-header): Don't remove a header for the 10798 * mml.el (mml-minibuffer-read-disposition): Show attachment type
4848 parent article of a sparse article in the thread hashtb. 10799 in prompt.
4849 10800
48502004-08-26 David Hedbor <dhedbor@real.com> (tiny change) 108012004-01-06 Steve Youngs <sryoungs@bigpond.net.au>
4851 10802
4852 * nnmail.el (nnmail-split-lowercase-expanded): New user option. 10803 * gnus-ems.el (gnus-mode-line-modified): Don't conditionalise on
4853 (nnmail-expand-newtext): Lowercase expanded entries if 10804 XEmacs version.
4854 nnmail-split-lowercase-expanded is non-nil.
4855 10805
4856 * gnus-agent.el (gnus-agent-regenerate-group): Activate the group 10806 * dns.el (dns-make-network-process): Use `open-network-stream'
4857 when the group's active is not available. 10807 instead of `gnus-xmas-open-network-stream'.
4858 10808
4859 * gnus-art.el (article-hide-headers): Refer to the values for 10809 * .cvsignore: Add auto-autoloads.el, custom-load.el.
4860 gnus-ignored-headers and gnus-visible-headers in the summary
4861 buffer since a user may have set them as group parameters.
4862 (gnus-article-read-summary-keys): Restore new window-start and
4863 hscroll to summary window.
4864 (gnus-prev-page-map): Remove duplicated one.
4865 10810
4866 * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option. 108112004-01-06 Jesper Harder <harder@ifa.au.dk>
4867 (gnus-cite-parse): Ignore quoted envelope From_. Suggested by
4868 Karl Chen <quarl@nospam.quarl.org> and Reiner Steib
4869 <Reiner.Steib@gmx.de>.
4870 10812
4871 * gnus-cus.el (gnus-agent-cat-prepare-category-field): 10813 * gnus-art.el (gnus-mime-display-alternative)
4872 Replace pp-to-string with gnus-pp-to-string. 10814 (gnus-insert-mime-button, gnus-insert-mime-security-button)
10815 (gnus-insert-prev-page-button, gnus-insert-next-page-button):
10816 Don't use gnus-local-map-property.
4873 10817
4874 * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp. 10818 * gnus-util.el (gnus-local-map-property): Remove.
4875 10819
4876 * gnus-group.el (gnus-group-make-kiboze-group): Replace pp with 10820 * mm-view.el (mm-view-pkcs7-decrypt): Replace
4877 gnus-pp. 10821 gnus-completing-read-maybe-default with completing-read.
4878 10822
4879 * gnus-msg.el (gnus-setup-message): Ignore an article copy while 10823 * gnus-util.el (gnus-completing-read): do.
4880 parsing gnus-posting-styles when the message is not for replying. 10824 (gnus-completing-read-maybe-default): Remove.
4881 (gnus-summary-resend-message-edit): Call mime-to-mml.
4882 Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
4883 (gnus-debug): Replace pp with gnus-pp.
4884 10825
4885 * gnus-score.el (gnus-score-save): Replace pp with gnus-pp. 108262004-01-06 Steve Youngs <sryoungs@bigpond.net.au>
4886 10827
4887 * gnus-spec.el (gnus-update-format): Replace pp-to-string with 10828 * password.el: Only autoload `run-at-time' if not XEmacs.
4888 gnus-pp-to-string. 10829 Only autoload the itimer functions if XEmacs.
4889 10830
4890 * gnus-util.el (gnus-bind-print-variables): New macro. 108312004-01-06 Jesper Harder <harder@ifa.au.dk>
4891 (gnus-prin1): Use it.
4892 (gnus-prin1-to-string): Use it.
4893 (gnus-pp): New function.
4894 (gnus-pp-to-string): New function.
4895 10832
4896 * gnus.el: Don't make unnecessary *Group* buffer when loading. 10833 * gnus-art.el (gnus-read-string): Remove.
10834 (gnus-summary-pipe-to-muttprint): Replace gnus-read-string with
10835 read-string.
4897 10836
4898 * mail-source.el (mail-source-touch-pop): Doc fix. 108372004-01-05 Teodor Zlatanov <tzz@lifelogs.com>
4899 10838
4900 * message.el (message-mode): Don't modify paragraph-separate there. 10839 * netrc.el: Autoload password-read.
4901 (message-setup-fill-variables): Add mml tags to paragraph-start 10840 (netrc): Add configuration group.
4902 and paragraph-separate. Suggested by Andrew Korty <ajk@iu.edu>. 10841 (netrc-encoding-method, netrc-openssl-path): Add
4903 (message-smtpmail-send-it): Doc fix. 10842 variables for encoding and decoding of files with symmetric
4904 (message-exchange-point-and-mark): Don't activate region if it was 10843 ciphers.
4905 inactive. Suggested by Hiroshi Fujishima 10844 (netrc-encode): Add assistant function to encode a file with
4906 <pooh@nature.tsukuba.ac.jp> and Jesper Harder <harder@ifa.au.dk>. 10845 netrc-encoding-method.
10846 (netrc-parse): Add interactive parameter, added optional
10847 decoding if netrc-encoding-method is non-nil but otherwise
10848 behavior is standard.
10849 (netrc-encrypting-method, netrc-encrypt, netrc-parse):
10850 Do s/encode/encrypt/ everywhere.
4907 10851
4908 * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to 10852 * spam.el: Remove executable-find autoload.
4909 t while entering a file name using the mm-with-multibyte macro.
4910 Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
4911 10853
4912 * mm-encode.el (mm-content-transfer-encoding-defaults): 108542004-01-05 Jesper Harder <harder@ifa.au.dk>
4913 Use qp-or-base64 for the application/* types.
4914 (mm-safer-encoding): Consider 7bit is safe.
4915 10855
4916 * mm-util.el (mm-with-multibyte-buffer): New macro. 10856 * gnus-registry.el: Remove Emacs 20 hash table compatibility code.
4917 (mm-with-multibyte): New macro.
4918 10857
4919 * mm-view.el (mm-inline-render-with-function): Use multibyte 10858 * gnus-uu.el (gnus-uu-post-encoded): bury-buffer is always fbound.
4920 buffer; decode html source by charset.
4921 10859
4922 * nndoc.el (nndoc-type-alist): Improve regexp for article-begin, 108602004-01-05 Reiner Steib <Reiner.Steib@gmx.de>
4923 add generate-head-function and generate-article-function to the
4924 rfc822-forward entry.
4925 (nndoc-forward-type-p): Recognize envelope From_.
4926 (nndoc-rfc822-forward-generate-article): New function.
4927 (nndoc-rfc822-forward-generate-head): New function.
4928 10861
4929 * score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp. 10862 * gnus-art.el (gnus-treat-ansi-sequences,
10863 article-treat-ansi-sequences): New variable and function.
10864 Suggested by Dan Jacobson <jidanni@jidanni.org>.
4930 10865
4931 * webmail.el (webmail-debug): Replace pp with gnus-pp. 10866 * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar):
10867 Use it.
4932 10868
4933 * gnus-art.el (gnus-article-wash-html-with-w3m): 108692004-01-05 Jesper Harder <harder@ifa.au.dk>
4934 Bind w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp;
4935 use w3m-minor-mode-map instead of mm-w3m-local-map-property.
4936 (gnus-mime-save-part-and-strip): Use mm-complicated-handles
4937 instead of mm-multiple-handles.
4938 (gnus-mime-delete-part): Ditto.
4939 10870
4940 * mm-decode.el (mm-multiple-handles): Recognize a string as a mime 10871 * mm-util.el (mm-quote-arg): Remove.
4941 handle, as well as a list.
4942 (mm-complicated-handles): Former definition of mm-multiple-handles.
4943 10872
4944 * mm-view.el (mm-w3m-mode-map): Remove. 10873 * mm-decode.el (mm-mailcap-command): Replace mm-quote-arg with
4945 (mm-w3m-local-map-property): Remove. 10874 shell-quote-argument.
4946 (mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by
4947 ARISAWA Akihiro <ari@mbf.sphere.ne.jp>.
4948 (mm-w3m-cid-retrieve): Simplify.
4949 (mm-inline-text-html-render-with-w3m): Decode html source by
4950 charset; check META tags only when charsets are not specified in
4951 headers; specify charset to w3m-region; use w3m-minor-mode-map
4952 instead of mm-w3m-local-map-property.
4953 10875
49542004-08-30 Juanma Barranquero <lektu@terra.es> 10876 * gnus-uu.el (gnus-uu-command): do.
4955 10877
4956 * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant. 10878 * gnus-sum.el (gnus-summary-insert-pseudos): do.
4957 10879
49582004-08-30 Andreas Schwab <schwab@suse.de> 10880 * ietf-drums.el (ietf-drums-token-to-list): Replace mm-make-char
10881 with make-char.
4959 10882
4960 * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting. 10883 * mm-util.el (mm-make-char): Remove.
4961 10884
4962 * gnus-score.el (gnus-summary-increase-score): Fix format string. 10885 * mml.el (mml-mode): Replace gnus-add-minor-mode with
10886 add-minor-mode.
4963 10887
49642004-08-30 Stefan Monnier <monnier@iro.umontreal.ca> 10888 * gnus-undo.el (gnus-undo-mode): do.
4965 10889
4966 * nnimap.el (nnimap-demule): Avoid string-as-multibyte. 10890 * gnus-topic.el (gnus-topic-mode): do.
4967 10891
49682004-08-30 Kim F. Storm <storm@cua.dk> 10892 * gnus-sum.el (gnus-dead-summary-mode): do.
4969 10893
4970 * nntp.el (nntp-authinfo-file): Add :group 'nntp. 10894 * gnus-start.el (gnus-slave-mode): do.
4971 10895
4972 * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache): 10896 * gnus-salt.el (gnus-binary-mode, gnus-pick-mode): do.
4973 Add :group 'nnimap.
4974 10897
49752004-08-23 Reiner Steib <Reiner.Steib@gmx.de> 10898 * gnus-ml.el (gnus-mailing-list-mode): do.
4976 10899
4977 * mm-decode.el (mime-display, mime-security): Fix custom-manual 10900 * gnus-gl.el (gnus-grouplens-mode): do.
4978 entries.
4979 10901
4980 * gnus-art.el (gnus-article): Ditto. 10902 * gnus-draft.el (gnus-draft-mode): do.
4981 10903
49822004-08-23 Katsumi Yamaoka <yamaoka@jpl.org> 10904 * gnus-dired.el (gnus-dired-mode): do.
4983 10905
4984 * gnus-art.el (article-hide-list-identifiers): 10906 * gnus-ems.el (gnus-add-minor-mode): Remove.
4985 Bind inhibit-read-only as t.
4986 10907
49872004-08-22 Reiner Steib <Reiner.Steib@gmx.de> 10908 * gnus-spec.el (gnus-correct-length, gnus-correct-substring):
10909 Replace gnus-char-width with char-width.
4988 10910
4989 * gnus-mlspl.el (gnus-group-split-update): Fix docstring. 10911 * gnus-ems.el (gnus-char-width): Remove.
4990 10912
49912004-08-22 Stefan Monnier <monnier@iro.umontreal.ca> 10913 * gnus-spec.el (gnus-correct-length, gnus-correct-substring):
10914 Replace gnus-char-width with char-width.
4992 10915
4993 * gnus-art.el: Use inhibit-read-only instead of buffer-read-only. 10916 * gnus-ems.el (gnus-char-width): Remove.
4994 (gnus-narrow-to-page): Don't assume point-min == 1.
4995 (gnus-article-edit-mode): Derive from message-mode.
4996 10917
4997 * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume 10918 * spam-stat.el (with-syntax-table): Remove with-syntax-table
4998 point-min == 1. 10919 definition.
10920 Remove Emacs 20 hash table compatibility code.
4999 10921
5000 * imap.el (imap-parse-address-list, imap-parse-body-ext): 10922 * rfc2047.el (with-syntax-table): Remove with-syntax-table Emacs
5001 Disable incorrect use of `assert'. 10923 20 compatibility code.
5002 10924
5003 * message.el (message-mode): Set comment-start-skip. 10925 * spam.el (spam-point-at-eol): Replace with point-at-eol.
5004 10926
50052004-08-22 Sam Steingold <sds@gnu.org> 10927 * smime.el (smime-point-at-eol): Replace with point-at-eol.
5006 10928
5007 * pop3.el (pop3-leave-mail-on-server): New user variable. 10929 * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): Replace
5008 (pop3-movemail): Delete mail only when it is nil. 10930 with point-at-{eol,bol}.
5009 10931
50102004-08-17 Reiner Steib <Reiner.Steib@gmx.de> 10932 * netrc.el (netrc-point-at-eol): Replace with point-at-eol.
5011 10933
5012 * netrc.el, tls.el: Removed; use files from ../net instead. 10934 * imap.el (imap-point-at-eol): Replace with point-at-eol.
5013 10935
50142004-08-16 Reiner Steib <Reiner.Steib@gmx.de> 10936 * flow-fill.el (fill-flowed-point-at-bol,
10937 fill-flowed-point-at-eol): Replace with point-at-{eol,bol}.
5015 10938
5016 * gnus-mule.el, smiley-ems.el: Removed obsolete files. 10939 * gnus-util.el (gnus-point-at-bol, gnus-point-at-eol): Remove.
10940 Replace with point-at-{eol,bol} throughout all files.
5017 10941
5018 * mailcap.el (mailcap-mime-data): Mark as risky. 109422004-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
5019 10943
5020 * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): 10944 * ntlm.el (ntlm-string-as-unibyte): New macro.
5021 Fix custom-manual entries. 10945 (ntlm-build-auth-response): Use it.
5022 10946
5023 * time-date.el: Removed. Merged into ../calendar/time-date.el. 10947 Remove Emacs 20 stuff:
10948 * gnus-msg.el (gnus-summary-news-other-window): Use remove instead
10949 of delq and copy-sequence.
10950 * gnus-art.el (popup-menu): Remove the compiler macro.
10951 * nnmail.el (nnmail-split-fancy): Don't support customizing with
10952 Emacs 20.
5024 10953
50252004-08-02 Reiner Steib <Reiner.Steib@gmx.de> 109542004-01-05 Simon Josefsson <jas@extundo.com>
5026 10955
5027 * blink.pbm, blink.xpm, braindamaged.xpm, cry.xpm, dead.xpm, 10956 * ntlm.el: Fix namespace. Change smb-passwd-hash into
5028 evil.xpm, forced.xpm, frown.xpm, grin.xpm, indifferent.xpm, 10957 ntlm-smb-passwd-hash, smb-owf-encrypt into ntlm-smb-owf-encrypt,
5029 reverse-smile.xpm, sad.pbm, sad.xpm, smile.xpm, time-date.el, 10958 smb-passwd-hash into ntlm-smb-passwd-hash, smbdes-e-p16 into
5030 wry.xpm: Added new files from the v5_10 branch of Gnus. 10959 ntlm-smb-des-e-p16, smbdes-e-p24 into ntlm-smb-des-e-p24, smbhash
10960 into ntlm-smb-hash, smb-sp8 into ntlm-smb-sp8, smb-str-to-key into
10961 ntlm-smb-str-to-key, smb-dohash into ntlm-smb-dohash, smb-perm1
10962 into ntlm-smb-perm1, smb-perm2 into ntlm-smb-perm2, smb-perm3 into
10963 ntlm-smb-perm3, smb-perm4 into ntlm-smb-perm4, smb-perm5 into
10964 ntlm-smb-perm5, smb-perm6 into ntlm-smb-perm6, smb-sc into
10965 ntlm-smb-sc, smb-sbox into ntlm-smb-sbox, string-permute into
10966 ntlm-string-permute, string-lshift into ntlm-string-lshift,
10967 string-xor into ntlm-string-xor. Suggested by
10968 Jesper Harder <harder@myrealbox.com>.
5031 10969
50322004-07-22 Andreas Schwab <schwab@suse.de> 10970 * ntlm.el: Don't include poem.
5033 10971
5034 Import Gnus 5.10 from the v5_10 branch of the Gnus repository. 10972 * md4.el (print-int32, print-string-hexa): Remove. Suggested by
10973 Jesper Harder <harder@myrealbox.com>.
5035 10974
50362004-05-23 Katsumi Yamaoka <yamaoka@jpl.org> 10975 * sasl-ntlm.el, ntlm.el, md4.el: New files.
5037 10976
5038 * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in 10977 * hmac-md5.el (md5-binary): Fix byte compile warning. (This
5039 addition to emacs-w3m. 10978 probably breaks emacs with DL patch, but do we care? Is anyone
10979 still using the DL stuff?)
5040 10980
50412004-05-19 Reiner Steib <Reiner.Steib@gmx.de> 10981 * sieve-manage.el: Use the password package.
10982 (sieve-manage-read-passwd): Remove.
10983 (sieve-manage-interactive-login): Use password. Re-add
10984 condition-case around loop.
10985
10986 * pgg.el (pgg-passphrase-cache, pgg-run-at-time): Remove.
10987 (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): Use
10988 the password package.
10989
109902003-02-19 Simon Josefsson <jas@extundo.com>
10991
10992 * sieve-manage.el (sieve-sasl-auth): Quote optional initial SASL
10993 token.
10994
109952002-08-07 Simon Josefsson <jas@extundo.com>
10996
10997 * sieve-manage.el (require): Use SASL, not RFC2104/MD5.
10998 (sieve-manage-authenticators):
10999 (sieve-manage-authenticator-alist): Add some SASL mechs.
11000 (sieve-sasl-auth): New function.
11001 (sieve-manage-cram-md5-auth):
11002 (sieve-manage-plain-auth): Rewrite using SASL library.
11003 (sieve-manage-digest-md5-p, sieve-manage-digest-md5-auth)
11004 (sieve-manage-scram-md5-p, sieve-manage-scram-md5-auth)
11005 (sieve-manage-ntlm-p, sieve-manage-ntlm-auth)
11006 (sieve-manage-login-p, sieve-manage-login-auth): Add wrappers.
11007
110082004-01-05 Simon Josefsson <jas@extundo.com>
11009
11010 * sasl.el, sasl-cram.el, sasl-digest.el, hmac-md5.el, hmac-def.el:
11011 New files.
11012
110132004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
11014
11015 * gnus-group.el (gnus-no-groups-message): Update.
11016
11017 * gnus-sum.el (gnus-summary-insert-new-articles): Remove .
11018
110192003-11-09 Simon Josefsson <jas@extundo.com>
11020
11021 * imap.el: Support for ID IMAP extension (RFC 2971).
11022 (imap-local-variables): Add imap-id.
11023 (imap-id): New variable.
11024 (imap-id): New function.
11025 (imap-parse-response): Parse untagged ID response.
11026 * nnimap.el (nnimap-id): New variable.
11027 (nnimap-open-connection): Use it.
11028
110292003-12-28 Simon Josefsson <jas@extundo.com>
11030
11031 * gnus-score.el (gnus-score-edit-all-score): New.
11032 * gnus-group.el (gnus-group-score-map): Bind it to W e.
11033
110342004-01-04 Simon Josefsson <jas@extundo.com>
11035
11036 * password.el: Add.
11037
110382004-01-04 Mario Lang <lang@zid.tugraz.at>
11039
11040 * dns.el: Add support for AAAA records (see RFC 3596)
11041
11042 * Fix typo PRT -> PTR
11043
11044 * Parse MX, PTR and SOA replies (see RFC 1035)
11045
110462004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
11047
11048 * gnus.el (gnus-logo-color-style): Changed colors to `no'.
11049
11050 * Moved to Changelog.2.
11051
110522004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
11053
11054 * gnus.el (gnus-version-number): Bump version.
11055
110562004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
11057
11058 * gnus.el: No Gnus v0.1 is released.
5042 11059
5043 * gnus-msg.el (gnus-summary-followup-with-original): 110602004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
5044 Document yanking of region when active.
5045 11061
50462004-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com> 11062 * gnus.el: No Gnus v0.0 is released.
5047 11063
5048 * gnus-agent.el: Merged 7.3 through 7.7 updates into branch. 110642004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
5049 Revision 7.2 changes excluded to maintain compatibility with all
5050 targeted emacs versions.
5051 11065
5052 * gnus-cus.el: Merged revisions 7.2 through 7.5 into branch to support 11066 * gnus.el (gnus-version-number): Bump.
5053 gnus-agent.el update and incorporate bug fixes. 11067 (gnus-version): No.
5054 11068
5055See ChangeLog.2 for earlier changes. 11069See ChangeLog.2 for earlier changes.
5056 11070
diff --git a/lisp/gnus/assistant.el b/lisp/gnus/assistant.el
new file mode 100644
index 00000000000..25ff1732f8f
--- /dev/null
+++ b/lisp/gnus/assistant.el
@@ -0,0 +1,487 @@
1;;; assistant.el --- guiding users through Emacs setup
2;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
3
4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5;; Keywords: util
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
23
24;;; Commentary:
25
26;;; Code:
27
28(eval-when-compile
29 (require 'cl))
30
31(require 'widget)
32(require 'wid-edit)
33
34(autoload 'gnus-error "gnus-util")
35(autoload 'netrc-get "netrc")
36(autoload 'netrc-machine "netrc")
37(autoload 'netrc-parse "netrc")
38
39(defvar assistant-readers
40 '(("variable" assistant-variable-reader)
41 ("validate" assistant-sexp-reader)
42 ("result" assistant-list-reader)
43 ("next" assistant-list-reader)
44 ("text" assistant-text-reader)))
45
46(defface assistant-field '((t (:bold t)))
47 "Face used for editable fields."
48 :group 'gnus-article-emphasis)
49;; backward-compatibility alias
50(put 'assistant-field-face 'face-alias 'assistant-field)
51
52;;; Internal variables
53
54(defvar assistant-data nil)
55(defvar assistant-current-node nil)
56(defvar assistant-previous-nodes nil)
57(defvar assistant-widgets nil)
58
59(defun assistant-parse-buffer ()
60 (let (results command value)
61 (goto-char (point-min))
62 (while (search-forward "@" nil t)
63 (if (not (looking-at "[^ \t\n]+"))
64 (error "Dangling @")
65 (setq command (downcase (match-string 0)))
66 (goto-char (match-end 0)))
67 (setq value
68 (if (looking-at "[ \t]*\n")
69 (let (start)
70 (forward-line 1)
71 (setq start (point))
72 (unless (re-search-forward (concat "^@end " command) nil t)
73 (error "No @end %s found" command))
74 (beginning-of-line)
75 (prog1
76 (buffer-substring start (point))
77 (forward-line 1)))
78 (skip-chars-forward " \t")
79 (prog1
80 (buffer-substring (point) (point-at-eol))
81 (forward-line 1))))
82 (push (list command (assistant-reader command value))
83 results))
84 (assistant-segment (nreverse results))))
85
86(defun assistant-text-reader (text)
87 (with-temp-buffer
88 (insert text)
89 (goto-char (point-min))
90 (let ((start (point))
91 (sections nil))
92 (while (re-search-forward "@\\([^{]+\\){\\([^}]+\\)}" nil t)
93 (push (buffer-substring start (match-beginning 0))
94 sections)
95 (push (list (match-string 1) (match-string 2))
96 sections)
97 (setq start (point)))
98 (push (buffer-substring start (point-max))
99 sections)
100 (nreverse sections))))
101
102;; Segment the raw assistant data into a list of nodes.
103(defun assistant-segment (list)
104 (let ((ast nil)
105 (node nil)
106 (title (pop list)))
107 (dolist (elem list)
108 (when (and (equal (car elem) "node")
109 node)
110 (push (list "save" nil) node)
111 (push (nreverse node) ast)
112 (setq node nil))
113 (push elem node))
114 (when node
115 (push (list "save" nil) node)
116 (push (nreverse node) ast))
117 (cons title (nreverse ast))))
118
119(defun assistant-reader (command value)
120 (let ((formatter (cadr (assoc command assistant-readers))))
121 (if (not formatter)
122 value
123 (funcall formatter value))))
124
125(defun assistant-list-reader (value)
126 (car (read-from-string (concat "(" value ")"))))
127
128(defun assistant-variable-reader (value)
129 (let ((section (car (read-from-string (concat "(" value ")")))))
130 (append section (list 'default))))
131
132(defun assistant-sexp-reader (value)
133 (if (zerop (length value))
134 nil
135 (car (read-from-string value))))
136
137(defun assistant-buffer-name (title)
138 (format "*Assistant %s*" title))
139
140(defun assistant-get (ast command)
141 (cadr (assoc command ast)))
142
143(defun assistant-set (ast command value)
144 (let ((elem (assoc command ast)))
145 (when elem
146 (setcar (cdr elem) value))))
147
148(defun assistant-get-list (ast command)
149 (let ((result nil))
150 (dolist (elem ast)
151 (when (equal (car elem) command)
152 (push elem result)))
153 (nreverse result)))
154
155;;;###autoload
156(defun assistant (file)
157 "Assist setting up Emacs based on FILE."
158 (interactive "fAssistant file name: ")
159 (let ((ast
160 (with-temp-buffer
161 (insert-file-contents file)
162 (assistant-parse-buffer))))
163 (pop-to-buffer (assistant-buffer-name (assistant-get ast "title")))
164 (assistant-render ast)))
165
166(defun assistant-render (ast)
167 (let ((first-node (assistant-get (nth 1 ast) "node")))
168 (set (make-local-variable 'assistant-data) ast)
169 (set (make-local-variable 'assistant-current-node) nil)
170 (set (make-local-variable 'assistant-previous-nodes) nil)
171 (assistant-render-node first-node)))
172
173(defun assistant-find-node (node-name)
174 (let ((ast (cdr assistant-data)))
175 (while (and ast
176 (not (string= node-name (assistant-get (car ast) "node"))))
177 (pop ast))
178 (car ast)))
179
180(defun assistant-node-name (node)
181 (assistant-get node "node"))
182
183(defun assistant-previous-node-text (node)
184 (format "<< Go back to %s" node))
185
186(defun assistant-next-node-text (node)
187 (if (and node
188 (not (eq node 'finish)))
189 (format "Proceed to %s >>" node)
190 "Finish"))
191
192(defun assistant-set-defaults (node &optional forcep)
193 (dolist (variable (assistant-get-list node "variable"))
194 (setq variable (cadr variable))
195 (when (or (eq (nth 3 variable) 'default)
196 forcep)
197 (setcar (nthcdr 3 variable)
198 (assistant-eval (nth 2 variable))))))
199
200(defun assistant-get-variable (node variable &optional type raw)
201 (let ((variables (assistant-get-list node "variable"))
202 (result nil)
203 elem)
204 (while (and (setq elem (pop variables))
205 (not result))
206 (setq elem (cadr elem))
207 (when (eq (intern variable) (car elem))
208 (if type
209 (setq result (nth 1 elem))
210 (setq result (if raw (nth 3 elem)
211 (format "%s" (nth 3 elem)))))))
212 result))
213
214(defun assistant-set-variable (node variable value)
215 (let ((variables (assistant-get-list node "variable"))
216 elem)
217 (while (setq elem (pop variables))
218 (setq elem (cadr elem))
219 (when (eq (intern variable) (car elem))
220 (setcar (nthcdr 3 elem) value)))))
221
222(defun assistant-render-text (text node)
223 (unless (and text node)
224 (gnus-error
225 5
226 "The assistant was asked to render invalid text or node data"))
227 (dolist (elem text)
228 (if (stringp elem)
229 ;; Ordinary text
230 (insert elem)
231 ;; A variable to be inserted as a widget.
232 (let* ((start (point))
233 (variable (cadr elem))
234 (type (assistant-get-variable node variable 'type)))
235 (cond
236 ((eq (car-safe type) :radio)
237 (push
238 (apply
239 #'widget-create
240 'radio-button-choice
241 :assistant-variable variable
242 :assistant-node node
243 :value (assistant-get-variable node variable)
244 :notify (lambda (widget &rest ignore)
245 (assistant-set-variable
246 (widget-get widget :assistant-node)
247 (widget-get widget :assistant-variable)
248 (widget-value widget))
249 (assistant-render-node
250 (assistant-get
251 (widget-get widget :assistant-node)
252 "node")))
253 (cadr type))
254 assistant-widgets))
255 ((eq (car-safe type) :set)
256 (push
257 (apply
258 #'widget-create
259 'set
260 :assistant-variable variable
261 :assistant-node node
262 :value (assistant-get-variable node variable nil t)
263 :notify (lambda (widget &rest ignore)
264 (assistant-set-variable
265 (widget-get widget :assistant-node)
266 (widget-get widget :assistant-variable)
267 (widget-value widget))
268 (assistant-render-node
269 (assistant-get
270 (widget-get widget :assistant-node)
271 "node")))
272 (cadr type))
273 assistant-widgets))
274 (t
275 (push
276 (widget-create
277 'editable-field
278 :value-face 'assistant-field
279 :assistant-variable variable
280 (assistant-get-variable node variable))
281 assistant-widgets)
282 ;; The editable-field widget apparently inserts a newline;
283 ;; remove it.
284 (delete-char -1)
285 (add-text-properties start (point)
286 (list
287 'bold t
288 'face 'assistant-field
289 'not-read-only t))))))))
290
291(defun assistant-render-node (node-name)
292 (let ((node (assistant-find-node node-name))
293 (inhibit-read-only t)
294 (previous assistant-current-node)
295 (buffer-read-only nil))
296 (unless node
297 (gnus-error 5 "The node for %s could not be found" node-name))
298 (set (make-local-variable 'assistant-widgets) nil)
299 (assistant-set-defaults node)
300 (if (equal (assistant-get node "type") "interstitial")
301 (assistant-render-node (nth 0 (assistant-find-next-nodes node-name)))
302 (setq assistant-current-node node-name)
303 (when previous
304 (push previous assistant-previous-nodes))
305 (erase-buffer)
306 (insert (cadar assistant-data) "\n\n")
307 (insert node-name "\n\n")
308 (assistant-render-text (assistant-get node "text") node)
309 (insert "\n\n")
310 (when assistant-previous-nodes
311 (assistant-node-button 'previous (car assistant-previous-nodes)))
312 (widget-create
313 'push-button
314 :assistant-node node-name
315 :notify (lambda (widget &rest ignore)
316 (let* ((node (widget-get widget :assistant-node)))
317 (assistant-set-defaults (assistant-find-node node) 'force)
318 (assistant-render-node node)))
319 "Reset")
320 (insert "\n")
321 (dolist (nnode (assistant-find-next-nodes))
322 (assistant-node-button 'next nnode)
323 (insert "\n"))
324
325 (goto-char (point-min))
326 (assistant-make-read-only))))
327
328(defun assistant-make-read-only ()
329 (let ((start (point-min))
330 end)
331 (while (setq end (text-property-any start (point-max) 'not-read-only t))
332 (put-text-property start end 'read-only t)
333 (put-text-property start end 'rear-nonsticky t)
334 (while (get-text-property end 'not-read-only)
335 (incf end))
336 (setq start end))
337 (put-text-property start (point-max) 'read-only t)))
338
339(defun assistant-node-button (type node)
340 (let ((text (if (eq type 'next)
341 (assistant-next-node-text node)
342 (assistant-previous-node-text node))))
343 (widget-create
344 'push-button
345 :assistant-node node
346 :assistant-type type
347 :notify (lambda (widget &rest ignore)
348 (let* ((node (widget-get widget :assistant-node))
349 (type (widget-get widget :assistant-type)))
350 (if (eq type 'previous)
351 (progn
352 (setq assistant-current-node nil)
353 (pop assistant-previous-nodes))
354 (assistant-get-widget-values)
355 (assistant-validate))
356 (if (null node)
357 (assistant-finish)
358 (assistant-render-node node))))
359 text)
360 (use-local-map widget-keymap)))
361
362(defun assistant-validate-types (node)
363 (dolist (variable (assistant-get-list node "variable"))
364 (setq variable (cadr variable))
365 (let ((type (nth 1 variable))
366 (value (nth 3 variable)))
367 (when
368 (cond
369 ((eq type :number)
370 (string-match "[^0-9]" value))
371 (t
372 nil))
373 (error "%s is not of type %s: %s"
374 (car variable) type value)))))
375
376(defun assistant-get-widget-values ()
377 (let ((node (assistant-find-node assistant-current-node)))
378 (dolist (widget assistant-widgets)
379 (assistant-set-variable
380 node (widget-get widget :assistant-variable)
381 (widget-value widget)))))
382
383(defun assistant-validate ()
384 (let* ((node (assistant-find-node assistant-current-node))
385 (validation (assistant-get node "validate"))
386 result)
387 (assistant-validate-types node)
388 (when validation
389 (when (setq result (assistant-eval validation))
390 (unless (y-or-n-p (format "Error: %s. Continue? " result))
391 (error "%s" result))))
392 (assistant-set node "save" t)))
393
394;; (defun assistant-find-next-node (&optional node)
395;; (let* ((node (assistant-find-node (or node assistant-current-node)))
396;; (node-name (assistant-node-name node))
397;; (nexts (assistant-get-list node "next"))
398;; next elem applicable)
399
400;; (while (setq elem (pop nexts))
401;; (when (assistant-eval (car (cadr elem)))
402;; (setq applicable (cons elem applicable))))
403
404;; ;; return the first thing we can
405;; (cadr (cadr (pop applicable)))))
406
407(defun assistant-find-next-nodes (&optional node)
408 (let* ((node (assistant-find-node (or node assistant-current-node)))
409 (nexts (assistant-get-list node "next"))
410 next elem applicable return)
411
412 (while (setq elem (pop nexts))
413 (when (assistant-eval (car (cadr elem)))
414 (setq applicable (cons elem applicable))))
415
416 ;; return the first thing we can
417
418 (while (setq elem (pop applicable))
419 (push (cadr (cadr elem)) return))
420
421 return))
422
423(defun assistant-get-all-variables ()
424 (let ((variables nil))
425 (dolist (node (cdr assistant-data))
426 (setq variables
427 (append (assistant-get-list node "variable")
428 variables)))
429 variables))
430
431(defun assistant-eval (form)
432 (let ((bindings nil))
433 (dolist (variable (assistant-get-all-variables))
434 (setq variable (cadr variable))
435 (push (list (car variable)
436 (if (eq (nth 3 variable) 'default)
437 nil
438 (if (listp (nth 3 variable))
439 `(list ,@(nth 3 variable))
440 (nth 3 variable))))
441 bindings))
442 (eval
443 `(let ,bindings
444 ,form))))
445
446(defun assistant-finish ()
447 (let ((results nil)
448 result)
449 (dolist (node (cdr assistant-data))
450 (when (assistant-get node "save")
451 (setq result (assistant-get node "result"))
452 (push (list (car result)
453 (assistant-eval (cadr result)))
454 results)))
455 (message "Results: %s"
456 (nreverse results))))
457
458;;; Validation functions.
459
460(defun assistant-validate-connect-to-server (server port)
461 (let* ((error nil)
462 (stream
463 (condition-case err
464 (open-network-stream "nntpd" nil server port)
465 (error (setq error err)))))
466 (if (and (processp stream)
467 (memq (process-status stream) '(open run)))
468 (progn
469 (delete-process stream)
470 nil)
471 error)))
472
473(defun assistant-authinfo-data (server port type)
474 (when (file-exists-p "~/.authinfo")
475 (netrc-get (netrc-machine (netrc-parse "~/.authinfo")
476 server port)
477 (if (eq type 'user)
478 "login"
479 "password"))))
480
481(defun assistant-password-required-p ()
482 nil)
483
484(provide 'assistant)
485
486;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b
487;;; assistant.el ends here
diff --git a/lisp/gnus/binhex.el b/lisp/gnus/binhex.el
index 69866a9eacc..88f0e20f17c 100644
--- a/lisp/gnus/binhex.el
+++ b/lisp/gnus/binhex.el
@@ -27,8 +27,6 @@
27 27
28;;; Code: 28;;; Code:
29 29
30(autoload 'executable-find "executable")
31
32(eval-when-compile (require 'cl)) 30(eval-when-compile (require 'cl))
33 31
34(eval-and-compile 32(eval-and-compile
@@ -246,14 +244,13 @@ If HEADER-ONLY is non-nil only decode header and return filename."
246 (setq file-name-length (char-after (point-min)) 244 (setq file-name-length (char-after (point-min))
247 data-fork-start (+ (point-min) 245 data-fork-start (+ (point-min)
248 file-name-length 22)))) 246 file-name-length 22))))
249 (if (and (null header) 247 (when (and (null header)
250 (with-current-buffer work-buffer 248 (with-current-buffer work-buffer
251 (>= (buffer-size) data-fork-start))) 249 (>= (buffer-size) data-fork-start)))
252 (progn 250 (binhex-verify-crc work-buffer
253 (binhex-verify-crc work-buffer 251 (point-min) data-fork-start)
254 (point-min) data-fork-start) 252 (setq header (binhex-header work-buffer))
255 (setq header (binhex-header work-buffer)) 253 (when header-only (setq tmp nil counter 0)))
256 (if header-only (setq tmp nil counter 0))))
257 (setq tmp (and tmp (not (eq inputpos end))))) 254 (setq tmp (and tmp (not (eq inputpos end)))))
258 (cond 255 (cond
259 ((= counter 3) 256 ((= counter 3)
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index b1fdc9a2f0e..4019db2390e 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -315,71 +315,77 @@ You can control what lines will be unwrapped by frobbing
315indicating the minimum and maximum length of an unwrapped citation line. If 315indicating the minimum and maximum length of an unwrapped citation line. If
316NODISPLAY is non-nil, don't redisplay the article buffer." 316NODISPLAY is non-nil, don't redisplay the article buffer."
317 (interactive "P") 317 (interactive "P")
318 (save-excursion 318 (let ((case-fold-search nil)
319 (let ((case-fold-search nil) 319 (inhibit-read-only t)
320 (inhibit-read-only t) 320 (cite-marks gnus-outlook-deuglify-cite-marks)
321 (cite-marks gnus-outlook-deuglify-cite-marks) 321 (no-wrap gnus-outlook-deuglify-no-wrap-chars)
322 (no-wrap gnus-outlook-deuglify-no-wrap-chars) 322 (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
323 (stop-chars gnus-outlook-deuglify-unwrap-stop-chars)) 323 (gnus-with-article-buffer
324 (gnus-with-article-buffer 324 (article-goto-body)
325 (article-goto-body) 325 (while (re-search-forward
326 (while (re-search-forward 326 (concat
327 (concat 327 "^\\([ \t" cite-marks "]*\\)"
328 "^\\([ \t" cite-marks "]*\\)" 328 "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
329 "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n" 329 "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
330 "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
331 nil t) 330 nil t)
332 (let ((len12 (- (match-end 2) (match-beginning 1))) 331 (let ((len12 (- (match-end 2) (match-beginning 1)))
333 (len3 (- (match-end 3) (match-beginning 3)))) 332 (len3 (- (match-end 3) (match-beginning 3))))
334 (if (and (> len12 gnus-outlook-deuglify-unwrap-min) 333 (when (and (> len12 gnus-outlook-deuglify-unwrap-min)
335 (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max)) 334 (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
336 (progn 335 (replace-match "\\1\\2 \\3")
337 (replace-match "\\1\\2 \\3") 336 (goto-char (match-beginning 0)))))))
338 (goto-char (match-beginning 0)))))))))
339 (unless nodisplay (gnus-outlook-display-article-buffer))) 337 (unless nodisplay (gnus-outlook-display-article-buffer)))
340 338
341(defun gnus-outlook-rearrange-article (attr-start) 339(defun gnus-outlook-rearrange-article (attr-start)
342 "Put the text from ATTR-START to the end of buffer at the top of the article buffer." 340 "Put the text from ATTR-START to the end of buffer at the top of the article buffer."
343 (save-excursion 341 ;; FIXME: 1. (*) text/plain ( ) text/html
344 (let ((inhibit-read-only t) 342 (let ((inhibit-read-only t)
345 (cite-marks gnus-outlook-deuglify-cite-marks)) 343 (cite-marks gnus-outlook-deuglify-cite-marks))
346 (gnus-with-article-buffer 344 (gnus-with-article-buffer
347 (article-goto-body) 345 (article-goto-body)
348 ;; article does not start with attribution 346 ;; article does not start with attribution
349 (unless (= (point) attr-start) 347 (unless (= (point) attr-start)
350 (gnus-kill-all-overlays) 348 (gnus-kill-all-overlays)
351 (let ((cur (point)) 349 (let ((cur (point))
352 ;; before signature or end of buffer 350 ;; before signature or end of buffer
353 (to (if (gnus-article-search-signature) 351 (to (if (gnus-article-search-signature)
354 (point) 352 (point)
355 (point-max)))) 353 (point-max))))
356 ;; handle the case where the full quote is below the 354 ;; handle the case where the full quote is below the
357 ;; signature 355 ;; signature
358 (if (< to attr-start) 356 (when (< to attr-start)
359 (setq to (point-max))) 357 (setq to (point-max)))
360 (transpose-regions cur attr-start attr-start to))))))) 358 (save-excursion
359 (narrow-to-region attr-start to)
360 (goto-char attr-start)
361 (forward-line)
362 (unless (looking-at ">")
363 (message-indent-citation (point) (point-max) 'yank-only)
364 (goto-char (point-max))
365 (newline)
366 (setq to (point-max)))
367 (widen))
368 (transpose-regions cur attr-start attr-start to))))))
361 369
362;; John Doe <john.doe@some.domain> wrote in message 370;; John Doe <john.doe@some.domain> wrote in message
363;; news:a87usw8$dklsssa$2@some.news.server... 371;; news:a87usw8$dklsssa$2@some.news.server...
364 372
365(defun gnus-outlook-repair-attribution-outlook () 373(defun gnus-outlook-repair-attribution-outlook ()
366 "Repair a broken attribution line (Outlook)." 374 "Repair a broken attribution line (Outlook)."
367 (save-excursion 375 (let ((case-fold-search nil)
368 (let ((case-fold-search nil) 376 (inhibit-read-only t)
369 (inhibit-read-only t) 377 (cite-marks gnus-outlook-deuglify-cite-marks))
370 (cite-marks gnus-outlook-deuglify-cite-marks)) 378 (gnus-with-article-buffer
371 (gnus-with-article-buffer 379 (article-goto-body)
372 (article-goto-body) 380 (when (re-search-forward
373 (if (re-search-forward
374 (concat "^\\([^" cite-marks "].+\\)" 381 (concat "^\\([^" cite-marks "].+\\)"
375 "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)" 382 "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
376 "\\(.*\n?[^\n" cite-marks "].*\\)?" 383 "\\(.*\n?[^\n" cite-marks "].*\\)?"
377 "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$") 384 "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
378 nil t) 385 nil t)
379 (progn 386 (gnus-kill-all-overlays)
380 (gnus-kill-all-overlays) 387 (replace-match "\\1\\2\\4")
381 (replace-match "\\1\\2\\4") 388 (match-beginning 0)))))
382 (match-beginning 0)))))))
383 389
384 390
385;; ----- Original Message ----- 391;; ----- Original Message -----
@@ -390,42 +396,38 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
390 396
391(defun gnus-outlook-repair-attribution-block () 397(defun gnus-outlook-repair-attribution-block ()
392 "Repair a big broken attribution block." 398 "Repair a big broken attribution block."
393 (save-excursion 399 (let ((case-fold-search nil)
394 (let ((case-fold-search nil) 400 (inhibit-read-only t)
395 (inhibit-read-only t) 401 (cite-marks gnus-outlook-deuglify-cite-marks))
396 (cite-marks gnus-outlook-deuglify-cite-marks)) 402 (gnus-with-article-buffer
397 (gnus-with-article-buffer 403 (article-goto-body)
398 (article-goto-body) 404 (when (re-search-forward
399 (if (re-search-forward 405 (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
400 (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
401 "[^\n:]+:[ \t]*\\([^\n]+\\)\n" 406 "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
402 "\\([^\n:]+:[ \t]*[^\n]+\n\\)+") 407 "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
403 nil t) 408 nil t)
404 (progn 409 (gnus-kill-all-overlays)
405 (gnus-kill-all-overlays) 410 (replace-match "\\1 wrote:\n")
406 (replace-match "\\1 wrote:\n") 411 (match-beginning 0)))))
407 (match-beginning 0)))))))
408 412
409;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote: 413;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
410 414
411(defun gnus-outlook-repair-attribution-other () 415(defun gnus-outlook-repair-attribution-other ()
412 "Repair a broken attribution line (other user agents than Outlook)." 416 "Repair a broken attribution line (other user agents than Outlook)."
413 (save-excursion 417 (let ((case-fold-search nil)
414 (let ((case-fold-search nil) 418 (inhibit-read-only t)
415 (inhibit-read-only t) 419 (cite-marks gnus-outlook-deuglify-cite-marks))
416 (cite-marks gnus-outlook-deuglify-cite-marks)) 420 (gnus-with-article-buffer
417 (gnus-with-article-buffer 421 (article-goto-body)
418 (article-goto-body) 422 (when (re-search-forward
419 (if (re-search-forward
420 (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?" 423 (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
421 "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?" 424 "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
422 "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*" 425 "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
423 "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$") 426 "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
424 nil t) 427 nil t)
425 (progn 428 (gnus-kill-all-overlays)
426 (gnus-kill-all-overlays) 429 (replace-match "\\4 \\5\\6\\7")
427 (replace-match "\\4 \\5\\6\\7") 430 (match-beginning 0)))))
428 (match-beginning 0)))))))
429 431
430;;;###autoload 432;;;###autoload
431(defun gnus-article-outlook-repair-attribution (&optional nodisplay) 433(defun gnus-article-outlook-repair-attribution (&optional nodisplay)
diff --git a/lisp/gnus/dns.el b/lisp/gnus/dns.el
index fdbe9258686..7910261125a 100644
--- a/lisp/gnus/dns.el
+++ b/lisp/gnus/dns.el
@@ -51,11 +51,13 @@ If nil, /etc/resolv.conf will be consulted.")
51 (MR 9) 51 (MR 9)
52 (NULL 10) 52 (NULL 10)
53 (WKS 11) 53 (WKS 11)
54 (PRT 12) 54 (PTR 12)
55 (HINFO 13) 55 (HINFO 13)
56 (MINFO 14) 56 (MINFO 14)
57 (MX 15) 57 (MX 15)
58 (TXT 16) 58 (TXT 16)
59 (AAAA 28) ; RFC3596
60 (SRV 33) ; RFC2782
59 (AXFR 252) 61 (AXFR 252)
60 (MAILB 253) 62 (MAILB 253)
61 (MAILA 254) 63 (MAILA 254)
@@ -252,6 +254,12 @@ If TCP-P, the first two bytes of the package with be the length field."
252 (push (list slot qs) spec))) 254 (push (list slot qs) spec)))
253 (nreverse spec)))) 255 (nreverse spec))))
254 256
257(defun dns-read-int32 ()
258 ;; Full 32 bit Integers can't be handled by Emacs. If we use
259 ;; floats, it works.
260 (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
261 (dns-read-bytes 3))))
262
255(defun dns-read-type (string type) 263(defun dns-read-type (string type)
256 (let ((buffer (current-buffer)) 264 (let ((buffer (current-buffer))
257 (point (point))) 265 (point (point)))
@@ -265,9 +273,27 @@ If TCP-P, the first two bytes of the package with be the length field."
265 (dotimes (i 4) 273 (dotimes (i 4)
266 (push (dns-read-bytes 1) bytes)) 274 (push (dns-read-bytes 1) bytes))
267 (mapconcat 'number-to-string (nreverse bytes) "."))) 275 (mapconcat 'number-to-string (nreverse bytes) ".")))
268 ((eq type 'NS) 276 ((eq type 'AAAA)
269 (dns-read-string-name string buffer)) 277 (let (hextets)
270 ((eq type 'CNAME) 278 (dotimes (i 8)
279 (push (dns-read-bytes 2) hextets))
280 (mapconcat (lambda (n) (format "%x" n)) (nreverse hextets) ":")))
281 ((eq type 'SOA)
282 (list (list 'mname (dns-read-name buffer))
283 (list 'rname (dns-read-name buffer))
284 (list 'serial (dns-read-int32))
285 (list 'refresh (dns-read-int32))
286 (list 'retry (dns-read-int32))
287 (list 'expire (dns-read-int32))
288 (list 'minimum (dns-read-int32))))
289 ((eq type 'SRV)
290 (list (list 'priority (dns-read-bytes 2))
291 (list 'weight (dns-read-bytes 2))
292 (list 'port (dns-read-bytes 2))
293 (list 'target (dns-read-name buffer))))
294 ((eq type 'MX)
295 (cons (dns-read-bytes 2) (dns-read-name buffer)))
296 ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
271 (dns-read-string-name string buffer)) 297 (dns-read-string-name string buffer))
272 (t string))) 298 (t string)))
273 (goto-char point)))) 299 (goto-char point))))
@@ -281,17 +307,32 @@ If TCP-P, the first two bytes of the package with be the length field."
281 (push (match-string 1) dns-servers)) 307 (push (match-string 1) dns-servers))
282 (setq dns-servers (nreverse dns-servers))))) 308 (setq dns-servers (nreverse dns-servers)))))
283 309
284;;; Interface functions. 310(defun dns-read-txt (string)
285(eval-when-compile 311 (if (> (length string) 1)
286 (when (featurep 'xemacs) 312 (substring string 1)
287 (require 'gnus-xmas))) 313 string))
314
315(defun dns-get-txt-answer (answers)
316 (let ((result "")
317 (do-next nil))
318 (dolist (answer answers)
319 (dolist (elem answer)
320 (when (consp elem)
321 (cond
322 ((eq (car elem) 'type)
323 (setq do-next (eq (cadr elem) 'TXT)))
324 ((eq (car elem) 'data)
325 (when do-next
326 (setq result (concat result (dns-read-txt (cadr elem))))))))))
327 result))
288 328
329;;; Interface functions.
289(defmacro dns-make-network-process (server) 330(defmacro dns-make-network-process (server)
290 (if (featurep 'xemacs) 331 (if (featurep 'xemacs)
291 `(let ((coding-system-for-read 'binary) 332 `(let ((coding-system-for-read 'binary)
292 (coding-system-for-write 'binary)) 333 (coding-system-for-write 'binary))
293 (gnus-xmas-open-network-stream "dns" (current-buffer) 334 (open-network-stream "dns" (current-buffer)
294 ,server "domain" 'udp)) 335 ,server "domain" 'udp))
295 `(let ((server ,server) 336 `(let ((server ,server)
296 (coding-system-for-read 'binary) 337 (coding-system-for-read 'binary)
297 (coding-system-for-write 'binary)) 338 (coding-system-for-write 'binary))
@@ -308,13 +349,32 @@ If TCP-P, the first two bytes of the package with be the length field."
308 ;; connection to the DNS server. 349 ;; connection to the DNS server.
309 (open-network-stream "dns" (current-buffer) server "domain"))))) 350 (open-network-stream "dns" (current-buffer) server "domain")))))
310 351
311(defun query-dns (name &optional type fullp) 352(defvar dns-cache (make-vector 4096 0))
353
354(defun query-dns-cached (name &optional type fullp reversep)
355 (let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
356 (sym (intern-soft key dns-cache)))
357 (if (and sym
358 (boundp sym))
359 (symbol-value sym)
360 (let ((result (query-dns name type fullp reversep)))
361 (set (intern key dns-cache) result)
362 result))))
363
364(defun query-dns (name &optional type fullp reversep)
312 "Query a DNS server for NAME of TYPE. 365 "Query a DNS server for NAME of TYPE.
313If FULLP, return the entire record returned." 366If FULLP, return the entire record returned.
367If REVERSEP, look up an IP address."
314 (setq type (or type 'A)) 368 (setq type (or type 'A))
315 (unless dns-servers 369 (unless dns-servers
316 (dns-parse-resolv-conf)) 370 (dns-parse-resolv-conf))
317 371
372 (when reversep
373 (setq name (concat
374 (mapconcat 'identity (nreverse (split-string name "\\.")) ".")
375 ".in-addr.arpa")
376 type 'PTR))
377
318 (if (not dns-servers) 378 (if (not dns-servers)
319 (message "No DNS server configuration found") 379 (message "No DNS server configuration found")
320 (mm-with-unibyte-buffer 380 (mm-with-unibyte-buffer
@@ -339,6 +399,7 @@ If FULLP, return the entire record returned."
339 tcp-p)) 399 tcp-p))
340 (while (and (zerop (buffer-size)) 400 (while (and (zerop (buffer-size))
341 (> times 0)) 401 (> times 0))
402 (sit-for (/ step 1000.0))
342 (accept-process-output process 0 step) 403 (accept-process-output process 0 step)
343 (decf times step)) 404 (decf times step))
344 (ignore-errors 405 (ignore-errors
@@ -347,13 +408,17 @@ If FULLP, return the entire record returned."
347 (>= (buffer-size) 2)) 408 (>= (buffer-size) 2))
348 (goto-char (point-min)) 409 (goto-char (point-min))
349 (delete-region (point) (+ (point) 2))) 410 (delete-region (point) (+ (point) 2)))
350 (when (>= (buffer-size) 2) 411 (when (and (>= (buffer-size) 2)
412 ;; We had a time-out.
413 (> times 0))
351 (let ((result (dns-read (buffer-string)))) 414 (let ((result (dns-read (buffer-string))))
352 (if fullp 415 (if fullp
353 result 416 result
354 (let ((answer (car (dns-get 'answers result)))) 417 (let ((answer (car (dns-get 'answers result))))
355 (when (eq type (dns-get 'type answer)) 418 (when (eq type (dns-get 'type answer))
356 (dns-get 'data answer))))))))))) 419 (if (eq type 'TXT)
420 (dns-get-txt-answer (dns-get 'answers result))
421 (dns-get 'data answer))))))))))))
357 422
358(provide 'dns) 423(provide 'dns)
359 424
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el
new file mode 100644
index 00000000000..1c333fd2e03
--- /dev/null
+++ b/lisp/gnus/ecomplete.el
@@ -0,0 +1,152 @@
1;;; ecomplete.el --- electric completion of addresses and the like
2;; Copyright (C) 2006 Free Software Foundation, Inc.
3
4;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5;; Keywords: mail
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
23
24;;; Commentary:
25
26;;; Code:
27
28(eval-when-compile
29 (require 'cl))
30
31(defgroup ecomplete nil
32 "Electric completion of email addresses and the like."
33 :group 'mail)
34
35(defcustom ecomplete-database-file "~/.ecompleterc"
36 "*The name of the file to store the ecomplete data."
37 :group 'ecomplete
38 :type 'file)
39
40(defcustom ecomplete-database-file-coding-system 'iso-2022-7bit
41 "Coding system used for writing the ecomplete database file."
42 :type '(symbol :tag "Coding system")
43 :group 'ecomplete)
44
45;;; Internal variables.
46
47(defvar ecomplete-database nil)
48
49;;;###autoload
50(defun ecomplete-setup ()
51 (when (file-exists-p ecomplete-database-file)
52 (with-temp-buffer
53 (let ((coding-system-for-read ecomplete-database-file-coding-system))
54 (insert-file-contents ecomplete-database-file)
55 (setq ecomplete-database (read (current-buffer)))))))
56
57(defun ecomplete-add-item (type key text)
58 (let ((elems (assq type ecomplete-database))
59 (now (string-to-number
60 (format "%.0f" (time-to-seconds (current-time)))))
61 entry)
62 (unless elems
63 (push (setq elems (list type)) ecomplete-database))
64 (if (setq entry (assoc key (cdr elems)))
65 (setcdr entry (list (1+ (cadr entry)) now text))
66 (nconc elems (list (list key 1 now text))))))
67
68(defun ecomplete-get-item (type key)
69 (assoc key (cdr (assq type ecomplete-database))))
70
71(defun ecomplete-save ()
72 (with-temp-buffer
73 (let ((coding-system-for-write ecomplete-database-file-coding-system))
74 (insert "(")
75 (loop for (type . elems) in ecomplete-database
76 do
77 (insert (format "(%s\n" type))
78 (dolist (entry elems)
79 (prin1 entry (current-buffer))
80 (insert "\n"))
81 (insert ")\n"))
82 (insert ")")
83 (write-region (point-min) (point-max)
84 ecomplete-database-file nil 'silent))))
85
86(defun ecomplete-get-matches (type match)
87 (let* ((elems (cdr (assq type ecomplete-database)))
88 (match (regexp-quote match))
89 (candidates
90 (sort
91 (loop for (key count time text) in elems
92 when (string-match match text)
93 collect (list count time text))
94 (lambda (l1 l2)
95 (> (car l1) (car l2))))))
96 (when (> (length candidates) 10)
97 (setcdr (nthcdr 10 candidates) nil))
98 (unless (zerop (length candidates))
99 (with-temp-buffer
100 (dolist (candidate candidates)
101 (insert (caddr candidate) "\n"))
102 (goto-char (point-min))
103 (put-text-property (point) (1+ (point)) 'ecomplete t)
104 (while (re-search-forward match nil t)
105 (put-text-property (match-beginning 0) (match-end 0)
106 'face 'isearch))
107 (buffer-string)))))
108
109(defun ecomplete-display-matches (type word &optional choose)
110 (let* ((matches (ecomplete-get-matches type word))
111 (line 0)
112 (max-lines (when matches (- (length (split-string matches "\n")) 2)))
113 (message-log-max nil)
114 command highlight)
115 (if (not matches)
116 (progn
117 (message "No ecomplete matches")
118 nil)
119 (if (not choose)
120 (progn
121 (message matches)
122 nil)
123 (setq highlight (ecomplete-highlight-match-line matches line))
124 (while (not (memq (setq command (read-event highlight)) '(? return)))
125 (cond
126 ((eq command ?\M-n)
127 (setq line (min (1+ line) max-lines)))
128 ((eq command ?\M-p)
129 (setq line (max (1- line) 0))))
130 (setq highlight (ecomplete-highlight-match-line matches line)))
131 (when (eq command 'return)
132 (nth line (split-string matches "\n")))))))
133
134(defun ecomplete-highlight-match-line (matches line)
135 (with-temp-buffer
136 (insert matches)
137 (goto-char (point-min))
138 (forward-line line)
139 (save-restriction
140 (narrow-to-region (point) (point-at-eol))
141 (while (not (eobp))
142 ;; Put the 'region face on any charactes on this line that
143 ;; aren't already highlighted.
144 (unless (get-text-property (point) 'face)
145 (put-text-property (point) (1+ (point)) 'face 'highlight))
146 (forward-char 1)))
147 (buffer-string)))
148
149(provide 'ecomplete)
150
151;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72
152;;; ecomplete.el ends here
diff --git a/lisp/gnus/encrypt.el b/lisp/gnus/encrypt.el
new file mode 100644
index 00000000000..02169dd25e0
--- /dev/null
+++ b/lisp/gnus/encrypt.el
@@ -0,0 +1,296 @@
1;;; encrypt.el --- file encryption routines
2;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
3
4;; Author: Teodor Zlatanov <tzz@lifelogs.com>
5;; Created: 2003/01/24
6;; Keywords: files
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 3, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;;; This module addresses data encryption. Page breaks are used for
28;;; grouping declarations and documentation relating to each
29;;; particular aspect.
30
31;;; Use in Gnus like this:
32;;; (setq
33;;; nnimap-authinfo-file "~/.authinfo.enc"
34;;; nntp-authinfo-file "~/.authinfo.enc"
35;;; smtpmail-auth-credentials "~/.authinfo.enc"
36;;; ;; using the AES256 cipher, feel free to use your own favorite
37;;; encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256"))))
38;;; password-cache-expiry 600)
39
40;;; Then write ~/.authinfo.enc:
41
42;;; 1) open the old authinfo
43;;; C-x C-f ~/.authinfo
44
45;;; 2) write the new authinfo.enc
46;;; M-x encrypt-file-contents ~/.authinfo.enc
47
48;;; 3) verify the new authinfo is correct (this will show the contents in the minibuffer)
49;;; M-: (encrypt-get-file-contents "~/.authinfo.enc")
50
51
52;;; Code:
53
54;; autoload password
55(eval-and-compile
56 (autoload 'password-read "password"))
57
58(defgroup encrypt '((password-cache custom-variable)
59 (password-cache-expiry custom-variable))
60 "File encryption configuration."
61 :group 'applications)
62
63(defcustom encrypt-file-alist nil
64 "List of file names or regexes matched with encryptions.
65Format example:
66 '((\"beta\"
67 (gpg \"AES\"))
68 (\"/home/tzz/alpha\"
69 (encrypt-xor \"Semi-Secret\")))"
70
71 :type '(repeat
72 (list :tag "Encryption entry"
73 (radio :tag "What to encrypt"
74 (file :tag "Filename")
75 (regexp :tag "Regular expression match"))
76 (radio :tag "How to encrypt it"
77 (list
78 :tag "GPG Encryption"
79 (const :tag "GPG Program" gpg)
80 (radio :tag "Choose a cipher"
81 (const :tag "3DES Encryption" "3DES")
82 (const :tag "CAST5 Encryption" "CAST5")
83 (const :tag "Blowfish Encryption" "BLOWFISH")
84 (const :tag "AES Encryption" "AES")
85 (const :tag "AES192 Encryption" "AES192")
86 (const :tag "AES256 Encryption" "AES256")
87 (const :tag "Twofish Encryption" "TWOFISH")
88 (string :tag "Cipher Name")))
89 (list
90 :tag "Built-in simple XOR"
91 (const :tag "XOR Encryption" encrypt-xor)
92 (string :tag "XOR Cipher Value (seed value)")))))
93 :group 'encrypt)
94
95;; TODO: now, load gencrypt.el and if successful, modify the
96;; custom-type of encrypt-file-alist to add the gencrypt.el options
97
98;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
99;; then use plist-put
100
101(defcustom encrypt-gpg-path (executable-find "gpg")
102 "Path to the GPG program."
103 :type '(radio
104 (file :tag "Location of the GPG executable")
105 (const :tag "GPG is not installed" nil))
106 :group 'encrypt)
107
108(defvar encrypt-temp-prefix "encrypt"
109 "Prefix for temporary filenames")
110
111;;;###autoload
112(defun encrypt-find-model (filename)
113 "Given a filename, find a encrypt-file-alist entry"
114 (dolist (entry encrypt-file-alist)
115 (let ((match (nth 0 entry))
116 (model (nth 1 entry)))
117 (when (or (eq match filename)
118 (string-match match filename))
119 (return model)))))
120
121;;;###autoload
122(defun encrypt-insert-file-contents (file &optional model)
123 "Decrypt FILE into the current buffer."
124 (interactive "fFile to insert: ")
125 (let* ((model (or model (encrypt-find-model file)))
126 (method (nth 0 model))
127 (cipher (nth 1 model))
128 (password-key (format "encrypt-password-%s-%s %s"
129 (symbol-name method) cipher file))
130 (passphrase
131 (password-read-and-add
132 (format "%s password for cipher %s (file %s)? "
133 file (symbol-name method) cipher)
134 password-key))
135 (buffer-file-coding-system 'binary)
136 (coding-system-for-read 'binary)
137 outdata)
138
139 ;; note we only insert-file-contents if the method is known to be valid
140 (cond
141 ((eq method 'gpg)
142 (insert-file-contents file)
143 (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
144 ((eq method 'encrypt-xor)
145 (insert-file-contents file)
146 (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
147
148 (if outdata
149 (progn
150 (message "%s was decrypted with %s (cipher %s)"
151 file (symbol-name method) cipher)
152 (delete-region (point-min) (point-max))
153 (goto-char (point-min))
154 (insert outdata))
155 ;; the decryption failed, alas
156 (password-cache-remove password-key)
157 (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
158 file (symbol-name method) cipher))))
159
160(defun encrypt-get-file-contents (file &optional model)
161 "Decrypt FILE and return the contents."
162 (interactive "fFile to decrypt: ")
163 (with-temp-buffer
164 (encrypt-insert-file-contents file model)
165 (buffer-string)))
166
167(defun encrypt-put-file-contents (file data &optional model)
168 "Encrypt the DATA to FILE, then continue normally."
169 (with-temp-buffer
170 (insert data)
171 (encrypt-write-file-contents file model)))
172
173(defun encrypt-write-file-contents (file &optional model)
174 "Encrypt the current buffer to FILE, then continue normally."
175 (interactive "sFile to write: ")
176 (setq model (or model (encrypt-find-model file)))
177 (if model
178 (let* ((method (nth 0 model))
179 (cipher (nth 1 model))
180 (password-key (format "encrypt-password-%s-%s %s"
181 (symbol-name method) cipher file))
182 (passphrase
183 (password-read
184 (format "%s password for cipher %s? "
185 (symbol-name method) cipher)
186 password-key))
187 outdata)
188
189 (cond
190 ((eq method 'gpg)
191 (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
192 ((eq method 'encrypt-xor)
193 (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
194
195 (if outdata
196 (progn
197 (message "%s was encrypted with %s (cipher %s)"
198 file (symbol-name method) cipher)
199 (delete-region (point-min) (point-max))
200 (goto-char (point-min))
201 (insert outdata)
202 ;; do not confirm overwrites
203 (write-file file nil))
204 ;; the decryption failed, alas
205 (password-cache-remove password-key)
206 (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
207 file (symbol-name method) cipher)))
208 (gnus-error 1 "%s has no associated encryption model! See encrypt-file-alist." file)))
209
210(defun encrypt-xor-encode-buffer (passphrase cipher)
211 (encrypt-xor-process-buffer passphrase cipher t))
212
213(defun encrypt-xor-decode-buffer (passphrase cipher)
214 (encrypt-xor-process-buffer passphrase cipher nil))
215
216(defun encrypt-xor-process-buffer (passphrase
217 cipher
218 &optional encode)
219 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
220 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
221 ;; passphrase-sum is a simple additive checksum of the
222 ;; passphrase and the cipher
223 (passphrase-sum
224 (when (stringp passphrase)
225 (apply '+ (append cipher passphrase nil))))
226 new-list)
227
228 (with-temp-buffer
229 (if encode
230 (progn
231 (dolist (x (append bs nil))
232 (setq new-list (cons (logxor x passphrase-sum) new-list)))
233
234 (dolist (x new-list)
235 (insert (format "%d " x))))
236 (progn
237 (setq new-list (reverse (split-string bs)))
238 (dolist (x new-list)
239 (setq x (string-to-number x))
240 (insert (format "%c" (logxor x passphrase-sum))))))
241 (buffer-substring-no-properties (point-min) (point-max)))))
242
243(defun encrypt-gpg-encode-buffer (passphrase cipher)
244 (encrypt-gpg-process-buffer passphrase cipher t))
245
246(defun encrypt-gpg-decode-buffer (passphrase cipher)
247 (encrypt-gpg-process-buffer passphrase cipher nil))
248
249(defun encrypt-gpg-process-buffer (passphrase
250 cipher
251 &optional encode)
252 "With PASSPHRASE, use GPG to encode or decode the current buffer."
253 (let* ((program encrypt-gpg-path)
254 (input (buffer-substring-no-properties (point-min) (point-max)))
255 (temp-maker (if (fboundp 'make-temp-file)
256 'make-temp-file
257 'make-temp-name))
258 (temp-file (funcall temp-maker encrypt-temp-prefix))
259 (default-enable-multibyte-characters nil)
260 (args `("--cipher-algo" ,cipher
261 "--status-fd" "2"
262 "--logger-fd" "2"
263 "--passphrase-fd" "0"
264 "--no-tty"))
265 exit-status exit-data)
266
267 (when encode
268 (setq args
269 (append args
270 '("--symmetric"
271 "--armor"))))
272
273 (if program
274 (with-temp-buffer
275 (when passphrase
276 (insert passphrase "\n"))
277 (insert input)
278 (setq exit-status
279 (apply #'call-process-region (point-min) (point-max) program
280 t `(t ,temp-file) nil args))
281 (if (equal exit-status 0)
282 (setq exit-data
283 (buffer-substring-no-properties (point-min) (point-max)))
284 (with-temp-buffer
285 (when (file-exists-p temp-file)
286 (insert-file-contents temp-file))
287 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
288 program exit-status (buffer-string)))))
289 (delete-file temp-file))
290 (gnus-error 5 "GPG is not installed."))
291 exit-data))
292
293(provide 'encrypt)
294;;; encrypt.el ends here
295
296;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648
diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el
index 5c2cd65b503..1644ed0f8f2 100644
--- a/lisp/gnus/flow-fill.el
+++ b/lisp/gnus/flow-fill.el
@@ -75,17 +75,6 @@ RFC 2646 suggests 66 characters for readability."
75 (sexp) 75 (sexp)
76 (integer))) 76 (integer)))
77 77
78(eval-and-compile
79 (defalias 'fill-flowed-point-at-bol
80 (if (fboundp 'point-at-bol)
81 'point-at-bol
82 'line-beginning-position))
83
84 (defalias 'fill-flowed-point-at-eol
85 (if (fboundp 'point-at-eol)
86 'point-at-eol
87 'line-end-position)))
88
89;;;###autoload 78;;;###autoload
90(defun fill-flowed-encode (&optional buffer) 79(defun fill-flowed-encode (&optional buffer)
91 (with-current-buffer (or buffer (current-buffer)) 80 (with-current-buffer (or buffer (current-buffer))
@@ -109,7 +98,7 @@ RFC 2646 suggests 66 characters for readability."
109 t))) 98 t)))
110 99
111;;;###autoload 100;;;###autoload
112(defun fill-flowed (&optional buffer) 101(defun fill-flowed (&optional buffer delete-space)
113 (save-excursion 102 (save-excursion
114 (set-buffer (or (current-buffer) buffer)) 103 (set-buffer (or (current-buffer) buffer))
115 (goto-char (point-min)) 104 (goto-char (point-min))
@@ -119,6 +108,8 @@ RFC 2646 suggests 66 characters for readability."
119 (forward-line 1)) 108 (forward-line 1))
120 (goto-char (point-min)) 109 (goto-char (point-min))
121 (while (re-search-forward " $" nil t) 110 (while (re-search-forward " $" nil t)
111 (when delete-space
112 (delete-char -1))
122 (when (save-excursion 113 (when (save-excursion
123 (beginning-of-line) 114 (beginning-of-line)
124 (looking-at "^\\(>*\\)\\( ?\\)")) 115 (looking-at "^\\(>*\\)\\( ?\\)"))
@@ -153,8 +144,8 @@ RFC 2646 suggests 66 characters for readability."
153 (fill-column (eval fill-flowed-display-column)) 144 (fill-column (eval fill-flowed-display-column))
154 filladapt-mode 145 filladapt-mode
155 adaptive-fill-mode) 146 adaptive-fill-mode)
156 (fill-region (fill-flowed-point-at-bol) 147 (fill-region (point-at-bol)
157 (min (1+ (fill-flowed-point-at-eol)) 148 (min (1+ (point-at-eol))
158 (point-max)) 149 (point-max))
159 'left 'nosqueeze)) 150 'left 'nosqueeze))
160 (error 151 (error
diff --git a/lisp/gnus/format-spec.el b/lisp/gnus/format-spec.el
index 137603e42c9..951f9aecb81 100644
--- a/lisp/gnus/format-spec.el
+++ b/lisp/gnus/format-spec.el
@@ -49,7 +49,7 @@ the text that it generates."
49 (spec (string-to-char (match-string 2))) 49 (spec (string-to-char (match-string 2)))
50 (val (cdr (assq spec specification)))) 50 (val (cdr (assq spec specification))))
51 (unless val 51 (unless val
52 (error "Invalid format character: %s" spec)) 52 (error "Invalid format character: `%%%c'" spec))
53 ;; Pad result to desired length. 53 ;; Pad result to desired length.
54 (let ((text (format (concat "%" num "s") val))) 54 (let ((text (format (concat "%" num "s") val)))
55 ;; Insert first, to preserve text properties. 55 ;; Insert first, to preserve text properties.
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 71a0662f35a..1d9f30c273c 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -50,6 +50,19 @@ jabbering all the time."
50 :group 'gmm) 50 :group 'gmm)
51 51
52;;;###autoload 52;;;###autoload
53(defun gmm-regexp-concat (regexp)
54 "Potentially concat a list of regexps into a single one.
55The concatenation is done with logical ORs."
56 (cond ((null regexp)
57 nil)
58 ((stringp regexp)
59 regexp)
60 ((listp regexp)
61 (mapconcat (lambda (elt) (concat "\\(" elt "\\)"))
62 regexp
63 "\\|"))))
64
65;;;###autoload
53(defun gmm-message (level &rest args) 66(defun gmm-message (level &rest args)
54 "If LEVEL is lower than `gmm-verbose' print ARGS using `message'. 67 "If LEVEL is lower than `gmm-verbose' print ARGS using `message'.
55 68
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 21b442aebbb..0271186273a 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -115,7 +115,7 @@ If nil, only read articles will be expired."
115 :group 'gnus-agent 115 :group 'gnus-agent
116 :type 'function) 116 :type 'function)
117 117
118(defcustom gnus-agent-synchronize-flags t 118(defcustom gnus-agent-synchronize-flags nil
119 "Indicate if flags are synchronized when you plug in. 119 "Indicate if flags are synchronized when you plug in.
120If this is `ask' the hook will query the user." 120If this is `ask' the hook will query the user."
121 ;; If the default switches to something else than nil, then the function 121 ;; If the default switches to something else than nil, then the function
@@ -251,11 +251,24 @@ NOTES:
251(defvar gnus-agent-send-mail-function nil) 251(defvar gnus-agent-send-mail-function nil)
252(defvar gnus-agent-file-coding-system 'raw-text) 252(defvar gnus-agent-file-coding-system 'raw-text)
253(defvar gnus-agent-file-loading-cache nil) 253(defvar gnus-agent-file-loading-cache nil)
254(defvar gnus-agent-total-fetched-hashtb nil)
255(defvar gnus-agent-inhibit-update-total-fetched-for nil)
256(defvar gnus-agent-need-update-total-fetched-for nil)
254 257
255;; Dynamic variables 258;; Dynamic variables
256(defvar gnus-headers) 259(defvar gnus-headers)
257(defvar gnus-score) 260(defvar gnus-score)
258 261
262;; Added to support XEmacs
263(eval-and-compile
264 (unless (fboundp 'directory-files-and-attributes)
265 (defun directory-files-and-attributes (directory
266 &optional full match nosort)
267 (let (result)
268 (dolist (file (directory-files directory full match nosort))
269 (push (cons file (file-attributes file)) result))
270 (nreverse result)))))
271
259;;; 272;;;
260;;; Setup 273;;; Setup
261;;; 274;;;
@@ -290,6 +303,17 @@ NOTES:
290;;; Utility functions 303;;; Utility functions
291;;; 304;;;
292 305
306(defmacro gnus-agent-with-refreshed-group (group &rest body)
307 "Performs the body then updates the group's line in the group
308buffer. Automatically blocks multiple updates due to recursion."
309`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
310 (when (and gnus-agent-need-update-total-fetched-for
311 (not gnus-agent-inhibit-update-total-fetched-for))
312 (save-excursion
313 (set-buffer gnus-group-buffer)
314 (setq gnus-agent-need-update-total-fetched-for nil)
315 (gnus-group-update-group ,group t)))))
316
293(defun gnus-agent-read-file (file) 317(defun gnus-agent-read-file (file)
294 "Load FILE and do a `read' there." 318 "Load FILE and do a `read' there."
295 (with-temp-buffer 319 (with-temp-buffer
@@ -345,8 +369,8 @@ manipulated as follows:
345 (let* ((--category--temp-- (make-symbol "--category--")) 369 (let* ((--category--temp-- (make-symbol "--category--"))
346 (--value--temp-- (make-symbol "--value--"))) 370 (--value--temp-- (make-symbol "--value--")))
347 (list (list --category--temp--) ; temporary-variables 371 (list (list --category--temp--) ; temporary-variables
348 (list category) ; value-forms 372 (list category) ; value-forms
349 (list --value--temp--) ; store-variables 373 (list --value--temp--) ; store-variables
350 (let* ((category --category--temp--) ; store-form 374 (let* ((category --category--temp--) ; store-form
351 (value --value--temp--)) 375 (value --value--temp--))
352 (list (quote gnus-agent-cat-set-property) 376 (list (quote gnus-agent-cat-set-property)
@@ -435,6 +459,16 @@ manipulated as follows:
435(defsubst gnus-agent-cat-make (name &optional default-agent-predicate) 459(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
436 (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) 460 (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
437 461
462(defun gnus-agent-read-group ()
463 "Read a group name in the minibuffer, with completion."
464 (let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
465 (when def
466 (setq def (gnus-group-decoded-name def)))
467 (gnus-group-completing-read (if def
468 (concat "Group Name (" def "): ")
469 "Group Name: ")
470 nil nil t nil nil def)))
471
438;;; Fetching setup functions. 472;;; Fetching setup functions.
439 473
440(defun gnus-agent-start-fetch () 474(defun gnus-agent-start-fetch ()
@@ -892,7 +926,8 @@ supported."
892 (new-command-method (gnus-find-method-for-group new-group)) 926 (new-command-method (gnus-find-method-for-group new-group))
893 (new-path (directory-file-name 927 (new-path (directory-file-name
894 (let (gnus-command-method new-command-method) 928 (let (gnus-command-method new-command-method)
895 (gnus-agent-group-pathname new-group))))) 929 (gnus-agent-group-pathname new-group))))
930 (file-name-coding-system nnmail-pathname-coding-system))
896 (gnus-rename-file old-path new-path t) 931 (gnus-rename-file old-path new-path t)
897 932
898 (let* ((old-real-group (gnus-group-real-name old-group)) 933 (let* ((old-real-group (gnus-group-real-name old-group))
@@ -920,7 +955,8 @@ supported."
920 (let* ((command-method (gnus-find-method-for-group group)) 955 (let* ((command-method (gnus-find-method-for-group group))
921 (path (directory-file-name 956 (path (directory-file-name
922 (let (gnus-command-method command-method) 957 (let (gnus-command-method command-method)
923 (gnus-agent-group-pathname group))))) 958 (gnus-agent-group-pathname group))))
959 (file-name-coding-system nnmail-pathname-coding-system))
924 (gnus-delete-directory path) 960 (gnus-delete-directory path)
925 961
926 (let* ((real-group (gnus-group-real-name group))) 962 (let* ((real-group (gnus-group-real-name group)))
@@ -1285,7 +1321,8 @@ This can be added to `gnus-select-article-hook' or
1285 (gnus-active-to-gnus-format nil new) 1321 (gnus-active-to-gnus-format nil new)
1286 (gnus-agent-write-active file new) 1322 (gnus-agent-write-active file new)
1287 (erase-buffer) 1323 (erase-buffer)
1288 (nnheader-insert-file-contents file)))) 1324 (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
1325 (nnheader-insert-file-contents file)))))
1289 1326
1290(defun gnus-agent-write-active (file new) 1327(defun gnus-agent-write-active (file new)
1291 (gnus-make-directory (file-name-directory file)) 1328 (gnus-make-directory (file-name-directory file))
@@ -1398,6 +1435,18 @@ downloaded into the agent."
1398 oactive-min (read (current-buffer))) ;; min 1435 oactive-min (read (current-buffer))) ;; min
1399 (cons oactive-min oactive-max)))))))) 1436 (cons oactive-min oactive-max))))))))
1400 1437
1438(defvar gnus-agent-decoded-group-names nil
1439 "Alist of non-ASCII group names and decoded ones.")
1440
1441(defun gnus-agent-decoded-group-name (group)
1442 "Return a decoded group name of GROUP."
1443 (or (cdr (assoc group gnus-agent-decoded-group-names))
1444 (if (string-match "[^\000-\177]" group)
1445 (let ((decoded (gnus-group-decoded-name group)))
1446 (push (cons group decoded) gnus-agent-decoded-group-names)
1447 decoded)
1448 group)))
1449
1401(defun gnus-agent-group-path (group) 1450(defun gnus-agent-group-path (group)
1402 "Translate GROUP into a file name." 1451 "Translate GROUP into a file name."
1403 1452
@@ -1409,26 +1458,25 @@ downloaded into the agent."
1409 (nnheader-translate-file-chars 1458 (nnheader-translate-file-chars
1410 (nnheader-replace-duplicate-chars-in-string 1459 (nnheader-replace-duplicate-chars-in-string
1411 (nnheader-replace-chars-in-string 1460 (nnheader-replace-chars-in-string
1412 (gnus-group-real-name (gnus-group-decoded-name group)) 1461 (gnus-group-real-name (gnus-agent-decoded-group-name group))
1413 ?/ ?_) 1462 ?/ ?_)
1414 ?. ?_))) 1463 ?. ?_)))
1415 (if (or nnmail-use-long-file-names 1464 (if (or nnmail-use-long-file-names
1416 (file-directory-p (expand-file-name group (gnus-agent-directory)))) 1465 (file-directory-p (expand-file-name group (gnus-agent-directory))))
1417 group 1466 group
1418 (mm-encode-coding-string 1467 (nnheader-replace-chars-in-string group ?. ?/)))
1419 (nnheader-replace-chars-in-string group ?. ?/)
1420 nnmail-pathname-coding-system)))
1421 1468
1422(defun gnus-agent-group-pathname (group) 1469(defun gnus-agent-group-pathname (group)
1423 "Translate GROUP into a file name." 1470 "Translate GROUP into a file name."
1424 ;; nnagent uses nnmail-group-pathname to read articles while 1471 ;; nnagent uses nnmail-group-pathname to read articles while
1425 ;; unplugged. The agent must, therefore, use the same directory 1472 ;; unplugged. The agent must, therefore, use the same directory
1426 ;; while plugged. 1473 ;; while plugged.
1427 (let ((gnus-command-method (or gnus-command-method 1474 (nnmail-group-pathname
1428 (gnus-find-method-for-group group)))) 1475 (gnus-group-real-name (gnus-agent-decoded-group-name group))
1429 (nnmail-group-pathname (gnus-group-real-name 1476 (if gnus-command-method
1430 (gnus-group-decoded-name group)) 1477 (gnus-agent-directory)
1431 (gnus-agent-directory)))) 1478 (let ((gnus-command-method (gnus-find-method-for-group group)))
1479 (gnus-agent-directory)))))
1432 1480
1433(defun gnus-agent-get-function (method) 1481(defun gnus-agent-get-function (method)
1434 (if (gnus-online method) 1482 (if (gnus-online method)
@@ -1532,7 +1580,8 @@ downloaded into the agent."
1532 (dir (gnus-agent-group-pathname group)) 1580 (dir (gnus-agent-group-pathname group))
1533 (date (time-to-days (current-time))) 1581 (date (time-to-days (current-time)))
1534 (case-fold-search t) 1582 (case-fold-search t)
1535 pos crosses id) 1583 pos crosses id
1584 (file-name-coding-system nnmail-pathname-coding-system))
1536 1585
1537 (setcar selected-sets (nreverse (car selected-sets))) 1586 (setcar selected-sets (nreverse (car selected-sets)))
1538 (setq selected-sets (nreverse selected-sets)) 1587 (setq selected-sets (nreverse selected-sets))
@@ -1601,33 +1650,46 @@ downloaded into the agent."
1601 (setq pos (cdr pos))))) 1650 (setq pos (cdr pos)))))
1602 1651
1603 (gnus-agent-save-alist group (cdr fetched-articles) date) 1652 (gnus-agent-save-alist group (cdr fetched-articles) date)
1653 (gnus-agent-update-files-total-fetched-for group (cdr fetched-articles))
1654
1604 (gnus-message 7 "")) 1655 (gnus-message 7 ""))
1605 (cdr fetched-articles)))))) 1656 (cdr fetched-articles))))))
1606 1657
1607(defun gnus-agent-unfetch-articles (group articles) 1658(defun gnus-agent-unfetch-articles (group articles)
1608 "Delete ARTICLES that were fetched from GROUP into the agent." 1659 "Delete ARTICLES that were fetched from GROUP into the agent."
1609 (when articles 1660 (when articles
1610 (gnus-agent-load-alist group) 1661 (gnus-agent-with-refreshed-group
1611 (let* ((alist (cons nil gnus-agent-article-alist)) 1662 group
1612 (articles (sort articles #'<)) 1663 (gnus-agent-load-alist group)
1613 (next-possibility alist) 1664 (let* ((alist (cons nil gnus-agent-article-alist))
1614 (delete-this (pop articles))) 1665 (articles (sort articles #'<))
1615 (while (and (cdr next-possibility) delete-this) 1666 (next-possibility alist)
1616 (let ((have-this (caar (cdr next-possibility)))) 1667 (delete-this (pop articles)))
1617 (cond ((< delete-this have-this) 1668 (while (and (cdr next-possibility) delete-this)
1618 (setq delete-this (pop articles))) 1669 (let ((have-this (caar (cdr next-possibility))))
1619 ((= delete-this have-this) 1670 (cond
1620 (let ((timestamp (cdar (cdr next-possibility)))) 1671 ((< delete-this have-this)
1621 (when timestamp 1672 (setq delete-this (pop articles)))
1622 (let* ((file-name (concat (gnus-agent-group-pathname group) 1673 ((= delete-this have-this)
1623 (number-to-string have-this)))) 1674 (let ((timestamp (cdar (cdr next-possibility))))
1624 (delete-file file-name)))) 1675 (when timestamp
1625 1676 (let* ((file-name (concat (gnus-agent-group-pathname group)
1626 (setcdr next-possibility (cddr next-possibility))) 1677 (number-to-string have-this)))
1627 (t 1678 (size-file
1628 (setq next-possibility (cdr next-possibility)))))) 1679 (float (or (and gnus-agent-total-fetched-hashtb
1629 (setq gnus-agent-article-alist (cdr alist)) 1680 (nth 7 (file-attributes file-name)))
1630 (gnus-agent-save-alist group)))) 1681 0)))
1682 (file-name-coding-system
1683 nnmail-pathname-coding-system))
1684 (delete-file file-name)
1685 (gnus-agent-update-files-total-fetched-for
1686 group (- size-file)))))
1687
1688 (setcdr next-possibility (cddr next-possibility)))
1689 (t
1690 (setq next-possibility (cdr next-possibility))))))
1691 (setq gnus-agent-article-alist (cdr alist))
1692 (gnus-agent-save-alist group)))))
1631 1693
1632(defun gnus-agent-crosspost (crosses article &optional date) 1694(defun gnus-agent-crosspost (crosses article &optional date)
1633 (setq date (or date t)) 1695 (setq date (or date t))
@@ -1651,8 +1713,9 @@ downloaded into the agent."
1651 (when (= (point-max) (point-min)) 1713 (when (= (point-max) (point-min))
1652 (push (cons group (current-buffer)) gnus-agent-buffer-alist) 1714 (push (cons group (current-buffer)) gnus-agent-buffer-alist)
1653 (ignore-errors 1715 (ignore-errors
1654 (nnheader-insert-file-contents 1716 (let ((file-name-coding-system nnmail-pathname-coding-system))
1655 (gnus-agent-article-name ".overview" group)))) 1717 (nnheader-insert-file-contents
1718 (gnus-agent-article-name ".overview" group)))))
1656 (nnheader-find-nov-line (string-to-number (cdar crosses))) 1719 (nnheader-find-nov-line (string-to-number (cdar crosses)))
1657 (insert (string-to-number (cdar crosses))) 1720 (insert (string-to-number (cdar crosses)))
1658 (insert-buffer-substring gnus-agent-overview-buffer beg end) 1721 (insert-buffer-substring gnus-agent-overview-buffer beg end)
@@ -1663,7 +1726,8 @@ downloaded into the agent."
1663 (when gnus-newsgroup-name 1726 (when gnus-newsgroup-name
1664 (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name)) 1727 (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
1665 (cnt 0) 1728 (cnt 0)
1666 name) 1729 name
1730 (file-name-coding-system nnmail-pathname-coding-system))
1667 (while (file-exists-p 1731 (while (file-exists-p
1668 (setq name (concat root "~" 1732 (setq name (concat root "~"
1669 (int-to-string (setq cnt (1+ cnt))) "~")))) 1733 (int-to-string (setq cnt (1+ cnt))) "~"))))
@@ -1697,7 +1761,7 @@ and that there are no duplicates."
1697 (gnus-message 1 1761 (gnus-message 1
1698 "Overview buffer contains garbage '%s'." 1762 "Overview buffer contains garbage '%s'."
1699 (buffer-substring 1763 (buffer-substring
1700 p (gnus-point-at-eol)))) 1764 p (point-at-eol))))
1701 ((= cur prev-num) 1765 ((= cur prev-num)
1702 (or backed-up 1766 (or backed-up
1703 (setq backed-up (gnus-agent-backup-overview-buffer))) 1767 (setq backed-up (gnus-agent-backup-overview-buffer)))
@@ -1715,25 +1779,71 @@ and that there are no duplicates."
1715 (setq prev-num cur))) 1779 (setq prev-num cur)))
1716 (forward-line 1))))))) 1780 (forward-line 1)))))))
1717 1781
1782(defun gnus-agent-flush-server (&optional server-or-method)
1783 "Flush all agent index files for every subscribed group within
1784 the given SERVER-OR-METHOD. When called with nil, the current
1785 value of gnus-command-method identifies the server."
1786 (let* ((gnus-command-method (if server-or-method
1787 (gnus-server-to-method server-or-method)
1788 gnus-command-method))
1789 (alist gnus-newsrc-alist))
1790 (while alist
1791 (let ((entry (pop alist)))
1792 (when (gnus-methods-equal-p gnus-command-method (gnus-info-method entry))
1793 (gnus-agent-flush-group (gnus-info-group entry)))))))
1794
1795(defun gnus-agent-flush-group (group)
1796 "Flush the agent's index files such that the GROUP no longer
1797appears to have any local content. The actual content, the
1798article files, may then be deleted using gnus-agent-expire-group.
1799If flushing was a mistake, the gnus-agent-regenerate-group method
1800provides an undo mechanism by reconstructing the index files from
1801the article files."
1802 (interactive (list (gnus-agent-read-group)))
1803
1804 (let* ((gnus-command-method (or gnus-command-method
1805 (gnus-find-method-for-group group)))
1806 (overview (gnus-agent-article-name ".overview" group))
1807 (agentview (gnus-agent-article-name ".agentview" group))
1808 (file-name-coding-system nnmail-pathname-coding-system))
1809
1810 (if (file-exists-p overview)
1811 (delete-file overview))
1812 (if (file-exists-p agentview)
1813 (delete-file agentview))
1814
1815 (gnus-agent-update-view-total-fetched-for group nil gnus-command-method)
1816 (gnus-agent-update-view-total-fetched-for group t gnus-command-method)
1817
1818 ;(gnus-agent-set-local group nil nil)
1819 ;(gnus-agent-save-local t)
1820 (gnus-agent-save-group-info nil group nil)))
1821
1718(defun gnus-agent-flush-cache () 1822(defun gnus-agent-flush-cache ()
1823 "Flush the agent's index files such that the group no longer
1824appears to have any local content. The actual content, the
1825article files, is then deleted using gnus-agent-expire-group. The
1826gnus-agent-regenerate-group method provides an undo mechanism by
1827reconstructing the index files from the article files."
1828 (interactive)
1719 (save-excursion 1829 (save-excursion
1720 (while gnus-agent-buffer-alist 1830 (let ((file-name-coding-system nnmail-pathname-coding-system))
1721 (set-buffer (cdar gnus-agent-buffer-alist)) 1831 (while gnus-agent-buffer-alist
1722 (let ((coding-system-for-write 1832 (set-buffer (cdar gnus-agent-buffer-alist))
1723 gnus-agent-file-coding-system)) 1833 (let ((coding-system-for-write gnus-agent-file-coding-system))
1724 (write-region (point-min) (point-max) 1834 (write-region (point-min) (point-max)
1725 (gnus-agent-article-name ".overview" 1835 (gnus-agent-article-name ".overview"
1726 (caar gnus-agent-buffer-alist)) 1836 (caar gnus-agent-buffer-alist))
1727 nil 'silent)) 1837 nil 'silent))
1728 (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist))) 1838 (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
1729 (while gnus-agent-group-alist 1839 (while gnus-agent-group-alist
1730 (with-temp-file (gnus-agent-article-name 1840 (with-temp-file (gnus-agent-article-name
1731 ".agentview" (caar gnus-agent-group-alist)) 1841 ".agentview" (caar gnus-agent-group-alist))
1732 (princ (cdar gnus-agent-group-alist)) 1842 (princ (cdar gnus-agent-group-alist))
1733 (insert "\n") 1843 (insert "\n")
1734 (princ 1 (current-buffer)) 1844 (princ 1 (current-buffer))
1735 (insert "\n")) 1845 (insert "\n"))
1736 (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) 1846 (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))))
1737 1847
1738;;;###autoload 1848;;;###autoload
1739(defun gnus-agent-find-parameter (group symbol) 1849(defun gnus-agent-find-parameter (group symbol)
@@ -1777,7 +1887,8 @@ article numbers will be returned."
1777 (gnus-list-of-unread-articles group))) 1887 (gnus-list-of-unread-articles group)))
1778 (gnus-decode-encoded-word-function 'identity) 1888 (gnus-decode-encoded-word-function 'identity)
1779 (gnus-decode-encoded-address-function 'identity) 1889 (gnus-decode-encoded-address-function 'identity)
1780 (file (gnus-agent-article-name ".overview" group))) 1890 (file (gnus-agent-article-name ".overview" group))
1891 (file-name-coding-system nnmail-pathname-coding-system))
1781 1892
1782 (unless fetch-all 1893 (unless fetch-all
1783 ;; Add articles with marks to the list of article headers we want to 1894 ;; Add articles with marks to the list of article headers we want to
@@ -1857,6 +1968,7 @@ article numbers will be returned."
1857 gnus-agent-file-coding-system)) 1968 gnus-agent-file-coding-system))
1858 (gnus-agent-check-overview-buffer) 1969 (gnus-agent-check-overview-buffer)
1859 (write-region (point-min) (point-max) file nil 'silent)) 1970 (write-region (point-min) (point-max) file nil 'silent))
1971 (gnus-agent-update-view-total-fetched-for group t)
1860 (gnus-agent-save-alist group articles nil) 1972 (gnus-agent-save-alist group articles nil)
1861 articles) 1973 articles)
1862 (ignore-errors 1974 (ignore-errors
@@ -1926,21 +2038,21 @@ doesn't exist, to valid the overview buffer."
1926 (gnus-agent-copy-nov-line (pop articles)) 2038 (gnus-agent-copy-nov-line (pop articles))
1927 2039
1928 (ignore-errors 2040 (ignore-errors
1929 (while articles 2041 (while articles
1930 (while (let ((art (read (current-buffer)))) 2042 (while (let ((art (read (current-buffer))))
1931 (cond ((< art (car articles)) 2043 (cond ((< art (car articles))
1932 (forward-line 1) 2044 (forward-line 1)
1933 t) 2045 t)
1934 ((= art (car articles)) 2046 ((= art (car articles))
1935 (beginning-of-line) 2047 (beginning-of-line)
1936 (delete-region 2048 (delete-region
1937 (point) (progn (forward-line 1) (point))) 2049 (point) (progn (forward-line 1) (point)))
1938 nil) 2050 nil)
1939 (t 2051 (t
1940 (beginning-of-line) 2052 (beginning-of-line)
1941 nil)))) 2053 nil))))
1942 2054
1943 (gnus-agent-copy-nov-line (pop articles))))) 2055 (gnus-agent-copy-nov-line (pop articles)))))
1944 2056
1945 (goto-char (point-max)) 2057 (goto-char (point-max))
1946 2058
@@ -1957,26 +2069,26 @@ doesn't exist, to valid the overview buffer."
1957 2069
1958 (setq last (or last -134217728)) 2070 (setq last (or last -134217728))
1959 (while (catch 'problems 2071 (while (catch 'problems
1960 (let (sort art) 2072 (let (sort art)
1961 (while (not (eobp)) 2073 (while (not (eobp))
1962 (setq art (gnus-agent-read-article-number)) 2074 (setq art (gnus-agent-read-article-number))
1963 (cond ((not art) 2075 (cond ((not art)
1964 ;; Bad art num - delete this line 2076 ;; Bad art num - delete this line
1965 (beginning-of-line) 2077 (beginning-of-line)
1966 (delete-region (point) (progn (forward-line 1) (point)))) 2078 (delete-region (point) (progn (forward-line 1) (point))))
1967 ((< art last) 2079 ((< art last)
1968 ;; Art num out of order - enable sort 2080 ;; Art num out of order - enable sort
1969 (setq sort t) 2081 (setq sort t)
1970 (forward-line 1)) 2082 (forward-line 1))
1971 ((= art last) 2083 ((= art last)
1972 ;; Bad repeat of art number - delete this line 2084 ;; Bad repeat of art number - delete this line
1973 (beginning-of-line) 2085 (beginning-of-line)
1974 (delete-region (point) (progn (forward-line 1) (point)))) 2086 (delete-region (point) (progn (forward-line 1) (point))))
1975 (t 2087 (t
1976 ;; Good art num 2088 ;; Good art num
1977 (setq last art) 2089 (setq last art)
1978 (forward-line 1)))) 2090 (forward-line 1))))
1979 (when sort 2091 (when sort
1980 ;; something is seriously wrong as we simply shouldn't see out-of-order data. 2092 ;; something is seriously wrong as we simply shouldn't see out-of-order data.
1981 ;; First, we'll fix the sort. 2093 ;; First, we'll fix the sort.
1982 (sort-numeric-fields 1 (point-min) (point-max)) 2094 (sort-numeric-fields 1 (point-min) (point-max))
@@ -1998,7 +2110,8 @@ doesn't exist, to valid the overview buffer."
1998(defun gnus-agent-load-alist (group) 2110(defun gnus-agent-load-alist (group)
1999 "Load the article-state alist for GROUP." 2111 "Load the article-state alist for GROUP."
2000 ;; Bind free variable that's used in `gnus-agent-read-agentview'. 2112 ;; Bind free variable that's used in `gnus-agent-read-agentview'.
2001 (let ((gnus-agent-read-agentview group)) 2113 (let ((gnus-agent-read-agentview group)
2114 (file-name-coding-system nnmail-pathname-coding-system))
2002 (setq gnus-agent-article-alist 2115 (setq gnus-agent-article-alist
2003 (gnus-cache-file-contents 2116 (gnus-cache-file-contents
2004 (gnus-agent-article-name ".agentview" group) 2117 (gnus-agent-article-name ".agentview" group)
@@ -2009,52 +2122,63 @@ doesn't exist, to valid the overview buffer."
2009 "Load FILE and do a `read' there." 2122 "Load FILE and do a `read' there."
2010 (with-temp-buffer 2123 (with-temp-buffer
2011 (condition-case nil 2124 (condition-case nil
2012 (progn 2125 (progn
2013 (nnheader-insert-file-contents file) 2126 (nnheader-insert-file-contents file)
2014 (goto-char (point-min)) 2127 (goto-char (point-min))
2015 (let ((alist (read (current-buffer))) 2128 (let ((alist (read (current-buffer)))
2016 (version (condition-case nil (read (current-buffer)) 2129 (version (condition-case nil (read (current-buffer))
2017 (end-of-file 0))) 2130 (end-of-file 0)))
2018 changed-version) 2131 changed-version)
2019 2132
2020 (cond 2133 (cond
2021 ((= version 0) 2134 ((= version 0)
2022 (let ((inhibit-quit t) 2135 (let ((inhibit-quit t)
2023 entry) 2136 entry)
2024 (gnus-agent-open-history) 2137 (gnus-agent-open-history)
2025 (set-buffer (gnus-agent-history-buffer)) 2138 (set-buffer (gnus-agent-history-buffer))
2026 (goto-char (point-min)) 2139 (goto-char (point-min))
2027 (while (not (eobp)) 2140 (while (not (eobp))
2028 (if (and (looking-at 2141 (if (and (looking-at
2029 "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") 2142 "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
2030 (string= (match-string 2) 2143 (string= (match-string 2)
2031 gnus-agent-read-agentview) 2144 gnus-agent-read-agentview)
2032 (setq entry (assoc (string-to-number (match-string 3)) alist))) 2145 (setq entry (assoc (string-to-number (match-string 3)) alist)))
2033 (setcdr entry (string-to-number (match-string 1)))) 2146 (setcdr entry (string-to-number (match-string 1))))
2034 (forward-line 1)) 2147 (forward-line 1))
2035 (gnus-agent-close-history) 2148 (gnus-agent-close-history)
2036 (setq changed-version t))) 2149 (setq changed-version t)))
2037 ((= version 1) 2150 ((= version 1)
2038 (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) 2151 (setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
2039 ((= version 2) 2152 ((= version 2)
2040 (let (uncomp) 2153 (let (state sequence uncomp)
2041 (mapcar 2154 (while alist
2042 (lambda (comp-list) 2155 (setq state (caar alist)
2043 (let ((state (car comp-list)) 2156 sequence (inline (gnus-uncompress-range (cdar alist)))
2044 (sequence (inline 2157 alist (cdr alist))
2045 (gnus-uncompress-range 2158 (while sequence
2046 (cdr comp-list))))) 2159 (push (cons (pop sequence) state) uncomp)))
2047 (mapcar (lambda (article-id)
2048 (setq uncomp (cons (cons article-id state) uncomp)))
2049 sequence)))
2050 alist)
2051 (setq alist (sort uncomp 'car-less-than-car))) 2160 (setq alist (sort uncomp 'car-less-than-car)))
2052 (setq changed-version (not (= 2 gnus-agent-article-alist-save-format))))) 2161 (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
2053 (when changed-version 2162 (when changed-version
2054 (let ((gnus-agent-article-alist alist)) 2163 (let ((gnus-agent-article-alist alist))
2055 (gnus-agent-save-alist gnus-agent-read-agentview))) 2164 (gnus-agent-save-alist gnus-agent-read-agentview)))
2056 alist)) 2165 alist))
2057 (file-error nil)))) 2166 ((end-of-file file-error)
2167 ;; The agentview file is missing.
2168 (condition-case nil
2169 ;; If the agent directory exists, attempt to perform a brute-force
2170 ;; reconstruction of its contents.
2171 (let* (alist
2172 (file-name-coding-system nnmail-pathname-coding-system)
2173 (file-attributes (directory-files-and-attributes
2174 (gnus-agent-article-name ""
2175 gnus-agent-read-agentview) nil "^[0-9]+$" t)))
2176 (while file-attributes
2177 (let ((fa (pop file-attributes)))
2178 (unless (nth 1 fa)
2179 (push (cons (string-to-number (nth 0 fa)) (time-to-days (nth 5 fa))) alist))))
2180 alist)
2181 (file-error nil))))))
2058 2182
2059(defun gnus-agent-save-alist (group &optional articles state) 2183(defun gnus-agent-save-alist (group &optional articles state)
2060 "Save the article-state alist for GROUP." 2184 "Save the article-state alist for GROUP."
@@ -2085,27 +2209,27 @@ doesn't exist, to valid the overview buffer."
2085 (cond ((eq gnus-agent-article-alist-save-format 1) 2209 (cond ((eq gnus-agent-article-alist-save-format 1)
2086 (princ gnus-agent-article-alist (current-buffer))) 2210 (princ gnus-agent-article-alist (current-buffer)))
2087 ((eq gnus-agent-article-alist-save-format 2) 2211 ((eq gnus-agent-article-alist-save-format 2)
2088 (let ((compressed nil)) 2212 (let ((alist gnus-agent-article-alist)
2089 (mapcar (lambda (pair) 2213 article-id day-of-download comp-list compressed)
2090 (let* ((article-id (car pair)) 2214 (while alist
2091 (day-of-download (cdr pair)) 2215 (setq article-id (caar alist)
2092 (comp-list (assq day-of-download compressed))) 2216 day-of-download (cdar alist)
2093 (if comp-list 2217 comp-list (assq day-of-download compressed)
2094 (setcdr comp-list 2218 alist (cdr alist))
2095 (cons article-id (cdr comp-list))) 2219 (if comp-list
2096 (setq compressed 2220 (setcdr comp-list (cons article-id (cdr comp-list)))
2097 (cons (list day-of-download article-id) 2221 (push (list day-of-download article-id) compressed)))
2098 compressed))) 2222 (setq alist compressed)
2099 nil)) gnus-agent-article-alist) 2223 (while alist
2100 (mapcar (lambda (comp-list) 2224 (setq comp-list (pop alist))
2101 (setcdr comp-list 2225 (setcdr comp-list
2102 (gnus-compress-sequence 2226 (gnus-compress-sequence (nreverse (cdr comp-list)))))
2103 (nreverse (cdr comp-list)))))
2104 compressed)
2105 (princ compressed (current-buffer))))) 2227 (princ compressed (current-buffer)))))
2106 (insert "\n") 2228 (insert "\n")
2107 (princ gnus-agent-article-alist-save-format (current-buffer)) 2229 (princ gnus-agent-article-alist-save-format (current-buffer))
2108 (insert "\n")))) 2230 (insert "\n"))
2231
2232 (gnus-agent-update-view-total-fetched-for group nil)))
2109 2233
2110(defvar gnus-agent-article-local nil) 2234(defvar gnus-agent-article-local nil)
2111(defvar gnus-agent-file-loading-local nil) 2235(defvar gnus-agent-file-loading-local nil)
@@ -2183,10 +2307,10 @@ modified) original contents, they are first saved to their own file."
2183 (dest (gnus-agent-lib-file "local"))) 2307 (dest (gnus-agent-lib-file "local")))
2184 (gnus-make-directory (gnus-agent-lib-file "")) 2308 (gnus-make-directory (gnus-agent-lib-file ""))
2185 2309
2186 (let ((buffer-file-coding-system gnus-agent-file-coding-system)) 2310 (let ((coding-system-for-write gnus-agent-file-coding-system)
2311 (file-name-coding-system nnmail-pathname-coding-system))
2187 (with-temp-file dest 2312 (with-temp-file dest
2188 (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) 2313 (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
2189 (file-name-coding-system nnmail-pathname-coding-system)
2190 print-level print-length item article 2314 print-level print-length item article
2191 (standard-output (current-buffer))) 2315 (standard-output (current-buffer)))
2192 (mapatoms (lambda (symbol) 2316 (mapatoms (lambda (symbol)
@@ -2197,11 +2321,11 @@ modified) original contents, they are first saved to their own file."
2197 (t 2321 (t
2198 (let ((range (symbol-value symbol))) 2322 (let ((range (symbol-value symbol)))
2199 (when range 2323 (when range
2200 (prin1 symbol) 2324 (prin1 symbol)
2201 (princ " ") 2325 (princ " ")
2202 (princ (car range)) 2326 (princ (car range))
2203 (princ " ") 2327 (princ " ")
2204 (princ (cdr range)) 2328 (princ (cdr range))
2205 (princ "\n")))))) 2329 (princ "\n"))))))
2206 my-obarray)))))))) 2330 my-obarray))))))))
2207 2331
@@ -2462,8 +2586,8 @@ modified) original contents, they are first saved to their own file."
2462 (when gnus-agent-mark-unread-after-downloaded 2586 (when gnus-agent-mark-unread-after-downloaded
2463 (setq gnus-newsgroup-downloadable 2587 (setq gnus-newsgroup-downloadable
2464 (delq article gnus-newsgroup-downloadable)) 2588 (delq article gnus-newsgroup-downloadable))
2465 (gnus-summary-mark-article 2589 (gnus-summary-mark-article
2466 article gnus-unread-mark)) 2590 article gnus-unread-mark))
2467 (when (gnus-summary-goto-subject article nil t) 2591 (when (gnus-summary-goto-subject article nil t)
2468 (gnus-summary-update-download-mark article))) 2592 (gnus-summary-update-download-mark article)))
2469 (dolist (article unfetched-articles) 2593 (dolist (article unfetched-articles)
@@ -2654,7 +2778,7 @@ The following commands are available:
2654 (gnus-category-position-point))) 2778 (gnus-category-position-point)))
2655 2779
2656(defun gnus-category-name () 2780(defun gnus-category-name ()
2657 (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category)) 2781 (or (intern (get-text-property (point-at-bol) 'gnus-category))
2658 (error "No category on the current line"))) 2782 (error "No category on the current line")))
2659 2783
2660(defun gnus-category-read () 2784(defun gnus-category-read ()
@@ -2975,22 +3099,12 @@ The articles on which the expiration process runs are selected as follows:
2975 if ARTICLES is t, all articles. 3099 if ARTICLES is t, all articles.
2976 if ARTICLES is a list, just those articles. 3100 if ARTICLES is a list, just those articles.
2977FORCE is equivalent to setting the expiration predicates to true." 3101FORCE is equivalent to setting the expiration predicates to true."
2978 (interactive 3102 (interactive (list (gnus-agent-read-group)))
2979 (list (let ((def (or (gnus-group-group-name)
2980 gnus-newsgroup-name)))
2981 (let ((select (read-string (if def
2982 (concat "Group Name ("
2983 def "): ")
2984 "Group Name: "))))
2985 (if (and (equal "" select)
2986 def)
2987 def
2988 select)))))
2989 3103
2990 (if (not group) 3104 (if (not group)
2991 (gnus-agent-expire articles group force) 3105 (gnus-agent-expire articles group force)
2992 (let ( ;; Bind gnus-agent-expire-stats to enable tracking of 3106 (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
2993 ;; expiration statistics of this single group 3107 ;; expiration statistics of this single group
2994 (gnus-agent-expire-stats (list 0 0 0.0))) 3108 (gnus-agent-expire-stats (list 0 0 0.0)))
2995 (if (or (not (eq articles t)) 3109 (if (or (not (eq articles t))
2996 (yes-or-no-p 3110 (yes-or-no-p
@@ -3020,337 +3134,375 @@ FORCE is equivalent to setting the expiration predicates to true."
3020 ;; gnus-command-method, initialized overview buffer, and to have 3134 ;; gnus-command-method, initialized overview buffer, and to have
3021 ;; provided a non-nil active 3135 ;; provided a non-nil active
3022 3136
3023 (let ((dir (gnus-agent-group-pathname group))) 3137 (let ((dir (gnus-agent-group-pathname group))
3024 (when (boundp 'gnus-agent-expire-current-dirs) 3138 (file-name-coding-system nnmail-pathname-coding-system)
3025 (set 'gnus-agent-expire-current-dirs 3139 (decoded (gnus-agent-decoded-group-name group)))
3026 (cons dir 3140 (gnus-agent-with-refreshed-group
3027 (symbol-value 'gnus-agent-expire-current-dirs)))) 3141 group
3028 3142 (when (boundp 'gnus-agent-expire-current-dirs)
3029 (if (and (not force) 3143 (set 'gnus-agent-expire-current-dirs
3030 (eq 'DISABLE (gnus-agent-find-parameter group 3144 (cons dir
3031 'agent-enable-expiration))) 3145 (symbol-value 'gnus-agent-expire-current-dirs))))
3032 (gnus-message 5 "Expiry skipping over %s" group) 3146
3033 (gnus-message 5 "Expiring articles in %s" group) 3147 (if (and (not force)
3034 (gnus-agent-load-alist group) 3148 (eq 'DISABLE (gnus-agent-find-parameter group
3035 (let* ((bytes-freed 0) 3149 'agent-enable-expiration)))
3036 (files-deleted 0) 3150 (gnus-message 5 "Expiry skipping over %s" decoded)
3037 (nov-entries-deleted 0) 3151 (gnus-message 5 "Expiring articles in %s" decoded)
3038 (info (gnus-get-info group)) 3152 (gnus-agent-load-alist group)
3039 (alist gnus-agent-article-alist) 3153 (let* ((bytes-freed 0)
3040 (day (- (time-to-days (current-time)) 3154 (size-files-deleted 0.0)
3041 (gnus-agent-find-parameter group 'agent-days-until-old))) 3155 (files-deleted 0)
3042 (specials (if (and alist 3156 (nov-entries-deleted 0)
3043 (not force)) 3157 (info (gnus-get-info group))
3044 ;; This could be a bit of a problem. I need to 3158 (alist gnus-agent-article-alist)
3045 ;; keep the last article to avoid refetching 3159 (day (- (time-to-days (current-time))
3046 ;; headers when using nntp in the backend. At 3160 (gnus-agent-find-parameter group 'agent-days-until-old)))
3047 ;; the same time, if someone uses a backend 3161 (specials (if (and alist
3048 ;; that supports article moving then I may have 3162 (not force))
3049 ;; to remove the last article to complete the 3163 ;; This could be a bit of a problem. I need to
3050 ;; move. Right now, I'm going to assume that 3164 ;; keep the last article to avoid refetching
3051 ;; FORCE overrides specials. 3165 ;; headers when using nntp in the backend. At
3052 (list (caar (last alist))))) 3166 ;; the same time, if someone uses a backend
3053 (unreads ;; Articles that are excluded from the 3167 ;; that supports article moving then I may have
3054 ;; expiration process 3168 ;; to remove the last article to complete the
3055 (cond (gnus-agent-expire-all 3169 ;; move. Right now, I'm going to assume that
3056 ;; All articles are marked read by global decree 3170 ;; FORCE overrides specials.
3057 nil) 3171 (list (caar (last alist)))))
3058 ((eq articles t) 3172 (unreads ;; Articles that are excluded from the
3059 ;; All articles are marked read by function 3173 ;; expiration process
3060 ;; parameter 3174 (cond (gnus-agent-expire-all
3061 nil) 3175 ;; All articles are marked read by global decree
3062 ((not articles) 3176 nil)
3063 ;; Unread articles are marked protected from 3177 ((eq articles t)
3064 ;; expiration Don't call 3178 ;; All articles are marked read by function
3065 ;; gnus-list-of-unread-articles as it returns 3179 ;; parameter
3066 ;; articles that have not been fetched into the 3180 nil)
3067 ;; agent. 3181 ((not articles)
3068 (ignore-errors 3182 ;; Unread articles are marked protected from
3069 (gnus-agent-unread-articles group))) 3183 ;; expiration Don't call
3070 (t 3184 ;; gnus-list-of-unread-articles as it returns
3071 ;; All articles EXCEPT those named by the caller 3185 ;; articles that have not been fetched into the
3072 ;; are protected from expiration 3186 ;; agent.
3073 (gnus-sorted-difference 3187 (ignore-errors
3074 (gnus-uncompress-range 3188 (gnus-agent-unread-articles group)))
3075 (cons (caar alist) 3189 (t
3076 (caar (last alist)))) 3190 ;; All articles EXCEPT those named by the caller
3077 (sort articles '<))))) 3191 ;; are protected from expiration
3078 (marked ;; More articles that are excluded from the 3192 (gnus-sorted-difference
3079 ;; expiration process 3193 (gnus-uncompress-range
3080 (cond (gnus-agent-expire-all 3194 (cons (caar alist)
3081 ;; All articles are unmarked by global decree 3195 (caar (last alist))))
3082 nil) 3196 (sort articles '<)))))
3083 ((eq articles t) 3197 (marked ;; More articles that are excluded from the
3084 ;; All articles are unmarked by function 3198 ;; expiration process
3085 ;; parameter 3199 (cond (gnus-agent-expire-all
3086 nil) 3200 ;; All articles are unmarked by global decree
3087 (articles 3201 nil)
3088 ;; All articles may as well be unmarked as the 3202 ((eq articles t)
3089 ;; unreads list already names the articles we are 3203 ;; All articles are unmarked by function
3090 ;; going to keep 3204 ;; parameter
3091 nil) 3205 nil)
3092 (t 3206 (articles
3093 ;; Ticked and/or dormant articles are excluded 3207 ;; All articles may as well be unmarked as the
3094 ;; from expiration 3208 ;; unreads list already names the articles we are
3095 (nconc 3209 ;; going to keep
3096 (gnus-uncompress-range 3210 nil)
3097 (cdr (assq 'tick (gnus-info-marks info)))) 3211 (t
3098 (gnus-uncompress-range 3212 ;; Ticked and/or dormant articles are excluded
3099 (cdr (assq 'dormant 3213 ;; from expiration
3100 (gnus-info-marks info)))))))) 3214 (nconc
3101 (nov-file (concat dir ".overview")) 3215 (gnus-uncompress-range
3102 (cnt 0) 3216 (cdr (assq 'tick (gnus-info-marks info))))
3103 (completed -1) 3217 (gnus-uncompress-range
3104 dlist 3218 (cdr (assq 'dormant
3105 type) 3219 (gnus-info-marks info))))))))
3106 3220 (nov-file (concat dir ".overview"))
3107 ;; The normal article alist contains elements that look like 3221 (cnt 0)
3108 ;; (article# . fetch_date) I need to combine other 3222 (completed -1)
3109 ;; information with this list. For example, a flag indicating 3223 dlist
3110 ;; that a particular article MUST BE KEPT. To do this, I'm 3224 type)
3111 ;; going to transform the elements to look like (article# 3225
3112 ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse 3226 ;; The normal article alist contains elements that look like
3113 ;; the process to generate the expired article alist. 3227 ;; (article# . fetch_date) I need to combine other
3114 3228 ;; information with this list. For example, a flag indicating
3115 ;; Convert the alist elements to (article# fetch_date nil 3229 ;; that a particular article MUST BE KEPT. To do this, I'm
3116 ;; nil). 3230 ;; going to transform the elements to look like (article#
3117 (setq dlist (mapcar (lambda (e) 3231 ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse
3118 (list (car e) (cdr e) nil nil)) alist)) 3232 ;; the process to generate the expired article alist.
3119 3233
3120 ;; Convert the keep lists to elements that look like (article# 3234 ;; Convert the alist elements to (article# fetch_date nil
3121 ;; nil keep_flag nil) then append it to the expanded dlist 3235 ;; nil).
3122 ;; These statements are sorted by ascending precidence of the 3236 (setq dlist (mapcar (lambda (e)
3123 ;; keep_flag. 3237 (list (car e) (cdr e) nil nil)) alist))
3124 (setq dlist (nconc dlist 3238
3125 (mapcar (lambda (e) 3239 ;; Convert the keep lists to elements that look like (article#
3126 (list e nil 'unread nil)) 3240 ;; nil keep_flag nil) then append it to the expanded dlist
3127 unreads))) 3241 ;; These statements are sorted by ascending precidence of the
3128 (setq dlist (nconc dlist 3242 ;; keep_flag.
3129 (mapcar (lambda (e) 3243 (setq dlist (nconc dlist
3130 (list e nil 'marked nil)) 3244 (mapcar (lambda (e)
3131 marked))) 3245 (list e nil 'unread nil))
3132 (setq dlist (nconc dlist 3246 unreads)))
3133 (mapcar (lambda (e) 3247 (setq dlist (nconc dlist
3134 (list e nil 'special nil)) 3248 (mapcar (lambda (e)
3135 specials))) 3249 (list e nil 'marked nil))
3136 3250 marked)))
3137 (set-buffer overview) 3251 (setq dlist (nconc dlist
3138 (erase-buffer) 3252 (mapcar (lambda (e)
3139 (buffer-disable-undo) 3253 (list e nil 'special nil))
3140 (when (file-exists-p nov-file) 3254 specials)))
3141 (gnus-message 7 "gnus-agent-expire: Loading overview...") 3255
3142 (nnheader-insert-file-contents nov-file) 3256 (set-buffer overview)
3143 (goto-char (point-min)) 3257 (erase-buffer)
3144 3258 (buffer-disable-undo)
3145 (let (p) 3259 (when (file-exists-p nov-file)
3146 (while (< (setq p (point)) (point-max)) 3260 (gnus-message 7 "gnus-agent-expire: Loading overview...")
3147 (condition-case nil 3261 (nnheader-insert-file-contents nov-file)
3148 ;; If I successfully read an integer (the plus zero 3262 (goto-char (point-min))
3149 ;; ensures a numeric type), prepend a marker entry 3263
3150 ;; to the list 3264 (let (p)
3151 (push (list (+ 0 (read (current-buffer))) nil nil 3265 (while (< (setq p (point)) (point-max))
3152 (set-marker (make-marker) p)) 3266 (condition-case nil
3153 dlist) 3267 ;; If I successfully read an integer (the plus zero
3154 (error 3268 ;; ensures a numeric type), append the position
3155 (gnus-message 1 "gnus-agent-expire: read error \ 3269 ;; to the list
3270 (push (list (+ 0 (read (current-buffer))) nil nil
3271 p)
3272 dlist)
3273 (error
3274 (gnus-message 1 "gnus-agent-expire: read error \
3156occurred when reading expression at %s in %s. Skipping to next \ 3275occurred when reading expression at %s in %s. Skipping to next \
3157line." (point) nov-file))) 3276line." (point) nov-file)))
3158 ;; Whether I succeeded, or failed, it doesn't matter. 3277 ;; Whether I succeeded, or failed, it doesn't matter.
3159 ;; Move to the next line then try again. 3278 ;; Move to the next line then try again.
3160 (forward-line 1))) 3279 (forward-line 1)))
3161 3280
3162 (gnus-message 3281 (gnus-message
3163 7 "gnus-agent-expire: Loading overview... Done")) 3282 7 "gnus-agent-expire: Loading overview... Done"))
3164 (set-buffer-modified-p nil) 3283 (set-buffer-modified-p nil)
3165 3284
3166 ;; At this point, all of the information is in dlist. The 3285 ;; At this point, all of the information is in dlist. The
3167 ;; only problem is that much of it is spread across multiple 3286 ;; only problem is that much of it is spread across multiple
3168 ;; entries. Sort then MERGE!! 3287 ;; entries. Sort then MERGE!!
3169 (gnus-message 7 "gnus-agent-expire: Sorting entries... ") 3288 (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
3170 ;; If two entries have the same article-number then sort by 3289 ;; If two entries have the same article-number then sort by
3171 ;; ascending keep_flag. 3290 ;; ascending keep_flag.
3172 (let ((special 0) 3291 (let ((special 0)
3173 (marked 1) 3292 (marked 1)
3174 (unread 2)) 3293 (unread 2))
3175 (setq dlist 3294 (setq dlist
3176 (sort dlist 3295 (sort dlist
3177 (lambda (a b) 3296 (lambda (a b)
3178 (cond ((< (nth 0 a) (nth 0 b)) 3297 (cond ((< (nth 0 a) (nth 0 b))
3179 t) 3298 t)
3180 ((> (nth 0 a) (nth 0 b)) 3299 ((> (nth 0 a) (nth 0 b))
3181 nil) 3300 nil)
3182 (t 3301 (t
3183 (let ((a (or (symbol-value (nth 2 a)) 3302 (let ((a (or (symbol-value (nth 2 a))
3184 3)) 3303 3))
3185 (b (or (symbol-value (nth 2 b)) 3304 (b (or (symbol-value (nth 2 b))
3186 3))) 3305 3)))
3187 (<= a b)))))))) 3306 (<= a b))))))))
3188 (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") 3307 (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
3189 (gnus-message 7 "gnus-agent-expire: Merging entries... ") 3308 (gnus-message 7 "gnus-agent-expire: Merging entries... ")
3190 (let ((dlist dlist)) 3309 (let ((dlist dlist))
3191 (while (cdr dlist) ; I'm not at the end-of-list 3310 (while (cdr dlist) ; I'm not at the end-of-list
3192 (if (eq (caar dlist) (caadr dlist)) 3311 (if (eq (caar dlist) (caadr dlist))
3193 (let ((first (cdr (car dlist))) 3312 (let ((first (cdr (car dlist)))
3194 (secnd (cdr (cadr dlist)))) 3313 (secnd (cdr (cadr dlist))))
3195 (setcar first (or (car first) 3314 (setcar first (or (car first)
3196 (car secnd))) ; fetch_date 3315 (car secnd))) ; fetch_date
3197 (setq first (cdr first) 3316 (setq first (cdr first)
3198 secnd (cdr secnd)) 3317 secnd (cdr secnd))
3199 (setcar first (or (car first) 3318 (setcar first (or (car first)
3200 (car secnd))) ; Keep_flag 3319 (car secnd))) ; Keep_flag
3201 (setq first (cdr first) 3320 (setq first (cdr first)
3202 secnd (cdr secnd)) 3321 secnd (cdr secnd))
3203 (setcar first (or (car first) 3322 (setcar first (or (car first)
3204 (car secnd))) ; NOV_entry_marker 3323 (car secnd))) ; NOV_entry_position
3205 3324
3206 (setcdr dlist (cddr dlist))) 3325 (setcdr dlist (cddr dlist)))
3207 (setq dlist (cdr dlist))))) 3326 (setq dlist (cdr dlist)))))
3208 (gnus-message 7 "gnus-agent-expire: Merging entries... Done") 3327
3209 3328 ;; Check the order of the entry positions. They should be in
3210 (let* ((len (float (length dlist))) 3329 ;; ascending order. If they aren't, the positions must be
3211 (alist (list nil)) 3330 ;; converted to markers.
3212 (tail-alist alist)) 3331 (when (catch 'sort-results
3213 (while dlist 3332 (let ((dlist dlist)
3214 (let ((new-completed (truncate (* 100.0 3333 (prev-pos -1)
3215 (/ (setq cnt (1+ cnt)) 3334 pos)
3216 len)))) 3335 (while dlist
3217 message-log-max) 3336 (if (setq pos (nth 3 (pop dlist)))
3218 (when (> new-completed completed) 3337 (if (< pos prev-pos)
3219 (setq completed new-completed) 3338 (throw 'sort-results 'unsorted)
3220 (gnus-message 7 "%3d%% completed..." completed))) 3339 (setq prev-pos pos))))))
3221 (let* ((entry (car dlist)) 3340 (gnus-message 7 "gnus-agent-expire: Unsorted overview; inserting markers to compensate.")
3222 (article-number (nth 0 entry)) 3341 (mapc (lambda (entry)
3223 (fetch-date (nth 1 entry)) 3342 (let ((pos (nth 3 entry)))
3224 (keep (nth 2 entry)) 3343 (if pos
3225 (marker (nth 3 entry))) 3344 (setf (nth 3 entry)
3226 3345 (set-marker (make-marker)
3227 (cond 3346 pos)))))
3228 ;; Kept articles are unread, marked, or special. 3347 dlist))
3229 (keep 3348
3230 (gnus-agent-message 10 3349 (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
3231 "gnus-agent-expire: %s:%d: Kept %s article%s." 3350
3232 group article-number keep (if fetch-date " and file" "")) 3351 (let* ((len (float (length dlist)))
3233 (when fetch-date 3352 (alist (list nil))
3234 (unless (file-exists-p 3353 (tail-alist alist)
3235 (concat dir (number-to-string 3354 (position-offset 0)
3236 article-number))) 3355 )
3237 (setf (nth 1 entry) nil) 3356
3238 (gnus-agent-message 3 "gnus-agent-expire cleared \ 3357 (while dlist
3358 (let ((new-completed (truncate (* 100.0
3359 (/ (setq cnt (1+ cnt))
3360 len))))
3361 message-log-max)
3362 (when (> new-completed completed)
3363 (setq completed new-completed)
3364 (gnus-message 7 "%3d%% completed..." completed)))
3365 (let* ((entry (car dlist))
3366 (article-number (nth 0 entry))
3367 (fetch-date (nth 1 entry))
3368 (keep (nth 2 entry))
3369 (marker (nth 3 entry)))
3370
3371 (cond
3372 ;; Kept articles are unread, marked, or special.
3373 (keep
3374 (gnus-agent-message 10
3375 "gnus-agent-expire: %s:%d: Kept %s article%s."
3376 decoded article-number keep (if fetch-date " and file" ""))
3377 (when fetch-date
3378 (unless (file-exists-p
3379 (concat dir (number-to-string
3380 article-number)))
3381 (setf (nth 1 entry) nil)
3382 (gnus-agent-message 3 "gnus-agent-expire cleared \
3239download flag on %s:%d as the cached article file is missing." 3383download flag on %s:%d as the cached article file is missing."
3240 group (caar dlist))) 3384 decoded (caar dlist)))
3241 (unless marker 3385 (unless marker
3242 (gnus-message 1 "gnus-agent-expire detected a \ 3386 (gnus-message 1 "gnus-agent-expire detected a \
3243missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) 3387missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
3244 (gnus-agent-append-to-list 3388 (gnus-agent-append-to-list
3245 tail-alist 3389 tail-alist
3246 (cons article-number fetch-date))) 3390 (cons article-number fetch-date)))
3247 3391
3248 ;; The following articles are READ, UNMARKED, and 3392 ;; The following articles are READ, UNMARKED, and
3249 ;; ORDINARY. See if they can be EXPIRED!!! 3393 ;; ORDINARY. See if they can be EXPIRED!!!
3250 ((setq type 3394 ((setq type
3251 (cond 3395 (cond
3252 ((not (integerp fetch-date)) 3396 ((not (integerp fetch-date))
3253 'read) ;; never fetched article (may expire 3397 'read) ;; never fetched article (may expire
3254 ;; right now) 3398 ;; right now)
3255 ((not (file-exists-p 3399 ((not (file-exists-p
3256 (concat dir (number-to-string 3400 (concat dir (number-to-string
3257 article-number)))) 3401 article-number))))
3258 (setf (nth 1 entry) nil) 3402 (setf (nth 1 entry) nil)
3259 'externally-expired) ;; Can't find the cached 3403 'externally-expired) ;; Can't find the cached
3260 ;; article. Handle case 3404 ;; article. Handle case
3261 ;; as though this article 3405 ;; as though this article
3262 ;; was never fetched. 3406 ;; was never fetched.
3263 3407
3264 ;; We now have the arrival day, so we see 3408 ;; We now have the arrival day, so we see
3265 ;; whether it's old enough to be expired. 3409 ;; whether it's old enough to be expired.
3266 ((< fetch-date day) 3410 ((< fetch-date day)
3267 'expired) 3411 'expired)
3268 (force 3412 (force
3269 'forced))) 3413 'forced)))
3270 3414
3271 ;; I found some reason to expire this entry. 3415 ;; I found some reason to expire this entry.
3272 3416
3273 (let ((actions nil)) 3417 (let ((actions nil))
3274 (when (memq type '(forced expired)) 3418 (when (memq type '(forced expired))
3275 (ignore-errors ; Just being paranoid. 3419 (ignore-errors ; Just being paranoid.
3276 (let* ((file-name (nnheader-concat dir (number-to-string 3420 (let* ((file-name (nnheader-concat dir (number-to-string
3277 article-number))) 3421 article-number)))
3278 (size (float (nth 7 (file-attributes file-name))))) 3422 (size (float (nth 7 (file-attributes file-name)))))
3279 (incf bytes-freed size) 3423 (incf bytes-freed size)
3280 (incf files-deleted) 3424 (incf size-files-deleted size)
3281 (delete-file file-name)) 3425 (incf files-deleted)
3282 (push "expired cached article" actions)) 3426 (delete-file file-name))
3283 (setf (nth 1 entry) nil) 3427 (push "expired cached article" actions))
3284 ) 3428 (setf (nth 1 entry) nil)
3285 3429 )
3286 (when marker 3430
3287 (push "NOV entry removed" actions) 3431 (when marker
3288 (goto-char marker) 3432 (push "NOV entry removed" actions)
3289 3433
3290 (incf nov-entries-deleted) 3434 (goto-char (if (markerp marker)
3291 3435 marker
3292 (let ((from (gnus-point-at-bol)) 3436 (- marker position-offset)))
3293 (to (progn (forward-line 1) (point)))) 3437
3294 (incf bytes-freed (- to from)) 3438 (incf nov-entries-deleted)
3295 (delete-region from to))) 3439
3296 3440 (let* ((from (point-at-bol))
3297 ;; If considering all articles is set, I can only 3441 (to (progn (forward-line 1) (point)))
3298 ;; expire article IDs that are no longer in the 3442 (freed (- to from)))
3299 ;; active range (That is, articles that preceed the 3443 (incf bytes-freed freed)
3300 ;; first article in the new alist). 3444 (incf position-offset freed)
3301 (if (and gnus-agent-consider-all-articles 3445 (delete-region from to)))
3302 (>= article-number (car active))) 3446
3303 ;; I have to keep this ID in the alist 3447 ;; If considering all articles is set, I can only
3304 (gnus-agent-append-to-list 3448 ;; expire article IDs that are no longer in the
3305 tail-alist (cons article-number fetch-date)) 3449 ;; active range (That is, articles that preceed the
3306 (push (format "Removed %s article number from \ 3450 ;; first article in the new alist).
3451 (if (and gnus-agent-consider-all-articles
3452 (>= article-number (car active)))
3453 ;; I have to keep this ID in the alist
3454 (gnus-agent-append-to-list
3455 tail-alist (cons article-number fetch-date))
3456 (push (format "Removed %s article number from \
3307article alist" type) actions)) 3457article alist" type) actions))
3308 3458
3309 (when actions 3459 (when actions
3310 (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" 3460 (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
3311 group article-number 3461 decoded article-number
3312 (mapconcat 'identity actions ", "))))) 3462 (mapconcat 'identity actions ", ")))))
3313 (t 3463 (t
3314 (gnus-agent-message 3464 (gnus-agent-message
3315 10 "gnus-agent-expire: %s:%d: Article kept as \ 3465 10 "gnus-agent-expire: %s:%d: Article kept as \
3316expiration tests failed." group article-number) 3466expiration tests failed." decoded article-number)
3317 (gnus-agent-append-to-list 3467 (gnus-agent-append-to-list
3318 tail-alist (cons article-number fetch-date))) 3468 tail-alist (cons article-number fetch-date)))
3319 ) 3469 )
3320 3470
3321 ;; Clean up markers as I want to recycle this buffer 3471 ;; Remove markers as I intend to reuse this buffer again.
3322 ;; over several groups. 3472 (when (and marker
3323 (when marker 3473 (markerp marker))
3324 (set-marker marker nil)) 3474 (set-marker marker nil))
3325 3475
3326 (setq dlist (cdr dlist)))) 3476 (setq dlist (cdr dlist))))
3327 3477
3328 (setq alist (cdr alist)) 3478 (setq alist (cdr alist))
3329 3479
3330 (let ((inhibit-quit t)) 3480 (let ((inhibit-quit t))
3331 (unless (equal alist gnus-agent-article-alist) 3481 (unless (equal alist gnus-agent-article-alist)
3332 (setq gnus-agent-article-alist alist) 3482 (setq gnus-agent-article-alist alist)
3333 (gnus-agent-save-alist group)) 3483 (gnus-agent-save-alist group))
3334 3484
3335 (when (buffer-modified-p) 3485 (when (buffer-modified-p)
3336 (let ((coding-system-for-write 3486 (let ((coding-system-for-write
3337 gnus-agent-file-coding-system)) 3487 gnus-agent-file-coding-system))
3338 (gnus-make-directory dir) 3488 (gnus-make-directory dir)
3339 (write-region (point-min) (point-max) nov-file nil 3489 (write-region (point-min) (point-max) nov-file nil
3340 'silent) 3490 'silent)
3341 ;; clear the modified flag as that I'm not confused by 3491 ;; clear the modified flag as that I'm not confused by
3342 ;; its status on the next pass through this routine. 3492 ;; its status on the next pass through this routine.
3343 (set-buffer-modified-p nil))) 3493 (set-buffer-modified-p nil)
3344 3494 (gnus-agent-update-view-total-fetched-for group t)))
3345 (when (eq articles t) 3495
3346 (gnus-summary-update-info)))) 3496 (when (eq articles t)
3347 3497 (gnus-summary-update-info))))
3348 (when (boundp 'gnus-agent-expire-stats) 3498
3349 (let ((stats (symbol-value 'gnus-agent-expire-stats))) 3499 (when (boundp 'gnus-agent-expire-stats)
3350 (incf (nth 2 stats) bytes-freed) 3500 (let ((stats (symbol-value 'gnus-agent-expire-stats)))
3351 (incf (nth 1 stats) files-deleted) 3501 (incf (nth 2 stats) bytes-freed)
3352 (incf (nth 0 stats) nov-entries-deleted))) 3502 (incf (nth 1 stats) files-deleted)
3353 )))) 3503 (incf (nth 0 stats) nov-entries-deleted)))
3504
3505 (gnus-agent-update-files-total-fetched-for group (- size-files-deleted)))))))
3354 3506
3355(defun gnus-agent-expire (&optional articles group force) 3507(defun gnus-agent-expire (&optional articles group force)
3356 "Expire all old articles. 3508 "Expire all old articles.
@@ -3428,7 +3580,8 @@ articles in every agentized group? "))
3428 ;; compiler will not complain about free references. 3580 ;; compiler will not complain about free references.
3429 (gnus-agent-expire-current-dirs 3581 (gnus-agent-expire-current-dirs
3430 (symbol-value 'gnus-agent-expire-current-dirs)) 3582 (symbol-value 'gnus-agent-expire-current-dirs))
3431 dir) 3583 dir
3584 (file-name-coding-system nnmail-pathname-coding-system))
3432 3585
3433 (gnus-sethash gnus-agent-directory t keep) 3586 (gnus-sethash gnus-agent-directory t keep)
3434 (while gnus-agent-expire-current-dirs 3587 (while gnus-agent-expire-current-dirs
@@ -3485,6 +3638,7 @@ articles in every agentized group? "))
3485 (let ((dir (pop to-remove))) 3638 (let ((dir (pop to-remove)))
3486 (if (gnus-y-or-n-p (format "Delete %s? " dir)) 3639 (if (gnus-y-or-n-p (format "Delete %s? " dir))
3487 (let* (delete-recursive 3640 (let* (delete-recursive
3641 files f
3488 (delete-recursive 3642 (delete-recursive
3489 (function 3643 (function
3490 (lambda (f-or-d) 3644 (lambda (f-or-d)
@@ -3493,12 +3647,13 @@ articles in every agentized group? "))
3493 (condition-case nil 3647 (condition-case nil
3494 (delete-directory f-or-d) 3648 (delete-directory f-or-d)
3495 (file-error 3649 (file-error
3496 (mapcar (lambda (f) 3650 (setq files (directory-files f-or-d))
3497 (or (member f '("." "..")) 3651 (while files
3498 (funcall delete-recursive 3652 (setq f (pop files))
3499 (nnheader-concat 3653 (or (member f '("." ".."))
3500 f-or-d f)))) 3654 (funcall delete-recursive
3501 (directory-files f-or-d)) 3655 (nnheader-concat
3656 f-or-d f))))
3502 (delete-directory f-or-d))) 3657 (delete-directory f-or-d)))
3503 (delete-file f-or-d))))))) 3658 (delete-file f-or-d)))))))
3504 (funcall delete-recursive dir)))))))))) 3659 (funcall delete-recursive dir))))))))))
@@ -3582,7 +3737,8 @@ has been fetched."
3582 (let ((gnus-decode-encoded-word-function 'identity) 3737 (let ((gnus-decode-encoded-word-function 'identity)
3583 (gnus-decode-encoded-address-function 'identity) 3738 (gnus-decode-encoded-address-function 'identity)
3584 (file (gnus-agent-article-name ".overview" group)) 3739 (file (gnus-agent-article-name ".overview" group))
3585 cached-articles uncached-articles) 3740 cached-articles uncached-articles
3741 (file-name-coding-system nnmail-pathname-coding-system))
3586 (gnus-make-directory (nnheader-translate-file-chars 3742 (gnus-make-directory (nnheader-translate-file-chars
3587 (file-name-directory file) t)) 3743 (file-name-directory file) t))
3588 3744
@@ -3685,6 +3841,8 @@ has been fetched."
3685 (gnus-agent-check-overview-buffer) 3841 (gnus-agent-check-overview-buffer)
3686 (write-region (point-min) (point-max) file nil 'silent)) 3842 (write-region (point-min) (point-max) file nil 'silent))
3687 3843
3844 (gnus-agent-update-view-total-fetched-for group t)
3845
3688 ;; Update the group's article alist to include the newly 3846 ;; Update the group's article alist to include the newly
3689 ;; fetched articles. 3847 ;; fetched articles.
3690 (gnus-agent-load-alist group) 3848 (gnus-agent-load-alist group)
@@ -3715,7 +3873,8 @@ has been fetched."
3715 (numberp article)) 3873 (numberp article))
3716 (let* ((gnus-command-method (gnus-find-method-for-group group)) 3874 (let* ((gnus-command-method (gnus-find-method-for-group group))
3717 (file (gnus-agent-article-name (number-to-string article) group)) 3875 (file (gnus-agent-article-name (number-to-string article) group))
3718 (buffer-read-only nil)) 3876 (buffer-read-only nil)
3877 (file-name-coding-system nnmail-pathname-coding-system))
3719 (when (and (file-exists-p file) 3878 (when (and (file-exists-p file)
3720 (> (nth 7 (file-attributes file)) 0)) 3879 (> (nth 7 (file-attributes file)) 0))
3721 (erase-buffer) 3880 (erase-buffer)
@@ -3732,16 +3891,7 @@ In addition, their NOV entries in .overview will be refreshed using
3732the articles' current headers. 3891the articles' current headers.
3733If REREAD is not nil, downloaded articles are marked as unread." 3892If REREAD is not nil, downloaded articles are marked as unread."
3734 (interactive 3893 (interactive
3735 (list (let ((def (or (gnus-group-group-name) 3894 (list (gnus-agent-read-group)
3736 gnus-newsgroup-name)))
3737 (let ((select (read-string (if def
3738 (concat "Group Name ("
3739 def "): ")
3740 "Group Name: "))))
3741 (if (and (equal "" select)
3742 def)
3743 def
3744 select)))
3745 (catch 'mark 3895 (catch 'mark
3746 (while (let (c 3896 (while (let (c
3747 (cursor-in-echo-area t) 3897 (cursor-in-echo-area t)
@@ -3759,199 +3909,200 @@ If REREAD is not nil, downloaded articles are marked as unread."
3759 (sit-for 1) 3909 (sit-for 1)
3760 t))))) 3910 t)))))
3761 (when group 3911 (when group
3762 (gnus-message 5 "Regenerating in %s" group) 3912 (gnus-message 5 "Regenerating in %s" group)
3763 (let* ((gnus-command-method (or gnus-command-method 3913 (let* ((gnus-command-method (or gnus-command-method
3764 (gnus-find-method-for-group group))) 3914 (gnus-find-method-for-group group)))
3765 (file (gnus-agent-article-name ".overview" group)) 3915 (file (gnus-agent-article-name ".overview" group))
3766 (dir (file-name-directory file)) 3916 (dir (file-name-directory file))
3767 point 3917 point
3768 (downloaded (if (file-exists-p dir) 3918 (file-name-coding-system nnmail-pathname-coding-system)
3919 (downloaded (if (file-exists-p dir)
3769 (sort (delq nil (mapcar (lambda (name) 3920 (sort (delq nil (mapcar (lambda (name)
3770 (and (not (file-directory-p (nnheader-concat dir name))) 3921 (and (not (file-directory-p (nnheader-concat dir name)))
3771 (string-to-number name))) 3922 (string-to-number name)))
3772 (directory-files dir nil "^[0-9]+$" t))) 3923 (directory-files dir nil "^[0-9]+$" t)))
3773 '>) 3924 '>)
3774 (progn (gnus-make-directory dir) nil))) 3925 (progn (gnus-make-directory dir) nil)))
3775 dl nov-arts 3926 dl nov-arts
3776 alist header 3927 alist header
3777 regenerated) 3928 regenerated)
3778 3929
3779 (mm-with-unibyte-buffer 3930 (mm-with-unibyte-buffer
3780 (if (file-exists-p file) 3931 (if (file-exists-p file)
3781 (let ((nnheader-file-coding-system 3932 (let ((nnheader-file-coding-system
3782 gnus-agent-file-coding-system)) 3933 gnus-agent-file-coding-system))
3783 (nnheader-insert-file-contents file))) 3934 (nnheader-insert-file-contents file)))
3784 (set-buffer-modified-p nil) 3935 (set-buffer-modified-p nil)
3785 3936
3786 ;; Load the article IDs found in the overview file. As a 3937 ;; Load the article IDs found in the overview file. As a
3787 ;; side-effect, validate the file contents. 3938 ;; side-effect, validate the file contents.
3788 (let ((load t)) 3939 (let ((load t))
3789 (while load 3940 (while load
3790 (setq load nil) 3941 (setq load nil)
3791 (goto-char (point-min)) 3942 (goto-char (point-min))
3792 (while (< (point) (point-max)) 3943 (while (< (point) (point-max))
3793 (cond ((and (looking-at "[0-9]+\t") 3944 (cond ((and (looking-at "[0-9]+\t")
3794 (<= (- (match-end 0) (match-beginning 0)) 9)) 3945 (<= (- (match-end 0) (match-beginning 0)) 9))
3795 (push (read (current-buffer)) nov-arts) 3946 (push (read (current-buffer)) nov-arts)
3796 (forward-line 1) 3947 (forward-line 1)
3797 (let ((l1 (car nov-arts)) 3948 (let ((l1 (car nov-arts))
3798 (l2 (cadr nov-arts))) 3949 (l2 (cadr nov-arts)))
3799 (cond ((and (listp reread) (memq l1 reread)) 3950 (cond ((and (listp reread) (memq l1 reread))
3800 (gnus-delete-line) 3951 (gnus-delete-line)
3801 (setq nov-arts (cdr nov-arts)) 3952 (setq nov-arts (cdr nov-arts))
3802 (gnus-message 4 "gnus-agent-regenerate-group: NOV\ 3953 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3803 entry of article %s deleted." l1)) 3954 entry of article %s deleted." l1))
3804 ((not l2) 3955 ((not l2)
3805 nil) 3956 nil)
3806 ((< l1 l2) 3957 ((< l1 l2)
3807 (gnus-message 3 "gnus-agent-regenerate-group: NOV\ 3958 (gnus-message 3 "gnus-agent-regenerate-group: NOV\
3808 entries are NOT in ascending order.") 3959 entries are NOT in ascending order.")
3809 ;; Don't sort now as I haven't verified 3960 ;; Don't sort now as I haven't verified
3810 ;; that every line begins with a number 3961 ;; that every line begins with a number
3811 (setq load t)) 3962 (setq load t))
3812 ((= l1 l2) 3963 ((= l1 l2)
3813 (forward-line -1) 3964 (forward-line -1)
3814 (gnus-message 4 "gnus-agent-regenerate-group: NOV\ 3965 (gnus-message 4 "gnus-agent-regenerate-group: NOV\
3815 entries contained duplicate of article %s. Duplicate deleted." l1) 3966 entries contained duplicate of article %s. Duplicate deleted." l1)
3816 (gnus-delete-line) 3967 (gnus-delete-line)
3817 (setq nov-arts (cdr nov-arts)))))) 3968 (setq nov-arts (cdr nov-arts))))))
3818 (t 3969 (t
3819 (gnus-message 1 "gnus-agent-regenerate-group: NOV\ 3970 (gnus-message 1 "gnus-agent-regenerate-group: NOV\
3820 entries contained line that did not begin with an article number. Deleted\ 3971 entries contained line that did not begin with an article number. Deleted\
3821 line.") 3972 line.")
3822 (gnus-delete-line)))) 3973 (gnus-delete-line))))
3823 (when load 3974 (when load
3824 (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ 3975 (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
3825 entries into ascending order.") 3976 entries into ascending order.")
3826 (sort-numeric-fields 1 (point-min) (point-max)) 3977 (sort-numeric-fields 1 (point-min) (point-max))
3827 (setq nov-arts nil)))) 3978 (setq nov-arts nil))))
3828 (gnus-agent-check-overview-buffer) 3979 (gnus-agent-check-overview-buffer)
3829 3980
3830 ;; Construct a new article alist whose nodes match every header 3981 ;; Construct a new article alist whose nodes match every header
3831 ;; in the .overview file. As a side-effect, missing headers are 3982 ;; in the .overview file. As a side-effect, missing headers are
3832 ;; reconstructed from the downloaded article file. 3983 ;; reconstructed from the downloaded article file.
3833 (while (or downloaded nov-arts) 3984 (while (or downloaded nov-arts)
3834 (cond ((and downloaded 3985 (cond ((and downloaded
3835 (or (not nov-arts) 3986 (or (not nov-arts)
3836 (> (car downloaded) (car nov-arts)))) 3987 (> (car downloaded) (car nov-arts))))
3837 ;; This entry is missing from the overview file 3988 ;; This entry is missing from the overview file
3838 (gnus-message 3 "Regenerating NOV %s %d..." group 3989 (gnus-message 3 "Regenerating NOV %s %d..." group
3839 (car downloaded)) 3990 (car downloaded))
3840 (let ((file (concat dir (number-to-string (car downloaded))))) 3991 (let ((file (concat dir (number-to-string (car downloaded)))))
3841 (mm-with-unibyte-buffer 3992 (mm-with-unibyte-buffer
3842 (nnheader-insert-file-contents file) 3993 (nnheader-insert-file-contents file)
3843 (nnheader-remove-body) 3994 (nnheader-remove-body)
3844 (setq header (nnheader-parse-naked-head))) 3995 (setq header (nnheader-parse-naked-head)))
3845 (mail-header-set-number header (car downloaded)) 3996 (mail-header-set-number header (car downloaded))
3846 (if nov-arts 3997 (if nov-arts
3847 (let ((key (concat "^" (int-to-string (car nov-arts)) 3998 (let ((key (concat "^" (int-to-string (car nov-arts))
3848 "\t"))) 3999 "\t")))
3849 (or (re-search-backward key nil t) 4000 (or (re-search-backward key nil t)
3850 (re-search-forward key)) 4001 (re-search-forward key))
3851 (forward-line 1)) 4002 (forward-line 1))
3852 (goto-char (point-min))) 4003 (goto-char (point-min)))
3853 (nnheader-insert-nov header)) 4004 (nnheader-insert-nov header))
3854 (setq nov-arts (cons (car downloaded) nov-arts))) 4005 (setq nov-arts (cons (car downloaded) nov-arts)))
3855 ((eq (car downloaded) (car nov-arts)) 4006 ((eq (car downloaded) (car nov-arts))
3856 ;; This entry in the overview has been downloaded 4007 ;; This entry in the overview has been downloaded
3857 (push (cons (car downloaded) 4008 (push (cons (car downloaded)
3858 (time-to-days 4009 (time-to-days
3859 (nth 5 (file-attributes 4010 (nth 5 (file-attributes
3860 (concat dir (number-to-string 4011 (concat dir (number-to-string
3861 (car downloaded))))))) alist) 4012 (car downloaded))))))) alist)
3862 (setq downloaded (cdr downloaded)) 4013 (setq downloaded (cdr downloaded))
3863 (setq nov-arts (cdr nov-arts))) 4014 (setq nov-arts (cdr nov-arts)))
3864 (t 4015 (t
3865 ;; This entry in the overview has not been downloaded 4016 ;; This entry in the overview has not been downloaded
3866 (push (cons (car nov-arts) nil) alist) 4017 (push (cons (car nov-arts) nil) alist)
3867 (setq nov-arts (cdr nov-arts))))) 4018 (setq nov-arts (cdr nov-arts)))))
3868 4019
3869 ;; When gnus-agent-consider-all-articles is set, 4020 ;; When gnus-agent-consider-all-articles is set,
3870 ;; gnus-agent-regenerate-group should NOT remove article IDs from 4021 ;; gnus-agent-regenerate-group should NOT remove article IDs from
3871 ;; the alist. Those IDs serve as markers to indicate that an 4022 ;; the alist. Those IDs serve as markers to indicate that an
3872 ;; attempt has been made to fetch that article's header. 4023 ;; attempt has been made to fetch that article's header.
3873 4024
3874 ;; When gnus-agent-consider-all-articles is NOT set, 4025 ;; When gnus-agent-consider-all-articles is NOT set,
3875 ;; gnus-agent-regenerate-group can remove the article ID of every 4026 ;; gnus-agent-regenerate-group can remove the article ID of every
3876 ;; article (with the exception of the last ID in the list - it's 4027 ;; article (with the exception of the last ID in the list - it's
3877 ;; special) that no longer appears in the overview. In this 4028 ;; special) that no longer appears in the overview. In this
3878 ;; situtation, the last article ID in the list implies that it, 4029 ;; situtation, the last article ID in the list implies that it,
3879 ;; and every article ID preceeding it, have been fetched from the 4030 ;; and every article ID preceeding it, have been fetched from the
3880 ;; server. 4031 ;; server.
3881 4032
3882 (if gnus-agent-consider-all-articles 4033 (if gnus-agent-consider-all-articles
3883 ;; Restore all article IDs that were not found in the overview file. 4034 ;; Restore all article IDs that were not found in the overview file.
3884 (let* ((n (cons nil alist)) 4035 (let* ((n (cons nil alist))
3885 (merged n) 4036 (merged n)
3886 (o (gnus-agent-load-alist group))) 4037 (o (gnus-agent-load-alist group)))
3887 (while o 4038 (while o
3888 (let ((nID (caadr n)) 4039 (let ((nID (caadr n))
3889 (oID (caar o))) 4040 (oID (caar o)))
3890 (cond ((not nID) 4041 (cond ((not nID)
3891 (setq n (setcdr n (list (list oID)))) 4042 (setq n (setcdr n (list (list oID))))
3892 (setq o (cdr o))) 4043 (setq o (cdr o)))
3893 ((< oID nID) 4044 ((< oID nID)
3894 (setcdr n (cons (list oID) (cdr n))) 4045 (setcdr n (cons (list oID) (cdr n)))
3895 (setq o (cdr o))) 4046 (setq o (cdr o)))
3896 ((= oID nID) 4047 ((= oID nID)
3897 (setq o (cdr o)) 4048 (setq o (cdr o))
3898 (setq n (cdr n))) 4049 (setq n (cdr n)))
3899 (t 4050 (t
3900 (setq n (cdr n)))))) 4051 (setq n (cdr n))))))
3901 (setq alist (cdr merged))) 4052 (setq alist (cdr merged)))
3902 ;; Restore the last article ID if it is not already in the new alist 4053 ;; Restore the last article ID if it is not already in the new alist
3903 (let ((n (last alist)) 4054 (let ((n (last alist))
3904 (o (last (gnus-agent-load-alist group)))) 4055 (o (last (gnus-agent-load-alist group))))
3905 (cond ((not o) 4056 (cond ((not o)
3906 nil) 4057 nil)
3907 ((not n) 4058 ((not n)
3908 (push (cons (caar o) nil) alist)) 4059 (push (cons (caar o) nil) alist))
3909 ((< (caar n) (caar o)) 4060 ((< (caar n) (caar o))
3910 (setcdr n (list (car o))))))) 4061 (setcdr n (list (car o)))))))
3911 4062
3912 (let ((inhibit-quit t)) 4063 (let ((inhibit-quit t))
3913 (if (setq regenerated (buffer-modified-p)) 4064 (if (setq regenerated (buffer-modified-p))
3914 (let ((coding-system-for-write gnus-agent-file-coding-system)) 4065 (let ((coding-system-for-write gnus-agent-file-coding-system))
3915 (write-region (point-min) (point-max) file nil 'silent))) 4066 (write-region (point-min) (point-max) file nil 'silent)))
3916 4067
3917 (setq regenerated (or regenerated 4068 (setq regenerated (or regenerated
3918 (and reread gnus-agent-article-alist) 4069 (and reread gnus-agent-article-alist)
3919 (not (equal alist gnus-agent-article-alist)))) 4070 (not (equal alist gnus-agent-article-alist))))
3920 4071
3921 (setq gnus-agent-article-alist alist) 4072 (setq gnus-agent-article-alist alist)
3922 4073
3923 (when regenerated 4074 (when regenerated
3924 (gnus-agent-save-alist group) 4075 (gnus-agent-save-alist group)
3925 4076
3926 ;; I have to alter the group's active range NOW as 4077 ;; I have to alter the group's active range NOW as
3927 ;; gnus-make-ascending-articles-unread will use it to 4078 ;; gnus-make-ascending-articles-unread will use it to
3928 ;; recalculate the number of unread articles in the group 4079 ;; recalculate the number of unread articles in the group
3929 4080
3930 (let ((group (gnus-group-real-name group)) 4081 (let ((group (gnus-group-real-name group))
3931 (group-active (or (gnus-active group) 4082 (group-active (or (gnus-active group)
3932 (gnus-activate-group group)))) 4083 (gnus-activate-group group))))
3933 (gnus-agent-possibly-alter-active group group-active))))) 4084 (gnus-agent-possibly-alter-active group group-active)))))
3934 4085
3935 (when (and reread gnus-agent-article-alist) 4086 (when (and reread gnus-agent-article-alist)
3936 (gnus-agent-synchronize-group-flags 4087 (gnus-agent-synchronize-group-flags
3937 group 4088 group
3938 (list (list 4089 (list (list
3939 (if (listp reread) 4090 (if (listp reread)
3940 reread 4091 reread
3941 (delq nil (mapcar (function (lambda (c) 4092 (delq nil (mapcar (function (lambda (c)
3942 (cond ((eq reread t) 4093 (cond ((eq reread t)
3943 (car c)) 4094 (car c))
3944 ((cdr c) 4095 ((cdr c)
3945 (car c))))) 4096 (car c)))))
3946 gnus-agent-article-alist))) 4097 gnus-agent-article-alist)))
3947 'del '(read))) 4098 'del '(read)))
3948 gnus-command-method) 4099 gnus-command-method)
3949 4100
3950 (when (gnus-buffer-live-p gnus-group-buffer) 4101 (when regenerated
3951 (gnus-group-update-group group t))) 4102 (gnus-agent-update-files-total-fetched-for group nil)))
3952 4103
3953 (gnus-message 5 "") 4104 (gnus-message 5 "")
3954 regenerated))) 4105 regenerated)))
3955 4106
3956;;;###autoload 4107;;;###autoload
3957(defun gnus-agent-regenerate (&optional clean reread) 4108(defun gnus-agent-regenerate (&optional clean reread)
@@ -3996,6 +4147,84 @@ If CLEAN, obsolete (ignore)."
3996(defun gnus-agent-group-covered-p (group) 4147(defun gnus-agent-group-covered-p (group)
3997 (gnus-agent-method-p (gnus-group-method group))) 4148 (gnus-agent-method-p (gnus-group-method group)))
3998 4149
4150(defun gnus-agent-update-files-total-fetched-for
4151 (group delta &optional method path)
4152 "Update, or set, the total disk space used by the articles that the
4153agent has fetched."
4154 (when gnus-agent-total-fetched-hashtb
4155 (gnus-agent-with-refreshed-group
4156 group
4157 ;; if null, gnus-agent-group-pathname will calc method.
4158 (let* ((gnus-command-method method)
4159 (path (or path (gnus-agent-group-pathname group)))
4160 (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
4161 (gnus-sethash path (make-list 3 0)
4162 gnus-agent-total-fetched-hashtb)))
4163 (file-name-coding-system nnmail-pathname-coding-system))
4164 (when (listp delta)
4165 (if delta
4166 (let ((sum 0.0)
4167 file)
4168 (while (setq file (pop delta))
4169 (incf sum (float (or (nth 7 (file-attributes
4170 (nnheader-concat
4171 path
4172 (if (numberp file)
4173 (number-to-string file)
4174 file)))) 0))))
4175 (setq delta sum))
4176 (let ((sum (- (nth 2 entry)))
4177 (info (directory-files-and-attributes path nil "^-?[0-9]+$" t))
4178 file)
4179 (while (setq file (pop info))
4180 (incf sum (float (or (nth 8 file) 0))))
4181 (setq delta sum))))
4182
4183 (setq gnus-agent-need-update-total-fetched-for t)
4184 (incf (nth 2 entry) delta)))))
4185
4186(defun gnus-agent-update-view-total-fetched-for
4187 (group agent-over &optional method path)
4188 "Update, or set, the total disk space used by the .agentview and
4189.overview files. These files are calculated separately as they can be
4190modified."
4191 (when gnus-agent-total-fetched-hashtb
4192 (gnus-agent-with-refreshed-group
4193 group
4194 ;; if null, gnus-agent-group-pathname will calc method.
4195 (let* ((gnus-command-method method)
4196 (path (or path (gnus-agent-group-pathname group)))
4197 (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
4198 (gnus-sethash path (make-list 3 0)
4199 gnus-agent-total-fetched-hashtb)))
4200 (file-name-coding-system nnmail-pathname-coding-system)
4201 (size (or (nth 7 (file-attributes
4202 (nnheader-concat
4203 path (if agent-over
4204 ".overview"
4205 ".agentview"))))
4206 0)))
4207 (setq gnus-agent-need-update-total-fetched-for t)
4208 (setf (nth (if agent-over 1 0) entry) size)))))
4209
4210(defun gnus-agent-total-fetched-for (group &optional method no-inhibit)
4211 "Get the total disk space used by the specified GROUP."
4212 (unless (equal group "dummy.group")
4213 (unless gnus-agent-total-fetched-hashtb
4214 (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024)))
4215
4216 ;; if null, gnus-agent-group-pathname will calc method.
4217 (let* ((gnus-command-method method)
4218 (path (gnus-agent-group-pathname group))
4219 (entry (gnus-gethash path gnus-agent-total-fetched-hashtb)))
4220 (if entry
4221 (apply '+ entry)
4222 (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
4223 (+
4224 (gnus-agent-update-view-total-fetched-for group nil method path)
4225 (gnus-agent-update-view-total-fetched-for group t method path)
4226 (gnus-agent-update-files-total-fetched-for group nil method path)))))))
4227
3999(provide 'gnus-agent) 4228(provide 'gnus-agent)
4000 4229
4001;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e 4230;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index a02a7d153bb..9db4408e9d0 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -33,7 +33,10 @@
33 (defvar w3m-minor-mode-map)) 33 (defvar w3m-minor-mode-map))
34 34
35(require 'gnus) 35(require 'gnus)
36(require 'gnus-sum) 36;; Avoid the "Recursive load suspected" error in Emacs 21.1.
37(eval-and-compile
38 (let ((recursive-load-depth-limit 100))
39 (require 'gnus-sum)))
37(require 'gnus-spec) 40(require 'gnus-spec)
38(require 'gnus-int) 41(require 'gnus-int)
39(require 'gnus-win) 42(require 'gnus-win)
@@ -49,6 +52,8 @@
49(autoload 'gnus-button-mailto "gnus-msg") 52(autoload 'gnus-button-mailto "gnus-msg")
50(autoload 'gnus-button-reply "gnus-msg" nil t) 53(autoload 'gnus-button-reply "gnus-msg" nil t)
51(autoload 'parse-time-string "parse-time" nil nil) 54(autoload 'parse-time-string "parse-time" nil nil)
55(autoload 'ansi-color-apply-on-region "ansi-color")
56(autoload 'mm-url-insert-file-contents-external "mm-url")
52(autoload 'mm-extern-cache-contents "mm-extern") 57(autoload 'mm-extern-cache-contents "mm-extern")
53 58
54(defgroup gnus-article nil 59(defgroup gnus-article nil
@@ -153,7 +158,10 @@
153 "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" 158 "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
154 "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" 159 "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
155 "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" 160 "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
156 "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) 161 "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"
162 "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane"
163 "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At"
164 "Envelope-Sender" "Envelope-Recipients"))
157 "*All headers that start with this regexp will be hidden. 165 "*All headers that start with this regexp will be hidden.
158This variable can also be a list of regexps of headers to be ignored. 166This variable can also be a list of regexps of headers to be ignored.
159If `gnus-visible-headers' is non-nil, this variable will be ignored." 167If `gnus-visible-headers' is non-nil, this variable will be ignored."
@@ -238,7 +246,9 @@ that number. If it is a floating point number, no signature may be
238longer (in lines) than that number. If it is a function, the function 246longer (in lines) than that number. If it is a function, the function
239will be called without any parameters, and if it returns nil, there is 247will be called without any parameters, and if it returns nil, there is
240no signature in the buffer. If it is a string, it will be used as a 248no signature in the buffer. If it is a string, it will be used as a
241regexp. If it matches, the text in question is not a signature." 249regexp. If it matches, the text in question is not a signature.
250
251This can also be a list of the above values."
242 :type '(choice (const nil) 252 :type '(choice (const nil)
243 (integer :value 200) 253 (integer :value 200)
244 (number :value 4.0) 254 (number :value 4.0)
@@ -412,7 +422,7 @@ is the face used for highlighting."
412 (widget-group-value-create widget)) 422 (widget-group-value-create widget))
413 regexp 423 regexp
414 (integer :format "Match group: %v") 424 (integer :format "Match group: %v")
415 (integer :format "Emphasize group: %v") 425 (integer :format "Emphasize group: %v")
416 face) 426 face)
417 (group :tag "Simple" 427 (group :tag "Simple"
418 :value (("_" . "_") nil default) 428 :value (("_" . "_") nil default)
@@ -480,14 +490,14 @@ Example: (_/*word*/_)."
480 "Face used for displaying highlighted words." 490 "Face used for displaying highlighted words."
481 :group 'gnus-article-emphasis) 491 :group 'gnus-article-emphasis)
482 492
483(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" 493(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
484 "Format for display of Date headers in article bodies. 494 "Format for display of Date headers in article bodies.
485See `format-time-string' for the possible values. 495See `format-time-string' for the possible values.
486 496
487The variable can also be function, which should return a complete Date 497The variable can also be function, which should return a complete Date
488header. The function is called with one argument, the time, which can 498header. The function is called with one argument, the time, which can
489be fed to `format-time-string'." 499be fed to `format-time-string'."
490 :type '(choice string symbol) 500 :type '(choice string function)
491 :link '(custom-manual "(gnus)Article Date") 501 :link '(custom-manual "(gnus)Article Date")
492 :group 'gnus-article-washing) 502 :group 'gnus-article-washing)
493 503
@@ -645,17 +655,18 @@ you could set this variable to something like:
645 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") 655 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
646 (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) 656 (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
647 657
648This variable is an alist where the where the key is the match and the 658This variable is an alist where the key is the match and the
649value is a list of possible files to save in if the match is non-nil. 659value is a list of possible files to save in if the match is
660non-nil.
650 661
651If the match is a string, it is used as a regexp match on the 662If the match is a string, it is used as a regexp match on the
652article. If the match is a symbol, that symbol will be funcalled 663article. If the match is a symbol, that symbol will be funcalled
653from the buffer of the article to be saved with the newsgroup as the 664from the buffer of the article to be saved with the newsgroup as the
654parameter. If it is a list, it will be evalled in the same buffer. 665parameter. If it is a list, it will be evaled in the same buffer.
655 666
656If this form or function returns a string, this string will be used as 667If this form or function returns a string, this string will be used as a
657a possible file name; and if it returns a non-nil list, that list will 668possible file name; and if it returns a non-nil list, that list will be
658be used as possible file names." 669used as possible file names."
659 :group 'gnus-article-saving 670 :group 'gnus-article-saving
660 :type '(repeat (choice (list :value (fun) function) 671 :type '(repeat (choice (list :value (fun) function)
661 (cons :value ("" "") regexp (repeat string)) 672 (cons :value ("" "") regexp (repeat string))
@@ -701,10 +712,22 @@ The following additional specs are available:
701 :type 'hook 712 :type 'hook
702 :group 'gnus-article-various) 713 :group 'gnus-article-various)
703 714
715(defcustom gnus-copy-article-ignored-headers nil
716 "List of headers to be removed when copying an article.
717Each element is a regular expression."
718 :version "23.0" ;; No Gnus
719 :type '(repeat regexp)
720 :group 'gnus-article-various)
721
704(make-obsolete-variable 'gnus-article-hide-pgp-hook 722(make-obsolete-variable 'gnus-article-hide-pgp-hook
705 "This variable is obsolete in Gnus 5.10.") 723 "This variable is obsolete in Gnus 5.10.")
706 724
707(defcustom gnus-article-button-face 'bold 725(defface gnus-button
726 '((t (:weight bold)))
727 "Face used for highlighting a button in the article buffer."
728 :group 'gnus-article-buttons)
729
730(defcustom gnus-article-button-face 'gnus-button
708 "Face used for highlighting buttons in the article buffer. 731 "Face used for highlighting buttons in the article buffer.
709 732
710An article button is a piece of text that you can activate by pressing 733An article button is a piece of text that you can activate by pressing
@@ -739,7 +762,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
739(defface gnus-header-from 762(defface gnus-header-from
740 '((((class color) 763 '((((class color)
741 (background dark)) 764 (background dark))
742 (:foreground "spring green")) 765 (:foreground "PaleGreen1"))
743 (((class color) 766 (((class color)
744 (background light)) 767 (background light))
745 (:foreground "red3")) 768 (:foreground "red3"))
@@ -754,7 +777,7 @@ Obsolete; use the face `gnus-signature' for customizations instead."
754(defface gnus-header-subject 777(defface gnus-header-subject
755 '((((class color) 778 '((((class color)
756 (background dark)) 779 (background dark))
757 (:foreground "SeaGreen3")) 780 (:foreground "SeaGreen1"))
758 (((class color) 781 (((class color)
759 (background light)) 782 (background light))
760 (:foreground "red4")) 783 (:foreground "red4"))
@@ -786,7 +809,7 @@ articles."
786(defface gnus-header-name 809(defface gnus-header-name
787 '((((class color) 810 '((((class color)
788 (background dark)) 811 (background dark))
789 (:foreground "SeaGreen")) 812 (:foreground "SpringGreen2"))
790 (((class color) 813 (((class color)
791 (background light)) 814 (background light))
792 (:foreground "maroon")) 815 (:foreground "maroon"))
@@ -801,7 +824,7 @@ articles."
801(defface gnus-header-content 824(defface gnus-header-content
802 '((((class color) 825 '((((class color)
803 (background dark)) 826 (background dark))
804 (:foreground "forest green" :italic t)) 827 (:foreground "SpringGreen1" :italic t))
805 (((class color) 828 (((class color)
806 (background light)) 829 (background light))
807 (:foreground "indianred4" :italic t)) 830 (:foreground "indianred4" :italic t))
@@ -838,6 +861,31 @@ be displayed by the first non-nil matching CONTENT face."
838 (item :tag "skip" nil) 861 (item :tag "skip" nil)
839 (face :value default))))) 862 (face :value default)))))
840 863
864(defcustom gnus-face-properties-alist (if (featurep 'xemacs)
865 '((xface . (:face gnus-x-face)))
866 '((pbm . (:face gnus-x-face))
867 (png . nil)))
868 "Alist of image types and properties applied to Face and X-Face images.
869Here are examples:
870
871;; Specify the altitude of Face images in the From header.
872\(setq gnus-face-properties-alist
873 '((pbm . (:face gnus-x-face :ascent 80))
874 (png . (:ascent 80))))
875
876;; Show Face images as pressed buttons.
877\(setq gnus-face-properties-alist
878 '((pbm . (:face gnus-x-face :relief -2))
879 (png . (:relief -2))))
880
881See the manual for the valid properties for various image types.
882Currently, `pbm' is used for X-Face images and `png' is used for Face
883images in Emacs. Only the `:face' property is effective on the `xface'
884image type in XEmacs if it is built with the libcompface library."
885 :version "23.0" ;; No Gnus
886 :group 'gnus-article-headers
887 :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
888
841(defcustom gnus-article-decode-hook 889(defcustom gnus-article-decode-hook
842 '(article-decode-charset article-decode-encoded-words 890 '(article-decode-charset article-decode-encoded-words
843 article-decode-group-name article-decode-idna-rhs) 891 article-decode-group-name article-decode-idna-rhs)
@@ -954,7 +1002,7 @@ on parts -- for instance, adding Vcard info to a database."
954 "An alist of MIME types to functions to display them." 1002 "An alist of MIME types to functions to display them."
955 :version "21.1" 1003 :version "21.1"
956 :group 'gnus-article-mime 1004 :group 'gnus-article-mime
957 :type 'alist) 1005 :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
958 1006
959(defcustom gnus-article-date-lapsed-new-header nil 1007(defcustom gnus-article-date-lapsed-new-header nil
960 "Whether the X-Sent and Date headers can coexist. 1008 "Whether the X-Sent and Date headers can coexist.
@@ -985,6 +1033,7 @@ used."
985(defcustom gnus-mime-action-alist 1033(defcustom gnus-mime-action-alist
986 '(("save to file" . gnus-mime-save-part) 1034 '(("save to file" . gnus-mime-save-part)
987 ("save and strip" . gnus-mime-save-part-and-strip) 1035 ("save and strip" . gnus-mime-save-part-and-strip)
1036 ("replace with file" . gnus-mime-replace-part)
988 ("delete part" . gnus-mime-delete-part) 1037 ("delete part" . gnus-mime-delete-part)
989 ("display as text" . gnus-mime-inline-part) 1038 ("display as text" . gnus-mime-inline-part)
990 ("view the part" . gnus-mime-view-part) 1039 ("view the part" . gnus-mime-view-part)
@@ -999,6 +1048,19 @@ used."
999 :type '(repeat (cons (string :tag "name") 1048 :type '(repeat (cons (string :tag "name")
1000 (function)))) 1049 (function))))
1001 1050
1051(defcustom gnus-auto-select-part 1
1052 "Advance to next MIME part when deleting or stripping parts.
1053
1054When 0, point will be placed on the same part as before. When
1055positive (negative), move point forward (backwards) this many
1056parts. When nil, redisplay article."
1057 :version "23.0" ;; No Gnus
1058 :group 'gnus-article-mime
1059 :type '(choice (const nil :tag "Redisplay article.")
1060 (const 1 :tag "Next part.")
1061 (const 0 :tag "Current part.")
1062 integer))
1063
1002;;; 1064;;;
1003;;; The treatment variables 1065;;; The treatment variables
1004;;; 1066;;;
@@ -1010,6 +1072,7 @@ used."
1010 '(choice (const :tag "Off" nil) 1072 '(choice (const :tag "Off" nil)
1011 (const :tag "On" t) 1073 (const :tag "On" t)
1012 (const :tag "Header" head) 1074 (const :tag "Header" head)
1075 (const :tag "First" first)
1013 (const :tag "Last" last) 1076 (const :tag "Last" last)
1014 (integer :tag "Less") 1077 (integer :tag "Less")
1015 (repeat :tag "Groups" regexp) 1078 (repeat :tag "Groups" regexp)
@@ -1019,7 +1082,8 @@ used."
1019 '(choice (const :tag "Off" nil) 1082 '(choice (const :tag "Off" nil)
1020 (const :tag "Header" head))) 1083 (const :tag "Header" head)))
1021 1084
1022(defvar gnus-article-treat-types '("text/plain") 1085(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
1086 "text/x-patch")
1023 "Parts to treat.") 1087 "Parts to treat.")
1024 1088
1025(defvar gnus-inhibit-treatment nil 1089(defvar gnus-inhibit-treatment nil
@@ -1027,8 +1091,8 @@ used."
1027 1091
1028(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard")) 1092(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
1029 "Highlight the signature. 1093 "Highlight the signature.
1030Valid values are nil, t, `head', `last', an integer or a predicate. 1094Valid values are nil, t, `head', `first', `last', an integer or a
1031See Info node `(gnus)Customizing Articles'." 1095predicate. See Info node `(gnus)Customizing Articles'."
1032 :group 'gnus-article-treat 1096 :group 'gnus-article-treat
1033 :link '(custom-manual "(gnus)Customizing Articles") 1097 :link '(custom-manual "(gnus)Customizing Articles")
1034 :type gnus-article-treat-custom) 1098 :type gnus-article-treat-custom)
@@ -1036,8 +1100,8 @@ See Info node `(gnus)Customizing Articles'."
1036 1100
1037(defcustom gnus-treat-buttonize 100000 1101(defcustom gnus-treat-buttonize 100000
1038 "Add buttons. 1102 "Add buttons.
1039Valid values are nil, t, `head', `last', an integer or a predicate. 1103Valid values are nil, t, `head', `first', `last', an integer or a
1040See Info node `(gnus)Customizing Articles'." 1104predicate. See Info node `(gnus)Customizing Articles'."
1041 :group 'gnus-article-treat 1105 :group 'gnus-article-treat
1042 :link '(custom-manual "(gnus)Customizing Articles") 1106 :link '(custom-manual "(gnus)Customizing Articles")
1043 :type gnus-article-treat-custom) 1107 :type gnus-article-treat-custom)
@@ -1045,8 +1109,8 @@ See Info node `(gnus)Customizing Articles'."
1045 1109
1046(defcustom gnus-treat-buttonize-head 'head 1110(defcustom gnus-treat-buttonize-head 'head
1047 "Add buttons to the head. 1111 "Add buttons to the head.
1048Valid values are nil, t, `head', `last', an integer or a predicate. 1112Valid values are nil, t, `head', `first', `last', an integer or a
1049See Info node `(gnus)Customizing Articles' for details." 1113predicate. See Info node `(gnus)Customizing Articles'."
1050 :group 'gnus-article-treat 1114 :group 'gnus-article-treat
1051 :link '(custom-manual "(gnus)Customizing Articles") 1115 :link '(custom-manual "(gnus)Customizing Articles")
1052 :type gnus-article-treat-head-custom) 1116 :type gnus-article-treat-head-custom)
@@ -1054,12 +1118,11 @@ See Info node `(gnus)Customizing Articles' for details."
1054 1118
1055(defcustom gnus-treat-emphasize 1119(defcustom gnus-treat-emphasize
1056 (and (or window-system 1120 (and (or window-system
1057 (featurep 'xemacs) 1121 (featurep 'xemacs))
1058 (>= (string-to-number emacs-version) 21))
1059 50000) 1122 50000)
1060 "Emphasize text. 1123 "Emphasize text.
1061Valid values are nil, t, `head', `last', an integer or a predicate. 1124Valid values are nil, t, `head', `first', `last', an integer or a
1062See Info node `(gnus)Customizing Articles' for details." 1125predicate. See Info node `(gnus)Customizing Articles'."
1063 :group 'gnus-article-treat 1126 :group 'gnus-article-treat
1064 :link '(custom-manual "(gnus)Customizing Articles") 1127 :link '(custom-manual "(gnus)Customizing Articles")
1065 :type gnus-article-treat-custom) 1128 :type gnus-article-treat-custom)
@@ -1067,8 +1130,8 @@ See Info node `(gnus)Customizing Articles' for details."
1067 1130
1068(defcustom gnus-treat-strip-cr nil 1131(defcustom gnus-treat-strip-cr nil
1069 "Remove carriage returns. 1132 "Remove carriage returns.
1070Valid values are nil, t, `head', `last', an integer or a predicate. 1133Valid values are nil, t, `head', `first', `last', an integer or a
1071See Info node `(gnus)Customizing Articles' for details." 1134predicate. See Info node `(gnus)Customizing Articles'."
1072 :version "22.1" 1135 :version "22.1"
1073 :group 'gnus-article-treat 1136 :group 'gnus-article-treat
1074 :link '(custom-manual "(gnus)Customizing Articles") 1137 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1076,8 +1139,8 @@ See Info node `(gnus)Customizing Articles' for details."
1076 1139
1077(defcustom gnus-treat-unsplit-urls nil 1140(defcustom gnus-treat-unsplit-urls nil
1078 "Remove newlines from within URLs. 1141 "Remove newlines from within URLs.
1079Valid values are nil, t, `head', `last', an integer or a predicate. 1142Valid values are nil, t, `head', `first', `last', an integer or a
1080See Info node `(gnus)Customizing Articles' for details." 1143predicate. See Info node `(gnus)Customizing Articles'."
1081 :version "22.1" 1144 :version "22.1"
1082 :group 'gnus-article-treat 1145 :group 'gnus-article-treat
1083 :link '(custom-manual "(gnus)Customizing Articles") 1146 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1085,8 +1148,8 @@ See Info node `(gnus)Customizing Articles' for details."
1085 1148
1086(defcustom gnus-treat-leading-whitespace nil 1149(defcustom gnus-treat-leading-whitespace nil
1087 "Remove leading whitespace in headers. 1150 "Remove leading whitespace in headers.
1088Valid values are nil, t, `head', `last', an integer or a predicate. 1151Valid values are nil, t, `head', `first', `last', an integer or a
1089See Info node `(gnus)Customizing Articles' for details." 1152predicate. See Info node `(gnus)Customizing Articles'."
1090 :version "22.1" 1153 :version "22.1"
1091 :group 'gnus-article-treat 1154 :group 'gnus-article-treat
1092 :link '(custom-manual "(gnus)Customizing Articles") 1155 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1094,56 +1157,56 @@ See Info node `(gnus)Customizing Articles' for details."
1094 1157
1095(defcustom gnus-treat-hide-headers 'head 1158(defcustom gnus-treat-hide-headers 'head
1096 "Hide headers. 1159 "Hide headers.
1097Valid values are nil, t, `head', `last', an integer or a predicate. 1160Valid values are nil, t, `head', `first', `last', an integer or a
1098See Info node `(gnus)Customizing Articles' for details." 1161predicate. See Info node `(gnus)Customizing Articles'."
1099 :group 'gnus-article-treat 1162 :group 'gnus-article-treat
1100 :link '(custom-manual "(gnus)Customizing Articles") 1163 :link '(custom-manual "(gnus)Customizing Articles")
1101 :type gnus-article-treat-head-custom) 1164 :type gnus-article-treat-head-custom)
1102 1165
1103(defcustom gnus-treat-hide-boring-headers nil 1166(defcustom gnus-treat-hide-boring-headers nil
1104 "Hide boring headers. 1167 "Hide boring headers.
1105Valid values are nil, t, `head', `last', an integer or a predicate. 1168Valid values are nil, t, `head', `first', `last', an integer or a
1106See Info node `(gnus)Customizing Articles' for details." 1169predicate. See Info node `(gnus)Customizing Articles'."
1107 :group 'gnus-article-treat 1170 :group 'gnus-article-treat
1108 :link '(custom-manual "(gnus)Customizing Articles") 1171 :link '(custom-manual "(gnus)Customizing Articles")
1109 :type gnus-article-treat-head-custom) 1172 :type gnus-article-treat-head-custom)
1110 1173
1111(defcustom gnus-treat-hide-signature nil 1174(defcustom gnus-treat-hide-signature nil
1112 "Hide the signature. 1175 "Hide the signature.
1113Valid values are nil, t, `head', `last', an integer or a predicate. 1176Valid values are nil, t, `head', `first', `last', an integer or a
1114See Info node `(gnus)Customizing Articles' for details." 1177predicate. See Info node `(gnus)Customizing Articles'."
1115 :group 'gnus-article-treat 1178 :group 'gnus-article-treat
1116 :link '(custom-manual "(gnus)Customizing Articles") 1179 :link '(custom-manual "(gnus)Customizing Articles")
1117 :type gnus-article-treat-custom) 1180 :type gnus-article-treat-custom)
1118 1181
1119(defcustom gnus-treat-fill-article nil 1182(defcustom gnus-treat-fill-article nil
1120 "Fill the article. 1183 "Fill the article.
1121Valid values are nil, t, `head', `last', an integer or a predicate. 1184Valid values are nil, t, `head', `first', `last', an integer or a
1122See Info node `(gnus)Customizing Articles' for details." 1185predicate. See Info node `(gnus)Customizing Articles'."
1123 :group 'gnus-article-treat 1186 :group 'gnus-article-treat
1124 :link '(custom-manual "(gnus)Customizing Articles") 1187 :link '(custom-manual "(gnus)Customizing Articles")
1125 :type gnus-article-treat-custom) 1188 :type gnus-article-treat-custom)
1126 1189
1127(defcustom gnus-treat-hide-citation nil 1190(defcustom gnus-treat-hide-citation nil
1128 "Hide cited text. 1191 "Hide cited text.
1129Valid values are nil, t, `head', `last', an integer or a predicate. 1192Valid values are nil, t, `head', `first', `last', an integer or a
1130See Info node `(gnus)Customizing Articles' for details." 1193predicate. See Info node `(gnus)Customizing Articles'."
1131 :group 'gnus-article-treat 1194 :group 'gnus-article-treat
1132 :link '(custom-manual "(gnus)Customizing Articles") 1195 :link '(custom-manual "(gnus)Customizing Articles")
1133 :type gnus-article-treat-custom) 1196 :type gnus-article-treat-custom)
1134 1197
1135(defcustom gnus-treat-hide-citation-maybe nil 1198(defcustom gnus-treat-hide-citation-maybe nil
1136 "Hide cited text. 1199 "Hide cited text.
1137Valid values are nil, t, `head', `last', an integer or a predicate. 1200Valid values are nil, t, `head', `first', `last', an integer or a
1138See Info node `(gnus)Customizing Articles' for details." 1201predicate. See Info node `(gnus)Customizing Articles'."
1139 :group 'gnus-article-treat 1202 :group 'gnus-article-treat
1140 :link '(custom-manual "(gnus)Customizing Articles") 1203 :link '(custom-manual "(gnus)Customizing Articles")
1141 :type gnus-article-treat-custom) 1204 :type gnus-article-treat-custom)
1142 1205
1143(defcustom gnus-treat-strip-list-identifiers 'head 1206(defcustom gnus-treat-strip-list-identifiers 'head
1144 "Strip list identifiers from `gnus-list-identifiers`. 1207 "Strip list identifiers from `gnus-list-identifiers`.
1145Valid values are nil, t, `head', `last', an integer or a predicate. 1208Valid values are nil, t, `head', `first', `last', an integer or a
1146See Info node `(gnus)Customizing Articles' for details." 1209predicate. See Info node `(gnus)Customizing Articles'."
1147 :version "21.1" 1210 :version "21.1"
1148 :group 'gnus-article-treat 1211 :group 'gnus-article-treat
1149 :link '(custom-manual "(gnus)Customizing Articles") 1212 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1154,8 +1217,8 @@ See Info node `(gnus)Customizing Articles' for details."
1154 1217
1155(defcustom gnus-treat-strip-pem nil 1218(defcustom gnus-treat-strip-pem nil
1156 "Strip PEM signatures. 1219 "Strip PEM signatures.
1157Valid values are nil, t, `head', `last', an integer or a predicate. 1220Valid values are nil, t, `head', `first', `last', an integer or a
1158See Info node `(gnus)Customizing Articles' for details." 1221predicate. See Info node `(gnus)Customizing Articles'."
1159 :group 'gnus-article-treat 1222 :group 'gnus-article-treat
1160 :link '(custom-manual "(gnus)Customizing Articles") 1223 :link '(custom-manual "(gnus)Customizing Articles")
1161 :type gnus-article-treat-custom) 1224 :type gnus-article-treat-custom)
@@ -1163,16 +1226,16 @@ See Info node `(gnus)Customizing Articles' for details."
1163(defcustom gnus-treat-strip-banner t 1226(defcustom gnus-treat-strip-banner t
1164 "Strip banners from articles. 1227 "Strip banners from articles.
1165The banner to be stripped is specified in the `banner' group parameter. 1228The banner to be stripped is specified in the `banner' group parameter.
1166Valid values are nil, t, `head', `last', an integer or a predicate. 1229Valid values are nil, t, `head', `first', `last', an integer or a
1167See Info node `(gnus)Customizing Articles' for details." 1230predicate. See Info node `(gnus)Customizing Articles'."
1168 :group 'gnus-article-treat 1231 :group 'gnus-article-treat
1169 :link '(custom-manual "(gnus)Customizing Articles") 1232 :link '(custom-manual "(gnus)Customizing Articles")
1170 :type gnus-article-treat-custom) 1233 :type gnus-article-treat-custom)
1171 1234
1172(defcustom gnus-treat-highlight-headers 'head 1235(defcustom gnus-treat-highlight-headers 'head
1173 "Highlight the headers. 1236 "Highlight the headers.
1174Valid values are nil, t, `head', `last', an integer or a predicate. 1237Valid values are nil, t, `head', `first', `last', an integer or a
1175See Info node `(gnus)Customizing Articles' for details." 1238predicate. See Info node `(gnus)Customizing Articles'."
1176 :group 'gnus-article-treat 1239 :group 'gnus-article-treat
1177 :link '(custom-manual "(gnus)Customizing Articles") 1240 :link '(custom-manual "(gnus)Customizing Articles")
1178 :type gnus-article-treat-head-custom) 1241 :type gnus-article-treat-head-custom)
@@ -1180,8 +1243,8 @@ See Info node `(gnus)Customizing Articles' for details."
1180 1243
1181(defcustom gnus-treat-highlight-citation t 1244(defcustom gnus-treat-highlight-citation t
1182 "Highlight cited text. 1245 "Highlight cited text.
1183Valid values are nil, t, `head', `last', an integer or a predicate. 1246Valid values are nil, t, `head', `first', `last', an integer or a
1184See Info node `(gnus)Customizing Articles' for details." 1247predicate. See Info node `(gnus)Customizing Articles'."
1185 :group 'gnus-article-treat 1248 :group 'gnus-article-treat
1186 :link '(custom-manual "(gnus)Customizing Articles") 1249 :link '(custom-manual "(gnus)Customizing Articles")
1187 :type gnus-article-treat-custom) 1250 :type gnus-article-treat-custom)
@@ -1189,24 +1252,24 @@ See Info node `(gnus)Customizing Articles' for details."
1189 1252
1190(defcustom gnus-treat-date-ut nil 1253(defcustom gnus-treat-date-ut nil
1191 "Display the Date in UT (GMT). 1254 "Display the Date in UT (GMT).
1192Valid values are nil, t, `head', `last', an integer or a predicate. 1255Valid values are nil, t, `head', `first', `last', an integer or a
1193See Info node `(gnus)Customizing Articles' for details." 1256predicate. See Info node `(gnus)Customizing Articles'."
1194 :group 'gnus-article-treat 1257 :group 'gnus-article-treat
1195 :link '(custom-manual "(gnus)Customizing Articles") 1258 :link '(custom-manual "(gnus)Customizing Articles")
1196 :type gnus-article-treat-head-custom) 1259 :type gnus-article-treat-head-custom)
1197 1260
1198(defcustom gnus-treat-date-local nil 1261(defcustom gnus-treat-date-local nil
1199 "Display the Date in the local timezone. 1262 "Display the Date in the local timezone.
1200Valid values are nil, t, `head', `last', an integer or a predicate. 1263Valid values are nil, t, `head', `first', `last', an integer or a
1201See Info node `(gnus)Customizing Articles' for details." 1264predicate. See Info node `(gnus)Customizing Articles'."
1202 :group 'gnus-article-treat 1265 :group 'gnus-article-treat
1203 :link '(custom-manual "(gnus)Customizing Articles") 1266 :link '(custom-manual "(gnus)Customizing Articles")
1204 :type gnus-article-treat-head-custom) 1267 :type gnus-article-treat-head-custom)
1205 1268
1206(defcustom gnus-treat-date-english nil 1269(defcustom gnus-treat-date-english nil
1207 "Display the Date in a format that can be read aloud in English. 1270 "Display the Date in a format that can be read aloud in English.
1208Valid values are nil, t, `head', `last', an integer or a predicate. 1271Valid values are nil, t, `head', `first', `last', an integer or a
1209See Info node `(gnus)Customizing Articles' for details." 1272predicate. See Info node `(gnus)Customizing Articles'."
1210 :version "22.1" 1273 :version "22.1"
1211 :group 'gnus-article-treat 1274 :group 'gnus-article-treat
1212 :link '(custom-manual "(gnus)Customizing Articles") 1275 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1214,24 +1277,24 @@ See Info node `(gnus)Customizing Articles' for details."
1214 1277
1215(defcustom gnus-treat-date-lapsed nil 1278(defcustom gnus-treat-date-lapsed nil
1216 "Display the Date header in a way that says how much time has elapsed. 1279 "Display the Date header in a way that says how much time has elapsed.
1217Valid values are nil, t, `head', `last', an integer or a predicate. 1280Valid values are nil, t, `head', `first', `last', an integer or a
1218See Info node `(gnus)Customizing Articles' for details." 1281predicate. See Info node `(gnus)Customizing Articles'."
1219 :group 'gnus-article-treat 1282 :group 'gnus-article-treat
1220 :link '(custom-manual "(gnus)Customizing Articles") 1283 :link '(custom-manual "(gnus)Customizing Articles")
1221 :type gnus-article-treat-head-custom) 1284 :type gnus-article-treat-head-custom)
1222 1285
1223(defcustom gnus-treat-date-original nil 1286(defcustom gnus-treat-date-original nil
1224 "Display the date in the original timezone. 1287 "Display the date in the original timezone.
1225Valid values are nil, t, `head', `last', an integer or a predicate. 1288Valid values are nil, t, `head', `first', `last', an integer or a
1226See Info node `(gnus)Customizing Articles' for details." 1289predicate. See Info node `(gnus)Customizing Articles'."
1227 :group 'gnus-article-treat 1290 :group 'gnus-article-treat
1228 :link '(custom-manual "(gnus)Customizing Articles") 1291 :link '(custom-manual "(gnus)Customizing Articles")
1229 :type gnus-article-treat-head-custom) 1292 :type gnus-article-treat-head-custom)
1230 1293
1231(defcustom gnus-treat-date-iso8601 nil 1294(defcustom gnus-treat-date-iso8601 nil
1232 "Display the date in the ISO8601 format. 1295 "Display the date in the ISO8601 format.
1233Valid values are nil, t, `head', `last', an integer or a predicate. 1296Valid values are nil, t, `head', `first', `last', an integer or a
1234See Info node `(gnus)Customizing Articles' for details." 1297predicate. See Info node `(gnus)Customizing Articles'."
1235 :version "21.1" 1298 :version "21.1"
1236 :group 'gnus-article-treat 1299 :group 'gnus-article-treat
1237 :link '(custom-manual "(gnus)Customizing Articles") 1300 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1240,16 +1303,16 @@ See Info node `(gnus)Customizing Articles' for details."
1240(defcustom gnus-treat-date-user-defined nil 1303(defcustom gnus-treat-date-user-defined nil
1241 "Display the date in a user-defined format. 1304 "Display the date in a user-defined format.
1242The format is defined by the `gnus-article-time-format' variable. 1305The format is defined by the `gnus-article-time-format' variable.
1243Valid values are nil, t, `head', `last', an integer or a predicate. 1306Valid values are nil, t, `head', `first', `last', an integer or a
1244See Info node `(gnus)Customizing Articles' for details." 1307predicate. See Info node `(gnus)Customizing Articles'."
1245 :group 'gnus-article-treat 1308 :group 'gnus-article-treat
1246 :link '(custom-manual "(gnus)Customizing Articles") 1309 :link '(custom-manual "(gnus)Customizing Articles")
1247 :type gnus-article-treat-head-custom) 1310 :type gnus-article-treat-head-custom)
1248 1311
1249(defcustom gnus-treat-strip-headers-in-body t 1312(defcustom gnus-treat-strip-headers-in-body t
1250 "Strip the X-No-Archive header line from the beginning of the body. 1313 "Strip the X-No-Archive header line from the beginning of the body.
1251Valid values are nil, t, `head', `last', an integer or a predicate. 1314Valid values are nil, t, `head', `first', `last', an integer or a
1252See Info node `(gnus)Customizing Articles' for details." 1315predicate. See Info node `(gnus)Customizing Articles'."
1253 :version "21.1" 1316 :version "21.1"
1254 :group 'gnus-article-treat 1317 :group 'gnus-article-treat
1255 :link '(custom-manual "(gnus)Customizing Articles") 1318 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1257,8 +1320,8 @@ See Info node `(gnus)Customizing Articles' for details."
1257 1320
1258(defcustom gnus-treat-strip-trailing-blank-lines nil 1321(defcustom gnus-treat-strip-trailing-blank-lines nil
1259 "Strip trailing blank lines. 1322 "Strip trailing blank lines.
1260Valid values are nil, t, `head', `last', an integer or a predicate. 1323Valid values are nil, t, `head', `first', `last', an integer or a
1261See Info node `(gnus)Customizing Articles' for details. 1324predicate. See Info node `(gnus)Customizing Articles'.
1262 1325
1263When set to t, it also strips trailing blanks in all MIME parts. 1326When set to t, it also strips trailing blanks in all MIME parts.
1264Consider to use `last' instead." 1327Consider to use `last' instead."
@@ -1268,8 +1331,8 @@ Consider to use `last' instead."
1268 1331
1269(defcustom gnus-treat-strip-leading-blank-lines nil 1332(defcustom gnus-treat-strip-leading-blank-lines nil
1270 "Strip leading blank lines. 1333 "Strip leading blank lines.
1271Valid values are nil, t, `head', `last', an integer or a predicate. 1334Valid values are nil, t, `head', `first', `last', an integer or a
1272See Info node `(gnus)Customizing Articles' for details. 1335predicate. See Info node `(gnus)Customizing Articles'.
1273 1336
1274When set to t, it also strips trailing blanks in all MIME parts." 1337When set to t, it also strips trailing blanks in all MIME parts."
1275 :group 'gnus-article-treat 1338 :group 'gnus-article-treat
@@ -1278,25 +1341,37 @@ When set to t, it also strips trailing blanks in all MIME parts."
1278 1341
1279(defcustom gnus-treat-strip-multiple-blank-lines nil 1342(defcustom gnus-treat-strip-multiple-blank-lines nil
1280 "Strip multiple blank lines. 1343 "Strip multiple blank lines.
1281Valid values are nil, t, `head', `last', an integer or a predicate. 1344Valid values are nil, t, `head', `first', `last', an integer or a
1282See Info node `(gnus)Customizing Articles' for details." 1345predicate. See Info node `(gnus)Customizing Articles'."
1283 :group 'gnus-article-treat 1346 :group 'gnus-article-treat
1284 :link '(custom-manual "(gnus)Customizing Articles") 1347 :link '(custom-manual "(gnus)Customizing Articles")
1285 :type gnus-article-treat-custom) 1348 :type gnus-article-treat-custom)
1286 1349
1287(defcustom gnus-treat-unfold-headers 'head 1350(defcustom gnus-treat-unfold-headers 'head
1288 "Unfold folded header lines. 1351 "Unfold folded header lines.
1289Valid values are nil, t, `head', `last', an integer or a predicate. 1352Valid values are nil, t, `head', `first', `last', an integer or a
1290See Info node `(gnus)Customizing Articles' for details." 1353predicate. See Info node `(gnus)Customizing Articles'."
1291 :version "22.1" 1354 :version "22.1"
1292 :group 'gnus-article-treat 1355 :group 'gnus-article-treat
1293 :link '(custom-manual "(gnus)Customizing Articles") 1356 :link '(custom-manual "(gnus)Customizing Articles")
1294 :type gnus-article-treat-custom) 1357 :type gnus-article-treat-custom)
1295 1358
1359(defcustom gnus-article-unfold-long-headers nil
1360 "If non-nil, allow unfolding headers even if the header is long.
1361If it is a regexp, only long headers matching this regexp are unfolded.
1362If it is t, all long headers are unfolded.
1363
1364This variable has no effect if `gnus-treat-unfold-headers' is nil."
1365 :version "23.0" ;; No Gnus
1366 :group 'gnus-article-treat
1367 :type '(choice (const nil)
1368 (const :tag "all" t)
1369 (regexp)))
1370
1296(defcustom gnus-treat-fold-headers nil 1371(defcustom gnus-treat-fold-headers nil
1297 "Fold headers. 1372 "Fold headers.
1298Valid values are nil, t, `head', `last', an integer or a predicate. 1373Valid values are nil, t, `head', `first', `last', an integer or a
1299See Info node `(gnus)Customizing Articles' for details." 1374predicate. See Info node `(gnus)Customizing Articles'."
1300 :version "22.1" 1375 :version "22.1"
1301 :group 'gnus-article-treat 1376 :group 'gnus-article-treat
1302 :link '(custom-manual "(gnus)Customizing Articles") 1377 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1304,8 +1379,8 @@ See Info node `(gnus)Customizing Articles' for details."
1304 1379
1305(defcustom gnus-treat-fold-newsgroups 'head 1380(defcustom gnus-treat-fold-newsgroups 'head
1306 "Fold the Newsgroups and Followup-To headers. 1381 "Fold the Newsgroups and Followup-To headers.
1307Valid values are nil, t, `head', `last', an integer or a predicate. 1382Valid values are nil, t, `head', `first', `last', an integer or a
1308See Info node `(gnus)Customizing Articles' for details." 1383predicate. See Info node `(gnus)Customizing Articles'."
1309 :version "22.1" 1384 :version "22.1"
1310 :group 'gnus-article-treat 1385 :group 'gnus-article-treat
1311 :link '(custom-manual "(gnus)Customizing Articles") 1386 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1313,13 +1388,21 @@ See Info node `(gnus)Customizing Articles' for details."
1313 1388
1314(defcustom gnus-treat-overstrike t 1389(defcustom gnus-treat-overstrike t
1315 "Treat overstrike highlighting. 1390 "Treat overstrike highlighting.
1316Valid values are nil, t, `head', `last', an integer or a predicate. 1391Valid values are nil, t, `head', `first', `last', an integer or a
1317See Info node `(gnus)Customizing Articles' for details." 1392predicate. See Info node `(gnus)Customizing Articles'."
1318 :group 'gnus-article-treat 1393 :group 'gnus-article-treat
1319 :link '(custom-manual "(gnus)Customizing Articles") 1394 :link '(custom-manual "(gnus)Customizing Articles")
1320 :type gnus-article-treat-custom) 1395 :type gnus-article-treat-custom)
1321(put 'gnus-treat-overstrike 'highlight t) 1396(put 'gnus-treat-overstrike 'highlight t)
1322 1397
1398(defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t)
1399 "Treat ANSI SGR control sequences.
1400Valid values are nil, t, `head', `first', `last', an integer or a
1401predicate. See Info node `(gnus)Customizing Articles'."
1402 :group 'gnus-article-treat
1403 :link '(custom-manual "(gnus)Customizing Articles")
1404 :type gnus-article-treat-custom)
1405
1323(make-obsolete-variable 'gnus-treat-display-xface 1406(make-obsolete-variable 'gnus-treat-display-xface
1324 'gnus-treat-display-x-face) 1407 'gnus-treat-display-x-face)
1325 1408
@@ -1364,9 +1447,9 @@ See Info node `(gnus)Customizing Articles' and Info node
1364 (gnus-image-type-available-p 'png) 1447 (gnus-image-type-available-p 'png)
1365 'head) 1448 'head)
1366 "Display Face headers. 1449 "Display Face headers.
1367Valid values are nil, t, `head', `last', an integer or a predicate. 1450Valid values are nil, t, `head', `first', `last', an integer or a
1368See Info node `(gnus)Customizing Articles' and Info node 1451predicate. See Info node `(gnus)Customizing Articles' and Info
1369`(gnus)X-Face' for details." 1452node `(gnus)X-Face' for details."
1370 :group 'gnus-article-treat 1453 :group 'gnus-article-treat
1371 :version "22.1" 1454 :version "22.1"
1372 :link '(custom-manual "(gnus)Customizing Articles") 1455 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1376,9 +1459,9 @@ See Info node `(gnus)Customizing Articles' and Info node
1376 1459
1377(defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm) 1460(defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm)
1378 "Display smileys. 1461 "Display smileys.
1379Valid values are nil, t, `head', `last', an integer or a predicate. 1462Valid values are nil, t, `head', `first', `last', an integer or a
1380See Info node `(gnus)Customizing Articles' and Info node 1463predicate. See Info node `(gnus)Customizing Articles' and Info
1381`(gnus)Smileys' for details." 1464node `(gnus)Smileys' for details."
1382 :group 'gnus-article-treat 1465 :group 'gnus-article-treat
1383 :version "21.1" 1466 :version "21.1"
1384 :link '(custom-manual "(gnus)Customizing Articles") 1467 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1391,9 +1474,9 @@ See Info node `(gnus)Customizing Articles' and Info node
1391 (gnus-picons-installed-p)) 1474 (gnus-picons-installed-p))
1392 'head nil) 1475 'head nil)
1393 "Display picons in the From header. 1476 "Display picons in the From header.
1394Valid values are nil, t, `head', `last', an integer or a predicate. 1477Valid values are nil, t, `head', `first', `last', an integer or a
1395See Info node `(gnus)Customizing Articles' and Info node 1478predicate. See Info node `(gnus)Customizing Articles' and Info
1396`(gnus)Picons' for details." 1479node `(gnus)Picons' for details."
1397 :version "22.1" 1480 :version "22.1"
1398 :group 'gnus-article-treat 1481 :group 'gnus-article-treat
1399 :group 'gnus-picon 1482 :group 'gnus-picon
@@ -1407,9 +1490,9 @@ See Info node `(gnus)Customizing Articles' and Info node
1407 (gnus-picons-installed-p)) 1490 (gnus-picons-installed-p))
1408 'head nil) 1491 'head nil)
1409 "Display picons in To and Cc headers. 1492 "Display picons in To and Cc headers.
1410Valid values are nil, t, `head', `last', an integer or a predicate. 1493Valid values are nil, t, `head', `first', `last', an integer or a
1411See Info node `(gnus)Customizing Articles' and Info node 1494predicate. See Info node `(gnus)Customizing Articles' and Info
1412`(gnus)Picons' for details." 1495node `(gnus)Picons' for details."
1413 :version "22.1" 1496 :version "22.1"
1414 :group 'gnus-article-treat 1497 :group 'gnus-article-treat
1415 :group 'gnus-picon 1498 :group 'gnus-picon
@@ -1423,9 +1506,9 @@ See Info node `(gnus)Customizing Articles' and Info node
1423 (gnus-picons-installed-p)) 1506 (gnus-picons-installed-p))
1424 'head nil) 1507 'head nil)
1425 "Display picons in the Newsgroups and Followup-To headers. 1508 "Display picons in the Newsgroups and Followup-To headers.
1426Valid values are nil, t, `head', `last', an integer or a predicate. 1509Valid values are nil, t, `head', `first', `last', an integer or a
1427See Info node `(gnus)Customizing Articles' and Info node 1510predicate. See Info node `(gnus)Customizing Articles' and Info
1428`(gnus)Picons' for details." 1511node `(gnus)Picons' for details."
1429 :version "22.1" 1512 :version "22.1"
1430 :group 'gnus-article-treat 1513 :group 'gnus-article-treat
1431 :group 'gnus-picon 1514 :group 'gnus-picon
@@ -1435,9 +1518,10 @@ See Info node `(gnus)Customizing Articles' and Info node
1435(put 'gnus-treat-newsgroups-picon 'highlight t) 1518(put 'gnus-treat-newsgroups-picon 'highlight t)
1436 1519
1437(defcustom gnus-treat-body-boundary 1520(defcustom gnus-treat-body-boundary
1438 (if (or gnus-treat-newsgroups-picon 1521 (if (and (eq window-system 'x)
1439 gnus-treat-mail-picon 1522 (or gnus-treat-newsgroups-picon
1440 gnus-treat-from-picon) 1523 gnus-treat-mail-picon
1524 gnus-treat-from-picon))
1441 'head nil) 1525 'head nil)
1442 "Draw a boundary at the end of the headers. 1526 "Draw a boundary at the end of the headers.
1443Valid values are nil and `head'. 1527Valid values are nil and `head'.
@@ -1449,8 +1533,8 @@ See Info node `(gnus)Customizing Articles' for details."
1449 1533
1450(defcustom gnus-treat-capitalize-sentences nil 1534(defcustom gnus-treat-capitalize-sentences nil
1451 "Capitalize sentence-starting words. 1535 "Capitalize sentence-starting words.
1452Valid values are nil, t, `head', `last', an integer or a predicate. 1536Valid values are nil, t, `head', `first', `last', an integer or a
1453See Info node `(gnus)Customizing Articles' for details." 1537predicate. See Info node `(gnus)Customizing Articles'."
1454 :version "21.1" 1538 :version "21.1"
1455 :group 'gnus-article-treat 1539 :group 'gnus-article-treat
1456 :link '(custom-manual "(gnus)Customizing Articles") 1540 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1458,8 +1542,8 @@ See Info node `(gnus)Customizing Articles' for details."
1458 1542
1459(defcustom gnus-treat-wash-html nil 1543(defcustom gnus-treat-wash-html nil
1460 "Format as HTML. 1544 "Format as HTML.
1461Valid values are nil, t, `head', `last', an integer or a predicate. 1545Valid values are nil, t, `head', `first', `last', an integer or a
1462See Info node `(gnus)Customizing Articles' for details." 1546predicate. See Info node `(gnus)Customizing Articles'."
1463 :version "22.1" 1547 :version "22.1"
1464 :group 'gnus-article-treat 1548 :group 'gnus-article-treat
1465 :link '(custom-manual "(gnus)Customizing Articles") 1549 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1467,16 +1551,16 @@ See Info node `(gnus)Customizing Articles' for details."
1467 1551
1468(defcustom gnus-treat-fill-long-lines nil 1552(defcustom gnus-treat-fill-long-lines nil
1469 "Fill long lines. 1553 "Fill long lines.
1470Valid values are nil, t, `head', `last', an integer or a predicate. 1554Valid values are nil, t, `head', `first', `last', an integer or a
1471See Info node `(gnus)Customizing Articles' for details." 1555predicate. See Info node `(gnus)Customizing Articles'."
1472 :group 'gnus-article-treat 1556 :group 'gnus-article-treat
1473 :link '(custom-manual "(gnus)Customizing Articles") 1557 :link '(custom-manual "(gnus)Customizing Articles")
1474 :type gnus-article-treat-custom) 1558 :type gnus-article-treat-custom)
1475 1559
1476(defcustom gnus-treat-play-sounds nil 1560(defcustom gnus-treat-play-sounds nil
1477 "Play sounds. 1561 "Play sounds.
1478Valid values are nil, t, `head', `last', an integer or a predicate. 1562Valid values are nil, t, `head', `first', `last', an integer or a
1479See Info node `(gnus)Customizing Articles' for details." 1563predicate. See Info node `(gnus)Customizing Articles'."
1480 :version "21.1" 1564 :version "21.1"
1481 :group 'gnus-article-treat 1565 :group 'gnus-article-treat
1482 :link '(custom-manual "(gnus)Customizing Articles") 1566 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1484,8 +1568,8 @@ See Info node `(gnus)Customizing Articles' for details."
1484 1568
1485(defcustom gnus-treat-translate nil 1569(defcustom gnus-treat-translate nil
1486 "Translate articles from one language to another. 1570 "Translate articles from one language to another.
1487Valid values are nil, t, `head', `last', an integer or a predicate. 1571Valid values are nil, t, `head', `first', `last', an integer or a
1488See Info node `(gnus)Customizing Articles' for details." 1572predicate. See Info node `(gnus)Customizing Articles'."
1489 :version "21.1" 1573 :version "21.1"
1490 :group 'gnus-article-treat 1574 :group 'gnus-article-treat
1491 :link '(custom-manual "(gnus)Customizing Articles") 1575 :link '(custom-manual "(gnus)Customizing Articles")
@@ -1494,8 +1578,8 @@ See Info node `(gnus)Customizing Articles' for details."
1494(defcustom gnus-treat-x-pgp-sig nil 1578(defcustom gnus-treat-x-pgp-sig nil
1495 "Verify X-PGP-Sig. 1579 "Verify X-PGP-Sig.
1496To automatically treat X-PGP-Sig, set it to head. 1580To automatically treat X-PGP-Sig, set it to head.
1497Valid values are nil, t, `head', `last', an integer or a predicate. 1581Valid values are nil, t, `head', `first', `last', an integer or a
1498See Info node `(gnus)Customizing Articles' for details." 1582predicate. See Info node `(gnus)Customizing Articles'."
1499 :version "22.1" 1583 :version "22.1"
1500 :group 'gnus-article-treat 1584 :group 'gnus-article-treat
1501 :group 'mime-security 1585 :group 'mime-security
@@ -1581,9 +1665,10 @@ This requires GNU Libidn, and by default only enabled if it is found."
1581 (gnus-treat-strip-multiple-blank-lines 1665 (gnus-treat-strip-multiple-blank-lines
1582 gnus-article-strip-multiple-blank-lines) 1666 gnus-article-strip-multiple-blank-lines)
1583 (gnus-treat-overstrike gnus-article-treat-overstrike) 1667 (gnus-treat-overstrike gnus-article-treat-overstrike)
1668 (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
1584 (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) 1669 (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1585 (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1586 (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) 1670 (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1671 (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1587 (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) 1672 (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1588 (gnus-treat-display-smileys gnus-treat-smiley) 1673 (gnus-treat-display-smileys gnus-treat-smiley)
1589 (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) 1674 (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
@@ -1814,12 +1899,9 @@ always hide."
1814 (save-excursion 1899 (save-excursion
1815 (save-restriction 1900 (save-restriction
1816 (let ((inhibit-read-only t) 1901 (let ((inhibit-read-only t)
1817 (list gnus-boring-article-headers) 1902 (inhibit-point-motion-hooks t))
1818 (inhibit-point-motion-hooks t)
1819 elem)
1820 (article-narrow-to-head) 1903 (article-narrow-to-head)
1821 (while list 1904 (dolist (elem gnus-boring-article-headers)
1822 (setq elem (pop list))
1823 (goto-char (point-min)) 1905 (goto-char (point-min))
1824 (cond 1906 (cond
1825 ;; Hide empty headers. 1907 ;; Hide empty headers.
@@ -1827,7 +1909,7 @@ always hide."
1827 (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) 1909 (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
1828 (forward-line -1) 1910 (forward-line -1)
1829 (gnus-article-hide-text-type 1911 (gnus-article-hide-text-type
1830 (gnus-point-at-bol) 1912 (point-at-bol)
1831 (progn 1913 (progn
1832 (end-of-line) 1914 (end-of-line)
1833 (if (re-search-forward "^[^ \t]" nil t) 1915 (if (re-search-forward "^[^ \t]" nil t)
@@ -1957,7 +2039,7 @@ always hide."
1957 (goto-char (point-min)) 2039 (goto-char (point-min))
1958 (when (re-search-forward (concat "^" header ":") nil t) 2040 (when (re-search-forward (concat "^" header ":") nil t)
1959 (gnus-article-hide-text-type 2041 (gnus-article-hide-text-type
1960 (gnus-point-at-bol) 2042 (point-at-bol)
1961 (progn 2043 (progn
1962 (end-of-line) 2044 (end-of-line)
1963 (if (re-search-forward "^[^ \t]" nil t) 2045 (if (re-search-forward "^[^ \t]" nil t)
@@ -1978,7 +2060,7 @@ always hide."
1978 (article-narrow-to-head) 2060 (article-narrow-to-head)
1979 (while (not (eobp)) 2061 (while (not (eobp))
1980 (cond 2062 (cond
1981 ((< (setq column (- (gnus-point-at-eol) (point))) 2063 ((< (setq column (- (point-at-eol) (point)))
1982 gnus-article-normalized-header-length) 2064 gnus-article-normalized-header-length)
1983 (end-of-line) 2065 (end-of-line)
1984 (insert (make-string 2066 (insert (make-string
@@ -1989,7 +2071,7 @@ always hide."
1989 (progn 2071 (progn
1990 (forward-char gnus-article-normalized-header-length) 2072 (forward-char gnus-article-normalized-header-length)
1991 (point)) 2073 (point))
1992 (gnus-point-at-eol) 2074 (point-at-eol)
1993 'invisible t)) 2075 'invisible t))
1994 (t 2076 (t
1995 ;; Do nothing. 2077 ;; Do nothing.
@@ -2031,9 +2113,8 @@ characters to translate to."
2031MAP is an alist where the elements are on the form (\"from\" \"to\")." 2113MAP is an alist where the elements are on the form (\"from\" \"to\")."
2032 (save-excursion 2114 (save-excursion
2033 (when (article-goto-body) 2115 (when (article-goto-body)
2034 (let ((inhibit-read-only t) 2116 (let ((inhibit-read-only t))
2035 elem) 2117 (dolist (elem map)
2036 (while (setq elem (pop map))
2037 (save-excursion 2118 (save-excursion
2038 (while (search-forward (car elem) nil t) 2119 (while (search-forward (car elem) nil t)
2039 (replace-match (cadr elem))))))))) 2120 (replace-match (cadr elem)))))))))
@@ -2064,6 +2145,14 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
2064 (put-text-property 2145 (put-text-property
2065 (point) (1+ (point)) 'face 'underline))))))))) 2146 (point) (1+ (point)) 'face 'underline)))))))))
2066 2147
2148(defun article-treat-ansi-sequences ()
2149 "Translate ANSI SGR control sequences into overlays or extents."
2150 (interactive)
2151 (save-excursion
2152 (when (article-goto-body)
2153 (let ((inhibit-read-only t))
2154 (ansi-color-apply-on-region (point) (point-max))))))
2155
2067(defun gnus-article-treat-unfold-headers () 2156(defun gnus-article-treat-unfold-headers ()
2068 "Unfold folded message headers. 2157 "Unfold folded message headers.
2069Only the headers that fit into the current window width will be 2158Only the headers that fit into the current window width will be
@@ -2074,16 +2163,21 @@ unfolded."
2074 (while (not (eobp)) 2163 (while (not (eobp))
2075 (save-restriction 2164 (save-restriction
2076 (mail-header-narrow-to-field) 2165 (mail-header-narrow-to-field)
2077 (let ((header (buffer-string))) 2166 (let* ((header (buffer-string))
2167 (unfoldable
2168 (or (equal gnus-article-unfold-long-headers t)
2169 (and (stringp gnus-article-unfold-long-headers)
2170 (string-match gnus-article-unfold-long-headers header)))))
2078 (with-temp-buffer 2171 (with-temp-buffer
2079 (insert header) 2172 (insert header)
2080 (goto-char (point-min)) 2173 (goto-char (point-min))
2081 (while (re-search-forward "\n[\t ]" nil t) 2174 (while (re-search-forward "\n[\t ]" nil t)
2082 (replace-match " " t t))) 2175 (replace-match " " t t)))
2083 (setq length (- (point-max) (point-min) 1))) 2176 (setq length (- (point-max) (point-min) 1))
2084 (when (< length (window-width)) 2177 (when (or unfoldable
2085 (while (re-search-forward "\n[\t ]" nil t) 2178 (< length (window-width)))
2086 (replace-match " " t t))) 2179 (while (re-search-forward "\n[\t ]" nil t)
2180 (replace-match " " t t))))
2087 (goto-char (point-max))))))) 2181 (goto-char (point-max)))))))
2088 2182
2089(defun gnus-article-treat-fold-headers () 2183(defun gnus-article-treat-fold-headers ()
@@ -2130,6 +2224,39 @@ unfolded."
2130 (mail-header-fold-field) 2224 (mail-header-fold-field)
2131 (goto-char (point-max)))))) 2225 (goto-char (point-max))))))
2132 2226
2227(defcustom gnus-article-truncate-lines default-truncate-lines
2228 "Value of `truncate-lines' in Gnus Article buffer.
2229Valid values are nil, t, `head', `first', `last', an integer or a
2230predicate. See Info node `(gnus)Customizing Articles'."
2231 :version "23.0" ;; No Gnus
2232 :group 'gnus-article
2233 ;; :link '(custom-manual "(gnus)Customizing Articles")
2234 :type 'boolean)
2235
2236(defun gnus-article-toggle-truncate-lines (&optional arg)
2237 "Toggle whether to fold or truncate long lines in article the buffer.
2238If ARG is non-nil and not a number, toggle
2239`gnus-article-truncate-lines' too. If ARG is a number, truncate
2240long lines iff arg is positive."
2241 (interactive "P")
2242 (cond
2243 ((and (numberp arg) (> arg 0))
2244 (setq gnus-article-truncate-lines t))
2245 ((numberp arg)
2246 (setq gnus-article-truncate-lines nil))
2247 (arg
2248 (setq gnus-article-truncate-lines
2249 (not gnus-article-truncate-lines))))
2250 (gnus-with-article-buffer
2251 (cond
2252 ((and (numberp arg) (> arg 0))
2253 (setq truncate-lines nil))
2254 ((numberp arg)
2255 (setq truncate-lines t)))
2256 ;; In versions of Emacs 22 (CVS) before 2006-05-26,
2257 ;; `toggle-truncate-lines' needs an argument.
2258 (toggle-truncate-lines)))
2259
2133(defun gnus-article-treat-body-boundary () 2260(defun gnus-article-treat-body-boundary ()
2134 "Place a boundary line at the end of the headers." 2261 "Place a boundary line at the end of the headers."
2135 (interactive) 2262 (interactive)
@@ -2160,7 +2287,7 @@ unfolded."
2160 (end-of-line) 2287 (end-of-line)
2161 (when (>= (current-column) (min fill-column width)) 2288 (when (>= (current-column) (min fill-column width))
2162 (narrow-to-region (min (1+ (point)) (point-max)) 2289 (narrow-to-region (min (1+ (point)) (point-max))
2163 (gnus-point-at-bol)) 2290 (point-at-bol))
2164 (let ((goback (point-marker))) 2291 (let ((goback (point-marker)))
2165 (fill-paragraph nil) 2292 (fill-paragraph nil)
2166 (goto-char (marker-position goback))) 2293 (goto-char (marker-position goback)))
@@ -2202,11 +2329,14 @@ unfolded."
2202 (while (and (not (bobp)) 2329 (while (and (not (bobp))
2203 (looking-at "^[ \t]*$") 2330 (looking-at "^[ \t]*$")
2204 (not (gnus-annotation-in-region-p 2331 (not (gnus-annotation-in-region-p
2205 (point) (gnus-point-at-eol)))) 2332 (point) (point-at-eol))))
2206 (forward-line -1)) 2333 (forward-line -1))
2207 (forward-line 1) 2334 (forward-line 1)
2208 (point)))))) 2335 (point))))))
2209 2336
2337(eval-when-compile
2338 (defvar gnus-face-properties-alist))
2339
2210(defun article-display-face () 2340(defun article-display-face ()
2211 "Display any Face headers in the header." 2341 "Display any Face headers in the header."
2212 (interactive) 2342 (interactive)
@@ -2239,7 +2369,9 @@ unfolded."
2239 (insert "[no `from' set]\n")) 2369 (insert "[no `from' set]\n"))
2240 (while faces 2370 (while faces
2241 (when (setq png (gnus-convert-face-to-png (pop faces))) 2371 (when (setq png (gnus-convert-face-to-png (pop faces)))
2242 (setq image (gnus-create-image png 'png t)) 2372 (setq image
2373 (apply 'gnus-create-image png 'png t
2374 (cdr (assq 'png gnus-face-properties-alist))))
2243 (goto-char from) 2375 (goto-char from)
2244 (gnus-add-wash-type 'face) 2376 (gnus-add-wash-type 'face)
2245 (gnus-add-image 'face image) 2377 (gnus-add-image 'face image)
@@ -2311,14 +2443,12 @@ unfolded."
2311(defun article-decode-mime-words () 2443(defun article-decode-mime-words ()
2312 "Decode all MIME-encoded words in the article." 2444 "Decode all MIME-encoded words in the article."
2313 (interactive) 2445 (interactive)
2314 (save-excursion 2446 (gnus-with-article-buffer
2315 (set-buffer gnus-article-buffer)
2316 (let ((inhibit-point-motion-hooks t) 2447 (let ((inhibit-point-motion-hooks t)
2317 (inhibit-read-only t)
2318 (mail-parse-charset gnus-newsgroup-charset) 2448 (mail-parse-charset gnus-newsgroup-charset)
2319 (mail-parse-ignored-charsets 2449 (mail-parse-ignored-charsets
2320 (save-excursion (set-buffer gnus-summary-buffer) 2450 (with-current-buffer gnus-summary-buffer
2321 gnus-newsgroup-ignored-charsets))) 2451 gnus-newsgroup-ignored-charsets)))
2322 (mail-decode-encoded-word-region (point-min) (point-max))))) 2452 (mail-decode-encoded-word-region (point-min) (point-max)))))
2323 2453
2324(defun article-decode-charset (&optional prompt) 2454(defun article-decode-charset (&optional prompt)
@@ -2395,44 +2525,31 @@ If PROMPT (the prefix), prompt for a coding system to use."
2395 (goto-char (setq end start))))) 2525 (goto-char (setq end start)))))
2396 2526
2397(defun article-decode-group-name () 2527(defun article-decode-group-name ()
2398 "Decode group names in `Newsgroups:'." 2528 "Decode group names in Newsgroups, Followup-To and Xref headers."
2399 (let ((inhibit-point-motion-hooks t) 2529 (let ((inhibit-point-motion-hooks t)
2400 (inhibit-read-only t) 2530 (inhibit-read-only t)
2401 (method (gnus-find-method-for-group gnus-newsgroup-name))) 2531 (method (gnus-find-method-for-group gnus-newsgroup-name))
2532 regexp)
2402 (when (and (or gnus-group-name-charset-method-alist 2533 (when (and (or gnus-group-name-charset-method-alist
2403 gnus-group-name-charset-group-alist) 2534 gnus-group-name-charset-group-alist)
2404 (gnus-buffer-live-p gnus-original-article-buffer)) 2535 (gnus-buffer-live-p gnus-original-article-buffer))
2405 (save-restriction 2536 (save-restriction
2406 (article-narrow-to-head) 2537 (article-narrow-to-head)
2407 (with-current-buffer gnus-original-article-buffer 2538 (dolist (header '("Newsgroups" "Followup-To" "Xref"))
2408 (goto-char (point-min))) 2539 (with-current-buffer gnus-original-article-buffer
2409 (while (re-search-forward 2540 (goto-char (point-min)))
2410 "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) 2541 (setq regexp (concat "^" header
2411 (replace-match (save-match-data 2542 ":\\([^\n]*\\(?:\n[\t ]+[^\n]+\\)*\\)\n"))
2412 (gnus-decode-newsgroups 2543 (while (re-search-forward regexp nil t)
2413 ;; XXX how to use data in article buffer? 2544 (replace-match (save-match-data
2414 (with-current-buffer gnus-original-article-buffer 2545 (gnus-decode-newsgroups
2415 (re-search-forward 2546 ;; XXX how to use data in article buffer?
2416 "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" 2547 (with-current-buffer gnus-original-article-buffer
2417 nil t) 2548 (re-search-forward regexp nil t)
2418 (match-string 1)) 2549 (match-string 1))
2419 gnus-newsgroup-name method)) 2550 gnus-newsgroup-name method))
2420 t t nil 1)) 2551 t t nil 1))
2421 (goto-char (point-min)) 2552 (goto-char (point-min)))))))
2422 (with-current-buffer gnus-original-article-buffer
2423 (goto-char (point-min)))
2424 (while (re-search-forward
2425 "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
2426 (replace-match (save-match-data
2427 (gnus-decode-newsgroups
2428 ;; XXX how to use data in article buffer?
2429 (with-current-buffer gnus-original-article-buffer
2430 (re-search-forward
2431 "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
2432 nil t)
2433 (match-string 1))
2434 gnus-newsgroup-name method))
2435 t t nil 1))))))
2436 2553
2437(autoload 'idna-to-unicode "idna") 2554(autoload 'idna-to-unicode "idna")
2438 2555
@@ -2628,6 +2745,104 @@ charset defined in `gnus-summary-show-article-charset-alist' is used."
2628 "-I" (symbol-name charset) "-O" (symbol-name charset)))) 2745 "-I" (symbol-name charset) "-O" (symbol-name charset))))
2629 (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html"))) 2746 (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html")))
2630 2747
2748(defvar gnus-article-browse-html-temp-list nil
2749 "List of temporary files created by `gnus-article-browse-html-parts'.
2750Internal variable.")
2751
2752(defcustom gnus-article-browse-delete-temp 'ask
2753 "What to do with temporary files from `gnus-article-browse-html-parts'.
2754If nil, don't delete temporary files. If it is t, delete them on
2755exit from the summary buffer. If it is the symbol `file', query
2756on each file, if it is `ask' ask once when exiting from the
2757summary buffer."
2758 :group 'gnus-article
2759 :version "23.0" ;; No Gnus
2760 :type '(choice (const :tag "Don't delete" nil)
2761 (const :tag "Don't ask" t)
2762 (const :tag "Ask" ask)
2763 (const :tag "Ask for each file" file)))
2764
2765;; Cf. mm-postponed-undisplay-list / mm-destroy-postponed-undisplay-list.
2766
2767(defun gnus-article-browse-delete-temp-files (&optional how)
2768 "Delete temp-files created by `gnus-article-browse-html-parts'."
2769 (when (and gnus-article-browse-html-temp-list
2770 (or how
2771 (setq how gnus-article-browse-delete-temp)))
2772 (when (and (eq how 'ask)
2773 (y-or-n-p (format
2774 "Delete all %s temporary HTML file(s)? "
2775 (length gnus-article-browse-html-temp-list)))
2776 (setq how t)))
2777 (dolist (file gnus-article-browse-html-temp-list)
2778 (when (and (file-exists-p file)
2779 (or (eq how t)
2780 ;; `how' is neither `nil', `ask' nor `t' (i.e. `file'):
2781 (gnus-y-or-n-p
2782 (format "Delete temporary HTML file `%s'? " file))))
2783 (delete-file file)))
2784 ;; Also remove file from the list when not deleted or if file doesn't
2785 ;; exist anymore.
2786 (setq gnus-article-browse-html-temp-list nil))
2787 gnus-article-browse-html-temp-list)
2788
2789(defun gnus-article-browse-html-parts (list)
2790 "View all \"text/html\" parts from LIST.
2791Recurse into multiparts."
2792 ;; Internal function used by `gnus-article-browse-html-article'.
2793 (let ((showed))
2794 ;; Find and show the html-parts.
2795 (dolist (handle list)
2796 ;; If HTML, show it:
2797 (when (listp handle)
2798 (cond ((and (bufferp (car handle))
2799 (string-match "text/html" (car (mm-handle-type handle))))
2800 (let ((tmp-file (mm-make-temp-file
2801 ;; Do we need to care for 8.3 filenames?
2802 "mm-" nil ".html")))
2803 (mm-save-part-to-file handle tmp-file)
2804 (add-to-list 'gnus-article-browse-html-temp-list tmp-file)
2805 (add-hook 'gnus-summary-prepare-exit-hook
2806 'gnus-article-browse-delete-temp-files)
2807 (add-hook 'gnus-exit-gnus-hook
2808 (lambda ()
2809 (gnus-article-browse-delete-temp-files t)))
2810 ;; FIXME: Warn if there's an <img> tag?
2811 (browse-url-of-file tmp-file)
2812 (setq showed t)))
2813 ;; If multipart, recurse
2814 ((and (stringp (car handle))
2815 (string-match "^multipart/" (car handle))
2816 (setq showed
2817 (or showed
2818 (gnus-article-browse-html-parts handle))))))))
2819 showed))
2820
2821;; FIXME: Documentation in texi/gnus.texi missing.
2822(defun gnus-article-browse-html-article ()
2823 "View \"text/html\" parts of the current article with a WWW browser.
2824
2825Warning: Spammers use links to images in HTML articles to verify
2826whether you have read the message. As
2827`gnus-article-browse-html-article' passes the unmodified HTML
2828content to the browser without eliminating these \"web bugs\" you
2829should only use it for mails from trusted senders."
2830 ;; Cf. `mm-w3m-safe-url-regexp'
2831 (interactive)
2832 (save-window-excursion
2833 ;; Open raw article and select the buffer
2834 (gnus-summary-show-article t)
2835 (gnus-summary-select-article-buffer)
2836 (let ((parts (mm-dissect-buffer t t)))
2837 ;; If singlepart, enforce a list.
2838 (when (and (bufferp (car parts))
2839 (stringp (car (mm-handle-type parts))))
2840 (setq parts (list parts)))
2841 ;; Process the list
2842 (unless (gnus-article-browse-html-parts parts)
2843 (gnus-error 3 "Mail doesn't contain a \"text/html\" part!"))
2844 (gnus-summary-show-article))))
2845
2631(defun article-hide-list-identifiers () 2846(defun article-hide-list-identifiers ()
2632 "Remove list identifies from the Subject header. 2847 "Remove list identifies from the Subject header.
2633The `gnus-list-identifiers' variable specifies what to do." 2848The `gnus-list-identifiers' variable specifies what to do."
@@ -2732,11 +2947,9 @@ always hide."
2732 "Translate article using an online translation service." 2947 "Translate article using an online translation service."
2733 (interactive) 2948 (interactive)
2734 (require 'babel) 2949 (require 'babel)
2735 (save-excursion 2950 (gnus-with-article-buffer
2736 (set-buffer gnus-article-buffer)
2737 (when (article-goto-body) 2951 (when (article-goto-body)
2738 (let* ((inhibit-read-only t) 2952 (let* ((start (point))
2739 (start (point))
2740 (end (point-max)) 2953 (end (point-max))
2741 (orig (buffer-substring start end)) 2954 (orig (buffer-substring start end))
2742 (trans (babel-as-string orig))) 2955 (trans (babel-as-string orig)))
@@ -3007,22 +3220,20 @@ should replace the \"Date:\" one, or should be added below it."
3007 (point-max))) 3220 (point-max)))
3008 (goto-char (point-min)) 3221 (goto-char (point-min))
3009 (when (re-search-forward tdate-regexp nil t) 3222 (when (re-search-forward tdate-regexp nil t)
3010 (setq bface (get-text-property (gnus-point-at-bol) 'face) 3223 (setq bface (get-text-property (point-at-bol) 'face)
3011 eface (get-text-property (1- (gnus-point-at-eol)) 'face))) 3224 eface (get-text-property (1- (point-at-eol)) 'face)))
3012 (goto-char (point-min)) 3225 (goto-char (point-min))
3013 (setq pos nil) 3226 (setq pos nil)
3014 ;; Delete any old Date headers. 3227 ;; Delete any old Date headers.
3015 (while (re-search-forward date-regexp nil t) 3228 (while (re-search-forward date-regexp nil t)
3016 (if pos 3229 (if pos
3017 (delete-region (gnus-point-at-bol) 3230 (delete-region (point-at-bol) (progn
3018 (progn 3231 (gnus-article-forward-header)
3019 (gnus-article-forward-header) 3232 (point)))
3020 (point))) 3233 (delete-region (point-at-bol) (progn
3021 (delete-region (gnus-point-at-bol) 3234 (gnus-article-forward-header)
3022 (progn 3235 (forward-char -1)
3023 (gnus-article-forward-header) 3236 (point)))
3024 (forward-char -1)
3025 (point)))
3026 (setq pos (point)))) 3237 (setq pos (point))))
3027 (when (and (not pos) 3238 (when (and (not pos)
3028 (re-search-forward tdate-regexp nil t)) 3239 (re-search-forward tdate-regexp nil t))
@@ -3052,22 +3263,21 @@ should replace the \"Date:\" one, or should be added below it."
3052 (cond 3263 (cond
3053 ;; Convert to the local timezone. 3264 ;; Convert to the local timezone.
3054 ((eq type 'local) 3265 ((eq type 'local)
3055 (let ((tz (car (current-time-zone time)))) 3266 (concat "Date: " (message-make-date time)))
3056 (format "Date: %s %s%02d%02d" (current-time-string time)
3057 (if (> tz 0) "+" "-") (/ (abs tz) 3600)
3058 (/ (% (abs tz) 3600) 60))))
3059 ;; Convert to Universal Time. 3267 ;; Convert to Universal Time.
3060 ((eq type 'ut) 3268 ((eq type 'ut)
3061 (concat "Date: " 3269 (concat "Date: "
3062 (current-time-string 3270 (substring
3063 (let* ((e (parse-time-string date)) 3271 (message-make-date
3064 (tm (apply 'encode-time e)) 3272 (let* ((e (parse-time-string date))
3065 (ms (car tm)) 3273 (tm (apply 'encode-time e))
3066 (ls (- (cadr tm) (car (current-time-zone time))))) 3274 (ms (car tm))
3067 (cond ((< ls 0) (list (1- ms) (+ ls 65536))) 3275 (ls (- (cadr tm) (car (current-time-zone time)))))
3068 ((> ls 65535) (list (1+ ms) (- ls 65536))) 3276 (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
3069 (t (list ms ls))))) 3277 ((> ls 65535) (list (1+ ms) (- ls 65536)))
3070 " UT")) 3278 (t (list ms ls)))))
3279 0 -5)
3280 "UT"))
3071 ;; Get the original date from the article. 3281 ;; Get the original date from the article.
3072 ((eq type 'original) 3282 ((eq type 'original)
3073 (concat "Date: " (if (string-match "\n+$" date) 3283 (concat "Date: " (if (string-match "\n+$" date)
@@ -3208,7 +3418,7 @@ is to run."
3208 (setq n 1)) 3418 (setq n 1))
3209 (gnus-stop-date-timer) 3419 (gnus-stop-date-timer)
3210 (setq article-lapsed-timer 3420 (setq article-lapsed-timer
3211 (nnheader-run-at-time 1 n 'article-update-date-lapsed))) 3421 (run-at-time 1 n 'article-update-date-lapsed)))
3212 3422
3213(defun gnus-stop-date-timer () 3423(defun gnus-stop-date-timer ()
3214 "Stop the X-Sent timer." 3424 "Stop the X-Sent timer."
@@ -3237,7 +3447,7 @@ This format is defined by the `gnus-article-time-format' variable."
3237 (not (bolp))) 3447 (not (bolp)))
3238 (match-end 0)))) 3448 (match-end 0))))
3239 (date (when (and start 3449 (date (when (and start
3240 (re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)" 3450 (re-search-forward "[\t ]*\n\\(?:[^\t ]\\|\\'\\)"
3241 nil t)) 3451 nil t))
3242 (buffer-substring-no-properties start 3452 (buffer-substring-no-properties start
3243 (match-beginning 0))))) 3453 (match-beginning 0)))))
@@ -3588,17 +3798,9 @@ The directory to save in defaults to `gnus-article-save-directory'."
3588 (shell-command-on-region (point-min) (point-max) command nil))) 3798 (shell-command-on-region (point-min) (point-max) command nil)))
3589 (setq gnus-last-shell-command command)) 3799 (setq gnus-last-shell-command command))
3590 3800
3591(defmacro gnus-read-string (prompt &optional initial-contents history
3592 default-value)
3593 "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
3594 (if (and (featurep 'xemacs)
3595 (< emacs-minor-version 2))
3596 `(read-string ,prompt ,initial-contents ,history)
3597 `(read-string ,prompt ,initial-contents ,history ,default-value)))
3598
3599(defun gnus-summary-pipe-to-muttprint (&optional command) 3801(defun gnus-summary-pipe-to-muttprint (&optional command)
3600 "Pipe this article to muttprint." 3802 "Pipe this article to muttprint."
3601 (setq command (gnus-read-string 3803 (setq command (read-string
3602 "Print using command: " gnus-summary-muttprint-program 3804 "Print using command: " gnus-summary-muttprint-program
3603 nil gnus-summary-muttprint-program)) 3805 nil gnus-summary-muttprint-program))
3604 (gnus-summary-save-in-pipe command)) 3806 (gnus-summary-save-in-pipe command))
@@ -3721,8 +3923,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
3721 (message-narrow-to-head) 3923 (message-narrow-to-head)
3722 (goto-char (point-max)) 3924 (goto-char (point-max))
3723 (forward-line -1) 3925 (forward-line -1)
3724 (setq bface (get-text-property (gnus-point-at-bol) 'face) 3926 (setq bface (get-text-property (point-at-bol) 'face)
3725 eface (get-text-property (1- (gnus-point-at-eol)) 'face)) 3927 eface (get-text-property (1- (point-at-eol)) 'face))
3726 (message-remove-header "X-Gnus-PGP-Verify") 3928 (message-remove-header "X-Gnus-PGP-Verify")
3727 (if (re-search-forward "^X-PGP-Sig:" nil t) 3929 (if (re-search-forward "^X-PGP-Sig:" nil t)
3728 (forward-line) 3930 (forward-line)
@@ -3750,7 +3952,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
3750 (canlock-verify gnus-original-article-buffer))) 3952 (canlock-verify gnus-original-article-buffer)))
3751 3953
3752(eval-and-compile 3954(eval-and-compile
3753 (mapcar 3955 (mapc
3754 (lambda (func) 3956 (lambda (func)
3755 (let (afunc gfunc) 3957 (let (afunc gfunc)
3756 (if (consp func) 3958 (if (consp func)
@@ -3773,6 +3975,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
3773 article-verify-cancel-lock 3975 article-verify-cancel-lock
3774 article-hide-boring-headers 3976 article-hide-boring-headers
3775 article-treat-overstrike 3977 article-treat-overstrike
3978 article-treat-ansi-sequences
3776 article-fill-long-lines 3979 article-fill-long-lines
3777 article-capitalize-sentences 3980 article-capitalize-sentences
3778 article-remove-cr 3981 article-remove-cr
@@ -3810,7 +4013,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
3810 article-emphasize 4013 article-emphasize
3811 article-treat-dumbquotes 4014 article-treat-dumbquotes
3812 article-normalize-headers 4015 article-normalize-headers
3813;; (article-show-all . gnus-article-show-all-headers) 4016 ;;(article-show-all . gnus-article-show-all-headers)
3814 ))) 4017 )))
3815 4018
3816;;; 4019;;;
@@ -3873,6 +4076,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
3873 ["Hide signature" gnus-article-hide-signature t] 4076 ["Hide signature" gnus-article-hide-signature t]
3874 ["Hide citation" gnus-article-hide-citation t] 4077 ["Hide citation" gnus-article-hide-citation t]
3875 ["Treat overstrike" gnus-article-treat-overstrike t] 4078 ["Treat overstrike" gnus-article-treat-overstrike t]
4079 ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t]
3876 ["Remove carriage return" gnus-article-remove-cr t] 4080 ["Remove carriage return" gnus-article-remove-cr t]
3877 ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] 4081 ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
3878 ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] 4082 ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
@@ -3929,20 +4133,18 @@ commands:
3929 ;; face. 4133 ;; face.
3930 (set (make-local-variable 'nobreak-char-display) nil) 4134 (set (make-local-variable 'nobreak-char-display) nil)
3931 (setq cursor-in-non-selected-windows nil) 4135 (setq cursor-in-non-selected-windows nil)
4136 (setq truncate-lines gnus-article-truncate-lines)
3932 (gnus-set-default-directory) 4137 (gnus-set-default-directory)
3933 (buffer-disable-undo) 4138 (buffer-disable-undo)
3934 (setq buffer-read-only t) 4139 (setq buffer-read-only t
4140 show-trailing-whitespace nil)
3935 (set-syntax-table gnus-article-mode-syntax-table) 4141 (set-syntax-table gnus-article-mode-syntax-table)
3936 (mm-enable-multibyte) 4142 (mm-enable-multibyte)
3937 (gnus-run-mode-hooks 'gnus-article-mode-hook)) 4143 (gnus-run-mode-hooks 'gnus-article-mode-hook))
3938 4144
3939;; Internal variables. Are `gnus-button-regexp' and `gnus-button-last' used
3940;; at all?
3941(defvar gnus-button-regexp nil)
3942(defvar gnus-button-marker-list nil 4145(defvar gnus-button-marker-list nil
3943 "Regexp matching any of the regexps from `gnus-button-alist'.") 4146 "Regexp matching any of the regexps from `gnus-button-alist'.
3944(defvar gnus-button-last nil 4147Internal variable.")
3945 "The value of `gnus-button-alist' when `gnus-button-regexp' was build.")
3946 4148
3947(defun gnus-article-setup-buffer () 4149(defun gnus-article-setup-buffer ()
3948 "Initialize the article buffer." 4150 "Initialize the article buffer."
@@ -3955,10 +4157,9 @@ commands:
3955 (setq gnus-article-buffer name) 4157 (setq gnus-article-buffer name)
3956 (setq gnus-original-article-buffer original) 4158 (setq gnus-original-article-buffer original)
3957 (setq gnus-article-mime-handle-alist nil) 4159 (setq gnus-article-mime-handle-alist nil)
3958 ;; This might be a variable local to the summary buffer. 4160 (with-current-buffer gnus-summary-buffer
3959 (unless gnus-single-article-buffer 4161 ;; This might be a variable local to the summary buffer.
3960 (save-excursion 4162 (unless gnus-single-article-buffer
3961 (set-buffer gnus-summary-buffer)
3962 (setq gnus-article-buffer name) 4163 (setq gnus-article-buffer name)
3963 (setq gnus-original-article-buffer original) 4164 (setq gnus-original-article-buffer original)
3964 (gnus-set-global-variables))) 4165 (gnus-set-global-variables)))
@@ -3999,23 +4200,27 @@ commands:
3999 (set-buffer (gnus-get-buffer-create name)) 4200 (set-buffer (gnus-get-buffer-create name))
4000 (gnus-article-mode) 4201 (gnus-article-mode)
4001 (make-local-variable 'gnus-summary-buffer) 4202 (make-local-variable 'gnus-summary-buffer)
4203 (setq gnus-summary-buffer
4204 (gnus-summary-buffer-name gnus-newsgroup-name))
4002 (gnus-summary-set-local-parameters gnus-newsgroup-name) 4205 (gnus-summary-set-local-parameters gnus-newsgroup-name)
4003 (current-buffer))))) 4206 (current-buffer)))))
4004 4207
4005;; Set article window start at LINE, where LINE is the number of lines 4208;; Set article window start at LINE, where LINE is the number of lines
4006;; from the head of the article. 4209;; from the head of the article.
4007(defun gnus-article-set-window-start (&optional line) 4210(defun gnus-article-set-window-start (&optional line)
4008 (set-window-start 4211 (let ((article-window (gnus-get-buffer-window gnus-article-buffer t)))
4009 (gnus-get-buffer-window gnus-article-buffer t) 4212 (when article-window
4010 (save-excursion 4213 (set-window-start
4011 (set-buffer gnus-article-buffer) 4214 article-window
4012 (goto-char (point-min)) 4215 (save-excursion
4013 (if (not line) 4216 (set-buffer gnus-article-buffer)
4014 (point-min) 4217 (goto-char (point-min))
4015 (gnus-message 6 "Moved to bookmark") 4218 (if (not line)
4016 (search-forward "\n\n" nil t) 4219 (point-min)
4017 (forward-line line) 4220 (gnus-message 6 "Moved to bookmark")
4018 (point))))) 4221 (search-forward "\n\n" nil t)
4222 (forward-line line)
4223 (point)))))))
4019 4224
4020(defun gnus-article-prepare (article &optional all-headers header) 4225(defun gnus-article-prepare (article &optional all-headers header)
4021 "Prepare ARTICLE in article mode buffer. 4226 "Prepare ARTICLE in article mode buffer.
@@ -4147,6 +4352,90 @@ If ALL-HEADERS is non-nil, no headers are hidden."
4147 (gnus-run-hooks 'gnus-article-prepare-hook))) 4352 (gnus-run-hooks 'gnus-article-prepare-hook)))
4148 4353
4149;;; 4354;;;
4355;;; Gnus Sticky Article Mode
4356;;;
4357
4358(define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle"
4359 "Mode for sticky articles."
4360 ;; Release bindings that won't work.
4361 (substitute-key-definition 'gnus-article-read-summary-keys 'undefined
4362 gnus-sticky-article-mode-map)
4363 (substitute-key-definition 'gnus-article-refer-article 'undefined
4364 gnus-sticky-article-mode-map)
4365 (dolist (k '("e" "h" "s" "F" "R"))
4366 (define-key gnus-sticky-article-mode-map k nil))
4367 (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer)
4368 (define-key gnus-sticky-article-mode-map "q" 'bury-buffer)
4369 (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly)
4370 (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key))
4371
4372(defun gnus-sticky-article (arg)
4373 "Make the current article sticky.
4374If a prefix ARG is given, ask for a name for this sticky article buffer."
4375 (interactive "P")
4376 (gnus-summary-show-thread)
4377 (gnus-summary-select-article nil nil 'pseudo)
4378 (let (new-art-buf-name)
4379 (gnus-eval-in-buffer-window gnus-article-buffer
4380 (setq new-art-buf-name
4381 (concat
4382 "*Sticky Article: "
4383 (if arg
4384 (read-from-minibuffer "Sticky article buffer name: ")
4385 (gnus-with-article-headers
4386 (gnus-article-goto-header "subject")
4387 (setq new-art-buf-name
4388 (buffer-substring-no-properties
4389 (line-beginning-position) (line-end-position)))
4390 (goto-char (point-min))
4391 (gnus-article-goto-header "from")
4392 (setq new-art-buf-name
4393 (concat
4394 new-art-buf-name ", "
4395 (buffer-substring-no-properties
4396 (line-beginning-position) (line-end-position))))
4397 (goto-char (point-min))
4398 (gnus-article-goto-header "date")
4399 (setq new-art-buf-name
4400 (concat
4401 new-art-buf-name ", "
4402 (buffer-substring-no-properties
4403 (line-beginning-position) (line-end-position))))))
4404 "*"))
4405 (if (and (gnus-buffer-live-p new-art-buf-name)
4406 (with-current-buffer new-art-buf-name
4407 (eq major-mode 'gnus-sticky-article-mode)))
4408 (switch-to-buffer new-art-buf-name)
4409 (setq new-art-buf-name (rename-buffer new-art-buf-name t)))
4410 (gnus-sticky-article-mode))
4411 (setq gnus-article-buffer new-art-buf-name))
4412 (gnus-summary-recenter)
4413 (gnus-summary-position-point))
4414
4415(defun gnus-kill-sticky-article-buffer (&optional buffer)
4416 "Kill the given sticky article BUFFER.
4417If none is given, assume the current buffer and kill it if it has
4418`gnus-sticky-article-mode'."
4419 (interactive)
4420 (unless buffer
4421 (setq buffer (current-buffer)))
4422 (with-current-buffer buffer
4423 (when (eq major-mode 'gnus-sticky-article-mode)
4424 (gnus-kill-buffer buffer))))
4425
4426(defun gnus-kill-sticky-article-buffers (arg)
4427 "Kill all sticky article buffers.
4428If a prefix ARG is given, ask for confirmation."
4429 (interactive "P")
4430 (dolist (buf (gnus-buffers))
4431 (with-current-buffer buf
4432 (when (eq major-mode 'gnus-sticky-article-mode)
4433 (if (not arg)
4434 (gnus-kill-buffer buf)
4435 (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
4436 (gnus-kill-buffer buf)))))))
4437
4438;;;
4150;;; Gnus MIME viewing functions 4439;;; Gnus MIME viewing functions
4151;;; 4440;;;
4152 4441
@@ -4181,10 +4470,11 @@ General format specifiers can also be used. See Info node
4181 (gnus-mime-view-part-as-charset "C" "View As charset...") 4470 (gnus-mime-view-part-as-charset "C" "View As charset...")
4182 (gnus-mime-save-part "o" "Save...") 4471 (gnus-mime-save-part "o" "Save...")
4183 (gnus-mime-save-part-and-strip "\C-o" "Save and Strip") 4472 (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
4473 (gnus-mime-replace-part "r" "Replace part")
4184 (gnus-mime-delete-part "d" "Delete part") 4474 (gnus-mime-delete-part "d" "Delete part")
4185 (gnus-mime-copy-part "c" "View As Text, In Other Buffer") 4475 (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
4186 (gnus-mime-inline-part "i" "View As Text, In This Buffer") 4476 (gnus-mime-inline-part "i" "View As Text, In This Buffer")
4187 (gnus-mime-view-part-internally "E" "View Internally") 4477 (gnus-mime-view-part-internally "E" "View Internally") ;; Why `E'?
4188 (gnus-mime-view-part-externally "e" "View Externally") 4478 (gnus-mime-view-part-externally "e" "View Externally")
4189 (gnus-mime-print-part "p" "Print") 4479 (gnus-mime-print-part "p" "Print")
4190 (gnus-mime-pipe-part "|" "Pipe To Command...") 4480 (gnus-mime-pipe-part "|" "Pipe To Command...")
@@ -4199,9 +4489,6 @@ General format specifiers can also be used. See Info node
4199 4489
4200(defvar gnus-mime-button-map 4490(defvar gnus-mime-button-map
4201 (let ((map (make-sparse-keymap))) 4491 (let ((map (make-sparse-keymap)))
4202 (unless (>= (string-to-number emacs-version) 21)
4203 ;; XEmacs doesn't care.
4204 (set-keymap-parent map gnus-article-mode-map))
4205 (define-key map gnus-mouse-2 'gnus-article-push-button) 4492 (define-key map gnus-mouse-2 'gnus-article-push-button)
4206 (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) 4493 (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
4207 (dolist (c gnus-mime-button-commands) 4494 (dolist (c gnus-mime-button-commands)
@@ -4212,25 +4499,9 @@ General format specifiers can also be used. See Info node
4212 gnus-mime-button-menu gnus-mime-button-map "MIME button menu." 4499 gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
4213 `("MIME Part" 4500 `("MIME Part"
4214 ,@(mapcar (lambda (c) 4501 ,@(mapcar (lambda (c)
4215 (vector (caddr c) (car c) :enable t)) 4502 (vector (caddr c) (car c) :active t))
4216 gnus-mime-button-commands))) 4503 gnus-mime-button-commands)))
4217 4504
4218(eval-when-compile
4219 (define-compiler-macro popup-menu (&whole form
4220 menu &optional position prefix)
4221 (if (and (fboundp 'popup-menu)
4222 (not (memq 'popup-menu (assoc "lmenu" load-history))))
4223 form
4224 ;; Gnus is probably running under Emacs 20.
4225 `(let* ((menu (cdr ,menu))
4226 (response (x-popup-menu
4227 t (list (car menu)
4228 (cons "" (mapcar (lambda (c)
4229 (cons (caddr c) (car c)))
4230 (cdr menu)))))))
4231 (if response
4232 (call-interactively (nth 3 (assq response menu))))))))
4233
4234(defun gnus-mime-button-menu (event prefix) 4505(defun gnus-mime-button-menu (event prefix)
4235 "Construct a context-sensitive menu of MIME commands." 4506 "Construct a context-sensitive menu of MIME commands."
4236 (interactive "e\nP") 4507 (interactive "e\nP")
@@ -4244,8 +4515,7 @@ General format specifiers can also be used. See Info node
4244(defun gnus-mime-view-all-parts (&optional handles) 4515(defun gnus-mime-view-all-parts (&optional handles)
4245 "View all the MIME parts." 4516 "View all the MIME parts."
4246 (interactive) 4517 (interactive)
4247 (save-current-buffer 4518 (with-current-buffer gnus-article-buffer
4248 (set-buffer gnus-article-buffer)
4249 (let ((handles (or handles gnus-article-mime-handles)) 4519 (let ((handles (or handles gnus-article-mime-handles))
4250 (mail-parse-charset gnus-newsgroup-charset) 4520 (mail-parse-charset gnus-newsgroup-charset)
4251 (mail-parse-ignored-charsets 4521 (mail-parse-ignored-charsets
@@ -4259,8 +4529,102 @@ General format specifiers can also be used. See Info node
4259 (delete-region (point) (point-max)) 4529 (delete-region (point) (point-max))
4260 (mm-display-parts handles)))))) 4530 (mm-display-parts handles))))))
4261 4531
4262(defun gnus-mime-save-part-and-strip () 4532(defun gnus-article-jump-to-part (n)
4263 "Save the MIME part under point then replace it with an external body." 4533 "Jump to MIME part N."
4534 (interactive "P")
4535 (pop-to-buffer gnus-article-buffer)
4536 ;; FIXME: why is it necessary?
4537 (sit-for 0)
4538 (let ((parts (length gnus-article-mime-handle-alist)))
4539 (or n (setq n
4540 (string-to-number
4541 (read-string ;; Emacs 21 doesn't have `read-number'.
4542 (format "Jump to part (2..%s): " parts)))))
4543 (unless (and (integerp n) (<= n parts) (>= n 1))
4544 (setq n
4545 (progn
4546 (gnus-message 7 "Invalid part `%s', using %s instead."
4547 n parts)
4548 parts)))
4549 (gnus-message 9 "Jumping to part %s." n)
4550 (cond ((>= gnus-auto-select-part 1)
4551 (while (and (<= n parts)
4552 (not (gnus-article-goto-part n)))
4553 (setq n (1+ n))))
4554 ((< gnus-auto-select-part 0)
4555 (while (and (>= n 1)
4556 (not (gnus-article-goto-part n)))
4557 (setq n (1- n))))
4558 (t
4559 (gnus-article-goto-part n)))))
4560
4561(eval-when-compile
4562 (defsubst gnus-article-edit-part (handles &optional current-id)
4563 "Edit an article in order to delete a mime part.
4564This function is exclusively used by `gnus-mime-save-part-and-strip'
4565and `gnus-mime-delete-part', and not provided at run-time normally."
4566 (gnus-article-edit-article
4567 `(lambda ()
4568 (buffer-disable-undo)
4569 (erase-buffer)
4570 (let ((mail-parse-charset (or gnus-article-charset
4571 ',gnus-newsgroup-charset))
4572 (mail-parse-ignored-charsets
4573 (or gnus-article-ignored-charsets
4574 ',gnus-newsgroup-ignored-charsets))
4575 (mbl mml-buffer-list))
4576 (setq mml-buffer-list nil)
4577 (insert-buffer-substring gnus-original-article-buffer)
4578 (mime-to-mml ',handles)
4579 (setq gnus-article-mime-handles nil)
4580 (let ((mbl1 mml-buffer-list))
4581 (setq mml-buffer-list mbl)
4582 (set (make-local-variable 'mml-buffer-list) mbl1))
4583 (gnus-make-local-hook 'kill-buffer-hook)
4584 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
4585 `(lambda (no-highlight)
4586 (let ((mail-parse-charset (or gnus-article-charset
4587 ',gnus-newsgroup-charset))
4588 (message-options message-options)
4589 (message-options-set-recipient)
4590 (mail-parse-ignored-charsets
4591 (or gnus-article-ignored-charsets
4592 ',gnus-newsgroup-ignored-charsets)))
4593 (mml-to-mime)
4594 (mml-destroy-buffers)
4595 (remove-hook 'kill-buffer-hook
4596 'mml-destroy-buffers t)
4597 (kill-local-variable 'mml-buffer-list))
4598 (gnus-summary-edit-article-done
4599 ,(or (mail-header-references gnus-current-headers) "")
4600 ,(gnus-group-read-only-p)
4601 ,gnus-summary-buffer no-highlight))
4602 t)
4603 (gnus-article-edit-done)
4604 (gnus-summary-expand-window)
4605 (gnus-summary-show-article)
4606 (when (and current-id (integerp gnus-auto-select-part))
4607 (gnus-article-jump-to-part
4608 (if (text-property-any (point-min) (point-max)
4609 'gnus-part (+ current-id gnus-auto-select-part))
4610 (+ current-id gnus-auto-select-part)
4611 (with-current-buffer gnus-article-buffer
4612 (length gnus-article-mime-handle-alist)))))))
4613
4614(defun gnus-mime-replace-part (file)
4615 "Replace MIME part under point with an external body."
4616 ;; Useful if file has already been saved to disk
4617 (interactive
4618 (list
4619 (mm-with-multibyte
4620 (read-file-name "Replace MIME part with file: "
4621 (or mm-default-directory default-directory)
4622 nil nil))))
4623 (gnus-mime-save-part-and-strip file))
4624
4625(defun gnus-mime-save-part-and-strip (&optional file)
4626 "Save the MIME part under point then replace it with an external body.
4627If FILE is given, use it for the external part."
4264 (interactive) 4628 (interactive)
4265 (gnus-article-check-buffer) 4629 (gnus-article-check-buffer)
4266 (when (gnus-group-read-only-p) 4630 (when (gnus-group-read-only-p)
@@ -4268,66 +4632,36 @@ General format specifiers can also be used. See Info node
4268 (when (mm-complicated-handles gnus-article-mime-handles) 4632 (when (mm-complicated-handles gnus-article-mime-handles)
4269 (error "\ 4633 (error "\
4270The current article has a complicated MIME structure, giving up...")) 4634The current article has a complicated MIME structure, giving up..."))
4271 (when (gnus-yes-or-no-p "\ 4635 (let* ((data (get-text-property (point) 'gnus-data))
4272Deleting parts may malfunction or destroy the article; continue? ") 4636 (id (get-text-property (point) 'gnus-part))
4273 (let* ((data (get-text-property (point) 'gnus-data)) 4637 param
4274 file param 4638 (handles gnus-article-mime-handles))
4275 (handles gnus-article-mime-handles)) 4639 (unless file
4276 (setq file (and data (mm-save-part data))) 4640 (setq file
4277 (when file 4641 (and data (mm-save-part data "Delete MIME part and save to: "))))
4278 (with-current-buffer (mm-handle-buffer data) 4642 (when file
4279 (erase-buffer) 4643 (with-current-buffer (mm-handle-buffer data)
4280 (insert "Content-Type: " (mm-handle-media-type data)) 4644 (erase-buffer)
4281 (mml-insert-parameter-string (cdr (mm-handle-type data)) 4645 (insert "Content-Type: " (mm-handle-media-type data))
4282 '(charset)) 4646 (mml-insert-parameter-string (cdr (mm-handle-type data))
4283 ;; Add a filename for the sake of saving the part again. 4647 '(charset))
4284 (mml-insert-parameter 4648 ;; Add a filename for the sake of saving the part again.
4285 (mail-header-encode-parameter "name" (file-name-nondirectory file))) 4649 (mml-insert-parameter
4286 (insert "\n") 4650 (mail-header-encode-parameter "name" (file-name-nondirectory file)))
4287 (insert "Content-ID: " (message-make-message-id) "\n") 4651 (insert "\n")
4288 (insert "Content-Transfer-Encoding: binary\n") 4652 (insert "Content-ID: " (message-make-message-id) "\n")
4289 (insert "\n")) 4653 (insert "Content-Transfer-Encoding: binary\n")
4290 (setcdr data 4654 (insert "\n"))
4291 (cdr (mm-make-handle nil 4655 (setcdr data
4292 `("message/external-body" 4656 (cdr (mm-make-handle nil
4293 (access-type . "LOCAL-FILE") 4657 `("message/external-body"
4294 (name . ,file))))) 4658 (access-type . "LOCAL-FILE")
4295 (set-buffer gnus-summary-buffer) 4659 (name . ,file)))))
4296 (gnus-article-edit-article 4660 ;; (set-buffer gnus-summary-buffer)
4297 `(lambda () 4661 (gnus-article-edit-part handles id))))
4298 (erase-buffer) 4662
4299 (let ((mail-parse-charset (or gnus-article-charset 4663;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
4300 ',gnus-newsgroup-charset)) 4664;; parts...>') but with stripping would be nice.
4301 (mail-parse-ignored-charsets
4302 (or gnus-article-ignored-charsets
4303 ',gnus-newsgroup-ignored-charsets))
4304 (mbl mml-buffer-list))
4305 (setq mml-buffer-list nil)
4306 (insert-buffer-substring gnus-original-article-buffer)
4307 (mime-to-mml ',handles)
4308 (setq gnus-article-mime-handles nil)
4309 (let ((mbl1 mml-buffer-list))
4310 (setq mml-buffer-list mbl)
4311 (set (make-local-variable 'mml-buffer-list) mbl1))
4312 (gnus-make-local-hook 'kill-buffer-hook)
4313 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
4314 `(lambda (no-highlight)
4315 (let ((mail-parse-charset (or gnus-article-charset
4316 ',gnus-newsgroup-charset))
4317 (message-options message-options)
4318 (message-options-set-recipient)
4319 (mail-parse-ignored-charsets
4320 (or gnus-article-ignored-charsets
4321 ',gnus-newsgroup-ignored-charsets)))
4322 (mml-to-mime)
4323 (mml-destroy-buffers)
4324 (remove-hook 'kill-buffer-hook
4325 'mml-destroy-buffers t)
4326 (kill-local-variable 'mml-buffer-list))
4327 (gnus-summary-edit-article-done
4328 ,(or (mail-header-references gnus-current-headers) "")
4329 ,(gnus-group-read-only-p)
4330 ,gnus-summary-buffer no-highlight)))))))
4331 4665
4332(defun gnus-mime-delete-part () 4666(defun gnus-mime-delete-part ()
4333 "Delete the MIME part under point. 4667 "Delete the MIME part under point.
@@ -4339,9 +4673,11 @@ Replace it with some information about the removed part."
4339 (when (mm-complicated-handles gnus-article-mime-handles) 4673 (when (mm-complicated-handles gnus-article-mime-handles)
4340 (error "\ 4674 (error "\
4341The current article has a complicated MIME structure, giving up...")) 4675The current article has a complicated MIME structure, giving up..."))
4342 (when (gnus-yes-or-no-p "\ 4676 (when (or gnus-expert-user
4343Deleting parts may malfunction or destroy the article; continue? ") 4677 (gnus-yes-or-no-p "\
4678Deleting parts may malfunction or destroy the article; continue? "))
4344 (let* ((data (get-text-property (point) 'gnus-data)) 4679 (let* ((data (get-text-property (point) 'gnus-data))
4680 (id (get-text-property (point) 'gnus-part))
4345 (handles gnus-article-mime-handles) 4681 (handles gnus-article-mime-handles)
4346 (none "(none)") 4682 (none "(none)")
4347 (description 4683 (description
@@ -4371,48 +4707,8 @@ Deleting parts may malfunction or destroy the article; continue? ")
4371 nil `("text/plain") nil nil 4707 nil `("text/plain") nil nil
4372 (list "attachment") 4708 (list "attachment")
4373 (format "Deleted attachment (%s bytes)" bsize)))))) 4709 (format "Deleted attachment (%s bytes)" bsize))))))
4374 (set-buffer gnus-summary-buffer) 4710 ;; (set-buffer gnus-summary-buffer)
4375 ;; FIXME: maybe some of the following code (borrowed from 4711 (gnus-article-edit-part handles id))))
4376 ;; `gnus-mime-save-part-and-strip') isn't necessary?
4377 (gnus-article-edit-article
4378 `(lambda ()
4379 (erase-buffer)
4380 (let ((mail-parse-charset (or gnus-article-charset
4381 ',gnus-newsgroup-charset))
4382 (mail-parse-ignored-charsets
4383 (or gnus-article-ignored-charsets
4384 ',gnus-newsgroup-ignored-charsets))
4385 (mbl mml-buffer-list))
4386 (setq mml-buffer-list nil)
4387 (insert-buffer-substring gnus-original-article-buffer)
4388 (mime-to-mml ',handles)
4389 (setq gnus-article-mime-handles nil)
4390 (let ((mbl1 mml-buffer-list))
4391 (setq mml-buffer-list mbl)
4392 (set (make-local-variable 'mml-buffer-list) mbl1))
4393 (gnus-make-local-hook 'kill-buffer-hook)
4394 (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
4395 `(lambda (no-highlight)
4396 (let ((mail-parse-charset (or gnus-article-charset
4397 ',gnus-newsgroup-charset))
4398 (message-options message-options)
4399 (message-options-set-recipient)
4400 (mail-parse-ignored-charsets
4401 (or gnus-article-ignored-charsets
4402 ',gnus-newsgroup-ignored-charsets)))
4403 (mml-to-mime)
4404 (mml-destroy-buffers)
4405 (remove-hook 'kill-buffer-hook
4406 'mml-destroy-buffers t)
4407 (kill-local-variable 'mml-buffer-list))
4408 (gnus-summary-edit-article-done
4409 ,(or (mail-header-references gnus-current-headers) "")
4410 ,(gnus-group-read-only-p)
4411 ,gnus-summary-buffer no-highlight))))
4412 ;; Not in `gnus-mime-save-part-and-strip':
4413 (gnus-article-edit-done)
4414 (gnus-summary-expand-window)
4415 (gnus-summary-show-article)))
4416 4712
4417(defun gnus-mime-save-part () 4713(defun gnus-mime-save-part ()
4418 "Save the MIME part under point." 4714 "Save the MIME part under point."
@@ -4450,7 +4746,11 @@ Deleting parts may malfunction or destroy the article; continue? ")
4450 ;; Content-Disposition: attachment; filename=... 4746 ;; Content-Disposition: attachment; filename=...
4451 (cdr (assq 'filename (cdr (mm-handle-disposition handle)))))) 4747 (cdr (assq 'filename (cdr (mm-handle-disposition handle))))))
4452 (def-type (and name (mm-default-file-encoding name)))) 4748 (def-type (and name (mm-default-file-encoding name))))
4453 (and def-type (cons def-type 0)))) 4749 (or (and def-type (cons def-type 0))
4750 (and handle
4751 (equal (mm-handle-media-supertype handle) "text")
4752 '("text/plain" . 0))
4753 '("application/octet-stream" . 0))))
4454 4754
4455(defun gnus-mime-view-part-as-type (&optional mime-type pred) 4755(defun gnus-mime-view-part-as-type (&optional mime-type pred)
4456 "Choose a MIME media type, and view the part as such. 4756 "Choose a MIME media type, and view the part as such.
@@ -4484,62 +4784,67 @@ available media-types."
4484 (mm-handle-id handle))) 4784 (mm-handle-id handle)))
4485 (setq gnus-article-mime-handles 4785 (setq gnus-article-mime-handles
4486 (mm-merge-handles gnus-article-mime-handles handle)) 4786 (mm-merge-handles gnus-article-mime-handles handle))
4787 (when (mm-handle-displayed-p handle)
4788 (mm-remove-part handle))
4487 (gnus-mm-display-part handle)))) 4789 (gnus-mm-display-part handle))))
4488 4790
4489(eval-when-compile 4791(defun gnus-mime-copy-part (&optional handle arg)
4490 (require 'jka-compr))
4491
4492;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
4493;; emacs can do that itself.
4494;;
4495(defun gnus-mime-jka-compr-maybe-uncompress ()
4496 "Uncompress the current buffer if `auto-compression-mode' is enabled.
4497The uncompress method used is derived from `buffer-file-name'."
4498 (when (and (fboundp 'jka-compr-installed-p)
4499 (jka-compr-installed-p))
4500 (let ((info (jka-compr-get-compression-info buffer-file-name)))
4501 (when info
4502 (let ((basename (file-name-nondirectory buffer-file-name))
4503 (args (jka-compr-info-uncompress-args info))
4504 (prog (jka-compr-info-uncompress-program info))
4505 (message (jka-compr-info-uncompress-message info))
4506 (err-file (jka-compr-make-temp-name)))
4507 (if message
4508 (message "%s %s..." message basename))
4509 (unwind-protect
4510 (unless (memq (apply 'call-process-region
4511 (point-min) (point-max)
4512 prog
4513 t (list t err-file) nil
4514 args)
4515 jka-compr-acceptable-retval-list)
4516 (jka-compr-error prog args basename message err-file))
4517 (jka-compr-delete-temp-file err-file)))))))
4518
4519(defun gnus-mime-copy-part (&optional handle)
4520 "Put the MIME part under point into a new buffer. 4792 "Put the MIME part under point into a new buffer.
4521If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 4793If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
4522are decompressed." 4794are decompressed."
4523 (interactive) 4795 (interactive (list nil current-prefix-arg))
4524 (gnus-article-check-buffer) 4796 (gnus-article-check-buffer)
4525 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 4797 (unless handle
4526 (contents (and handle (mm-get-part handle))) 4798 (setq handle (get-text-property (point) 'gnus-data)))
4527 (base (and handle 4799 (when handle
4528 (file-name-nondirectory 4800 (let ((filename (or (mail-content-type-get (mm-handle-type handle)
4529 (or 4801 'name)
4530 (mail-content-type-get (mm-handle-type handle) 'name) 4802 (mail-content-type-get (mm-handle-disposition handle)
4531 (mail-content-type-get (mm-handle-disposition handle) 4803 'filename)))
4532 'filename) 4804 contents dont-decode charset coding-system)
4533 "*decoded*")))) 4805 (mm-with-unibyte-buffer
4534 (buffer (and base (generate-new-buffer base)))) 4806 (mm-insert-part handle)
4535 (when contents 4807 (setq contents (or (condition-case nil
4536 (switch-to-buffer buffer) 4808 (mm-decompress-buffer filename nil 'sig)
4537 (insert contents) 4809 (error
4810 (setq dont-decode t)
4811 nil))
4812 (buffer-string))))
4813 (setq filename (cond (filename (file-name-nondirectory filename))
4814 (dont-decode "*raw data*")
4815 (t "*decoded*")))
4816 (cond
4817 (dont-decode)
4818 ((not arg)
4819 (unless (setq charset (mail-content-type-get
4820 (mm-handle-type handle) 'charset))
4821 (unless (setq coding-system (mm-with-unibyte-buffer
4822 (insert contents)
4823 (mm-find-buffer-file-coding-system)))
4824 (setq charset gnus-newsgroup-charset))))
4825 ((numberp arg)
4826 (setq charset (or (cdr (assq arg
4827 gnus-summary-show-article-charset-alist))
4828 (mm-read-coding-system "Charset: ")))))
4829 (switch-to-buffer (generate-new-buffer filename))
4830 (if (or coding-system
4831 (and charset
4832 (setq coding-system (mm-charset-to-coding-system charset))
4833 (not (eq charset 'ascii))))
4834 (progn
4835 (mm-enable-multibyte)
4836 (insert (mm-decode-coding-string contents coding-system))
4837 (setq buffer-file-coding-system
4838 (if (boundp 'last-coding-system-used)
4839 (symbol-value 'last-coding-system-used)
4840 coding-system)))
4841 (mm-disable-multibyte)
4842 (insert contents)
4843 (setq buffer-file-coding-system mm-binary-coding-system))
4538 ;; We do it this way to make `normal-mode' set the appropriate mode. 4844 ;; We do it this way to make `normal-mode' set the appropriate mode.
4539 (unwind-protect 4845 (unwind-protect
4540 (progn 4846 (progn
4541 (setq buffer-file-name (expand-file-name base)) 4847 (setq buffer-file-name (expand-file-name filename))
4542 (gnus-mime-jka-compr-maybe-uncompress)
4543 (normal-mode)) 4848 (normal-mode))
4544 (setq buffer-file-name nil)) 4849 (setq buffer-file-name nil))
4545 (goto-char (point-min))))) 4850 (goto-char (point-min)))))
@@ -4570,22 +4875,37 @@ are decompressed."
4570 (ps-despool filename))))) 4875 (ps-despool filename)))))
4571 4876
4572(defun gnus-mime-inline-part (&optional handle arg) 4877(defun gnus-mime-inline-part (&optional handle arg)
4573 "Insert the MIME part under point into the current buffer." 4878 "Insert the MIME part under point into the current buffer.
4879Compressed files like .gz and .bz2 are decompressed."
4574 (interactive (list nil current-prefix-arg)) 4880 (interactive (list nil current-prefix-arg))
4575 (gnus-article-check-buffer) 4881 (gnus-article-check-buffer)
4576 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 4882 (unless handle
4577 contents charset 4883 (setq handle (get-text-property (point) 'gnus-data)))
4578 (b (point)) 4884 (when handle
4579 (inhibit-read-only t)) 4885 (let ((b (point))
4580 (when handle 4886 (inhibit-read-only t)
4887 contents charset coding-system)
4581 (if (and (not arg) (mm-handle-undisplayer handle)) 4888 (if (and (not arg) (mm-handle-undisplayer handle))
4582 (mm-remove-part handle) 4889 (mm-remove-part handle)
4583 (setq contents (mm-get-part handle)) 4890 (mm-with-unibyte-buffer
4891 (mm-insert-part handle)
4892 (setq contents
4893 (or (mm-decompress-buffer
4894 (or (mail-content-type-get (mm-handle-type handle)
4895 'name)
4896 (mail-content-type-get (mm-handle-disposition handle)
4897 'filename))
4898 nil t)
4899 (buffer-string))))
4584 (cond 4900 (cond
4585 ((not arg) 4901 ((not arg)
4586 (setq charset (or (mail-content-type-get 4902 (unless (setq charset (mail-content-type-get
4587 (mm-handle-type handle) 'charset) 4903 (mm-handle-type handle) 'charset))
4588 gnus-newsgroup-charset))) 4904 (unless (setq coding-system
4905 (mm-with-unibyte-buffer
4906 (insert contents)
4907 (mm-find-buffer-file-coding-system)))
4908 (setq charset gnus-newsgroup-charset))))
4589 ((numberp arg) 4909 ((numberp arg)
4590 (if (mm-handle-undisplayer handle) 4910 (if (mm-handle-undisplayer handle)
4591 (mm-remove-part handle)) 4911 (mm-remove-part handle))
@@ -4599,11 +4919,12 @@ are decompressed."
4599 (forward-line 2) 4919 (forward-line 2)
4600 (mm-insert-inline 4920 (mm-insert-inline
4601 handle 4921 handle
4602 (if (and charset 4922 (if (or coding-system
4603 (setq charset (mm-charset-to-coding-system 4923 (and charset
4604 charset)) 4924 (setq coding-system
4605 (not (eq charset 'ascii))) 4925 (mm-charset-to-coding-system charset))
4606 (mm-decode-coding-string contents charset) 4926 (not (eq coding-system 'ascii))))
4927 (mm-decode-coding-string contents coding-system)
4607 (mm-string-to-multibyte contents))) 4928 (mm-string-to-multibyte contents)))
4608 (goto-char b))))) 4929 (goto-char b)))))
4609 4930
@@ -4632,12 +4953,15 @@ specified charset."
4632 (gnus-newsgroup-ignored-charsets 'gnus-all) 4953 (gnus-newsgroup-ignored-charsets 'gnus-all)
4633 gnus-newsgroup-charset form preferred parts) 4954 gnus-newsgroup-charset form preferred parts)
4634 (when handle 4955 (when handle
4635 (if (mm-handle-undisplayer handle) 4956 (when (prog1
4636 (mm-remove-part handle)) 4957 (and fun
4637 (when fun 4958 (setq gnus-newsgroup-charset
4638 (setq gnus-newsgroup-charset 4959 (or (cdr (assq
4639 (or (cdr (assq arg gnus-summary-show-article-charset-alist)) 4960 arg
4640 (mm-read-coding-system "Charset: "))) 4961 gnus-summary-show-article-charset-alist))
4962 (mm-read-coding-system "Charset: "))))
4963 (if (mm-handle-undisplayer handle)
4964 (mm-remove-part handle)))
4641 (gnus-mime-strip-charset-parameters handle) 4965 (gnus-mime-strip-charset-parameters handle)
4642 (when (and (consp (setq form (cdr-safe fun))) 4966 (when (and (consp (setq form (cdr-safe fun)))
4643 (setq form (ignore-errors 4967 (setq form (ignore-errors
@@ -4710,64 +5034,152 @@ If no internal viewer is available, use an external viewer."
4710 (if action-pair 5034 (if action-pair
4711 (funcall (cdr action-pair))))) 5035 (funcall (cdr action-pair)))))
4712 5036
4713(defun gnus-article-part-wrapper (n function) 5037(defun gnus-article-part-wrapper (n function &optional no-handle interactive)
4714 (let ((window (get-buffer-window gnus-article-buffer 'visible)) 5038 "Call FUNCTION on MIME part N.
4715 frame) 5039Unless NO-HANDLE, call FUNCTION with N-th MIME handle as it's only argument.
4716 (when window 5040If INTERACTIVE, call FUNCTION interactivly."
4717 ;; It is necessary to select the article window so that 5041 (let (window frame)
4718 ;; `gnus-article-goto-part' may really move the point. 5042 ;; Check whether the article is displayed.
4719 (setq frame (selected-frame)) 5043 (unless (and (gnus-buffer-live-p gnus-article-buffer)
4720 (gnus-select-frame-set-input-focus (window-frame window)) 5044 (setq window (get-buffer-window gnus-article-buffer t))
4721 (unwind-protect 5045 (frame-visible-p (setq frame (window-frame window))))
4722 (save-window-excursion 5046 (error "No article is displayed"))
4723 (select-window window) 5047 (with-current-buffer gnus-article-buffer
4724 (when (> n (length gnus-article-mime-handle-alist)) 5048 ;; Check whether the article displays the right contents.
4725 (error "No such part")) 5049 (unless (with-current-buffer gnus-summary-buffer
4726 (gnus-article-goto-part n) 5050 (eq gnus-current-article (gnus-summary-article-number)))
4727 (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) 5051 (error "You should select the right article first"))
4728 (funcall function handle))) 5052 (if n
4729 (gnus-select-frame-set-input-focus frame))))) 5053 (setq n (prefix-numeric-value n))
5054 (let ((pt (point)))
5055 (setq n (or (get-text-property pt 'gnus-part)
5056 (and (not (bobp))
5057 (get-text-property (1- pt) 'gnus-part))
5058 (get-text-property (prog2
5059 (forward-line 1)
5060 (point)
5061 (goto-char pt))
5062 'gnus-part)
5063 (get-text-property
5064 (or (and (setq pt (previous-single-property-change
5065 pt 'gnus-part))
5066 (1- pt))
5067 (next-single-property-change (point) 'gnus-part)
5068 (point))
5069 'gnus-part)
5070 1))))
5071 ;; Check whether the specified part exists.
5072 (when (> n (length gnus-article-mime-handle-alist))
5073 (error "No such part")))
5074 (unless
5075 (progn
5076 ;; To select the window is needed so that the cursor
5077 ;; might be visible on the MIME button.
5078 (select-window (prog1
5079 window
5080 (setq window (selected-window))
5081 ;; Article may be displayed in the other frame.
5082 (gnus-select-frame-set-input-focus
5083 (prog1
5084 frame
5085 (setq frame (selected-frame))))))
5086 (when (gnus-article-goto-part n)
5087 ;; We point the cursor and the arrow at the MIME button
5088 ;; when the `function' prompt the user for something.
5089 (let ((cursor-in-non-selected-windows t)
5090 (overlay-arrow-string "=>")
5091 (overlay-arrow-position (point-marker)))
5092 (unwind-protect
5093 (cond
5094 ((and no-handle interactive)
5095 (call-interactively function))
5096 (no-handle
5097 (funcall function))
5098 (interactive
5099 (call-interactively
5100 function
5101 (cdr (assq n gnus-article-mime-handle-alist))))
5102 (t
5103 (funcall function
5104 (cdr (assq n gnus-article-mime-handle-alist)))))
5105 (set-marker overlay-arrow-position nil)
5106 (unless gnus-auto-select-part
5107 (gnus-select-frame-set-input-focus frame)
5108 (select-window window))))
5109 t))
5110 (if gnus-inhibit-mime-unbuttonizing
5111 ;; This is the default though the program shouldn't reach here.
5112 (error "No such part")
5113 ;; The part which doesn't have the MIME button is selected.
5114 ;; So, we display all the buttons and redo it.
5115 (let ((gnus-inhibit-mime-unbuttonizing t))
5116 (gnus-summary-show-article)
5117 (gnus-article-part-wrapper n function no-handle))))))
4730 5118
4731(defun gnus-article-pipe-part (n) 5119(defun gnus-article-pipe-part (n)
4732 "Pipe MIME part N, which is the numerical prefix." 5120 "Pipe MIME part N, which is the numerical prefix."
4733 (interactive "p") 5121 (interactive "P")
4734 (gnus-article-part-wrapper n 'mm-pipe-part)) 5122 (gnus-article-part-wrapper n 'mm-pipe-part))
4735 5123
4736(defun gnus-article-save-part (n) 5124(defun gnus-article-save-part (n)
4737 "Save MIME part N, which is the numerical prefix." 5125 "Save MIME part N, which is the numerical prefix."
4738 (interactive "p") 5126 (interactive "P")
4739 (gnus-article-part-wrapper n 'mm-save-part)) 5127 (gnus-article-part-wrapper n 'mm-save-part))
4740 5128
4741(defun gnus-article-interactively-view-part (n) 5129(defun gnus-article-interactively-view-part (n)
4742 "View MIME part N interactively, which is the numerical prefix." 5130 "View MIME part N interactively, which is the numerical prefix."
4743 (interactive "p") 5131 (interactive "P")
4744 (gnus-article-part-wrapper n 'mm-interactively-view-part)) 5132 (gnus-article-part-wrapper n 'mm-interactively-view-part))
4745 5133
4746(defun gnus-article-copy-part (n) 5134(defun gnus-article-copy-part (n)
4747 "Copy MIME part N, which is the numerical prefix." 5135 "Copy MIME part N, which is the numerical prefix."
4748 (interactive "p") 5136 (interactive "P")
4749 (gnus-article-part-wrapper n 'gnus-mime-copy-part)) 5137 (gnus-article-part-wrapper n 'gnus-mime-copy-part))
4750 5138
4751(defun gnus-article-view-part-as-charset (n) 5139(defun gnus-article-view-part-as-charset (n)
4752 "View MIME part N using a specified charset. 5140 "View MIME part N using a specified charset.
4753N is the numerical prefix." 5141N is the numerical prefix."
4754 (interactive "p") 5142 (interactive "P")
4755 (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) 5143 (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
4756 5144
4757(defun gnus-article-view-part-externally (n) 5145(defun gnus-article-view-part-externally (n)
4758 "View MIME part N externally, which is the numerical prefix." 5146 "View MIME part N externally, which is the numerical prefix."
4759 (interactive "p") 5147 (interactive "P")
4760 (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) 5148 (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
4761 5149
4762(defun gnus-article-inline-part (n) 5150(defun gnus-article-inline-part (n)
4763 "Inline MIME part N, which is the numerical prefix." 5151 "Inline MIME part N, which is the numerical prefix."
4764 (interactive "p") 5152 (interactive "P")
4765 (gnus-article-part-wrapper n 'gnus-mime-inline-part)) 5153 (gnus-article-part-wrapper n 'gnus-mime-inline-part))
4766 5154
5155(defun gnus-article-save-part-and-strip (n)
5156 "Save MIME part N and replace it with an external body.
5157N is the numerical prefix."
5158 (interactive "P")
5159 (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
5160
5161(defun gnus-article-replace-part (n)
5162 "Replace MIME part N with an external body.
5163N is the numerical prefix."
5164 (interactive "P")
5165 (gnus-article-part-wrapper n 'gnus-mime-replace-part t t))
5166
5167(defun gnus-article-delete-part (n)
5168 "Delete MIME part N and add some information about the removed part.
5169N is the numerical prefix."
5170 (interactive "P")
5171 (gnus-article-part-wrapper n 'gnus-mime-delete-part t))
5172
5173(defun gnus-article-view-part-as-type (n)
5174 "Choose a MIME media type, and view part N as such.
5175N is the numerical prefix."
5176 (interactive "P")
5177 (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
5178
4767(defun gnus-article-mime-match-handle-first (condition) 5179(defun gnus-article-mime-match-handle-first (condition)
4768 (if condition 5180 (if condition
4769 (let ((alist gnus-article-mime-handle-alist) ihandle n) 5181 (let (n)
4770 (while (setq ihandle (pop alist)) 5182 (dolist (ihandle gnus-article-mime-handle-alist)
4771 (if (and (cond 5183 (if (and (cond
4772 ((functionp condition) 5184 ((functionp condition)
4773 (funcall condition (cdr ihandle))) 5185 (funcall condition (cdr ihandle)))
@@ -4787,8 +5199,7 @@ N is the numerical prefix."
4787(defun gnus-article-view-part (&optional n) 5199(defun gnus-article-view-part (&optional n)
4788 "View MIME part N, which is the numerical prefix." 5200 "View MIME part N, which is the numerical prefix."
4789 (interactive "P") 5201 (interactive "P")
4790 (save-current-buffer 5202 (with-current-buffer gnus-article-buffer
4791 (set-buffer gnus-article-buffer)
4792 (or (numberp n) (setq n (gnus-article-mime-match-handle-first 5203 (or (numberp n) (setq n (gnus-article-mime-match-handle-first
4793 gnus-article-mime-match-handle-function))) 5204 gnus-article-mime-match-handle-function)))
4794 (when (> n (length gnus-article-mime-handle-alist)) 5205 (when (> n (length gnus-article-mime-handle-alist))
@@ -4816,8 +5227,7 @@ N is the numerical prefix."
4816 (mail-parse-charset gnus-newsgroup-charset) 5227 (mail-parse-charset gnus-newsgroup-charset)
4817 (mail-parse-ignored-charsets 5228 (mail-parse-ignored-charsets
4818 (if (gnus-buffer-live-p gnus-summary-buffer) 5229 (if (gnus-buffer-live-p gnus-summary-buffer)
4819 (save-excursion 5230 (with-current-buffer gnus-summary-buffer
4820 (set-buffer gnus-summary-buffer)
4821 gnus-newsgroup-ignored-charsets) 5231 gnus-newsgroup-ignored-charsets)
4822 nil))) 5232 nil)))
4823 (save-excursion 5233 (save-excursion
@@ -4885,15 +5295,18 @@ N is the numerical prefix."
4885 (setq b (point)) 5295 (setq b (point))
4886 (gnus-eval-format 5296 (gnus-eval-format
4887 gnus-mime-button-line-format gnus-mime-button-line-format-alist 5297 gnus-mime-button-line-format gnus-mime-button-line-format-alist
4888 `(,@(gnus-local-map-property gnus-mime-button-map) 5298 `(keymap ,gnus-mime-button-map
4889 gnus-callback gnus-mm-display-part 5299 gnus-callback gnus-mm-display-part
4890 gnus-part ,gnus-tmp-id 5300 gnus-part ,gnus-tmp-id
4891 article-type annotation 5301 article-type annotation
4892 gnus-data ,handle)) 5302 gnus-data ,handle))
4893 (setq e (if (bolp) 5303 (setq e (if (bolp)
4894 ;; Exclude a newline. 5304 ;; Exclude a newline.
4895 (1- (point)) 5305 (1- (point))
4896 (point))) 5306 (point)))
5307 (when gnus-article-button-face
5308 (gnus-overlay-put (gnus-make-overlay b e nil t)
5309 'face gnus-article-button-face))
4897 (widget-convert-button 5310 (widget-convert-button
4898 'link b e 5311 'link b e
4899 :mime-handle handle 5312 :mime-handle handle
@@ -5121,8 +5534,9 @@ If displaying \"text/html\" is discouraged \(see
5121 (gnus-article-insert-newline) 5534 (gnus-article-insert-newline)
5122 (mm-insert-inline 5535 (mm-insert-inline
5123 handle 5536 handle
5124 (let ((charset (mail-content-type-get (mm-handle-type handle) 5537 (let ((charset (or (mail-content-type-get (mm-handle-type handle)
5125 'charset))) 5538 'charset)
5539 (and (equal type "text/calendar") 'utf-8))))
5126 (cond ((not charset) 5540 (cond ((not charset)
5127 (mm-string-as-multibyte (mm-get-part handle))) 5541 (mm-string-as-multibyte (mm-get-part handle)))
5128 ((eq charset 'gnus-decoded) 5542 ((eq charset 'gnus-decoded)
@@ -5135,10 +5549,21 @@ If displaying \"text/html\" is discouraged \(see
5135 (save-excursion 5549 (save-excursion
5136 (save-restriction 5550 (save-restriction
5137 (narrow-to-region beg (point)) 5551 (narrow-to-region beg (point))
5138 (gnus-treat-article 5552 (if (eq handle gnus-article-mime-handles)
5139 nil id 5553 ;; The format=flowed case.
5140 (gnus-article-mime-total-parts) 5554 (gnus-treat-article nil 1 1 (mm-handle-media-type handle))
5141 (mm-handle-media-type handle))))))))) 5555 ;; Don't count signature parts that are never displayed.
5556 ;; The part number should be re-calculated supposing this
5557 ;; might be a message/rfc822 part.
5558 (let (handles)
5559 (dolist (part gnus-article-mime-handles)
5560 (unless (or (stringp part)
5561 (equal (car (mm-handle-type part))
5562 "application/pgp-signature"))
5563 (push part handles)))
5564 (gnus-treat-article
5565 nil (length (memq handle handles)) (length handles)
5566 (mm-handle-media-type handle)))))))))))
5142 5567
5143(defun gnus-unbuttonized-mime-type-p (type) 5568(defun gnus-unbuttonized-mime-type-p (type)
5144 "Say whether TYPE is to be unbuttonized." 5569 "Say whether TYPE is to be unbuttonized."
@@ -5195,7 +5620,7 @@ If displaying \"text/html\" is discouraged \(see
5195 ',gnus-article-mime-handle-alist)) 5620 ',gnus-article-mime-handle-alist))
5196 (gnus-mime-display-alternative 5621 (gnus-mime-display-alternative
5197 ',ihandles ',not-pref ',begend ,id)) 5622 ',ihandles ',not-pref ',begend ,id))
5198 ,@(gnus-local-map-property gnus-mime-button-map) 5623 keymap ,gnus-mime-button-map
5199 ,gnus-mouse-face-prop ,gnus-article-mouse-face 5624 ,gnus-mouse-face-prop ,gnus-article-mouse-face
5200 face ,gnus-article-button-face 5625 face ,gnus-article-button-face
5201 gnus-part ,id 5626 gnus-part ,id
@@ -5219,7 +5644,7 @@ If displaying \"text/html\" is discouraged \(see
5219 ',gnus-article-mime-handle-alist)) 5644 ',gnus-article-mime-handle-alist))
5220 (gnus-mime-display-alternative 5645 (gnus-mime-display-alternative
5221 ',ihandles ',handle ',begend ,id)) 5646 ',ihandles ',handle ',begend ,id))
5222 ,@(gnus-local-map-property gnus-mime-button-map) 5647 keymap ,gnus-mime-button-map
5223 ,gnus-mouse-face-prop ,gnus-article-mouse-face 5648 ,gnus-mouse-face-prop ,gnus-article-mouse-face
5224 face ,gnus-article-button-face 5649 face ,gnus-article-button-face
5225 gnus-part ,id 5650 gnus-part ,id
@@ -5234,8 +5659,8 @@ If displaying \"text/html\" is discouraged \(see
5234 (gnus-display-mime preferred) 5659 (gnus-display-mime preferred)
5235 (let ((mail-parse-charset gnus-newsgroup-charset) 5660 (let ((mail-parse-charset gnus-newsgroup-charset)
5236 (mail-parse-ignored-charsets 5661 (mail-parse-ignored-charsets
5237 (save-excursion (set-buffer gnus-summary-buffer) 5662 (with-current-buffer gnus-summary-buffer
5238 gnus-newsgroup-ignored-charsets))) 5663 gnus-newsgroup-ignored-charsets)))
5239 (mm-display-part preferred) 5664 (mm-display-part preferred)
5240 ;; Do highlighting. 5665 ;; Do highlighting.
5241 (save-excursion 5666 (save-excursion
@@ -5285,8 +5710,7 @@ is the string to use when it is inactive.")
5285 5710
5286(defun gnus-article-wash-status () 5711(defun gnus-article-wash-status ()
5287 "Return a string which display status of article washing." 5712 "Return a string which display status of article washing."
5288 (save-excursion 5713 (with-current-buffer gnus-article-buffer
5289 (set-buffer gnus-article-buffer)
5290 (let ((cite (memq 'cite gnus-article-wash-types)) 5714 (let ((cite (memq 'cite gnus-article-wash-types))
5291 (headers (memq 'headers gnus-article-wash-types)) 5715 (headers (memq 'headers gnus-article-wash-types))
5292 (boring (memq 'boring-headers gnus-article-wash-types)) 5716 (boring (memq 'boring-headers gnus-article-wash-types))
@@ -5335,8 +5759,8 @@ is the string to use when it is inactive.")
5335 "Hide unwanted headers if `gnus-have-all-headers' is nil. 5759 "Hide unwanted headers if `gnus-have-all-headers' is nil.
5336Provided for backwards compatibility." 5760Provided for backwards compatibility."
5337 (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer)) 5761 (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
5338 (not (save-excursion (set-buffer gnus-summary-buffer) 5762 (not (with-current-buffer gnus-summary-buffer
5339 gnus-have-all-headers))) 5763 gnus-have-all-headers)))
5340 (not gnus-inhibit-hiding)) 5764 (not gnus-inhibit-hiding))
5341 (gnus-article-hide-headers))) 5765 (gnus-article-hide-headers)))
5342 5766
@@ -5502,9 +5926,7 @@ specifies."
5502 (min (max 0 scroll-margin) 5926 (min (max 0 scroll-margin)
5503 (max 1 (- (window-height) 5927 (max 1 (- (window-height)
5504 (if mode-line-format 1 0) 5928 (if mode-line-format 1 0)
5505 (if (and (boundp 'header-line-format) 5929 (if header-line-format 1 0)))))))
5506 (symbol-value 'header-line-format))
5507 1 0)))))))
5508 5930
5509(defun gnus-article-next-page-1 (lines) 5931(defun gnus-article-next-page-1 (lines)
5510 (when (and (not (featurep 'xemacs)) 5932 (when (and (not (featurep 'xemacs))
@@ -5567,9 +5989,9 @@ not have a face in `gnus-article-boring-faces'."
5567 "Read article specified by message-id around point." 5989 "Read article specified by message-id around point."
5568 (interactive) 5990 (interactive)
5569 (save-excursion 5991 (save-excursion
5570 (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) 5992 (re-search-backward "[ \t]\\|^" (point-at-bol) t)
5571 (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t) 5993 (re-search-forward "<?news:<?\\|<" (point-at-eol) t)
5572 (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t) 5994 (if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t)
5573 (let ((msg-id (concat "<" (match-string 0) ">"))) 5995 (let ((msg-id (concat "<" (match-string 0) ">")))
5574 (set-buffer gnus-summary-buffer) 5996 (set-buffer gnus-summary-buffer)
5575 (gnus-summary-refer-article msg-id)) 5997 (gnus-summary-refer-article msg-id))
@@ -5641,64 +6063,94 @@ not have a face in `gnus-article-boring-faces'."
5641 6063
5642 (message "") 6064 (message "")
5643 6065
5644 (if (or (member keys nosaves) 6066 (cond
5645 (member keys nosave-but-article) 6067 ((eq (aref keys (1- (length keys))) ?\C-h)
5646 (member keys nosave-in-article)) 6068 (with-current-buffer gnus-article-current-summary
5647 (let (func) 6069 (describe-bindings (substring keys 0 -1))))
5648 (save-window-excursion 6070 ((or (member keys nosaves)
5649 (pop-to-buffer gnus-article-current-summary) 6071 (member keys nosave-but-article)
5650 ;; We disable the pick minor mode commands. 6072 (member keys nosave-in-article))
5651 (let (gnus-pick-mode) 6073 (let (func)
5652 (setq func (lookup-key (current-local-map) keys)))) 6074 (save-window-excursion
5653 (if (or (not func) 6075 (pop-to-buffer gnus-article-current-summary)
5654 (numberp func)) 6076 ;; We disable the pick minor mode commands.
5655 (ding) 6077 (let (gnus-pick-mode)
5656 (unless (member keys nosave-in-article) 6078 (setq func (lookup-key (current-local-map) keys))))
5657 (set-buffer gnus-article-current-summary)) 6079 (if (or (not func)
5658 (call-interactively func) 6080 (numberp func))
5659 (setq new-sum-point (point))) 6081 (ding)
5660 (when (member keys nosave-but-article) 6082 (unless (member keys nosave-in-article)
5661 (pop-to-buffer gnus-article-buffer))) 6083 (set-buffer gnus-article-current-summary))
6084 (call-interactively func)
6085 (setq new-sum-point (point)))
6086 (when (member keys nosave-but-article)
6087 (pop-to-buffer gnus-article-buffer))))
6088 (t
5662 ;; These commands should restore window configuration. 6089 ;; These commands should restore window configuration.
5663 (let ((obuf (current-buffer)) 6090 (let ((obuf (current-buffer))
5664 (owin (current-window-configuration)) 6091 (owin (current-window-configuration))
5665 (opoint (point)) 6092 win func in-buffer selected new-sum-start new-sum-hscroll err)
5666 win func in-buffer selected new-sum-start new-sum-hscroll)
5667 (cond (not-restore-window 6093 (cond (not-restore-window
5668 (pop-to-buffer gnus-article-current-summary)) 6094 (pop-to-buffer gnus-article-current-summary)
6095 (setq win (selected-window)))
5669 ((setq win (get-buffer-window gnus-article-current-summary)) 6096 ((setq win (get-buffer-window gnus-article-current-summary))
5670 (select-window win)) 6097 (select-window win))
5671 (t 6098 (t
5672 (switch-to-buffer gnus-article-current-summary 'norecord))) 6099 (let ((summary-buffer gnus-article-current-summary))
6100 (gnus-configure-windows 'article)
6101 (unless (setq win (get-buffer-window summary-buffer 'visible))
6102 (let ((gnus-buffer-configuration
6103 '(article ((vertical 1.0
6104 (summary 0.25 point)
6105 (article 1.0))))))
6106 (gnus-configure-windows 'article))
6107 (setq win (get-buffer-window summary-buffer 'visible)))
6108 (gnus-select-frame-set-input-focus (window-frame win))
6109 (select-window win))))
5673 (setq in-buffer (current-buffer)) 6110 (setq in-buffer (current-buffer))
5674 ;; We disable the pick minor mode commands. 6111 ;; We disable the pick minor mode commands.
5675 (if (and (setq func (let (gnus-pick-mode) 6112 (if (and (setq func (let (gnus-pick-mode)
5676 (lookup-key (current-local-map) keys))) 6113 (lookup-key (current-local-map) keys)))
5677 (functionp func)) 6114 (functionp func)
6115 (condition-case code
6116 (progn
6117 (call-interactively func)
6118 t)
6119 (error
6120 (setq err code)
6121 nil)))
5678 (progn 6122 (progn
5679 (call-interactively func)
5680 (when (eq win (selected-window)) 6123 (when (eq win (selected-window))
5681 (setq new-sum-point (point) 6124 (setq new-sum-point (point)
5682 new-sum-start (window-start win) 6125 new-sum-start (window-start win)
5683 new-sum-hscroll (window-hscroll win))) 6126 new-sum-hscroll (window-hscroll win)))
5684 (when (eq in-buffer (current-buffer)) 6127 (when (or (eq in-buffer (current-buffer))
6128 (when (eq obuf (current-buffer))
6129 (set-buffer in-buffer)
6130 t))
5685 (setq selected (gnus-summary-select-article)) 6131 (setq selected (gnus-summary-select-article))
5686 (set-buffer obuf) 6132 (set-buffer obuf)
5687 (unless not-restore-window 6133 (unless not-restore-window
5688 (set-window-configuration owin)) 6134 (set-window-configuration owin))
5689 (when (eq selected 'old) 6135 (when (and (eq selected 'old)
5690 (article-goto-body) 6136 new-sum-point)
5691 (set-window-start (get-buffer-window (current-buffer)) 6137 (set-window-start (get-buffer-window (current-buffer))
5692 1) 6138 1)
5693 (set-window-point (get-buffer-window (current-buffer)) 6139 (set-window-point (get-buffer-window (current-buffer))
5694 (point))) 6140 (if (article-goto-body)
6141 (1- (point))
6142 (point))))
5695 (when (and (not not-restore-window) 6143 (when (and (not not-restore-window)
5696 new-sum-point) 6144 new-sum-point
6145 (with-current-buffer (window-buffer win)
6146 (eq major-mode 'gnus-summary-mode)))
5697 (set-window-point win new-sum-point) 6147 (set-window-point win new-sum-point)
5698 (set-window-start win new-sum-start) 6148 (set-window-start win new-sum-start)
5699 (set-window-hscroll win new-sum-hscroll)))) 6149 (set-window-hscroll win new-sum-hscroll))))
5700 (set-window-configuration owin) 6150 (set-window-configuration owin)
5701 (ding)))))) 6151 (if err
6152 (signal (car err) (cdr err))
6153 (ding))))))))
5702 6154
5703(defun gnus-article-describe-key (key) 6155(defun gnus-article-describe-key (key)
5704 "Display documentation of the function invoked by KEY. KEY is a string." 6156 "Display documentation of the function invoked by KEY. KEY is a string."
@@ -5868,16 +6320,14 @@ If given a prefix, show the hidden text instead."
5868 gnus-summary-buffer 6320 gnus-summary-buffer
5869 (get-buffer gnus-summary-buffer) 6321 (get-buffer gnus-summary-buffer)
5870 (gnus-buffer-exists-p gnus-summary-buffer) 6322 (gnus-buffer-exists-p gnus-summary-buffer)
5871 (eq (cdr (save-excursion 6323 (eq (cdr (with-current-buffer gnus-summary-buffer
5872 (set-buffer gnus-summary-buffer)
5873 (assq article gnus-newsgroup-reads))) 6324 (assq article gnus-newsgroup-reads)))
5874 gnus-canceled-mark)) 6325 gnus-canceled-mark))
5875 nil) 6326 nil)
5876 ;; We first check `gnus-original-article-buffer'. 6327 ;; We first check `gnus-original-article-buffer'.
5877 ((and (get-buffer gnus-original-article-buffer) 6328 ((and (get-buffer gnus-original-article-buffer)
5878 (numberp article) 6329 (numberp article)
5879 (save-excursion 6330 (with-current-buffer gnus-original-article-buffer
5880 (set-buffer gnus-original-article-buffer)
5881 (and (equal (car gnus-original-article) group) 6331 (and (equal (car gnus-original-article) group)
5882 (eq (cdr gnus-original-article) article)))) 6332 (eq (cdr gnus-original-article) article))))
5883 (insert-buffer-substring gnus-original-article-buffer) 6333 (insert-buffer-substring gnus-original-article-buffer)
@@ -5995,7 +6445,6 @@ If given a prefix, show the hidden text instead."
5995(defvar gnus-article-edit-done-function nil) 6445(defvar gnus-article-edit-done-function nil)
5996 6446
5997(defvar gnus-article-edit-mode-map nil) 6447(defvar gnus-article-edit-mode-map nil)
5998(defvar gnus-article-edit-mode nil)
5999 6448
6000;; Should we be using derived.el for this? 6449;; Should we be using derived.el for this?
6001(unless gnus-article-edit-mode-map 6450(unless gnus-article-edit-mode-map
@@ -6095,7 +6544,7 @@ groups."
6095 ,(or (mail-header-references gnus-current-headers) "") 6544 ,(or (mail-header-references gnus-current-headers) "")
6096 ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) 6545 ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
6097 6546
6098(defun gnus-article-edit-article (start-func exit-func) 6547(defun gnus-article-edit-article (start-func exit-func &optional quiet)
6099 "Start editing the contents of the current article buffer." 6548 "Start editing the contents of the current article buffer."
6100 (let ((winconf (current-window-configuration))) 6549 (let ((winconf (current-window-configuration)))
6101 (set-buffer gnus-article-buffer) 6550 (set-buffer gnus-article-buffer)
@@ -6108,7 +6557,8 @@ groups."
6108 (gnus-configure-windows 'edit-article) 6557 (gnus-configure-windows 'edit-article)
6109 (setq gnus-article-edit-done-function exit-func) 6558 (setq gnus-article-edit-done-function exit-func)
6110 (setq gnus-prev-winconf winconf) 6559 (setq gnus-prev-winconf winconf)
6111 (gnus-message 6 "C-c C-c to end edits"))) 6560 (unless quiet
6561 (gnus-message 6 "C-c C-c to end edits"))))
6112 6562
6113(defun gnus-article-edit-done (&optional arg) 6563(defun gnus-article-edit-done (&optional arg)
6114 "Update the article edits and exit." 6564 "Update the article edits and exit."
@@ -6135,7 +6585,7 @@ groups."
6135 (car gnus-article-current) (cdr gnus-article-current))) 6585 (car gnus-article-current) (cdr gnus-article-current)))
6136 ;; We remove all text props from the article buffer. 6586 ;; We remove all text props from the article buffer.
6137 (kill-all-local-variables) 6587 (kill-all-local-variables)
6138 (gnus-set-text-properties (point-min) (point-max) nil) 6588 (set-text-properties (point-min) (point-max) nil)
6139 (gnus-article-mode) 6589 (gnus-article-mode)
6140 (set-window-configuration winconf) 6590 (set-window-configuration winconf)
6141 (set-buffer buf) 6591 (set-buffer buf)
@@ -6183,9 +6633,24 @@ groups."
6183;;; Internal Variables: 6633;;; Internal Variables:
6184 6634
6185(defcustom gnus-button-url-regexp 6635(defcustom gnus-button-url-regexp
6186 (if (string-match "[[:digit:]]" "1") ;; support POSIX? 6636 (concat
6187 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" 6637 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
6188 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") 6638 "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
6639 "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
6640 (if (string-match "[[:digit:]]" "1") ;; Support POSIX?
6641 (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
6642 (punct "!?:;.,"))
6643 (concat
6644 "\\(?:"
6645 ;; Match paired parentheses, e.g. in Wikipedia URLs:
6646 "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
6647 "\\|"
6648 "[" chars punct "]+" "[" chars "]"
6649 "\\)"))
6650 (concat ;; XEmacs 21.4 doesn't support POSIX.
6651 "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
6652 "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
6653 "\\)")
6189 "Regular expression that matches URLs." 6654 "Regular expression that matches URLs."
6190 :group 'gnus-article-buttons 6655 :group 'gnus-article-buttons
6191 :type 'regexp) 6656 :type 'regexp)
@@ -6437,9 +6902,14 @@ address, `ask' if unsure and `invalid' if the string is invalid."
6437 (gnus-url-mailto url-mailto)) 6902 (gnus-url-mailto url-mailto))
6438 (t (gnus-message 3 "Invalid string."))))) 6903 (t (gnus-message 3 "Invalid string.")))))
6439 6904
6440(defun gnus-button-handle-custom (url) 6905(defun gnus-button-handle-custom (fun arg)
6441 "Follow a Custom URL." 6906 "Call function FUN on argument ARG.
6442 (customize-apropos (gnus-url-unhex-string url))) 6907Both FUN and ARG are supposed to be strings. ARG will be passed
6908as a symbol to FUN."
6909 (funcall (intern fun)
6910 (if (string-match "^customize-apropos" fun)
6911 arg
6912 (intern arg))))
6443 6913
6444(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)") 6914(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
6445 6915
@@ -6583,6 +7053,8 @@ positives are possible."
6583 0 (>= gnus-button-message-level 0) gnus-button-message-id 2) 7053 0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
6584 ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 7054 ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
6585 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) 7055 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
7056 ("\\b\\(mid\\|message-id\\):? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
7057 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
6586 ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 7058 ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
6587 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) 7059 0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
6588 ;; RFC 2368 (The mailto URL scheme) 7060 ;; RFC 2368 (The mailto URL scheme)
@@ -6619,10 +7091,8 @@ positives are possible."
6619 ;; Info links like `C-h i d m CC Mode RET' 7091 ;; Info links like `C-h i d m CC Mode RET'
6620 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) 7092 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
6621 ;; This is custom 7093 ;; This is custom
6622 ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" 7094 ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
6623 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) 7095 (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2)
6624 ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
6625 (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
6626 ;; Emacs help commands 7096 ;; Emacs help commands
6627 ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" 7097 ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
6628 ;; regexp doesn't match arguments containing ` '. 7098 ;; regexp doesn't match arguments containing ` '.
@@ -6640,7 +7110,7 @@ positives are possible."
6640 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) 7110 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
6641 ("`\\([a-z][-a-z0-9]+\\.el\\)'" 7111 ("`\\([a-z][-a-z0-9]+\\.el\\)'"
6642 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) 7112 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
6643 ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" 7113 ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
6644 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) 7114 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
6645 ("`\\([a-z][a-z0-9]+-[a-z]+\\)'" 7115 ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
6646 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) 7116 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
@@ -6657,13 +7127,10 @@ positives are possible."
6657 ;; here to determine where it ends. 7127 ;; here to determine where it ends.
6658 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) 7128 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
6659 ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... 7129 ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
6660 ("<URL: *\\([^<>]*\\)>" 7130 ("<URL: *\\([^\n<>]*\\)>"
6661 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6662 ;; RFC 2396 (2.4.3., delims) ...
6663 ("\"URL: *\\([^\"]*\\)\""
6664 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) 7131 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6665 ;; RFC 2396 (2.4.3., delims) ... 7132 ;; RFC 2396 (2.4.3., delims) ...
6666 ("\"URL: *\\([^\"]*\\)\"" 7133 ("\"URL: *\\([^\n\"]*\\)\""
6667 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) 7134 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6668 ;; Raw URLs. 7135 ;; Raw URLs.
6669 (gnus-button-url-regexp 7136 (gnus-button-url-regexp
@@ -6680,6 +7147,13 @@ positives are possible."
6680 ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) 7147 ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
6681 ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W" 7148 ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"
6682 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) 7149 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
7150 ;; Recognizing patches to .el files. This is somewhat obscure,
7151 ;; but considering the percentage of Gnus users who hack Emacs
7152 ;; Lisp files...
7153 ("^--- \\([^ .]+\\.el\\).*\n.*\n@@ -?\\([0-9]+\\)" 1
7154 (>= gnus-button-message-level 4) gnus-button-patch 1 2)
7155 ("^\\*\\*\\* \\([^ .]+\\.el\\).*\n.*\n\\*+\n\\*\\*\\* \\([0-9]+\\)" 1
7156 (>= gnus-button-message-level 4) gnus-button-patch 1 2)
6683 ;; MID or mail: To avoid too many false positives we don't try to catch 7157 ;; MID or mail: To avoid too many false positives we don't try to catch
6684 ;; all kind of allowed MIDs or mail addresses. Domain part must contain 7158 ;; all kind of allowed MIDs or mail addresses. Domain part must contain
6685 ;; at least one dot. TLD must contain two or three chars or be a know TLD 7159 ;; at least one dot. TLD must contain two or three chars or be a know TLD
@@ -6722,6 +7196,8 @@ variable it the real callback function."
6722 0 (>= gnus-button-browse-level 0) browse-url 0) 7196 0 (>= gnus-button-browse-level 0) browse-url 0)
6723 ("^[^:]+:" gnus-button-url-regexp 7197 ("^[^:]+:" gnus-button-url-regexp
6724 0 (>= gnus-button-browse-level 0) browse-url 0) 7198 0 (>= gnus-button-browse-level 0) browse-url 0)
7199 ("^OpenPGP:.*url=" gnus-button-url-regexp
7200 0 (>= gnus-button-browse-level 0) gnus-button-openpgp 0)
6725 ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" 7201 ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
6726 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) 7202 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6727 ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" 7203 ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
@@ -6797,55 +7273,46 @@ do the highlighting. See the documentation for those functions."
6797(defun gnus-article-highlight-headers () 7273(defun gnus-article-highlight-headers ()
6798 "Highlight article headers as specified by `gnus-header-face-alist'." 7274 "Highlight article headers as specified by `gnus-header-face-alist'."
6799 (interactive) 7275 (interactive)
6800 (save-excursion 7276 (gnus-with-article-headers
6801 (set-buffer gnus-article-buffer) 7277 (let (regexp header-face field-face from hpoints fpoints)
6802 (save-restriction 7278 (dolist (entry gnus-header-face-alist)
6803 (let ((alist gnus-header-face-alist) 7279 (goto-char (point-min))
6804 (inhibit-read-only t) 7280 (setq regexp (concat "^\\("
6805 (case-fold-search t) 7281 (if (string-equal "" (nth 0 entry))
6806 (inhibit-point-motion-hooks t) 7282 "[^\t ]"
6807 entry regexp header-face field-face from hpoints fpoints) 7283 (nth 0 entry))
6808 (article-narrow-to-head) 7284 "\\)")
6809 (while (setq entry (pop alist)) 7285 header-face (nth 1 entry)
6810 (goto-char (point-min)) 7286 field-face (nth 2 entry))
6811 (setq regexp (concat "^\\(" 7287 (while (and (re-search-forward regexp nil t)
6812 (if (string-equal "" (nth 0 entry)) 7288 (not (eobp)))
6813 "[^\t ]" 7289 (beginning-of-line)
6814 (nth 0 entry)) 7290 (setq from (point))
6815 "\\)") 7291 (unless (search-forward ":" nil t)
6816 header-face (nth 1 entry) 7292 (forward-char 1))
6817 field-face (nth 2 entry)) 7293 (when (and header-face
6818 (while (and (re-search-forward regexp nil t) 7294 (not (memq (point) hpoints)))
6819 (not (eobp))) 7295 (push (point) hpoints)
6820 (beginning-of-line) 7296 (gnus-put-text-property from (point) 'face header-face))
6821 (setq from (point)) 7297 (when (and field-face
6822 (unless (search-forward ":" nil t) 7298 (not (memq (setq from (point)) fpoints)))
6823 (forward-char 1)) 7299 (push from fpoints)
6824 (when (and header-face 7300 (if (re-search-forward "^[^ \t]" nil t)
6825 (not (memq (point) hpoints))) 7301 (forward-char -2)
6826 (push (point) hpoints) 7302 (goto-char (point-max)))
6827 (gnus-put-text-property from (point) 'face header-face)) 7303 (gnus-put-text-property from (point) 'face field-face)))))))
6828 (when (and field-face
6829 (not (memq (setq from (point)) fpoints)))
6830 (push from fpoints)
6831 (if (re-search-forward "^[^ \t]" nil t)
6832 (forward-char -2)
6833 (goto-char (point-max)))
6834 (gnus-put-text-property from (point) 'face field-face))))))))
6835 7304
6836(defun gnus-article-highlight-signature () 7305(defun gnus-article-highlight-signature ()
6837 "Highlight the signature in an article. 7306 "Highlight the signature in an article.
6838It does this by highlighting everything after 7307It does this by highlighting everything after
6839`gnus-signature-separator' using the face `gnus-signature'." 7308`gnus-signature-separator' using the face `gnus-signature'."
6840 (interactive) 7309 (interactive)
6841 (save-excursion 7310 (gnus-with-article-buffer
6842 (set-buffer gnus-article-buffer) 7311 (let ((inhibit-point-motion-hooks t))
6843 (let ((inhibit-read-only t)
6844 (inhibit-point-motion-hooks t))
6845 (save-restriction 7312 (save-restriction
6846 (when (and gnus-signature-face 7313 (when (and gnus-signature-face
6847 (gnus-article-narrow-to-signature)) 7314 (gnus-article-narrow-to-signature))
6848 (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 7315 (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t)
6849 'face gnus-signature-face) 7316 'face gnus-signature-face)
6850 (widen) 7317 (widen)
6851 (gnus-article-search-signature) 7318 (gnus-article-search-signature)
@@ -6863,10 +7330,8 @@ It does this by highlighting everything after
6863\"External references\" are things like Message-IDs and URLs, as 7330\"External references\" are things like Message-IDs and URLs, as
6864specified by `gnus-button-alist'." 7331specified by `gnus-button-alist'."
6865 (interactive (list 'force)) 7332 (interactive (list 'force))
6866 (save-excursion 7333 (gnus-with-article-buffer
6867 (set-buffer gnus-article-buffer) 7334 (let ((inhibit-point-motion-hooks t)
6868 (let ((inhibit-read-only t)
6869 (inhibit-point-motion-hooks t)
6870 (case-fold-search t) 7335 (case-fold-search t)
6871 (alist gnus-button-alist) 7336 (alist gnus-button-alist)
6872 beg entry regexp) 7337 beg entry regexp)
@@ -6889,65 +7354,116 @@ specified by `gnus-button-alist'."
6889 (setq regexp (eval (car entry))) 7354 (setq regexp (eval (car entry)))
6890 (goto-char beg) 7355 (goto-char beg)
6891 (while (re-search-forward regexp nil t) 7356 (while (re-search-forward regexp nil t)
6892 (let* ((start (and entry (match-beginning (nth 1 entry)))) 7357 (let ((start (match-beginning (nth 1 entry)))
6893 (end (and entry (match-end (nth 1 entry)))) 7358 (end (match-end (nth 1 entry)))
6894 (from (match-beginning 0))) 7359 (from (match-beginning 0)))
6895 (when (and (or (eq t (nth 2 entry)) 7360 (when (and (or (eq t (nth 2 entry))
6896 (eval (nth 2 entry))) 7361 (eval (nth 2 entry)))
6897 (not (gnus-button-in-region-p 7362 (not (gnus-button-in-region-p
6898 start end 'gnus-callback))) 7363 start end 'gnus-callback)))
6899 ;; That optional form returned non-nil, so we add the 7364 ;; That optional form returned non-nil, so we add the
6900 ;; button. 7365 ;; button.
6901 (gnus-article-add-button 7366 (setq from (set-marker (make-marker) from))
6902 start end 'gnus-button-push 7367 (push from gnus-button-marker-list)
6903 (car (push (set-marker (make-marker) from) 7368 (unless (and (eq (car entry) 'gnus-button-url-regexp)
6904 gnus-button-marker-list)))))))))) 7369 (gnus-article-extend-url-button from start end))
7370 (gnus-article-add-button start end
7371 'gnus-button-push from)))))))))
7372
7373(defun gnus-article-extend-url-button (beg start end)
7374 "Extend url button if url is folded into two or more lines.
7375Return non-nil if button is extended. BEG is a marker that points to
7376the beginning position of a text containing url. START and END are
7377the endpoints of a url button before it is extended. The concatenated
7378url is put as the `gnus-button-url' overlay property on the button."
7379 (let ((opoint (point))
7380 (points (list start end))
7381 url delim regexp)
7382 (prog1
7383 (when (and (progn
7384 (goto-char end)
7385 (not (looking-at "[\t ]*[\">]")))
7386 (progn
7387 (goto-char start)
7388 (string-match
7389 "\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'"
7390 (buffer-substring (point-at-bol) start)))
7391 (progn
7392 (setq url (list (buffer-substring start end))
7393 delim (if (match-beginning 1) ">" "\""))
7394 (beginning-of-line)
7395 (setq regexp (concat
7396 (when (and (looking-at
7397 message-cite-prefix-regexp)
7398 (< (match-end 0) start))
7399 (regexp-quote (match-string 0)))
7400 "\
7401\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
7402 delim "\\)"))
7403 (while (progn
7404 (forward-line 1)
7405 (and (looking-at regexp)
7406 (prog1
7407 (match-beginning 1)
7408 (push (or (match-string 2)
7409 (match-string 1))
7410 url)
7411 (push (setq end (or (match-end 2)
7412 (match-end 1)))
7413 points)
7414 (push (or (match-beginning 2)
7415 (match-beginning 1))
7416 points)))))
7417 (match-beginning 2)))
7418 (let (gnus-article-mouse-face widget-mouse-face)
7419 (while points
7420 (gnus-article-add-button (pop points) (pop points)
7421 'gnus-button-push beg)))
7422 (let ((overlay (gnus-make-overlay start end)))
7423 (gnus-overlay-put overlay 'evaporate t)
7424 (gnus-overlay-put overlay 'gnus-button-url
7425 (list (mapconcat 'identity (nreverse url) "")))
7426 (when gnus-article-mouse-face
7427 (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
7428 t)
7429 (goto-char opoint))))
6905 7430
6906;; Add buttons to the head of an article. 7431;; Add buttons to the head of an article.
6907(defun gnus-article-add-buttons-to-head () 7432(defun gnus-article-add-buttons-to-head ()
6908 "Add buttons to the head of the article." 7433 "Add buttons to the head of the article."
6909 (interactive) 7434 (interactive)
6910 (save-excursion 7435 (gnus-with-article-headers
6911 (set-buffer gnus-article-buffer) 7436 (let (beg end)
6912 (save-restriction 7437 (dolist (entry gnus-header-button-alist)
6913 (let ((inhibit-read-only t) 7438 ;; Each alist entry.
6914 (inhibit-point-motion-hooks t) 7439 (goto-char (point-min))
6915 (case-fold-search t) 7440 (while (re-search-forward (car entry) nil t)
6916 (alist gnus-header-button-alist) 7441 ;; Each header matching the entry.
6917 entry beg end) 7442 (setq beg (match-beginning 0))
6918 (article-narrow-to-head) 7443 (setq end (or (and (re-search-forward "^[^ \t]" nil t)
6919 (while alist 7444 (match-beginning 0))
6920 ;; Each alist entry. 7445 (point-max)))
6921 (setq entry (car alist) 7446 (goto-char beg)
6922 alist (cdr alist)) 7447 (while (re-search-forward (eval (nth 1 entry)) end t)
6923 (goto-char (point-min)) 7448 ;; Each match within a header.
6924 (while (re-search-forward (car entry) nil t) 7449 (let* ((entry (cdr entry))
6925 ;; Each header matching the entry. 7450 (start (match-beginning (nth 1 entry)))
6926 (setq beg (match-beginning 0)) 7451 (end (match-end (nth 1 entry)))
6927 (setq end (or (and (re-search-forward "^[^ \t]" nil t) 7452 (form (nth 2 entry)))
6928 (match-beginning 0)) 7453 (goto-char (match-end 0))
6929 (point-max))) 7454 (when (eval form)
6930 (goto-char beg) 7455 (gnus-article-add-button
6931 (while (re-search-forward (eval (nth 1 entry)) end t) 7456 start end (nth 3 entry)
6932 ;; Each match within a header. 7457 (buffer-substring (match-beginning (nth 4 entry))
6933 (let* ((entry (cdr entry)) 7458 (match-end (nth 4 entry)))))))
6934 (start (match-beginning (nth 1 entry))) 7459 (goto-char end))))))
6935 (end (match-end (nth 1 entry)))
6936 (form (nth 2 entry)))
6937 (goto-char (match-end 0))
6938 (when (eval form)
6939 (gnus-article-add-button
6940 start end (nth 3 entry)
6941 (buffer-substring (match-beginning (nth 4 entry))
6942 (match-end (nth 4 entry)))))))
6943 (goto-char end)))))))
6944 7460
6945;;; External functions: 7461;;; External functions:
6946 7462
6947(defun gnus-article-add-button (from to fun &optional data) 7463(defun gnus-article-add-button (from to fun &optional data)
6948 "Create a button between FROM and TO with callback FUN and data DATA." 7464 "Create a button between FROM and TO with callback FUN and data DATA."
6949 (when gnus-article-button-face 7465 (when gnus-article-button-face
6950 (gnus-overlay-put (gnus-make-overlay from to) 7466 (gnus-overlay-put (gnus-make-overlay from to nil t)
6951 'face gnus-article-button-face)) 7467 'face gnus-article-button-face))
6952 (gnus-add-text-properties 7468 (gnus-add-text-properties
6953 from to 7469 from to
@@ -6961,15 +7477,12 @@ specified by `gnus-button-alist'."
6961;;; Internal functions: 7477;;; Internal functions:
6962 7478
6963(defun gnus-article-set-globals () 7479(defun gnus-article-set-globals ()
6964 (save-excursion 7480 (with-current-buffer gnus-summary-buffer
6965 (set-buffer gnus-summary-buffer)
6966 (gnus-set-global-variables))) 7481 (gnus-set-global-variables)))
6967 7482
6968(defun gnus-signature-toggle (end) 7483(defun gnus-signature-toggle (end)
6969 (save-excursion 7484 (gnus-with-article-buffer
6970 (set-buffer gnus-article-buffer) 7485 (let ((inhibit-point-motion-hooks t))
6971 (let ((inhibit-read-only t)
6972 (inhibit-point-motion-hooks t))
6973 (if (text-property-any end (point-max) 'article-type 'signature) 7486 (if (text-property-any end (point-max) 'article-type 'signature)
6974 (progn 7487 (progn
6975 (gnus-delete-wash-type 'signature) 7488 (gnus-delete-wash-type 'signature)
@@ -7003,12 +7516,14 @@ specified by `gnus-button-alist'."
7003 (let* ((entry (gnus-button-entry)) 7516 (let* ((entry (gnus-button-entry))
7004 (inhibit-point-motion-hooks t) 7517 (inhibit-point-motion-hooks t)
7005 (fun (nth 3 entry)) 7518 (fun (nth 3 entry))
7006 (args (mapcar (lambda (group) 7519 (args (or (and (eq (car entry) 'gnus-button-url-regexp)
7007 (let ((string (match-string group))) 7520 (get-char-property marker 'gnus-button-url))
7008 (gnus-set-text-properties 7521 (mapcar (lambda (group)
7009 0 (length string) nil string) 7522 (let ((string (match-string group)))
7010 string)) 7523 (set-text-properties
7011 (nthcdr 4 entry)))) 7524 0 (length string) nil string)
7525 string))
7526 (nthcdr 4 entry)))))
7012 (cond 7527 (cond
7013 ((fboundp fun) 7528 ((fboundp fun)
7014 (apply fun args)) 7529 (apply fun args))
@@ -7066,6 +7581,15 @@ specified by `gnus-button-alist'."
7066 (group 7581 (group
7067 (gnus-button-fetch-group url))))) 7582 (gnus-button-fetch-group url)))))
7068 7583
7584(defun gnus-button-patch (library line)
7585 "Visit an Emacs Lisp library LIBRARY on line LINE."
7586 (interactive)
7587 (let ((file (locate-library (file-name-nondirectory library))))
7588 (unless file
7589 (error "Couldn't find library %s" library))
7590 (find-file file)
7591 (goto-line (string-to-number line))))
7592
7069(defun gnus-button-handle-man (url) 7593(defun gnus-button-handle-man (url)
7070 "Fetch a man page." 7594 "Fetch a man page."
7071 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) 7595 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
@@ -7115,14 +7639,25 @@ specified by `gnus-button-alist'."
7115 (Info-directory) 7639 (Info-directory)
7116 (Info-menu url)) 7640 (Info-menu url))
7117 7641
7642(defun gnus-button-openpgp (url)
7643 "Retrieve and add an OpenPGP key given URL from an OpenPGP header."
7644 (with-temp-buffer
7645 (mm-url-insert-file-contents-external url)
7646 (pgg-snarf-keys-region (point-min) (point-max))
7647 (pgg-display-output-buffer nil nil nil)))
7648
7118(defun gnus-button-message-id (message-id) 7649(defun gnus-button-message-id (message-id)
7119 "Fetch MESSAGE-ID." 7650 "Fetch MESSAGE-ID."
7120 (save-excursion 7651 (with-current-buffer gnus-summary-buffer
7121 (set-buffer gnus-summary-buffer)
7122 (gnus-summary-refer-article message-id))) 7652 (gnus-summary-refer-article message-id)))
7123 7653
7124(defun gnus-button-fetch-group (address) 7654(defun gnus-button-fetch-group (address &rest ignore)
7125 "Fetch GROUP specified by ADDRESS." 7655 "Fetch GROUP specified by ADDRESS."
7656 (when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'"
7657 address)
7658 ;; Allow to use `gnus-button-fetch-group' in `browse-url-browser-function'
7659 ;; for nntp:// and news://
7660 (setq address (match-string 3 address)))
7126 (if (not (string-match "[:/]" address)) 7661 (if (not (string-match "[:/]" address))
7127 ;; This is just a simple group url. 7662 ;; This is just a simple group url.
7128 (gnus-group-read-ephemeral-group address gnus-select-method) 7663 (gnus-group-read-ephemeral-group address gnus-select-method)
@@ -7198,9 +7733,6 @@ specified by `gnus-button-alist'."
7198 7733
7199(defvar gnus-prev-page-map 7734(defvar gnus-prev-page-map
7200 (let ((map (make-sparse-keymap))) 7735 (let ((map (make-sparse-keymap)))
7201 (unless (>= emacs-major-version 21)
7202 ;; XEmacs doesn't care.
7203 (set-keymap-parent map gnus-article-mode-map))
7204 (define-key map gnus-mouse-2 'gnus-button-prev-page) 7736 (define-key map gnus-mouse-2 'gnus-button-prev-page)
7205 (define-key map "\r" 'gnus-button-prev-page) 7737 (define-key map "\r" 'gnus-button-prev-page)
7206 map)) 7738 map))
@@ -7215,19 +7747,23 @@ specified by `gnus-button-alist'."
7215 map)) 7747 map))
7216 7748
7217(defun gnus-insert-prev-page-button () 7749(defun gnus-insert-prev-page-button ()
7218 (let ((b (point)) 7750 (let ((b (point)) e
7219 (inhibit-read-only t)) 7751 (inhibit-read-only t))
7220 (gnus-eval-format 7752 (gnus-eval-format
7221 gnus-prev-page-line-format nil 7753 gnus-prev-page-line-format nil
7222 `(,@(gnus-local-map-property gnus-prev-page-map) 7754 `(keymap ,gnus-prev-page-map
7223 gnus-prev t 7755 gnus-prev t
7224 gnus-callback gnus-article-button-prev-page 7756 gnus-callback gnus-article-button-prev-page
7225 article-type annotation)) 7757 article-type annotation))
7758 (setq e (if (bolp)
7759 ;; Exclude a newline.
7760 (1- (point))
7761 (point)))
7762 (when gnus-article-button-face
7763 (gnus-overlay-put (gnus-make-overlay b e nil t)
7764 'face gnus-article-button-face))
7226 (widget-convert-button 7765 (widget-convert-button
7227 'link b (if (bolp) 7766 'link b e
7228 ;; Exclude a newline.
7229 (1- (point))
7230 (point))
7231 :action 'gnus-button-prev-page 7767 :action 'gnus-button-prev-page
7232 :button-keymap gnus-prev-page-map))) 7768 :button-keymap gnus-prev-page-map)))
7233 7769
@@ -7248,18 +7784,22 @@ specified by `gnus-button-alist'."
7248 (select-window win))) 7784 (select-window win)))
7249 7785
7250(defun gnus-insert-next-page-button () 7786(defun gnus-insert-next-page-button ()
7251 (let ((b (point)) 7787 (let ((b (point)) e
7252 (inhibit-read-only t)) 7788 (inhibit-read-only t))
7253 (gnus-eval-format gnus-next-page-line-format nil 7789 (gnus-eval-format gnus-next-page-line-format nil
7254 `(,@(gnus-local-map-property gnus-next-page-map) 7790 `(keymap ,gnus-next-page-map
7255 gnus-next t 7791 gnus-next t
7256 gnus-callback gnus-article-button-next-page 7792 gnus-callback gnus-article-button-next-page
7257 article-type annotation)) 7793 article-type annotation))
7794 (setq e (if (bolp)
7795 ;; Exclude a newline.
7796 (1- (point))
7797 (point)))
7798 (when gnus-article-button-face
7799 (gnus-overlay-put (gnus-make-overlay b e nil t)
7800 'face gnus-article-button-face))
7258 (widget-convert-button 7801 (widget-convert-button
7259 'link b (if (bolp) 7802 'link b e
7260 ;; Exclude a newline.
7261 (1- (point))
7262 (point))
7263 :action 'gnus-button-next-page 7803 :action 'gnus-button-next-page
7264 :button-keymap gnus-next-page-map))) 7804 :button-keymap gnus-next-page-map)))
7265 7805
@@ -7302,14 +7842,13 @@ For example:
7302 (eq gnus-newsgroup-name 7842 (eq gnus-newsgroup-name
7303 (car gnus-decode-header-methods-cache))) 7843 (car gnus-decode-header-methods-cache)))
7304 (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name)) 7844 (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
7305 (mapcar (lambda (x) 7845 (dolist (x gnus-decode-header-methods)
7306 (if (symbolp x) 7846 (if (symbolp x)
7307 (nconc gnus-decode-header-methods-cache (list x)) 7847 (nconc gnus-decode-header-methods-cache (list x))
7308 (if (and gnus-newsgroup-name 7848 (if (and gnus-newsgroup-name
7309 (string-match (car x) gnus-newsgroup-name)) 7849 (string-match (car x) gnus-newsgroup-name))
7310 (nconc gnus-decode-header-methods-cache 7850 (nconc gnus-decode-header-methods-cache
7311 (list (cdr x)))))) 7851 (list (cdr x)))))))
7312 gnus-decode-header-methods))
7313 (let ((xlist gnus-decode-header-methods-cache)) 7852 (let ((xlist gnus-decode-header-methods-cache))
7314 (pop xlist) 7853 (pop xlist)
7315 (save-restriction 7854 (save-restriction
@@ -7385,6 +7924,8 @@ For example:
7385 t) 7924 t)
7386 ((eq val 'head) 7925 ((eq val 'head)
7387 nil) 7926 nil)
7927 ((eq val 'first)
7928 (eq part-number 1))
7388 ((eq val 'last) 7929 ((eq val 'last)
7389 (eq part-number total-parts)) 7930 (eq part-number total-parts))
7390 ((numberp val) 7931 ((numberp val)
@@ -7485,14 +8026,51 @@ For example:
7485 (?d gnus-tmp-details ?s) 8026 (?d gnus-tmp-details ?s)
7486 (?D gnus-tmp-pressed-details ?s))) 8027 (?D gnus-tmp-pressed-details ?s)))
7487 8028
8029(defvar gnus-mime-security-button-commands
8030 '((gnus-article-press-button "\r" "Show Detail")
8031 (undefined "v")
8032 (undefined "t")
8033 (undefined "C")
8034 (gnus-mime-security-save-part "o" "Save...")
8035 (undefined "\C-o")
8036 (undefined "r")
8037 (undefined "d")
8038 (undefined "c")
8039 (undefined "i")
8040 (undefined "E")
8041 (undefined "e")
8042 (undefined "p")
8043 (gnus-mime-security-pipe-part "|" "Pipe To Command...")
8044 (undefined ".")))
8045
7488(defvar gnus-mime-security-button-map 8046(defvar gnus-mime-security-button-map
7489 (let ((map (make-sparse-keymap))) 8047 (let ((map (make-sparse-keymap)))
7490 (unless (>= (string-to-number emacs-version) 21)
7491 (set-keymap-parent map gnus-article-mode-map))
7492 (define-key map gnus-mouse-2 'gnus-article-push-button) 8048 (define-key map gnus-mouse-2 'gnus-article-push-button)
7493 (define-key map "\r" 'gnus-article-press-button) 8049 (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu)
8050 (dolist (c gnus-mime-security-button-commands)
8051 (define-key map (cadr c) (car c)))
7494 map)) 8052 map))
7495 8053
8054(easy-menu-define
8055 gnus-mime-security-button-menu gnus-mime-security-button-map
8056 "Security button menu."
8057 `("Security Part"
8058 ,@(delq nil
8059 (mapcar (lambda (c)
8060 (unless (eq (car c) 'undefined)
8061 (vector (caddr c) (car c) :active t)))
8062 gnus-mime-security-button-commands))))
8063
8064(defun gnus-mime-security-button-menu (event prefix)
8065 "Construct a context-sensitive menu of security commands."
8066 (interactive "e\nP")
8067 (save-window-excursion
8068 (let ((pos (event-start event)))
8069 (select-window (posn-window pos))
8070 (goto-char (posn-point pos))
8071 (gnus-article-check-buffer)
8072 (popup-menu gnus-mime-security-button-menu nil prefix))))
8073
7496(defvar gnus-mime-security-details-buffer nil) 8074(defvar gnus-mime-security-details-buffer nil)
7497 8075
7498(defvar gnus-mime-security-button-pressed nil) 8076(defvar gnus-mime-security-button-pressed nil)
@@ -7506,18 +8084,15 @@ For example:
7506 point (inhibit-read-only t)) 8084 point (inhibit-read-only t))
7507 (if region 8085 (if region
7508 (goto-char (car region))) 8086 (goto-char (car region)))
7509 (save-restriction 8087 (setq point (point))
7510 (narrow-to-region (point) (point)) 8088 (with-current-buffer (mm-handle-multipart-original-buffer handle)
7511 (with-current-buffer (mm-handle-multipart-original-buffer handle) 8089 (let* ((mm-verify-option 'known)
7512 (let* ((mm-verify-option 'known) 8090 (mm-decrypt-option 'known)
7513 (mm-decrypt-option 'known) 8091 (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
7514 (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) 8092 (unless (eq nparts (cdr handle))
7515 (unless (eq nparts (cdr handle)) 8093 (mm-destroy-parts (cdr handle))
7516 (mm-destroy-parts (cdr handle)) 8094 (setcdr handle nparts))))
7517 (setcdr handle nparts)))) 8095 (gnus-mime-display-security handle)
7518 (setq point (point))
7519 (gnus-mime-display-security handle)
7520 (goto-char (point-max)))
7521 (when region 8096 (when region
7522 (delete-region (point) (cdr region)) 8097 (delete-region (point) (cdr region))
7523 (set-marker (car region) nil) 8098 (set-marker (car region) nil)
@@ -7595,7 +8170,7 @@ For example:
7595 (gnus-eval-format 8170 (gnus-eval-format
7596 gnus-mime-security-button-line-format 8171 gnus-mime-security-button-line-format
7597 gnus-mime-security-button-line-format-alist 8172 gnus-mime-security-button-line-format-alist
7598 `(,@(gnus-local-map-property gnus-mime-security-button-map) 8173 `(keymap ,gnus-mime-security-button-map
7599 gnus-callback gnus-mime-security-press-button 8174 gnus-callback gnus-mime-security-press-button
7600 gnus-line-format ,gnus-mime-security-button-line-format 8175 gnus-line-format ,gnus-mime-security-button-line-format
7601 gnus-mime-details ,gnus-mime-security-button-pressed 8176 gnus-mime-details ,gnus-mime-security-button-pressed
@@ -7605,6 +8180,9 @@ For example:
7605 ;; Exclude a newline. 8180 ;; Exclude a newline.
7606 (1- (point)) 8181 (1- (point))
7607 (point))) 8182 (point)))
8183 (when gnus-article-button-face
8184 (gnus-overlay-put (gnus-make-overlay b e nil t)
8185 'face gnus-article-button-face))
7608 (widget-convert-button 8186 (widget-convert-button
7609 'link b e 8187 'link b e
7610 :mime-handle handle 8188 :mime-handle handle
@@ -7617,15 +8195,16 @@ For example:
7617 (when (boundp 'help-echo-owns-message) 8195 (when (boundp 'help-echo-owns-message)
7618 (setq help-echo-owns-message t)) 8196 (setq help-echo-owns-message t))
7619 (format 8197 (format
7620 "%S: show detail" 8198 "%S: show detail; %S: more options"
7621 (aref gnus-mouse-2 0)))))) 8199 (aref gnus-mouse-2 0)
8200 (aref gnus-down-mouse-3 0))))))
7622 8201
7623(defun gnus-mime-display-security (handle) 8202(defun gnus-mime-display-security (handle)
7624 (save-restriction 8203 (save-restriction
7625 (narrow-to-region (point) (point)) 8204 (narrow-to-region (point) (point))
7626 (unless (gnus-unbuttonized-mime-type-p (car handle)) 8205 (unless (gnus-unbuttonized-mime-type-p (car handle))
7627 (gnus-insert-mime-security-button handle)) 8206 (gnus-insert-mime-security-button handle))
7628 (gnus-mime-display-mixed (cdr handle)) 8207 (gnus-mime-display-part (cadr handle))
7629 (unless (bolp) 8208 (unless (bolp)
7630 (insert "\n")) 8209 (insert "\n"))
7631 (unless (gnus-unbuttonized-mime-type-p (car handle)) 8210 (unless (gnus-unbuttonized-mime-type-p (car handle))
@@ -7635,7 +8214,36 @@ For example:
7635 (mm-set-handle-multipart-parameter 8214 (mm-set-handle-multipart-parameter
7636 handle 'gnus-region 8215 handle 'gnus-region
7637 (cons (set-marker (make-marker) (point-min)) 8216 (cons (set-marker (make-marker) (point-min))
7638 (set-marker (make-marker) (point-max)))))) 8217 (set-marker (make-marker) (point-max))))
8218 (goto-char (point-max))))
8219
8220(defun gnus-mime-security-run-function (function)
8221 "Run FUNCTION with the security part under point."
8222 (gnus-article-check-buffer)
8223 (let ((data (get-text-property (point) 'gnus-data))
8224 buffer handle)
8225 (when (and (stringp (car-safe data))
8226 (setq buffer (mm-handle-multipart-original-buffer data))
8227 (setq handle (cadr data)))
8228 (if (bufferp (mm-handle-buffer handle))
8229 (progn
8230 (setq handle (cons buffer (copy-sequence (cdr handle))))
8231 (mm-handle-set-undisplayer handle nil))
8232 (setq handle (mm-make-handle
8233 buffer
8234 (mm-handle-multipart-ctl-parameter handle 'protocol)
8235 nil nil nil nil nil nil)))
8236 (funcall function handle))))
8237
8238(defun gnus-mime-security-save-part ()
8239 "Save the security part under point."
8240 (interactive)
8241 (gnus-mime-security-run-function 'mm-save-part))
8242
8243(defun gnus-mime-security-pipe-part ()
8244 "Pipe the security part under point to a process."
8245 (interactive)
8246 (gnus-mime-security-run-function 'mm-pipe-part))
7639 8247
7640(gnus-ems-redefine) 8248(gnus-ems-redefine)
7641 8249
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index a06724855c5..65189573da3 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -33,10 +33,6 @@
33(require 'gnus-sum) 33(require 'gnus-sum)
34(require 'nntp) 34(require 'nntp)
35 35
36(eval-when-compile
37 (when (featurep 'xemacs)
38 (require 'timer-funcs)))
39
40(defgroup gnus-asynchronous nil 36(defgroup gnus-asynchronous nil
41 "Support for asynchronous operations." 37 "Support for asynchronous operations."
42 :group 'gnus) 38 :group 'gnus)
@@ -274,28 +270,29 @@ It should return non-nil if the article is to be prefetched."
274 (nntp-server-buffer (current-buffer)) 270 (nntp-server-buffer (current-buffer))
275 (nntp-have-messaged nil) 271 (nntp-have-messaged nil)
276 (tries 0)) 272 (tries 0))
277 (condition-case nil 273 (when proc
278 ;; FIXME: we could stop waiting after some 274 (condition-case nil
279 ;; timeout, but this is the wrong place to do it. 275 ;; FIXME: we could stop waiting after some
280 ;; rather than checking time-spent-waiting, we 276 ;; timeout, but this is the wrong place to do it.
281 ;; should check time-since-last-output, which 277 ;; rather than checking time-spent-waiting, we
282 ;; needs to be done in nntp.el. 278 ;; should check time-since-last-output, which
283 (while (eq article gnus-async-current-prefetch-article) 279 ;; needs to be done in nntp.el.
284 (incf tries) 280 (while (eq article gnus-async-current-prefetch-article)
285 (when (nntp-accept-process-output proc) 281 (incf tries)
286 (setq tries 0)) 282 (when (nntp-accept-process-output proc)
287 (when (and (not nntp-have-messaged) 283 (setq tries 0))
288 (= tries 3)) 284 (when (and (not nntp-have-messaged)
289 (gnus-message 5 "Waiting for async article...") 285 (= tries 3))
290 (setq nntp-have-messaged t))) 286 (gnus-message 5 "Waiting for async article...")
291 (quit 287 (setq nntp-have-messaged t)))
292 ;; if the user interrupted on a slow/hung connection, 288 (quit
293 ;; do something friendly. 289 ;; if the user interrupted on a slow/hung connection,
294 (when (> tries 3) 290 ;; do something friendly.
295 (setq gnus-async-current-prefetch-article nil)) 291 (when (> tries 3)
296 (signal 'quit nil))) 292 (setq gnus-async-current-prefetch-article nil))
297 (when nntp-have-messaged 293 (signal 'quit nil)))
298 (gnus-message 5 ""))))) 294 (when nntp-have-messaged
295 (gnus-message 5 ""))))))
299 296
300(defun gnus-async-delete-prefetched-entry (entry) 297(defun gnus-async-delete-prefetched-entry (entry)
301 "Delete ENTRY from buffer and alist." 298 "Delete ENTRY from buffer and alist."
@@ -311,13 +308,11 @@ It should return non-nil if the article is to be prefetched."
311 "Remove all articles belonging to GROUP from the prefetch buffer." 308 "Remove all articles belonging to GROUP from the prefetch buffer."
312 (when (and (gnus-group-asynchronous-p group) 309 (when (and (gnus-group-asynchronous-p group)
313 (memq 'exit gnus-prefetched-article-deletion-strategy)) 310 (memq 'exit gnus-prefetched-article-deletion-strategy))
314 (let ((alist gnus-async-article-alist)) 311 (save-excursion
315 (save-excursion 312 (gnus-async-set-buffer)
316 (gnus-async-set-buffer) 313 (dolist (entry gnus-async-article-alist)
317 (while alist 314 (when (equal group (nth 3 entry))
318 (when (equal group (nth 3 (car alist))) 315 (gnus-async-delete-prefetched-entry entry))))))
319 (gnus-async-delete-prefetched-entry (car alist)))
320 (pop alist))))))
321 316
322(defun gnus-async-prefetched-article-entry (group article) 317(defun gnus-async-prefetched-article-entry (group article)
323 "Return the entry for ARTICLE in GROUP if it has been prefetched." 318 "Return the entry for ARTICLE in GROUP if it has been prefetched."
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
new file mode 100644
index 00000000000..1e76e3ac57b
--- /dev/null
+++ b/lisp/gnus/gnus-bookmark.el
@@ -0,0 +1,826 @@
1;;; gnus-bookmark.el --- Bookmarks in Gnus
2
3;; Copyright (C) 2006 Free Software Foundation, Inc.
4
5;; Author: Bastien Guerry <bzg AT altern DOT org>
6;; Keywords: news
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 3, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This file implements real bookmarks for Gnus, closely following the way
28;; `bookmark.el' handles bookmarks. Most of the code comes from
29;; `bookmark.el'.
30;;
31;; Set a Gnus bookmark:
32;; M-x `gnus-bookmark-set' from the summary buffer.
33;;
34;; Jump to a Gnus bookmark:
35;; M-x `gnus-bookmark-jump'.
36;;
37;; Display a list of bookmarks
38;; M-x `gnus-bookmark-bmenu-list'.
39;;
40
41;;; Todo:
42
43;; - add tags to bookmarks
44;; - don't write file each time a bookmark is created
45;; - better annotation interactive buffer
46;; - edit annotation in gnus-bookmark-bmenu
47;; - sort gnus-bookmark-buffer by author/subject/date/group/message-id
48;; - auto-bmk-name customizable format
49;; - renaming bookmarks in gnus-bookmark-bmenu-list
50;; - better (formatted string) display in bmenu-list
51
52;; - Integrate the `gnus-summary-*-bookmark' functionality
53;; - Initialize defcustoms from corresponding `bookmark.el' variables?
54
55;;; Code:
56
57(require 'gnus-sum)
58
59;; FIXME: should avoid using C-c (no?)
60;; (define-key gnus-summary-mode-map "\C-crm" 'gnus-bookmark-set)
61;; (define-key global-map "\C-crb" 'gnus-bookmark-jump)
62;; (define-key global-map "\C-crj" 'gnus-bookmark-jump)
63;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list)
64
65(defgroup gnus-bookmark nil
66 "Setting, annotation and jumping to Gnus bookmarks."
67 :group 'gnus)
68
69(defcustom gnus-bookmark-default-file
70 (cond
71 ;; Backward compatibility with previous versions:
72 ((file-exists-p "~/.gnus.bmk") "~/.gnus.bmk")
73 (t (nnheader-concat gnus-directory "bookmarks.el")))
74 "The default Gnus bookmarks file."
75 :type 'string
76 :group 'gnus-bookmark)
77
78(defcustom gnus-bookmark-file-coding-system
79 (if (mm-coding-system-p 'iso-2022-7bit)
80 'iso-2022-7bit)
81 "Coding system used for writing Gnus bookmark files."
82 :type '(symbol :tag "Coding system")
83 :group 'gnus-bookmark)
84
85(defcustom gnus-bookmark-sort-flag t
86 "Non-nil means Gnus bookmarks are sorted by bookmark names.
87Otherwise they will be displayed in LIFO order (that is,
88most recently set ones come first, oldest ones come last)."
89 :type 'boolean
90 :group 'gnus-bookmark)
91
92(defcustom gnus-bookmark-bmenu-toggle-infos t
93 "Non-nil means show details when listing Gnus bookmarks.
94List of details is defined in `gnus-bookmark-bookmark-inline-details'.
95This may result in truncated bookmark names. To disable this, put the
96following in your `.emacs' file:
97
98\(setq gnus-bookmark-bmenu-toggle-infos nil\)"
99 :type 'boolean
100 :group 'gnus-bookmark)
101
102(defcustom gnus-bookmark-bmenu-file-column 30
103 "Column at which to display details in a buffer listing Gnus bookmarks.
104You can toggle whether details are shown with \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-toggle-infos]."
105 :type 'integer
106 :group 'gnus-bookmark)
107
108(defcustom gnus-bookmark-use-annotations nil
109 "If non-nil, ask for an annotation when setting a bookmark."
110 :type 'boolean
111 :group 'gnus-bookmark)
112
113(defcustom gnus-bookmark-bookmark-inline-details '(author)
114 "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'.
115The default value is \(subject\)."
116 :type '(list :tag "Gnus bookmark details"
117 (set :inline t
118 (const :tag "Author" author)
119 (const :tag "Subject" subject)
120 (const :tag "Date" date)
121 (const :tag "Group" group)
122 (const :tag "Message-id" message-id)))
123 :group 'gnus-bookmark)
124
125(defcustom gnus-bookmark-bookmark-details
126 '(author subject date group annotation)
127 "Details to be shown with `gnus-bookmark-bmenu-show-details'.
128The default value is \(author subject date group annotation\)."
129 :type '(list :tag "Gnus bookmark details"
130 (set :inline t
131 (const :tag "Author" author)
132 (const :tag "Subject" subject)
133 (const :tag "Date" date)
134 (const :tag "Group" group)
135 (const :tag "Message-id" message-id)
136 (const :tag "Annotation" annotation)))
137 :group 'gnus-bookmark)
138
139(defface gnus-bookmark-menu-heading
140 '((t (:inherit font-lock-type-face)))
141 "Face used to highlight the heading in Gnus bookmark menu buffers."
142 :version "23.0" ;; No Gnus
143 :group 'gnus-bookmark)
144
145(defconst gnus-bookmark-end-of-version-stamp-marker
146 "-*- End Of Bookmark File Format Version Stamp -*-\n"
147 "This string marks the end of the version stamp in a Gnus bookmark file.")
148
149(defconst gnus-bookmark-file-format-version 0
150 "The current version of the format used by bookmark files.
151You should never need to change this.")
152
153(defvar gnus-bookmark-after-jump-hook nil
154 "Hook run after `gnus-bookmark-jump' jumps to a Gnus bookmark.")
155
156(defvar gnus-bookmark-alist ()
157 "Association list of Gnus bookmarks and their records.
158The format of the alist is
159
160 \(BMK1 BMK2 ...\)
161
162where each BMK is of the form
163
164\(NAME
165 \(group . GROUP\)
166 \(message-id . MESSAGE-ID\)
167 \(author . AUTHOR\)
168 \(date . DATE\)
169 \(subject . SUBJECT\)
170 \(annotation . ANNOTATION\)\)
171
172So the cdr of each bookmark is an alist too.")
173
174(defmacro gnus-bookmark-mouse-available-p ()
175 "Return non-nil if a mouse is available."
176 (if (featurep 'xemacs)
177 '(and (eq (device-class) 'color) (device-on-window-system-p))
178 '(and (display-color-p) (display-mouse-p))))
179
180(defun gnus-bookmark-remove-properties (string)
181 "Remove all text properties from STRING."
182 (set-text-properties 0 (length string) nil string)
183 string)
184
185;;;###autoload
186(defun gnus-bookmark-set ()
187 "Set a bookmark for this article."
188 (interactive)
189 (gnus-bookmark-maybe-load-default-file)
190 (if (or (not (eq major-mode 'gnus-summary-mode))
191 (not gnus-article-current))
192 (error "Please select an article in the Gnus summary buffer")
193 (let* ((group (car gnus-article-current))
194 (article (cdr gnus-article-current))
195 (header (gnus-summary-article-header article))
196 (author (mail-header-from header))
197 (message-id (mail-header-id header))
198 (date (mail-header-date header))
199 (subject (gnus-summary-subject-string))
200 (bmk-name (gnus-bookmark-set-bookmark-name group author subject))
201 ;; Maybe ask for annotation
202 (annotation
203 (if gnus-bookmark-use-annotations
204 (read-from-minibuffer
205 (format "Annotation for %s: " bmk-name)) "")))
206 ;; Set the bookmark list
207 (setq gnus-bookmark-alist
208 (cons
209 (list (gnus-bookmark-remove-properties bmk-name)
210 (gnus-bookmark-make-cell
211 group message-id author date subject annotation))
212 gnus-bookmark-alist))))
213 (gnus-bookmark-bmenu-surreptitiously-rebuild-list)
214 (gnus-bookmark-write-file))
215
216(defun gnus-bookmark-make-cell
217 (group message-id author date subject annotation)
218 "Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION."
219 (let ((the-record
220 `((group . ,(gnus-bookmark-remove-properties group))
221 (message-id . ,(gnus-bookmark-remove-properties message-id))
222 (author . ,(gnus-bookmark-remove-properties author))
223 (date . ,(gnus-bookmark-remove-properties date))
224 (subject . ,(gnus-bookmark-remove-properties subject))
225 (annotation . ,(gnus-bookmark-remove-properties annotation)))))
226 the-record))
227
228(defun gnus-bookmark-set-bookmark-name (group author subject)
229 "Set bookmark name from GROUP AUTHOR and SUBJECT."
230 (let* ((subject (split-string subject))
231 (default-name-0 ;; Should be merged with -1?
232 (concat (car (nreverse (delete "" (split-string group "[\\.:]"))))
233 "-" (car (split-string author))
234 "-" (car subject) "-" (cadr subject)))
235 (default-name-1
236 ;; Strip "[]" chars from the bookmark name:
237 (gnus-replace-in-string default-name-0 "[]_[]" ""))
238 (name (read-from-minibuffer
239 (format "Set bookmark (%s): " default-name-1)
240 nil nil nil nil
241 default-name-1)))
242 (if (string-equal name "")
243 default-name-1
244 name)))
245
246(defun gnus-bookmark-write-file ()
247 "Write currently defined Gnus bookmarks into `gnus-bookmark-default-file'."
248 (interactive)
249 (save-excursion
250 (save-window-excursion
251 ;; Avoir warnings?
252 ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
253 (set-buffer (get-buffer-create " *Gnus bookmarks*"))
254 (erase-buffer)
255 (gnus-bookmark-insert-file-format-version-stamp)
256 (pp gnus-bookmark-alist (current-buffer))
257 (condition-case nil
258 (let ((coding-system-for-write gnus-bookmark-file-coding-system))
259 (write-region (point-min) (point-max)
260 gnus-bookmark-default-file))
261 (file-error (message "Can't write %s"
262 gnus-bookmark-default-file)))
263 (kill-buffer (current-buffer))
264 (message
265 "Saving Gnus bookmarks to file %s...done"
266 gnus-bookmark-default-file))))
267
268(defun gnus-bookmark-insert-file-format-version-stamp ()
269 "Insert text indicating current version of Gnus bookmark file format."
270 (insert
271 (format ";;;; Gnus Bookmark Format Version %d %s;;;;\n"
272 gnus-bookmark-file-format-version
273 (if gnus-bookmark-file-coding-system
274 (concat "-*- coding: "
275 (symbol-name gnus-bookmark-file-coding-system)
276 "; -*- ")
277 "")))
278 (insert ";;; This format is meant to be slightly human-readable;\n"
279 ";;; nevertheless, you probably don't want to edit it.\n"
280 ";;; "
281 gnus-bookmark-end-of-version-stamp-marker))
282
283;;;###autoload
284(defun gnus-bookmark-jump (&optional bmk-name)
285 "Jump to a Gnus bookmark (BMK-NAME)."
286 (interactive)
287 (gnus-bookmark-maybe-load-default-file)
288 (let* ((bookmark (or bmk-name
289 (completing-read "Jump to bookmarked article: "
290 gnus-bookmark-alist)))
291 (bmk-cell (cadr (assoc bookmark gnus-bookmark-alist)))
292 (group (cdr (assoc 'group bmk-cell)))
293 (message-id (cdr (assoc 'message-id bmk-cell))))
294 (when group
295 (unless (get-buffer gnus-group-buffer)
296 (gnus-no-server))
297 (gnus-activate-group group)
298 (gnus-group-quick-select-group 0 group))
299 (if message-id
300 (or (gnus-summary-goto-article message-id nil 'force)
301 (if (fboundp 'gnus-summary-insert-cached-articles)
302 (progn
303 (gnus-summary-insert-cached-articles)
304 (gnus-summary-goto-article message-id nil 'force))
305 (message "Message could not be found."))))))
306
307(defvar gnus-bookmark-already-loaded nil)
308
309(defun gnus-bookmark-alist-from-buffer ()
310 "Return a `gnus-bookmark-alist' from the current buffer.
311The buffer must of course contain Gnus bookmark format information.
312Does not care from where in the buffer it is called, and does not
313affect point."
314 (save-excursion
315 (goto-char (point-min))
316 (if (search-forward
317 gnus-bookmark-end-of-version-stamp-marker nil t)
318 (read (current-buffer))
319 ;; Else no hope of getting information here.
320 (error "Not Gnus bookmark format"))))
321
322(defun gnus-bookmark-load (file)
323 "Load Gnus bookmarks from FILE (which must be in bookmark format)."
324 (interactive
325 (list (read-file-name
326 (format "Load Gnus bookmarks from: (%s) "
327 gnus-bookmark-default-file)
328 "~/" gnus-bookmark-default-file 'confirm)))
329 (setq file (expand-file-name file))
330 (if (file-readable-p file)
331 (save-excursion
332 (save-window-excursion
333 (set-buffer (let ((enable-local-variables nil))
334 (find-file-noselect file)))
335 (goto-char (point-min))
336 (let ((blist (gnus-bookmark-alist-from-buffer)))
337 (if (listp blist)
338 (progn (setq gnus-bookmark-already-loaded t)
339 (setq gnus-bookmark-alist blist))
340 (error "Not Gnus bookmark format")))))))
341
342(defun gnus-bookmark-maybe-load-default-file ()
343 "Maybe load Gnus bookmarks in `gnus-bookmark-alist'."
344 (and (not gnus-bookmark-already-loaded)
345 (null gnus-bookmark-alist)
346 (file-readable-p (expand-file-name gnus-bookmark-default-file))
347 (gnus-bookmark-load gnus-bookmark-default-file)))
348
349(defun gnus-bookmark-maybe-sort-alist ()
350 "Return the gnus-bookmark-alist for display.
351If the gnus-bookmark-sort-flag is non-nil, then return a sorted
352copy of the alist."
353 (when gnus-bookmark-sort-flag
354 (setq gnus-bookmark-alist
355 (sort (copy-alist gnus-bookmark-alist)
356 (function
357 (lambda (x y) (string-lessp (car x) (car y))))))))
358
359;;;###autoload
360(defun gnus-bookmark-bmenu-list ()
361 "Display a list of existing Gnus bookmarks.
362The list is displayed in a buffer named `*Gnus Bookmark List*'.
363The leftmost column displays a D if the bookmark is flagged for
364deletion, or > if it is flagged for displaying."
365 (interactive)
366 (gnus-bookmark-maybe-load-default-file)
367 (if (interactive-p)
368 (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
369 (set-buffer (get-buffer-create "*Gnus Bookmark List*")))
370 (let ((inhibit-read-only t)
371 alist name start end)
372 (erase-buffer)
373 (insert "% Gnus Bookmark\n- --------\n")
374 (add-text-properties (point-min) (point)
375 '(font-lock-face gnus-bookmark-menu-heading))
376 ;; sort before displaying
377 (gnus-bookmark-maybe-sort-alist)
378 ;; Display gnus bookmarks
379 (setq alist gnus-bookmark-alist)
380 (while alist
381 (setq name (gnus-bookmark-name-from-full-record (pop alist)))
382 ;; if a Gnus bookmark has an annotation, prepend a "*"
383 ;; in the list of bookmarks.
384 (insert (if (member (gnus-bookmark-get-annotation name) (list nil ""))
385 " "
386 " *"))
387 (if (gnus-bookmark-mouse-available-p)
388 (add-text-properties
389 (prog1
390 (point)
391 (insert name))
392 (let ((end (point)))
393 (prog2
394 (re-search-backward "[^ \t]")
395 (1+ (point))
396 (goto-char end)
397 (insert "\n")))
398 `(mouse-face highlight follow-link t
399 help-echo ,(format "%s: go to this article"
400 (aref gnus-mouse-2 0))))
401 (insert name "\n")))
402 (goto-char (point-min))
403 (forward-line 2)
404 (gnus-bookmark-bmenu-mode)
405 (if gnus-bookmark-bmenu-toggle-infos
406 (gnus-bookmark-bmenu-toggle-infos t))))
407
408(defun gnus-bookmark-bmenu-surreptitiously-rebuild-list ()
409 "Rebuild the Bookmark List if it exists.
410Don't affect the buffer ring order."
411 (if (get-buffer "*Gnus Bookmark List*")
412 (save-excursion
413 (save-window-excursion
414 (gnus-bookmark-bmenu-list)))))
415
416(defun gnus-bookmark-get-annotation (bookmark)
417 "Return the annotation of Gnus BOOKMARK, or nil if none."
418 (cdr (assq 'annotation (gnus-bookmark-get-bookmark-record bookmark))))
419
420(defun gnus-bookmark-get-bookmark (bookmark)
421 "Return the full entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
422If BOOKMARK is not a string, return nil."
423 (when (stringp bookmark)
424 (assoc bookmark gnus-bookmark-alist)))
425
426(defun gnus-bookmark-get-bookmark-record (bookmark)
427 "Return the guts of the entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
428That is, all information but the name."
429 (car (cdr (gnus-bookmark-get-bookmark bookmark))))
430
431(defun gnus-bookmark-name-from-full-record (full-record)
432 "Return name of FULL-RECORD \(an alist element instead of a string\)."
433 (car full-record))
434
435(defvar gnus-bookmark-bmenu-bookmark-column nil)
436(defvar gnus-bookmark-bmenu-hidden-bookmarks ())
437(defvar gnus-bookmark-bmenu-mode-map nil)
438
439(if gnus-bookmark-bmenu-mode-map
440 nil
441 (setq gnus-bookmark-bmenu-mode-map (make-keymap))
442 (suppress-keymap gnus-bookmark-bmenu-mode-map t)
443 (define-key gnus-bookmark-bmenu-mode-map "q" (if (fboundp 'quit-window)
444 'quit-window
445 'bury-buffer))
446 (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select)
447 (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select)
448 (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete)
449 (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete)
450 (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards)
451 (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions)
452 (define-key gnus-bookmark-bmenu-mode-map " " 'next-line)
453 (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line)
454 (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line)
455 (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark)
456 (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode)
457 (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark)
458 (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark)
459 (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load)
460 (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save)
461 (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos)
462 (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details)
463 (define-key gnus-bookmark-bmenu-mode-map gnus-mouse-2
464 'gnus-bookmark-bmenu-select-by-mouse))
465
466;; Bookmark Buffer Menu mode is suitable only for specially formatted
467;; data.
468(put 'gnus-bookmark-bmenu-mode 'mode-class 'special)
469
470;; Been to lazy to use gnus-bookmark-save...
471(defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
472
473(defun gnus-bookmark-bmenu-mode ()
474 "Major mode for editing a list of Gnus bookmarks.
475Each line describes one of the bookmarks in Gnus.
476Letters do not insert themselves; instead, they are commands.
477Gnus bookmarks names preceded by a \"*\" have annotations.
478\\<gnus-bookmark-bmenu-mode-map>
479\\[gnus-bookmark-bmenu-mark] -- mark bookmark to be displayed.
480\\[gnus-bookmark-bmenu-select] -- select bookmark of line point is on.
481 Also show bookmarks marked using m in other windows.
482\\[gnus-bookmark-bmenu-toggle-infos] -- toggle displaying of details (they may obscure long bookmark names).
483\\[gnus-bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
484\\[gnus-bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
485\\[gnus-bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
486\\[gnus-bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
487\\[gnus-bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[gnus-bookmark-bmenu-delete]'.
488\\[gnus-bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
489\\[gnus-bookmark-bmenu-save] -- load in a file of bookmarks (prompts for file.)
490\\[gnus-bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
491 With prefix argument, also move up one line.
492\\[gnus-bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
493\\[gnus-bookmark-bmenu-show-details] -- show the annotation, if it exists, for the current bookmark
494 in another buffer.
495\\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
496\\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
497 (kill-all-local-variables)
498 (use-local-map gnus-bookmark-bmenu-mode-map)
499 (setq truncate-lines t)
500 (setq buffer-read-only t)
501 (setq major-mode 'gnus-bookmark-bmenu-mode)
502 (setq mode-name "Bookmark Menu")
503 (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook))
504
505;; avoid compilation warnings
506(defvar gnus-bookmark-bmenu-toggle-infos nil)
507
508(defun gnus-bookmark-bmenu-toggle-infos (&optional show)
509 "Toggle whether details are shown in the Gnus bookmark list.
510Optional argument SHOW means show them unconditionally."
511 (interactive)
512 (cond
513 (show
514 (setq gnus-bookmark-bmenu-toggle-infos nil)
515 (gnus-bookmark-bmenu-show-infos)
516 (setq gnus-bookmark-bmenu-toggle-infos t))
517 (gnus-bookmark-bmenu-toggle-infos
518 (gnus-bookmark-bmenu-hide-infos)
519 (setq gnus-bookmark-bmenu-toggle-infos nil))
520 (t
521 (gnus-bookmark-bmenu-show-infos)
522 (setq gnus-bookmark-bmenu-toggle-infos t))))
523
524(defun gnus-bookmark-bmenu-show-infos (&optional force)
525 "Show infos in bmenu, maybe FORCE display of infos."
526 (if (and (not force) gnus-bookmark-bmenu-toggle-infos)
527 nil ;already shown, so do nothing
528 (save-excursion
529 (save-window-excursion
530 (goto-char (point-min))
531 (forward-line 2)
532 (setq gnus-bookmark-bmenu-hidden-bookmarks ())
533 (let ((inhibit-read-only t))
534 (while (< (point) (point-max))
535 (let ((bmrk (gnus-bookmark-bmenu-bookmark)))
536 (setq gnus-bookmark-bmenu-hidden-bookmarks
537 (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks))
538 (let ((start (save-excursion (end-of-line) (point))))
539 (move-to-column gnus-bookmark-bmenu-file-column t)
540 ;; Strip off `mouse-face' from the white spaces region.
541 (if (gnus-bookmark-mouse-available-p)
542 (remove-text-properties start (point)
543 '(mouse-face nil help-echo nil))))
544 (delete-region (point) (progn (end-of-line) (point)))
545 (insert " ")
546 ;; Pass the NO-HISTORY arg:
547 (gnus-bookmark-insert-details bmrk)
548 (forward-line 1))))))))
549
550(defun gnus-bookmark-insert-details (bmk-name)
551 "Insert the details of the article associated with BMK-NAME."
552 (let ((start (point)))
553 (prog1
554 (insert (gnus-bookmark-get-details
555 bmk-name
556 gnus-bookmark-bookmark-inline-details))
557 (if (gnus-bookmark-mouse-available-p)
558 (add-text-properties
559 start
560 (save-excursion (re-search-backward
561 "[^ \t]")
562 (1+ (point)))
563 `(mouse-face highlight
564 follow-link t
565 help-echo ,(format "%s: go to this article"
566 (aref gnus-mouse-2 0))))))))
567
568(defun gnus-bookmark-kill-line (&optional newline-too)
569 "Kill from point to end of line.
570If optional arg NEWLINE-TOO is non-nil, delete the newline too.
571Does not affect the kill ring."
572 (let ((eol (save-excursion (end-of-line) (point))))
573 (delete-region (point) eol)
574 (if (and newline-too (looking-at "\n"))
575 (delete-char 1))))
576
577(defun gnus-bookmark-get-details (bmk-name details-list)
578 "Get details for a Gnus BMK-NAME depending on DETAILS-LIST."
579 (let ((details (cadr (assoc bmk-name gnus-bookmark-alist))))
580 (mapconcat
581 (lambda (info)
582 (cdr (assoc info details)))
583 details-list " | ")))
584
585(defun gnus-bookmark-bmenu-hide-infos (&optional force)
586 "Hide infos in bmenu, maybe FORCE."
587 (if (and (not force) gnus-bookmark-bmenu-toggle-infos)
588 ;; nothing to hide if above is nil
589 (save-excursion
590 (save-window-excursion
591 (goto-char (point-min))
592 (forward-line 2)
593 (setq gnus-bookmark-bmenu-hidden-bookmarks
594 (nreverse gnus-bookmark-bmenu-hidden-bookmarks))
595 (save-excursion
596 (goto-char (point-min))
597 (search-forward "Gnus Bookmark")
598 (backward-word 2)
599 (setq gnus-bookmark-bmenu-bookmark-column (current-column)))
600 (save-excursion
601 (let ((inhibit-read-only t))
602 (while gnus-bookmark-bmenu-hidden-bookmarks
603 (move-to-column gnus-bookmark-bmenu-bookmark-column t)
604 (gnus-bookmark-kill-line)
605 (let ((start (point)))
606 (insert (car gnus-bookmark-bmenu-hidden-bookmarks))
607 (if (gnus-bookmark-mouse-available-p)
608 (add-text-properties
609 start
610 (save-excursion (re-search-backward
611 "[^ \t]")
612 (1+ (point)))
613 `(mouse-face highlight
614 follow-link t
615 help-echo
616 ,(format "%s: go to this bookmark in other window"
617 (aref gnus-mouse-2 0))))))
618 (setq gnus-bookmark-bmenu-hidden-bookmarks
619 (cdr gnus-bookmark-bmenu-hidden-bookmarks))
620 (forward-line 1))))))))
621
622(defun gnus-bookmark-bmenu-check-position ()
623 "Return non-nil if on a line with a bookmark.
624The actual value returned is gnus-bookmark-alist. Else
625reposition and try again, else return nil."
626 (cond ((< (count-lines (point-min) (point)) 2)
627 (goto-char (point-min))
628 (forward-line 2)
629 gnus-bookmark-alist)
630 ((and (bolp) (eobp))
631 (beginning-of-line 0)
632 gnus-bookmark-alist)
633 (t
634 gnus-bookmark-alist)))
635
636(defun gnus-bookmark-bmenu-bookmark ()
637 "Return a string which is bookmark of this line."
638 (if (gnus-bookmark-bmenu-check-position)
639 (save-excursion
640 (save-window-excursion
641 (goto-char (point-min))
642 (search-forward "Gnus Bookmark")
643 (backward-word 2)
644 (setq gnus-bookmark-bmenu-bookmark-column (current-column)))))
645 (if gnus-bookmark-bmenu-toggle-infos
646 (gnus-bookmark-bmenu-hide-infos))
647 (save-excursion
648 (save-window-excursion
649 (beginning-of-line)
650 (forward-char gnus-bookmark-bmenu-bookmark-column)
651 (prog1
652 (buffer-substring-no-properties (point)
653 (progn
654 (end-of-line)
655 (point)))
656 ;; well, this is certainly crystal-clear:
657 (if gnus-bookmark-bmenu-toggle-infos
658 (gnus-bookmark-bmenu-toggle-infos t))))))
659
660(defun gnus-bookmark-show-details (bookmark)
661 "Display the annotation for BOOKMARK in a buffer."
662 (let ((record (gnus-bookmark-get-bookmark-record bookmark))
663 (old-buf (current-buffer))
664 (details gnus-bookmark-bookmark-details)
665 detail)
666 (save-excursion
667 (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
668 (erase-buffer)
669 (while details
670 (setq detail (pop details))
671 (unless (equal (cdr (assoc detail record)) "")
672 (insert (symbol-name detail) ": " (cdr (assoc detail record)) "\n")))
673 (goto-char (point-min))
674 (pop-to-buffer old-buf))))
675
676(defun gnus-bookmark-bmenu-show-details ()
677 "Show the annotation for the current bookmark in another window."
678 (interactive)
679 (let ((bookmark (gnus-bookmark-bmenu-bookmark)))
680 (if (gnus-bookmark-bmenu-check-position)
681 (gnus-bookmark-show-details bookmark))))
682
683(defun gnus-bookmark-bmenu-mark ()
684 "Mark bookmark on this line to be displayed by \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-select]."
685 (interactive)
686 (beginning-of-line)
687 (if (gnus-bookmark-bmenu-check-position)
688 (let ((inhibit-read-only t))
689 (delete-char 1)
690 (insert ?>)
691 (forward-line 1)
692 (gnus-bookmark-bmenu-check-position))))
693
694(defun gnus-bookmark-bmenu-unmark (&optional backup)
695 "Cancel all requested operations on bookmark on this line and move down.
696Optional BACKUP means move up."
697 (interactive "P")
698 (beginning-of-line)
699 (if (gnus-bookmark-bmenu-check-position)
700 (progn
701 (let ((inhibit-read-only t))
702 (delete-char 1)
703 ;; any flags to reset according to circumstances? How about a
704 ;; flag indicating whether this bookmark is being visited?
705 ;; well, we don't have this now, so maybe later.
706 (insert " "))
707 (forward-line (if backup -1 1))
708 (gnus-bookmark-bmenu-check-position))))
709
710(defun gnus-bookmark-bmenu-backup-unmark ()
711 "Move up and cancel all requested operations on bookmark on line above."
712 (interactive)
713 (forward-line -1)
714 (if (gnus-bookmark-bmenu-check-position)
715 (progn
716 (gnus-bookmark-bmenu-unmark)
717 (forward-line -1)
718 (gnus-bookmark-bmenu-check-position))))
719
720(defun gnus-bookmark-bmenu-delete ()
721 "Mark Gnus bookmark on this line to be deleted.
722To carry out the deletions that you've marked, use
723\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
724 (interactive)
725 (beginning-of-line)
726 (if (gnus-bookmark-bmenu-check-position)
727 (let ((inhibit-read-only t))
728 (delete-char 1)
729 (insert ?D)
730 (forward-line 1)
731 (gnus-bookmark-bmenu-check-position))))
732
733(defun gnus-bookmark-bmenu-delete-backwards ()
734 "Mark bookmark on this line to be deleted, then move up one line.
735To carry out the deletions that you've marked, use
736\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
737 (interactive)
738 (gnus-bookmark-bmenu-delete)
739 (forward-line -2)
740 (if (gnus-bookmark-bmenu-check-position)
741 (forward-line 1))
742 (gnus-bookmark-bmenu-check-position))
743
744(defun gnus-bookmark-bmenu-select ()
745 "Select this line's bookmark; also display bookmarks marked with `>'.
746You can mark bookmarks with the
747\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark]
748command."
749 (interactive)
750 (if (gnus-bookmark-bmenu-check-position)
751 (let ((bmrk (gnus-bookmark-bmenu-bookmark))
752 (menu (current-buffer)))
753 (goto-char (point-min))
754 (delete-other-windows)
755 (gnus-bookmark-jump bmrk)
756 (bury-buffer menu))))
757
758(defun gnus-bookmark-bmenu-select-by-mouse (event)
759 (interactive "e")
760 (mouse-set-point event)
761 (gnus-bookmark-bmenu-select))
762
763(defun gnus-bookmark-bmenu-load ()
764 "Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
765 (interactive)
766 (if (gnus-bookmark-bmenu-check-position)
767 (save-excursion
768 (save-window-excursion
769 ;; This will call `gnus-bookmark-bmenu-list'
770 (call-interactively 'gnus-bookmark-load)))))
771
772(defun gnus-bookmark-bmenu-execute-deletions ()
773 "Delete Gnus bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
774 (interactive)
775 (message "Deleting Gnus bookmarks...")
776 (let ((hide-em gnus-bookmark-bmenu-toggle-infos)
777 (o-point (point))
778 (o-str (save-excursion
779 (beginning-of-line)
780 (if (looking-at "^D")
781 nil
782 (buffer-substring
783 (point)
784 (progn (end-of-line) (point))))))
785 (o-col (current-column)))
786 (if hide-em (gnus-bookmark-bmenu-hide-infos))
787 (setq gnus-bookmark-bmenu-toggle-infos nil)
788 (goto-char (point-min))
789 (forward-line 1)
790 (while (re-search-forward "^D" (point-max) t)
791 (gnus-bookmark-delete (gnus-bookmark-bmenu-bookmark) t)) ; pass BATCH arg
792 (gnus-bookmark-bmenu-list)
793 (setq gnus-bookmark-bmenu-toggle-infos hide-em)
794 (if gnus-bookmark-bmenu-toggle-infos
795 (gnus-bookmark-bmenu-toggle-infos t))
796 (if o-str
797 (progn
798 (goto-char (point-min))
799 (search-forward o-str)
800 (beginning-of-line)
801 (forward-char o-col))
802 (goto-char o-point))
803 (beginning-of-line)
804 (gnus-bookmark-write-file)
805 (message "Deleting bookmarks...done")))
806
807(defun gnus-bookmark-delete (bookmark &optional batch)
808 "Delete BOOKMARK from the bookmark list.
809Removes only the first instance of a bookmark with that name. If
810there are one or more other bookmarks with the same name, they will
811not be deleted. Defaults to the \"current\" bookmark \(that is, the
812one most recently used in this file, if any\).
813Optional second arg BATCH means don't update the bookmark list buffer,
814probably because we were called from there."
815 (gnus-bookmark-maybe-load-default-file)
816 (let ((will-go (gnus-bookmark-get-bookmark bookmark)))
817 (setq gnus-bookmark-alist (delq will-go gnus-bookmark-alist)))
818 ;; Don't rebuild the list
819 (if batch
820 nil
821 (gnus-bookmark-bmenu-surreptitiously-rebuild-list)))
822
823(provide 'gnus-bookmark)
824
825;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525
826;;; gnus-bookmark.el ends here
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 581a8db3227..fecb0685858 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -30,11 +30,8 @@
30(eval-when-compile (require 'cl)) 30(eval-when-compile (require 'cl))
31 31
32(require 'gnus) 32(require 'gnus)
33(require 'gnus-int)
34(require 'gnus-range)
35(require 'gnus-start)
36(eval-when-compile 33(eval-when-compile
37 (if (not (fboundp 'gnus-agent-load-alist)) 34 (unless (fboundp 'gnus-agent-load-alist)
38 (defun gnus-agent-load-alist (group))) 35 (defun gnus-agent-load-alist (group)))
39 (require 'gnus-sum)) 36 (require 'gnus-sum))
40 37
@@ -92,6 +89,7 @@ it's not cached."
92(defvar gnus-cache-buffer nil) 89(defvar gnus-cache-buffer nil)
93(defvar gnus-cache-active-hashtb nil) 90(defvar gnus-cache-active-hashtb nil)
94(defvar gnus-cache-active-altered nil) 91(defvar gnus-cache-active-altered nil)
92(defvar gnus-cache-total-fetched-hashtb nil)
95 93
96(eval-and-compile 94(eval-and-compile
97 (autoload 'nnml-generate-nov-databases-1 "nnml") 95 (autoload 'nnml-generate-nov-databases-1 "nnml")
@@ -133,16 +131,20 @@ it's not cached."
133 (let ((coding-system-for-write 131 (let ((coding-system-for-write
134 gnus-cache-overview-coding-system)) 132 gnus-cache-overview-coding-system))
135 (gnus-write-buffer overview-file)) 133 (gnus-write-buffer overview-file))
136 ;; Empty overview file, remove it 134 (let ((file-name-coding-system nnmail-pathname-coding-system))
137 (when (file-exists-p overview-file) 135 ;; Empty overview file, remove it
138 (delete-file overview-file)) 136 (when (file-exists-p overview-file)
139 ;; If possible, remove group's cache subdirectory. 137 (delete-file overview-file))
140 (condition-case nil 138 ;; If possible, remove group's cache subdirectory.
141 ;; FIXME: we can detect the error type and warn the user 139 (condition-case nil
142 ;; of any inconsistencies (articles w/o nov entries?). 140 ;; FIXME: we can detect the error type and warn the user
143 ;; for now, just be conservative...delete only if safe -- sj 141 ;; of any inconsistencies (articles w/o nov entries?).
144 (delete-directory (file-name-directory overview-file)) 142 ;; for now, just be conservative...delete only if safe -- sj
145 (error nil))))) 143 (delete-directory (file-name-directory overview-file))
144 (error))))
145
146 (gnus-cache-update-overview-total-fetched-for
147 (car gnus-cache-buffer) overview-file)))
146 ;; Kill the buffer -- it's either unmodified or saved. 148 ;; Kill the buffer -- it's either unmodified or saved.
147 (gnus-kill-buffer buffer) 149 (gnus-kill-buffer buffer)
148 (setq gnus-cache-buffer nil)))) 150 (setq gnus-cache-buffer nil))))
@@ -152,7 +154,9 @@ it's not cached."
152 (when (and (or force (not (eq gnus-use-cache 'passive))) 154 (when (and (or force (not (eq gnus-use-cache 'passive)))
153 (numberp article) 155 (numberp article)
154 (> article 0)) ; This might be a dummy article. 156 (> article 0)) ; This might be a dummy article.
155 (let ((number article) file headers) 157 (let ((number article)
158 file headers lines-chars
159 (file-name-coding-system nnmail-pathname-coding-system))
156 ;; If this is a virtual group, we find the real group. 160 ;; If this is a virtual group, we find the real group.
157 (when (gnus-virtual-group-p group) 161 (when (gnus-virtual-group-p group)
158 (let ((result (nnvirtual-find-group-art 162 (let ((result (nnvirtual-find-group-art
@@ -180,10 +184,14 @@ it's not cached."
180 (gnus-request-article-this-buffer number group)) 184 (gnus-request-article-this-buffer number group))
181 (when (> (buffer-size) 0) 185 (when (> (buffer-size) 0)
182 (let ((coding-system-for-write gnus-cache-coding-system)) 186 (let ((coding-system-for-write gnus-cache-coding-system))
183 (gnus-write-buffer file)) 187 (gnus-write-buffer file)
188 (gnus-cache-update-file-total-fetched-for group file))
189 (setq lines-chars (nnheader-get-lines-and-char))
184 (nnheader-remove-body) 190 (nnheader-remove-body)
185 (setq headers (nnheader-parse-naked-head)) 191 (setq headers (nnheader-parse-naked-head))
186 (mail-header-set-number headers number) 192 (mail-header-set-number headers number)
193 (mail-header-set-lines headers (car lines-chars))
194 (mail-header-set-chars headers (cadr lines-chars))
187 (gnus-cache-change-buffer group) 195 (gnus-cache-change-buffer group)
188 (set-buffer (cdr gnus-cache-buffer)) 196 (set-buffer (cdr gnus-cache-buffer))
189 (goto-char (point-max)) 197 (goto-char (point-max))
@@ -236,12 +244,10 @@ it's not cached."
236(defun gnus-cache-possibly-remove-articles-1 () 244(defun gnus-cache-possibly-remove-articles-1 ()
237 "Possibly remove some of the removable articles." 245 "Possibly remove some of the removable articles."
238 (when (gnus-cache-fully-p gnus-newsgroup-name) 246 (when (gnus-cache-fully-p gnus-newsgroup-name)
239 (let ((articles gnus-cache-removable-articles) 247 (let ((cache-articles gnus-newsgroup-cached))
240 (cache-articles gnus-newsgroup-cached)
241 article)
242 (gnus-cache-change-buffer gnus-newsgroup-name) 248 (gnus-cache-change-buffer gnus-newsgroup-name)
243 (while articles 249 (dolist (article gnus-cache-removable-articles)
244 (when (memq (setq article (pop articles)) cache-articles) 250 (when (memq article cache-articles)
245 ;; The article was in the cache, so we see whether we are 251 ;; The article was in the cache, so we see whether we are
246 ;; supposed to remove it from the cache. 252 ;; supposed to remove it from the cache.
247 (gnus-cache-possibly-remove-article 253 (gnus-cache-possibly-remove-article
@@ -256,7 +262,8 @@ it's not cached."
256(defun gnus-cache-request-article (article group) 262(defun gnus-cache-request-article (article group)
257 "Retrieve ARTICLE in GROUP from the cache." 263 "Retrieve ARTICLE in GROUP from the cache."
258 (let ((file (gnus-cache-file-name group article)) 264 (let ((file (gnus-cache-file-name group article))
259 (buffer-read-only nil)) 265 (buffer-read-only nil)
266 (file-name-coding-system nnmail-pathname-coding-system))
260 (when (file-exists-p file) 267 (when (file-exists-p file)
261 (erase-buffer) 268 (erase-buffer)
262 (gnus-kill-all-overlays) 269 (gnus-kill-all-overlays)
@@ -285,7 +292,8 @@ it's not cached."
285 (gnus-retrieve-headers articles group fetch-old)) 292 (gnus-retrieve-headers articles group fetch-old))
286 (let ((uncached-articles (gnus-sorted-difference articles cached)) 293 (let ((uncached-articles (gnus-sorted-difference articles cached))
287 (cache-file (gnus-cache-file-name group ".overview")) 294 (cache-file (gnus-cache-file-name group ".overview"))
288 type) 295 type
296 (file-name-coding-system nnmail-pathname-coding-system))
289 ;; We first retrieve all the headers that we don't have in 297 ;; We first retrieve all the headers that we don't have in
290 ;; the cache. 298 ;; the cache.
291 (let ((gnus-use-cache nil)) 299 (let ((gnus-use-cache nil))
@@ -325,9 +333,8 @@ it's not cached."
325If not given a prefix, use the process marked articles instead. 333If not given a prefix, use the process marked articles instead.
326Returns the list of articles entered." 334Returns the list of articles entered."
327 (interactive "P") 335 (interactive "P")
328 (let ((articles (gnus-summary-work-articles n)) 336 (let (out)
329 article out) 337 (dolist (article (gnus-summary-work-articles n))
330 (while (setq article (pop articles))
331 (gnus-summary-remove-process-mark article) 338 (gnus-summary-remove-process-mark article)
332 (if (natnump article) 339 (if (natnump article)
333 (when (gnus-cache-possibly-enter-article 340 (when (gnus-cache-possibly-enter-article
@@ -348,10 +355,8 @@ If not given a prefix, use the process marked articles instead.
348Returns the list of articles removed." 355Returns the list of articles removed."
349 (interactive "P") 356 (interactive "P")
350 (gnus-cache-change-buffer gnus-newsgroup-name) 357 (gnus-cache-change-buffer gnus-newsgroup-name)
351 (let ((articles (gnus-summary-work-articles n)) 358 (let (out)
352 article out) 359 (dolist (article (gnus-summary-work-articles n))
353 (while articles
354 (setq article (pop articles))
355 (gnus-summary-remove-process-mark article) 360 (gnus-summary-remove-process-mark article)
356 (when (gnus-cache-possibly-remove-article article nil nil nil t) 361 (when (gnus-cache-possibly-remove-article article nil nil nil t)
357 (when gnus-newsgroup-agentized 362 (when gnus-newsgroup-agentized
@@ -407,7 +412,8 @@ Returns the list of articles removed."
407 " *gnus-cache-overview*")))) 412 " *gnus-cache-overview*"))))
408 ;; Insert the contents of this group's cache overview. 413 ;; Insert the contents of this group's cache overview.
409 (erase-buffer) 414 (erase-buffer)
410 (let ((file (gnus-cache-file-name group ".overview"))) 415 (let ((file (gnus-cache-file-name group ".overview"))
416 (file-name-coding-system nnmail-pathname-coding-system))
411 (when (file-exists-p file) 417 (when (file-exists-p file)
412 (nnheader-insert-file-contents file))) 418 (nnheader-insert-file-contents file)))
413 ;; We have a fresh (empty/just loaded) buffer, 419 ;; We have a fresh (empty/just loaded) buffer,
@@ -421,8 +427,43 @@ Returns the list of articles removed."
421 (and unread (memq 'unread class)) 427 (and unread (memq 'unread class))
422 (and (not unread) (not ticked) (not dormant) (memq 'read class)))) 428 (and (not unread) (not ticked) (not dormant) (memq 'read class))))
423 429
430(defvar gnus-cache-decoded-group-names nil
431 "Alist of original group names and decoded group names.
432Decoding is done according to `gnus-group-name-charset-method-alist'
433or `gnus-group-name-charset-group-alist'.")
434
435(defvar gnus-cache-unified-group-names nil
436 "Alist of unified decoded group names and original group names.
437A group name is decoded according to
438`gnus-group-name-charset-method-alist' or
439`gnus-group-name-charset-group-alist' first, and is encoded and
440decoded again according to `nnmail-pathname-coding-system',
441`file-name-coding-system', or `default-file-name-coding-system'.
442
443It is used when asking for a original group name from a cache
444directory name, in which non-ASCII characters might have been unified
445into the ones of a certain charset particularly if the `utf-8' coding
446system for example was used.")
447
448(defun gnus-cache-decoded-group-name (group)
449 "Return a decoded group name of GROUP."
450 (or (cdr (assoc group gnus-cache-decoded-group-names))
451 (let ((decoded (gnus-group-decoded-name group))
452 (coding (or nnmail-pathname-coding-system
453 (and (boundp 'file-name-coding-system)
454 file-name-coding-system)
455 (and (boundp 'default-file-name-coding-system)
456 default-file-name-coding-system))))
457 (push (cons group decoded) gnus-cache-decoded-group-names)
458 (push (cons (mm-decode-coding-string
459 (mm-encode-coding-string decoded coding)
460 coding)
461 group)
462 gnus-cache-unified-group-names)
463 decoded)))
464
424(defun gnus-cache-file-name (group article) 465(defun gnus-cache-file-name (group article)
425 (setq group (gnus-group-decoded-name group)) 466 (setq group (gnus-cache-decoded-group-name group))
426 (expand-file-name 467 (expand-file-name
427 (if (stringp article) article (int-to-string article)) 468 (if (stringp article) article (int-to-string article))
428 (file-name-as-directory 469 (file-name-as-directory
@@ -455,7 +496,8 @@ Returns the list of articles removed."
455 "Possibly remove ARTICLE from the cache." 496 "Possibly remove ARTICLE from the cache."
456 (let ((group gnus-newsgroup-name) 497 (let ((group gnus-newsgroup-name)
457 (number article) 498 (number article)
458 file) 499 file
500 (file-name-coding-system nnmail-pathname-coding-system))
459 ;; If this is a virtual group, we find the real group. 501 ;; If this is a virtual group, we find the real group.
460 (when (gnus-virtual-group-p group) 502 (when (gnus-virtual-group-p group)
461 (let ((result (nnvirtual-find-group-art 503 (let ((result (nnvirtual-find-group-art
@@ -468,13 +510,15 @@ Returns the list of articles removed."
468 (gnus-cache-member-of-class 510 (gnus-cache-member-of-class
469 gnus-cache-remove-articles ticked dormant unread))) 511 gnus-cache-remove-articles ticked dormant unread)))
470 (save-excursion 512 (save-excursion
513 (gnus-cache-update-file-total-fetched-for group file t)
471 (delete-file file) 514 (delete-file file)
515
472 (set-buffer (cdr gnus-cache-buffer)) 516 (set-buffer (cdr gnus-cache-buffer))
473 (goto-char (point-min)) 517 (goto-char (point-min))
474 (when (or (looking-at (concat (int-to-string number) "\t")) 518 (when (or (looking-at (concat (int-to-string number) "\t"))
475 (search-forward (concat "\n" (int-to-string number) "\t") 519 (search-forward (concat "\n" (int-to-string number) "\t")
476 (point-max) t)) 520 (point-max) t))
477 (gnus-delete-line))) 521 (gnus-delete-line)))
478 (unless (setq gnus-newsgroup-cached 522 (unless (setq gnus-newsgroup-cached
479 (delq article gnus-newsgroup-cached)) 523 (delq article gnus-newsgroup-cached))
480 (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) 524 (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
@@ -485,7 +529,8 @@ Returns the list of articles removed."
485(defun gnus-cache-articles-in-group (group) 529(defun gnus-cache-articles-in-group (group)
486 "Return a sorted list of cached articles in GROUP." 530 "Return a sorted list of cached articles in GROUP."
487 (let ((dir (file-name-directory (gnus-cache-file-name group 1))) 531 (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
488 articles) 532 articles
533 (file-name-coding-system nnmail-pathname-coding-system))
489 (when (file-exists-p dir) 534 (when (file-exists-p dir)
490 (setq articles 535 (setq articles
491 (sort (mapcar (lambda (name) (string-to-number name)) 536 (sort (mapcar (lambda (name) (string-to-number name))
@@ -508,8 +553,8 @@ Returns the list of articles removed."
508 (save-excursion 553 (save-excursion
509 (set-buffer cache-buf) 554 (set-buffer cache-buf)
510 (erase-buffer) 555 (erase-buffer)
511 (let ((coding-system-for-read 556 (let ((coding-system-for-read gnus-cache-overview-coding-system)
512 gnus-cache-overview-coding-system)) 557 (file-name-coding-system nnmail-pathname-coding-system))
513 (insert-file-contents 558 (insert-file-contents
514 (or file (gnus-cache-file-name group ".overview")))) 559 (or file (gnus-cache-file-name group ".overview"))))
515 (goto-char (point-min)) 560 (goto-char (point-min))
@@ -525,7 +570,7 @@ Returns the list of articles removed."
525 (set-buffer cache-buf) 570 (set-buffer cache-buf)
526 (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") 571 (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
527 nil t) 572 nil t)
528 (setq beg (gnus-point-at-bol) 573 (setq beg (point-at-bol)
529 end (progn (end-of-line) (point))) 574 end (progn (end-of-line) (point)))
530 (setq beg nil)) 575 (setq beg nil))
531 (set-buffer nntp-server-buffer) 576 (set-buffer nntp-server-buffer)
@@ -537,24 +582,23 @@ Returns the list of articles removed."
537 582
538(defun gnus-cache-braid-heads (group cached) 583(defun gnus-cache-braid-heads (group cached)
539 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) 584 (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
540 (save-excursion 585 (with-current-buffer cache-buf
541 (set-buffer cache-buf)
542 (erase-buffer)) 586 (erase-buffer))
543 (set-buffer nntp-server-buffer) 587 (set-buffer nntp-server-buffer)
544 (goto-char (point-min)) 588 (goto-char (point-min))
545 (while cached 589 (dolist (entry cached)
546 (while (and (not (eobp)) 590 (while (and (not (eobp))
547 (looking-at "2.. +\\([0-9]+\\) ") 591 (looking-at "2.. +\\([0-9]+\\) ")
548 (< (progn (goto-char (match-beginning 1)) 592 (< (progn (goto-char (match-beginning 1))
549 (read (current-buffer))) 593 (read (current-buffer)))
550 (car cached))) 594 entry))
551 (search-forward "\n.\n" nil 'move)) 595 (search-forward "\n.\n" nil 'move))
552 (beginning-of-line) 596 (beginning-of-line)
553 (set-buffer cache-buf) 597 (set-buffer cache-buf)
554 (erase-buffer) 598 (erase-buffer)
555 (let ((coding-system-for-read 599 (let ((coding-system-for-read gnus-cache-coding-system)
556 gnus-cache-coding-system)) 600 (file-name-coding-system nnmail-pathname-coding-system))
557 (insert-file-contents (gnus-cache-file-name group (car cached)))) 601 (insert-file-contents (gnus-cache-file-name group entry)))
558 (goto-char (point-min)) 602 (goto-char (point-min))
559 (insert "220 ") 603 (insert "220 ")
560 (princ (car cached) (current-buffer)) 604 (princ (car cached) (current-buffer))
@@ -564,8 +608,7 @@ Returns the list of articles removed."
564 (forward-char -1) 608 (forward-char -1)
565 (insert ".") 609 (insert ".")
566 (set-buffer nntp-server-buffer) 610 (set-buffer nntp-server-buffer)
567 (insert-buffer-substring cache-buf) 611 (insert-buffer-substring cache-buf))
568 (setq cached (cdr cached)))
569 (kill-buffer cache-buf))) 612 (kill-buffer cache-buf)))
570 613
571;;;###autoload 614;;;###autoload
@@ -661,6 +704,7 @@ If LOW, update the lower bound instead."
661 (interactive) 704 (interactive)
662 (let* ((top (null directory)) 705 (let* ((top (null directory))
663 (directory (expand-file-name (or directory gnus-cache-directory))) 706 (directory (expand-file-name (or directory gnus-cache-directory)))
707 (file-name-coding-system nnmail-pathname-coding-system)
664 (files (directory-files directory 'full)) 708 (files (directory-files directory 'full))
665 (group 709 (group
666 (if top 710 (if top
@@ -686,16 +730,21 @@ If LOW, update the lower bound instead."
686 (push (pop files) alphs))) 730 (push (pop files) alphs)))
687 ;; If we have nums, then this is probably a valid group. 731 ;; If we have nums, then this is probably a valid group.
688 (when (setq nums (sort nums '<)) 732 (when (setq nums (sort nums '<))
689 (gnus-sethash group (cons (car nums) (gnus-last-element nums)) 733 ;; Use non-decoded group name.
734 ;; FIXME: this is kind of a workaround. The active file should
735 ;; be updated at the time articles are cached. It will make
736 ;; `gnus-cache-unified-group-names' needless.
737 (gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names))
738 group)
739 (cons (car nums) (gnus-last-element nums))
690 gnus-cache-active-hashtb)) 740 gnus-cache-active-hashtb))
691 ;; Go through all the other files. 741 ;; Go through all the other files.
692 (while alphs 742 (dolist (file alphs)
693 (when (and (file-directory-p (car alphs)) 743 (when (and (file-directory-p file)
694 (not (string-match "^\\." 744 (not (string-match "^\\."
695 (file-name-nondirectory (car alphs))))) 745 (file-name-nondirectory file))))
696 ;; We descend directories. 746 ;; We descend directories.
697 (gnus-cache-generate-active (car alphs))) 747 (gnus-cache-generate-active file)))
698 (setq alphs (cdr alphs)))
699 ;; Write the new active file. 748 ;; Write the new active file.
700 (when top 749 (when top
701 (gnus-cache-write-active t) 750 (gnus-cache-write-active t)
@@ -708,6 +757,9 @@ If LOW, update the lower bound instead."
708 (gnus-cache-close) 757 (gnus-cache-close)
709 (let ((nnml-generate-active-function 'identity)) 758 (let ((nnml-generate-active-function 'identity))
710 (nnml-generate-nov-databases-1 dir)) 759 (nnml-generate-nov-databases-1 dir))
760
761 (setq gnus-cache-total-fetched-hashtb nil)
762
711 (gnus-cache-open)) 763 (gnus-cache-open))
712 764
713(defun gnus-cache-move-cache (dir) 765(defun gnus-cache-move-cache (dir)
@@ -736,9 +788,12 @@ files would corrupt Gnus when the cache was next enabled. It
736depends on the caller to determine whether group renaming is 788depends on the caller to determine whether group renaming is
737supported." 789supported."
738 (let ((old-dir (gnus-cache-file-name old-group "")) 790 (let ((old-dir (gnus-cache-file-name old-group ""))
739 (new-dir (gnus-cache-file-name new-group ""))) 791 (new-dir (gnus-cache-file-name new-group ""))
792 (file-name-coding-system nnmail-pathname-coding-system))
740 (gnus-rename-file old-dir new-dir t)) 793 (gnus-rename-file old-dir new-dir t))
741 794
795 (gnus-cache-rename-group-total-fetched-for old-group new-group)
796
742 (let ((no-save gnus-cache-active-hashtb)) 797 (let ((no-save gnus-cache-active-hashtb))
743 (unless gnus-cache-active-hashtb 798 (unless gnus-cache-active-hashtb
744 (gnus-cache-read-active)) 799 (gnus-cache-read-active))
@@ -762,9 +817,12 @@ Always updates the cache, even when disabled, as the old cache
762files would corrupt gnus when the cache was next enabled. 817files would corrupt gnus when the cache was next enabled.
763Depends upon the caller to determine whether group deletion is 818Depends upon the caller to determine whether group deletion is
764supported." 819supported."
765 (let ((dir (gnus-cache-file-name group ""))) 820 (let ((dir (gnus-cache-file-name group ""))
821 (file-name-coding-system nnmail-pathname-coding-system))
766 (gnus-delete-directory dir)) 822 (gnus-delete-directory dir))
767 823
824 (gnus-cache-delete-group-total-fetched-for group)
825
768 (let ((no-save gnus-cache-active-hashtb)) 826 (let ((no-save gnus-cache-active-hashtb))
769 (unless gnus-cache-active-hashtb 827 (unless gnus-cache-active-hashtb
770 (gnus-cache-read-active)) 828 (gnus-cache-read-active))
@@ -775,6 +833,85 @@ supported."
775 (setq gnus-cache-active-altered group-hash-value) 833 (setq gnus-cache-active-altered group-hash-value)
776 (gnus-cache-write-active group-hash-value))))) 834 (gnus-cache-write-active group-hash-value)))))
777 835
836(defvar gnus-cache-inhibit-update-total-fetched-for nil)
837(defvar gnus-cache-need-update-total-fetched-for nil)
838
839(defmacro gnus-cache-with-refreshed-group (group &rest body)
840 `(prog1 (let ((gnus-cache-inhibit-update-total-fetched-for t))
841 ,@body)
842 (when (and gnus-cache-need-update-total-fetched-for
843 (not gnus-cache-inhibit-update-total-fetched-for))
844 (save-excursion
845 (set-buffer gnus-group-buffer)
846 (setq gnus-cache-need-update-total-fetched-for nil)
847 (gnus-group-update-group ,group t)))))
848
849(defun gnus-cache-update-file-total-fetched-for (group file &optional subtract)
850 (when gnus-cache-total-fetched-hashtb
851 (gnus-cache-with-refreshed-group
852 group
853 (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
854 (gnus-sethash group (make-vector 2 0)
855 gnus-cache-total-fetched-hashtb)))
856 size)
857
858 (if file
859 (setq size (or (nth 7 (file-attributes file)) 0))
860 (let* ((file-name-coding-system nnmail-pathname-coding-system)
861 (files (directory-files (gnus-cache-file-name group "")
862 t nil t))
863 file attrs)
864 (setq size 0.0)
865 (while (setq file (pop files))
866 (setq attrs (file-attributes file))
867 (unless (nth 0 attrs)
868 (incf size (float (nth 7 attrs)))))))
869
870 (setq gnus-cache-need-update-total-fetched-for t)
871
872 (incf (nth 1 entry) (if subtract (- size) size))))))
873
874(defun gnus-cache-update-overview-total-fetched-for (group file)
875 (when gnus-cache-total-fetched-hashtb
876 (gnus-cache-with-refreshed-group
877 group
878 (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
879 (gnus-sethash group (make-list 2 0)
880 gnus-cache-total-fetched-hashtb)))
881 (file-name-coding-system nnmail-pathname-coding-system)
882 (size (or (nth 7 (file-attributes
883 (or file
884 (gnus-cache-file-name group ".overview"))))
885 0)))
886 (setq gnus-cache-need-update-total-fetched-for t)
887 (setf (nth 0 entry) size)))))
888
889(defun gnus-cache-rename-group-total-fetched-for (old-group new-group)
890 "Record of disk space used by OLD-GROUP now associated with NEW-GROUP."
891 (when gnus-cache-total-fetched-hashtb
892 (let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb)))
893 (gnus-sethash new-group entry gnus-cache-total-fetched-hashtb)
894 (gnus-sethash old-group nil gnus-cache-total-fetched-hashtb))))
895
896(defun gnus-cache-delete-group-total-fetched-for (group)
897 "Delete record of disk space used by GROUP being deleted."
898 (when gnus-cache-total-fetched-hashtb
899 (gnus-sethash group nil gnus-cache-total-fetched-hashtb)))
900
901(defun gnus-cache-total-fetched-for (group &optional no-inhibit)
902 "Get total disk space used by the cache for the specified GROUP."
903 (unless (equal group "dummy.group")
904 (unless gnus-cache-total-fetched-hashtb
905 (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024)))
906
907 (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb)))
908 (if entry
909 (apply '+ entry)
910 (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit)))
911 (+
912 (gnus-cache-update-overview-total-fetched-for group nil)
913 (gnus-cache-update-file-total-fetched-for group nil)))))))
914
778(provide 'gnus-cache) 915(provide 'gnus-cache)
779 916
780;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a 917;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 1611dd235f5..5d1b2b26a8e 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -27,6 +27,9 @@
27;;; Code: 27;;; Code:
28 28
29(eval-when-compile (require 'cl)) 29(eval-when-compile (require 'cl))
30(eval-when-compile
31 (when (featurep 'xemacs)
32 (require 'easy-mmode))) ; for `define-minor-mode'
30 33
31(require 'gnus) 34(require 'gnus)
32(require 'gnus-range) 35(require 'gnus-range)
@@ -268,7 +271,7 @@ It is merged with the face for the cited text belonging to the attribution."
268 271
269(defface gnus-cite-10 '((((class color) 272(defface gnus-cite-10 '((((class color)
270 (background dark)) 273 (background dark))
271 (:foreground "medium purple")) 274 (:foreground "plum1"))
272 (((class color) 275 (((class color)
273 (background light)) 276 (background light))
274 (:foreground "medium purple")) 277 (:foreground "medium purple"))
@@ -294,14 +297,28 @@ It is merged with the face for the cited text belonging to the attribution."
294 297
295(defcustom gnus-cite-face-list 298(defcustom gnus-cite-face-list
296 '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6 299 '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6
297 gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11) 300 gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11)
298 "*List of faces used for highlighting citations. 301 "*List of faces used for highlighting citations.
299 302
300When there are citations from multiple articles in the same message, 303When there are citations from multiple articles in the same message,
301Gnus will try to give each citation from each article its own face. 304Gnus will try to give each citation from each article its own face.
302This should make it easier to see who wrote what." 305This should make it easier to see who wrote what."
303 :group 'gnus-cite 306 :group 'gnus-cite
304 :type '(repeat face)) 307 :type '(repeat face)
308 :set (lambda (symbol value)
309 (prog1
310 (custom-set-default symbol value)
311 (if (boundp 'gnus-message-max-citation-depth)
312 (setq gnus-message-max-citation-depth (length value)))
313 (if (boundp 'gnus-message-citation-keywords)
314 (setq gnus-message-citation-keywords
315 `((gnus-message-search-citation-line
316 ,@(let ((list nil)
317 (count 1))
318 (dolist (face value (nreverse list))
319 (push (list count (list 'quote face) 'prepend t)
320 list)
321 (setq count (1+ count)))))))))))
305 322
306(defcustom gnus-cite-hide-percentage 50 323(defcustom gnus-cite-hide-percentage 50
307 "Only hide excess citation if above this percentage of the body." 324 "Only hide excess citation if above this percentage of the body."
@@ -367,7 +384,7 @@ in a boring face, then the pages will be skipped."
367 384
368;;; Commands: 385;;; Commands:
369 386
370(defun gnus-article-highlight-citation (&optional force) 387(defun gnus-article-highlight-citation (&optional force same-buffer)
371 "Highlight cited text. 388 "Highlight cited text.
372Each citation in the article will be highlighted with a different face. 389Each citation in the article will be highlighted with a different face.
373The faces are taken from `gnus-cite-face-list'. 390The faces are taken from `gnus-cite-face-list'.
@@ -381,7 +398,8 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
381`gnus-cite-attribution-prefix' are considered attribution lines." 398`gnus-cite-attribution-prefix' are considered attribution lines."
382 (interactive (list 'force)) 399 (interactive (list 'force))
383 (save-excursion 400 (save-excursion
384 (set-buffer gnus-article-buffer) 401 (unless same-buffer
402 (set-buffer gnus-article-buffer))
385 (gnus-cite-parse-maybe force) 403 (gnus-cite-parse-maybe force)
386 (let ((buffer-read-only nil) 404 (let ((buffer-read-only nil)
387 (alist gnus-cite-prefix-alist) 405 (alist gnus-cite-prefix-alist)
@@ -416,7 +434,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
416 (goto-char (point-min)) 434 (goto-char (point-min))
417 (forward-line (1- number)) 435 (forward-line (1- number))
418 (when (re-search-forward gnus-cite-attribution-suffix 436 (when (re-search-forward gnus-cite-attribution-suffix
419 (gnus-point-at-eol) 437 (point-at-eol)
420 t) 438 t)
421 (gnus-article-add-button (match-beginning 1) (match-end 1) 439 (gnus-article-add-button (match-beginning 1) (match-end 1)
422 'gnus-cite-toggle prefix)) 440 'gnus-cite-toggle prefix))
@@ -770,7 +788,7 @@ See also the documentation for `gnus-article-highlight-citation'."
770 ;; Each line. 788 ;; Each line.
771 (setq begin (point) 789 (setq begin (point)
772 guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) 790 guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
773 end (gnus-point-at-bol 2) 791 end (point-at-bol 2)
774 start end) 792 start end)
775 (goto-char begin) 793 (goto-char begin)
776 ;; Ignore standard Supercite attribution prefix. 794 ;; Ignore standard Supercite attribution prefix.
@@ -793,7 +811,7 @@ See also the documentation for `gnus-article-highlight-citation'."
793 ;; Each prefix. 811 ;; Each prefix.
794 (setq end (match-end 0) 812 (setq end (match-end 0)
795 prefix (buffer-substring begin end)) 813 prefix (buffer-substring begin end))
796 (gnus-set-text-properties 0 (length prefix) nil prefix) 814 (set-text-properties 0 (length prefix) nil prefix)
797 (setq entry (assoc prefix alist)) 815 (setq entry (assoc prefix alist))
798 (if entry 816 (if entry
799 (setcdr entry (cons line (cdr entry))) 817 (setcdr entry (cons line (cdr entry)))
@@ -803,13 +821,24 @@ See also the documentation for `gnus-article-highlight-citation'."
803 (setq line (1+ line))) 821 (setq line (1+ line)))
804 ;; Horrible special case for some Microsoft mailers. 822 ;; Horrible special case for some Microsoft mailers.
805 (goto-char (point-min)) 823 (goto-char (point-min))
806 (when (re-search-forward gnus-cite-unsightly-citation-regexp max t) 824 (setq start t begin nil entry nil)
807 (setq begin (count-lines (point-min) (point))) 825 (while start
808 (setq end (count-lines (point-min) max)) 826 ;; Assume this search ends up at the beginning of a line.
809 (setq entry nil) 827 (if (re-search-forward gnus-cite-unsightly-citation-regexp max t)
810 (while (< begin end) 828 (progn
811 (push begin entry) 829 (when (number-or-marker-p start)
812 (setq begin (1+ begin))) 830 (setq begin (count-lines (point-min) start)
831 end (count-lines (point-min) (match-beginning 0))))
832 (setq start (match-end 0)))
833 (when (number-or-marker-p start)
834 (setq begin (count-lines (point-min) start)
835 end (count-lines (point-min) max)))
836 (setq start nil))
837 (when begin
838 (while (< begin end)
839 ;; Need to do 1+ because we're in the bol.
840 (push (setq begin (1+ begin)) entry))))
841 (when entry
813 (push (cons "" entry) alist)) 842 (push (cons "" entry) alist))
814 ;; We got all the potential prefixes. Now create 843 ;; We got all the potential prefixes. Now create
815 ;; `gnus-cite-prefix-alist' containing the oldest prefix for each 844 ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
@@ -875,11 +904,10 @@ See also the documentation for `gnus-article-highlight-citation'."
875 (let ((al (buffer-substring (save-excursion (beginning-of-line 0) 904 (let ((al (buffer-substring (save-excursion (beginning-of-line 0)
876 (1+ (point))) 905 (1+ (point)))
877 end))) 906 end)))
878 (if (not (assoc al al-alist)) 907 (when (not (assoc al al-alist))
879 (progn 908 (push (list wrote in prefix tag)
880 (push (list wrote in prefix tag) 909 gnus-cite-loose-attribution-alist)
881 gnus-cite-loose-attribution-alist) 910 (push (cons al t) al-alist)))))))
882 (push (cons al t) al-alist))))))))
883 911
884(defun gnus-cite-connect-attributions () 912(defun gnus-cite-connect-attributions ()
885 ;; Connect attributions to citations 913 ;; Connect attributions to citations
@@ -1101,6 +1129,108 @@ See also the documentation for `gnus-article-highlight-citation'."
1101 (setq found t))) 1129 (setq found t)))
1102 found))) 1130 found)))
1103 1131
1132
1133;; Highlighting of different citation levels in message-mode.
1134;; - message-cite-prefix will be overridden if this is enabled.
1135
1136(defvar gnus-message-max-citation-depth
1137 (length gnus-cite-face-list)
1138 "Maximum supported level of citation.")
1139
1140(defvar gnus-message-cite-prefix-regexp
1141 (concat "^\\(?:" message-cite-prefix-regexp "\\)"))
1142
1143(defun gnus-message-search-citation-line (limit)
1144 "Search for a cited line and set match data accordingly.
1145Returns nil if there is no such line before LIMIT, t otherwise."
1146 (when (re-search-forward gnus-message-cite-prefix-regexp limit t)
1147 (let ((cdepth (min (length (apply 'concat
1148 (split-string
1149 (match-string-no-properties 0)
1150 "[ \t [:alnum:]]+")))
1151 gnus-message-max-citation-depth))
1152 (mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil))
1153 (start (point-at-bol))
1154 (end (point-at-eol)))
1155 (setcar mlist start)
1156 (setcar (cdr mlist) end)
1157 (setcar (nthcdr (* cdepth 2) mlist) start)
1158 (setcar (nthcdr (1+ (* cdepth 2)) mlist) end)
1159 (set-match-data mlist))
1160 t))
1161
1162(defvar gnus-message-citation-keywords
1163 ;; eval-when-compile ;; This breaks in XEmacs
1164 `((gnus-message-search-citation-line
1165 ,@(let ((list nil)
1166 (count 1))
1167 ;; (require 'gnus-cite)
1168 (dolist (face gnus-cite-face-list (nreverse list))
1169 (push (list count (list 'quote face) 'prepend t) list)
1170 (setq count (1+ count)))))) ;;
1171 "Keywords for highlighting different levels of message citations.")
1172
1173(eval-when-compile
1174 (defvar font-lock-defaults-computed)
1175 (defvar font-lock-keywords)
1176 (defvar font-lock-set-defaults))
1177
1178(eval-and-compile
1179 (unless (featurep 'xemacs)
1180 (autoload 'font-lock-set-defaults "font-lock")))
1181
1182(define-minor-mode gnus-message-citation-mode
1183 "Toggle `gnus-message-citation-mode' in current buffer.
1184This buffer local minor mode provides additional font-lock support for
1185nested citations.
1186With prefix ARG, turn `gnus-message-citation-mode' on if and only if ARG
1187is positive.
1188Automatically turn `font-lock-mode' on when `gnus-message-citation-mode'
1189is turned on."
1190 nil ;; init-value
1191 "" ;; lighter
1192 nil ;; keymap
1193 (when (eq major-mode 'message-mode)
1194 (let ((defaults (car (if (featurep 'xemacs)
1195 (get 'message-mode 'font-lock-defaults)
1196 font-lock-defaults)))
1197 default keywords)
1198 (while defaults
1199 (setq default (if (consp defaults)
1200 (pop defaults)
1201 (prog1
1202 defaults
1203 (setq defaults nil))))
1204 (if gnus-message-citation-mode
1205 ;; `gnus-message-citation-keywords' should be the last
1206 ;; elements of the keywords because the others are unlikely
1207 ;; to have the OVERRIDE flags -- XEmacs applies a keyword
1208 ;; having no OVERRIDE flag to matched text even if it has
1209 ;; already other faces, while Emacs doesn't.
1210 (set (make-local-variable default)
1211 (append (default-value default)
1212 gnus-message-citation-keywords))
1213 (kill-local-variable default))))
1214 ;; Force `font-lock-set-defaults' to update `font-lock-keywords'.
1215 (if (featurep 'xemacs)
1216 (progn
1217 (require 'font-lock)
1218 (setq font-lock-defaults-computed nil
1219 font-lock-keywords nil))
1220 (setq font-lock-set-defaults nil))
1221 (font-lock-set-defaults)
1222 (cond ((symbol-value 'font-lock-mode)
1223 (font-lock-fontify-buffer))
1224 (gnus-message-citation-mode
1225 (font-lock-mode 1)))))
1226
1227(defun turn-on-gnus-message-citation-mode ()
1228 "Turn on `gnus-message-citation-mode'."
1229 (gnus-message-citation-mode 1))
1230(defun turn-off-gnus-message-citation-mode ()
1231 "Turn off `gnus-message-citation-mode'."
1232 (gnus-message-citation-mode -1))
1233
1104(gnus-ems-redefine) 1234(gnus-ems-redefine)
1105 1235
1106(provide 'gnus-cite) 1236(provide 'gnus-cite)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 1470f0cbac1..6d37120bd59 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -980,7 +980,7 @@ articles in the thread.
980 (deflt (if (,field defaults) 980 (deflt (if (,field defaults)
981 (concat " [" (gnus-trim-whitespace 981 (concat " [" (gnus-trim-whitespace
982 (gnus-pp-to-string (,field defaults))) 982 (gnus-pp-to-string (,field defaults)))
983 "]"))) 983 "]")))
984 symb) 984 symb)
985 985
986 (if (eq (car type) 'radio) 986 (if (eq (car type) 'radio)
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index e928dc78c8f..ea38ba0456d 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -152,7 +152,7 @@ DELAY is a string, giving the length of the time. Possible values are:
152 (message-send-hook (copy-sequence message-send-hook)) 152 (message-send-hook (copy-sequence message-send-hook))
153 articles 153 articles
154 article deadline) 154 article deadline)
155 (when (gnus-gethash group gnus-newsrc-hashtb) 155 (when (gnus-group-entry group)
156 (gnus-activate-group group) 156 (gnus-activate-group group)
157 (add-hook 'message-send-hook 157 (add-hook 'message-send-hook
158 '(lambda () 158 '(lambda ()
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 715e77a7099..98d098c51cf 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -35,10 +35,6 @@
35(require 'nntp) 35(require 'nntp)
36(require 'nnmail) 36(require 'nnmail)
37(require 'gnus-util) 37(require 'gnus-util)
38(eval-and-compile
39 (if (featurep 'xemacs)
40 (require 'itimer)
41 (require 'timer)))
42 38
43(autoload 'parse-time-string "parse-time" nil nil) 39(autoload 'parse-time-string "parse-time" nil nil)
44 40
@@ -109,7 +105,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
109 (when gnus-demon-handlers 105 (when gnus-demon-handlers
110 ;; Set up the timer. 106 ;; Set up the timer.
111 (setq gnus-demon-timer 107 (setq gnus-demon-timer
112 (nnheader-run-at-time 108 (run-at-time
113 gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) 109 gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
114 ;; Reset control variables. 110 ;; Reset control variables.
115 (setq gnus-demon-handler-state 111 (setq gnus-demon-handler-state
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index cc3c3815a1c..655d652ba27 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -251,32 +251,32 @@ Optional prefix (or REVERSE argument) means sort in reverse order."
251 ;; - a nice summary line format 251 ;; - a nice summary line format
252 ;; - NNDiary specific sorting by schedule functions 252 ;; - NNDiary specific sorting by schedule functions
253 ;; In general, try not to mess with what the user might have modified. 253 ;; In general, try not to mess with what the user might have modified.
254 (let ((posting-style (gnus-group-get-parameter group 'posting-style t))) 254
255 ;; Posting style: 255 ;; Posting style:
256 (mapcar (lambda (elt) 256 (let ((posting-style (gnus-group-get-parameter group 'posting-style t))
257 (let ((header (format "X-Diary-%s" (car elt)))) 257 (headers nndiary-headers)
258 (unless (assoc header posting-style) 258 header)
259 (setq posting-style (append posting-style 259 (while headers
260 `((,header "*"))))) 260 (setq header (format "X-Diary-%s" (caar headers))
261 )) 261 headers (cdr headers))
262 nndiary-headers) 262 (unless (assoc header posting-style)
263 (gnus-group-set-parameter group 'posting-style posting-style) 263 (setq posting-style (append posting-style (list (list header "*"))))))
264 ;; Summary line format: 264 (gnus-group-set-parameter group 'posting-style posting-style))
265 (unless (gnus-group-get-parameter group 'gnus-summary-line-format t) 265 ;; Summary line format:
266 (gnus-group-set-parameter group 'gnus-summary-line-format 266 (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
267 `(,gnus-diary-summary-line-format))) 267 (gnus-group-set-parameter group 'gnus-summary-line-format
268 ;; Sorting by schedule: 268 `(,gnus-diary-summary-line-format)))
269 (unless (gnus-group-get-parameter group 'gnus-article-sort-functions) 269 ;; Sorting by schedule:
270 (gnus-group-set-parameter group 'gnus-article-sort-functions 270 (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
271 '((append gnus-article-sort-functions 271 (gnus-group-set-parameter group 'gnus-article-sort-functions
272 (list 272 '((append gnus-article-sort-functions
273 'gnus-article-sort-by-schedule))))) 273 (list
274 (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions) 274 'gnus-article-sort-by-schedule)))))
275 (gnus-group-set-parameter group 'gnus-thread-sort-functions 275 (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
276 '((append gnus-thread-sort-functions 276 (gnus-group-set-parameter group 'gnus-thread-sort-functions
277 (list 277 '((append gnus-thread-sort-functions
278 'gnus-thread-sort-by-schedule))))) 278 (list
279 )) 279 'gnus-thread-sort-by-schedule))))))
280 280
281;; Called when a group is subscribed. This is needed because groups created 281;; Called when a group is subscribed. This is needed because groups created
282;; because of mail splitting are *not* created with the back end function. 282;; because of mail splitting are *not* created with the back end function.
@@ -347,7 +347,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields."
347 (when (re-search-forward (concat "^" header ":") nil t) 347 (when (re-search-forward (concat "^" header ":") nil t)
348 (unless (eq (char-after) ? ) 348 (unless (eq (char-after) ? )
349 (insert " ")) 349 (insert " "))
350 (setq value (buffer-substring (point) (gnus-point-at-eol))) 350 (setq value (buffer-substring (point) (point-at-eol)))
351 (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value) 351 (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value)
352 (setq value (match-string 1 value))) 352 (setq value (match-string 1 value)))
353 (condition-case () 353 (condition-case ()
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 93c89aec3ea..fa9ef21bd1a 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -72,7 +72,7 @@
72 (if (null arg) (not gnus-dired-mode) 72 (if (null arg) (not gnus-dired-mode)
73 (> (prefix-numeric-value arg) 0))) 73 (> (prefix-numeric-value arg) 0)))
74 (when gnus-dired-mode 74 (when gnus-dired-mode
75 (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) 75 (add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
76 (gnus-run-hooks 'gnus-dired-mode-hook)))) 76 (gnus-run-hooks 'gnus-dired-mode-hook))))
77 77
78;;;###autoload 78;;;###autoload
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 287d71844af..344f9c028d6 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -75,7 +75,7 @@
75 ;; Set up the menu. 75 ;; Set up the menu.
76 (when (gnus-visual-p 'draft-menu 'menu) 76 (when (gnus-visual-p 'draft-menu 'menu)
77 (gnus-draft-make-menu-bar)) 77 (gnus-draft-make-menu-bar))
78 (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) 78 (add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
79 (gnus-run-hooks 'gnus-draft-mode-hook)))) 79 (gnus-run-hooks 'gnus-draft-mode-hook))))
80 80
81;;; Commands 81;;; Commands
@@ -105,7 +105,9 @@
105 (save-restriction 105 (save-restriction
106 (message-narrow-to-headers) 106 (message-narrow-to-headers)
107 (message-remove-header "date"))) 107 (message-remove-header "date")))
108 (save-buffer) 108 (let ((message-draft-headers
109 (delq 'Date (copy-sequence message-draft-headers))))
110 (save-buffer))
109 (let ((gnus-verbose-backends nil)) 111 (let ((gnus-verbose-backends nil))
110 (gnus-request-expire-articles (list article) group t)) 112 (gnus-request-expire-articles (list article) group t))
111 (push 113 (push
@@ -160,7 +162,7 @@
160 (concat "^" (regexp-quote gnus-agent-target-move-group-header) 162 (concat "^" (regexp-quote gnus-agent-target-move-group-header)
161 ":") nil t) 163 ":") nil t)
162 (skip-syntax-forward "-") 164 (skip-syntax-forward "-")
163 (setq move-to (buffer-substring (point) (gnus-point-at-eol))) 165 (setq move-to (buffer-substring (point) (point-at-eol)))
164 (message-remove-header gnus-agent-target-move-group-header)) 166 (message-remove-header gnus-agent-target-move-group-header))
165 (goto-char (point-min)) 167 (goto-char (point-min))
166 (when (re-search-forward 168 (when (re-search-forward
@@ -238,6 +240,12 @@
238 (throw 'continue t) 240 (throw 'continue t)
239 (error "Stop!")))))))) 241 (error "Stop!"))))))))
240 242
243(defcustom gnus-draft-setup-hook nil
244 "Hook run after setting up a draft buffer."
245 :group 'gnus-message
246 :version "23.0" ;; No Gnus
247 :type 'hook)
248
241;;; Utility functions 249;;; Utility functions
242 250
243;;;!!!If this is byte-compiled, it fails miserably. 251;;;!!!If this is byte-compiled, it fails miserably.
@@ -285,7 +293,8 @@
285 (gnus-add-mark ,(car ga) 'replied ,article) 293 (gnus-add-mark ,(car ga) 'replied ,article)
286 (gnus-request-set-mark ,(car ga) (list (list (list ,article) 294 (gnus-request-set-mark ,(car ga) (list (list (list ,article)
287 'add '(reply))))) 295 'add '(reply)))))
288 'send))))))) 296 'send))))
297 (run-hooks 'gnus-draft-setup-hook))))
289 298
290(defun gnus-draft-article-sendable-p (article) 299(defun gnus-draft-article-sendable-p (article)
291 "Say whether ARTICLE is sendable." 300 "Say whether ARTICLE is sendable."
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 0c2e1af0a94..fa08b443a90 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -85,10 +85,8 @@ seen in the same session."
85 (setq gnus-dup-list nil)) 85 (setq gnus-dup-list nil))
86 (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) 86 (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
87 ;; Enter all Message-IDs into the hash table. 87 ;; Enter all Message-IDs into the hash table.
88 (let ((list gnus-dup-list) 88 (let ((obarray gnus-dup-hashtb))
89 (obarray gnus-dup-hashtb)) 89 (mapc 'intern gnus-dup-list)))
90 (while list
91 (intern (pop list)))))
92 90
93(defun gnus-dup-read () 91(defun gnus-dup-read ()
94 "Read the duplicate suppression list." 92 "Read the duplicate suppression list."
@@ -113,11 +111,10 @@ seen in the same session."
113 (unless gnus-dup-list 111 (unless gnus-dup-list
114 (gnus-dup-open)) 112 (gnus-dup-open))
115 (setq gnus-dup-list-dirty t) ; mark list for saving 113 (setq gnus-dup-list-dirty t) ; mark list for saving
116 (let ((data gnus-newsgroup-data) 114 (let (msgid)
117 datum msgid)
118 ;; Enter the Message-IDs of all read articles into the list 115 ;; Enter the Message-IDs of all read articles into the list
119 ;; and hash table. 116 ;; and hash table.
120 (while (setq datum (pop data)) 117 (dolist (datum gnus-newsgroup-data)
121 (when (and (not (gnus-data-pseudo-p datum)) 118 (when (and (not (gnus-data-pseudo-p datum))
122 (> (gnus-data-number datum) 0) 119 (> (gnus-data-number datum) 0)
123 (not (memq (gnus-data-number datum) gnus-newsgroup-unreads)) 120 (not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
@@ -130,6 +127,7 @@ seen in the same session."
130 ;; Chop off excess Message-IDs from the list. 127 ;; Chop off excess Message-IDs from the list.
131 (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) 128 (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
132 (when end 129 (when end
130 (mapc (lambda (id) (unintern id gnus-dup-hashtb)) (cdr end))
133 (setcdr end nil)))) 131 (setcdr end nil))))
134 132
135(defun gnus-dup-suppress-articles () 133(defun gnus-dup-suppress-articles ()
@@ -137,11 +135,10 @@ seen in the same session."
137 (unless gnus-dup-list 135 (unless gnus-dup-list
138 (gnus-dup-open)) 136 (gnus-dup-open))
139 (gnus-message 6 "Suppressing duplicates...") 137 (gnus-message 6 "Suppressing duplicates...")
140 (let ((headers gnus-newsgroup-headers) 138 (let ((auto (and gnus-newsgroup-auto-expire
141 (auto (and gnus-newsgroup-auto-expire
142 (memq gnus-duplicate-mark gnus-auto-expirable-marks))) 139 (memq gnus-duplicate-mark gnus-auto-expirable-marks)))
143 number header) 140 number)
144 (while (setq header (pop headers)) 141 (dolist (header gnus-newsgroup-headers)
145 (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) 142 (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb)
146 (gnus-summary-article-unread-p (mail-header-number header))) 143 (gnus-summary-article-unread-p (mail-header-number header)))
147 (setq gnus-newsgroup-unreads 144 (setq gnus-newsgroup-unreads
@@ -155,7 +152,8 @@ seen in the same session."
155 152
156(defun gnus-dup-unsuppress-article (article) 153(defun gnus-dup-unsuppress-article (article)
157 "Stop suppression of ARTICLE." 154 "Stop suppression of ARTICLE."
158 (let ((id (mail-header-id (gnus-data-header (gnus-data-find article))))) 155 (let* ((header (gnus-data-header (gnus-data-find article)))
156 (id (when header (mail-header-id header))))
159 (when id 157 (when id
160 (setq gnus-dup-list-dirty t) 158 (setq gnus-dup-list-dirty t)
161 (setq gnus-dup-list (delete id gnus-dup-list)) 159 (setq gnus-dup-list (delete id gnus-dup-list))
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 4dc5dde369a..220f9c3ce5c 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -86,13 +86,14 @@ It is a slightly enhanced emacs-lisp-mode.
86 (make-local-variable 'gnus-prev-winconf) 86 (make-local-variable 'gnus-prev-winconf)
87 (gnus-run-mode-hooks 'gnus-edit-form-mode-hook)) 87 (gnus-run-mode-hooks 'gnus-edit-form-mode-hook))
88 88
89(defun gnus-edit-form (form documentation exit-func) 89(defun gnus-edit-form (form documentation exit-func &optional layout)
90 "Edit FORM in a new buffer. 90 "Edit FORM in a new buffer.
91Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning 91Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning
92of the buffer." 92of the buffer.
93The optional LAYOUT overrides the `edit-form' window layout."
93 (let ((winconf (current-window-configuration))) 94 (let ((winconf (current-window-configuration)))
94 (set-buffer (gnus-get-buffer-create gnus-edit-form-buffer)) 95 (set-buffer (gnus-get-buffer-create gnus-edit-form-buffer))
95 (gnus-configure-windows 'edit-form) 96 (gnus-configure-windows (or layout 'edit-form))
96 (gnus-edit-form-mode) 97 (gnus-edit-form-mode)
97 (setq gnus-prev-winconf winconf) 98 (setq gnus-prev-winconf winconf)
98 (setq gnus-edit-form-done-function exit-func) 99 (setq gnus-edit-form-done-function exit-func)
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index 88190b8085b..c30363b9ee1 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -38,21 +38,17 @@
38(defvar gnus-down-mouse-2 [down-mouse-2]) 38(defvar gnus-down-mouse-2 [down-mouse-2])
39(defvar gnus-widget-button-keymap nil) 39(defvar gnus-widget-button-keymap nil)
40(defvar gnus-mode-line-modified 40(defvar gnus-mode-line-modified
41 (if (or (featurep 'xemacs) 41 (if (featurep 'xemacs)
42 (< emacs-major-version 20))
43 '("--**-" . "-----") 42 '("--**-" . "-----")
44 '("**" "--"))) 43 '("**" "--")))
45 44
46(eval-and-compile 45(eval-and-compile
47 (autoload 'gnus-xmas-define "gnus-xmas") 46 (autoload 'gnus-xmas-define "gnus-xmas")
48 (autoload 'gnus-xmas-redefine "gnus-xmas") 47 (autoload 'gnus-xmas-redefine "gnus-xmas")
49 (autoload 'appt-select-lowest-window "appt")
50 (autoload 'gnus-get-buffer-create "gnus") 48 (autoload 'gnus-get-buffer-create "gnus")
51 (autoload 'nnheader-find-etc-directory "nnheader")) 49 (autoload 'nnheader-find-etc-directory "nnheader"))
52 50
53(autoload 'smiley-region "smiley") 51(autoload 'smiley-region "smiley")
54;; Fixme: shouldn't require message
55(autoload 'message-text-with-property "message")
56 52
57(defun gnus-kill-all-overlays () 53(defun gnus-kill-all-overlays ()
58 "Delete all overlays in the current buffer." 54 "Delete all overlays in the current buffer."
@@ -73,12 +69,6 @@
73 valstr))) 69 valstr)))
74 70
75(eval-and-compile 71(eval-and-compile
76 (defalias 'gnus-char-width
77 (if (fboundp 'char-width)
78 'char-width
79 (lambda (ch) 1)))) ;; A simple hack.
80
81(eval-and-compile
82 (if (featurep 'xemacs) 72 (if (featurep 'xemacs)
83 (gnus-xmas-define) 73 (gnus-xmas-define)
84 (defvar gnus-mouse-face-prop 'mouse-face 74 (defvar gnus-mouse-face-prop 'mouse-face
@@ -149,6 +139,18 @@
149 gnus-mouse-face-prop gnus-mouse-face) 139 gnus-mouse-face-prop gnus-mouse-face)
150 (insert " " gnus-tmp-subject-or-nil "\n"))))) 140 (insert " " gnus-tmp-subject-or-nil "\n")))))
151 141
142;; Clone of `appt-select-lowest-window' in appt.el.
143(defun gnus-select-lowest-window ()
144"Select the lowest window on the frame."
145 (let ((lowest-window (selected-window))
146 (bottom-edge (nth 3 (window-edges))))
147 (walk-windows (lambda (w)
148 (let ((next-bottom-edge (nth 3 (window-edges w))))
149 (when (< bottom-edge next-bottom-edge)
150 (setq bottom-edge next-bottom-edge
151 lowest-window w)))))
152 (select-window lowest-window)))
153
152(defun gnus-region-active-p () 154(defun gnus-region-active-p ()
153 "Say whether the region is active." 155 "Say whether the region is active."
154 (and (boundp 'transient-mark-mode) 156 (and (boundp 'transient-mark-mode)
@@ -160,16 +162,6 @@
160 "Non-nil means the mark and region are currently active in this buffer." 162 "Non-nil means the mark and region are currently active in this buffer."
161 mark-active) ; aliased to region-exists-p in XEmacs. 163 mark-active) ; aliased to region-exists-p in XEmacs.
162 164
163(if (fboundp 'add-minor-mode)
164 (defalias 'gnus-add-minor-mode 'add-minor-mode)
165 (defun gnus-add-minor-mode (mode name map &rest rest)
166 (set (make-local-variable mode) t)
167 (unless (assq mode minor-mode-alist)
168 (push `(,mode ,name) minor-mode-alist))
169 (unless (assq mode minor-mode-map-alist)
170 (push (cons mode map)
171 minor-mode-map-alist))))
172
173(defun gnus-x-splash () 165(defun gnus-x-splash ()
174 "Show a splash screen using a pixmap in the current buffer." 166 "Show a splash screen using a pixmap in the current buffer."
175 (interactive) 167 (interactive)
@@ -289,13 +281,26 @@
289 glyph)) 281 glyph))
290 282
291(defun gnus-remove-image (image &optional category) 283(defun gnus-remove-image (image &optional category)
292 (dolist (position (message-text-with-property 'display)) 284 "Remove the image matching IMAGE and CATEGORY found first."
293 (when (and (equal (get-text-property position 'display) image) 285 (let ((start (point-min))
294 (equal (get-text-property position 'gnus-image-category) 286 val end)
287 (while (and (not end)
288 (or (setq val (get-text-property start 'display))
289 (and (setq start
290 (next-single-property-change start 'display))
291 (setq val (get-text-property start 'display)))))
292 (setq end (or (next-single-property-change start 'display)
293 (point-max)))
294 (if (and (equal val image)
295 (equal (get-text-property start 'gnus-image-category)
295 category)) 296 category))
296 (put-text-property position (1+ position) 'display nil) 297 (progn
297 (when (get-text-property position 'gnus-image-text-deletable) 298 (put-text-property start end 'display nil)
298 (delete-region position (1+ position)))))) 299 (when (get-text-property start 'gnus-image-text-deletable)
300 (delete-region start end)))
301 (unless (= end (point-max))
302 (setq start end
303 end nil))))))
299 304
300(provide 'gnus-ems) 305(provide 'gnus-ems)
301 306
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 83b5904e80b..162cc7e1984 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -46,21 +46,37 @@
46 :group 'gnus-fun 46 :group 'gnus-fun
47 :type 'string) 47 :type 'string)
48 48
49(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface" 49(defcustom gnus-convert-image-to-x-face-command
50 "convert -scale 48x48! %s xbm:- | xbm2xface.pl"
50 "Command for converting an image to an X-Face. 51 "Command for converting an image to an X-Face.
52The command must take a image filename (use \"%s\") as input.
53The output must be the Face header data on stdout in PNG format.
54
51By default it takes a GIF filename and output the X-Face header data 55By default it takes a GIF filename and output the X-Face header data
52on stdout." 56on stdout."
53 :version "22.1" 57 :version "22.1"
54 :group 'gnus-fun 58 :group 'gnus-fun
55 :type 'string) 59 :type '(choice (const :tag "giftopnm, netpbm (GIF input only)"
60 "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface")
61 (const :tag "convert"
62 "convert -scale 48x48! %s xbm:- | xbm2xface.pl")
63 (string)))
56 64
57(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng" 65(defcustom gnus-convert-image-to-face-command
66 "convert -scale 48x48! %s -colors %d png:-"
58 "Command for converting an image to a Face. 67 "Command for converting an image to a Face.
59By default it takes a JPEG filename and output the Face header data 68
60on stdout." 69The command must take an image filename (first format argument
70\"%s\") and the number of colors (second format argument: \"%d\")
71as input. The output must be the Face header data on stdout in
72PNG format."
61 :version "22.1" 73 :version "22.1"
62 :group 'gnus-fun 74 :group 'gnus-fun
63 :type 'string) 75 :type '(choice (const :tag "djpeg, netpbm (JPG input only)"
76 "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng")
77 (const :tag "convert"
78 "convert -scale 48x48! %s -colors %d png:-")
79 (string)))
64 80
65(defun gnus-shell-command-to-string (command) 81(defun gnus-shell-command-to-string (command)
66 "Like `shell-command-to-string' except not mingling ERROR." 82 "Like `shell-command-to-string' except not mingling ERROR."
@@ -102,8 +118,11 @@ Output to the current buffer, replace text, and don't mingle error."
102 118
103;;;###autoload 119;;;###autoload
104(defun gnus-x-face-from-file (file) 120(defun gnus-x-face-from-file (file)
105 "Insert an X-Face header based on an image file." 121 "Insert an X-Face header based on an image file.
106 (interactive "fImage file name (by default GIF): ") 122
123Depending on `gnus-convert-image-to-x-face-command' it may accept
124different input formats."
125 (interactive "fImage file name: ")
107 (when (file-exists-p file) 126 (when (file-exists-p file)
108 (gnus-shell-command-to-string 127 (gnus-shell-command-to-string
109 (format gnus-convert-image-to-x-face-command 128 (format gnus-convert-image-to-x-face-command
@@ -111,8 +130,11 @@ Output to the current buffer, replace text, and don't mingle error."
111 130
112;;;###autoload 131;;;###autoload
113(defun gnus-face-from-file (file) 132(defun gnus-face-from-file (file)
114 "Return a Face header based on an image file." 133 "Return a Face header based on an image file.
115 (interactive "fImage file name (by default JPEG): ") 134
135Depending on `gnus-convert-image-to-face-command' it may accept
136different input formats."
137 (interactive "fImage file name: ")
116 (when (file-exists-p file) 138 (when (file-exists-p file)
117 (let ((done nil) 139 (let ((done nil)
118 (attempt "") 140 (attempt "")
@@ -127,7 +149,7 @@ Output to the current buffer, replace text, and don't mingle error."
127 quant)))) 149 quant))))
128 (if (> (length attempt) 726) 150 (if (> (length attempt) 726)
129 (progn 151 (progn
130 (setq quant (- quant 2)) 152 (setq quant (- quant (if (< quant 10) 1 2)))
131 (gnus-message 9 "Length %d; trying quant %d" 153 (gnus-message 9 "Length %d; trying quant %d"
132 (length attempt) quant)) 154 (length attempt) quant))
133 (setq done t))) 155 (setq done t)))
@@ -197,11 +219,11 @@ colors of the displayed X-Faces."
197 'xface 219 'xface
198 (gnus-put-image 220 (gnus-put-image
199 (if (gnus-image-type-available-p 'xface) 221 (if (gnus-image-type-available-p 'xface)
200 (gnus-create-image 222 (apply 'gnus-create-image (concat "X-Face: " data) 'xface t
201 (concat "X-Face: " data) 223 (cdr (assq 'xface gnus-face-properties-alist)))
202 'xface t :face 'gnus-x-face) 224 (apply 'gnus-create-image pbm 'pbm t
203 (gnus-create-image 225 (cdr (assq 'pbm gnus-face-properties-alist))))
204 pbm 'pbm t :face 'gnus-x-face)) nil 'xface)) 226 nil 'xface))
205 (gnus-add-wash-type 'xface)))))) 227 (gnus-add-wash-type 'xface))))))
206 228
207(defun gnus-grab-cam-x-face () 229(defun gnus-grab-cam-x-face ()
diff --git a/lisp/gnus/gnus-gl.el b/lisp/gnus/gnus-gl.el
deleted file mode 100644
index 98326ee2923..00000000000
--- a/lisp/gnus/gnus-gl.el
+++ /dev/null
@@ -1,860 +0,0 @@
1;;; gnus-gl.el --- an interface to GroupLens for Gnus
2
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Brad Miller <bmiller@cs.umn.edu>
7;; Keywords: news, score
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29;; GroupLens software and documentation is copyright (c) 1995 by Paul
30;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
31;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
32;; and David Maltz (Carnegie-Mellon University).
33;;
34;; Permission to use, copy, modify, and distribute this documentation
35;; for non-commercial and commercial purposes without fee is hereby
36;; granted provided that this copyright notice and permission notice
37;; appears in all copies and that the names of the individuals and
38;; institutions holding this copyright are not used in advertising or
39;; publicity pertaining to this software without specific, written
40;; prior permission. The copyright holders make no representations
41;; about the suitability of this software and documentation for any
42;; purpose. It is provided ``as is'' without express or implied
43;; warranty.
44;;
45;; The copyright holders request that they be notified of
46;; modifications of this code. Please send electronic mail to
47;; grouplens@cs.umn.edu for more information or to announce derived
48;; works.
49;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50;; Author: Brad Miller
51;;
52;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53;;
54;; User Documentation:
55;; To use GroupLens you must load this file.
56;; You must also register a pseudonym with the Better Bit Bureau.
57;; http://www.cs.umn.edu/Research/GroupLens
58;;
59;; ---------------- For your .emacs or .gnus file ----------------
60;;
61;; As of version 2.5, grouplens now works as a minor mode of
62;; gnus-summary-mode. To get make that work you just need a couple of
63;; hooks.
64;; (setq gnus-use-grouplens t)
65;; (setq grouplens-pseudonym "")
66;; (setq grouplens-bbb-host "grouplens.cs.umn.edu")
67;;
68;; (setq gnus-summary-default-score 0)
69;;
70;; USING GROUPLENS
71;; How do I Rate an article??
72;; Before you type n to go to the next article, hit a number from 1-5
73;; Type r in the summary buffer and you will be prompted.
74;; Note that when you're in grouplens-minor-mode 'r' masks the
75;; usual reply binding for 'r'
76;;
77;; What if, Gasp, I find a bug???
78;; Please type M-x gnus-gl-submit-bug-report. This will set up a
79;; mail buffer with the state of variables and buffers that will help
80;; me debug the problem. A short description up front would help too!
81;;
82;; How do I display the prediction for an article:
83;; If you set the gnus-summary-line-format as shown above, the score
84;; (prediction) will be shown automatically.
85;;
86;;
87;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
88;; Programmer Notes
89;; 10/9/95
90;; gnus-scores-articles contains the articles
91;; When scoring is done, the call tree looks something like:
92;; gnus-possibly-score-headers
93;; ==> gnus-score-headers
94;; ==> gnus-score-load-file
95;; ==> get-all-mids (from the eval form)
96;;
97;; it would be nice to have one that gets called after all the other
98;; headers have been scored.
99;; we may want a variable gnus-grouplens-scale-factor
100;; and gnus-grouplens-offset this would probably be either -3 or 0
101;; to make the scores centered around zero or not.
102;; Notes 10/12/95
103;; According to Lars, Norse god of gnus, the simple way to insert a
104;; call to an external function is to have a function added to the
105;; variable gnus-score-find-files-function This new function
106;; gnus-grouplens-score-alist will return a core alist that
107;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
108;; This seems like it would be pretty inefficient, though workable.
109;;
110;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111;; TODO
112;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
113;;
114;; 3. Add some more ways to rate messages
115;; 4. Better error handling for token timeouts.
116;;
117;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118;; bugs
119;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
120;;
121
122;;; Code:
123
124(eval-when-compile (require 'cl))
125
126(require 'gnus-score)
127(require 'gnus)
128
129;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130;;;; User variables
131;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132
133(defvar gnus-summary-grouplens-line-format
134 "%U\%R\%z%l%I\%(%[%4L: %-23,23n%]%) %s\n"
135 "*The line format spec in summary GroupLens mode buffers.")
136
137(defvar grouplens-pseudonym ""
138 "User's pseudonym.
139This pseudonym is obtained during the registration process")
140
141(defvar grouplens-bbb-host "grouplens.cs.umn.edu"
142 "Host where the bbbd is running.")
143
144(defvar grouplens-bbb-port 9000
145 "Port where the bbbd is listening.")
146
147(defvar grouplens-newsgroups
148 '("comp.groupware" "comp.human-factors" "comp.lang.c++"
149 "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy"
150 "comp.os.linux.announce" "comp.os.linux.answers"
151 "comp.os.linux.development" "comp.os.linux.development.apps"
152 "comp.os.linux.development.system" "comp.os.linux.hardware"
153 "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc"
154 "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x"
155 "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
156 "rec.food.recipes" "rec.humor")
157 "*Groups that are part of the GroupLens experiment.")
158
159(defvar grouplens-prediction-display 'prediction-spot
160 "valid values are:
161 prediction-spot -- an * corresponding to the prediction between 1 and 5,
162 confidence-interval -- a numeric confidence interval
163 prediction-bar -- |##### | the longer the bar, the better the article,
164 confidence-bar -- | ----- } the prediction is in the middle of the bar,
165 confidence-spot -- ) * | the spot gets bigger with more confidence,
166 prediction-num -- plain-old numeric value,
167 confidence-plus-minus -- prediction +/i confidence")
168
169(defvar grouplens-score-offset 0
170 "Offset the prediction by this value.
171Setting this variable to -2 would have the following effect on
172GroupLens scores:
173
174 1 --> -2
175 2 --> -1
176 3 --> 0
177 4 --> 1
178 5 --> 2
179
180The reason is that a user might want to do this is to combine
181GroupLens predictions with scores calculated by other score methods.")
182
183(defvar grouplens-score-scale-factor 1
184 "This variable allows the user to magnify the effect of GroupLens scores.
185The scale factor is applied after the offset.")
186
187(defvar gnus-grouplens-override-scoring 'override
188 "Tell GroupLens to override the normal Gnus scoring mechanism.
189GroupLens scores can be combined with gnus scores in one of three ways.
190'override -- just use grouplens predictions for grouplens groups
191'combine -- combine grouplens scores with gnus scores
192'separate -- treat grouplens scores completely separate from gnus")
193
194
195;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
196;;;; Program global variables
197;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
198(defvar grouplens-bbb-token nil
199 "Current session token number.")
200
201(defvar grouplens-bbb-process nil
202 "Process Id of current bbbd network stream process.")
203
204(defvar grouplens-bbb-buffer nil
205 "Buffer associated with the BBBD process.")
206
207(defvar grouplens-rating-alist nil
208 "Current set of message-id rating pairs.")
209
210(defvar grouplens-current-hashtable nil
211 "A hashtable to hold predictions from the BBB.")
212
213(defvar grouplens-current-group nil)
214
215;;(defvar bbb-alist nil)
216
217(defvar bbb-timeout-secs 10
218 "Number of seconds to wait for some response from the BBB.
219If this times out we give up and assume that something has died..." )
220
221(defvar grouplens-previous-article nil
222 "Message-ID of the last article read.")
223
224(defvar bbb-read-point)
225(defvar bbb-response-point)
226
227(defun bbb-renew-hash-table ()
228 (setq grouplens-current-hashtable (make-vector 100 0)))
229
230(bbb-renew-hash-table)
231
232;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
233;;;; Utility Functions
234;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
235
236(defun bbb-connect-to-bbbd (host port)
237 (unless grouplens-bbb-buffer
238 (setq grouplens-bbb-buffer
239 (gnus-get-buffer-create (format " *BBBD trace: %s*" host)))
240 (save-excursion
241 (set-buffer grouplens-bbb-buffer)
242 (make-local-variable 'bbb-read-point)
243 (make-local-variable 'bbb-response-point)
244 (setq bbb-read-point (point-min))))
245
246 ;; if an old process is still running for some reason, kill it
247 (when grouplens-bbb-process
248 (ignore-errors
249 (when (eq 'open (process-status grouplens-bbb-process))
250 (set-process-buffer grouplens-bbb-process nil)
251 (delete-process grouplens-bbb-process))))
252
253 ;; clear the trace buffer of old output
254 (save-excursion
255 (set-buffer grouplens-bbb-buffer)
256 (erase-buffer))
257
258 ;; open the connection to the server
259 (catch 'done
260 (condition-case error
261 (setq grouplens-bbb-process
262 (open-network-stream "BBBD" grouplens-bbb-buffer host port))
263 (error (gnus-message 3 "Error: Failed to connect to BBB")
264 nil))
265 (and (null grouplens-bbb-process)
266 (throw 'done nil))
267 (save-excursion
268 (set-buffer grouplens-bbb-buffer)
269 (setq bbb-read-point (point-min))
270 (or (bbb-read-response grouplens-bbb-process)
271 (throw 'done nil))))
272
273 ;; return the process
274 grouplens-bbb-process)
275
276(defun bbb-send-command (process command)
277 (goto-char (point-max))
278 (insert command)
279 (insert "\r\n")
280 (setq bbb-read-point (point))
281 (setq bbb-response-point (point))
282 (set-marker (process-mark process) (point)) ; process output also comes here
283 (process-send-string process command)
284 (process-send-string process "\r\n")
285 (process-send-eof process))
286
287(defun bbb-read-response (process)
288 "This function eats the initial response of OK or ERROR from the BBB."
289 (let ((case-fold-search nil)
290 match-end)
291 (goto-char bbb-read-point)
292 (while (and (not (search-forward "\r\n" nil t))
293 (accept-process-output process bbb-timeout-secs))
294 (goto-char bbb-read-point))
295 (setq match-end (point))
296 (goto-char bbb-read-point)
297 (setq bbb-read-point match-end)
298 (looking-at "OK")))
299
300;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
301;;;; Login Functions
302;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
303(defun bbb-login ()
304 "return the token number if login is successful, otherwise return nil."
305 (interactive)
306 (setq grouplens-bbb-token nil)
307 (if (not (equal grouplens-pseudonym ""))
308 (let ((bbb-process
309 (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
310 (if bbb-process
311 (save-excursion
312 (set-buffer (process-buffer bbb-process))
313 (bbb-send-command bbb-process
314 (concat "login " grouplens-pseudonym))
315 (if (bbb-read-response bbb-process)
316 (setq grouplens-bbb-token (bbb-extract-token-number))
317 (gnus-message 3 "Error: GroupLens login failed")))))
318 (gnus-message 3 "Error: you must set a pseudonym"))
319 grouplens-bbb-token)
320
321(defun bbb-extract-token-number ()
322 (let ((token-pos (search-forward "token=" nil t)))
323 (when (looking-at "[0-9]+")
324 (buffer-substring token-pos (match-end 0)))))
325
326(gnus-add-shutdown 'bbb-logout 'gnus)
327
328(defun bbb-logout ()
329 "logout of bbb session."
330 (when grouplens-bbb-token
331 (let ((bbb-process
332 (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
333 (when bbb-process
334 (save-excursion
335 (set-buffer (process-buffer bbb-process))
336 (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token))
337 (bbb-read-response bbb-process))))))
338
339;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
340;;;; Get Predictions
341;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
342
343(defun bbb-build-mid-scores-alist (groupname)
344 "this function can be called as part of the function to return the list of score files to use.
345See the gnus variable `gnus-score-find-score-files-function'.
346
347*Note:* If you want to use grouplens scores along with calculated scores,
348you should see the offset and scale variables. At this point, I don't
349recommend using both scores and grouplens predictions together."
350 (setq grouplens-current-group groupname)
351 (when (member groupname grouplens-newsgroups)
352 (setq grouplens-previous-article nil)
353 ;; scores-alist should be a list of lists:
354 ;; ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s))))
355 ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value
356 (list
357 (list
358 (list (append (list "message-id")
359 (bbb-get-predictions (bbb-get-all-mids) groupname)))))))
360
361(defun bbb-get-predictions (midlist groupname)
362 "Ask the bbb for predictions, and build up the score alist."
363 (gnus-message 5 "Fetching Predictions...")
364 (if grouplens-bbb-token
365 (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
366 grouplens-bbb-port)))
367 (when bbb-process
368 (save-excursion
369 (set-buffer (process-buffer bbb-process))
370 (bbb-send-command bbb-process
371 (bbb-build-predict-command midlist groupname
372 grouplens-bbb-token))
373 (if (bbb-read-response bbb-process)
374 (bbb-get-prediction-response bbb-process)
375 (gnus-message 1 "Invalid Token, login and try again")
376 (ding)))))
377 (gnus-message 3 "Error: You are not logged in to a BBB")
378 (ding)))
379
380(defun bbb-get-all-mids ()
381 (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers))
382
383(defun bbb-build-predict-command (mlist grpname token)
384 (concat "getpredictions " token " " grpname "\r\n"
385 (mapconcat 'identity mlist "\r\n") "\r\n.\r\n"))
386
387(defun bbb-get-prediction-response (process)
388 (let ((case-fold-search nil))
389 (goto-char bbb-read-point)
390 (while (and (not (search-forward ".\r\n" nil t))
391 (accept-process-output process bbb-timeout-secs))
392 (goto-char bbb-read-point))
393 (goto-char (+ bbb-response-point 4));; we ought to be right before OK
394 (bbb-build-response-alist)))
395
396;; build-response-alist assumes that the cursor has been positioned at
397;; the first line of the list of mid/rating pairs.
398(defun bbb-build-response-alist ()
399 (let (resp mid pred)
400 (while
401 (cond
402 ((looking-at "\\(<.*>\\) :nopred=")
403 ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp)
404 (forward-line 1)
405 t)
406 ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
407 (setq mid (bbb-get-mid)
408 pred (bbb-get-pred))
409 (push `(,mid ,pred nil s) resp)
410 (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh))
411 grouplens-current-hashtable)
412 (forward-line 1)
413 t)
414 ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
415 (setq mid (bbb-get-mid)
416 pred (bbb-get-pred))
417 (push `(,mid ,pred nil s) resp)
418 (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable)
419 (forward-line 1)
420 t)
421 (t nil)))
422 resp))
423
424;; these "get" functions assume that there is an active match lying
425;; around. Where the first parenthesized expression is the
426;; message-id, and the second is the prediction, the third and fourth
427;; are the confidence interval
428;;
429;; Since gnus assumes that scores are integer values?? we round the
430;; prediction.
431(defun bbb-get-mid ()
432 (buffer-substring (match-beginning 1) (match-end 1)))
433
434(defun bbb-get-pred ()
435 (let ((tpred (string-to-number (buffer-substring (match-beginning 2)
436 (match-end 2)))))
437 (if (> tpred 0)
438 (round (* grouplens-score-scale-factor
439 (+ grouplens-score-offset tpred)))
440 1)))
441
442(defun bbb-get-confl ()
443 (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
444
445(defun bbb-get-confh ()
446 (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
447
448;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
449;;;; Prediction Display
450;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
451(defconst grplens-rating-range 4.0)
452(defconst grplens-maxrating 5)
453(defconst grplens-minrating 1)
454(defconst grplens-predstringsize 12)
455
456(defvar gnus-tmp-score)
457(defun bbb-grouplens-score (header)
458 (if (eq gnus-grouplens-override-scoring 'separate)
459 (bbb-grouplens-other-score header)
460 (let* ((rate-string (make-string 12 ?\ ))
461 (mid (mail-header-id header))
462 (hashent (gnus-gethash mid grouplens-current-hashtable))
463 (iscore gnus-tmp-score)
464 (low (car (cdr hashent)))
465 (high (car (cdr (cdr hashent)))))
466 (aset rate-string 0 ?|)
467 (aset rate-string 11 ?|)
468 (unless (member grouplens-current-group grouplens-newsgroups)
469 (unless (equal grouplens-prediction-display 'prediction-num)
470 (cond ((< iscore 0)
471 (setq iscore 1))
472 ((> iscore 5)
473 (setq iscore 5))))
474 (setq low 0)
475 (setq high 0))
476 (if (and (bbb-valid-score iscore)
477 (not (null mid)))
478 (cond
479 ;; prediction-spot
480 ((equal grouplens-prediction-display 'prediction-spot)
481 (setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
482 ;; confidence-interval
483 ((equal grouplens-prediction-display 'confidence-interval)
484 (setq rate-string (bbb-fmt-confidence-interval iscore low high)))
485 ;; prediction-bar
486 ((equal grouplens-prediction-display 'prediction-bar)
487 (setq rate-string (bbb-fmt-prediction-bar rate-string iscore)))
488 ;; confidence-bar
489 ((equal grouplens-prediction-display 'confidence-bar)
490 (setq rate-string (format "| %4.2f |" iscore)))
491 ;; confidence-spot
492 ((equal grouplens-prediction-display 'confidence-spot)
493 (setq rate-string (format "| %4.2f |" iscore)))
494 ;; prediction-num
495 ((equal grouplens-prediction-display 'prediction-num)
496 (setq rate-string (bbb-fmt-prediction-num iscore)))
497 ;; confidence-plus-minus
498 ((equal grouplens-prediction-display 'confidence-plus-minus)
499 (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high))
500 )
501 (t (gnus-message 3 "Invalid prediction display type")))
502 (aset rate-string 5 ?N) (aset rate-string 6 ?A))
503 rate-string)))
504
505;; Gnus user format function that doesn't depend on
506;; bbb-build-mid-scores-alist being used as the score function, but is
507;; instead called from gnus-select-group-hook. -- LAB
508(defun bbb-grouplens-other-score (header)
509 (if (not (member grouplens-current-group grouplens-newsgroups))
510 ;; Return an empty string
511 ""
512 (let* ((rate-string (make-string 12 ?\ ))
513 (mid (mail-header-id header))
514 (hashent (gnus-gethash mid grouplens-current-hashtable))
515 (pred (or (nth 0 hashent) 0))
516 (low (nth 1 hashent))
517 (high (nth 2 hashent)))
518 ;; Init rate-string
519 (aset rate-string 0 ?|)
520 (aset rate-string 11 ?|)
521 (unless (equal grouplens-prediction-display 'prediction-num)
522 (cond ((< pred 0)
523 (setq pred 1))
524 ((> pred 5)
525 (setq pred 5))))
526 ;; If no entry in BBB hash mark rate string as NA and return
527 (cond
528 ((null hashent)
529 (aset rate-string 5 ?N)
530 (aset rate-string 6 ?A)
531 rate-string)
532
533 ((equal grouplens-prediction-display 'prediction-spot)
534 (bbb-fmt-prediction-spot rate-string pred))
535
536 ((equal grouplens-prediction-display 'confidence-interval)
537 (bbb-fmt-confidence-interval pred low high))
538
539 ((equal grouplens-prediction-display 'prediction-bar)
540 (bbb-fmt-prediction-bar rate-string pred))
541
542 ((equal grouplens-prediction-display 'confidence-bar)
543 (format "| %4.2f |" pred))
544
545 ((equal grouplens-prediction-display 'confidence-spot)
546 (format "| %4.2f |" pred))
547
548 ((equal grouplens-prediction-display 'prediction-num)
549 (bbb-fmt-prediction-num pred))
550
551 ((equal grouplens-prediction-display 'confidence-plus-minus)
552 (bbb-fmt-confidence-plus-minus pred low high))
553
554 (t
555 (gnus-message 3 "Invalid prediction display type")
556 (aset rate-string 0 ?|)
557 (aset rate-string 11 ?|)
558 rate-string)))))
559
560(defun bbb-valid-score (score)
561 (or (equal grouplens-prediction-display 'prediction-num)
562 (and (>= score grplens-minrating)
563 (<= score grplens-maxrating))))
564
565(defun bbb-requires-confidence (format-type)
566 (or (equal format-type 'confidence-plus-minus)
567 (equal format-type 'confidence-spot)
568 (equal format-type 'confidence-interval)))
569
570(defun bbb-have-confidence (clow chigh)
571 (not (or (null clow)
572 (null chigh))))
573
574(defun bbb-fmt-prediction-spot (rate-string score)
575 (aset rate-string
576 (round (* (/ (- score grplens-minrating) grplens-rating-range)
577 (+ (- grplens-predstringsize 4) 1.49)))
578 ?*)
579 rate-string)
580
581(defun bbb-fmt-confidence-interval (score low high)
582 (if (bbb-have-confidence low high)
583 (format "|%4.2f-%4.2f |" low high)
584 (bbb-fmt-prediction-num score)))
585
586(defun bbb-fmt-confidence-plus-minus (score low high)
587 (if (bbb-have-confidence low high)
588 (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
589 (bbb-fmt-prediction-num score)))
590
591(defun bbb-fmt-prediction-bar (rate-string score)
592 (let* ((i 1)
593 (step (/ grplens-rating-range (- grplens-predstringsize 4)))
594 (half-step (/ step 2))
595 (loc (- grplens-minrating half-step)))
596 (while (< i (- grplens-predstringsize 2))
597 (if (> score loc)
598 (aset rate-string i ?#)
599 (aset rate-string i ?\ ))
600 (setq i (+ i 1))
601 (setq loc (+ loc step)))
602 )
603 rate-string)
604
605(defun bbb-fmt-prediction-num (score)
606 (format "| %4.2f |" score))
607
608;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
609;;;; Put Ratings
610;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
611
612(defun bbb-put-ratings ()
613 (if (and grouplens-bbb-token
614 grouplens-rating-alist
615 (member gnus-newsgroup-name grouplens-newsgroups))
616 (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
617 grouplens-bbb-port))
618 (rate-command (bbb-build-rate-command grouplens-rating-alist)))
619 (if bbb-process
620 (save-excursion
621 (set-buffer (process-buffer bbb-process))
622 (gnus-message 5 "Sending Ratings...")
623 (bbb-send-command bbb-process rate-command)
624 (if (bbb-read-response bbb-process)
625 (setq grouplens-rating-alist nil)
626 (gnus-message 1
627 "Token timed out: call bbb-login and quit again")
628 (ding))
629 (gnus-message 5 "Sending Ratings...Done"))
630 (gnus-message 3 "No BBB connection")))
631 (setq grouplens-rating-alist nil)))
632
633(defun bbb-build-rate-command (rate-alist)
634 (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n"
635 (mapconcat (lambda (this) ; form (mid . (score . time))
636 (concat (car this)
637 " :rating=" (cadr this) ".00"
638 " :time=" (cddr this)))
639 rate-alist "\r\n")
640 "\r\n.\r\n"))
641
642;; Interactive rating functions.
643(defun bbb-summary-rate-article (rating &optional midin)
644 (interactive "nRating: ")
645 (when (member gnus-newsgroup-name grouplens-newsgroups)
646 (let ((mid (or midin (bbb-get-current-id))))
647 (if (and rating
648 (>= rating grplens-minrating)
649 (<= rating grplens-maxrating)
650 mid)
651 (let ((oldrating (assoc mid grouplens-rating-alist)))
652 (if oldrating
653 (setcdr oldrating (cons rating 0))
654 (push `(,mid . (,rating . 0)) grouplens-rating-alist))
655 (gnus-summary-mark-article nil (int-to-string rating)))
656 (gnus-message 3 "Invalid rating")))))
657
658(defun grouplens-next-unread-article (rating)
659 "Select unread article after current one."
660 (interactive "P")
661 (when rating
662 (bbb-summary-rate-article rating))
663 (gnus-summary-next-unread-article))
664
665(defun grouplens-best-unread-article (rating)
666 "Select unread article after current one."
667 (interactive "P")
668 (when rating
669 (bbb-summary-rate-article rating))
670 (gnus-summary-best-unread-article))
671
672(defun grouplens-summary-catchup-and-exit (rating)
673 "Mark all articles not marked as unread in this newsgroup as read, then exit.
674If prefix argument ALL is non-nil, all articles are marked as read."
675 (interactive "P")
676 (when rating
677 (bbb-summary-rate-article rating))
678 (if (numberp rating)
679 (gnus-summary-catchup-and-exit)
680 (gnus-summary-catchup-and-exit rating)))
681
682(defun grouplens-score-thread (score)
683 "Raise the score of the articles in the current thread with SCORE."
684 (interactive "nRating: ")
685 (let (e)
686 (save-excursion
687 (let ((articles (gnus-summary-articles-in-thread))
688 article)
689 (while (setq article (pop articles))
690 (gnus-summary-goto-subject article)
691 (bbb-summary-rate-article score
692 (mail-header-id
693 (gnus-summary-article-header article)))))
694 (setq e (point)))
695 (let ((gnus-summary-check-current t))
696 (or (zerop (gnus-summary-next-subject 1 t))
697 (goto-char e))))
698 (gnus-summary-recenter)
699 (gnus-summary-position-point)
700 (gnus-set-mode-line 'summary))
701
702(defun bbb-exit-group ()
703 (bbb-put-ratings)
704 (bbb-renew-hash-table))
705
706(defun bbb-get-current-id ()
707 (if gnus-current-headers
708 (mail-header-id gnus-current-headers)
709 (gnus-message 3 "You must select an article before you rate it")))
710
711(defun bbb-grouplens-group-p (group)
712 "Say whether GROUP is a GroupLens group."
713 (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" ""))
714
715;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
716;; TIME SPENT READING
717;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
718(defvar grouplens-current-starting-time nil)
719
720(defun grouplens-start-timer ()
721 (setq grouplens-current-starting-time (current-time)))
722
723(defun grouplens-elapsed-time ()
724 (let ((et (bbb-time-float (current-time))))
725 (- et (bbb-time-float grouplens-current-starting-time))))
726
727(defun bbb-time-float (timeval)
728 (+ (* (car timeval) 65536)
729 (cadr timeval)))
730
731(defun grouplens-do-time ()
732 (when (member gnus-newsgroup-name grouplens-newsgroups)
733 (when grouplens-previous-article
734 (let ((elapsed-time (grouplens-elapsed-time))
735 (oldrating (assoc grouplens-previous-article
736 grouplens-rating-alist)))
737 (if (not oldrating)
738 (push `(,grouplens-previous-article . (0 . ,elapsed-time))
739 grouplens-rating-alist)
740 (setcdr oldrating (cons (cadr oldrating) elapsed-time)))))
741 (grouplens-start-timer)
742 (setq grouplens-previous-article (bbb-get-current-id))))
743
744;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
745;; BUG REPORTING
746;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
747
748(defconst gnus-gl-version "gnus-gl.el 2.50")
749(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
750(defun gnus-gl-submit-bug-report ()
751 "Submit via mail a bug report on gnus-gl."
752 (interactive)
753 (require 'reporter)
754 (reporter-submit-bug-report gnus-gl-maintainer-address
755 (concat "gnus-gl.el " gnus-gl-version)
756 (list 'grouplens-pseudonym
757 'grouplens-bbb-host
758 'grouplens-bbb-port
759 'grouplens-newsgroups
760 'grouplens-bbb-token
761 'grouplens-bbb-process
762 'grouplens-current-group
763 'grouplens-previous-article)
764 nil
765 'gnus-gl-get-trace))
766
767(defun gnus-gl-get-trace ()
768 "Insert the contents of the BBBD trace buffer."
769 (when grouplens-bbb-buffer
770 (insert-buffer-substring grouplens-bbb-buffer)))
771
772;;
773;; GroupLens minor mode
774;;
775
776(defvar gnus-grouplens-mode nil
777 "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
778
779(defvar gnus-grouplens-mode-map nil)
780
781(unless gnus-grouplens-mode-map
782 (setq gnus-grouplens-mode-map (make-keymap))
783 (gnus-define-keys
784 gnus-grouplens-mode-map
785 "n" grouplens-next-unread-article
786 "r" bbb-summary-rate-article
787 "k" grouplens-score-thread
788 "c" grouplens-summary-catchup-and-exit
789 "," grouplens-best-unread-article))
790
791(defun gnus-grouplens-make-menu-bar ()
792 (unless (boundp 'gnus-grouplens-menu)
793 (easy-menu-define
794 gnus-grouplens-menu gnus-grouplens-mode-map ""
795 '("GroupLens"
796 ["Login" bbb-login t]
797 ["Rate" bbb-summary-rate-article t]
798 ["Next article" grouplens-next-unread-article t]
799 ["Best article" grouplens-best-unread-article t]
800 ["Raise thread" grouplens-score-thread t]
801 ["Report bugs" gnus-gl-submit-bug-report t]))))
802
803(defun gnus-grouplens-mode (&optional arg)
804 "Minor mode for providing a GroupLens interface in Gnus summary buffers."
805 (interactive "P")
806 (when (and (eq major-mode 'gnus-summary-mode)
807 (member gnus-newsgroup-name grouplens-newsgroups))
808 (make-local-variable 'gnus-grouplens-mode)
809 (setq gnus-grouplens-mode
810 (if (null arg) (not gnus-grouplens-mode)
811 (> (prefix-numeric-value arg) 0)))
812 (when gnus-grouplens-mode
813 (gnus-make-local-hook 'gnus-select-article-hook)
814 (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)
815 (gnus-make-local-hook 'gnus-exit-group-hook)
816 (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local)
817 (make-local-variable 'gnus-score-find-score-files-function)
818
819 (cond
820 ((eq gnus-grouplens-override-scoring 'combine)
821 ;; either add bbb-buld-mid-scores-alist to a list
822 ;; or make a list
823 (if (listp gnus-score-find-score-files-function)
824 (setq gnus-score-find-score-files-function
825 (append 'bbb-build-mid-scores-alist
826 gnus-score-find-score-files-function))
827 (setq gnus-score-find-score-files-function
828 (list gnus-score-find-score-files-function
829 'bbb-build-mid-scores-alist))))
830 ;; leave the gnus-score-find-score-files variable alone
831 ((eq gnus-grouplens-override-scoring 'separate)
832 (add-hook 'gnus-select-group-hook
833 (lambda ()
834 (bbb-get-predictions (bbb-get-all-mids)
835 gnus-newsgroup-name))))
836 ;; default is to override
837 (t
838 (setq gnus-score-find-score-files-function
839 'bbb-build-mid-scores-alist)))
840
841 ;; Change how summary lines look
842 (make-local-variable 'gnus-summary-line-format)
843 (make-local-variable 'gnus-summary-line-format-spec)
844 (setq gnus-summary-line-format gnus-summary-grouplens-line-format)
845 (setq gnus-summary-line-format-spec nil)
846 (gnus-update-format-specifications nil 'summary)
847 (gnus-update-summary-mark-positions)
848
849 ;; Set up the menu.
850 (when (and menu-bar-mode
851 (gnus-visual-p 'grouplens-menu 'menu))
852 (gnus-grouplens-make-menu-bar))
853 (gnus-add-minor-mode
854 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map)
855 (gnus-run-hooks 'gnus-grouplens-mode-hook))))
856
857(provide 'gnus-gl)
858
859;;; arch-tag: 6f1bab2c-c2a3-4764-9ef6-0714cd5902a4
860;;; gnus-gl.el ends here
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 3c5cd7bedef..acf07fd985b 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -47,7 +47,11 @@
47 (require 'mm-url) 47 (require 'mm-url)
48 (let ((features (cons 'gnus-group features))) 48 (let ((features (cons 'gnus-group features)))
49 (require 'gnus-sum)) 49 (require 'gnus-sum))
50 (defvar gnus-cache-active-hashtb)) 50 (unless (boundp 'gnus-cache-active-hashtb)
51 (defvar gnus-cache-active-hashtb nil)))
52
53(autoload 'gnus-agent-total-fetched-for "gnus-agent")
54(autoload 'gnus-cache-total-fetched-for "gnus-cache")
51 55
52(defcustom gnus-group-archive-directory 56(defcustom gnus-group-archive-directory
53 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" 57 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
@@ -61,7 +65,7 @@
61 :group 'gnus-group-foreign 65 :group 'gnus-group-foreign
62 :type 'directory) 66 :type 'directory)
63 67
64(defcustom gnus-no-groups-message "No gnus is bad news" 68(defcustom gnus-no-groups-message "No Gnus is good news"
65 "*Message displayed by Gnus when no groups are available." 69 "*Message displayed by Gnus when no groups are available."
66 :group 'gnus-start 70 :group 'gnus-start
67 :type 'string) 71 :type 'string)
@@ -151,7 +155,7 @@ list."
151 (function-item gnus-group-sort-by-rank) 155 (function-item gnus-group-sort-by-rank)
152 (function :tag "other" nil)))) 156 (function :tag "other" nil))))
153 157
154(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n" 158(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n"
155 "*Format of group lines. 159 "*Format of group lines.
156It works along the same lines as a normal formatting string, 160It works along the same lines as a normal formatting string,
157with some simple extensions. 161with some simple extensions.
@@ -179,11 +183,11 @@ with some simple extensions.
179%O Moderated group (string, \"(m)\" or \"\") 183%O Moderated group (string, \"(m)\" or \"\")
180%P Topic indentation (string) 184%P Topic indentation (string)
181%m Whether there is new(ish) mail in the group (char, \"%\") 185%m Whether there is new(ish) mail in the group (char, \"%\")
182%l Whether there are GroupLens predictions for this group (string)
183%n Select from where (string) 186%n Select from where (string)
184%z A string that look like `<%s:%n>' if a foreign select method is used 187%z A string that look like `<%s:%n>' if a foreign select method is used
185%d The date the group was last entered. 188%d The date the group was last entered.
186%E Icon as defined by `gnus-group-icon-list'. 189%E Icon as defined by `gnus-group-icon-list'.
190%F The disk space used by the articles fetched by both the cache and agent.
187%u User defined specifier. The next character in the format string should 191%u User defined specifier. The next character in the format string should
188 be a letter. Gnus will call the function gnus-user-format-function-X, 192 be a letter. Gnus will call the function gnus-user-format-function-X,
189 where X is the letter following %u. The function will be passed a 193 where X is the letter following %u. The function will be passed a
@@ -198,10 +202,10 @@ output may end up looking strange when listing both alive and killed
198groups. 202groups.
199 203
200If you use %o or %O, reading the active file will be slower and quite 204If you use %o or %O, reading the active file will be slower and quite
201a bit of extra memory will be used. %D will also worsen performance. 205a bit of extra memory will be used. %D and %F will also worsen
202Also note that if you change the format specification to include any 206performance. Also note that if you change the format specification to
203of these specs, you must probably re-start Gnus to see them go into 207include any of these specs, you must probably re-start Gnus to see
204effect. 208them go into effect.
205 209
206General format specifiers can also be used. 210General format specifiers can also be used.
207See Info node `(gnus)Formatting Variables'." 211See Info node `(gnus)Formatting Variables'."
@@ -440,13 +444,20 @@ For example:
440 444
441(defcustom gnus-group-jump-to-group-prompt nil 445(defcustom gnus-group-jump-to-group-prompt nil
442 "Default prompt for `gnus-group-jump-to-group'. 446 "Default prompt for `gnus-group-jump-to-group'.
443If non-nil, the value should be a string, e.g. \"nnml:\", 447
444in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" 448If non-nil, the value should be a string or an alist. If it is a string,
445in the minibuffer prompt." 449e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
450nnml:\" in the minibuffer prompt.
451
452If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example:
453\((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is
454used when no prefix argument is given to `gnus-group-jump-to-group'."
446 :version "22.1" 455 :version "22.1"
447 :group 'gnus-group-various 456 :group 'gnus-group-various
448 :type '(choice (string :tag "Prompt string") 457 :type '(choice (string :tag "Prompt string")
449 (const :tag "Empty" nil))) 458 (const :tag "Empty" nil)
459 (repeat (cons (integer :tag "Argument")
460 (string :tag "Prompt string")))))
450 461
451(defvar gnus-group-listing-limit 1000 462(defvar gnus-group-listing-limit 1000
452 "*A limit of the number of groups when listing. 463 "*A limit of the number of groups when listing.
@@ -512,11 +523,12 @@ simple manner.")
512 (?P gnus-group-indentation ?s) 523 (?P gnus-group-indentation ?s)
513 (?E gnus-tmp-group-icon ?s) 524 (?E gnus-tmp-group-icon ?s)
514 (?B gnus-tmp-summary-live ?c) 525 (?B gnus-tmp-summary-live ?c)
515 (?l gnus-tmp-grouplens ?s)
516 (?z gnus-tmp-news-method-string ?s) 526 (?z gnus-tmp-news-method-string ?s)
517 (?m (gnus-group-new-mail gnus-tmp-group) ?c) 527 (?m (gnus-group-new-mail gnus-tmp-group) ?c)
518 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) 528 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
519 (?u gnus-tmp-user-defined ?s))) 529 (?u gnus-tmp-user-defined ?s)
530 (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
531 ))
520 532
521(defvar gnus-group-mode-line-format-alist 533(defvar gnus-group-mode-line-format-alist
522 `((?S gnus-tmp-news-server ?s) 534 `((?S gnus-tmp-news-server ?s)
@@ -648,6 +660,7 @@ simple manner.")
648 "r" gnus-group-rename-group 660 "r" gnus-group-rename-group
649 "R" gnus-group-make-rss-group 661 "R" gnus-group-make-rss-group
650 "c" gnus-group-customize 662 "c" gnus-group-customize
663 "z" gnus-group-compact-group
651 "x" gnus-group-nnimap-expunge 664 "x" gnus-group-nnimap-expunge
652 "\177" gnus-group-delete-group 665 "\177" gnus-group-delete-group
653 [delete] gnus-group-delete-group) 666 [delete] gnus-group-delete-group)
@@ -730,7 +743,8 @@ simple manner.")
730 "?" gnus-group-list-plus) 743 "?" gnus-group-list-plus)
731 744
732(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) 745(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
733 "f" gnus-score-flush-cache) 746 "f" gnus-score-flush-cache
747 "e" gnus-score-edit-all-score)
734 748
735(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) 749(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
736 "c" gnus-group-fetch-charter 750 "c" gnus-group-fetch-charter
@@ -825,6 +839,8 @@ simple manner.")
825 (gnus-group-group-name)] 839 (gnus-group-group-name)]
826 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] 840 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
827 ["Customize" gnus-group-customize (gnus-group-group-name)] 841 ["Customize" gnus-group-customize (gnus-group-group-name)]
842 ["Compact" gnus-group-compact-group
843 :active (gnus-group-group-name)]
828 ("Edit" 844 ("Edit"
829 ["Parameters" gnus-group-edit-group-parameters 845 ["Parameters" gnus-group-edit-group-parameters
830 :included (not (gnus-topic-mode-p)) 846 :included (not (gnus-topic-mode-p))
@@ -1010,7 +1026,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
1010 (const :tag "Retro look" gnus-group-tool-bar-retro) 1026 (const :tag "Retro look" gnus-group-tool-bar-retro)
1011 (repeat :tag "User defined list" gmm-tool-bar-item) 1027 (repeat :tag "User defined list" gmm-tool-bar-item)
1012 (symbol)) 1028 (symbol))
1013 :version "22.1" ;; Gnus 5.10.9 1029 :version "23.0" ;; No Gnus
1014 :initialize 'custom-initialize-default 1030 :initialize 'custom-initialize-default
1015 :set 'gnus-group-tool-bar-update 1031 :set 'gnus-group-tool-bar-update
1016 :group 'gnus-group) 1032 :group 'gnus-group)
@@ -1053,7 +1069,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
1053 1069
1054See `gmm-tool-bar-from-list' for the format of the list." 1070See `gmm-tool-bar-from-list' for the format of the list."
1055 :type '(repeat gmm-tool-bar-item) 1071 :type '(repeat gmm-tool-bar-item)
1056 :version "22.1" ;; Gnus 5.10.9 1072 :version "23.0" ;; No Gnus
1057 :initialize 'custom-initialize-default 1073 :initialize 'custom-initialize-default
1058 :set 'gnus-group-tool-bar-update 1074 :set 'gnus-group-tool-bar-update
1059 :group 'gnus-group) 1075 :group 'gnus-group)
@@ -1072,7 +1088,7 @@ See `gmm-tool-bar-from-list' for the format of the list."
1072 1088
1073See `gmm-tool-bar-from-list' for the format of the list." 1089See `gmm-tool-bar-from-list' for the format of the list."
1074 :type '(repeat gmm-tool-bar-item) 1090 :type '(repeat gmm-tool-bar-item)
1075 :version "22.1" ;; Gnus 5.10.9 1091 :version "23.0" ;; No Gnus
1076 :initialize 'custom-initialize-default 1092 :initialize 'custom-initialize-default
1077 :set 'gnus-group-tool-bar-update 1093 :set 'gnus-group-tool-bar-update
1078 :group 'gnus-group) 1094 :group 'gnus-group)
@@ -1083,7 +1099,7 @@ These items are not displayed in the Gnus group mode tool bar.
1083 1099
1084See `gmm-tool-bar-from-list' for the format of the list." 1100See `gmm-tool-bar-from-list' for the format of the list."
1085 :type 'gmm-tool-bar-zap-list 1101 :type 'gmm-tool-bar-zap-list
1086 :version "22.1" ;; Gnus 5.10.9 1102 :version "23.0" ;; No Gnus
1087 :initialize 'custom-initialize-default 1103 :initialize 'custom-initialize-default
1088 :set 'gnus-group-tool-bar-update 1104 :set 'gnus-group-tool-bar-update
1089 :group 'gnus-group) 1105 :group 'gnus-group)
@@ -1143,7 +1159,8 @@ The following commands are available:
1143 (use-local-map gnus-group-mode-map) 1159 (use-local-map gnus-group-mode-map)
1144 (buffer-disable-undo) 1160 (buffer-disable-undo)
1145 (setq truncate-lines t) 1161 (setq truncate-lines t)
1146 (setq buffer-read-only t) 1162 (setq buffer-read-only t
1163 show-trailing-whitespace nil)
1147 (gnus-set-default-directory) 1164 (gnus-set-default-directory)
1148 (gnus-update-format-specifications nil 'group 'group-mode) 1165 (gnus-update-format-specifications nil 'group 'group-mode)
1149 (gnus-update-group-mark-positions) 1166 (gnus-update-group-mark-positions)
@@ -1202,7 +1219,10 @@ The following commands are available:
1202(defun gnus-group-name-charset (method group) 1219(defun gnus-group-name-charset (method group)
1203 (if (null method) 1220 (if (null method)
1204 (setq method (gnus-find-method-for-group group))) 1221 (setq method (gnus-find-method-for-group group)))
1205 (let ((item (assoc method gnus-group-name-charset-method-alist)) 1222 (let ((item (or (assoc method gnus-group-name-charset-method-alist)
1223 (and (consp method)
1224 (assoc (list (car method) (cadr method))
1225 gnus-group-name-charset-method-alist))))
1206 (alist gnus-group-name-charset-group-alist) 1226 (alist gnus-group-name-charset-group-alist)
1207 result) 1227 result)
1208 (if item 1228 (if item
@@ -1244,7 +1264,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
1244 (gnus-group-setup-buffer) 1264 (gnus-group-setup-buffer)
1245 (gnus-update-format-specifications nil 'group 'group-mode) 1265 (gnus-update-format-specifications nil 'group 'group-mode)
1246 (let ((case-fold-search nil) 1266 (let ((case-fold-search nil)
1247 (props (text-properties-at (gnus-point-at-bol))) 1267 (props (text-properties-at (point-at-bol)))
1248 (empty (= (point-min) (point-max))) 1268 (empty (= (point-min) (point-max)))
1249 (group (gnus-group-group-name)) 1269 (group (gnus-group-group-name))
1250 number) 1270 number)
@@ -1276,7 +1296,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
1276 (point-min) (point-max) 1296 (point-min) (point-max)
1277 'gnus-group (gnus-intern-safe 1297 'gnus-group (gnus-intern-safe
1278 group gnus-active-hashtb)))) 1298 group gnus-active-hashtb))))
1279 (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) 1299 (let ((newsrc (cdddr (gnus-group-entry group))))
1280 (while (and newsrc 1300 (while (and newsrc
1281 (not (gnus-goto-char 1301 (not (gnus-goto-char
1282 (text-property-any 1302 (text-property-any
@@ -1331,7 +1351,7 @@ if it is a string, only list groups matching REGEXP."
1331 group (gnus-info-group info) 1351 group (gnus-info-group info)
1332 params (gnus-info-params info) 1352 params (gnus-info-params info)
1333 newsrc (cdr newsrc) 1353 newsrc (cdr newsrc)
1334 unread (car (gnus-gethash group gnus-newsrc-hashtb))) 1354 unread (gnus-group-unread group))
1335 (when not-in-list 1355 (when not-in-list
1336 (setq not-in-list (delete group not-in-list))) 1356 (setq not-in-list (delete group not-in-list)))
1337 (when (gnus-group-prepare-logic 1357 (when (gnus-group-prepare-logic
@@ -1431,7 +1451,7 @@ if it is a string, only list groups matching REGEXP."
1431 "Update the current line in the group buffer." 1451 "Update the current line in the group buffer."
1432 (let* ((buffer-read-only nil) 1452 (let* ((buffer-read-only nil)
1433 (group (gnus-group-group-name)) 1453 (group (gnus-group-group-name))
1434 (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) 1454 (entry (and group (gnus-group-entry group)))
1435 gnus-group-indentation) 1455 gnus-group-indentation)
1436 (when group 1456 (when group
1437 (and entry 1457 (and entry
@@ -1448,7 +1468,7 @@ if it is a string, only list groups matching REGEXP."
1448 1468
1449(defun gnus-group-insert-group-line-info (group) 1469(defun gnus-group-insert-group-line-info (group)
1450 "Insert GROUP on the current line." 1470 "Insert GROUP on the current line."
1451 (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) 1471 (let ((entry (gnus-group-entry group))
1452 (gnus-group-indentation (gnus-group-group-indentation)) 1472 (gnus-group-indentation (gnus-group-group-indentation))
1453 active info) 1473 active info)
1454 (if entry 1474 (if entry
@@ -1575,10 +1595,6 @@ if it is a string, only list groups matching REGEXP."
1575 (gnus-tmp-process-marked 1595 (gnus-tmp-process-marked
1576 (if (member gnus-tmp-group gnus-group-marked) 1596 (if (member gnus-tmp-group gnus-group-marked)
1577 gnus-process-mark ? )) 1597 gnus-process-mark ? ))
1578 (gnus-tmp-grouplens
1579 (or (and gnus-use-grouplens
1580 (bbb-grouplens-group-p gnus-tmp-group))
1581 ""))
1582 (buffer-read-only nil) 1598 (buffer-read-only nil)
1583 beg end 1599 beg end
1584 header gnus-tmp-header) ; passed as parameter to user-funcs. 1600 header gnus-tmp-header) ; passed as parameter to user-funcs.
@@ -1615,7 +1631,7 @@ if it is a string, only list groups matching REGEXP."
1615 "Highlight the current line according to `gnus-group-highlight'." 1631 "Highlight the current line according to `gnus-group-highlight'."
1616 (let* ((list gnus-group-highlight) 1632 (let* ((list gnus-group-highlight)
1617 (p (point)) 1633 (p (point))
1618 (end (gnus-point-at-eol)) 1634 (end (point-at-eol))
1619 ;; now find out where the line starts and leave point there. 1635 ;; now find out where the line starts and leave point there.
1620 (beg (progn (beginning-of-line) (point))) 1636 (beg (progn (beginning-of-line) (point)))
1621 (group (gnus-group-group-name)) 1637 (group (gnus-group-group-name))
@@ -1666,7 +1682,7 @@ already."
1666 (loc (point-min)) 1682 (loc (point-min))
1667 found buffer-read-only) 1683 found buffer-read-only)
1668 ;; Enter the current status into the dribble buffer. 1684 ;; Enter the current status into the dribble buffer.
1669 (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) 1685 (let ((entry (gnus-group-entry group)))
1670 (when (and entry 1686 (when (and entry
1671 (not (gnus-ephemeral-group-p group))) 1687 (not (gnus-ephemeral-group-p group)))
1672 (gnus-dribble-enter 1688 (gnus-dribble-enter
@@ -1691,7 +1707,7 @@ already."
1691 ;; go, and insert it there (or at the end of the buffer). 1707 ;; go, and insert it there (or at the end of the buffer).
1692 (if gnus-goto-missing-group-function 1708 (if gnus-goto-missing-group-function
1693 (funcall gnus-goto-missing-group-function group) 1709 (funcall gnus-goto-missing-group-function group)
1694 (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) 1710 (let ((entry (cddr (gnus-group-entry group))))
1695 (while (and entry (car entry) 1711 (while (and entry (car entry)
1696 (not 1712 (not
1697 (gnus-goto-char 1713 (gnus-goto-char
@@ -1751,24 +1767,24 @@ already."
1751 1767
1752(defun gnus-group-group-name () 1768(defun gnus-group-group-name ()
1753 "Get the name of the newsgroup on the current line." 1769 "Get the name of the newsgroup on the current line."
1754 (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) 1770 (let ((group (get-text-property (point-at-bol) 'gnus-group)))
1755 (when group 1771 (when group
1756 (symbol-name group)))) 1772 (symbol-name group))))
1757 1773
1758(defun gnus-group-group-level () 1774(defun gnus-group-group-level ()
1759 "Get the level of the newsgroup on the current line." 1775 "Get the level of the newsgroup on the current line."
1760 (get-text-property (gnus-point-at-bol) 'gnus-level)) 1776 (get-text-property (point-at-bol) 'gnus-level))
1761 1777
1762(defun gnus-group-group-indentation () 1778(defun gnus-group-group-indentation ()
1763 "Get the indentation of the newsgroup on the current line." 1779 "Get the indentation of the newsgroup on the current line."
1764 (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) 1780 (or (get-text-property (point-at-bol) 'gnus-indentation)
1765 (and gnus-group-indentation-function 1781 (and gnus-group-indentation-function
1766 (funcall gnus-group-indentation-function)) 1782 (funcall gnus-group-indentation-function))
1767 "")) 1783 ""))
1768 1784
1769(defun gnus-group-group-unread () 1785(defun gnus-group-group-unread ()
1770 "Get the number of unread articles of the newsgroup on the current line." 1786 "Get the number of unread articles of the newsgroup on the current line."
1771 (get-text-property (gnus-point-at-bol) 'gnus-unread)) 1787 (get-text-property (point-at-bol) 'gnus-unread))
1772 1788
1773(defun gnus-group-new-mail (group) 1789(defun gnus-group-new-mail (group)
1774 (if (nnmail-new-mail-p (gnus-group-real-name group)) 1790 (if (nnmail-new-mail-p (gnus-group-real-name group))
@@ -1826,6 +1842,18 @@ If FIRST-TOO, the current line is also eligible as a target."
1826 (goto-char (or pos beg)) 1842 (goto-char (or pos beg))
1827 (and pos t)))) 1843 (and pos t))))
1828 1844
1845(defun gnus-total-fetched-for (group)
1846 (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0))
1847 (size-in-agent (or (gnus-agent-total-fetched-for group) 0))
1848 (size (+ size-in-cache size-in-agent))
1849 (suffix '("B" "K" "M" "G"))
1850 (scale 1024.0)
1851 (cutoff scale))
1852 (while (> size cutoff)
1853 (setq size (/ size scale)
1854 suffix (cdr suffix)))
1855 (format "%5.1f%s" size (car suffix))))
1856
1829;;; Gnus group mode commands 1857;;; Gnus group mode commands
1830 1858
1831;; Group marking. 1859;; Group marking.
@@ -1847,15 +1875,14 @@ If FIRST-TOO, the current line is also eligible as a target."
1847 ;; Go to the mark position. 1875 ;; Go to the mark position.
1848 (beginning-of-line) 1876 (beginning-of-line)
1849 (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) 1877 (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1850 (subst-char-in-region 1878 (delete-char 1)
1851 (point) (1+ (point)) (char-after) 1879 (if unmark
1852 (if unmark 1880 (progn
1853 (progn 1881 (setq gnus-group-marked (delete group gnus-group-marked))
1854 (setq gnus-group-marked (delete group gnus-group-marked)) 1882 (insert-char ? 1 t))
1855 ? )
1856 (setq gnus-group-marked 1883 (setq gnus-group-marked
1857 (cons group (delete group gnus-group-marked))) 1884 (cons group (delete group gnus-group-marked)))
1858 gnus-process-mark))) 1885 (insert-char gnus-process-mark 1 t)))
1859 (unless no-advance 1886 (unless no-advance
1860 (gnus-group-next-group 1)) 1887 (gnus-group-next-group 1))
1861 (decf n)) 1888 (decf n))
@@ -1871,10 +1898,8 @@ If FIRST-TOO, the current line is also eligible as a target."
1871(defun gnus-group-unmark-all-groups () 1898(defun gnus-group-unmark-all-groups ()
1872 "Unmark all groups." 1899 "Unmark all groups."
1873 (interactive) 1900 (interactive)
1874 (let ((groups gnus-group-marked)) 1901 (save-excursion
1875 (save-excursion 1902 (mapc 'gnus-group-remove-mark gnus-group-marked))
1876 (while groups
1877 (gnus-group-remove-mark (pop groups)))))
1878 (gnus-group-position-point)) 1903 (gnus-group-position-point))
1879 1904
1880(defun gnus-group-mark-region (unmark beg end) 1905(defun gnus-group-mark-region (unmark beg end)
@@ -2020,8 +2045,7 @@ group."
2020 (unless group 2045 (unless group
2021 (error "No group on current line")) 2046 (error "No group on current line"))
2022 (setq marked (gnus-info-marks 2047 (setq marked (gnus-info-marks
2023 (nth 2 (setq entry (gnus-gethash 2048 (nth 2 (setq entry (gnus-group-entry group)))))
2024 group gnus-newsrc-hashtb)))))
2025 ;; This group might be a dead group. In that case we have to get 2049 ;; This group might be a dead group. In that case we have to get
2026 ;; the number of unread articles from `gnus-active-hashtb'. 2050 ;; the number of unread articles from `gnus-active-hashtb'.
2027 (setq number 2051 (setq number
@@ -2051,11 +2075,11 @@ articles in the group."
2051 (forward-line -1)) 2075 (forward-line -1))
2052 (gnus-group-read-group all t)) 2076 (gnus-group-read-group all t))
2053 2077
2054(defun gnus-group-quick-select-group (&optional all) 2078(defun gnus-group-quick-select-group (&optional all group)
2055 "Select the current group \"quickly\". 2079 "Select the GROUP \"quickly\".
2056This means that no highlighting or scoring will be performed. 2080This means that no highlighting or scoring will be performed. If
2057If ALL (the prefix argument) is 0, don't even generate the summary 2081ALL (the prefix argument) is 0, don't even generate the summary
2058buffer. 2082buffer. If GROUP is nil, use current group.
2059 2083
2060This might be useful if you want to toggle threading 2084This might be useful if you want to toggle threading
2061before entering the group." 2085before entering the group."
@@ -2066,7 +2090,7 @@ before entering the group."
2066 gnus-home-score-file 2090 gnus-home-score-file
2067 gnus-apply-kill-hook 2091 gnus-apply-kill-hook
2068 gnus-summary-expunge-below) 2092 gnus-summary-expunge-below)
2069 (gnus-group-read-group all t))) 2093 (gnus-group-read-group all t group)))
2070 2094
2071(defun gnus-group-visible-select-group (&optional all) 2095(defun gnus-group-visible-select-group (&optional all)
2072 "Select the current group without hiding any articles." 2096 "Select the current group without hiding any articles."
@@ -2090,14 +2114,86 @@ be permanent."
2090 (gnus-group-read-ephemeral-group 2114 (gnus-group-read-ephemeral-group
2091 (gnus-group-prefixed-name group method) method))) 2115 (gnus-group-prefixed-name group method) method)))
2092 2116
2117(defun gnus-group-name-at-point ()
2118 "Return a group name from around point if it exists, or nil."
2119 (if (eq major-mode 'gnus-group-mode)
2120 (let ((group (gnus-group-group-name)))
2121 (when group
2122 (gnus-group-decoded-name group)))
2123 (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
2124\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
2125\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
2126\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)")
2127 (start (point))
2128 (case-fold-search nil))
2129 (prog1
2130 (if (or (and (not (or (eobp)
2131 (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]")))
2132 (prog1 t
2133 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2134 (point-at-bol))))
2135 (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$")
2136 (prog1 t
2137 (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2138 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2139 (point-at-bol))))
2140 (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'"
2141 (buffer-substring (point-at-bol) (point))))
2142 (when (looking-at regexp)
2143 (match-string 1))
2144 (let (group distance)
2145 (when (looking-at regexp)
2146 (setq group (match-string 1)
2147 distance (- (match-beginning 1) (match-beginning 0))))
2148 (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2149 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2150 (point-at-bol))
2151 (if (looking-at regexp)
2152 (if (and group (<= distance (- start (match-end 0))))
2153 group
2154 (match-string 1))
2155 group)))
2156 (goto-char start)))))
2157
2158(defun gnus-group-completing-read (prompt &optional collection predicate
2159 require-match initial-input hist def
2160 &rest args)
2161 "Read a group name with completion. Non-ASCII group names are allowed.
2162The arguments are the same as `completing-read' except that COLLECTION
2163and HIST default to `gnus-active-hashtb' and `gnus-group-history'
2164respectively if they are omitted."
2165 (let (group)
2166 (mapatoms (lambda (symbol)
2167 (setq group (symbol-name symbol))
2168 (set (intern (if (string-match "[^\000-\177]" group)
2169 (gnus-group-decoded-name group)
2170 group)
2171 collection)
2172 group))
2173 (prog1
2174 (or collection
2175 (setq collection (or gnus-active-hashtb [0])))
2176 (setq collection (gnus-make-hashtable (length collection)))))
2177 (setq group (apply 'completing-read prompt collection predicate
2178 require-match initial-input
2179 (or hist 'gnus-group-history)
2180 def args))
2181 (or (prog1
2182 (symbol-value (intern-soft group collection))
2183 (setq collection nil))
2184 (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
2185
2093;;;###autoload 2186;;;###autoload
2094(defun gnus-fetch-group (group &optional articles) 2187(defun gnus-fetch-group (group &optional articles)
2095 "Start Gnus if necessary and enter GROUP. 2188 "Start Gnus if necessary and enter GROUP.
2189If ARTICLES, display those articles.
2096Returns whether the fetching was successful or not." 2190Returns whether the fetching was successful or not."
2097 (interactive (list (completing-read "Group name: " gnus-active-hashtb))) 2191 (interactive (list (gnus-group-completing-read "Group name: "
2098 (unless (get-buffer gnus-group-buffer) 2192 nil nil nil
2193 (gnus-group-name-at-point))))
2194 (unless (gnus-alive-p)
2099 (gnus-no-server)) 2195 (gnus-no-server))
2100 (gnus-group-read-group articles nil group)) 2196 (gnus-group-read-group (if articles nil t) nil group articles))
2101 2197
2102;;;###autoload 2198;;;###autoload
2103(defun gnus-fetch-group-other-frame (group) 2199(defun gnus-fetch-group-other-frame (group)
@@ -2155,10 +2251,7 @@ Return the name of the group if selection was successful."
2155 (interactive 2251 (interactive
2156 (list 2252 (list
2157 ;; (gnus-read-group "Group name: ") 2253 ;; (gnus-read-group "Group name: ")
2158 (completing-read 2254 (gnus-group-completing-read "Group: ")
2159 "Group: " gnus-active-hashtb
2160 nil nil nil
2161 'gnus-group-history)
2162 (gnus-read-method "From method: "))) 2255 (gnus-read-method "From method: ")))
2163 ;; Transform the select method into a unique server. 2256 ;; Transform the select method into a unique server.
2164 (when (stringp method) 2257 (when (stringp method)
@@ -2204,15 +2297,20 @@ Return the name of the group if selection was successful."
2204 (message "Quit reading the ephemeral group") 2297 (message "Quit reading the ephemeral group")
2205 nil))))) 2298 nil)))))
2206 2299
2207(defun gnus-group-jump-to-group (group) 2300(defun gnus-group-jump-to-group (group &optional prompt)
2208 "Jump to newsgroup GROUP." 2301 "Jump to newsgroup GROUP.
2302
2303If PROMPT (the prefix) is a number, use the prompt specified in
2304`gnus-group-jump-to-group-prompt'."
2209 (interactive 2305 (interactive
2210 (list (mm-string-make-unibyte 2306 (list (gnus-group-completing-read
2211 (completing-read 2307 "Group: " nil nil (gnus-read-active-file-p)
2212 "Group: " gnus-active-hashtb nil 2308 (if current-prefix-arg
2213 (gnus-read-active-file-p) 2309 (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
2214 gnus-group-jump-to-group-prompt 2310 (or (and (stringp gnus-group-jump-to-group-prompt)
2215 'gnus-group-history)))) 2311 gnus-group-jump-to-group-prompt)
2312 (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
2313 (and (stringp p) p)))))))
2216 2314
2217 (when (equal group "") 2315 (when (equal group "")
2218 (error "Empty group name")) 2316 (error "Empty group name"))
@@ -2360,6 +2458,25 @@ If EXCLUDE-GROUP, do not go to that group."
2360 (gnus-group-position-point) 2458 (gnus-group-position-point)
2361 (and best-point (gnus-group-group-name)))) 2459 (and best-point (gnus-group-group-name))))
2362 2460
2461;; Is there something like an after-point-motion-hook?
2462;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function?
2463
2464;; (defun gnus-group-menu-bar-update ()
2465;; (let* ((buf (list (with-current-buffer gnus-group-buffer
2466;; (current-buffer))))
2467;; (name (buffer-name (car buf))))
2468;; (setcdr buf
2469;; (if (> (length name) 27)
2470;; (concat (substring name 0 12)
2471;; "..."
2472;; (substring name -12))
2473;; name))
2474;; (menu-bar-update-buffers-1 buf)))
2475
2476;; (defun gnus-group-position-point ()
2477;; (gnus-goto-colon)
2478;; (gnus-group-menu-bar-update))
2479
2363(defun gnus-group-first-unread-group () 2480(defun gnus-group-first-unread-group ()
2364 "Go to the first group with unread articles." 2481 "Go to the first group with unread articles."
2365 (interactive) 2482 (interactive)
@@ -2381,10 +2498,19 @@ If EXCLUDE-GROUP, do not go to that group."
2381 (interactive) 2498 (interactive)
2382 (gnus-enter-server-buffer)) 2499 (gnus-enter-server-buffer))
2383 2500
2384(defun gnus-group-make-group (name &optional method address args) 2501(defun gnus-group-make-group-simple (&optional group)
2502 "Add a new newsgroup.
2503The user will be prompted for GROUP."
2504 (interactive (list (gnus-group-completing-read "Group: ")))
2505 (gnus-group-make-group (gnus-group-real-name group)
2506 (gnus-group-server group)
2507 nil nil t))
2508
2509(defun gnus-group-make-group (name &optional method address args encoded)
2385 "Add a new newsgroup. 2510 "Add a new newsgroup.
2386The user will be prompted for a NAME, for a select METHOD, and an 2511The user will be prompted for a NAME, for a select METHOD, and an
2387ADDRESS." 2512ADDRESS. NAME should be a human-readable string (i.e., not be encoded
2513even if it contains non-ASCII characters) unless ENCODED is non-nil."
2388 (interactive 2514 (interactive
2389 (list 2515 (list
2390 (gnus-read-group "Group name: ") 2516 (gnus-read-group "Group name: ")
@@ -2392,6 +2518,10 @@ ADDRESS."
2392 2518
2393 (when (stringp method) 2519 (when (stringp method)
2394 (setq method (or (gnus-server-to-method method) method))) 2520 (setq method (or (gnus-server-to-method method) method)))
2521 (unless encoded
2522 (setq name (mm-encode-coding-string
2523 name
2524 (gnus-group-name-charset method name))))
2395 (let* ((meth (gnus-method-simplify 2525 (let* ((meth (gnus-method-simplify
2396 (when (and method 2526 (when (and method
2397 (not (gnus-server-equal method gnus-select-method))) 2527 (not (gnus-server-equal method gnus-select-method)))
@@ -2399,15 +2529,14 @@ ADDRESS."
2399 method)))) 2529 method))))
2400 (nname (if method (gnus-group-prefixed-name name meth) name)) 2530 (nname (if method (gnus-group-prefixed-name name meth) name))
2401 backend info) 2531 backend info)
2402 (when (gnus-gethash nname gnus-newsrc-hashtb) 2532 (when (gnus-group-entry nname)
2403 (error "Group %s already exists" (gnus-group-decoded-name nname))) 2533 (error "Group %s already exists" (gnus-group-decoded-name nname)))
2404 ;; Subscribe to the new group. 2534 ;; Subscribe to the new group.
2405 (gnus-group-change-level 2535 (gnus-group-change-level
2406 (setq info (list t nname gnus-level-default-subscribed nil nil meth)) 2536 (setq info (list t nname gnus-level-default-subscribed nil nil meth))
2407 gnus-level-default-subscribed gnus-level-killed 2537 gnus-level-default-subscribed gnus-level-killed
2408 (and (gnus-group-group-name) 2538 (and (gnus-group-group-name)
2409 (gnus-gethash (gnus-group-group-name) 2539 (gnus-group-entry (gnus-group-group-name)))
2410 gnus-newsrc-hashtb))
2411 t) 2540 t)
2412 ;; Make it active. 2541 ;; Make it active.
2413 (gnus-set-active nname (cons 1 0)) 2542 (gnus-set-active nname (cons 1 0))
@@ -2474,7 +2603,7 @@ be removed from the server, even when it's empty."
2474 (gnus-message 6 "Deleting group %s...done" group-decoded) 2603 (gnus-message 6 "Deleting group %s...done" group-decoded)
2475 (gnus-group-goto-group group) 2604 (gnus-group-goto-group group)
2476 (gnus-group-kill-group 1 t) 2605 (gnus-group-kill-group 1 t)
2477 (gnus-sethash group nil gnus-active-hashtb) 2606 (gnus-set-active group nil)
2478 t))) 2607 t)))
2479 (gnus-group-position-point))) 2608 (gnus-group-position-point)))
2480 2609
@@ -2641,7 +2770,7 @@ group already exists:
2641 (interactive) 2770 (interactive)
2642 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) 2771 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
2643 (file (nnheader-find-etc-directory "gnus-tut.txt" t))) 2772 (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
2644 (if (gnus-gethash name gnus-newsrc-hashtb) 2773 (if (gnus-group-entry name)
2645 (cond ((eq noerror nil) 2774 (cond ((eq noerror nil)
2646 (error "Documentation group already exists")) 2775 (error "Documentation group already exists"))
2647 ((eq noerror t) 2776 ((eq noerror t)
@@ -2684,19 +2813,17 @@ If called with a prefix argument, ask for the file type."
2684 nil)))) 2813 nil))))
2685 (setq type found))) 2814 (setq type found)))
2686 (setq file (expand-file-name file)) 2815 (setq file (expand-file-name file))
2687 (let ((name (gnus-generate-new-group-name 2816 (let* ((name (gnus-generate-new-group-name
2688 (gnus-group-prefixed-name 2817 (gnus-group-prefixed-name
2689 (file-name-nondirectory file) '(nndoc "")))) 2818 (file-name-nondirectory file) '(nndoc ""))))
2690 (encodable (mm-coding-system-p 'utf-8))) 2819 (method (list 'nndoc file
2820 (list 'nndoc-address file)
2821 (list 'nndoc-article-type (or type 'guess))))
2822 (coding (gnus-group-name-charset method name)))
2823 (setcar (cdr method) (mm-encode-coding-string file coding))
2691 (gnus-group-make-group 2824 (gnus-group-make-group
2692 (if encodable 2825 (mm-encode-coding-string (gnus-group-real-name name) coding)
2693 (mm-encode-coding-string (gnus-group-real-name name) 'utf-8) 2826 method nil nil t)))
2694 (gnus-group-real-name name))
2695 (list 'nndoc (if encodable
2696 (mm-encode-coding-string file 'utf-8)
2697 file)
2698 (list 'nndoc-address file)
2699 (list 'nndoc-article-type (or type 'guess))))))
2700 2827
2701(defvar nnweb-type-definition) 2828(defvar nnweb-type-definition)
2702(defvar gnus-group-web-type-history nil) 2829(defvar gnus-group-web-type-history nil)
@@ -2750,25 +2877,23 @@ If there is, use Gnus to create an nnrss group"
2750 (setq url (read-from-minibuffer "URL to Search for RSS: "))) 2877 (setq url (read-from-minibuffer "URL to Search for RSS: ")))
2751 (let ((feedinfo (nnrss-discover-feed url))) 2878 (let ((feedinfo (nnrss-discover-feed url)))
2752 (if feedinfo 2879 (if feedinfo
2753 (let ((title (gnus-newsgroup-savable-name 2880 (let* ((title (gnus-newsgroup-savable-name
2754 (read-from-minibuffer "Title: " 2881 (read-from-minibuffer "Title: "
2755 (gnus-newsgroup-savable-name 2882 (gnus-newsgroup-savable-name
2756 (or (cdr (assoc 'title 2883 (or (cdr (assoc 'title
2757 feedinfo)) 2884 feedinfo))
2758 ""))))) 2885 "")))))
2759 (desc (read-from-minibuffer "Description: " 2886 (desc (read-from-minibuffer "Description: "
2760 (cdr (assoc 'description 2887 (cdr (assoc 'description
2761 feedinfo)))) 2888 feedinfo))))
2762 (href (cdr (assoc 'href feedinfo))) 2889 (href (cdr (assoc 'href feedinfo)))
2763 (encodable (mm-coding-system-p 'utf-8))) 2890 (coding (gnus-group-name-charset '(nnrss "") title)))
2764 (when encodable 2891 (when coding
2765 ;; Unify non-ASCII text. 2892 ;; Unify non-ASCII text.
2766 (setq title (mm-decode-coding-string 2893 (setq title (mm-decode-coding-string
2767 (mm-encode-coding-string title 'utf-8) 'utf-8))) 2894 (mm-encode-coding-string title coding)
2768 (gnus-group-make-group (if encodable 2895 coding)))
2769 (mm-encode-coding-string title 'utf-8) 2896 (gnus-group-make-group title '(nnrss ""))
2770 title)
2771 '(nnrss ""))
2772 (push (list title href desc) nnrss-group-alist) 2897 (push (list title href desc) nnrss-group-alist)
2773 (nnrss-save-server-data nil)) 2898 (nnrss-save-server-data nil))
2774 (error "No feeds found for %s" url)))) 2899 (error "No feeds found for %s" url))))
@@ -2815,7 +2940,7 @@ Given a prefix, create a full group."
2815 (interactive "P") 2940 (interactive "P")
2816 (let ((group (gnus-group-prefixed-name 2941 (let ((group (gnus-group-prefixed-name
2817 (if all "ding.archives" "ding.recent") '(nndir "")))) 2942 (if all "ding.archives" "ding.recent") '(nndir ""))))
2818 (when (gnus-gethash group gnus-newsrc-hashtb) 2943 (when (gnus-group-entry group)
2819 (error "Archive group already exists")) 2944 (error "Archive group already exists"))
2820 (gnus-group-make-group 2945 (gnus-group-make-group
2821 (gnus-group-real-name group) 2946 (gnus-group-real-name group)
@@ -2839,7 +2964,7 @@ mail messages or news articles in files that have numeric names."
2839 (let ((ext "") 2964 (let ((ext "")
2840 (i 0) 2965 (i 0)
2841 group) 2966 group)
2842 (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) 2967 (while (or (not group) (gnus-group-entry group))
2843 (setq group 2968 (setq group
2844 (gnus-group-prefixed-name 2969 (gnus-group-prefixed-name
2845 (expand-file-name ext dir) 2970 (expand-file-name ext dir)
@@ -2858,7 +2983,7 @@ score file entries for articles to include in the group."
2858 (list 2983 (list
2859 (read-string "nnkiboze group name: ") 2984 (read-string "nnkiboze group name: ")
2860 (read-string "Source groups (regexp): ") 2985 (read-string "Source groups (regexp): ")
2861 (let ((headers (mapcar (lambda (group) (list group)) 2986 (let ((headers (mapcar 'list
2862 '("subject" "from" "number" "date" "message-id" 2987 '("subject" "from" "number" "date" "message-id"
2863 "references" "chars" "lines" "xref" 2988 "references" "chars" "lines" "xref"
2864 "followup" "all" "body" "head"))) 2989 "followup" "all" "body" "head")))
@@ -2909,7 +3034,7 @@ score file entries for articles to include in the group."
2909 (let* ((method (list 'nnvirtual "^$")) 3034 (let* ((method (list 'nnvirtual "^$"))
2910 (pgroup (gnus-group-prefixed-name group method))) 3035 (pgroup (gnus-group-prefixed-name group method)))
2911 ;; Check whether it exists already. 3036 ;; Check whether it exists already.
2912 (when (gnus-gethash pgroup gnus-newsrc-hashtb) 3037 (when (gnus-group-entry pgroup)
2913 (error "Group %s already exists" pgroup)) 3038 (error "Group %s already exists" pgroup))
2914 ;; Subscribe the new group after the group on the current line. 3039 ;; Subscribe the new group after the group on the current line.
2915 (gnus-subscribe-group pgroup (gnus-group-group-name) method) 3040 (gnus-subscribe-group pgroup (gnus-group-group-name) method)
@@ -3081,7 +3206,7 @@ If REVERSE, sort in reverse order."
3081 (let (entries infos) 3206 (let (entries infos)
3082 ;; First find all the group entries for these groups. 3207 ;; First find all the group entries for these groups.
3083 (while groups 3208 (while groups
3084 (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) 3209 (push (nthcdr 2 (gnus-group-entry (pop groups)))
3085 entries)) 3210 entries))
3086 ;; Then sort the infos. 3211 ;; Then sort the infos.
3087 (setq infos 3212 (setq infos
@@ -3162,8 +3287,8 @@ sort in reverse order."
3162 3287
3163(defun gnus-group-sort-by-unread (info1 info2) 3288(defun gnus-group-sort-by-unread (info1 info2)
3164 "Sort by number of unread articles." 3289 "Sort by number of unread articles."
3165 (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) 3290 (let ((n1 (gnus-group-unread (gnus-info-group info1)))
3166 (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) 3291 (n2 (gnus-group-unread (gnus-info-group info2))))
3167 (< (or (and (numberp n1) n1) 0) 3292 (< (or (and (numberp n1) n1) 0)
3168 (or (and (numberp n2) n2) 0)))) 3293 (or (and (numberp n2) n2) 0))))
3169 3294
@@ -3283,13 +3408,15 @@ up is returned."
3283 (when (eq 'nnvirtual (car method)) 3408 (when (eq 'nnvirtual (car method))
3284 (nnvirtual-catchup-group 3409 (nnvirtual-catchup-group
3285 (gnus-group-real-name group) (nth 1 method) all))) 3410 (gnus-group-real-name group) (nth 1 method) all)))
3286 (if (>= (gnus-group-level group) gnus-level-zombie) 3411 (cond
3287 (gnus-message 2 "Dead groups can't be caught up") 3412 ((>= (gnus-group-level group) gnus-level-zombie)
3288 (if (prog1 3413 (gnus-message 2 "Dead groups can't be caught up"))
3289 (gnus-group-goto-group group) 3414 ((prog1
3290 (gnus-group-catchup group all)) 3415 (gnus-group-goto-group group)
3291 (gnus-group-update-group-line) 3416 (gnus-group-catchup group all))
3292 (setq ret (1+ ret))))) 3417 (gnus-group-update-group-line))
3418 (t
3419 (setq ret (1+ ret)))))
3293 (gnus-group-next-unread-group 1) 3420 (gnus-group-next-unread-group 1)
3294 ret))) 3421 ret)))
3295 3422
@@ -3304,9 +3431,9 @@ Cross references (Xref: header) of articles are ignored."
3304If ALL is non-nil, all articles are marked as read. 3431If ALL is non-nil, all articles are marked as read.
3305The return value is the number of articles that were marked as read, 3432The return value is the number of articles that were marked as read,
3306or nil if no action could be taken." 3433or nil if no action could be taken."
3307 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) 3434 (let* ((entry (gnus-group-entry group))
3308 (num (car entry)) 3435 (num (car entry))
3309 (marks (nth 3 (nth 2 entry))) 3436 (marks (gnus-info-marks (nth 2 entry)))
3310 (unread (gnus-sequence-of-unread-articles group))) 3437 (unread (gnus-sequence-of-unread-articles group)))
3311 ;; Remove entries for this group. 3438 ;; Remove entries for this group.
3312 (nnmail-purge-split-history (gnus-group-real-name group)) 3439 (nnmail-purge-split-history (gnus-group-real-name group))
@@ -3321,16 +3448,18 @@ or nil if no action could be taken."
3321 (list (cdr (assq 'dormant marks)) 3448 (list (cdr (assq 'dormant marks))
3322 'del '(dormant)))) 3449 'del '(dormant))))
3323 (setq unread (gnus-range-add (gnus-range-add 3450 (setq unread (gnus-range-add (gnus-range-add
3324 unread (cdr (assq 'dormant marks))) 3451 unread (cdr (assq 'dormant marks)))
3325 (cdr (assq 'tick marks)))) 3452 (cdr (assq 'tick marks))))
3326 (gnus-add-marked-articles group 'tick nil nil 'force) 3453 (gnus-add-marked-articles group 'tick nil nil 'force)
3327 (gnus-add-marked-articles group 'dormant nil nil 'force)) 3454 (gnus-add-marked-articles group 'dormant nil nil 'force))
3328 ;; Do auto-expirable marks if that's required. 3455 ;; Do auto-expirable marks if that's required.
3329 (when (gnus-group-auto-expirable-p group) 3456 (when (gnus-group-auto-expirable-p group)
3330 (gnus-range-map (lambda (article) 3457 (gnus-range-map
3331 (gnus-add-marked-articles group 'expire (list article)) 3458 (lambda (article)
3332 (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) 3459 (gnus-add-marked-articles group 'expire (list article))
3333 unread)) 3460 (gnus-request-set-mark group (list (list (list article)
3461 'add '(expire)))))
3462 unread))
3334 (let ((gnus-newsgroup-name group)) 3463 (let ((gnus-newsgroup-name group))
3335 (gnus-run-hooks 'gnus-group-catchup-group-hook)) 3464 (gnus-run-hooks 'gnus-group-catchup-group-hook))
3336 num))) 3465 num)))
@@ -3412,17 +3541,15 @@ Uses the process/prefix convention."
3412 s)))))) 3541 s))))))
3413 (unless (and (>= level 1) (<= level gnus-level-killed)) 3542 (unless (and (>= level 1) (<= level gnus-level-killed))
3414 (error "Invalid level: %d" level)) 3543 (error "Invalid level: %d" level))
3415 (let ((groups (gnus-group-process-prefix n)) 3544 (dolist (group (gnus-group-process-prefix n))
3416 group) 3545 (gnus-group-remove-mark group)
3417 (while (setq group (pop groups)) 3546 (gnus-message 6 "Changed level of %s from %d to %d"
3418 (gnus-group-remove-mark group) 3547 (gnus-group-decoded-name group)
3419 (gnus-message 6 "Changed level of %s from %d to %d" 3548 (or (gnus-group-group-level) gnus-level-killed)
3420 (gnus-group-decoded-name group) 3549 level)
3421 (or (gnus-group-group-level) gnus-level-killed) 3550 (gnus-group-change-level
3422 level) 3551 group level (or (gnus-group-group-level) gnus-level-killed))
3423 (gnus-group-change-level 3552 (gnus-group-update-group-line))
3424 group level (or (gnus-group-group-level) gnus-level-killed))
3425 (gnus-group-update-group-line)))
3426 (gnus-group-position-point)) 3553 (gnus-group-position-point))
3427 3554
3428(defun gnus-group-unsubscribe (&optional n) 3555(defun gnus-group-unsubscribe (&optional n)
@@ -3460,13 +3587,9 @@ If given numerical prefix, toggle the N next groups."
3460 "Toggle subscription to GROUP. 3587 "Toggle subscription to GROUP.
3461Killed newsgroups are subscribed. If SILENT, don't try to update the 3588Killed newsgroups are subscribed. If SILENT, don't try to update the
3462group line." 3589group line."
3463 (interactive 3590 (interactive (list (gnus-group-completing-read
3464 (list (completing-read 3591 "Group: " nil nil (gnus-read-active-file-p))))
3465 "Group: " gnus-active-hashtb nil 3592 (let ((newsrc (gnus-group-entry group)))
3466 (gnus-read-active-file-p)
3467 nil
3468 'gnus-group-history)))
3469 (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
3470 (cond 3593 (cond
3471 ((string-match "^[ \t]*$" group) 3594 ((string-match "^[ \t]*$" group)
3472 (error "Empty group name")) 3595 (error "Empty group name"))
@@ -3490,7 +3613,7 @@ group line."
3490 gnus-level-zombie) 3613 gnus-level-zombie)
3491 gnus-level-killed) 3614 gnus-level-killed)
3492 (when (gnus-group-group-name) 3615 (when (gnus-group-group-name)
3493 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) 3616 (gnus-group-entry (gnus-group-group-name))))
3494 (unless silent 3617 (unless silent
3495 (gnus-group-update-group group))) 3618 (gnus-group-update-group group)))
3496 (t (error "No such newsgroup: %s" group))) 3619 (t (error "No such newsgroup: %s" group)))
@@ -3529,12 +3652,10 @@ The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3529 (count-lines 3652 (count-lines
3530 (progn 3653 (progn
3531 (goto-char begin) 3654 (goto-char begin)
3532 (beginning-of-line) 3655 (point-at-bol))
3533 (point))
3534 (progn 3656 (progn
3535 (goto-char end) 3657 (goto-char end)
3536 (beginning-of-line) 3658 (point-at-bol))))))
3537 (point))))))
3538 (goto-char begin) 3659 (goto-char begin)
3539 (beginning-of-line) ;Important when LINES < 1 3660 (beginning-of-line) ;Important when LINES < 1
3540 (gnus-group-kill-group lines))) 3661 (gnus-group-kill-group lines)))
@@ -3558,7 +3679,7 @@ of groups killed."
3558 (setq level (gnus-group-group-level)) 3679 (setq level (gnus-group-group-level))
3559 (gnus-delete-line) 3680 (gnus-delete-line)
3560 (when (and (not discard) 3681 (when (and (not discard)
3561 (setq entry (gnus-gethash group gnus-newsrc-hashtb))) 3682 (setq entry (gnus-group-entry group)))
3562 (gnus-undo-register 3683 (gnus-undo-register
3563 `(progn 3684 `(progn
3564 (gnus-group-goto-group ,(gnus-group-group-name)) 3685 (gnus-group-goto-group ,(gnus-group-group-name))
@@ -3581,7 +3702,7 @@ of groups killed."
3581 (funcall gnus-group-change-level-function 3702 (funcall gnus-group-change-level-function
3582 group gnus-level-killed 3)) 3703 group gnus-level-killed 3))
3583 (cond 3704 (cond
3584 ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) 3705 ((setq entry (gnus-group-entry group))
3585 (push (cons (car entry) (nth 2 entry)) 3706 (push (cons (car entry) (nth 2 entry))
3586 gnus-list-of-killed-groups) 3707 gnus-list-of-killed-groups)
3587 (setcdr (cdr entry) (cdddr entry))) 3708 (setcdr (cdr entry) (cdddr entry)))
@@ -3614,7 +3735,7 @@ yanked) a list of yanked groups is returned."
3614 (setq prev (gnus-group-group-name)) 3735 (setq prev (gnus-group-group-name))
3615 (gnus-group-change-level 3736 (gnus-group-change-level
3616 info (gnus-info-level (cdr info)) gnus-level-killed 3737 info (gnus-info-level (cdr info)) gnus-level-killed
3617 (and prev (gnus-gethash prev gnus-newsrc-hashtb)) 3738 (and prev (gnus-group-entry prev))
3618 t) 3739 t)
3619 (gnus-group-insert-group-line-info group) 3740 (gnus-group-insert-group-line-info group)
3620 (gnus-undo-register 3741 (gnus-undo-register
@@ -3773,6 +3894,7 @@ re-scanning. If ARG is non-nil and not a number, this will force
3773 (gnus-get-unread-articles arg)) 3894 (gnus-get-unread-articles arg))
3774 (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) 3895 (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
3775 (gnus-get-unread-articles arg))) 3896 (gnus-get-unread-articles arg)))
3897 (gnus-check-reasonable-setup)
3776 (gnus-run-hooks 'gnus-after-getting-new-news-hook) 3898 (gnus-run-hooks 'gnus-after-getting-new-news-hook)
3777 (gnus-group-list-groups (and (numberp arg) 3899 (gnus-group-list-groups (and (numberp arg)
3778 (max (car gnus-group-list-mode) arg))))) 3900 (max (car gnus-group-list-mode) arg)))))
@@ -3797,15 +3919,17 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
3797 (gnus-group-remove-mark group) 3919 (gnus-group-remove-mark group)
3798 ;; Bypass any previous denials from the server. 3920 ;; Bypass any previous denials from the server.
3799 (gnus-remove-denial (setq method (gnus-find-method-for-group group))) 3921 (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
3800 (if (gnus-activate-group group (if dont-scan nil 'scan)) 3922 (if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
3801 (progn 3923 (let ((info (gnus-get-info group))
3802 (gnus-get-unread-articles-in-group 3924 (active (gnus-active group)))
3803 (gnus-get-info group) (gnus-active group) t) 3925 (when info
3926 (gnus-request-update-info info method))
3927 (gnus-get-unread-articles-in-group info active)
3804 (unless (gnus-virtual-group-p group) 3928 (unless (gnus-virtual-group-p group)
3805 (gnus-close-group group)) 3929 (gnus-close-group group))
3806 (when gnus-agent 3930 (when gnus-agent
3807 (gnus-agent-save-group-info 3931 (gnus-agent-save-group-info
3808 method (gnus-group-real-name group) (gnus-active group))) 3932 method (gnus-group-real-name group) active))
3809 (gnus-group-update-group group)) 3933 (gnus-group-update-group group))
3810 (if (eq (gnus-server-status (gnus-find-method-for-group group)) 3934 (if (eq (gnus-server-status (gnus-find-method-for-group group))
3811 'denied) 3935 'denied)
@@ -3851,7 +3975,7 @@ to use."
3851If given a prefix argument, prompt for a group." 3975If given a prefix argument, prompt for a group."
3852 (interactive 3976 (interactive
3853 (list (or (when current-prefix-arg 3977 (list (or (when current-prefix-arg
3854 (completing-read "Group: " gnus-active-hashtb)) 3978 (gnus-group-completing-read "Group: "))
3855 (gnus-group-group-name) 3979 (gnus-group-group-name)
3856 gnus-newsgroup-name))) 3980 gnus-newsgroup-name)))
3857 (unless group 3981 (unless group
@@ -3879,7 +4003,7 @@ If given a prefix argument, prompt for a group."
3879If given a prefix argument, prompt for a group." 4003If given a prefix argument, prompt for a group."
3880 (interactive 4004 (interactive
3881 (list (or (when current-prefix-arg 4005 (list (or (when current-prefix-arg
3882 (completing-read "Group: " gnus-active-hashtb)) 4006 (gnus-group-completing-read "Group: "))
3883 (gnus-group-group-name) 4007 (gnus-group-group-name)
3884 gnus-newsgroup-name))) 4008 gnus-newsgroup-name)))
3885 (unless group 4009 (unless group
@@ -4105,14 +4229,12 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending."
4105 (gnus-offer-save-summaries) 4229 (gnus-offer-save-summaries)
4106 ;; Kill Gnus buffers except for group mode buffer. 4230 ;; Kill Gnus buffers except for group mode buffer.
4107 (let ((group-buf (get-buffer gnus-group-buffer))) 4231 (let ((group-buf (get-buffer gnus-group-buffer)))
4108 (mapcar (lambda (buf) 4232 (dolist (buf (gnus-buffers))
4109 (unless (or (member buf (list group-buf gnus-dribble-buffer)) 4233 (unless (or (eq buf group-buf)
4110 (progn 4234 (eq buf gnus-dribble-buffer)
4111 (save-excursion 4235 (with-current-buffer buf
4112 (set-buffer buf) 4236 (eq major-mode 'message-mode)))
4113 (eq major-mode 'message-mode)))) 4237 (gnus-kill-buffer buf)))
4114 (gnus-kill-buffer buf)))
4115 (gnus-buffers))
4116 (setq gnus-backlog-articles nil) 4238 (setq gnus-backlog-articles nil)
4117 (gnus-kill-gnus-frames) 4239 (gnus-kill-gnus-frames)
4118 (when group-buf 4240 (when group-buf
@@ -4196,17 +4318,15 @@ and the second element is the address."
4196 ;; Suggested by mapjph@bath.ac.uk. 4318 ;; Suggested by mapjph@bath.ac.uk.
4197 (completing-read 4319 (completing-read
4198 "Address: " 4320 "Address: "
4199 (mapcar (lambda (server) (list server)) 4321 (mapcar 'list gnus-secondary-servers)))
4200 gnus-secondary-servers)))
4201 ;; We got a server name. 4322 ;; We got a server name.
4202 how)))) 4323 how))))
4203 (gnus-browse-foreign-server method)) 4324 (gnus-browse-foreign-server method))
4204 4325
4205(defun gnus-group-set-info (info &optional method-only-group part) 4326(defun gnus-group-set-info (info &optional method-only-group part)
4206 (when (or info part) 4327 (when (or info part)
4207 (let* ((entry (gnus-gethash 4328 (let* ((entry (gnus-group-entry
4208 (or method-only-group (gnus-info-group info)) 4329 (or method-only-group (gnus-info-group info))))
4209 gnus-newsrc-hashtb))
4210 (part-info info) 4330 (part-info info)
4211 (info (if method-only-group (nth 2 entry) info)) 4331 (info (if method-only-group (nth 2 entry) info))
4212 method) 4332 method)
@@ -4239,15 +4359,15 @@ and the second element is the address."
4239 (if (stringp method) method 4359 (if (stringp method) method
4240 (prin1-to-string (car method))) 4360 (prin1-to-string (car method)))
4241 (and (consp method) 4361 (and (consp method)
4242 (nth 1 (gnus-info-method info)))) 4362 (nth 1 (gnus-info-method info)))
4363 nil t)
4243 ;; It's a native group. 4364 ;; It's a native group.
4244 (gnus-group-make-group (gnus-info-group info)))) 4365 (gnus-group-make-group (gnus-info-group info) nil nil nil t)))
4245 (gnus-message 6 "Note: New group created") 4366 (gnus-message 6 "Note: New group created")
4246 (setq entry 4367 (setq entry
4247 (gnus-gethash (gnus-group-prefixed-name 4368 (gnus-group-entry (gnus-group-prefixed-name
4248 (gnus-group-real-name (gnus-info-group info)) 4369 (gnus-group-real-name (gnus-info-group info))
4249 (or (gnus-info-method info) gnus-select-method)) 4370 (or (gnus-info-method info) gnus-select-method))))))
4250 gnus-newsrc-hashtb))))
4251 ;; Whether it was a new group or not, we now have the entry, so we 4371 ;; Whether it was a new group or not, we now have the entry, so we
4252 ;; can do the update. 4372 ;; can do the update.
4253 (if entry 4373 (if entry
@@ -4460,6 +4580,40 @@ This command may read the active file."
4460 (gnus-add-marked-articles 4580 (gnus-add-marked-articles
4461 group 'expire (list article)))))) 4581 group 'expire (list article))))))
4462 4582
4583
4584;;;
4585;;; Group compaction. -- dvl
4586;;;
4587
4588(defun gnus-group-compact-group (group)
4589 "Compact the current group.
4590Compaction means removing gaps between article numbers. Hence, this
4591operation is only meaningful for back ends using one file per article
4592\(e.g. nnml).
4593
4594Note: currently only implemented in nnml."
4595 (interactive (list (gnus-group-group-name)))
4596 (unless group
4597 (error "No group to compact"))
4598 (unless (gnus-check-backend-function 'request-compact-group group)
4599 (error "This back end does not support group compaction"))
4600 (let ((group-decoded (gnus-group-decoded-name group)))
4601 (gnus-message 6 "\
4602Compacting group %s... (this may take a long time)"
4603 group-decoded)
4604 (prog1
4605 (if (not (gnus-request-compact-group group))
4606 (gnus-error 3 "Couldn't compact group %s" group-decoded)
4607 (gnus-message 6 "Compacting group %s...done" group-decoded)
4608 t)
4609 ;; Invalidate the "original article" buffer which might be out of date.
4610 ;; #### NOTE: Yes, this might be a bit rude, but since compaction
4611 ;; #### will not happen very often, I think this is acceptable.
4612 (let ((original (get-buffer gnus-original-article-buffer)))
4613 (and original (gnus-kill-buffer original)))
4614 ;; Update the group line to reflect new information (art number etc).
4615 (gnus-group-update-group-line))))
4616
4463(provide 'gnus-group) 4617(provide 'gnus-group)
4464 4618
4465;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 4619;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index bbd997aee8a..52b5e350653 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -75,7 +75,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
75 ;; Read server name with completion. 75 ;; Read server name with completion.
76 (setq gnus-nntp-server 76 (setq gnus-nntp-server
77 (completing-read "NNTP server: " 77 (completing-read "NNTP server: "
78 (mapcar (lambda (server) (list server)) 78 (mapcar 'list
79 (cons (list gnus-nntp-server) 79 (cons (list gnus-nntp-server)
80 gnus-secondary-servers)) 80 gnus-secondary-servers))
81 nil nil gnus-nntp-server))) 81 nil nil gnus-nntp-server)))
@@ -209,11 +209,12 @@ If it is down, start it up (again)."
209 "Open a connection to GNUS-COMMAND-METHOD." 209 "Open a connection to GNUS-COMMAND-METHOD."
210 (when (stringp gnus-command-method) 210 (when (stringp gnus-command-method)
211 (setq gnus-command-method (gnus-server-to-method gnus-command-method))) 211 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
212 (let ((elem (assoc gnus-command-method gnus-opened-servers))) 212 (let ((elem (assoc gnus-command-method gnus-opened-servers))
213 (server (gnus-method-to-server-name gnus-command-method)))
213 ;; If this method was previously denied, we just return nil. 214 ;; If this method was previously denied, we just return nil.
214 (if (eq (nth 1 elem) 'denied) 215 (if (eq (nth 1 elem) 'denied)
215 (progn 216 (progn
216 (gnus-message 1 "Denied server") 217 (gnus-message 1 "Denied server %s" server)
217 nil) 218 nil)
218 ;; Open the server. 219 ;; Open the server.
219 (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) 220 (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server))
@@ -224,11 +225,11 @@ If it is down, start it up (again)."
224 (nthcdr 2 gnus-command-method)) 225 (nthcdr 2 gnus-command-method))
225 (error 226 (error
226 (gnus-message 1 (format 227 (gnus-message 1 (format
227 "Unable to open server due to: %s" 228 "Unable to open server %s due to: %s"
228 (error-message-string err))) 229 server (error-message-string err)))
229 nil) 230 nil)
230 (quit 231 (quit
231 (gnus-message 1 "Quit trying to open server") 232 (gnus-message 1 "Quit trying to open server %s" server)
232 nil))) 233 nil)))
233 open-offline) 234 open-offline)
234 ;; If this hasn't been opened before, we add it to the list. 235 ;; If this hasn't been opened before, we add it to the list.
@@ -253,9 +254,9 @@ If it is down, start it up (again)."
253 ((and 254 ((and
254 (not gnus-batch-mode) 255 (not gnus-batch-mode)
255 (gnus-y-or-n-p 256 (gnus-y-or-n-p
256 (format "Unable to open %s:%s, go offline? " 257 (format
257 (car gnus-command-method) 258 "Unable to open server %s, go offline? "
258 (cadr gnus-command-method)))) 259 server)))
259 (setq open-offline t) 260 (setq open-offline t)
260 'offline) 261 'offline)
261 (t 262 (t
@@ -335,6 +336,23 @@ name. The method this group uses will be queried."
335 (funcall (gnus-get-function gnus-command-method 'request-regenerate) 336 (funcall (gnus-get-function gnus-command-method 'request-regenerate)
336 (nth 1 gnus-command-method))) 337 (nth 1 gnus-command-method)))
337 338
339(defun gnus-request-compact-group (group)
340 (let* ((method (gnus-find-method-for-group group))
341 (gnus-command-method method)
342 (result
343 (funcall (gnus-get-function gnus-command-method
344 'request-compact-group)
345 (gnus-group-real-name group)
346 (nth 1 gnus-command-method) t)))
347 result))
348
349(defun gnus-request-compact (gnus-command-method)
350 "Request groups compaction from GNUS-COMMAND-METHOD."
351 (when (stringp gnus-command-method)
352 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
353 (funcall (gnus-get-function gnus-command-method 'request-compact)
354 (nth 1 gnus-command-method)))
355
338(defun gnus-request-group (group &optional dont-check gnus-command-method) 356(defun gnus-request-group (group &optional dont-check gnus-command-method)
339 "Request GROUP. If DONT-CHECK, no information is required." 357 "Request GROUP. If DONT-CHECK, no information is required."
340 (let ((gnus-command-method 358 (let ((gnus-command-method
@@ -342,7 +360,7 @@ name. The method this group uses will be queried."
342 (when (stringp gnus-command-method) 360 (when (stringp gnus-command-method)
343 (setq gnus-command-method 361 (setq gnus-command-method
344 (inline (gnus-server-to-method gnus-command-method)))) 362 (inline (gnus-server-to-method gnus-command-method))))
345 (funcall (inline (gnus-get-function gnus-command-method 'request-group)) 363 (funcall (inline (gnus-get-function gnus-command-method 'request-group))
346 (gnus-group-real-name group) (nth 1 gnus-command-method) 364 (gnus-group-real-name group) (nth 1 gnus-command-method)
347 dont-check))) 365 dont-check)))
348 366
@@ -521,12 +539,11 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
521 (if group (gnus-find-method-for-group group) gnus-command-method)) 539 (if group (gnus-find-method-for-group group) gnus-command-method))
522 (gnus-inhibit-demon t) 540 (gnus-inhibit-demon t)
523 (mail-source-plugged gnus-plugged)) 541 (mail-source-plugged gnus-plugged))
524 (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) 542 (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
525 (progn 543 (setq gnus-internal-registry-spool-current-method gnus-command-method)
526 (setq gnus-internal-registry-spool-current-method gnus-command-method) 544 (funcall (gnus-get-function gnus-command-method 'request-scan)
527 (funcall (gnus-get-function gnus-command-method 'request-scan) 545 (and group (gnus-group-real-name group))
528 (and group (gnus-group-real-name group)) 546 (nth 1 gnus-command-method)))))
529 (nth 1 gnus-command-method))))))
530 547
531(defsubst gnus-request-update-info (info gnus-command-method) 548(defsubst gnus-request-update-info (info gnus-command-method)
532 "Request that GNUS-COMMAND-METHOD update INFO." 549 "Request that GNUS-COMMAND-METHOD update INFO."
@@ -566,12 +583,12 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
566 not-deleted)) 583 not-deleted))
567 584
568(defun gnus-request-move-article (article group server accept-function 585(defun gnus-request-move-article (article group server accept-function
569 &optional last) 586 &optional last move-is-internal)
570 (let* ((gnus-command-method (gnus-find-method-for-group group)) 587 (let* ((gnus-command-method (gnus-find-method-for-group group))
571 (result (funcall (gnus-get-function gnus-command-method 588 (result (funcall (gnus-get-function gnus-command-method
572 'request-move-article) 589 'request-move-article)
573 article (gnus-group-real-name group) 590 article (gnus-group-real-name group)
574 (nth 1 gnus-command-method) accept-function last))) 591 (nth 1 gnus-command-method) accept-function last move-is-internal)))
575 (when (and result gnus-agent 592 (when (and result gnus-agent
576 (gnus-agent-method-p gnus-command-method)) 593 (gnus-agent-method-p gnus-command-method))
577 (gnus-agent-unfetch-articles group (list article))) 594 (gnus-agent-unfetch-articles group (list article)))
@@ -597,7 +614,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
597 (let ((mail-parse-charset message-default-charset)) 614 (let ((mail-parse-charset message-default-charset))
598 (mail-encode-encoded-word-buffer))) 615 (mail-encode-encoded-word-buffer)))
599 (message-encode-message-body))) 616 (message-encode-message-body)))
600(let ((gnus-command-method (or gnus-command-method 617 (let ((gnus-command-method (or gnus-command-method
601 (gnus-find-method-for-group group))) 618 (gnus-find-method-for-group group)))
602 (result 619 (result
603 (funcall 620 (funcall
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index edf463b8a2e..5778a02e168 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -497,7 +497,7 @@ Optional 1st argument COMMAND is default to
497 (gnus-summary-mark-as-read nil \"X\"). 497 (gnus-summary-mark-as-read nil \"X\").
498If optional 2nd argument ALL is non-nil, articles marked are also applied to. 498If optional 2nd argument ALL is non-nil, articles marked are also applied to.
499If FIELD is an empty string (or nil), entire article body is searched for. 499If FIELD is an empty string (or nil), entire article body is searched for.
500COMMAND must be a lisp expression or a string representing a key sequence." 500COMMAND must be a Lisp expression or a string representing a key sequence."
501 ;; We don't want to change current point nor window configuration. 501 ;; We don't want to change current point nor window configuration.
502 (let ((old-buffer (current-buffer))) 502 (let ((old-buffer (current-buffer)))
503 (save-excursion 503 (save-excursion
@@ -625,7 +625,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
625 did-kill))) 625 did-kill)))
626 626
627(defun gnus-execute (field regexp form &optional backward unread) 627(defun gnus-execute (field regexp form &optional backward unread)
628 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). 628 "If FIELD of article header matches REGEXP, execute Lisp FORM (or a string).
629If FIELD is an empty string (or nil), entire article body is searched for. 629If FIELD is an empty string (or nil), entire article body is searched for.
630If optional 1st argument BACKWARD is non-nil, do backward instead. 630If optional 1st argument BACKWARD is non-nil, do backward instead.
631If optional 2nd argument UNREAD is non-nil, articles which are 631If optional 2nd argument UNREAD is non-nil, articles which are
@@ -691,7 +691,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
691 (mail-sources nil) 691 (mail-sources nil)
692 (gnus-use-dribble-file nil) 692 (gnus-use-dribble-file nil)
693 (gnus-batch-mode t) 693 (gnus-batch-mode t)
694 info group newsrc entry 694 info group newsrc unread
695 ;; Disable verbose message. 695 ;; Disable verbose message.
696 gnus-novice-user gnus-large-newsgroup 696 gnus-novice-user gnus-large-newsgroup
697 gnus-options-subscribe gnus-auto-subscribed-groups 697 gnus-options-subscribe gnus-auto-subscribed-groups
@@ -703,11 +703,11 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
703 (setq newsrc (cdr gnus-newsrc-alist)) 703 (setq newsrc (cdr gnus-newsrc-alist))
704 (while (setq info (pop newsrc)) 704 (while (setq info (pop newsrc))
705 (setq group (gnus-info-group info) 705 (setq group (gnus-info-group info)
706 entry (gnus-gethash group gnus-newsrc-hashtb)) 706 unread (gnus-group-unread group))
707 (when (and (<= (gnus-info-level info) gnus-level-subscribed) 707 (when (and (<= (gnus-info-level info) gnus-level-subscribed)
708 (and (car entry) 708 (and unread
709 (or (eq (car entry) t) 709 (or (eq unread t)
710 (not (zerop (car entry)))))) 710 (not (zerop unread)))))
711 (ignore-errors 711 (ignore-errors
712 (gnus-summary-read-group group nil t nil t)) 712 (gnus-summary-read-group group nil t nil t))
713 (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) 713 (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index b72179645ac..7f8eb2b2888 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -102,8 +102,8 @@ If FORCE is non-nil, replace the old ones."
102 ;; Set up the menu. 102 ;; Set up the menu.
103 (when (gnus-visual-p 'mailing-list-menu 'menu) 103 (when (gnus-visual-p 'mailing-list-menu 'menu)
104 (gnus-mailing-list-make-menu-bar)) 104 (gnus-mailing-list-make-menu-bar))
105 (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" 105 (add-minor-mode 'gnus-mailing-list-mode " Mailing-List"
106 gnus-mailing-list-mode-map) 106 gnus-mailing-list-mode-map)
107 (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) 107 (gnus-run-hooks 'gnus-mailing-list-mode-hook))))
108 108
109;;; Commands 109;;; Commands
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index 7f8323258ae..1a3467d42f0 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -34,31 +34,31 @@
34(require 'nnmail) 34(require 'nnmail)
35 35
36(defvar gnus-group-split-updated-hook nil 36(defvar gnus-group-split-updated-hook nil
37 "Hook called just after nnmail-split-fancy is updated by 37 "Hook called just after `nnmail-split-fancy' is updated by
38gnus-group-split-update.") 38`gnus-group-split-update'.")
39 39
40(defvar gnus-group-split-default-catch-all-group "mail.misc" 40(defvar gnus-group-split-default-catch-all-group "mail.misc"
41 "Group name (or arbitrary fancy split) with default splitting rules. 41 "Group name (or arbitrary fancy split) with default splitting rules.
42Used by gnus-group-split and gnus-group-split-update as a fallback 42Used by `gnus-group-split' and `gnus-group-split-update' as a fallback
43split, in case none of the group-based splits matches.") 43split, in case none of the group-based splits matches.")
44 44
45;;;###autoload 45;;;###autoload
46(defun gnus-group-split-setup (&optional auto-update catch-all) 46(defun gnus-group-split-setup (&optional auto-update catch-all)
47 "Set up the split for nnmail-split-fancy. 47 "Set up the split for `nnmail-split-fancy'.
48Sets things up so that nnmail-split-fancy is used for mail 48Sets things up so that nnmail-split-fancy is used for mail
49splitting, and defines the variable nnmail-split-fancy according with 49splitting, and defines the variable nnmail-split-fancy according with
50group parameters. 50group parameters.
51 51
52If AUTO-UPDATE is non-nil (prefix argument accepted, if called 52If AUTO-UPDATE is non-nil (prefix argument accepted, if called
53interactively), it makes sure nnmail-split-fancy is re-computed before 53interactively), it makes sure nnmail-split-fancy is re-computed before
54getting new mail, by adding gnus-group-split-update to 54getting new mail, by adding `gnus-group-split-update' to
55nnmail-pre-get-new-mail-hook. 55`nnmail-pre-get-new-mail-hook'.
56 56
57A non-nil CATCH-ALL replaces the current value of 57A non-nil CATCH-ALL replaces the current value of
58gnus-group-split-default-catch-all-group. This variable is only used 58`gnus-group-split-default-catch-all-group'. This variable is only used
59by gnus-group-split-update, and only when its CATCH-ALL argument is 59by gnus-group-split-update, and only when its CATCH-ALL argument is
60nil. This argument may contain any fancy split, that will be added as 60nil. This argument may contain any fancy split, that will be added as
61the last split in a `|' split produced by gnus-group-split-fancy, 61the last split in a `|' split produced by `gnus-group-split-fancy',
62unless overridden by any group marked as a catch-all group. Typical 62unless overridden by any group marked as a catch-all group. Typical
63uses are as simple as the name of a default mail group, but more 63uses are as simple as the name of a default mail group, but more
64elaborate fancy splits may also be useful to split mail that doesn't 64elaborate fancy splits may also be useful to split mail that doesn't
@@ -78,8 +78,8 @@ match any of the group-specified splitting rules. See
78It does this by calling by calling (gnus-group-split-fancy nil 78It does this by calling by calling (gnus-group-split-fancy nil
79nil CATCH-ALL). 79nil CATCH-ALL).
80 80
81If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used 81If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used
82instead. This variable is set by gnus-group-split-setup." 82instead. This variable is set by `gnus-group-split-setup'."
83 (interactive) 83 (interactive)
84 (setq nnmail-split-fancy 84 (setq nnmail-split-fancy
85 (gnus-group-split-fancy 85 (gnus-group-split-fancy
@@ -89,10 +89,10 @@ instead. This variable is set by gnus-group-split-setup."
89 89
90;;;###autoload 90;;;###autoload
91(defun gnus-group-split () 91(defun gnus-group-split ()
92 "Uses information from group parameters in order to split mail. 92 "Use information from group parameters in order to split mail.
93See `gnus-group-split-fancy' for more information. 93See `gnus-group-split-fancy' for more information.
94 94
95gnus-group-split is a valid value for nnmail-split-methods." 95`gnus-group-split' is a valid value for `nnmail-split-methods'."
96 (let (nnmail-split-fancy) 96 (let (nnmail-split-fancy)
97 (gnus-group-split-update) 97 (gnus-group-split-update)
98 (nnmail-split-fancy))) 98 (nnmail-split-fancy)))
diff --git a/lisp/gnus/gnus-move.el b/lisp/gnus/gnus-move.el
index 93fa5a6be08..0a97f8d5bd6 100644
--- a/lisp/gnus/gnus-move.el
+++ b/lisp/gnus/gnus-move.el
@@ -53,10 +53,8 @@ Update the .newsrc.eld file to reflect the change of nntp server."
53 53
54 (save-excursion 54 (save-excursion
55 ;; Go through all groups and translate. 55 ;; Go through all groups and translate.
56 (let ((newsrc gnus-newsrc-alist) 56 (let ((nntp-nov-gap nil))
57 (nntp-nov-gap nil) 57 (dolist (info gnus-newsrc-alist)
58 info)
59 (while (setq info (pop newsrc))
60 (when (gnus-group-native-p (gnus-info-group info)) 58 (when (gnus-group-native-p (gnus-info-group info))
61 (gnus-move-group-to-server info from-server to-server)))))) 59 (gnus-move-group-to-server info from-server to-server))))))
62 60
@@ -177,8 +175,7 @@ Update the .newsrc.eld file to reflect the change of nntp server."
177 (new-name (gnus-group-prefixed-name 175 (new-name (gnus-group-prefixed-name
178 (gnus-group-real-name group) to-server))) 176 (gnus-group-real-name group) to-server)))
179 (gnus-info-set-group info new-name) 177 (gnus-info-set-group info new-name)
180 (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) 178 (gnus-sethash new-name (gnus-group-entry group) gnus-newsrc-hashtb)
181 gnus-newsrc-hashtb)
182 (gnus-sethash group nil gnus-newsrc-hashtb)))) 179 (gnus-sethash group nil gnus-newsrc-hashtb))))
183 180
184(provide 'gnus-move) 181(provide 'gnus-move)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index f8e4a7a67d0..001823b4021 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -255,7 +255,8 @@ See also the `mml-default-encrypt-method' variable."
255 :group 'gnus-message 255 :group 'gnus-message
256 :type 'boolean) 256 :type 'boolean)
257 257
258(defcustom gnus-confirm-mail-reply-to-news nil 258(defcustom gnus-confirm-mail-reply-to-news (and gnus-novice-user
259 (not gnus-expert-user))
259 "If non-nil, Gnus requests confirmation when replying to news. 260 "If non-nil, Gnus requests confirmation when replying to news.
260This is done because new users often reply by mistake when reading 261This is done because new users often reply by mistake when reading
261news. 262news.
@@ -288,6 +289,16 @@ If nil, the address field will always be empty after invoking
288 :group 'gnus-message 289 :group 'gnus-message
289 :type 'boolean) 290 :type 'boolean)
290 291
292(defcustom gnus-message-highlight-citation
293 t ;; gnus-treat-highlight-citation ;; gnus-cite dependency
294 "Enable highlighting of different citation levels in message-mode."
295 :version "23.0" ;; No Gnus
296 :group 'gnus-cite
297 :group 'gnus-message
298 :type 'boolean)
299
300(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
301
291;;; Internal variables. 302;;; Internal variables.
292 303
293(defvar gnus-inhibit-posting-styles nil 304(defvar gnus-inhibit-posting-styles nil
@@ -324,11 +335,7 @@ Thank you for your help in stamping out bugs.
324") 335")
325 336
326(eval-and-compile 337(eval-and-compile
327 (autoload 'gnus-uu-post-news "gnus-uu" nil t) 338 (autoload 'gnus-uu-post-news "gnus-uu" nil t))
328 (autoload 'news-setup "rnewspost")
329 (autoload 'news-reply-mode "rnewspost")
330 (autoload 'rmail-dont-reply-to "mail-utils")
331 (autoload 'rmail-output "rmailout"))
332 339
333 340
334;;; 341;;;
@@ -369,10 +376,10 @@ Thank you for your help in stamping out bugs.
369 376
370;;; Internal functions. 377;;; Internal functions.
371 378
372(defun gnus-inews-make-draft () 379(defun gnus-inews-make-draft (articles)
373 `(lambda () 380 `(lambda ()
374 (gnus-inews-make-draft-meta-information 381 (gnus-inews-make-draft-meta-information
375 ,gnus-newsgroup-name ',gnus-article-reply))) 382 ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
376 383
377(defvar gnus-article-reply nil) 384(defvar gnus-article-reply nil)
378(defmacro gnus-setup-message (config &rest forms) 385(defmacro gnus-setup-message (config &rest forms)
@@ -421,7 +428,7 @@ Thank you for your help in stamping out bugs.
421 (not (string= ,group ""))) 428 (not (string= ,group "")))
422 (push (cons 429 (push (cons
423 (intern gnus-draft-meta-information-header) 430 (intern gnus-draft-meta-information-header)
424 (gnus-inews-make-draft)) 431 (gnus-inews-make-draft (or ,yanked ,article)))
425 message-required-headers)) 432 message-required-headers))
426 (unwind-protect 433 (unwind-protect
427 (progn 434 (progn
@@ -432,6 +439,9 @@ Thank you for your help in stamping out bugs.
432 (set (make-local-variable 'gnus-message-group-art) 439 (set (make-local-variable 'gnus-message-group-art)
433 (cons ,group ,article)) 440 (cons ,group ,article))
434 (set (make-local-variable 'gnus-newsgroup-name) ,group) 441 (set (make-local-variable 'gnus-newsgroup-name) ,group)
442 ;; Enable highlighting of different citation levels
443 (when gnus-message-highlight-citation
444 (gnus-message-citation-mode 1))
435 (gnus-run-hooks 'gnus-message-setup-hook) 445 (gnus-run-hooks 'gnus-message-setup-hook)
436 (if (eq major-mode 'message-mode) 446 (if (eq major-mode 'message-mode)
437 (let ((mbl1 mml-buffer-list)) 447 (let ((mbl1 mml-buffer-list))
@@ -449,12 +459,20 @@ Thank you for your help in stamping out bugs.
449 (run-hooks 'post-command-hook) 459 (run-hooks 'post-command-hook)
450 (set-buffer-modified-p nil)))) 460 (set-buffer-modified-p nil))))
451 461
452(defun gnus-inews-make-draft-meta-information (group article) 462(defun gnus-inews-make-draft-meta-information (group articles)
453 (concat "(\"" group "\" " 463 (when (numberp articles)
454 (if article (number-to-string 464 (setq articles (list articles)))
455 (if (listp article) 465 (concat "(\"" group "\""
456 (car article) 466 (if articles
457 article)) "\"\"") 467 (concat " "
468 (mapconcat
469 (lambda (elem)
470 (number-to-string
471 (if (consp elem)
472 (car elem)
473 elem)))
474 articles " "))
475 "")
458 ")")) 476 ")"))
459 477
460;;;###autoload 478;;;###autoload
@@ -519,7 +537,7 @@ Gcc: header for archiving purposes."
519 (gnus-make-local-hook 'message-header-hook) 537 (gnus-make-local-hook 'message-header-hook)
520 (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) 538 (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
521 (setq message-post-method 539 (setq message-post-method
522 `(lambda (arg) 540 `(lambda (&optional arg)
523 (gnus-post-method arg ,gnus-newsgroup-name))) 541 (gnus-post-method arg ,gnus-newsgroup-name)))
524 (message-add-action 542 (message-add-action
525 `(when (gnus-buffer-exists-p ,buffer) 543 `(when (gnus-buffer-exists-p ,buffer)
@@ -562,9 +580,9 @@ If ARG is 1, prompt for a group name to find the posting style."
562 (setq gnus-newsgroup-name 580 (setq gnus-newsgroup-name
563 (if arg 581 (if arg
564 (if (= 1 (prefix-numeric-value arg)) 582 (if (= 1 (prefix-numeric-value arg))
565 (completing-read "Use posting style of group: " 583 (gnus-group-completing-read
566 gnus-active-hashtb nil 584 "Use posting style of group: "
567 (gnus-read-active-file-p)) 585 nil nil (gnus-read-active-file-p))
568 (gnus-group-group-name)) 586 (gnus-group-group-name))
569 "")) 587 ""))
570 ;; #### see comment in gnus-setup-message -- drv 588 ;; #### see comment in gnus-setup-message -- drv
@@ -593,9 +611,9 @@ network. The corresponding back end must have a 'request-post method."
593 (setq gnus-newsgroup-name 611 (setq gnus-newsgroup-name
594 (if arg 612 (if arg
595 (if (= 1 (prefix-numeric-value arg)) 613 (if (= 1 (prefix-numeric-value arg))
596 (completing-read "Use group: " 614 (gnus-group-completing-read "Use group: "
597 gnus-active-hashtb nil 615 nil nil
598 (gnus-read-active-file-p)) 616 (gnus-read-active-file-p))
599 (gnus-group-group-name)) 617 (gnus-group-group-name))
600 "")) 618 ""))
601 ;; #### see comment in gnus-setup-message -- drv 619 ;; #### see comment in gnus-setup-message -- drv
@@ -615,8 +633,8 @@ a news."
615 (let ((gnus-newsgroup-name 633 (let ((gnus-newsgroup-name
616 (if arg 634 (if arg
617 (if (= 1 (prefix-numeric-value arg)) 635 (if (= 1 (prefix-numeric-value arg))
618 (completing-read "Newsgroup: " gnus-active-hashtb nil 636 (gnus-group-completing-read "Newsgroup: " nil nil
619 (gnus-read-active-file-p)) 637 (gnus-read-active-file-p))
620 (gnus-group-group-name)) 638 (gnus-group-group-name))
621 "")) 639 ""))
622 ;; make sure last viewed article doesn't affect posting styles: 640 ;; make sure last viewed article doesn't affect posting styles:
@@ -641,9 +659,9 @@ posting style."
641 (setq gnus-newsgroup-name 659 (setq gnus-newsgroup-name
642 (if arg 660 (if arg
643 (if (= 1 (prefix-numeric-value arg)) 661 (if (= 1 (prefix-numeric-value arg))
644 (completing-read "Use group: " 662 (gnus-group-completing-read "Use group: "
645 gnus-active-hashtb nil 663 nil nil
646 (gnus-read-active-file-p)) 664 (gnus-read-active-file-p))
647 "") 665 "")
648 gnus-newsgroup-name)) 666 gnus-newsgroup-name))
649 ;; #### see comment in gnus-setup-message -- drv 667 ;; #### see comment in gnus-setup-message -- drv
@@ -672,9 +690,9 @@ network. The corresponding back end must have a 'request-post method."
672 (setq gnus-newsgroup-name 690 (setq gnus-newsgroup-name
673 (if arg 691 (if arg
674 (if (= 1 (prefix-numeric-value arg)) 692 (if (= 1 (prefix-numeric-value arg))
675 (completing-read "Use group: " 693 (gnus-group-completing-read "Use group: "
676 gnus-active-hashtb nil 694 nil nil
677 (gnus-read-active-file-p)) 695 (gnus-read-active-file-p))
678 "") 696 "")
679 gnus-newsgroup-name)) 697 gnus-newsgroup-name))
680 ;; #### see comment in gnus-setup-message -- drv 698 ;; #### see comment in gnus-setup-message -- drv
@@ -682,9 +700,9 @@ network. The corresponding back end must have a 'request-post method."
682 (progn 700 (progn
683 (message-news (gnus-group-real-name gnus-newsgroup-name)) 701 (message-news (gnus-group-real-name gnus-newsgroup-name))
684 (set (make-local-variable 'gnus-discouraged-post-methods) 702 (set (make-local-variable 'gnus-discouraged-post-methods)
685 (delq 703 (remove
686 (car (gnus-find-method-for-group gnus-newsgroup-name)) 704 (car (gnus-find-method-for-group gnus-newsgroup-name))
687 (copy-sequence gnus-discouraged-post-methods)))))) 705 gnus-discouraged-post-methods)))))
688 (save-excursion 706 (save-excursion
689 (set-buffer buffer) 707 (set-buffer buffer)
690 (setq gnus-newsgroup-name group))))) 708 (setq gnus-newsgroup-name group)))))
@@ -699,8 +717,8 @@ a news."
699 (let ((gnus-newsgroup-name 717 (let ((gnus-newsgroup-name
700 (if arg 718 (if arg
701 (if (= 1 (prefix-numeric-value arg)) 719 (if (= 1 (prefix-numeric-value arg))
702 (completing-read "Newsgroup: " gnus-active-hashtb nil 720 (gnus-group-completing-read "Newsgroup: " nil nil
703 (gnus-read-active-file-p)) 721 (gnus-read-active-file-p))
704 "") 722 "")
705 gnus-newsgroup-name)) 723 gnus-newsgroup-name))
706 ;; make sure last viewed article doesn't affect posting styles: 724 ;; make sure last viewed article doesn't affect posting styles:
@@ -784,12 +802,10 @@ Uses the process-prefix convention. If given the symbolic
784prefix `a', cancel using the standard posting method; if not 802prefix `a', cancel using the standard posting method; if not
785post using the current select method." 803post using the current select method."
786 (interactive (gnus-interactive "P\ny")) 804 (interactive (gnus-interactive "P\ny"))
787 (let ((articles (gnus-summary-work-articles n)) 805 (let ((message-post-method
788 (message-post-method
789 `(lambda (arg) 806 `(lambda (arg)
790 (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) 807 (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
791 article) 808 (dolist (article (gnus-summary-work-articles n))
792 (while (setq article (pop articles))
793 (when (gnus-summary-select-article t nil nil article) 809 (when (gnus-summary-select-article t nil nil article)
794 (when (gnus-eval-in-buffer-window gnus-original-article-buffer 810 (when (gnus-eval-in-buffer-window gnus-original-article-buffer
795 (message-cancel-news)) 811 (message-cancel-news))
@@ -1254,14 +1270,12 @@ For the `inline' alternatives, also see the variable
1254 (with-current-buffer gnus-original-article-buffer 1270 (with-current-buffer gnus-original-article-buffer
1255 (nnmail-fetch-field "to")))) 1271 (nnmail-fetch-field "to"))))
1256 current-prefix-arg)) 1272 current-prefix-arg))
1257 (let ((articles (gnus-summary-work-articles n)) 1273 (dolist (article (gnus-summary-work-articles n))
1258 article) 1274 (gnus-summary-select-article nil nil nil article)
1259 (while (setq article (pop articles)) 1275 (save-excursion
1260 (gnus-summary-select-article nil nil nil article) 1276 (set-buffer gnus-original-article-buffer)
1261 (save-excursion 1277 (message-resend address))
1262 (set-buffer gnus-original-article-buffer) 1278 (gnus-summary-mark-article-as-forwarded article)))
1263 (message-resend address))
1264 (gnus-summary-mark-article-as-forwarded article))))
1265 1279
1266;; From: Matthieu Moy <Matthieu.Moy@imag.fr> 1280;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
1267(defun gnus-summary-resend-message-edit () 1281(defun gnus-summary-resend-message-edit ()
@@ -1322,37 +1336,35 @@ The current group name will be inserted at \"%s\".")
1322(defun gnus-summary-mail-crosspost-complaint (n) 1336(defun gnus-summary-mail-crosspost-complaint (n)
1323 "Send a complaint about crossposting to the current article(s)." 1337 "Send a complaint about crossposting to the current article(s)."
1324 (interactive "P") 1338 (interactive "P")
1325 (let ((articles (gnus-summary-work-articles n)) 1339 (dolist (article (gnus-summary-work-articles n))
1326 article) 1340 (set-buffer gnus-summary-buffer)
1327 (while (setq article (pop articles)) 1341 (gnus-summary-goto-subject article)
1328 (set-buffer gnus-summary-buffer) 1342 (let ((group (gnus-group-real-name gnus-newsgroup-name))
1329 (gnus-summary-goto-subject article) 1343 newsgroups followup-to)
1330 (let ((group (gnus-group-real-name gnus-newsgroup-name)) 1344 (gnus-summary-select-article)
1331 newsgroups followup-to) 1345 (set-buffer gnus-original-article-buffer)
1332 (gnus-summary-select-article) 1346 (if (and (<= (length (message-tokenize-header
1333 (set-buffer gnus-original-article-buffer) 1347 (setq newsgroups
1334 (if (and (<= (length (message-tokenize-header 1348 (mail-fetch-field "newsgroups"))
1335 (setq newsgroups 1349 ", "))
1336 (mail-fetch-field "newsgroups")) 1350 1)
1337 ", ")) 1351 (or (not (setq followup-to (mail-fetch-field "followup-to")))
1338 1) 1352 (not (member group (message-tokenize-header
1339 (or (not (setq followup-to (mail-fetch-field "followup-to"))) 1353 followup-to ", ")))))
1340 (not (member group (message-tokenize-header 1354 (if followup-to
1341 followup-to ", "))))) 1355 (gnus-message 1 "Followup-to restricted")
1342 (if followup-to 1356 (gnus-message 1 "Not a crossposted article"))
1343 (gnus-message 1 "Followup-to restricted") 1357 (set-buffer gnus-summary-buffer)
1344 (gnus-message 1 "Not a crossposted article")) 1358 (gnus-summary-reply-with-original 1)
1345 (set-buffer gnus-summary-buffer) 1359 (set-buffer gnus-message-buffer)
1346 (gnus-summary-reply-with-original 1) 1360 (message-goto-body)
1347 (set-buffer gnus-message-buffer) 1361 (insert (format gnus-crosspost-complaint newsgroups group))
1348 (message-goto-body) 1362 (message-goto-subject)
1349 (insert (format gnus-crosspost-complaint newsgroups group)) 1363 (re-search-forward " *$")
1350 (message-goto-subject) 1364 (replace-match " (crosspost notification)" t t)
1351 (re-search-forward " *$") 1365 (gnus-deactivate-mark)
1352 (replace-match " (crosspost notification)" t t) 1366 (when (gnus-y-or-n-p "Send this complaint? ")
1353 (gnus-deactivate-mark) 1367 (message-send-and-exit))))))
1354 (when (gnus-y-or-n-p "Send this complaint? ")
1355 (message-send-and-exit)))))))
1356 1368
1357(defun gnus-mail-parse-comma-list () 1369(defun gnus-mail-parse-comma-list ()
1358 (let (accumulated 1370 (let (accumulated
@@ -1401,7 +1413,7 @@ The current group name will be inserted at \"%s\".")
1401 (not (gnus-group-read-only-p group))) 1413 (not (gnus-group-read-only-p group)))
1402 (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) 1414 (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
1403 1415
1404 (when (gnus-gethash group gnus-newsrc-hashtb) 1416 (when (gnus-group-entry group)
1405 (error "No such group: %s" group)) 1417 (error "No such group: %s" group))
1406 (save-excursion 1418 (save-excursion
1407 (save-restriction 1419 (save-restriction
@@ -1667,11 +1679,13 @@ this is a reply."
1667 (concat "^" (regexp-quote mail-header-separator) "$") 1679 (concat "^" (regexp-quote mail-header-separator) "$")
1668 nil t) 1680 nil t)
1669 (replace-match "" t t )) 1681 (replace-match "" t t ))
1670 (unless (setq group-art 1682 (when (or (not (gnus-check-backend-function
1671 (gnus-request-accept-article group method t t)) 1683 'request-accept-article group))
1684 (not (setq group-art
1685 (gnus-request-accept-article
1686 group method t t))))
1672 (gnus-message 1 "Couldn't store article in group %s: %s" 1687 (gnus-message 1 "Couldn't store article in group %s: %s"
1673 group (gnus-status-message method)) 1688 group (gnus-status-message method)))
1674 (sit-for 2))
1675 (when (and group-art 1689 (when (and group-art
1676 ;; FIXME: Should gcc-mark-as-read work when 1690 ;; FIXME: Should gcc-mark-as-read work when
1677 ;; Gnus is not running? 1691 ;; Gnus is not running?
@@ -1709,8 +1723,13 @@ this is a reply."
1709 1723
1710(defun gnus-inews-insert-archive-gcc (&optional group) 1724(defun gnus-inews-insert-archive-gcc (&optional group)
1711 "Insert the Gcc to say where the article is to be archived." 1725 "Insert the Gcc to say where the article is to be archived."
1726 (setq group (cond (group
1727 (gnus-group-decoded-name group))
1728 (gnus-newsgroup-name
1729 (gnus-group-decoded-name gnus-newsgroup-name))
1730 (t
1731 "")))
1712 (let* ((var gnus-message-archive-group) 1732 (let* ((var gnus-message-archive-group)
1713 (group (or group gnus-newsgroup-name ""))
1714 (gcc-self-val 1733 (gcc-self-val
1715 (and gnus-newsgroup-name 1734 (and gnus-newsgroup-name
1716 (not (equal gnus-newsgroup-name "")) 1735 (not (equal gnus-newsgroup-name ""))
@@ -1892,6 +1911,13 @@ this is a reply."
1892 ((eq element 'x-face-file) 1911 ((eq element 'x-face-file)
1893 (setq element 'x-face 1912 (setq element 'x-face
1894 filep t))) 1913 filep t)))
1914 ;; Post-processing for the signature posting-style:
1915 (and (eq element 'signature) filep
1916 message-signature-directory
1917 ;; don't actually use the signature directory
1918 ;; if message-signature-file contains a path.
1919 (not (file-name-directory v))
1920 (setq v (nnheader-concat message-signature-directory v)))
1895 ;; Get the contents of file elems. 1921 ;; Get the contents of file elems.
1896 (when (and filep v) 1922 (when (and filep v)
1897 (setq v (with-temp-buffer 1923 (setq v (with-temp-buffer
diff --git a/lisp/gnus/gnus-nocem.el b/lisp/gnus/gnus-nocem.el
index 7b54687c84c..f3437c64bee 100644
--- a/lisp/gnus/gnus-nocem.el
+++ b/lisp/gnus/gnus-nocem.el
@@ -129,11 +129,12 @@ valid issuer, which is much faster if you are selective about the issuers."
129 129
130(defun gnus-fill-real-hashtb () 130(defun gnus-fill-real-hashtb ()
131 "Fill up a hash table with the real-name mappings from the user's active file." 131 "Fill up a hash table with the real-name mappings from the user's active file."
132 (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable 132 (if (hash-table-p gnus-nocem-real-group-hashtb)
133 (length gnus-newsrc-alist))) 133 (clrhash gnus-nocem-real-group-hashtb)
134 (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal)))
134 (mapcar (lambda (group) 135 (mapcar (lambda (group)
135 (setq group (gnus-group-real-name (car group))) 136 (setq group (gnus-group-real-name (car group)))
136 (gnus-sethash group t gnus-nocem-real-group-hashtb)) 137 (puthash group t gnus-nocem-real-group-hashtb))
137 gnus-newsrc-alist)) 138 gnus-newsrc-alist))
138 139
139;;;###autoload 140;;;###autoload
@@ -191,7 +192,7 @@ valid issuer, which is much faster if you are selective about the issuers."
191 (and gnus-nocem-check-from 192 (and gnus-nocem-check-from
192 (let ((case-fold-search t)) 193 (let ((case-fold-search t))
193 (catch 'ok 194 (catch 'ok
194 (mapcar 195 (mapc
195 (lambda (author) 196 (lambda (author)
196 (if (consp author) 197 (if (consp author)
197 (setq author (car author))) 198 (setq author (car author)))
@@ -237,11 +238,11 @@ valid issuer, which is much faster if you are selective about the issuers."
237 (gnus-request-article-this-buffer (mail-header-number header) group) 238 (gnus-request-article-this-buffer (mail-header-number header) group)
238 (goto-char (point-min)) 239 (goto-char (point-min))
239 (when (re-search-forward 240 (when (re-search-forward
240 "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----" 241 "-----BEGIN PGP\\(?: SIGNED\\)? MESSAGE-----"
241 nil t) 242 nil t)
242 (delete-region (point-min) (match-beginning 0))) 243 (delete-region (point-min) (match-beginning 0)))
243 (when (re-search-forward 244 (when (re-search-forward
244 "-----END PGP \\(MESSAGE\\|SIGNATURE\\)-----\n?" 245 "-----END PGP \\(?:MESSAGE\\|SIGNATURE\\)-----\n?"
245 nil t) 246 nil t)
246 (delete-region (match-end 0) (point-max))) 247 (delete-region (match-end 0) (point-max)))
247 (goto-char (point-min)) 248 (goto-char (point-min))
@@ -304,34 +305,26 @@ valid issuer, which is much faster if you are selective about the issuers."
304 (while (search-forward "\t" nil t) 305 (while (search-forward "\t" nil t)
305 (cond 306 (cond
306 ((not (ignore-errors 307 ((not (ignore-errors
307 (setq group (let ((obarray gnus-nocem-real-group-hashtb)) 308 (setq group (gnus-group-real-name (symbol-name (read buf))))
308 (read buf))))) 309 (gethash group gnus-nocem-real-group-hashtb)))
309 ;; An error. 310 ;; An error.
310 ) 311 )
311 ((not (symbolp group))
312 ;; Ignore invalid entries.
313 )
314 ((not (boundp group))
315 ;; Make sure all entries in the hashtb are bound.
316 (set group nil))
317 (t 312 (t
318 (when (gnus-gethash (gnus-group-real-name (symbol-name group)) 313 ;; Valid group.
319 gnus-nocem-real-group-hashtb) 314 (beginning-of-line)
320 ;; Valid group. 315 (while (eq (char-after) ?\t)
321 (beginning-of-line) 316 (forward-line -1))
322 (while (eq (char-after) ?\t) 317 (setq id (buffer-substring (point) (1- (search-forward "\t"))))
323 (forward-line -1)) 318 (unless (if (hash-table-p gnus-nocem-hashtb)
324 (setq id (buffer-substring (point) (1- (search-forward "\t")))) 319 (gethash id gnus-nocem-hashtb)
325 (unless (if gnus-nocem-hashtb 320 (setq gnus-nocem-hashtb (make-hash-table :test 'equal))
326 (gnus-gethash id gnus-nocem-hashtb) 321 nil)
327 (setq gnus-nocem-hashtb (gnus-make-hashtable)) 322 ;; only store if not already present
328 nil) 323 (puthash id t gnus-nocem-hashtb)
329 ;; only store if not already present 324 (push id ncm))
330 (gnus-sethash id t gnus-nocem-hashtb) 325 (forward-line 1)
331 (push id ncm)) 326 (while (eq (char-after) ?\t)
332 (forward-line 1) 327 (forward-line 1)))))
333 (while (eq (char-after) ?\t)
334 (forward-line 1))))))
335 (when ncm 328 (when ncm
336 (setq gnus-nocem-touched-alist t) 329 (setq gnus-nocem-touched-alist t)
337 (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) 330 (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time)
@@ -370,7 +363,9 @@ valid issuer, which is much faster if you are selective about the issuers."
370 (prev pprev) 363 (prev pprev)
371 (expiry (days-to-time gnus-nocem-expiry-wait)) 364 (expiry (days-to-time gnus-nocem-expiry-wait))
372 entry) 365 entry)
373 (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) 366 (if (hash-table-p gnus-nocem-hashtb)
367 (clrhash gnus-nocem-hashtb)
368 (setq gnus-nocem-hashtb (make-hash-table :test 'equal)))
374 (while (setq entry (car alist)) 369 (while (setq entry (car alist))
375 (if (not (time-less-p (time-since (car entry)) expiry)) 370 (if (not (time-less-p (time-since (car entry)) expiry))
376 ;; This entry has expired, so we remove it. 371 ;; This entry has expired, so we remove it.
@@ -379,7 +374,7 @@ valid issuer, which is much faster if you are selective about the issuers."
379 ;; This is ok, so we enter it into the hashtable. 374 ;; This is ok, so we enter it into the hashtable.
380 (setq entry (cdr entry)) 375 (setq entry (cdr entry))
381 (while entry 376 (while entry
382 (gnus-sethash (car entry) t gnus-nocem-hashtb) 377 (puthash (car entry) t gnus-nocem-hashtb)
383 (setq entry (cdr entry)))) 378 (setq entry (cdr entry))))
384 (setq alist (cdr alist))))) 379 (setq alist (cdr alist)))))
385 380
@@ -397,7 +392,7 @@ valid issuer, which is much faster if you are selective about the issuers."
397(defun gnus-nocem-unwanted-article-p (id) 392(defun gnus-nocem-unwanted-article-p (id)
398 "Say whether article ID in the current group is wanted." 393 "Say whether article ID in the current group is wanted."
399 (and gnus-nocem-hashtb 394 (and gnus-nocem-hashtb
400 (gnus-gethash id gnus-nocem-hashtb))) 395 (gethash id gnus-nocem-hashtb)))
401 396
402(provide 'gnus-nocem) 397(provide 'gnus-nocem)
403 398
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index a9303af5fc8..e9643399719 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -74,6 +74,15 @@ Some people may want to add \"unknown\" to this list."
74 :type '(repeat string) 74 :type '(repeat string)
75 :group 'gnus-picon) 75 :group 'gnus-picon)
76 76
77(defcustom gnus-picon-style 'inline
78 "How should picons be displayed.
79If `inline', the textual representation is replaced. If `right', picons are
80added right to the textual representation."
81 ;; FIXME: `right' needs improvement for XEmacs.
82 :type '(choice (const inline)
83 (const right))
84 :group 'gnus-picon)
85
77(defface gnus-picon-xbm '((t (:foreground "black" :background "white"))) 86(defface gnus-picon-xbm '((t (:foreground "black" :background "white")))
78 "Face to show xbm picon in." 87 "Face to show xbm picon in."
79 :group 'gnus-picon) 88 :group 'gnus-picon)
@@ -139,14 +148,17 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
139 file 148 file
140 nil))) 149 nil)))
141 150
142(defun gnus-picon-insert-glyph (glyph category) 151(defun gnus-picon-insert-glyph (glyph category &optional nostring)
143 "Insert GLYPH into the buffer. 152 "Insert GLYPH into the buffer.
144GLYPH can be either a glyph or a string." 153GLYPH can be either a glyph or a string. When NOSTRING, no textual
154replacement is added."
155 ;; Using NOSTRING prevents wrong BBDB entries with `gnus-picon-style' set to
156 ;; 'right.
145 (if (stringp glyph) 157 (if (stringp glyph)
146 (insert glyph) 158 (insert glyph)
147 (gnus-add-wash-type category) 159 (gnus-add-wash-type category)
148 (gnus-add-image category (car glyph)) 160 (gnus-add-image category (car glyph))
149 (gnus-put-image (car glyph) (cdr glyph) category))) 161 (gnus-put-image (car glyph) (unless nostring (cdr glyph)) category)))
150 162
151(defun gnus-picon-create-glyph (file) 163(defun gnus-picon-create-glyph (file)
152 (or (cdr (assoc file gnus-picon-glyph-alist)) 164 (or (cdr (assoc file gnus-picon-glyph-alist))
@@ -157,87 +169,107 @@ GLYPH can be either a glyph or a string."
157 169
158(defun gnus-picon-transform-address (header category) 170(defun gnus-picon-transform-address (header category)
159 (gnus-with-article-headers 171 (gnus-with-article-headers
160 (let ((addresses 172 (let ((addresses
161 (mail-header-parse-addresses 173 (mail-header-parse-addresses
162 ;; mail-header-parse-addresses does not work (reliably) on 174 ;; mail-header-parse-addresses does not work (reliably) on
163 ;; decoded headers. 175 ;; decoded headers.
164 (or 176 (or
165 (ignore-errors 177 (ignore-errors
166 (mail-encode-encoded-word-string 178 (mail-encode-encoded-word-string
167 (or (mail-fetch-field header) ""))) 179 (or (mail-fetch-field header) "")))
168 (mail-fetch-field header)))) 180 (mail-fetch-field header))))
169 spec file point cache) 181 spec file point cache len)
170 (dolist (address addresses) 182 (dolist (address addresses)
171 (setq address (car address)) 183 (setq address (car address))
172 (when (and (stringp address) 184 (when (and (stringp address)
173 (setq spec (gnus-picon-split-address address))) 185 (setq spec (gnus-picon-split-address address)))
174 (if (setq cache (cdr (assoc address gnus-picon-cache))) 186 (if (setq cache (cdr (assoc address gnus-picon-cache)))
175 (setq spec cache) 187 (setq spec cache)
176 (when (setq file (or (gnus-picon-find-face 188 (when (setq file (or (gnus-picon-find-face
177 address gnus-picon-user-directories) 189 address gnus-picon-user-directories)
178 (gnus-picon-find-face 190 (gnus-picon-find-face
179 (concat "unknown@" 191 (concat "unknown@"
180 (mapconcat 192 (mapconcat
181 'identity (cdr spec) ".")) 193 'identity (cdr spec) "."))
182 gnus-picon-user-directories))) 194 gnus-picon-user-directories)))
183 (setcar spec (cons (gnus-picon-create-glyph file) 195 (setcar spec (cons (gnus-picon-create-glyph file)
184 (car spec)))) 196 (car spec))))
185 197
186 (dotimes (i (1- (length spec))) 198 (dotimes (i (1- (length spec)))
187 (when (setq file (gnus-picon-find-face 199 (when (setq file (gnus-picon-find-face
188 (concat "unknown@" 200 (concat "unknown@"
189 (mapconcat 201 (mapconcat
190 'identity (nthcdr (1+ i) spec) ".")) 202 'identity (nthcdr (1+ i) spec) "."))
191 gnus-picon-domain-directories t)) 203 gnus-picon-domain-directories t))
192 (setcar (nthcdr (1+ i) spec) 204 (setcar (nthcdr (1+ i) spec)
193 (cons (gnus-picon-create-glyph file) 205 (cons (gnus-picon-create-glyph file)
194 (nth (1+ i) spec))))) 206 (nth (1+ i) spec)))))
195 (setq spec (nreverse spec)) 207 (setq spec (nreverse spec))
196 (push (cons address spec) gnus-picon-cache)) 208 (push (cons address spec) gnus-picon-cache))
197 209
198 (gnus-article-goto-header header) 210 (gnus-article-goto-header header)
199 (mail-header-narrow-to-field) 211 (mail-header-narrow-to-field)
200 (when (search-forward address nil t) 212 (case gnus-picon-style
201 (delete-region (match-beginning 0) (match-end 0)) 213 (right
202 (setq point (point)) 214 (when (= (length addresses) 1)
203 (while spec 215 (setq len (apply '+ (mapcar (lambda (x)
204 (goto-char point) 216 (condition-case nil
205 (if (> (length spec) 2) 217 (car (image-size (car x)))
206 (insert ".") 218 (error 0))) spec)))
207 (if (= (length spec) 2) 219 (when (> len 0)
208 (insert "@"))) 220 (goto-char (point-at-eol))
209 (gnus-picon-insert-glyph (pop spec) category)))))))) 221 (insert (propertize
222 " " 'display
223 (cons 'space
224 (list :align-to (- (window-width) 1 len))))))
225 (goto-char (point-at-eol))
226 (setq point (point-at-eol))
227 (dolist (image spec)
228 (unless (stringp image)
229 (goto-char point)
230 (gnus-picon-insert-glyph image category 'nostring)))))
231 (inline
232 (when (search-forward address nil t)
233 (delete-region (match-beginning 0) (match-end 0))
234 (setq point (point))
235 (while spec
236 (goto-char point)
237 (if (> (length spec) 2)
238 (insert ".")
239 (if (= (length spec) 2)
240 (insert "@")))
241 (gnus-picon-insert-glyph (pop spec) category))))))))))
210 242
211(defun gnus-picon-transform-newsgroups (header) 243(defun gnus-picon-transform-newsgroups (header)
212 (interactive) 244 (interactive)
213 (gnus-with-article-headers 245 (gnus-with-article-headers
214 (gnus-article-goto-header header) 246 (gnus-article-goto-header header)
215 (mail-header-narrow-to-field) 247 (mail-header-narrow-to-field)
216 (let ((groups (message-tokenize-header (mail-fetch-field header))) 248 (let ((groups (message-tokenize-header (mail-fetch-field header)))
217 spec file point) 249 spec file point)
218 (dolist (group groups) 250 (dolist (group groups)
219 (unless (setq spec (cdr (assoc group gnus-picon-cache))) 251 (unless (setq spec (cdr (assoc group gnus-picon-cache)))
220 (setq spec (nreverse (split-string group "[.]"))) 252 (setq spec (nreverse (split-string group "[.]")))
221 (dotimes (i (length spec)) 253 (dotimes (i (length spec))
222 (when (setq file (gnus-picon-find-face 254 (when (setq file (gnus-picon-find-face
223 (concat "unknown@" 255 (concat "unknown@"
224 (mapconcat 256 (mapconcat
225 'identity (nthcdr i spec) ".")) 257 'identity (nthcdr i spec) "."))
226 gnus-picon-news-directories t)) 258 gnus-picon-news-directories t))
227 (setcar (nthcdr i spec) 259 (setcar (nthcdr i spec)
228 (cons (gnus-picon-create-glyph file) 260 (cons (gnus-picon-create-glyph file)
229 (nth i spec))))) 261 (nth i spec)))))
230 (push (cons group spec) gnus-picon-cache)) 262 (push (cons group spec) gnus-picon-cache))
231 (when (search-forward group nil t) 263 (when (search-forward group nil t)
232 (delete-region (match-beginning 0) (match-end 0)) 264 (delete-region (match-beginning 0) (match-end 0))
233 (save-restriction 265 (save-restriction
234 (narrow-to-region (point) (point)) 266 (narrow-to-region (point) (point))
235 (while spec 267 (while spec
236 (goto-char (point-min)) 268 (goto-char (point-min))
237 (if (> (length spec) 1) 269 (if (> (length spec) 1)
238 (insert ".")) 270 (insert "."))
239 (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)) 271 (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon))
240 (goto-char (point-max)))))))) 272 (goto-char (point-max))))))))
241 273
242;;; Commands: 274;;; Commands:
243 275
@@ -251,10 +283,9 @@ If picons are already displayed, remove them."
251 (interactive) 283 (interactive)
252 (let ((wash-picon-p buffer-read-only)) 284 (let ((wash-picon-p buffer-read-only))
253 (gnus-with-article-buffer 285 (gnus-with-article-buffer
254 (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) 286 (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types))
255 (gnus-delete-images 'from-picon) 287 (gnus-delete-images 'from-picon)
256 (gnus-picon-transform-address "from" 'from-picon))) 288 (gnus-picon-transform-address "from" 'from-picon)))))
257 ))
258 289
259;;;###autoload 290;;;###autoload
260(defun gnus-treat-mail-picon () 291(defun gnus-treat-mail-picon ()
@@ -263,11 +294,10 @@ If picons are already displayed, remove them."
263 (interactive) 294 (interactive)
264 (let ((wash-picon-p buffer-read-only)) 295 (let ((wash-picon-p buffer-read-only))
265 (gnus-with-article-buffer 296 (gnus-with-article-buffer
266 (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) 297 (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types))
267 (gnus-delete-images 'mail-picon) 298 (gnus-delete-images 'mail-picon)
268 (gnus-picon-transform-address "cc" 'mail-picon) 299 (gnus-picon-transform-address "cc" 'mail-picon)
269 (gnus-picon-transform-address "to" 'mail-picon))) 300 (gnus-picon-transform-address "to" 'mail-picon)))))
270 ))
271 301
272;;;###autoload 302;;;###autoload
273(defun gnus-treat-newsgroups-picon () 303(defun gnus-treat-newsgroups-picon ()
@@ -276,11 +306,10 @@ If picons are already displayed, remove them."
276 (interactive) 306 (interactive)
277 (let ((wash-picon-p buffer-read-only)) 307 (let ((wash-picon-p buffer-read-only))
278 (gnus-with-article-buffer 308 (gnus-with-article-buffer
279 (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) 309 (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types))
280 (gnus-delete-images 'newsgroups-picon) 310 (gnus-delete-images 'newsgroups-picon)
281 (gnus-picon-transform-newsgroups "newsgroups") 311 (gnus-picon-transform-newsgroups "newsgroups")
282 (gnus-picon-transform-newsgroups "followup-to"))) 312 (gnus-picon-transform-newsgroups "followup-to")))))
283 ))
284 313
285(provide 'gnus-picon) 314(provide 'gnus-picon)
286 315
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index b9b97797d17..d95269372f5 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -307,7 +307,7 @@ LIST1 and LIST2 have to be sorted over <."
307 (cdr top))) 307 (cdr top)))
308 308
309(defun gnus-compress-sequence (numbers &optional always-list) 309(defun gnus-compress-sequence (numbers &optional always-list)
310 "Convert list of numbers to a list of ranges or a single range. 310 "Convert sorted list of numbers to a list of ranges or a single range.
311If ALWAYS-LIST is non-nil, this function will always release a list of 311If ALWAYS-LIST is non-nil, this function will always release a list of
312ranges." 312ranges."
313 (let* ((first (car numbers)) 313 (let* ((first (car numbers))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 847cbf0a734..2ccf70efc46 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -25,11 +25,11 @@
25 25
26;;; Commentary: 26;;; Commentary:
27 27
28;; This is the gnus-registry.el package, works with other backends 28;; This is the gnus-registry.el package, which works with all
29;; besides nnmail. The major issue is that it doesn't go across 29;; backends, not just nnmail (e.g. NNTP). The major issue is that it
30;; backends, so for instance if an article is in nnml:sys and you see 30;; doesn't go across backends, so for instance if an article is in
31;; a reference to it in nnimap splitting, the article will end up in 31;; nnml:sys and you see a reference to it in nnimap splitting, the
32;; nnimap:sys 32;; article will end up in nnimap:sys
33 33
34;; gnus-registry.el intercepts article respooling, moving, deleting, 34;; gnus-registry.el intercepts article respooling, moving, deleting,
35;; and copying for all backends. If it doesn't work correctly for 35;; and copying for all backends. If it doesn't work correctly for
@@ -71,14 +71,19 @@
71 :version "22.1" 71 :version "22.1"
72 :group 'gnus) 72 :group 'gnus)
73 73
74(defvar gnus-registry-hashtb nil 74(defvar gnus-registry-hashtb (make-hash-table
75 :size 256
76 :test 'equal)
75 "*The article registry by Message ID.") 77 "*The article registry by Message ID.")
76 78
77(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue") 79(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$")
78 "List of groups that gnus-registry-split-fancy-with-parent won't follow. 80 "List of groups that gnus-registry-split-fancy-with-parent won't return.
79The group names are matched, they don't have to be fully qualified." 81The group names are matched, they don't have to be fully
82qualified. This parameter tells the Registry 'never split a
83message into a group that matches one of these, regardless of
84references.'"
80 :group 'gnus-registry 85 :group 'gnus-registry
81 :type '(repeat string)) 86 :type '(repeat regexp))
82 87
83(defcustom gnus-registry-install nil 88(defcustom gnus-registry-install nil
84 "Whether the registry should be installed." 89 "Whether the registry should be installed."
@@ -87,7 +92,8 @@ The group names are matched, they don't have to be fully qualified."
87 92
88(defcustom gnus-registry-clean-empty t 93(defcustom gnus-registry-clean-empty t
89 "Whether the empty registry entries should be deleted. 94 "Whether the empty registry entries should be deleted.
90Registry entries are considered empty when they have no groups." 95Registry entries are considered empty when they have no groups
96and no extra data."
91 :group 'gnus-registry 97 :group 'gnus-registry
92 :type 'boolean) 98 :type 'boolean)
93 99
@@ -121,7 +127,10 @@ way."
121 :group 'gnus-registry 127 :group 'gnus-registry
122 :type 'boolean) 128 :type 'boolean)
123 129
124(defcustom gnus-registry-cache-file "~/.gnus.registry.eld" 130(defcustom gnus-registry-cache-file
131 (nnheader-concat
132 (or gnus-dribble-directory gnus-home-directory "~/")
133 ".gnus.registry.eld")
125 "File where the Gnus registry will be stored." 134 "File where the Gnus registry will be stored."
126 :group 'gnus-registry 135 :group 'gnus-registry
127 :type 'file) 136 :type 'file)
@@ -132,13 +141,6 @@ way."
132 :type '(radio (const :format "Unlimited " nil) 141 :type '(radio (const :format "Unlimited " nil)
133 (integer :format "Maximum number: %v"))) 142 (integer :format "Maximum number: %v")))
134 143
135;; Function(s) missing in Emacs 20
136(when (memq nil (mapcar 'fboundp '(puthash)))
137 (require 'cl)
138 (unless (fboundp 'puthash)
139 ;; alias puthash is missing from Emacs 20 cl-extra.el
140 (defalias 'puthash 'cl-puthash)))
141
142(defun gnus-registry-track-subject-p () 144(defun gnus-registry-track-subject-p ()
143 (memq 'subject gnus-registry-track-extra)) 145 (memq 'subject gnus-registry-track-extra))
144 146
@@ -210,7 +212,7 @@ way."
210 212
211 ;; Replace the existing startup file with the temp file. 213 ;; Replace the existing startup file with the temp file.
212 (rename-file working-file startup-file t) 214 (rename-file working-file startup-file t)
213 (set-file-modes startup-file setmodes))) 215 (gnus-set-file-modes startup-file setmodes)))
214 (condition-case nil 216 (condition-case nil
215 (delete-file working-file) 217 (delete-file working-file)
216 (file-error nil))))) 218 (file-error nil)))))
@@ -221,7 +223,7 @@ way."
221;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> 223;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
222;; Save the gnus-registry file with extra line breaks. 224;; Save the gnus-registry file with extra line breaks.
223(defun gnus-registry-cache-whitespace (filename) 225(defun gnus-registry-cache-whitespace (filename)
224 (gnus-message 5 "Adding whitespace to %s" filename) 226 (gnus-message 7 "Adding whitespace to %s" filename)
225 (save-excursion 227 (save-excursion
226 (goto-char (point-min)) 228 (goto-char (point-min))
227 (while (re-search-forward "^(\\|(\\\"" nil t) 229 (while (re-search-forward "^(\\|(\\\"" nil t)
@@ -244,10 +246,12 @@ way."
244 ;; remove empty entries 246 ;; remove empty entries
245 (when gnus-registry-clean-empty 247 (when gnus-registry-clean-empty
246 (gnus-registry-clean-empty-function)) 248 (gnus-registry-clean-empty-function))
247 ;; now trim the registry appropriately 249 ;; now trim and clean text properties from the registry appropriately
248 (setq gnus-registry-alist (gnus-registry-trim 250 (setq gnus-registry-alist
249 (gnus-hashtable-to-alist 251 (gnus-registry-remove-alist-text-properties
250 gnus-registry-hashtb))) 252 (gnus-registry-trim
253 (gnus-hashtable-to-alist
254 gnus-registry-hashtb))))
251 ;; really save 255 ;; really save
252 (gnus-registry-cache-save) 256 (gnus-registry-cache-save)
253 (setq gnus-registry-entry-caching caching) 257 (setq gnus-registry-entry-caching caching)
@@ -256,11 +260,36 @@ way."
256(defun gnus-registry-clean-empty-function () 260(defun gnus-registry-clean-empty-function ()
257 "Remove all empty entries from the registry. Returns count thereof." 261 "Remove all empty entries from the registry. Returns count thereof."
258 (let ((count 0)) 262 (let ((count 0))
263
259 (maphash 264 (maphash
260 (lambda (key value) 265 (lambda (key value)
261 (unless (gnus-registry-fetch-group key) 266 (when (stringp key)
262 (incf count) 267 (dolist (group (gnus-registry-fetch-groups key))
263 (remhash key gnus-registry-hashtb))) 268 (when (gnus-parameter-registry-ignore group)
269 (gnus-message
270 10
271 "gnus-registry: deleted ignored group %s from key %s"
272 group key)
273 (gnus-registry-delete-group key group)))
274
275 (unless (gnus-registry-group-count key)
276 (gnus-registry-delete-id key))
277
278 (unless (or
279 (gnus-registry-fetch-group key)
280 ;; TODO: look for specific extra data here!
281 ;; in this example, we look for 'label
282 (gnus-registry-fetch-extra key 'label))
283 (incf count)
284 (gnus-registry-delete-id key))
285
286 (unless (stringp key)
287 (gnus-message
288 10
289 "gnus-registry key %s was not a string, removing"
290 key)
291 (gnus-registry-delete-id key))))
292
264 gnus-registry-hashtb) 293 gnus-registry-hashtb)
265 count)) 294 count))
266 295
@@ -269,8 +298,20 @@ way."
269 (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist)) 298 (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist))
270 (setq gnus-registry-dirty nil)) 299 (setq gnus-registry-dirty nil))
271 300
301(defun gnus-registry-remove-alist-text-properties (v)
302 "Remove text properties from all strings in alist."
303 (if (stringp v)
304 (gnus-string-remove-all-properties v)
305 (if (and (listp v) (listp (cdr v)))
306 (mapcar 'gnus-registry-remove-alist-text-properties v)
307 (if (and (listp v) (stringp (cdr v)))
308 (cons (gnus-registry-remove-alist-text-properties (car v))
309 (gnus-registry-remove-alist-text-properties (cdr v)))
310 v))))
311
272(defun gnus-registry-trim (alist) 312(defun gnus-registry-trim (alist)
273 "Trim alist to size, using gnus-registry-max-entries." 313 "Trim alist to size, using gnus-registry-max-entries.
314Also, drop all gnus-registry-ignored-groups matches."
274 (if (null gnus-registry-max-entries) 315 (if (null gnus-registry-max-entries)
275 alist ; just return the alist 316 alist ; just return the alist
276 ;; else, when given max-entries, trim the alist 317 ;; else, when given max-entries, trim the alist
@@ -283,27 +324,28 @@ way."
283 (lambda (key value) 324 (lambda (key value)
284 (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) 325 (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
285 gnus-registry-hashtb) 326 gnus-registry-hashtb)
286 327
287 ;; we use the return value of this setq, which is the trimmed alist 328 ;; we use the return value of this setq, which is the trimmed alist
288 (setq alist 329 (setq alist
289 (nthcdr 330 (nthcdr
290 trim-length 331 trim-length
291 (sort alist 332 (sort alist
292 (lambda (a b) 333 (lambda (a b)
293 (time-less-p 334 (time-less-p
294 (cdr (gethash (car a) timehash)) 335 (or (cdr (gethash (car a) timehash)) '(0 0 0))
295 (cdr (gethash (car b) timehash)))))))))) 336 (or (cdr (gethash (car b) timehash)) '(0 0 0))))))))))
296 337
297(defun gnus-registry-action (action data-header from &optional to method) 338(defun gnus-registry-action (action data-header from &optional to method)
298 (let* ((id (mail-header-id data-header)) 339 (let* ((id (mail-header-id data-header))
299 (subject (gnus-registry-simplify-subject 340 (subject (gnus-string-remove-all-properties
300 (mail-header-subject data-header))) 341 (gnus-registry-simplify-subject
301 (sender (mail-header-from data-header)) 342 (mail-header-subject data-header))))
343 (sender (gnus-string-remove-all-properties (mail-header-from data-header)))
302 (from (gnus-group-guess-full-name-from-command-method from)) 344 (from (gnus-group-guess-full-name-from-command-method from))
303 (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) 345 (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
304 (to-name (if to to "the Bit Bucket")) 346 (to-name (if to to "the Bit Bucket"))
305 (old-entry (gethash id gnus-registry-hashtb))) 347 (old-entry (gethash id gnus-registry-hashtb)))
306 (gnus-message 5 "Registry: article %s %s from %s to %s" 348 (gnus-message 7 "Registry: article %s %s from %s to %s"
307 id 349 id
308 (if method "respooling" "going") 350 (if method "respooling" "going")
309 from 351 from
@@ -321,7 +363,7 @@ way."
321 (let ((group (gnus-group-guess-full-name-from-command-method group))) 363 (let ((group (gnus-group-guess-full-name-from-command-method group)))
322 (when (and (stringp id) (string-match "\r$" id)) 364 (when (and (stringp id) (string-match "\r$" id))
323 (setq id (substring id 0 -1))) 365 (setq id (substring id 0 -1)))
324 (gnus-message 5 "Registry: article %s spooled to %s" 366 (gnus-message 7 "Registry: article %s spooled to %s"
325 id 367 id
326 group) 368 group)
327 (gnus-registry-add-group id group subject sender))) 369 (gnus-registry-add-group id group subject sender)))
@@ -334,36 +376,46 @@ is obtained from the registry. This function can be used as an entry
334in `nnmail-split-fancy' or `nnimap-split-fancy', for example like 376in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
335this: (: gnus-registry-split-fancy-with-parent) 377this: (: gnus-registry-split-fancy-with-parent)
336 378
379This function tracks ALL backends, unlike
380`nnmail-split-fancy-with-parent' which tracks only nnmail
381messages.
382
337For a message to be split, it looks for the parent message in the 383For a message to be split, it looks for the parent message in the
338References or In-Reply-To header and then looks in the registry to 384References or In-Reply-To header and then looks in the registry
339see which group that message was put in. This group is returned. 385to see which group that message was put in. This group is
386returned, unless it matches one of the entries in
387gnus-registry-unfollowed-groups or
388nnmail-split-fancy-with-parent-ignore-groups.
340 389
341See the Info node `(gnus)Fancy Mail Splitting' for more details." 390See the Info node `(gnus)Fancy Mail Splitting' for more details."
342 (let ((refstr (or (message-fetch-field "references") 391 (let* ((refstr (or (message-fetch-field "references") "")) ; guarantee string
343 (message-fetch-field "in-reply-to"))) 392 (reply-to (message-fetch-field "in-reply-to")) ; grab reply-to
393 ;; now, if reply-to is valid, append it to the References
394 (refstr (if reply-to
395 (concat refstr " " reply-to)
396 refstr))
344 (nnmail-split-fancy-with-parent-ignore-groups 397 (nnmail-split-fancy-with-parent-ignore-groups
345 (if (listp nnmail-split-fancy-with-parent-ignore-groups) 398 (if (listp nnmail-split-fancy-with-parent-ignore-groups)
346 nnmail-split-fancy-with-parent-ignore-groups 399 nnmail-split-fancy-with-parent-ignore-groups
347 (list nnmail-split-fancy-with-parent-ignore-groups))) 400 (list nnmail-split-fancy-with-parent-ignore-groups)))
348 references res) 401 res)
349 (if refstr 402 ;; the references string must be valid and parse to valid references
350 (progn 403 (if (and refstr (gnus-extract-references refstr))
351 (setq references (nreverse (gnus-split-references refstr))) 404 (dolist (reference (nreverse (gnus-extract-references refstr)))
352 (mapcar (lambda (x) 405 (setq res (or (gnus-registry-fetch-group reference) res))
353 (setq res (or (gnus-registry-fetch-group x) res)) 406 (when (or (gnus-registry-grep-in-list
354 (when (or (gnus-registry-grep-in-list 407 res
355 res 408 gnus-registry-unfollowed-groups)
356 gnus-registry-unfollowed-groups) 409 (gnus-registry-grep-in-list
357 (gnus-registry-grep-in-list 410 res
358 res 411 nnmail-split-fancy-with-parent-ignore-groups))
359 nnmail-split-fancy-with-parent-ignore-groups)) 412 (setq res nil)))
360 (setq res nil)))
361 references))
362 413
363 ;; else: there were no references, now try the extra tracking 414 ;; else: there were no references, now try the extra tracking
364 (let ((sender (message-fetch-field "from")) 415 (let ((sender (gnus-string-remove-all-properties(message-fetch-field "from")))
365 (subject (gnus-registry-simplify-subject 416 (subject (gnus-string-remove-all-properties
366 (message-fetch-field "subject"))) 417 (gnus-registry-simplify-subject
418 (message-fetch-field "subject"))))
367 (single-match t)) 419 (single-match t))
368 (when (and single-match 420 (when (and single-match
369 (gnus-registry-track-sender-p) 421 (gnus-registry-track-sender-p)
@@ -379,13 +431,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
379 (unless (equal res (gnus-registry-fetch-group key)) 431 (unless (equal res (gnus-registry-fetch-group key))
380 (setq single-match nil)) 432 (setq single-match nil))
381 (setq res (gnus-registry-fetch-group key)) 433 (setq res (gnus-registry-fetch-group key))
382 (gnus-message 434 (when (and sender res)
383 ;; raise level of messaging if gnus-registry-track-extra 435 (gnus-message
384 (if gnus-registry-track-extra 5 9) 436 ;; raise level of messaging if gnus-registry-track-extra
385 "%s (extra tracking) traced sender %s to group %s" 437 (if gnus-registry-track-extra 7 9)
386 "gnus-registry-split-fancy-with-parent" 438 "%s (extra tracking) traced sender %s to group %s"
387 sender 439 "gnus-registry-split-fancy-with-parent"
388 (if res res "nil"))))) 440 sender
441 res)))))
389 gnus-registry-hashtb)) 442 gnus-registry-hashtb))
390 (when (and single-match 443 (when (and single-match
391 (gnus-registry-track-subject-p) 444 (gnus-registry-track-subject-p)
@@ -402,24 +455,26 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
402 (unless (equal res (gnus-registry-fetch-group key)) 455 (unless (equal res (gnus-registry-fetch-group key))
403 (setq single-match nil)) 456 (setq single-match nil))
404 (setq res (gnus-registry-fetch-group key)) 457 (setq res (gnus-registry-fetch-group key))
405 (gnus-message 458 (when (and subject res)
406 ;; raise level of messaging if gnus-registry-track-extra 459 (gnus-message
407 (if gnus-registry-track-extra 5 9) 460 ;; raise level of messaging if gnus-registry-track-extra
408 "%s (extra tracking) traced subject %s to group %s" 461 (if gnus-registry-track-extra 7 9)
409 "gnus-registry-split-fancy-with-parent" 462 "%s (extra tracking) traced subject %s to group %s"
410 subject 463 "gnus-registry-split-fancy-with-parent"
411 (if res res "nil"))))) 464 subject
465 res)))))
412 gnus-registry-hashtb)) 466 gnus-registry-hashtb))
413 (unless single-match 467 (unless single-match
414 (gnus-message 468 (gnus-message
415 5 469 3
416 "gnus-registry-split-fancy-with-parent: too many extra matches for %s" 470 "gnus-registry-split-fancy-with-parent: too many extra matches for %s"
417 refstr) 471 refstr)
418 (setq res nil)))) 472 (setq res nil))))
419 (gnus-message 473 (when (and refstr res)
420 5 474 (gnus-message
421 "gnus-registry-split-fancy-with-parent traced %s to group %s" 475 5
422 refstr (if res res "nil")) 476 "gnus-registry-split-fancy-with-parent traced %s to group %s"
477 refstr res))
423 478
424 (when (and res gnus-registry-use-long-group-names) 479 (when (and res gnus-registry-use-long-group-names)
425 (let ((m1 (gnus-find-method-for-group res)) 480 (let ((m1 (gnus-find-method-for-group res))
@@ -436,12 +491,45 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
436 (setq res short-res)) 491 (setq res short-res))
437 ;; else... 492 ;; else...
438 (gnus-message 493 (gnus-message
439 5 494 7
440 "gnus-registry-split-fancy-with-parent ignored foreign group %s" 495 "gnus-registry-split-fancy-with-parent ignored foreign group %s"
441 res) 496 res)
442 (setq res nil)))) 497 (setq res nil))))
443 res)) 498 res))
444 499
500(defun gnus-registry-wash-for-keywords (&optional force)
501 (interactive)
502 (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article))
503 word words)
504 (if (or (not (gnus-registry-fetch-extra id 'keywords))
505 force)
506 (save-excursion
507 (set-buffer gnus-article-buffer)
508 (article-goto-body)
509 (save-window-excursion
510 (save-restriction
511 (narrow-to-region (point) (point-max))
512 (with-syntax-table gnus-adaptive-word-syntax-table
513 (while (re-search-forward "\\b\\w+\\b" nil t)
514 (setq word (gnus-registry-remove-alist-text-properties
515 (downcase (buffer-substring
516 (match-beginning 0) (match-end 0)))))
517 (if (> (length word) 3)
518 (push word words))))))
519 (gnus-registry-store-extra-entry id 'keywords words)))))
520
521(defun gnus-registry-find-keywords (keyword)
522 (interactive "skeyword: ")
523 (let (articles)
524 (maphash
525 (lambda (key value)
526 (when (gnus-registry-grep-in-list
527 keyword
528 (cdr (gnus-registry-fetch-extra key 'keywords)))
529 (push key articles)))
530 gnus-registry-hashtb)
531 articles))
532
445(defun gnus-registry-register-message-ids () 533(defun gnus-registry-register-message-ids ()
446 "Register the Message-ID of every article in the group" 534 "Register the Message-ID of every article in the group"
447 (unless (gnus-parameter-registry-ignore gnus-newsgroup-name) 535 (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
@@ -472,17 +560,19 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
472 "Fetch the Subject quickly, using the internal gnus-data-list function" 560 "Fetch the Subject quickly, using the internal gnus-data-list function"
473 (if (and (numberp article) 561 (if (and (numberp article)
474 (assoc article (gnus-data-list nil))) 562 (assoc article (gnus-data-list nil)))
475 (gnus-registry-simplify-subject 563 (gnus-string-remove-all-properties
476 (mail-header-subject (gnus-data-header 564 (gnus-registry-simplify-subject
477 (assoc article (gnus-data-list nil))))) 565 (mail-header-subject (gnus-data-header
566 (assoc article (gnus-data-list nil))))))
478 nil)) 567 nil))
479 568
480(defun gnus-registry-fetch-sender-fast (article) 569(defun gnus-registry-fetch-sender-fast (article)
481 "Fetch the Sender quickly, using the internal gnus-data-list function" 570 "Fetch the Sender quickly, using the internal gnus-data-list function"
482 (if (and (numberp article) 571 (if (and (numberp article)
483 (assoc article (gnus-data-list nil))) 572 (assoc article (gnus-data-list nil)))
484 (mail-header-from (gnus-data-header 573 (gnus-string-remove-all-properties
485 (assoc article (gnus-data-list nil)))) 574 (mail-header-from (gnus-data-header
575 (assoc article (gnus-data-list nil)))))
486 nil)) 576 nil))
487 577
488(defun gnus-registry-grep-in-list (word list) 578(defun gnus-registry-grep-in-list (word list)
@@ -491,9 +581,36 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
491 (mapcar 'not 581 (mapcar 'not
492 (mapcar 582 (mapcar
493 (lambda (x) 583 (lambda (x)
494 (string-match x word)) 584 (string-match word x))
495 list))))) 585 list)))))
496 586
587;;; if this extends to more than 'flags, it should be improved to be more generic.
588(defun gnus-registry-fetch-extra-flags (id)
589 "Get the flags of a message, based on the message ID.
590Returns a list of symbol flags or nil."
591 (car-safe (cdr (gnus-registry-fetch-extra id 'flags))))
592
593(defun gnus-registry-has-extra-flag (id flag)
594 "Checks if a message has `flag', based on the message ID."
595 (memq flag (gnus-registry-fetch-extra-flags id)))
596
597(defun gnus-registry-store-extra-flags (id &rest flag-list)
598 "Set the flags of a message, based on the message ID.
599The `flag-list' can be nil, in which case no flags are left."
600 (gnus-registry-store-extra-entry id 'flags (list flag-list)))
601
602(defun gnus-registry-delete-extra-flags (id &rest flag-delete-list)
603 "Delete the message flags in `flag-delete-list', based on the message ID."
604 (let ((flags (gnus-registry-fetch-extra-flags id)))
605 (when flags
606 (dolist (flag flag-delete-list)
607 (setq flags (delq flag flags))))
608 (gnus-registry-store-extra-flags id (car flags))))
609
610(defun gnus-registry-delete-all-extra-flags (id)
611 "Delete all the flags for a message ID."
612 (gnus-registry-store-extra-flags id nil))
613
497(defun gnus-registry-fetch-extra (id &optional entry) 614(defun gnus-registry-fetch-extra (id &optional entry)
498 "Get the extra data of a message, based on the message ID. 615 "Get the extra data of a message, based on the message ID.
499Returns the first place where the trail finds a nonstring." 616Returns the first place where the trail finds a nonstring."
@@ -551,11 +668,20 @@ The message must have at least one group name."
551 gnus-registry-hashtb) 668 gnus-registry-hashtb)
552 (setq gnus-registry-dirty t))))) 669 (setq gnus-registry-dirty t)))))
553 670
671(defun gnus-registry-delete-extra-entry (id key)
672 "Delete a specific entry in the extras field of the registry entry for id."
673 (gnus-registry-store-extra-entry id key nil))
674
554(defun gnus-registry-store-extra-entry (id key value) 675(defun gnus-registry-store-extra-entry (id key value)
555 "Put a specific entry in the extras field of the registry entry for id." 676 "Put a specific entry in the extras field of the registry entry for id."
556 (let* ((extra (gnus-registry-fetch-extra id)) 677 (let* ((extra (gnus-registry-fetch-extra id))
557 (alist (cons (cons key value) 678 ;; all the entries except the one for `key'
558 (gnus-assq-delete-all key (gnus-registry-fetch-extra id))))) 679 (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id)))
680 (alist (if value
681 (gnus-registry-remove-alist-text-properties
682 (cons (cons key value)
683 the-rest))
684 the-rest)))
559 (gnus-registry-store-extra id alist))) 685 (gnus-registry-store-extra id alist)))
560 686
561(defun gnus-registry-fetch-group (id) 687(defun gnus-registry-fetch-group (id)
@@ -570,6 +696,23 @@ Returns the first place where the trail finds a group name."
570 crumb 696 crumb
571 (gnus-group-short-name crumb)))))))) 697 (gnus-group-short-name crumb))))))))
572 698
699(defun gnus-registry-fetch-groups (id)
700 "Get the groups of a message, based on the message ID."
701 (let ((trail (gethash id gnus-registry-hashtb))
702 groups)
703 (dolist (crumb trail)
704 (when (stringp crumb)
705 ;; push the group name into the list
706 (setq
707 groups
708 (cons
709 (if (or (not (stringp crumb)) gnus-registry-use-long-group-names)
710 crumb
711 (gnus-group-short-name crumb))
712 groups))))
713 ;; return the list of groups
714 groups))
715
573(defun gnus-registry-group-count (id) 716(defun gnus-registry-group-count (id)
574 "Get the number of groups of a message, based on the message ID." 717 "Get the number of groups of a message, based on the message ID."
575 (let ((trail (gethash id gnus-registry-hashtb))) 718 (let ((trail (gethash id gnus-registry-hashtb)))
@@ -579,12 +722,11 @@ Returns the first place where the trail finds a group name."
579 722
580(defun gnus-registry-delete-group (id group) 723(defun gnus-registry-delete-group (id group)
581 "Delete a group for a message, based on the message ID." 724 "Delete a group for a message, based on the message ID."
582 (when group 725 (when (and group id)
583 (when id
584 (let ((trail (gethash id gnus-registry-hashtb)) 726 (let ((trail (gethash id gnus-registry-hashtb))
585 (group (gnus-group-short-name group))) 727 (short-group (gnus-group-short-name group)))
586 (puthash id (if trail 728 (puthash id (if trail
587 (delete group trail) 729 (delete short-group (delete group trail))
588 nil) 730 nil)
589 gnus-registry-hashtb)) 731 gnus-registry-hashtb))
590 ;; now, clear the entry if there are no more groups 732 ;; now, clear the entry if there are no more groups
@@ -593,7 +735,7 @@ Returns the first place where the trail finds a group name."
593 (gnus-registry-delete-id id))) 735 (gnus-registry-delete-id id)))
594 ;; is this ID still in the registry? 736 ;; is this ID still in the registry?
595 (when (gethash id gnus-registry-hashtb) 737 (when (gethash id gnus-registry-hashtb)
596 (gnus-registry-store-extra-entry id 'mtime (current-time)))))) 738 (gnus-registry-store-extra-entry id 'mtime (current-time)))))
597 739
598(defun gnus-registry-delete-id (id) 740(defun gnus-registry-delete-id (id)
599 "Delete a message ID from the registry." 741 "Delete a message ID from the registry."
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index e8d3e332ba3..6ecb7b4f3a6 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -128,7 +128,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
128 ;; Set up the menu. 128 ;; Set up the menu.
129 (when (gnus-visual-p 'pick-menu 'menu) 129 (when (gnus-visual-p 'pick-menu 'menu)
130 (gnus-pick-make-menu-bar)) 130 (gnus-pick-make-menu-bar))
131 (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) 131 (add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map)
132 (gnus-run-hooks 'gnus-pick-mode-hook)))) 132 (gnus-run-hooks 'gnus-pick-mode-hook))))
133 133
134(defun gnus-pick-setup-message () 134(defun gnus-pick-setup-message ()
@@ -360,7 +360,7 @@ This must be bound to a button-down mouse event."
360 ;; Set up the menu. 360 ;; Set up the menu.
361 (when (gnus-visual-p 'binary-menu 'menu) 361 (when (gnus-visual-p 'binary-menu 'menu)
362 (gnus-binary-make-menu-bar)) 362 (gnus-binary-make-menu-bar))
363 (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) 363 (add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map)
364 (gnus-run-hooks 'gnus-binary-mode-hook)))) 364 (gnus-run-hooks 'gnus-binary-mode-hook))))
365 365
366(defun gnus-binary-display-article (article &optional all-header) 366(defun gnus-binary-display-article (article &optional all-header)
@@ -719,7 +719,7 @@ Two predefined functions are available:
719 (unless (zerop level) 719 (unless (zerop level)
720 (gnus-tree-indent level) 720 (gnus-tree-indent level)
721 (insert (cadr gnus-tree-parent-child-edges)) 721 (insert (cadr gnus-tree-parent-child-edges))
722 (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) 722 (setq col (- (setq beg (point)) (point-at-bol) 1))
723 ;; Draw "|" lines upwards. 723 ;; Draw "|" lines upwards.
724 (while (progn 724 (while (progn
725 (forward-line -1) 725 (forward-line -1)
@@ -743,7 +743,7 @@ Two predefined functions are available:
743 743
744(defsubst gnus-tree-indent-vertical () 744(defsubst gnus-tree-indent-vertical ()
745 (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) 745 (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
746 (- (point) (gnus-point-at-bol))))) 746 (- (point) (point-at-bol)))))
747 (when (> len 0) 747 (when (> len 0)
748 (insert (make-string len ? ))))) 748 (insert (make-string len ? )))))
749 749
@@ -1016,11 +1016,11 @@ The following commands are available:
1016 (setq button (car buttons) 1016 (setq button (car buttons)
1017 buttons (cdr buttons)) 1017 buttons (cdr buttons))
1018 (if (stringp button) 1018 (if (stringp button)
1019 (gnus-set-text-properties 1019 (set-text-properties
1020 (point) 1020 (point)
1021 (prog2 (insert button) (point) (insert " ")) 1021 (prog2 (insert button) (point) (insert " "))
1022 (list 'face gnus-carpal-header-face)) 1022 (list 'face gnus-carpal-header-face))
1023 (gnus-set-text-properties 1023 (set-text-properties
1024 (point) 1024 (point)
1025 (prog2 (insert (car button)) (point) (insert " ")) 1025 (prog2 (insert (car button)) (point) (insert " "))
1026 (list 'gnus-callback (cdr button) 1026 (list 'gnus-callback (cdr button)
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index f7ba9222937..f910bfb3ec3 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -37,8 +37,6 @@
37(require 'message) 37(require 'message)
38(require 'score-mode) 38(require 'score-mode)
39 39
40(autoload 'ffap-string-at-point "ffap")
41
42(defcustom gnus-global-score-files nil 40(defcustom gnus-global-score-files nil
43 "List of global score files and directories. 41 "List of global score files and directories.
44Set this variable if you want to use people's score files. One entry 42Set this variable if you want to use people's score files. One entry
@@ -149,9 +147,15 @@ will be expired along with non-matching score entries."
149 :type 'boolean) 147 :type 'boolean)
150 148
151(defcustom gnus-decay-scores nil 149(defcustom gnus-decay-scores nil
152 "*If non-nil, decay non-permanent scores." 150 "*If non-nil, decay non-permanent scores.
151
152If it is a regexp, only decay score files matching regexp."
153 :group 'gnus-score-decay 153 :group 'gnus-score-decay
154 :type 'boolean) 154 :type `(choice (const :tag "never" nil)
155 (const :tag "always" t)
156 (const :tag "adaptive score files"
157 ,(concat "\\." gnus-adaptive-file-suffix "\\'"))
158 (regexp)))
155 159
156(defcustom gnus-decay-score-function 'gnus-decay-score 160(defcustom gnus-decay-score-function 'gnus-decay-score
157 "*Function called to decay a score. 161 "*Function called to decay a score.
@@ -318,6 +322,13 @@ If this variable is nil, exact matching will always be used."
318 :group 'gnus-score-files 322 :group 'gnus-score-files
319 :type 'regexp) 323 :type 'regexp)
320 324
325(defcustom gnus-adaptive-pretty-print nil
326 "If non-nil, adaptive score files fill are pretty printed."
327 :group 'gnus-score-files
328 :group 'gnus-score-adapt
329 :version "23.0" ;; No Gnus
330 :type 'boolean)
331
321(defcustom gnus-score-default-header nil 332(defcustom gnus-score-default-header nil
322 "Default header when entering new scores. 333 "Default header when entering new scores.
323 334
@@ -411,6 +422,18 @@ If nil, the user will be asked for a duration."
411 :group 'gnus-score-various 422 :group 'gnus-score-various
412 :type 'boolean) 423 :type 'boolean)
413 424
425(defcustom gnus-inhibit-slow-scoring nil
426 "Inhibit slow scoring, e.g. scoring on headers or body.
427
428If a regexp, scoring on headers or body is inhibited if the group
429matches the regexp. If it is t, scoring on headers or body is
430inhibited for all groups."
431 :group 'gnus-score-various
432 :version "23.0" ;; No Gnus
433 :type '(choice (const :tag "All" nil)
434 (const :tag "None" t)
435 regexp))
436
414 437
415 438
416;; Internal variables. 439;; Internal variables.
@@ -753,7 +776,7 @@ file for the command instead of the current score file."
753 (setq i (1+ i)))) 776 (setq i (1+ i))))
754 (goto-char (point-min)) 777 (goto-char (point-min))
755 ;; display ourselves in a small window at the bottom 778 ;; display ourselves in a small window at the bottom
756 (gnus-appt-select-lowest-window) 779 (gnus-select-lowest-window)
757 (if (< (/ (window-height) 2) window-min-height) 780 (if (< (/ (window-height) 2) window-min-height)
758 (switch-to-buffer "*Score Help*") 781 (switch-to-buffer "*Score Help*")
759 (split-window) 782 (split-window)
@@ -1099,6 +1122,16 @@ EXTRA is the possible non-standard header."
1099 4 (substitute-command-keys 1122 4 (substitute-command-keys
1100 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))) 1123 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
1101 1124
1125(defun gnus-score-edit-all-score ()
1126 "Edit the all.SCORE file."
1127 (interactive)
1128 (find-file (gnus-score-file-name "all"))
1129 (gnus-score-mode)
1130 (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
1131 (gnus-message
1132 4 (substitute-command-keys
1133 "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
1134
1102(defun gnus-score-edit-file (file) 1135(defun gnus-score-edit-file (file)
1103 "Edit a score file." 1136 "Edit a score file."
1104 (interactive 1137 (interactive
@@ -1128,9 +1161,9 @@ If FORMAT, also format the current score file."
1128 (reg " -> +") 1161 (reg " -> +")
1129 (file (save-excursion 1162 (file (save-excursion
1130 (end-of-line) 1163 (end-of-line)
1131 (if (and (re-search-backward reg (gnus-point-at-bol) t) 1164 (if (and (re-search-backward reg (point-at-bol) t)
1132 (re-search-forward reg (gnus-point-at-eol) t)) 1165 (re-search-forward reg (point-at-eol) t))
1133 (buffer-substring (point) (gnus-point-at-eol)) 1166 (buffer-substring (point) (point-at-eol))
1134 nil)))) 1167 nil))))
1135 (if (or (not file) 1168 (if (or (not file)
1136 (string-match "\\<\\(non-file rule\\|A file\\)\\>" file) 1169 (string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
@@ -1209,7 +1242,9 @@ If FORMAT, also format the current score file."
1209 (decay (car (gnus-score-get 'decay alist))) 1242 (decay (car (gnus-score-get 'decay alist)))
1210 (eval (car (gnus-score-get 'eval alist)))) 1243 (eval (car (gnus-score-get 'eval alist))))
1211 ;; Perform possible decays. 1244 ;; Perform possible decays.
1212 (when (and gnus-decay-scores 1245 (when (and (if (stringp gnus-decay-scores)
1246 (string-match gnus-decay-scores file)
1247 gnus-decay-scores)
1213 (or cached (file-exists-p file)) 1248 (or cached (file-exists-p file))
1214 (or (not decay) 1249 (or (not decay)
1215 (gnus-decay-scores alist decay))) 1250 (gnus-decay-scores alist decay)))
@@ -1219,8 +1254,7 @@ If FORMAT, also format the current score file."
1219 ;; files. 1254 ;; files.
1220 (when (and files (not global)) 1255 (when (and files (not global))
1221 (setq lists (apply 'append lists 1256 (setq lists (apply 'append lists
1222 (mapcar (lambda (file) 1257 (mapcar 'gnus-score-load-file
1223 (gnus-score-load-file file))
1224 (if adapt-file (cons adapt-file files) 1258 (if adapt-file (cons adapt-file files)
1225 files))))) 1259 files)))))
1226 (when (and eval (not global)) 1260 (when (and eval (not global))
@@ -1412,12 +1446,13 @@ If FORMAT, also format the current score file."
1412 (setq score (setcdr entry (gnus-delete-alist 'touched score))) 1446 (setq score (setcdr entry (gnus-delete-alist 'touched score)))
1413 (erase-buffer) 1447 (erase-buffer)
1414 (let (emacs-lisp-mode-hook) 1448 (let (emacs-lisp-mode-hook)
1415 (if (string-match 1449 (if (and (not gnus-adaptive-pretty-print)
1416 (concat (regexp-quote gnus-adaptive-file-suffix) "$") 1450 (string-match
1417 file) 1451 (concat (regexp-quote gnus-adaptive-file-suffix) "$")
1418 ;; This is an adaptive score file, so we do not run 1452 file))
1419 ;; it through `pp'. These files can get huge, and 1453 ;; This is an adaptive score file, so we do not run it through
1420 ;; are not meant to be edited by human hands. 1454 ;; `pp' unless requested. These files can get huge, and are
1455 ;; not meant to be edited by human hands.
1421 (gnus-prin1 score) 1456 (gnus-prin1 score)
1422 ;; This is a normal score file, so we print it very 1457 ;; This is a normal score file, so we print it very
1423 ;; prettily. 1458 ;; prettily.
@@ -1518,8 +1553,21 @@ If FORMAT, also format the current score file."
1518 (length (gnus-score-get header score))) 1553 (length (gnus-score-get header score)))
1519 scores))) 1554 scores)))
1520 ;; Call the scoring function for this type of "header". 1555 ;; Call the scoring function for this type of "header".
1521 (when (setq new (funcall (nth 2 entry) scores header 1556 (when (if (and gnus-inhibit-slow-scoring
1522 now expire trace)) 1557 (if (and (stringp gnus-inhibit-slow-scoring)
1558 ;; Always true here?
1559 ;; (stringp gnus-newsgroup-name)
1560 (string-match gnus-inhibit-slow-scoring
1561 gnus-newsgroup-name))
1562 t
1563 nil)
1564 (> 0 (nth 1 (assoc header gnus-header-index))))
1565 (progn
1566 (gnus-message
1567 7 "Scoring on headers or body skipped.")
1568 nil)
1569 (setq new (funcall (nth 2 entry) scores header
1570 now expire trace)))
1523 (push new news)))) 1571 (push new news))))
1524 (when (gnus-buffer-live-p gnus-summary-buffer) 1572 (when (gnus-buffer-live-p gnus-summary-buffer)
1525 (let ((scored gnus-newsgroup-scored)) 1573 (let ((scored gnus-newsgroup-scored))
@@ -1860,7 +1908,7 @@ score in `gnus-newsgroup-scored' by SCORE."
1860 (goto-char (point-min)) 1908 (goto-char (point-min))
1861 (if (= dmt ?e) 1909 (if (= dmt ?e)
1862 (while (funcall search-func match nil t) 1910 (while (funcall search-func match nil t)
1863 (and (= (gnus-point-at-bol) 1911 (and (= (point-at-bol)
1864 (match-beginning 0)) 1912 (match-beginning 0))
1865 (= (progn (end-of-line) (point)) 1913 (= (progn (end-of-line) (point))
1866 (match-end 0)) 1914 (match-end 0))
@@ -2030,7 +2078,7 @@ score in `gnus-newsgroup-scored' by SCORE."
2030 (funcall search-func match nil t)) 2078 (funcall search-func match nil t))
2031 ;; Is it really exact? 2079 ;; Is it really exact?
2032 (and (eolp) 2080 (and (eolp)
2033 (= (gnus-point-at-bol) (match-beginning 0)) 2081 (= (point-at-bol) (match-beginning 0))
2034 ;; Yup. 2082 ;; Yup.
2035 (progn 2083 (progn
2036 (setq found (setq arts (get-text-property 2084 (setq found (setq arts (get-text-property
@@ -2120,7 +2168,7 @@ score in `gnus-newsgroup-scored' by SCORE."
2120 (goto-char (point-min)) 2168 (goto-char (point-min))
2121 (while (and (not (eobp)) 2169 (while (and (not (eobp))
2122 (search-forward match nil t)) 2170 (search-forward match nil t))
2123 (when (and (= (gnus-point-at-bol) (match-beginning 0)) 2171 (when (and (= (point-at-bol) (match-beginning 0))
2124 (eolp)) 2172 (eolp))
2125 (setq found (setq arts (get-text-property (point) 'articles))) 2173 (setq found (setq arts (get-text-property (point) 'articles)))
2126 (if trace 2174 (if trace
@@ -2194,23 +2242,19 @@ score in `gnus-newsgroup-scored' by SCORE."
2194(defun gnus-enter-score-words-into-hashtb (hashtb) 2242(defun gnus-enter-score-words-into-hashtb (hashtb)
2195 ;; Find all the words in the buffer and enter them into 2243 ;; Find all the words in the buffer and enter them into
2196 ;; the hashtable. 2244 ;; the hashtable.
2197 (let ((syntab (syntax-table)) 2245 (let (word val)
2198 word val)
2199 (goto-char (point-min)) 2246 (goto-char (point-min))
2200 (unwind-protect 2247 (with-syntax-table gnus-adaptive-word-syntax-table
2201 (progn 2248 (while (re-search-forward "\\b\\w+\\b" nil t)
2202 (set-syntax-table gnus-adaptive-word-syntax-table) 2249 (setq val
2203 (while (re-search-forward "\\b\\w+\\b" nil t) 2250 (gnus-gethash
2204 (setq val 2251 (setq word (downcase (buffer-substring
2205 (gnus-gethash 2252 (match-beginning 0) (match-end 0))))
2206 (setq word (downcase (buffer-substring 2253 hashtb))
2207 (match-beginning 0) (match-end 0)))) 2254 (gnus-sethash
2208 hashtb)) 2255 word
2209 (gnus-sethash 2256 (append (get-text-property (point-at-eol) 'articles) val)
2210 word 2257 hashtb)))
2211 (append (get-text-property (gnus-point-at-eol) 'articles) val)
2212 hashtb)))
2213 (set-syntax-table syntab))
2214 ;; Make all the ignorable words ignored. 2258 ;; Make all the ignorable words ignored.
2215 (let ((ignored (append gnus-ignored-adaptive-words 2259 (let ((ignored (append gnus-ignored-adaptive-words
2216 (if gnus-adaptive-word-no-group-words 2260 (if gnus-adaptive-word-no-group-words
@@ -2313,39 +2357,35 @@ score in `gnus-newsgroup-scored' by SCORE."
2313 (let* ((hashtb (gnus-make-hashtable 1000)) 2357 (let* ((hashtb (gnus-make-hashtable 1000))
2314 (date (date-to-day (current-time-string))) 2358 (date (date-to-day (current-time-string)))
2315 (data gnus-newsgroup-data) 2359 (data gnus-newsgroup-data)
2316 (syntab (syntax-table))
2317 word d score val) 2360 word d score val)
2318 (unwind-protect 2361 (with-syntax-table gnus-adaptive-word-syntax-table
2319 (progn 2362 ;; Go through all articles.
2320 (set-syntax-table gnus-adaptive-word-syntax-table) 2363 (while (setq d (pop data))
2321 ;; Go through all articles. 2364 (when (and
2322 (while (setq d (pop data)) 2365 (not (gnus-data-pseudo-p d))
2323 (when (and 2366 (setq score
2324 (not (gnus-data-pseudo-p d)) 2367 (cdr (assq
2325 (setq score 2368 (gnus-data-mark d)
2326 (cdr (assq 2369 gnus-adaptive-word-score-alist))))
2327 (gnus-data-mark d) 2370 ;; This article has a mark that should lead to
2328 gnus-adaptive-word-score-alist)))) 2371 ;; adaptive word rules, so we insert the subject
2329 ;; This article has a mark that should lead to 2372 ;; and find all words in that string.
2330 ;; adaptive word rules, so we insert the subject 2373 (insert (mail-header-subject (gnus-data-header d)))
2331 ;; and find all words in that string. 2374 (downcase-region (point-min) (point-max))
2332 (insert (mail-header-subject (gnus-data-header d))) 2375 (goto-char (point-min))
2333 (downcase-region (point-min) (point-max)) 2376 (while (re-search-forward "\\b\\w+\\b" nil t)
2334 (goto-char (point-min)) 2377 ;; Put the word and score into the hashtb.
2335 (while (re-search-forward "\\b\\w+\\b" nil t) 2378 (setq val (gnus-gethash (setq word (match-string 0))
2336 ;; Put the word and score into the hashtb. 2379 hashtb))
2337 (setq val (gnus-gethash (setq word (match-string 0)) 2380 (when (or (not gnus-adaptive-word-length-limit)
2338 hashtb)) 2381 (> (length word)
2339 (when (or (not gnus-adaptive-word-length-limit) 2382 gnus-adaptive-word-length-limit))
2340 (> (length word) 2383 (setq val (+ score (or val 0)))
2341 gnus-adaptive-word-length-limit)) 2384 (if (and gnus-adaptive-word-minimum
2342 (setq val (+ score (or val 0))) 2385 (< val gnus-adaptive-word-minimum))
2343 (if (and gnus-adaptive-word-minimum 2386 (setq val gnus-adaptive-word-minimum))
2344 (< val gnus-adaptive-word-minimum)) 2387 (gnus-sethash word val hashtb)))
2345 (setq val gnus-adaptive-word-minimum)) 2388 (erase-buffer))))
2346 (gnus-sethash word val hashtb)))
2347 (erase-buffer))))
2348 (set-syntax-table syntab))
2349 ;; Make all the ignorable words ignored. 2389 ;; Make all the ignorable words ignored.
2350 (let ((ignored (append gnus-ignored-adaptive-words 2390 (let ((ignored (append gnus-ignored-adaptive-words
2351 (if gnus-adaptive-word-no-group-words 2391 (if gnus-adaptive-word-no-group-words
@@ -2373,7 +2413,8 @@ score in `gnus-newsgroup-scored' by SCORE."
2373 (when winconf 2413 (when winconf
2374 (set-window-configuration winconf)) 2414 (set-window-configuration winconf))
2375 (gnus-score-remove-from-cache bufnam) 2415 (gnus-score-remove-from-cache bufnam)
2376 (gnus-score-load-file bufnam))) 2416 (gnus-score-load-file bufnam)
2417 (run-hooks 'gnus-score-edit-done-hook)))
2377 2418
2378(defun gnus-score-find-trace () 2419(defun gnus-score-find-trace ()
2379 "Find all score rules that applies to the current article." 2420 "Find all score rules that applies to the current article."
@@ -2401,6 +2442,11 @@ score in `gnus-newsgroup-scored' by SCORE."
2401 (interactive) 2442 (interactive)
2402 (bury-buffer nil) 2443 (bury-buffer nil)
2403 (gnus-summary-expand-window))) 2444 (gnus-summary-expand-window)))
2445 (local-set-key "k"
2446 (lambda ()
2447 (interactive)
2448 (kill-buffer (current-buffer))
2449 (gnus-summary-expand-window)))
2404 (local-set-key "e" (lambda () 2450 (local-set-key "e" (lambda ()
2405 "Run `gnus-score-edit-file-at-point'." 2451 "Run `gnus-score-edit-file-at-point'."
2406 (interactive) 2452 (interactive)
@@ -2429,7 +2475,7 @@ score in `gnus-newsgroup-scored' by SCORE."
2429Type `e' to edit score file corresponding to the score rule on current line, 2475Type `e' to edit score file corresponding to the score rule on current line,
2430`f' to format (pretty print) the score file and edit it, 2476`f' to format (pretty print) the score file and edit it,
2431`t' toggle to truncate long lines in this buffer, 2477`t' toggle to truncate long lines in this buffer,
2432`q' to quit. 2478`q' to quit, `k' to kill score trace buffer.
2433 2479
2434The first sexp on each line is the score rule, followed by the file name of 2480The first sexp on each line is the score rule, followed by the file name of
2435the score file and its full name, including the directory.") 2481the score file and its full name, including the directory.")
@@ -2775,9 +2821,7 @@ Destroys the current buffer."
2775 (lambda (file) 2821 (lambda (file)
2776 (cons (inline (gnus-score-file-rank file)) file)) 2822 (cons (inline (gnus-score-file-rank file)) file))
2777 files))) 2823 files)))
2778 (mapcar 2824 (mapcar 'cdr (sort alist 'car-less-than-car)))))
2779 (lambda (f) (cdr f))
2780 (sort alist 'car-less-than-car)))))
2781 2825
2782(defun gnus-score-find-alist (group) 2826(defun gnus-score-find-alist (group)
2783 "Return list of score files for GROUP. 2827 "Return list of score files for GROUP.
diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el
index 55ab016a59e..fe261e119ee 100644
--- a/lisp/gnus/gnus-setup.el
+++ b/lisp/gnus/gnus-setup.el
@@ -140,8 +140,7 @@
140 140
141(when gnus-use-sc 141(when gnus-use-sc
142 (add-hook 'mail-citation-hook 'sc-cite-original) 142 (add-hook 'mail-citation-hook 'sc-cite-original)
143 (setq message-cite-function 'sc-cite-original) 143 (setq message-cite-function 'sc-cite-original))
144 (autoload 'sc-cite-original "supercite"))
145 144
146;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) 145;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137))
147;;; Generated autoloads from lisp/gnus.el 146;;; Generated autoloads from lisp/gnus.el
diff --git a/lisp/gnus/gnus-soup.el b/lisp/gnus/gnus-soup.el
index 241fb6a2c86..f2aa34b1aa1 100644
--- a/lisp/gnus/gnus-soup.el
+++ b/lisp/gnus/gnus-soup.el
@@ -306,7 +306,7 @@ Note -- this function hasn't been implemented yet."
306If NOT-ALL, don't pack ticked articles." 306If NOT-ALL, don't pack ticked articles."
307 (let ((gnus-expert-user t) 307 (let ((gnus-expert-user t)
308 (gnus-large-newsgroup nil) 308 (gnus-large-newsgroup nil)
309 (entry (gnus-gethash group gnus-newsrc-hashtb))) 309 (entry (gnus-group-entry group)))
310 (when (or (null entry) 310 (when (or (null entry)
311 (eq (car entry) t) 311 (eq (car entry) t)
312 (and (car entry) 312 (and (car entry)
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 2197e286757..f87377cb1ed 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -140,7 +140,7 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
140(defvar gnus-format-specs 140(defvar gnus-format-specs
141 `((version . ,emacs-version) 141 `((version . ,emacs-version)
142 (gnus-version . ,(gnus-continuum-version)) 142 (gnus-version . ,(gnus-continuum-version))
143 (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) 143 (group "%M\%S\%p\%P\%5y: %(%g%)\n" ,gnus-group-line-format-spec)
144 (summary-dummy "* %(: :%) %S\n" 144 (summary-dummy "* %(: :%) %S\n"
145 ,gnus-summary-dummy-line-format-spec) 145 ,gnus-summary-dummy-line-format-spec)
146 (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" 146 (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
@@ -198,12 +198,13 @@ Return a list of updated types."
198 (not (equal emacs-version 198 (not (equal emacs-version
199 (cdr (assq 'version gnus-format-specs))))) 199 (cdr (assq 'version gnus-format-specs)))))
200 (setq gnus-format-specs nil)) 200 (setq gnus-format-specs nil))
201 ;; Flush the group format spec cache if it doesn't support decoded 201 ;; Flush the group format spec cache if there's the grouplens stuff
202 ;; group names. 202 ;; or it doesn't support decoded group names.
203 (when (memq 'group types) 203 (when (memq 'group types)
204 (let ((spec (assq 'group gnus-format-specs))) 204 (let* ((spec (assq 'group gnus-format-specs))
205 (unless (string-match " gnus-tmp-decoded-group[ )]" 205 (sspec (gnus-prin1-to-string (nth 2 spec))))
206 (gnus-prin1-to-string (nth 2 spec))) 206 (when (or (string-match " gnus-tmp-grouplens[ )]" sspec)
207 (not (string-match " gnus-tmp-decoded-group[ )]" sspec)))
207 (setq gnus-format-specs (delq spec gnus-format-specs))))) 208 (setq gnus-format-specs (delq spec gnus-format-specs)))))
208 209
209 ;; Go through all the formats and see whether they need updating. 210 ;; Go through all the formats and see whether they need updating.
@@ -296,9 +297,7 @@ Return a list of updated types."
296 297
297(defun gnus-correct-length (string) 298(defun gnus-correct-length (string)
298 "Return the correct width of STRING." 299 "Return the correct width of STRING."
299 (let ((length 0)) 300 (apply #'+ (mapcar #'char-width string)))
300 (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
301 length))
302 301
303(defun gnus-correct-substring (string start &optional end) 302(defun gnus-correct-substring (string start &optional end)
304 (let ((wstart 0) 303 (let ((wstart 0)
@@ -310,14 +309,14 @@ Return a list of updated types."
310 ;; Find the start position. 309 ;; Find the start position.
311 (while (and (< seek length) 310 (while (and (< seek length)
312 (< wseek start)) 311 (< wseek start))
313 (incf wseek (gnus-char-width (aref string seek))) 312 (incf wseek (char-width (aref string seek)))
314 (incf seek)) 313 (incf seek))
315 (setq wstart seek) 314 (setq wstart seek)
316 ;; Find the end position. 315 ;; Find the end position.
317 (while (and (<= seek length) 316 (while (and (<= seek length)
318 (or (not end) 317 (or (not end)
319 (<= wseek end))) 318 (<= wseek end)))
320 (incf wseek (gnus-char-width (aref string seek))) 319 (incf wseek (char-width (aref string seek)))
321 (incf seek)) 320 (incf seek))
322 (setq wend seek) 321 (setq wend seek)
323 (substring string wstart (1- wend)))) 322 (substring string wstart (1- wend))))
@@ -622,6 +621,9 @@ are supported for %s."
622 ?s))) 621 ?s)))
623 ;; Find the specification from `spec-alist'. 622 ;; Find the specification from `spec-alist'.
624 ((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) 623 ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
624 ;; We used to use "%l" for displaying the grouplens score.
625 ((eq spec ?l)
626 (setq elem '("" ?s)))
625 (t 627 (t
626 (setq elem '("*" ?s)))) 628 (setq elem '("*" ?s))))
627 (setq elem-type (cadr elem)) 629 (setq elem-type (cadr elem))
@@ -672,7 +674,7 @@ are supported for %s."
672 (list (car flist))) 674 (list (car flist)))
673 ;; A single number. 675 ;; A single number.
674 ((string= fstring "%d") 676 ((string= fstring "%d")
675 (setq dontinsert) 677 (setq dontinsert t)
676 (if insert 678 (if insert
677 (list `(princ ,(car flist))) 679 (list `(princ ,(car flist)))
678 (list `(int-to-string ,(car flist))))) 680 (list `(int-to-string ,(car flist)))))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 9e709d0916c..ca087f9ca4d 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -52,7 +52,7 @@ with some simple extensions.
52 52
53The following specs are understood: 53The following specs are understood:
54 54
55%h backend 55%h back end
56%n name 56%n name
57%w address 57%w address
58%s status 58%s status
@@ -116,6 +116,7 @@ If nil, a faster, but more primitive, buffer is used instead."
116 ["Copy" gnus-server-copy-server t] 116 ["Copy" gnus-server-copy-server t]
117 ["Edit" gnus-server-edit-server t] 117 ["Edit" gnus-server-edit-server t]
118 ["Regenerate" gnus-server-regenerate-server t] 118 ["Regenerate" gnus-server-regenerate-server t]
119 ["Compact" gnus-server-compact-server t]
119 ["Exit" gnus-server-exit t])) 120 ["Exit" gnus-server-exit t]))
120 121
121 (easy-menu-define 122 (easy-menu-define
@@ -165,6 +166,8 @@ If nil, a faster, but more primitive, buffer is used instead."
165 166
166 "g" gnus-server-regenerate-server 167 "g" gnus-server-regenerate-server
167 168
169 "z" gnus-server-compact-server
170
168 "\C-c\C-i" gnus-info-find-node 171 "\C-c\C-i" gnus-info-find-node
169 "\C-c\C-b" gnus-bug)) 172 "\C-c\C-b" gnus-bug))
170 173
@@ -189,7 +192,7 @@ If nil, a faster, but more primitive, buffer is used instead."
189(defface gnus-server-closed 192(defface gnus-server-closed
190 '((((class color) (background light)) (:foreground "Steel Blue" :italic t)) 193 '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
191 (((class color) (background dark)) 194 (((class color) (background dark))
192 (:foreground "Light Steel Blue" :italic t)) 195 (:foreground "LightBlue" :italic t))
193 (t (:italic t))) 196 (t (:italic t)))
194 "Face used for displaying CLOSED servers" 197 "Face used for displaying CLOSED servers"
195 :group 'gnus-server-visual) 198 :group 'gnus-server-visual)
@@ -299,7 +302,6 @@ The following commands are available:
299 (gnus-set-format 'server t) 302 (gnus-set-format 'server t)
300 (let ((alist gnus-server-alist) 303 (let ((alist gnus-server-alist)
301 (buffer-read-only nil) 304 (buffer-read-only nil)
302 (opened gnus-opened-servers)
303 done server op-ser) 305 done server op-ser)
304 (erase-buffer) 306 (erase-buffer)
305 (setq gnus-inserted-opened-servers nil) 307 (setq gnus-inserted-opened-servers nil)
@@ -314,27 +316,26 @@ The following commands are available:
314 (pop alist))) 316 (pop alist)))
315 ;; Then we insert the list of servers that have been opened in 317 ;; Then we insert the list of servers that have been opened in
316 ;; this session. 318 ;; this session.
317 (while opened 319 (dolist (open gnus-opened-servers)
318 (when (and (not (member (caar opened) done)) 320 (when (and (not (member (car open) done))
319 ;; Just ignore ephemeral servers. 321 ;; Just ignore ephemeral servers.
320 (not (member (caar opened) gnus-ephemeral-servers))) 322 (not (member (car open) gnus-ephemeral-servers)))
321 (push (caar opened) done) 323 (push (car open) done)
322 (gnus-server-insert-server-line 324 (gnus-server-insert-server-line
323 (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) 325 (setq op-ser (format "%s:%s" (caar open) (nth 1 (car open))))
324 (caar opened)) 326 (car open))
325 (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) 327 (push (list op-ser (car open)) gnus-inserted-opened-servers))))
326 (setq opened (cdr opened))))
327 (goto-char (point-min)) 328 (goto-char (point-min))
328 (gnus-server-position-point)) 329 (gnus-server-position-point))
329 330
330(defun gnus-server-server-name () 331(defun gnus-server-server-name ()
331 (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) 332 (let ((server (get-text-property (point-at-bol) 'gnus-server)))
332 (and server (symbol-name server)))) 333 (and server (symbol-name server))))
333 334
334(defun gnus-server-named-server () 335(defun gnus-server-named-server ()
335 "Returns a server name that matches one of the names returned by 336 "Return a server name that matches one of the names returned by
336gnus-method-to-server." 337`gnus-method-to-server'."
337 (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server))) 338 (let ((server (get-text-property (point-at-bol) 'gnus-named-server)))
338 (and server (symbol-name server)))) 339 (and server (symbol-name server))))
339 340
340(defalias 'gnus-server-position-point 'gnus-goto-colon) 341(defalias 'gnus-server-position-point 'gnus-goto-colon)
@@ -377,7 +378,14 @@ gnus-method-to-server."
377 (if cached 378 (if cached
378 (setq gnus-server-method-cache 379 (setq gnus-server-method-cache
379 (delq cached gnus-server-method-cache))) 380 (delq cached gnus-server-method-cache)))
380 (if entry (setcdr entry info) 381 (if entry
382 (progn
383 ;; Remove the server from `gnus-opened-servers' since
384 ;; it has never been opened with the new `info' yet.
385 (gnus-opened-servers-remove (cdr entry))
386 ;; Don't make a new Lisp object.
387 (setcar (cdr entry) (car info))
388 (setcdr (cdr entry) (cdr info)))
381 (setq gnus-server-alist 389 (setq gnus-server-alist
382 (nconc gnus-server-alist (list (cons server info)))))))) 390 (nconc gnus-server-alist (list (cons server info))))))))
383 391
@@ -478,9 +486,8 @@ gnus-method-to-server."
478(defun gnus-server-open-all-servers () 486(defun gnus-server-open-all-servers ()
479 "Open all servers." 487 "Open all servers."
480 (interactive) 488 (interactive)
481 (let ((servers gnus-inserted-opened-servers)) 489 (dolist (server gnus-inserted-opened-servers)
482 (while servers 490 (gnus-server-open-server (car server))))
483 (gnus-server-open-server (car (pop servers))))))
484 491
485(defun gnus-server-close-server (server) 492(defun gnus-server-close-server (server)
486 "Close SERVER." 493 "Close SERVER."
@@ -510,6 +517,8 @@ gnus-method-to-server."
510 "Close all servers." 517 "Close all servers."
511 (interactive) 518 (interactive)
512 (dolist (server gnus-inserted-opened-servers) 519 (dolist (server gnus-inserted-opened-servers)
520 (gnus-server-close-server (car server)))
521 (dolist (server gnus-server-alist)
513 (gnus-server-close-server (car server)))) 522 (gnus-server-close-server (car server))))
514 523
515(defun gnus-server-deny-server (server) 524(defun gnus-server-deny-server (server)
@@ -586,7 +595,8 @@ gnus-method-to-server."
586 `(lambda (form) 595 `(lambda (form)
587 (gnus-server-set-info ,server form) 596 (gnus-server-set-info ,server form)
588 (gnus-server-list-servers) 597 (gnus-server-list-servers)
589 (gnus-server-position-point))))) 598 (gnus-server-position-point))
599 'edit-server)))
590 600
591(defun gnus-server-scan-server (server) 601(defun gnus-server-scan-server (server)
592 "Request a scan from the current server." 602 "Request a scan from the current server."
@@ -717,11 +727,12 @@ gnus-method-to-server."
717 (while (not (eobp)) 727 (while (not (eobp))
718 (ignore-errors 728 (ignore-errors
719 (push (cons 729 (push (cons
720 (buffer-substring 730 (mm-string-as-unibyte
721 (point) 731 (buffer-substring
722 (progn 732 (point)
723 (skip-chars-forward "^ \t") 733 (progn
724 (point))) 734 (skip-chars-forward "^ \t")
735 (point))))
725 (let ((last (read cur))) 736 (let ((last (read cur)))
726 (cons (read cur) last))) 737 (cons (read cur) last)))
727 groups)) 738 groups))
@@ -729,18 +740,19 @@ gnus-method-to-server."
729 (while (not (eobp)) 740 (while (not (eobp))
730 (ignore-errors 741 (ignore-errors
731 (push (cons 742 (push (cons
732 (if (eq (char-after) ?\") 743 (mm-string-as-unibyte
733 (read cur) 744 (if (eq (char-after) ?\")
734 (let ((p (point)) (name "")) 745 (read cur)
735 (skip-chars-forward "^ \t\\\\") 746 (let ((p (point)) (name ""))
736 (setq name (buffer-substring p (point))) 747 (skip-chars-forward "^ \t\\\\")
737 (while (eq (char-after) ?\\) 748 (setq name (buffer-substring p (point)))
738 (setq p (1+ (point))) 749 (while (eq (char-after) ?\\)
739 (forward-char 2) 750 (setq p (1+ (point)))
740 (skip-chars-forward "^ \t\\\\") 751 (forward-char 2)
741 (setq name (concat name (buffer-substring 752 (skip-chars-forward "^ \t\\\\")
742 p (point))))) 753 (setq name (concat name (buffer-substring
743 name)) 754 p (point)))))
755 name)))
744 (let ((last (read cur))) 756 (let ((last (read cur)))
745 (cons (read cur) last))) 757 (cons (read cur) last)))
746 groups)) 758 groups))
@@ -783,18 +795,26 @@ gnus-method-to-server."
783 (prog1 (1+ (point)) 795 (prog1 (1+ (point))
784 (insert 796 (insert
785 (format "%c%7d: %s\n" 797 (format "%c%7d: %s\n"
786 (let ((level (gnus-group-level 798 (let ((level
787 (concat prefix (setq name (car group)))))) 799 (if (string= prefix "")
788 (cond 800 (gnus-group-level (setq name (car group)))
789 ((<= level gnus-level-subscribed) ? ) 801 (gnus-group-level
790 ((<= level gnus-level-unsubscribed) ?U) 802 (concat prefix (setq name (car group)))))))
791 ((= level gnus-level-zombie) ?Z) 803 (cond
792 (t ?K))) 804 ((<= level gnus-level-subscribed) ? )
805 ((<= level gnus-level-unsubscribed) ?U)
806 ((= level gnus-level-zombie) ?Z)
807 (t ?K)))
793 (max 0 (- (1+ (cddr group)) (cadr group))) 808 (max 0 (- (1+ (cddr group)) (cadr group)))
794 (mm-decode-coding-string 809 ;; Don't decode if name is ASCII
795 name 810 (if (and (fboundp 'detect-coding-string)
796 (inline (gnus-group-name-charset method name)))))) 811 (eq (detect-coding-string name t) 'undecided))
797 (list 'gnus-group name)))) 812 name
813 (mm-decode-coding-string
814 name
815 (inline (gnus-group-name-charset method name)))))))
816 (list 'gnus-group name)
817 )))
798 (switch-to-buffer (current-buffer))) 818 (switch-to-buffer (current-buffer)))
799 (goto-char (point-min)) 819 (goto-char (point-min))
800 (gnus-group-position-point) 820 (gnus-group-position-point)
@@ -885,7 +905,7 @@ If NUMBER, fetch this number of articles."
885 (save-excursion 905 (save-excursion
886 (beginning-of-line) 906 (beginning-of-line)
887 (let ((name (get-text-property (point) 'gnus-group))) 907 (let ((name (get-text-property (point) 'gnus-group)))
888 (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) 908 (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t)
889 (concat (gnus-method-to-server-name gnus-browse-current-method) ":" 909 (concat (gnus-method-to-server-name gnus-browse-current-method) ":"
890 (or name 910 (or name
891 (match-string-no-properties 1))))))) 911 (match-string-no-properties 1)))))))
@@ -926,8 +946,7 @@ If NUMBER, fetch this number of articles."
926 gnus-browse-current-method)))) 946 gnus-browse-current-method))))
927 gnus-level-default-subscribed (gnus-group-level group) 947 gnus-level-default-subscribed (gnus-group-level group)
928 (and (car (nth 1 gnus-newsrc-alist)) 948 (and (car (nth 1 gnus-newsrc-alist))
929 (gnus-gethash (car (nth 1 gnus-newsrc-alist)) 949 (gnus-group-entry (car (nth 1 gnus-newsrc-alist))))
930 gnus-newsrc-hashtb))
931 (null (gnus-group-entry group))) 950 (null (gnus-group-entry group)))
932 (delete-char 1) 951 (delete-char 1)
933 (insert ? )) 952 (insert ? ))
@@ -966,7 +985,7 @@ If NUMBER, fetch this number of articles."
966 (gnus-get-function (gnus-server-to-method server) 985 (gnus-get-function (gnus-server-to-method server)
967 'request-regenerate) 986 'request-regenerate)
968 (error 987 (error
969 (error "This backend doesn't support regeneration"))) 988 (error "This back end doesn't support regeneration")))
970 (gnus-message 5 "Requesting regeneration of %s..." server) 989 (gnus-message 5 "Requesting regeneration of %s..." server)
971 (unless (gnus-open-server server) 990 (unless (gnus-open-server server)
972 (error "Couldn't open server")) 991 (error "Couldn't open server"))
@@ -974,6 +993,40 @@ If NUMBER, fetch this number of articles."
974 (gnus-message 5 "Requesting regeneration of %s...done" server) 993 (gnus-message 5 "Requesting regeneration of %s...done" server)
975 (gnus-message 5 "Couldn't regenerate %s" server)))) 994 (gnus-message 5 "Couldn't regenerate %s" server))))
976 995
996
997;;;
998;;; Server compaction. -- dvl
999;;;
1000
1001;; #### FIXME: this function currently fails to update the Group buffer's
1002;; #### appearance.
1003(defun gnus-server-compact-server ()
1004 "Issue a command to the server to compact all its groups.
1005
1006Note: currently only implemented in nnml."
1007 (interactive)
1008 (let ((server (gnus-server-server-name)))
1009 (unless server
1010 (error "No server on the current line"))
1011 (condition-case ()
1012 (gnus-get-function (gnus-server-to-method server)
1013 'request-compact)
1014 (error
1015 (error "This back end doesn't support compaction")))
1016 (gnus-message 5 "\
1017Requesting compaction of %s... (this may take a long time)"
1018 server)
1019 (unless (gnus-open-server server)
1020 (error "Couldn't open server"))
1021 (if (not (gnus-request-compact server))
1022 (gnus-message 5 "Couldn't compact %s" server)
1023 (gnus-message 5 "Requesting compaction of %s...done" server)
1024 ;; Invalidate the original article buffer which might be out of date.
1025 ;; #### NOTE: Yes, this might be a bit rude, but since compaction
1026 ;; #### will not happen very often, I think this is acceptable.
1027 (let ((original (get-buffer gnus-original-article-buffer)))
1028 (and original (gnus-kill-buffer original))))))
1029
977(provide 'gnus-srvr) 1030(provide 'gnus-srvr)
978 1031
979;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25 1032;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 526e350f592..1c5d7f6e037 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -506,19 +506,23 @@ Can be used to turn version control on or off."
506 506
507(defun gnus-subscribe-hierarchical-interactive (groups) 507(defun gnus-subscribe-hierarchical-interactive (groups)
508 (let ((groups (sort groups 'string<)) 508 (let ((groups (sort groups 'string<))
509 prefixes prefix start ans group starts) 509 prefixes prefix start ans group starts real-group)
510 (while groups 510 (while groups
511 (setq prefixes (list "^")) 511 (setq prefixes (list "^"))
512 (while (and groups prefixes) 512 (while (and groups prefixes)
513 (while (not (string-match (car prefixes) (car groups))) 513 (while (not (string-match (car prefixes)
514 (gnus-group-real-name (car groups))))
514 (setq prefixes (cdr prefixes))) 515 (setq prefixes (cdr prefixes)))
515 (setq prefix (car prefixes)) 516 (setq prefix (car prefixes))
516 (setq start (1- (length prefix))) 517 (setq start (1- (length prefix)))
517 (if (and (string-match "[^\\.]\\." (car groups) start) 518 (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups))
519 start)
518 (cdr groups) 520 (cdr groups)
519 (setq prefix 521 (setq prefix
520 (concat "^" (substring (car groups) 0 (match-end 0)))) 522 (concat "^" (substring
521 (string-match prefix (cadr groups))) 523 (gnus-group-real-name (car groups))
524 0 (match-end 0))))
525 (string-match prefix (gnus-group-real-name (cadr groups))))
522 (progn 526 (progn
523 (push prefix prefixes) 527 (push prefix prefixes)
524 (message "Descend hierarchy %s? ([y]nsq): " 528 (message "Descend hierarchy %s? ([y]nsq): "
@@ -530,16 +534,18 @@ Can be used to turn version control on or off."
530 (substring prefix 1 (1- (length prefix))))) 534 (substring prefix 1 (1- (length prefix)))))
531 (cond ((= ans ?n) 535 (cond ((= ans ?n)
532 (while (and groups 536 (while (and groups
533 (string-match prefix 537 (setq group (car groups)
534 (setq group (car groups)))) 538 real-group (gnus-group-real-name group))
539 (string-match prefix real-group))
535 (push group gnus-killed-list) 540 (push group gnus-killed-list)
536 (gnus-sethash group group gnus-killed-hashtb) 541 (gnus-sethash group group gnus-killed-hashtb)
537 (setq groups (cdr groups))) 542 (setq groups (cdr groups)))
538 (setq starts (cdr starts))) 543 (setq starts (cdr starts)))
539 ((= ans ?s) 544 ((= ans ?s)
540 (while (and groups 545 (while (and groups
541 (string-match prefix 546 (setq group (car groups)
542 (setq group (car groups)))) 547 real-group (gnus-group-real-name group))
548 (string-match prefix real-group))
543 (gnus-sethash group group gnus-killed-hashtb) 549 (gnus-sethash group group gnus-killed-hashtb)
544 (gnus-subscribe-alphabetically (car groups)) 550 (gnus-subscribe-alphabetically (car groups))
545 (setq groups (cdr groups))) 551 (setq groups (cdr groups)))
@@ -632,8 +638,7 @@ the first newsgroup."
632 ;; We subscribe the group by changing its level to `subscribed'. 638 ;; We subscribe the group by changing its level to `subscribed'.
633 (gnus-group-change-level 639 (gnus-group-change-level
634 newsgroup gnus-level-default-subscribed 640 newsgroup gnus-level-default-subscribed
635 gnus-level-killed (gnus-gethash (or next "dummy.group") 641 gnus-level-killed (gnus-group-entry (or next "dummy.group")))
636 gnus-newsrc-hashtb))
637 (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) 642 (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
638 (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) 643 (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
639 t)) 644 t))
@@ -755,6 +760,13 @@ prompt the user for the name of an NNTP server to use."
755 (nnheader-init-server-buffer) 760 (nnheader-init-server-buffer)
756 (setq gnus-slave slave) 761 (setq gnus-slave slave)
757 (gnus-read-init-file) 762 (gnus-read-init-file)
763
764 ;; Add "native" to gnus-predefined-server-alist just to have a
765 ;; name for the native select method.
766 (when gnus-select-method
767 (push (cons "native" gnus-select-method)
768 gnus-predefined-server-alist))
769
758 (if gnus-agent 770 (if gnus-agent
759 (gnus-agentize)) 771 (gnus-agentize))
760 772
@@ -787,11 +799,6 @@ prompt the user for the name of an NNTP server to use."
787 (when (or gnus-slave gnus-use-dribble-file) 799 (when (or gnus-slave gnus-use-dribble-file)
788 (gnus-dribble-read-file)) 800 (gnus-dribble-read-file))
789 801
790 ;; Allow using GroupLens predictions.
791 (when gnus-use-grouplens
792 (bbb-login)
793 (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
794
795 ;; Do the actual startup. 802 ;; Do the actual startup.
796 (if gnus-agent 803 (if gnus-agent
797 (gnus-request-create-group "queue" '(nndraft ""))) 804 (gnus-request-create-group "queue" '(nndraft "")))
@@ -809,8 +816,7 @@ prompt the user for the name of an NNTP server to use."
809(defun gnus-start-draft-setup () 816(defun gnus-start-draft-setup ()
810 "Make sure the draft group exists." 817 "Make sure the draft group exists."
811 (gnus-request-create-group "drafts" '(nndraft "")) 818 (gnus-request-create-group "drafts" '(nndraft ""))
812 (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) 819 (unless (gnus-group-entry "nndraft:drafts")
813 (gnus-message 3 "Subscribing drafts group")
814 (let ((gnus-level-default-subscribed 1)) 820 (let ((gnus-level-default-subscribed 1))
815 (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))) 821 (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
816 (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t) 822 (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
@@ -891,7 +897,7 @@ prompt the user for the name of an NNTP server to use."
891 (when (and (file-exists-p gnus-current-startup-file) 897 (when (and (file-exists-p gnus-current-startup-file)
892 (file-exists-p dribble-file) 898 (file-exists-p dribble-file)
893 (setq modes (file-modes gnus-current-startup-file))) 899 (setq modes (file-modes gnus-current-startup-file)))
894 (set-file-modes dribble-file modes)) 900 (gnus-set-file-modes dribble-file modes))
895 (goto-char (point-min)) 901 (goto-char (point-min))
896 (when (search-forward "Gnus was exited on purpose" nil t) 902 (when (search-forward "Gnus was exited on purpose" nil t)
897 (setq purpose t)) 903 (setq purpose t))
@@ -961,30 +967,34 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
961 (gnus-read-newsrc-file rawfile)) 967 (gnus-read-newsrc-file rawfile))
962 968
963 ;; Make sure the archive server is available to all and sundry. 969 ;; Make sure the archive server is available to all and sundry.
964 (when gnus-message-archive-method 970 (let ((method (or (and (stringp gnus-message-archive-method)
965 (unless (assoc "archive" gnus-server-alist) 971 (gnus-server-to-method
966 (let ((method (or (and (stringp gnus-message-archive-method) 972 gnus-message-archive-method))
967 (gnus-server-to-method 973 gnus-message-archive-method)))
968 gnus-message-archive-method)) 974 ;; Check whether the archive method is writable.
969 gnus-message-archive-method))) 975 (unless (or (not method)
970 ;; Check whether the archive method is writable. 976 (stringp method)
971 (unless (or (stringp method) 977 (memq 'respool (assoc (format "%s" (car method))
972 (memq 'respool (assoc (format "%s" (car method)) 978 gnus-valid-select-methods)))
973 gnus-valid-select-methods))) 979 (setq method "archive")) ;; The default.
974 (setq method "archive")) ;; The default. 980 (when (stringp method)
975 (push (if (stringp method) 981 (setq method `(nnfolder
976 `("archive" 982 ,method
977 nnfolder 983 (nnfolder-directory
978 ,method 984 ,(nnheader-concat message-directory method))
979 (nnfolder-directory 985 (nnfolder-active-file
980 ,(nnheader-concat message-directory method)) 986 ,(nnheader-concat message-directory
981 (nnfolder-active-file 987 (concat method "/active")))
982 ,(nnheader-concat message-directory 988 (nnfolder-get-new-mail nil)
983 (concat method "/active"))) 989 (nnfolder-inhibit-expiry t))))
984 (nnfolder-get-new-mail nil) 990 (if (assoc "archive" gnus-server-alist)
985 (nnfolder-inhibit-expiry t)) 991 (when gnus-update-message-archive-method
986 (cons "archive" method)) 992 (if method
987 gnus-server-alist)))) 993 (setcdr (assoc "archive" gnus-server-alist) method)
994 (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
995 gnus-server-alist))))
996 (when method
997 (push (cons "archive" method) gnus-server-alist))))
988 998
989 ;; If we don't read the complete active file, we fill in the 999 ;; If we don't read the complete active file, we fill in the
990 ;; hashtb here. 1000 ;; hashtb here.
@@ -1334,16 +1344,16 @@ for new groups, and subscribe the new groups as zombies."
1334 (when (and (stringp entry) 1344 (when (and (stringp entry)
1335 oldlevel 1345 oldlevel
1336 (< oldlevel gnus-level-zombie)) 1346 (< oldlevel gnus-level-zombie))
1337 (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) 1347 (setq entry (gnus-group-entry entry)))
1338 (if (and (not oldlevel) 1348 (if (and (not oldlevel)
1339 (consp entry)) 1349 (consp entry))
1340 (setq oldlevel (gnus-info-level (nth 2 entry))) 1350 (setq oldlevel (gnus-info-level (nth 2 entry)))
1341 (setq oldlevel (or oldlevel gnus-level-killed))) 1351 (setq oldlevel (or oldlevel gnus-level-killed)))
1342 (when (stringp previous) 1352 (when (stringp previous)
1343 (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) 1353 (setq previous (gnus-group-entry previous)))
1344 1354
1345 (if (and (>= oldlevel gnus-level-zombie) 1355 (if (and (>= oldlevel gnus-level-zombie)
1346 (gnus-gethash group gnus-newsrc-hashtb)) 1356 (gnus-group-entry group))
1347 ;; We are trying to subscribe a group that is already 1357 ;; We are trying to subscribe a group that is already
1348 ;; subscribed. 1358 ;; subscribed.
1349 () ; Do nothing. 1359 () ; Do nothing.
@@ -1367,8 +1377,7 @@ for new groups, and subscribe the new groups as zombies."
1367 entry) 1377 entry)
1368 (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) 1378 (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
1369 (when (nth 3 entry) 1379 (when (nth 3 entry)
1370 (setcdr (gnus-gethash (car (nth 3 entry)) 1380 (setcdr (gnus-group-entry (car (nth 3 entry)))
1371 gnus-newsrc-hashtb)
1372 (cdr entry))) 1381 (cdr entry)))
1373 (setcdr (cdr entry) (cdddr entry))))) 1382 (setcdr (cdr entry) (cdddr entry)))))
1374 1383
@@ -1428,7 +1437,7 @@ for new groups, and subscribe the new groups as zombies."
1428 (gnus-sethash group (cons num previous) 1437 (gnus-sethash group (cons num previous)
1429 gnus-newsrc-hashtb)) 1438 gnus-newsrc-hashtb))
1430 (when (cdr entry) 1439 (when (cdr entry)
1431 (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) 1440 (setcdr (gnus-group-entry (caadr entry)) entry))
1432 (gnus-dribble-enter 1441 (gnus-dribble-enter
1433 (format 1442 (format
1434 "(gnus-group-set-info '%S)" info))))) 1443 "(gnus-group-set-info '%S)" info)))))
@@ -1439,7 +1448,7 @@ for new groups, and subscribe the new groups as zombies."
1439(defun gnus-kill-newsgroup (newsgroup) 1448(defun gnus-kill-newsgroup (newsgroup)
1440 "Obsolete function. Kills a newsgroup." 1449 "Obsolete function. Kills a newsgroup."
1441 (gnus-group-change-level 1450 (gnus-group-change-level
1442 (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) 1451 (gnus-group-entry newsgroup) gnus-level-killed))
1443 1452
1444(defun gnus-check-bogus-newsgroups (&optional confirm) 1453(defun gnus-check-bogus-newsgroups (&optional confirm)
1445 "Remove bogus newsgroups. 1454 "Remove bogus newsgroups.
@@ -1467,14 +1476,14 @@ newsgroup."
1467 (lambda (group) 1476 (lambda (group)
1468 ;; Remove all bogus subscribed groups by first killing them, and 1477 ;; Remove all bogus subscribed groups by first killing them, and
1469 ;; then removing them from the list of killed groups. 1478 ;; then removing them from the list of killed groups.
1470 (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) 1479 (when (setq entry (gnus-group-entry group))
1471 (gnus-group-change-level entry gnus-level-killed) 1480 (gnus-group-change-level entry gnus-level-killed)
1472 (setq gnus-killed-list (delete group gnus-killed-list)))) 1481 (setq gnus-killed-list (delete group gnus-killed-list))))
1473 bogus '("group" "groups" "remove")) 1482 bogus '("group" "groups" "remove"))
1474 (while (setq group (pop bogus)) 1483 (while (setq group (pop bogus))
1475 ;; Remove all bogus subscribed groups by first killing them, and 1484 ;; Remove all bogus subscribed groups by first killing them, and
1476 ;; then removing them from the list of killed groups. 1485 ;; then removing them from the list of killed groups.
1477 (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) 1486 (when (setq entry (gnus-group-entry group))
1478 (gnus-group-change-level entry gnus-level-killed) 1487 (gnus-group-change-level entry gnus-level-killed)
1479 (setq gnus-killed-list (delete group gnus-killed-list))))) 1488 (setq gnus-killed-list (delete group gnus-killed-list)))))
1480 ;; Then we remove all bogus groups from the list of killed and 1489 ;; Then we remove all bogus groups from the list of killed and
@@ -1543,8 +1552,8 @@ If SCAN, request a scan of that group as well."
1543 ;; command may have responded with the `(0 . 0)'. We 1552 ;; command may have responded with the `(0 . 0)'. We
1544 ;; ignore this if we already have an active entry 1553 ;; ignore this if we already have an active entry
1545 ;; for the group. 1554 ;; for the group.
1546 (if (and (zerop (car active)) 1555 (if (and (zerop (or (car active) 0))
1547 (zerop (cdr active)) 1556 (zerop (or (cdr active) 0))
1548 (gnus-active group)) 1557 (gnus-active group))
1549 (gnus-active group) 1558 (gnus-active group)
1550 1559
@@ -1652,8 +1661,8 @@ If SCAN, request a scan of that group as well."
1652 (setq num (max 0 (- (cdr active) num))))) 1661 (setq num (max 0 (- (cdr active) num)))))
1653 ;; Set the number of unread articles. 1662 ;; Set the number of unread articles.
1654 (when (and info 1663 (when (and info
1655 (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb)) 1664 (gnus-group-entry (gnus-info-group info)))
1656 (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) 1665 (setcar (gnus-group-entry (gnus-info-group info)) num))
1657 num))) 1666 num)))
1658 1667
1659;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' 1668;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
@@ -1674,12 +1683,12 @@ If SCAN, request a scan of that group as well."
1674 (methods-cache nil) 1683 (methods-cache nil)
1675 (type-cache nil) 1684 (type-cache nil)
1676 scanned-methods info group active method retrieve-groups cmethod 1685 scanned-methods info group active method retrieve-groups cmethod
1677 method-type) 1686 method-type ignore)
1678 (gnus-message 6 "Checking new news...") 1687 (gnus-message 6 "Checking new news...")
1679 1688
1680 (while newsrc 1689 (while newsrc
1681 (setq active (gnus-active (setq group (gnus-info-group 1690 (setq active (gnus-active (setq group (gnus-info-group
1682 (setq info (pop newsrc)))))) 1691 (setq info (pop newsrc))))))
1683 1692
1684 ;; Check newsgroups. If the user doesn't want to check them, or 1693 ;; Check newsgroups. If the user doesn't want to check them, or
1685 ;; they can't be checked (for instance, if the news server can't 1694 ;; they can't be checked (for instance, if the news server can't
@@ -1702,28 +1711,30 @@ If SCAN, request a scan of that group as well."
1702 (when (and method 1711 (when (and method
1703 (not (setq method-type (cdr (assoc method type-cache))))) 1712 (not (setq method-type (cdr (assoc method type-cache)))))
1704 (setq method-type 1713 (setq method-type
1705 (cond 1714 (cond
1706 ((gnus-secondary-method-p method) 1715 ((gnus-secondary-method-p method)
1707 'secondary) 1716 'secondary)
1708 ((inline (gnus-server-equal gnus-select-method method)) 1717 ((inline (gnus-server-equal gnus-select-method method))
1709 'primary) 1718 'primary)
1710 (t 1719 (t
1711 'foreign))) 1720 'foreign)))
1712 (push (cons method method-type) type-cache)) 1721 (push (cons method method-type) type-cache))
1713 1722
1723 (setq ignore nil)
1714 (cond ((and method (eq method-type 'foreign)) 1724 (cond ((and method (eq method-type 'foreign))
1715 ;; These groups are foreign. Check the level. 1725 ;; These groups are foreign. Check the level.
1716 (when (and (<= (gnus-info-level info) foreign-level) 1726 (if (<= (gnus-info-level info) foreign-level)
1717 (setq active (gnus-activate-group group 'scan))) 1727 (when (setq active (gnus-activate-group group 'scan))
1718 ;; Let the Gnus agent save the active file. 1728 ;; Let the Gnus agent save the active file.
1719 (when (and gnus-agent active (gnus-online method)) 1729 (when (and gnus-agent active (gnus-online method))
1720 (gnus-agent-save-group-info 1730 (gnus-agent-save-group-info
1721 method (gnus-group-real-name group) active)) 1731 method (gnus-group-real-name group) active))
1722 (unless (inline (gnus-virtual-group-p group)) 1732 (unless (inline (gnus-virtual-group-p group))
1723 (inline (gnus-close-group group))) 1733 (inline (gnus-close-group group)))
1724 (when (fboundp (intern (concat (symbol-name (car method)) 1734 (when (fboundp (intern (concat (symbol-name (car method))
1725 "-request-update-info"))) 1735 "-request-update-info")))
1726 (inline (gnus-request-update-info info method))))) 1736 (inline (gnus-request-update-info info method))))
1737 (setq ignore t)))
1727 ;; These groups are native or secondary. 1738 ;; These groups are native or secondary.
1728 ((> (gnus-info-level info) level) 1739 ((> (gnus-info-level info) level)
1729 ;; We don't want these groups. 1740 ;; We don't want these groups.
@@ -1762,13 +1773,17 @@ If SCAN, request a scan of that group as well."
1762 ((eq active 'ignore) 1773 ((eq active 'ignore)
1763 ;; Don't do anything. 1774 ;; Don't do anything.
1764 ) 1775 )
1776 ((and active ignore)
1777 ;; The level of the foreign group is higher than the specified
1778 ;; value.
1779 )
1765 (active 1780 (active
1766 (inline (gnus-get-unread-articles-in-group info active t))) 1781 (inline (gnus-get-unread-articles-in-group info active t)))
1767 (t 1782 (t
1768 ;; The group couldn't be reached, so we nix out the number of 1783 ;; The group couldn't be reached, so we nix out the number of
1769 ;; unread articles and stuff. 1784 ;; unread articles and stuff.
1770 (gnus-set-active group nil) 1785 (gnus-set-active group nil)
1771 (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) 1786 (let ((tmp (gnus-group-entry group)))
1772 (when tmp 1787 (when tmp
1773 (setcar tmp t)))))) 1788 (setcar tmp t))))))
1774 1789
@@ -1782,8 +1797,8 @@ If SCAN, request a scan of that group as well."
1782 (when (gnus-check-backend-function 'request-scan (car method)) 1797 (when (gnus-check-backend-function 'request-scan (car method))
1783 (gnus-request-scan nil method)) 1798 (gnus-request-scan nil method))
1784 (gnus-read-active-file-2 1799 (gnus-read-active-file-2
1785 (mapcar (lambda (group) (gnus-group-real-name group)) groups) 1800 (mapcar (lambda (group) (gnus-group-real-name group)) groups)
1786 method) 1801 method)
1787 (dolist (group groups) 1802 (dolist (group groups)
1788 (cond 1803 (cond
1789 ((setq active (gnus-active (gnus-info-group 1804 ((setq active (gnus-active (gnus-info-group
@@ -1793,7 +1808,7 @@ If SCAN, request a scan of that group as well."
1793 ;; The group couldn't be reached, so we nix out the number of 1808 ;; The group couldn't be reached, so we nix out the number of
1794 ;; unread articles and stuff. 1809 ;; unread articles and stuff.
1795 (gnus-set-active group nil) 1810 (gnus-set-active group nil)
1796 (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) 1811 (setcar (gnus-group-entry group) t)))))))
1797 1812
1798 (gnus-message 6 "Checking new news...done"))) 1813 (gnus-message 6 "Checking new news...done")))
1799 1814
@@ -1802,7 +1817,7 @@ If SCAN, request a scan of that group as well."
1802(defun gnus-make-hashtable-from-newsrc-alist () 1817(defun gnus-make-hashtable-from-newsrc-alist ()
1803 (let ((alist gnus-newsrc-alist) 1818 (let ((alist gnus-newsrc-alist)
1804 (ohashtb gnus-newsrc-hashtb) 1819 (ohashtb gnus-newsrc-hashtb)
1805 prev) 1820 prev info method rest methods)
1806 (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) 1821 (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
1807 (setq alist 1822 (setq alist
1808 (setq prev (setq gnus-newsrc-alist 1823 (setq prev (setq gnus-newsrc-alist
@@ -1811,14 +1826,26 @@ If SCAN, request a scan of that group as well."
1811 gnus-newsrc-alist 1826 gnus-newsrc-alist
1812 (cons (list "dummy.group" 0 nil) alist))))) 1827 (cons (list "dummy.group" 0 nil) alist)))))
1813 (while alist 1828 (while alist
1829 (setq info (car alist))
1830 ;; Make the same select-methods identical Lisp objects.
1831 (when (setq method (gnus-info-method info))
1832 (if (setq rest (member method methods))
1833 (gnus-info-set-method info (car rest))
1834 (push method methods)))
1814 (gnus-sethash 1835 (gnus-sethash
1815 (caar alist) 1836 (car info)
1816 ;; Preserve number of unread articles in groups. 1837 ;; Preserve number of unread articles in groups.
1817 (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) 1838 (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
1818 prev) 1839 prev)
1819 gnus-newsrc-hashtb) 1840 gnus-newsrc-hashtb)
1820 (setq prev alist 1841 (setq prev alist
1821 alist (cdr alist))))) 1842 alist (cdr alist)))
1843 ;; Make the same select-methods in `gnus-server-alist' identical
1844 ;; as well.
1845 (while methods
1846 (setq method (pop methods))
1847 (when (setq rest (rassoc method gnus-server-alist))
1848 (setcdr rest method)))))
1822 1849
1823(defun gnus-make-hashtable-from-killed () 1850(defun gnus-make-hashtable-from-killed ()
1824 "Create a hash table from the killed and zombie lists." 1851 "Create a hash table from the killed and zombie lists."
@@ -1845,9 +1872,9 @@ If SCAN, request a scan of that group as well."
1845 1872
1846(defun gnus-make-articles-unread (group articles) 1873(defun gnus-make-articles-unread (group articles)
1847 "Mark ARTICLES in GROUP as unread." 1874 "Mark ARTICLES in GROUP as unread."
1848 (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) 1875 (let* ((info (nth 2 (or (gnus-group-entry group)
1849 (gnus-gethash (gnus-group-real-name group) 1876 (gnus-group-entry
1850 gnus-newsrc-hashtb)))) 1877 (gnus-group-real-name group)))))
1851 (ranges (gnus-info-read info)) 1878 (ranges (gnus-info-read info))
1852 news article) 1879 news article)
1853 (while articles 1880 (while articles
@@ -1867,9 +1894,8 @@ If SCAN, request a scan of that group as well."
1867 1894
1868(defun gnus-make-ascending-articles-unread (group articles) 1895(defun gnus-make-ascending-articles-unread (group articles)
1869 "Mark ascending ARTICLES in GROUP as unread." 1896 "Mark ascending ARTICLES in GROUP as unread."
1870 (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb) 1897 (let* ((entry (or (gnus-group-entry group)
1871 (gnus-gethash (gnus-group-real-name group) 1898 (gnus-group-entry (gnus-group-real-name group))))
1872 gnus-newsrc-hashtb)))
1873 (info (nth 2 entry)) 1899 (info (nth 2 entry))
1874 (ranges (gnus-info-read info)) 1900 (ranges (gnus-info-read info))
1875 (r ranges) 1901 (r ranges)
@@ -1941,7 +1967,7 @@ If SCAN, request a scan of that group as well."
1941 (while lists 1967 (while lists
1942 (setq killed (car lists)) 1968 (setq killed (car lists))
1943 (while killed 1969 (while killed
1944 (gnus-sethash (car killed) nil hashtb) 1970 (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb)
1945 (setq killed (cdr killed))) 1971 (setq killed (cdr killed)))
1946 (setq lists (cdr lists))))) 1972 (setq lists (cdr lists)))))
1947 1973
@@ -2118,7 +2144,7 @@ If SCAN, request a scan of that group as well."
2118 (while (not (eobp)) 2144 (while (not (eobp))
2119 (condition-case () 2145 (condition-case ()
2120 (progn 2146 (progn
2121 (narrow-to-region (point) (gnus-point-at-eol)) 2147 (narrow-to-region (point) (point-at-eol))
2122 ;; group gets set to a symbol interned in the hash table 2148 ;; group gets set to a symbol interned in the hash table
2123 ;; (what a hack!!) - jwz 2149 ;; (what a hack!!) - jwz
2124 (setq group (let ((obarray hashtb)) (read cur))) 2150 (setq group (let ((obarray hashtb)) (read cur)))
@@ -2150,7 +2176,7 @@ If SCAN, request a scan of that group as well."
2150 (unless ignore-errors 2176 (unless ignore-errors
2151 (gnus-message 3 "Warning - invalid active: %s" 2177 (gnus-message 3 "Warning - invalid active: %s"
2152 (buffer-substring 2178 (buffer-substring
2153 (gnus-point-at-bol) (gnus-point-at-eol)))))) 2179 (point-at-bol) (point-at-eol))))))
2154 (widen) 2180 (widen)
2155 (forward-line 1))))) 2181 (forward-line 1)))))
2156 2182
@@ -2387,6 +2413,8 @@ If FORCE is non-nil, the .newsrc file is read."
2387 (setq gnus-format-specs gnus-default-format-specs))) 2413 (setq gnus-format-specs gnus-default-format-specs)))
2388 (when gnus-newsrc-assoc 2414 (when gnus-newsrc-assoc
2389 (setq gnus-newsrc-alist gnus-newsrc-assoc)))) 2415 (setq gnus-newsrc-alist gnus-newsrc-assoc))))
2416 (dolist (elem gnus-newsrc-alist)
2417 (setcar elem (mm-string-as-unibyte (car elem))))
2390 (gnus-make-hashtable-from-newsrc-alist) 2418 (gnus-make-hashtable-from-newsrc-alist)
2391 (when (file-newer-than-file-p file ding-file) 2419 (when (file-newer-than-file-p file ding-file)
2392 ;; Old format quick file 2420 ;; Old format quick file
@@ -2502,10 +2530,10 @@ If FORCE is non-nil, the .newsrc file is read."
2502 ;; don't give a damn, frankly, my dear. 2530 ;; don't give a damn, frankly, my dear.
2503 (concat gnus-newsrc-options 2531 (concat gnus-newsrc-options
2504 (buffer-substring 2532 (buffer-substring
2505 (gnus-point-at-bol) 2533 (point-at-bol)
2506 ;; Options may continue on the next line. 2534 ;; Options may continue on the next line.
2507 (or (and (re-search-forward "^[^ \t]" nil 'move) 2535 (or (and (re-search-forward "^[^ \t]" nil 'move)
2508 (progn (beginning-of-line) (point))) 2536 (point-at-bol))
2509 (point))))) 2537 (point)))))
2510 (forward-line -1)) 2538 (forward-line -1))
2511 (symbol 2539 (symbol
@@ -2573,8 +2601,8 @@ If FORCE is non-nil, the .newsrc file is read."
2573 ;; The line was buggy. 2601 ;; The line was buggy.
2574 (setq group nil) 2602 (setq group nil)
2575 (gnus-error 3.1 "Mangled line: %s" 2603 (gnus-error 3.1 "Mangled line: %s"
2576 (buffer-substring (gnus-point-at-bol) 2604 (buffer-substring (point-at-bol)
2577 (gnus-point-at-eol)))) 2605 (point-at-eol))))
2578 nil)) 2606 nil))
2579 ;; Skip past ", ". Spaces are invalid in these ranges, but 2607 ;; Skip past ", ". Spaces are invalid in these ranges, but
2580 ;; we allow them, because it's a common mistake to put a 2608 ;; we allow them, because it's a common mistake to put a
@@ -2683,9 +2711,9 @@ If FORCE is non-nil, the .newsrc file is read."
2683 (while (re-search-forward "[ \t]-n" nil t) 2711 (while (re-search-forward "[ \t]-n" nil t)
2684 (setq eol 2712 (setq eol
2685 (or (save-excursion 2713 (or (save-excursion
2686 (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) 2714 (and (re-search-forward "[ \t]-n" (point-at-eol) t)
2687 (- (point) 2))) 2715 (- (point) 2)))
2688 (gnus-point-at-eol))) 2716 (point-at-eol)))
2689 ;; Search for all "words"... 2717 ;; Search for all "words"...
2690 (while (re-search-forward "[^ \t,\n]+" eol t) 2718 (while (re-search-forward "[^ \t,\n]+" eol t)
2691 (if (eq (char-after (match-beginning 0)) ?!) 2719 (if (eq (char-after (match-beginning 0)) ?!)
@@ -2793,7 +2821,7 @@ If FORCE is non-nil, the .newsrc file is read."
2793 2821
2794 ;; Replace the existing startup file with the temp file. 2822 ;; Replace the existing startup file with the temp file.
2795 (rename-file working-file startup-file t) 2823 (rename-file working-file startup-file t)
2796 (set-file-modes startup-file setmodes))) 2824 (gnus-set-file-modes startup-file setmodes)))
2797 (condition-case nil 2825 (condition-case nil
2798 (delete-file working-file) 2826 (delete-file working-file)
2799 (file-error nil))))) 2827 (file-error nil)))))
@@ -2845,7 +2873,7 @@ If FORCE is non-nil, the .newsrc file is read."
2845 (while variables 2873 (while variables
2846 (when (and (boundp (setq variable (pop variables))) 2874 (when (and (boundp (setq variable (pop variables)))
2847 (symbol-value variable)) 2875 (symbol-value variable))
2848 (princ "(setq ") 2876 (princ "\n(setq ")
2849 (princ (symbol-name variable)) 2877 (princ (symbol-name variable))
2850 (princ " '") 2878 (princ " '")
2851 (prin1 (symbol-value variable)) 2879 (prin1 (symbol-value variable))
@@ -2872,6 +2900,10 @@ If FORCE is non-nil, the .newsrc file is read."
2872 (setq default-directory (file-name-directory buffer-file-name)) 2900 (setq default-directory (file-name-directory buffer-file-name))
2873 (buffer-disable-undo) 2901 (buffer-disable-undo)
2874 (erase-buffer) 2902 (erase-buffer)
2903 ;; Use a unibyte buffer since group names are unibyte strings;
2904 ;; in particular, non-ASCII group names are the ones encoded by
2905 ;; a certain coding system.
2906 (mm-disable-multibyte)
2875 ;; Write options. 2907 ;; Write options.
2876 (when gnus-newsrc-options 2908 (when gnus-newsrc-options
2877 (insert gnus-newsrc-options)) 2909 (insert gnus-newsrc-options))
@@ -2914,7 +2946,8 @@ If FORCE is non-nil, the .newsrc file is read."
2914 (delete-file gnus-startup-file) 2946 (delete-file gnus-startup-file)
2915 (clear-visited-file-modtime)) 2947 (clear-visited-file-modtime))
2916 (gnus-run-hooks 'gnus-save-standard-newsrc-hook) 2948 (gnus-run-hooks 'gnus-save-standard-newsrc-hook)
2917 (save-buffer) 2949 (let ((coding-system-for-write 'raw-text))
2950 (save-buffer))
2918 (kill-buffer (current-buffer))))) 2951 (kill-buffer (current-buffer)))))
2919 2952
2920 2953
@@ -2926,7 +2959,7 @@ If FORCE is non-nil, the .newsrc file is read."
2926 2959
2927(defun gnus-slave-mode () 2960(defun gnus-slave-mode ()
2928 "Minor mode for slave Gnusae." 2961 "Minor mode for slave Gnusae."
2929 (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) 2962 (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
2930 (gnus-run-hooks 'gnus-slave-mode-hook)) 2963 (gnus-run-hooks 'gnus-slave-mode-hook))
2931 2964
2932(defun gnus-slave-save-newsrc () 2965(defun gnus-slave-save-newsrc ()
@@ -2939,7 +2972,7 @@ If FORCE is non-nil, the .newsrc file is read."
2939 (let ((coding-system-for-write gnus-ding-file-coding-system)) 2972 (let ((coding-system-for-write gnus-ding-file-coding-system))
2940 (gnus-write-buffer slave-name)) 2973 (gnus-write-buffer slave-name))
2941 (when modes 2974 (when modes
2942 (set-file-modes slave-name modes))))) 2975 (gnus-set-file-modes slave-name modes)))))
2943 2976
2944(defun gnus-master-read-slave-newsrc () 2977(defun gnus-master-read-slave-newsrc ()
2945 (let ((slave-files 2978 (let ((slave-files
@@ -3117,6 +3150,41 @@ If this variable is nil, don't do anything."
3117 (symbol-value 'nnimap-mailbox-info) 3150 (symbol-value 'nnimap-mailbox-info)
3118 (make-vector 1 0))))) 3151 (make-vector 1 0)))))
3119 3152
3153(defun gnus-check-reasonable-setup ()
3154 ;; Check whether nnml and nnfolder share a directory.
3155 (let ((display-warn
3156 (if (fboundp 'display-warning)
3157 'display-warning
3158 (lambda (type message)
3159 (if noninteractive
3160 (message "Warning (%s): %s" type message)
3161 (let (window)
3162 (with-current-buffer (get-buffer-create "*Warnings*")
3163 (goto-char (point-max))
3164 (unless (bolp)
3165 (insert "\n"))
3166 (insert (format "Warning (%s): %s\n" type message))
3167 (setq window (display-buffer (current-buffer)))
3168 (set-window-start
3169 window
3170 (prog2
3171 (forward-line (- 1 (window-height window)))
3172 (point)
3173 (goto-char (point-max))))))))))
3174 method active actives match)
3175 (dolist (server gnus-server-alist)
3176 (setq method (gnus-server-to-method server)
3177 active (intern (format "%s-active-file" (car method))))
3178 (when (and (member (car method) '(nnml nnfolder))
3179 (gnus-server-opened method)
3180 (boundp active))
3181 (when (setq match (assoc (symbol-value active) actives))
3182 (funcall display-warn 'gnus-server
3183 (format "%s and %s share the same active file %s"
3184 (car method)
3185 (cadr match)
3186 (car match))))
3187 (push (list (symbol-value active) method) actives)))))
3120 3188
3121(provide 'gnus-start) 3189(provide 'gnus-start)
3122 3190
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 8fb18d3a990..5709de62b19 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -62,19 +62,31 @@ it will be killed sometime later."
62 :group 'gnus-summary-exit 62 :group 'gnus-summary-exit
63 :type 'boolean) 63 :type 'boolean)
64 64
65(defcustom gnus-summary-next-group-on-exit t
66 "If non-nil, go to the next unread newsgroup on summary exit.
67See `gnus-group-goto-unread'."
68 :link '(custom-manual "(gnus)Group Maneuvering")
69 :group 'gnus-summary-exit
70 :version "23.0" ;; No Gnus
71 :type 'boolean)
72
65(defcustom gnus-fetch-old-headers nil 73(defcustom gnus-fetch-old-headers nil
66 "*Non-nil means that Gnus will try to build threads by grabbing old headers. 74 "*Non-nil means that Gnus will try to build threads by grabbing old headers.
67If an unread article in the group refers to an older, already read (or 75If an unread article in the group refers to an older, already
68just marked as read) article, the old article will not normally be 76read (or just marked as read) article, the old article will not
69displayed in the Summary buffer. If this variable is t, Gnus 77normally be displayed in the Summary buffer. If this variable is
70will attempt to grab the headers to the old articles, and thereby 78t, Gnus will attempt to grab the headers to the old articles, and
71build complete threads. If it has the value `some', only enough 79thereby build complete threads. If it has the value `some', all
72headers to connect otherwise loose threads will be displayed. This 80old headers will be fetched but only enough headers to connect
73variable can also be a number. In that case, no more than that number 81otherwise loose threads will be displayed. This variable can
74of old headers will be fetched. If it has the value `invisible', all 82also be a number. In that case, no more than that number of old
83headers will be fetched. If it has the value `invisible', all
75old headers will be fetched, but none will be displayed. 84old headers will be fetched, but none will be displayed.
76 85
77The server has to support NOV for any of this to work." 86The server has to support NOV for any of this to work.
87
88This feature can seriously impact performance it ignores all
89locally cached header entries."
78 :group 'gnus-thread 90 :group 'gnus-thread
79 :type '(choice (const :tag "off" nil) 91 :type '(choice (const :tag "off" nil)
80 (const :tag "on" t) 92 (const :tag "on" t)
@@ -83,7 +95,7 @@ The server has to support NOV for any of this to work."
83 number 95 number
84 (sexp :menu-tag "other" t))) 96 (sexp :menu-tag "other" t)))
85 97
86(defcustom gnus-refer-thread-limit 200 98(defcustom gnus-refer-thread-limit 500
87 "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread]. 99 "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
88If t, fetch all the available old headers." 100If t, fetch all the available old headers."
89 :group 'gnus-thread 101 :group 'gnus-thread
@@ -366,6 +378,28 @@ the first unread article."
366 :group 'gnus-summary-maneuvering 378 :group 'gnus-summary-maneuvering
367 :type 'boolean) 379 :type 'boolean)
368 380
381(defcustom gnus-auto-select-on-ephemeral-exit 'next-noselect
382 "What article should be selected after exiting an ephemeral group.
383Valid values include:
384
385`next'
386 Select the next article.
387`next-unread'
388 Select the next unread article.
389`next-noselect'
390 Move the cursor to the next article. This is the default.
391`next-unread-noselect'
392 Move the cursor to the next unread article.
393
394If it has any other value or there is no next (unread) article, the
395article selected before entering to the ephemeral group will appear."
396 :version "23.0" ;; No Gnus
397 :group 'gnus-summary-maneuvering
398 :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
399 (const next) (const next-unread)
400 (const next-noselect) (const next-unread-noselect)
401 (sexp :tag "other" :value nil)))
402
369(defcustom gnus-auto-goto-ignores 'unfetched 403(defcustom gnus-auto-goto-ignores 'unfetched
370 "*Says how to handle unfetched articles when maneuvering. 404 "*Says how to handle unfetched articles when maneuvering.
371 405
@@ -391,7 +425,7 @@ current article is unread."
391 :group 'gnus-summary-maneuvering 425 :group 'gnus-summary-maneuvering
392 :type 'boolean) 426 :type 'boolean)
393 427
394(defcustom gnus-auto-center-summary t 428(defcustom gnus-auto-center-summary 2
395 "*If non-nil, always center the current summary buffer. 429 "*If non-nil, always center the current summary buffer.
396In particular, if `vertical' do only vertical recentering. If non-nil 430In particular, if `vertical' do only vertical recentering. If non-nil
397and non-`vertical', do both horizontal and vertical recentering." 431and non-`vertical', do both horizontal and vertical recentering."
@@ -438,6 +472,13 @@ this variable specifies group names."
438 (cons :value ("" "") regexp (repeat string)) 472 (cons :value ("" "") regexp (repeat string))
439 (sexp :value nil)))) 473 (sexp :value nil))))
440 474
475(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
476 "Function used to compute default prefix for article move/copy/etc prompts.
477The function should take one argument, a group name, and return a
478string with the suggested prefix."
479 :group 'gnus-summary-mail
480 :type 'function)
481
441;; FIXME: Although the custom type is `character' for the following variables, 482;; FIXME: Although the custom type is `character' for the following variables,
442;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs 483;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
443 484
@@ -697,6 +738,40 @@ score file."
697 :group 'gnus-score-default 738 :group 'gnus-score-default
698 :type 'integer) 739 :type 'integer)
699 740
741(defun gnus-widget-reversible-match (widget value)
742 "Ignoring WIDGET, convert VALUE to internal form.
743VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
744 ;; (debug value)
745 (or (symbolp value)
746 (and (listp value)
747 (eq (length value) 2)
748 (eq (nth 0 value) 'not)
749 (symbolp (nth 1 value)))))
750
751(defun gnus-widget-reversible-to-internal (widget value)
752 "Ignoring WIDGET, convert VALUE to internal form.
753VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
754FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
755 ;; (debug value)
756 (if (atom value)
757 (list value nil)
758 (list (nth 1 value) t)))
759
760(defun gnus-widget-reversible-to-external (widget value)
761 "Ignoring WIDGET, convert VALUE to external form.
762VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
763\(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)."
764 ;; (debug value)
765 (if (nth 1 value)
766 (list 'not (nth 0 value))
767 (nth 0 value)))
768
769(define-widget 'gnus-widget-reversible 'group
770 "A `group' that convert values."
771 :match 'gnus-widget-reversible-match
772 :value-to-internal 'gnus-widget-reversible-to-internal
773 :value-to-external 'gnus-widget-reversible-to-external)
774
700(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) 775(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
701 "*List of functions used for sorting articles in the summary buffer. 776 "*List of functions used for sorting articles in the summary buffer.
702 777
@@ -709,6 +784,9 @@ is often much slower than sorting by number, and the sorting order is
709very similar. (Sorting by date means sorting by the time the message 784very similar. (Sorting by date means sorting by the time the message
710was sent, sorting by number means sorting by arrival time.) 785was sent, sorting by number means sorting by arrival time.)
711 786
787Each item can also be a list `(not F)' where F is a function;
788this reverses the sort order.
789
712Ready-made functions include `gnus-article-sort-by-number', 790Ready-made functions include `gnus-article-sort-by-number',
713`gnus-article-sort-by-author', `gnus-article-sort-by-subject', 791`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
714`gnus-article-sort-by-date', `gnus-article-sort-by-random' 792`gnus-article-sort-by-date', `gnus-article-sort-by-random'
@@ -717,13 +795,16 @@ and `gnus-article-sort-by-score'.
717When threading is turned on, the variable `gnus-thread-sort-functions' 795When threading is turned on, the variable `gnus-thread-sort-functions'
718controls how articles are sorted." 796controls how articles are sorted."
719 :group 'gnus-summary-sort 797 :group 'gnus-summary-sort
720 :type '(repeat (choice (function-item gnus-article-sort-by-number) 798 :type '(repeat (gnus-widget-reversible
721 (function-item gnus-article-sort-by-author) 799 (choice (function-item gnus-article-sort-by-number)
722 (function-item gnus-article-sort-by-subject) 800 (function-item gnus-article-sort-by-author)
723 (function-item gnus-article-sort-by-date) 801 (function-item gnus-article-sort-by-subject)
724 (function-item gnus-article-sort-by-score) 802 (function-item gnus-article-sort-by-date)
725 (function-item gnus-article-sort-by-random) 803 (function-item gnus-article-sort-by-score)
726 (function :tag "other")))) 804 (function-item gnus-article-sort-by-random)
805 (function :tag "other"))
806 (boolean :tag "Reverse order"))))
807
727 808
728(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) 809(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
729 "*List of functions used for sorting threads in the summary buffer. 810 "*List of functions used for sorting threads in the summary buffer.
@@ -738,25 +819,34 @@ is often much slower than sorting by number, and the sorting order is
738very similar. (Sorting by date means sorting by the time the message 819very similar. (Sorting by date means sorting by the time the message
739was sent, sorting by number means sorting by arrival time.) 820was sent, sorting by number means sorting by arrival time.)
740 821
822Each list item can also be a list `(not F)' where F is a
823function; this specifies reversed sort order.
824
741Ready-made functions include `gnus-thread-sort-by-number', 825Ready-made functions include `gnus-thread-sort-by-number',
742`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', 826`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
743`gnus-thread-sort-by-date', `gnus-thread-sort-by-score', 827`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
744`gnus-thread-sort-by-most-recent-number', 828`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
745`gnus-thread-sort-by-most-recent-date', 829`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
746`gnus-thread-sort-by-random', and 830and `gnus-thread-sort-by-total-score' (see
747`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). 831`gnus-thread-score-function').
748 832
749When threading is turned off, the variable 833When threading is turned off, the variable
750`gnus-article-sort-functions' controls how articles are sorted." 834`gnus-article-sort-functions' controls how articles are sorted."
751 :group 'gnus-summary-sort 835 :group 'gnus-summary-sort
752 :type '(repeat (choice (function-item gnus-thread-sort-by-number) 836 :type '(repeat
753 (function-item gnus-thread-sort-by-author) 837 (gnus-widget-reversible
754 (function-item gnus-thread-sort-by-subject) 838 (choice (function-item gnus-thread-sort-by-number)
755 (function-item gnus-thread-sort-by-date) 839 (function-item gnus-thread-sort-by-author)
756 (function-item gnus-thread-sort-by-score) 840 (function-item gnus-thread-sort-by-recipient)
757 (function-item gnus-thread-sort-by-total-score) 841 (function-item gnus-thread-sort-by-subject)
758 (function-item gnus-thread-sort-by-random) 842 (function-item gnus-thread-sort-by-date)
759 (function :tag "other")))) 843 (function-item gnus-thread-sort-by-score)
844 (function-item gnus-thread-sort-by-most-recent-number)
845 (function-item gnus-thread-sort-by-most-recent-date)
846 (function-item gnus-thread-sort-by-random)
847 (function-item gnus-thread-sort-by-total-score)
848 (function :tag "other"))
849 (boolean :tag "Reverse order"))))
760 850
761(defcustom gnus-thread-score-function '+ 851(defcustom gnus-thread-score-function '+
762 "*Function used for calculating the total score of a thread. 852 "*Function used for calculating the total score of a thread.
@@ -1016,10 +1106,29 @@ which it may alter in any way."
1016 (and user-mail-address 1106 (and user-mail-address
1017 (not (string= user-mail-address "")) 1107 (not (string= user-mail-address ""))
1018 (regexp-quote user-mail-address)) 1108 (regexp-quote user-mail-address))
1019 "*Regexp of From headers that may be suppressed in favor of To headers." 1109 "*From headers that may be suppressed in favor of To headers.
1110This can be a regexp or a list of regexps."
1020 :version "21.1" 1111 :version "21.1"
1021 :group 'gnus-summary 1112 :group 'gnus-summary
1022 :type 'regexp) 1113 :type '(choice regexp
1114 (repeat :tag "Regexp List" regexp)))
1115
1116(defsubst gnus-ignored-from-addresses ()
1117 (gmm-regexp-concat gnus-ignored-from-addresses))
1118
1119(defcustom gnus-summary-to-prefix "-> "
1120 "*String prefixed to the To field in the summary line when
1121using `gnus-ignored-from-addresses'."
1122 :version "22.1"
1123 :group 'gnus-summary
1124 :type 'string)
1125
1126(defcustom gnus-summary-newsgroup-prefix "=> "
1127 "*String prefixed to the Newsgroup field in the summary
1128line when using `gnus-ignored-from-addresses'."
1129 :version "22.1"
1130 :group 'gnus-summary
1131 :type 'string)
1023 1132
1024(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) 1133(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
1025 "List of charsets that should be ignored. 1134 "List of charsets that should be ignored.
@@ -1127,12 +1236,12 @@ that were fetched. Say, for nnultimate groups."
1127 :group 'gnus-summary 1236 :group 'gnus-summary
1128 :type 'string) 1237 :type 'string)
1129 1238
1130(defcustom gnus-article-loose-mime nil 1239(defcustom gnus-article-loose-mime t
1131 "If non-nil, don't require MIME-Version header. 1240 "If non-nil, don't require MIME-Version header.
1132Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not 1241Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
1133supply the MIME-Version header or deliberately strip it from the mail. 1242supply the MIME-Version header or deliberately strip it from the mail.
1134Set it to non-nil, Gnus will treat some articles as MIME even if 1243If non-nil (the default), Gnus will treat some articles as MIME
1135the MIME-Version header is missed." 1244even if the MIME-Version header is missing."
1136 :version "22.1" 1245 :version "22.1"
1137 :type 'boolean 1246 :type 'boolean
1138 :group 'gnus-article-mime) 1247 :group 'gnus-article-mime)
@@ -1214,7 +1323,6 @@ the normal Gnus MIME machinery."
1214 (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) 1323 (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1215 (?i gnus-tmp-score ?d) 1324 (?i gnus-tmp-score ?d)
1216 (?z gnus-tmp-score-char ?c) 1325 (?z gnus-tmp-score-char ?c)
1217 (?l (bbb-grouplens-score gnus-tmp-header) ?s)
1218 (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) 1326 (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1219 (?U gnus-tmp-unread ?c) 1327 (?U gnus-tmp-unread ?c)
1220 (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from) 1328 (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
@@ -1463,7 +1571,6 @@ For example:
1463 nil 1571 nil
1464 (load "gnus-sum.el" t t t)) 1572 (load "gnus-sum.el" t t t))
1465 (require 'gnus) 1573 (require 'gnus)
1466 (require 'gnus-agent)
1467 (require 'gnus-art))) 1574 (require 'gnus-art)))
1468 1575
1469;; MIME stuff. 1576;; MIME stuff.
@@ -1490,19 +1597,15 @@ For example:
1490 (eq gnus-newsgroup-name 1597 (eq gnus-newsgroup-name
1491 (car gnus-decode-encoded-word-methods-cache))) 1598 (car gnus-decode-encoded-word-methods-cache)))
1492 (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) 1599 (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
1493 (mapcar (lambda (x) 1600 (dolist (method gnus-decode-encoded-word-methods)
1494 (if (symbolp x) 1601 (if (symbolp method)
1495 (nconc gnus-decode-encoded-word-methods-cache (list x)) 1602 (nconc gnus-decode-encoded-word-methods-cache (list method))
1496 (if (and gnus-newsgroup-name 1603 (if (and gnus-newsgroup-name
1497 (string-match (car x) gnus-newsgroup-name)) 1604 (string-match (car method) gnus-newsgroup-name))
1498 (nconc gnus-decode-encoded-word-methods-cache 1605 (nconc gnus-decode-encoded-word-methods-cache
1499 (list (cdr x)))))) 1606 (list (cdr method)))))))
1500 gnus-decode-encoded-word-methods)) 1607 (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string)
1501 (let ((xlist gnus-decode-encoded-word-methods-cache)) 1608 (setq string (funcall method string))))
1502 (pop xlist)
1503 (while xlist
1504 (setq string (funcall (pop xlist) string))))
1505 string)
1506 1609
1507;; Subject simplification. 1610;; Subject simplification.
1508 1611
@@ -1574,8 +1677,8 @@ matter is removed. Additional things can be deleted by setting
1574 (setq modified-tick (buffer-modified-tick)) 1677 (setq modified-tick (buffer-modified-tick))
1575 (cond 1678 (cond
1576 ((listp gnus-simplify-subject-fuzzy-regexp) 1679 ((listp gnus-simplify-subject-fuzzy-regexp)
1577 (mapcar 'gnus-simplify-buffer-fuzzy-step 1680 (mapc 'gnus-simplify-buffer-fuzzy-step
1578 gnus-simplify-subject-fuzzy-regexp)) 1681 gnus-simplify-subject-fuzzy-regexp))
1579 (gnus-simplify-subject-fuzzy-regexp 1682 (gnus-simplify-subject-fuzzy-regexp
1580 (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) 1683 (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
1581 (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") 1684 (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
@@ -1612,8 +1715,8 @@ See `gnus-simplify-buffer-fuzzy' for details."
1612 ((eq gnus-summary-gather-subject-limit 'fuzzy) 1715 ((eq gnus-summary-gather-subject-limit 'fuzzy)
1613 (gnus-simplify-subject-fuzzy subject)) 1716 (gnus-simplify-subject-fuzzy subject))
1614 ((numberp gnus-summary-gather-subject-limit) 1717 ((numberp gnus-summary-gather-subject-limit)
1615 (gnus-limit-string (gnus-simplify-subject-re subject) 1718 (truncate-string-to-width (gnus-simplify-subject-re subject)
1616 gnus-summary-gather-subject-limit)) 1719 gnus-summary-gather-subject-limit))
1617 (t 1720 (t
1618 subject))) 1721 subject)))
1619 1722
@@ -1665,6 +1768,8 @@ increase the score of each group you read."
1665 "," gnus-summary-best-unread-article 1768 "," gnus-summary-best-unread-article
1666 "\M-s" gnus-summary-search-article-forward 1769 "\M-s" gnus-summary-search-article-forward
1667 "\M-r" gnus-summary-search-article-backward 1770 "\M-r" gnus-summary-search-article-backward
1771 "\M-S" gnus-summary-repeat-search-article-forward
1772 "\M-R" gnus-summary-repeat-search-article-backward
1668 "<" gnus-summary-beginning-of-article 1773 "<" gnus-summary-beginning-of-article
1669 ">" gnus-summary-end-of-article 1774 ">" gnus-summary-end-of-article
1670 "j" gnus-summary-goto-article 1775 "j" gnus-summary-goto-article
@@ -1704,6 +1809,7 @@ increase the score of each group you read."
1704 "\C-c\C-s\C-l" gnus-summary-sort-by-lines 1809 "\C-c\C-s\C-l" gnus-summary-sort-by-lines
1705 "\C-c\C-s\C-c" gnus-summary-sort-by-chars 1810 "\C-c\C-s\C-c" gnus-summary-sort-by-chars
1706 "\C-c\C-s\C-a" gnus-summary-sort-by-author 1811 "\C-c\C-s\C-a" gnus-summary-sort-by-author
1812 "\C-c\C-s\C-t" gnus-summary-sort-by-recipient
1707 "\C-c\C-s\C-s" gnus-summary-sort-by-subject 1813 "\C-c\C-s\C-s" gnus-summary-sort-by-subject
1708 "\C-c\C-s\C-d" gnus-summary-sort-by-date 1814 "\C-c\C-s\C-d" gnus-summary-sort-by-date
1709 "\C-c\C-s\C-i" gnus-summary-sort-by-score 1815 "\C-c\C-s\C-i" gnus-summary-sort-by-score
@@ -1795,6 +1901,8 @@ increase the score of each group you read."
1795(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) 1901(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
1796 "/" gnus-summary-limit-to-subject 1902 "/" gnus-summary-limit-to-subject
1797 "n" gnus-summary-limit-to-articles 1903 "n" gnus-summary-limit-to-articles
1904 "b" gnus-summary-limit-to-bodies
1905 "h" gnus-summary-limit-to-headers
1798 "w" gnus-summary-pop-limit 1906 "w" gnus-summary-pop-limit
1799 "s" gnus-summary-limit-to-subject 1907 "s" gnus-summary-limit-to-subject
1800 "a" gnus-summary-limit-to-author 1908 "a" gnus-summary-limit-to-author
@@ -1814,7 +1922,11 @@ increase the score of each group you read."
1814 "c" gnus-summary-limit-exclude-childless-dormant 1922 "c" gnus-summary-limit-exclude-childless-dormant
1815 "C" gnus-summary-limit-mark-excluded-as-read 1923 "C" gnus-summary-limit-mark-excluded-as-read
1816 "o" gnus-summary-insert-old-articles 1924 "o" gnus-summary-insert-old-articles
1817 "N" gnus-summary-insert-new-articles) 1925 "N" gnus-summary-insert-new-articles
1926 "S" gnus-summary-limit-to-singletons
1927 "r" gnus-summary-limit-to-replied
1928 "R" gnus-summary-limit-to-recipient
1929 "A" gnus-summary-limit-to-address)
1818 1930
1819(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) 1931(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
1820 "n" gnus-summary-next-unread-article 1932 "n" gnus-summary-next-unread-article
@@ -1834,11 +1946,13 @@ increase the score of each group you read."
1834 1946
1835(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) 1947(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
1836 "k" gnus-summary-kill-thread 1948 "k" gnus-summary-kill-thread
1949 "E" gnus-summary-expire-thread
1837 "l" gnus-summary-lower-thread 1950 "l" gnus-summary-lower-thread
1838 "i" gnus-summary-raise-thread 1951 "i" gnus-summary-raise-thread
1839 "T" gnus-summary-toggle-threads 1952 "T" gnus-summary-toggle-threads
1840 "t" gnus-summary-rethread-current 1953 "t" gnus-summary-rethread-current
1841 "^" gnus-summary-reparent-thread 1954 "^" gnus-summary-reparent-thread
1955 "\M-^" gnus-summary-reparent-children
1842 "s" gnus-summary-show-thread 1956 "s" gnus-summary-show-thread
1843 "S" gnus-summary-show-all-threads 1957 "S" gnus-summary-show-all-threads
1844 "h" gnus-summary-hide-thread 1958 "h" gnus-summary-hide-thread
@@ -1854,7 +1968,8 @@ increase the score of each group you read."
1854(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) 1968(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
1855 "g" gnus-summary-prepare 1969 "g" gnus-summary-prepare
1856 "c" gnus-summary-insert-cached-articles 1970 "c" gnus-summary-insert-cached-articles
1857 "d" gnus-summary-insert-dormant-articles) 1971 "d" gnus-summary-insert-dormant-articles
1972 "t" gnus-summary-insert-ticked-articles)
1858 1973
1859(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) 1974(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
1860 "c" gnus-summary-catchup-and-exit 1975 "c" gnus-summary-catchup-and-exit
@@ -1863,6 +1978,7 @@ increase the score of each group you read."
1863 "Q" gnus-summary-exit 1978 "Q" gnus-summary-exit
1864 "Z" gnus-summary-exit 1979 "Z" gnus-summary-exit
1865 "n" gnus-summary-catchup-and-goto-next-group 1980 "n" gnus-summary-catchup-and-goto-next-group
1981 "p" gnus-summary-catchup-and-goto-prev-group
1866 "R" gnus-summary-reselect-current-group 1982 "R" gnus-summary-reselect-current-group
1867 "G" gnus-summary-rescan-group 1983 "G" gnus-summary-rescan-group
1868 "N" gnus-summary-next-group 1984 "N" gnus-summary-next-group
@@ -1889,6 +2005,7 @@ increase the score of each group you read."
1889 "g" gnus-summary-show-article 2005 "g" gnus-summary-show-article
1890 "s" gnus-summary-isearch-article 2006 "s" gnus-summary-isearch-article
1891 "P" gnus-summary-print-article 2007 "P" gnus-summary-print-article
2008 "S" gnus-sticky-article
1892 "M" gnus-mailing-list-insinuate 2009 "M" gnus-mailing-list-insinuate
1893 "t" gnus-article-babel) 2010 "t" gnus-article-babel)
1894 2011
@@ -1899,11 +2016,13 @@ increase the score of each group you read."
1899 "e" gnus-article-emphasize 2016 "e" gnus-article-emphasize
1900 "w" gnus-article-fill-cited-article 2017 "w" gnus-article-fill-cited-article
1901 "Q" gnus-article-fill-long-lines 2018 "Q" gnus-article-fill-long-lines
2019 "L" gnus-article-toggle-truncate-lines
1902 "C" gnus-article-capitalize-sentences 2020 "C" gnus-article-capitalize-sentences
1903 "c" gnus-article-remove-cr 2021 "c" gnus-article-remove-cr
1904 "q" gnus-article-de-quoted-unreadable 2022 "q" gnus-article-de-quoted-unreadable
1905 "6" gnus-article-de-base64-unreadable 2023 "6" gnus-article-de-base64-unreadable
1906 "Z" gnus-article-decode-HZ 2024 "Z" gnus-article-decode-HZ
2025 "A" gnus-article-treat-ansi-sequences
1907 "h" gnus-article-wash-html 2026 "h" gnus-article-wash-html
1908 "u" gnus-article-unsplit-urls 2027 "u" gnus-article-unsplit-urls
1909 "s" gnus-summary-force-verify-and-decrypt 2028 "s" gnus-summary-force-verify-and-decrypt
@@ -1916,7 +2035,8 @@ increase the score of each group you read."
1916 "v" gnus-summary-verbose-headers 2035 "v" gnus-summary-verbose-headers
1917 "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive 2036 "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
1918 "p" gnus-article-verify-x-pgp-sig 2037 "p" gnus-article-verify-x-pgp-sig
1919 "d" gnus-article-treat-dumbquotes) 2038 "d" gnus-article-treat-dumbquotes
2039 "i" gnus-summary-idna-message)
1920 2040
1921(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) 2041(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
1922 ;; mnemonic: deuglif*Y* 2042 ;; mnemonic: deuglif*Y*
@@ -2028,9 +2148,15 @@ increase the score of each group you read."
2028 "m" gnus-summary-repair-multipart 2148 "m" gnus-summary-repair-multipart
2029 "v" gnus-article-view-part 2149 "v" gnus-article-view-part
2030 "o" gnus-article-save-part 2150 "o" gnus-article-save-part
2151 "O" gnus-article-save-part-and-strip
2152 "r" gnus-article-replace-part
2153 "d" gnus-article-delete-part
2154 "t" gnus-article-view-part-as-type
2155 "j" gnus-article-jump-to-part
2031 "c" gnus-article-copy-part 2156 "c" gnus-article-copy-part
2032 "C" gnus-article-view-part-as-charset 2157 "C" gnus-article-view-part-as-charset
2033 "e" gnus-article-view-part-externally 2158 "e" gnus-article-view-part-externally
2159 "H" gnus-article-browse-html-article
2034 "E" gnus-article-encrypt-body 2160 "E" gnus-article-encrypt-body
2035 "i" gnus-article-inline-part 2161 "i" gnus-article-inline-part
2036 "|" gnus-article-pipe-part) 2162 "|" gnus-article-pipe-part)
@@ -2174,11 +2300,13 @@ increase the score of each group you read."
2174 ["Repair multipart" gnus-summary-repair-multipart t] 2300 ["Repair multipart" gnus-summary-repair-multipart t]
2175 ["Pipe part..." gnus-article-pipe-part t] 2301 ["Pipe part..." gnus-article-pipe-part t]
2176 ["Inline part" gnus-article-inline-part t] 2302 ["Inline part" gnus-article-inline-part t]
2303 ["View part as type..." gnus-article-view-part-as-type t]
2177 ["Encrypt body" gnus-article-encrypt-body 2304 ["Encrypt body" gnus-article-encrypt-body
2178 :active (not (gnus-group-read-only-p)) 2305 :active (not (gnus-group-read-only-p))
2179 ,@(if (featurep 'xemacs) nil 2306 ,@(if (featurep 'xemacs) nil
2180 '(:help "Encrypt the message body on disk"))] 2307 '(:help "Encrypt the message body on disk"))]
2181 ["View part externally" gnus-article-view-part-externally t] 2308 ["View part externally" gnus-article-view-part-externally t]
2309 ["View HTML parts in browser" gnus-article-browse-html-article t]
2182 ["View part with charset..." gnus-article-view-part-as-charset t] 2310 ["View part with charset..." gnus-article-view-part-as-charset t]
2183 ["Copy part" gnus-article-copy-part t] 2311 ["Copy part" gnus-article-copy-part t]
2184 ["Save part..." gnus-article-save-part t] 2312 ["Save part..." gnus-article-save-part t]
@@ -2233,6 +2361,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2233 ["Emphasis" gnus-article-emphasize t] 2361 ["Emphasis" gnus-article-emphasize t]
2234 ["Word wrap" gnus-article-fill-cited-article t] 2362 ["Word wrap" gnus-article-fill-cited-article t]
2235 ["Fill long lines" gnus-article-fill-long-lines t] 2363 ["Fill long lines" gnus-article-fill-long-lines t]
2364 ["Toggle truncate long lines" gnus-article-toggle-truncate-lines t]
2236 ["Capitalize sentences" gnus-article-capitalize-sentences t] 2365 ["Capitalize sentences" gnus-article-capitalize-sentences t]
2237 ["Remove CR" gnus-article-remove-cr t] 2366 ["Remove CR" gnus-article-remove-cr t]
2238 ["Quoted-Printable" gnus-article-de-quoted-unreadable t] 2367 ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
@@ -2240,6 +2369,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2240 ["Rot 13" gnus-summary-caesar-message 2369 ["Rot 13" gnus-summary-caesar-message
2241 ,@(if (featurep 'xemacs) '(t) 2370 ,@(if (featurep 'xemacs) '(t)
2242 '(:help "\"Caesar rotate\" article by 13"))] 2371 '(:help "\"Caesar rotate\" article by 13"))]
2372 ["De-IDNA" gnus-summary-idna-message t]
2243 ["Morse decode" gnus-summary-morse-message t] 2373 ["Morse decode" gnus-summary-morse-message t]
2244 ["Unix pipe..." gnus-summary-pipe-message t] 2374 ["Unix pipe..." gnus-summary-pipe-message t]
2245 ["Add buttons" gnus-article-add-buttons t] 2375 ["Add buttons" gnus-article-add-buttons t]
@@ -2253,6 +2383,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2253 ["Unsplit URLs" gnus-article-unsplit-urls t] 2383 ["Unsplit URLs" gnus-article-unsplit-urls t]
2254 ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] 2384 ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
2255 ["Decode HZ" gnus-article-decode-HZ t] 2385 ["Decode HZ" gnus-article-decode-HZ t]
2386 ["ANSI sequences" gnus-article-treat-ansi-sequences t]
2256 ("(Outlook) Deuglify" 2387 ("(Outlook) Deuglify"
2257 ["Unwrap lines" gnus-article-outlook-unwrap-lines t] 2388 ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
2258 ["Repair attribution" gnus-article-outlook-repair-attribution t] 2389 ["Repair attribution" gnus-article-outlook-repair-attribution t]
@@ -2322,6 +2453,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2322 ["Remove article" gnus-cache-remove-article t]) 2453 ["Remove article" gnus-cache-remove-article t])
2323 ["Translate" gnus-article-babel t] 2454 ["Translate" gnus-article-babel t]
2324 ["Select article buffer" gnus-summary-select-article-buffer t] 2455 ["Select article buffer" gnus-summary-select-article-buffer t]
2456 ["Make article buffer sticky" gnus-sticky-article t]
2325 ["Enter digest buffer" gnus-summary-enter-digest-group t] 2457 ["Enter digest buffer" gnus-summary-enter-digest-group t]
2326 ["Isearch article..." gnus-summary-isearch-article t] 2458 ["Isearch article..." gnus-summary-isearch-article t]
2327 ["Beginning of the article" gnus-summary-beginning-of-article t] 2459 ["Beginning of the article" gnus-summary-beginning-of-article t]
@@ -2362,6 +2494,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2362 ["Go up thread" gnus-summary-up-thread t] 2494 ["Go up thread" gnus-summary-up-thread t]
2363 ["Top of thread" gnus-summary-top-thread t] 2495 ["Top of thread" gnus-summary-top-thread t]
2364 ["Mark thread as read" gnus-summary-kill-thread t] 2496 ["Mark thread as read" gnus-summary-kill-thread t]
2497 ["Mark thread as expired" gnus-summary-expire-thread t]
2365 ["Lower thread score" gnus-summary-lower-thread t] 2498 ["Lower thread score" gnus-summary-lower-thread t]
2366 ["Raise thread score" gnus-summary-raise-thread t] 2499 ["Raise thread score" gnus-summary-raise-thread t]
2367 ["Rethread current" gnus-summary-rethread-current t])) 2500 ["Rethread current" gnus-summary-rethread-current t]))
@@ -2450,12 +2583,16 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2450 ["Marks..." gnus-summary-limit-to-marks t] 2583 ["Marks..." gnus-summary-limit-to-marks t]
2451 ["Subject..." gnus-summary-limit-to-subject t] 2584 ["Subject..." gnus-summary-limit-to-subject t]
2452 ["Author..." gnus-summary-limit-to-author t] 2585 ["Author..." gnus-summary-limit-to-author t]
2586 ["Recipient..." gnus-summary-limit-to-recipient t]
2587 ["Address..." gnus-summary-limit-to-address t]
2453 ["Age..." gnus-summary-limit-to-age t] 2588 ["Age..." gnus-summary-limit-to-age t]
2454 ["Extra..." gnus-summary-limit-to-extra t] 2589 ["Extra..." gnus-summary-limit-to-extra t]
2455 ["Score..." gnus-summary-limit-to-score t] 2590 ["Score..." gnus-summary-limit-to-score t]
2456 ["Display Predicate" gnus-summary-limit-to-display-predicate t] 2591 ["Display Predicate" gnus-summary-limit-to-display-predicate t]
2457 ["Unread" gnus-summary-limit-to-unread t] 2592 ["Unread" gnus-summary-limit-to-unread t]
2458 ["Unseen" gnus-summary-limit-to-unseen t] 2593 ["Unseen" gnus-summary-limit-to-unseen t]
2594 ["Singletons" gnus-summary-limit-to-singletons t]
2595 ["Replied" gnus-summary-limit-to-replied t]
2459 ["Non-dormant" gnus-summary-limit-exclude-dormant t] 2596 ["Non-dormant" gnus-summary-limit-exclude-dormant t]
2460 ["Next or process marked articles" gnus-summary-limit-to-articles t] 2597 ["Next or process marked articles" gnus-summary-limit-to-articles t]
2461 ["Pop limit" gnus-summary-pop-limit t] 2598 ["Pop limit" gnus-summary-pop-limit t]
@@ -2469,6 +2606,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2469 ["Set mark" gnus-summary-mark-as-processable t] 2606 ["Set mark" gnus-summary-mark-as-processable t]
2470 ["Remove mark" gnus-summary-unmark-as-processable t] 2607 ["Remove mark" gnus-summary-unmark-as-processable t]
2471 ["Remove all marks" gnus-summary-unmark-all-processable t] 2608 ["Remove all marks" gnus-summary-unmark-all-processable t]
2609 ["Invert marks" gnus-uu-invert-processable t]
2472 ["Mark above" gnus-uu-mark-over t] 2610 ["Mark above" gnus-uu-mark-over t]
2473 ["Mark series" gnus-uu-mark-series t] 2611 ["Mark series" gnus-uu-mark-series t]
2474 ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)] 2612 ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
@@ -2512,6 +2650,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2512 ("Sort" 2650 ("Sort"
2513 ["Sort by number" gnus-summary-sort-by-number t] 2651 ["Sort by number" gnus-summary-sort-by-number t]
2514 ["Sort by author" gnus-summary-sort-by-author t] 2652 ["Sort by author" gnus-summary-sort-by-author t]
2653 ["Sort by recipient" gnus-summary-sort-by-recipient t]
2515 ["Sort by subject" gnus-summary-sort-by-subject t] 2654 ["Sort by subject" gnus-summary-sort-by-subject t]
2516 ["Sort by date" gnus-summary-sort-by-date t] 2655 ["Sort by date" gnus-summary-sort-by-date t]
2517 ["Sort by score" gnus-summary-sort-by-score t] 2656 ["Sort by score" gnus-summary-sort-by-score t]
@@ -2536,6 +2675,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2536 ["Regenerate" gnus-summary-prepare t] 2675 ["Regenerate" gnus-summary-prepare t]
2537 ["Insert cached articles" gnus-summary-insert-cached-articles t] 2676 ["Insert cached articles" gnus-summary-insert-cached-articles t]
2538 ["Insert dormant articles" gnus-summary-insert-dormant-articles t] 2677 ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
2678 ["Insert ticked articles" gnus-summary-insert-ticked-articles t]
2539 ["Toggle threading" gnus-summary-toggle-threads t]) 2679 ["Toggle threading" gnus-summary-toggle-threads t])
2540 ["See old articles" gnus-summary-insert-old-articles t] 2680 ["See old articles" gnus-summary-insert-old-articles t]
2541 ["See new articles" gnus-summary-insert-new-articles t] 2681 ["See new articles" gnus-summary-insert-new-articles t]
@@ -2559,6 +2699,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
2559 '(:help "Mark unread articles in this group as read, then exit"))] 2699 '(:help "Mark unread articles in this group as read, then exit"))]
2560 ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] 2700 ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
2561 ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] 2701 ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
2702 ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t]
2562 ["Exit group" gnus-summary-exit 2703 ["Exit group" gnus-summary-exit
2563 ,@(if (featurep 'xemacs) '(t) 2704 ,@(if (featurep 'xemacs) '(t)
2564 '(:help "Exit current group, return to group selection mode"))] 2705 '(:help "Exit current group, return to group selection mode"))]
@@ -2602,7 +2743,7 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
2602 (const :tag "Retro look" gnus-summary-tool-bar-retro) 2743 (const :tag "Retro look" gnus-summary-tool-bar-retro)
2603 (repeat :tag "User defined list" gmm-tool-bar-item) 2744 (repeat :tag "User defined list" gmm-tool-bar-item)
2604 (symbol)) 2745 (symbol))
2605 :version "22.1" ;; Gnus 5.10.9 2746 :version "23.0" ;; No Gnus
2606 :initialize 'custom-initialize-default 2747 :initialize 'custom-initialize-default
2607 :set 'gnus-summary-tool-bar-update 2748 :set 'gnus-summary-tool-bar-update
2608 :group 'gnus-summary) 2749 :group 'gnus-summary)
@@ -2653,7 +2794,7 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
2653 2794
2654See `gmm-tool-bar-from-list' for the format of the list." 2795See `gmm-tool-bar-from-list' for the format of the list."
2655 :type '(repeat gmm-tool-bar-item) 2796 :type '(repeat gmm-tool-bar-item)
2656 :version "22.1" ;; Gnus 5.10.9 2797 :version "23.0" ;; No Gnus
2657 :initialize 'custom-initialize-default 2798 :initialize 'custom-initialize-default
2658 :set 'gnus-summary-tool-bar-update 2799 :set 'gnus-summary-tool-bar-update
2659 :group 'gnus-summary) 2800 :group 'gnus-summary)
@@ -2688,7 +2829,7 @@ See `gmm-tool-bar-from-list' for the format of the list."
2688 2829
2689See `gmm-tool-bar-from-list' for the format of the list." 2830See `gmm-tool-bar-from-list' for the format of the list."
2690 :type '(repeat gmm-tool-bar-item) 2831 :type '(repeat gmm-tool-bar-item)
2691 :version "22.1" ;; Gnus 5.10.9 2832 :version "23.0" ;; No Gnus
2692 :initialize 'custom-initialize-default 2833 :initialize 'custom-initialize-default
2693 :set 'gnus-summary-tool-bar-update 2834 :set 'gnus-summary-tool-bar-update
2694 :group 'gnus-summary) 2835 :group 'gnus-summary)
@@ -2699,7 +2840,7 @@ These items are not displayed in the Gnus summary mode tool bar.
2699 2840
2700See `gmm-tool-bar-from-list' for the format of the list." 2841See `gmm-tool-bar-from-list' for the format of the list."
2701 :type 'gmm-tool-bar-zap-list 2842 :type 'gmm-tool-bar-zap-list
2702 :version "22.1" ;; Gnus 5.10.9 2843 :version "23.0" ;; No Gnus
2703 :initialize 'custom-initialize-default 2844 :initialize 'custom-initialize-default
2704 :set 'gnus-summary-tool-bar-update 2845 :set 'gnus-summary-tool-bar-update
2705 :group 'gnus-summary) 2846 :group 'gnus-summary)
@@ -2838,12 +2979,13 @@ The following commands are available:
2838\\{gnus-summary-mode-map}" 2979\\{gnus-summary-mode-map}"
2839 (interactive) 2980 (interactive)
2840 (kill-all-local-variables) 2981 (kill-all-local-variables)
2982 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
2983 (gnus-summary-make-local-variables))
2984 (gnus-summary-make-local-variables)
2985 (setq gnus-newsgroup-name group)
2841 (when (gnus-visual-p 'summary-menu 'menu) 2986 (when (gnus-visual-p 'summary-menu 'menu)
2842 (gnus-summary-make-menu-bar) 2987 (gnus-summary-make-menu-bar)
2843 (gnus-summary-make-tool-bar)) 2988 (gnus-summary-make-tool-bar))
2844 (gnus-summary-make-local-variables)
2845 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
2846 (gnus-summary-make-local-variables))
2847 (gnus-make-thread-indent-array) 2989 (gnus-make-thread-indent-array)
2848 (gnus-simplify-mode-line) 2990 (gnus-simplify-mode-line)
2849 (setq major-mode 'gnus-summary-mode) 2991 (setq major-mode 'gnus-summary-mode)
@@ -2851,13 +2993,13 @@ The following commands are available:
2851 (make-local-variable 'minor-mode-alist) 2993 (make-local-variable 'minor-mode-alist)
2852 (use-local-map gnus-summary-mode-map) 2994 (use-local-map gnus-summary-mode-map)
2853 (buffer-disable-undo) 2995 (buffer-disable-undo)
2854 (setq buffer-read-only t) ;Disable modification 2996 (setq buffer-read-only t ;Disable modification
2997 show-trailing-whitespace nil)
2855 (setq truncate-lines t) 2998 (setq truncate-lines t)
2856 (setq selective-display t) 2999 (setq selective-display t)
2857 (setq selective-display-ellipses t) ;Display `...' 3000 (setq selective-display-ellipses t) ;Display `...'
2858 (gnus-summary-set-display-table) 3001 (gnus-summary-set-display-table)
2859 (gnus-set-default-directory) 3002 (gnus-set-default-directory)
2860 (setq gnus-newsgroup-name group)
2861 (make-local-variable 'gnus-summary-line-format) 3003 (make-local-variable 'gnus-summary-line-format)
2862 (make-local-variable 'gnus-summary-line-format-spec) 3004 (make-local-variable 'gnus-summary-line-format-spec)
2863 (make-local-variable 'gnus-summary-dummy-line-format) 3005 (make-local-variable 'gnus-summary-dummy-line-format)
@@ -2890,9 +3032,9 @@ The following commands are available:
2890 (let ((locals gnus-summary-local-variables)) 3032 (let ((locals gnus-summary-local-variables))
2891 (while locals 3033 (while locals
2892 (if (consp (car locals)) 3034 (if (consp (car locals))
2893 (and (vectorp (caar locals)) 3035 (and (symbolp (caar locals))
2894 (set (caar locals) nil)) 3036 (set (caar locals) nil))
2895 (and (vectorp (car locals)) 3037 (and (symbolp (car locals))
2896 (set (car locals) nil))) 3038 (set (car locals) nil)))
2897 (setq locals (cdr locals))))) 3039 (setq locals (cdr locals)))))
2898 3040
@@ -2964,10 +3106,9 @@ The following commands are available:
2964 (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) 3106 (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
2965 (when offset 3107 (when offset
2966 (gnus-data-update-list odata offset))) 3108 (gnus-data-update-list odata offset)))
2967 ;; Find the last element in the list to be spliced into the main 3109 ;; Find the last element in the list to be spliced into the main
2968 ;; list. 3110 ;; list.
2969 (while (cdr list) 3111 (setq list (last list))
2970 (setq list (cdr list)))
2971 (if (not data) 3112 (if (not data)
2972 (progn 3113 (progn
2973 (setcdr list gnus-newsgroup-data) 3114 (setcdr list gnus-newsgroup-data)
@@ -3283,10 +3424,11 @@ display only a single character."
3283 (gnus-summary-mode group) 3424 (gnus-summary-mode group)
3284 (when gnus-carpal 3425 (when gnus-carpal
3285 (gnus-carpal-setup-buffer 'summary)) 3426 (gnus-carpal-setup-buffer 'summary))
3286 (unless gnus-single-article-buffer 3427 (when (gnus-group-quit-config group)
3287 (make-local-variable 'gnus-article-buffer) 3428 (set (make-local-variable 'gnus-single-article-buffer) nil))
3288 (make-local-variable 'gnus-article-current) 3429 (make-local-variable 'gnus-article-buffer)
3289 (make-local-variable 'gnus-original-article-buffer)) 3430 (make-local-variable 'gnus-article-current)
3431 (make-local-variable 'gnus-original-article-buffer)
3290 (setq gnus-newsgroup-name group) 3432 (setq gnus-newsgroup-name group)
3291 ;; Set any local variables in the group parameters. 3433 ;; Set any local variables in the group parameters.
3292 (gnus-summary-set-local-parameters gnus-newsgroup-name) 3434 (gnus-summary-set-local-parameters gnus-newsgroup-name)
@@ -3319,8 +3461,7 @@ buffer that was in action when the last article was fetched."
3319 (push (eval (car locals)) vlist)) 3461 (push (eval (car locals)) vlist))
3320 (setq locals (cdr locals))) 3462 (setq locals (cdr locals)))
3321 (setq vlist (nreverse vlist))) 3463 (setq vlist (nreverse vlist)))
3322 (save-excursion 3464 (with-current-buffer gnus-group-buffer
3323 (set-buffer gnus-group-buffer)
3324 (setq gnus-newsgroup-name name 3465 (setq gnus-newsgroup-name name
3325 gnus-newsgroup-marked marked 3466 gnus-newsgroup-marked marked
3326 gnus-newsgroup-spam-marked spam 3467 gnus-newsgroup-spam-marked spam
@@ -3444,25 +3585,33 @@ buffer that was in action when the last article was fetched."
3444 3585
3445(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) 3586(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
3446 (let ((mail-parse-charset gnus-newsgroup-charset) 3587 (let ((mail-parse-charset gnus-newsgroup-charset)
3588 (ignored-from-addresses (gnus-ignored-from-addresses))
3447 ; Is it really necessary to do this next part for each summary line? 3589 ; Is it really necessary to do this next part for each summary line?
3448 ; Luckily, doesn't seem to slow things down much. 3590 ; Luckily, doesn't seem to slow things down much.
3449 (mail-parse-ignored-charsets 3591 (mail-parse-ignored-charsets
3450 (save-excursion (set-buffer gnus-summary-buffer) 3592 (with-current-buffer gnus-summary-buffer
3451 gnus-newsgroup-ignored-charsets))) 3593 gnus-newsgroup-ignored-charsets)))
3452 (or 3594 (or
3453 (and gnus-ignored-from-addresses 3595 (and ignored-from-addresses
3454 (string-match gnus-ignored-from-addresses gnus-tmp-from) 3596 (string-match ignored-from-addresses gnus-tmp-from)
3455 (let ((extra-headers (mail-header-extra header)) 3597 (let ((extra-headers (mail-header-extra header))
3456 to 3598 to
3457 newsgroups) 3599 newsgroups)
3458 (cond 3600 (cond
3459 ((setq to (cdr (assq 'To extra-headers))) 3601 ((setq to (cdr (assq 'To extra-headers)))
3460 (concat "-> " 3602 (concat gnus-summary-to-prefix
3461 (inline 3603 (inline
3462 (gnus-summary-extract-address-component 3604 (gnus-summary-extract-address-component
3463 (funcall gnus-decode-encoded-address-function to))))) 3605 (funcall gnus-decode-encoded-address-function to)))))
3464 ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) 3606 ((setq newsgroups
3465 (concat "=> " newsgroups))))) 3607 (or
3608 (cdr (assq 'Newsgroups extra-headers))
3609 (and
3610 (memq 'Newsgroups gnus-extra-headers)
3611 (eq (car (gnus-find-method-for-group
3612 gnus-newsgroup-name)) 'nntp)
3613 (gnus-group-real-name gnus-newsgroup-name))))
3614 (concat gnus-summary-newsgroup-prefix newsgroups)))))
3466 (inline (gnus-summary-extract-address-component gnus-tmp-from))))) 3615 (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
3467 3616
3468(defun gnus-summary-insert-line (gnus-tmp-header 3617(defun gnus-summary-insert-line (gnus-tmp-header
@@ -3613,12 +3762,8 @@ This function is intended to be used in
3613 3762
3614(defun gnus-summary-set-local-parameters (group) 3763(defun gnus-summary-set-local-parameters (group)
3615 "Go through the local params of GROUP and set all variable specs in that list." 3764 "Go through the local params of GROUP and set all variable specs in that list."
3616 (let ((params (gnus-group-find-parameter group)) 3765 (let ((vars '(quit-config))) ; Ignore quit-config.
3617 (vars '(quit-config)) ; Ignore quit-config. 3766 (dolist (elem (gnus-group-find-parameter group))
3618 elem)
3619 (while params
3620 (setq elem (car params)
3621 params (cdr params))
3622 (and (consp elem) ; Has to be a cons. 3767 (and (consp elem) ; Has to be a cons.
3623 (consp (cdr elem)) ; The cdr has to be a list. 3768 (consp (cdr elem)) ; The cdr has to be a list.
3624 (symbolp (car elem)) ; Has to be a symbol in there. 3769 (symbolp (car elem)) ; Has to be a symbol in there.
@@ -4140,21 +4285,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
4140 (erase-buffer))) 4285 (erase-buffer)))
4141 (kill-buffer (current-buffer))) 4286 (kill-buffer (current-buffer)))
4142 ;; Sort over trustworthiness. 4287 ;; Sort over trustworthiness.
4143 (mapcar 4288 (dolist (relation (sort relations 'car-less-than-car))
4144 (lambda (relation) 4289 (when (gnus-dependencies-add-header
4145 (when (gnus-dependencies-add-header 4290 (make-full-mail-header
4146 (make-full-mail-header 4291 gnus-reffed-article-number
4147 gnus-reffed-article-number 4292 (nth 3 relation) "" (or (nth 4 relation) "")
4148 (nth 3 relation) "" (or (nth 4 relation) "") 4293 (nth 1 relation)
4149 (nth 1 relation) 4294 (or (nth 2 relation) "") 0 0 "")
4150 (or (nth 2 relation) "") 0 0 "") 4295 gnus-newsgroup-dependencies nil)
4151 gnus-newsgroup-dependencies nil) 4296 (push gnus-reffed-article-number gnus-newsgroup-limit)
4152 (push gnus-reffed-article-number gnus-newsgroup-limit) 4297 (push gnus-reffed-article-number gnus-newsgroup-sparse)
4153 (push gnus-reffed-article-number gnus-newsgroup-sparse) 4298 (push (cons gnus-reffed-article-number gnus-sparse-mark)
4154 (push (cons gnus-reffed-article-number gnus-sparse-mark) 4299 gnus-newsgroup-reads)
4155 gnus-newsgroup-reads) 4300 (decf gnus-reffed-article-number)))
4156 (decf gnus-reffed-article-number)))
4157 (sort relations 'car-less-than-car))
4158 (gnus-message 7 "Making sparse threads...done"))) 4301 (gnus-message 7 "Making sparse threads...done")))
4159 4302
4160(defun gnus-build-old-threads () 4303(defun gnus-build-old-threads ()
@@ -4182,13 +4325,12 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
4182 "Translate STRING into something that doesn't contain weird characters." 4325 "Translate STRING into something that doesn't contain weird characters."
4183 (mm-subst-char-in-string 4326 (mm-subst-char-in-string
4184 ?\r ?\- 4327 ?\r ?\-
4185 (mm-subst-char-in-string 4328 (mm-subst-char-in-string ?\n ?\- string t) t))
4186 ?\n ?\- string)))
4187 4329
4188;; This function has to be called with point after the article number 4330;; This function has to be called with point after the article number
4189;; on the beginning of the line. 4331;; on the beginning of the line.
4190(defsubst gnus-nov-parse-line (number dependencies &optional force-new) 4332(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
4191 (let ((eol (gnus-point-at-eol)) 4333 (let ((eol (point-at-eol))
4192 (buffer (current-buffer)) 4334 (buffer (current-buffer))
4193 header references in-reply-to) 4335 header references in-reply-to)
4194 4336
@@ -4213,7 +4355,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
4213 (setq x (nnheader-nov-field)))) 4355 (setq x (nnheader-nov-field))))
4214 (error x)) 4356 (error x))
4215 (nnheader-nov-field) ; date 4357 (nnheader-nov-field) ; date
4216 (nnheader-nov-read-message-id) ; id 4358 (nnheader-nov-read-message-id number) ; id
4217 (setq references (nnheader-nov-field)) ; refs 4359 (setq references (nnheader-nov-field)) ; refs
4218 (nnheader-nov-read-integer) ; chars 4360 (nnheader-nov-read-integer) ; chars
4219 (nnheader-nov-read-integer) ; lines 4361 (nnheader-nov-read-integer) ; lines
@@ -4287,8 +4429,7 @@ the id of the parent article (if any)."
4287 (setq article (read (current-buffer)) 4429 (setq article (read (current-buffer))
4288 header (gnus-nov-parse-line article dependencies))) 4430 header (gnus-nov-parse-line article dependencies)))
4289 (when header 4431 (when header
4290 (save-excursion 4432 (with-current-buffer gnus-summary-buffer
4291 (set-buffer gnus-summary-buffer)
4292 (push header gnus-newsgroup-headers) 4433 (push header gnus-newsgroup-headers)
4293 (if (memq (setq article (mail-header-number header)) 4434 (if (memq (setq article (mail-header-number header))
4294 gnus-newsgroup-unselected) 4435 gnus-newsgroup-unselected)
@@ -4385,7 +4526,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
4385 (setq thread (list (car (gnus-id-to-thread id)))) 4526 (setq thread (list (car (gnus-id-to-thread id))))
4386 ;; Get the thread this article is part of. 4527 ;; Get the thread this article is part of.
4387 (setq thread (gnus-remove-thread id))) 4528 (setq thread (gnus-remove-thread id)))
4388 (setq old-pos (gnus-point-at-bol)) 4529 (setq old-pos (point-at-bol))
4389 (setq current (save-excursion 4530 (setq current (save-excursion
4390 (and (re-search-backward "[\r\n]" nil t) 4531 (and (re-search-backward "[\r\n]" nil t)
4391 (gnus-summary-article-number)))) 4532 (gnus-summary-article-number))))
@@ -4567,9 +4708,9 @@ If LINE, insert the rebuilt thread starting on line LINE."
4567 (gnus-summary-show-thread) 4708 (gnus-summary-show-thread)
4568 (gnus-data-remove 4709 (gnus-data-remove
4569 number 4710 number
4570 (- (gnus-point-at-bol) 4711 (- (point-at-bol)
4571 (prog1 4712 (prog1
4572 (1+ (gnus-point-at-eol)) 4713 (1+ (point-at-eol))
4573 (gnus-delete-line))))))) 4714 (gnus-delete-line)))))))
4574 4715
4575(defun gnus-sort-threads-recursive (threads func) 4716(defun gnus-sort-threads-recursive (threads func)
@@ -4689,6 +4830,23 @@ using some other form will lead to serious barfage."
4689 (gnus-article-sort-by-author 4830 (gnus-article-sort-by-author
4690 (gnus-thread-header h1) (gnus-thread-header h2))) 4831 (gnus-thread-header h1) (gnus-thread-header h2)))
4691 4832
4833(defsubst gnus-article-sort-by-recipient (h1 h2)
4834 "Sort articles by recipient."
4835 (gnus-string<
4836 (let ((extract (funcall
4837 gnus-extract-address-components
4838 (or (cdr (assq 'To (mail-header-extra h1))) ""))))
4839 (or (car extract) (cadr extract)))
4840 (let ((extract (funcall
4841 gnus-extract-address-components
4842 (or (cdr (assq 'To (mail-header-extra h2))) ""))))
4843 (or (car extract) (cadr extract)))))
4844
4845(defun gnus-thread-sort-by-recipient (h1 h2)
4846 "Sort threads by root recipient."
4847 (gnus-article-sort-by-recipient
4848 (gnus-thread-header h1) (gnus-thread-header h2)))
4849
4692(defsubst gnus-article-sort-by-subject (h1 h2) 4850(defsubst gnus-article-sort-by-subject (h1 h2)
4693 "Sort articles by root subject." 4851 "Sort articles by root subject."
4694 (gnus-string< 4852 (gnus-string<
@@ -4809,33 +4967,39 @@ If nil, use subject instead."
4809 :version "22.1" 4967 :version "22.1"
4810 :type '(radio (const :format "%v " nil) string) 4968 :type '(radio (const :format "%v " nil) string)
4811 :group 'gnus-thread) 4969 :group 'gnus-thread)
4970
4812(defcustom gnus-sum-thread-tree-false-root "> " 4971(defcustom gnus-sum-thread-tree-false-root "> "
4813 "With %B spec, used for a false root of a thread. 4972 "With %B spec, used for a false root of a thread.
4814If nil, use subject instead." 4973If nil, use subject instead."
4815 :version "22.1" 4974 :version "22.1"
4816 :type '(radio (const :format "%v " nil) string) 4975 :type '(radio (const :format "%v " nil) string)
4817 :group 'gnus-thread) 4976 :group 'gnus-thread)
4977
4818(defcustom gnus-sum-thread-tree-single-indent "" 4978(defcustom gnus-sum-thread-tree-single-indent ""
4819 "With %B spec, used for a thread with just one message. 4979 "With %B spec, used for a thread with just one message.
4820If nil, use subject instead." 4980If nil, use subject instead."
4821 :version "22.1" 4981 :version "22.1"
4822 :type '(radio (const :format "%v " nil) string) 4982 :type '(radio (const :format "%v " nil) string)
4823 :group 'gnus-thread) 4983 :group 'gnus-thread)
4984
4824(defcustom gnus-sum-thread-tree-vertical "| " 4985(defcustom gnus-sum-thread-tree-vertical "| "
4825 "With %B spec, used for drawing a vertical line." 4986 "With %B spec, used for drawing a vertical line."
4826 :version "22.1" 4987 :version "22.1"
4827 :type 'string 4988 :type 'string
4828 :group 'gnus-thread) 4989 :group 'gnus-thread)
4990
4829(defcustom gnus-sum-thread-tree-indent " " 4991(defcustom gnus-sum-thread-tree-indent " "
4830 "With %B spec, used for indenting." 4992 "With %B spec, used for indenting."
4831 :version "22.1" 4993 :version "22.1"
4832 :type 'string 4994 :type 'string
4833 :group 'gnus-thread) 4995 :group 'gnus-thread)
4996
4834(defcustom gnus-sum-thread-tree-leaf-with-other "+-> " 4997(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
4835 "With %B spec, used for a leaf with brothers." 4998 "With %B spec, used for a leaf with brothers."
4836 :version "22.1" 4999 :version "22.1"
4837 :type 'string 5000 :type 'string
4838 :group 'gnus-thread) 5001 :group 'gnus-thread)
5002
4839(defcustom gnus-sum-thread-tree-single-leaf "\\-> " 5003(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
4840 "With %B spec, used for a leaf without brothers." 5004 "With %B spec, used for a leaf without brothers."
4841 :version "22.1" 5005 :version "22.1"
@@ -5194,23 +5358,20 @@ or a straight list of headers."
5194 gnus-list-identifiers)) 5358 gnus-list-identifiers))
5195 changed subject) 5359 changed subject)
5196 (when regexp 5360 (when regexp
5361 (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
5197 (dolist (header gnus-newsgroup-headers) 5362 (dolist (header gnus-newsgroup-headers)
5198 (setq subject (mail-header-subject header) 5363 (setq subject (mail-header-subject header)
5199 changed nil) 5364 changed nil)
5200 (while (string-match 5365 (while (string-match regexp subject)
5201 (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
5202 subject)
5203 (setq subject 5366 (setq subject
5204 (concat (substring subject 0 (match-beginning 2)) 5367 (concat (substring subject 0 (match-beginning 1))
5205 (substring subject (match-end 0))) 5368 (substring subject (match-end 0)))
5206 changed t)) 5369 changed t))
5207 (when (and changed
5208 (string-match
5209 "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
5210 (setq subject
5211 (concat (substring subject 0 (match-beginning 1))
5212 (substring subject (match-end 1)))))
5213 (when changed 5370 (when changed
5371 (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
5372 (setq subject
5373 (concat (substring subject 0 (match-beginning 1))
5374 (substring subject (match-end 1)))))
5214 (mail-header-set-subject header subject)))))) 5375 (mail-header-set-subject header subject))))))
5215 5376
5216(defun gnus-fetch-headers (articles) 5377(defun gnus-fetch-headers (articles)
@@ -5238,33 +5399,37 @@ or a straight list of headers."
5238 "Select newsgroup GROUP. 5399 "Select newsgroup GROUP.
5239If READ-ALL is non-nil, all articles in the group are selected. 5400If READ-ALL is non-nil, all articles in the group are selected.
5240If SELECT-ARTICLES, only select those articles from GROUP." 5401If SELECT-ARTICLES, only select those articles from GROUP."
5241 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) 5402 (let* ((entry (gnus-group-entry group))
5242 ;;!!! Dirty hack; should be removed. 5403 ;;!!! Dirty hack; should be removed.
5243 (gnus-summary-ignore-duplicates 5404 (gnus-summary-ignore-duplicates
5244 (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) 5405 (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
5245 t 5406 t
5246 gnus-summary-ignore-duplicates)) 5407 gnus-summary-ignore-duplicates))
5247 (info (nth 2 entry)) 5408 (info (nth 2 entry))
5248 articles fetched-articles cached) 5409 charset articles fetched-articles cached)
5249 5410
5250 (unless (gnus-check-server 5411 (unless (gnus-check-server
5251 (set (make-local-variable 'gnus-current-select-method) 5412 (set (make-local-variable 'gnus-current-select-method)
5252 (gnus-find-method-for-group group))) 5413 (gnus-find-method-for-group group)))
5253 (error "Couldn't open server")) 5414 (error "Couldn't open server"))
5415 (setq charset (gnus-group-name-charset gnus-current-select-method group))
5254 5416
5255 (or (and entry (not (eq (car entry) t))) ; Either it's active... 5417 (or (and entry (not (eq (car entry) t))) ; Either it's active...
5256 (gnus-activate-group group) ; Or we can activate it... 5418 (gnus-activate-group group) ; Or we can activate it...
5257 (progn ; Or we bug out. 5419 (progn ; Or we bug out.
5258 (when (equal major-mode 'gnus-summary-mode) 5420 (when (equal major-mode 'gnus-summary-mode)
5259 (gnus-kill-buffer (current-buffer))) 5421 (gnus-kill-buffer (current-buffer)))
5260 (error "Couldn't activate group %s: %s" 5422 (error
5261 (gnus-group-decoded-name group) (gnus-status-message group)))) 5423 "Couldn't activate group %s: %s"
5424 (mm-decode-coding-string group charset)
5425 (mm-decode-coding-string (gnus-status-message group) charset))))
5262 5426
5263 (unless (gnus-request-group group t) 5427 (unless (gnus-request-group group t)
5264 (when (equal major-mode 'gnus-summary-mode) 5428 (when (equal major-mode 'gnus-summary-mode)
5265 (gnus-kill-buffer (current-buffer))) 5429 (gnus-kill-buffer (current-buffer)))
5266 (error "Couldn't request group %s: %s" 5430 (error "Couldn't request group %s: %s"
5267 (gnus-group-decoded-name group) (gnus-status-message group))) 5431 (mm-decode-coding-string group charset)
5432 (mm-decode-coding-string (gnus-status-message group) charset)))
5268 5433
5269 (when gnus-agent 5434 (when gnus-agent
5270 (gnus-agent-possibly-alter-active group (gnus-active group) info) 5435 (gnus-agent-possibly-alter-active group (gnus-active group) info)
@@ -5387,7 +5552,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5387 (setq gnus-newsgroup-auto-expire 5552 (setq gnus-newsgroup-auto-expire
5388 (gnus-group-auto-expirable-p group)) 5553 (gnus-group-auto-expirable-p group))
5389 ;; Set up the article buffer now, if necessary. 5554 ;; Set up the article buffer now, if necessary.
5390 (unless gnus-single-article-buffer 5555 (unless (and gnus-single-article-buffer
5556 (equal gnus-article-buffer "*Article*"))
5391 (gnus-article-setup-buffer)) 5557 (gnus-article-setup-buffer))
5392 ;; First and last article in this newsgroup. 5558 ;; First and last article in this newsgroup.
5393 (when gnus-newsgroup-headers 5559 (when gnus-newsgroup-headers
@@ -5521,9 +5687,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5521 (read-string 5687 (read-string
5522 (format 5688 (format
5523 "How many articles from %s (%s %d): " 5689 "How many articles from %s (%s %d): "
5524 (gnus-limit-string 5690 (gnus-group-decoded-name gnus-newsgroup-name)
5525 (gnus-group-decoded-name gnus-newsgroup-name)
5526 35)
5527 (if initial "max" "default") 5691 (if initial "max" "default")
5528 number) 5692 number)
5529 (if initial 5693 (if initial
@@ -5849,7 +6013,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
5849(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) 6013(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
5850 "Look through all the headers and mark the Xrefs as read." 6014 "Look through all the headers and mark the Xrefs as read."
5851 (let ((virtual (gnus-virtual-group-p from-newsgroup)) 6015 (let ((virtual (gnus-virtual-group-p from-newsgroup))
5852 name entry info xref-hashtb idlist method nth4) 6016 name info xref-hashtb idlist method nth4)
5853 (save-excursion 6017 (save-excursion
5854 (set-buffer gnus-group-buffer) 6018 (set-buffer gnus-group-buffer)
5855 (when (setq xref-hashtb 6019 (when (setq xref-hashtb
@@ -5860,8 +6024,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
5860 (setq idlist (symbol-value group)) 6024 (setq idlist (symbol-value group))
5861 ;; Dead groups are not updated. 6025 ;; Dead groups are not updated.
5862 (and (prog1 6026 (and (prog1
5863 (setq entry (gnus-gethash name gnus-newsrc-hashtb) 6027 (setq info (gnus-get-info name))
5864 info (nth 2 entry))
5865 (when (stringp (setq nth4 (gnus-info-method info))) 6028 (when (stringp (setq nth4 (gnus-info-method info)))
5866 (setq nth4 (gnus-server-to-method nth4)))) 6029 (setq nth4 (gnus-server-to-method nth4))))
5867 ;; Only do the xrefs if the group has the same 6030 ;; Only do the xrefs if the group has the same
@@ -5883,7 +6046,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
5883 xref-hashtb))))) 6046 xref-hashtb)))))
5884 6047
5885(defun gnus-compute-read-articles (group articles) 6048(defun gnus-compute-read-articles (group articles)
5886 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) 6049 (let* ((entry (gnus-group-entry group))
5887 (info (nth 2 entry)) 6050 (info (nth 2 entry))
5888 (active (gnus-active group)) 6051 (active (gnus-active group))
5889 ninfo) 6052 ninfo)
@@ -5920,14 +6083,13 @@ The resulting hash table is returned, or nil if no Xrefs were found."
5920(defun gnus-group-make-articles-read (group articles) 6083(defun gnus-group-make-articles-read (group articles)
5921 "Update the info of GROUP to say that ARTICLES are read." 6084 "Update the info of GROUP to say that ARTICLES are read."
5922 (let* ((num 0) 6085 (let* ((num 0)
5923 (entry (gnus-gethash group gnus-newsrc-hashtb)) 6086 (entry (gnus-group-entry group))
5924 (info (nth 2 entry)) 6087 (info (nth 2 entry))
5925 (active (gnus-active group)) 6088 (active (gnus-active group))
5926 range) 6089 range)
5927 (when entry 6090 (when entry
5928 (setq range (gnus-compute-read-articles group articles)) 6091 (setq range (gnus-compute-read-articles group articles))
5929 (save-excursion 6092 (with-current-buffer gnus-group-buffer
5930 (set-buffer gnus-group-buffer)
5931 (gnus-undo-register 6093 (gnus-undo-register
5932 `(progn 6094 `(progn
5933 (gnus-info-set-marks ',info ',(gnus-info-marks info) t) 6095 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
@@ -5966,9 +6128,9 @@ The resulting hash table is returned, or nil if no Xrefs were found."
5966 (let ((cur nntp-server-buffer) 6128 (let ((cur nntp-server-buffer)
5967 (dependencies 6129 (dependencies
5968 (or dependencies 6130 (or dependencies
5969 (save-excursion (set-buffer gnus-summary-buffer) 6131 (with-current-buffer gnus-summary-buffer
5970 gnus-newsgroup-dependencies))) 6132 gnus-newsgroup-dependencies)))
5971 headers id end ref 6133 headers id end ref number
5972 (mail-parse-charset gnus-newsgroup-charset) 6134 (mail-parse-charset gnus-newsgroup-charset)
5973 (mail-parse-ignored-charsets 6135 (mail-parse-ignored-charsets
5974 (save-excursion (condition-case nil 6136 (save-excursion (condition-case nil
@@ -6001,7 +6163,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
6001 (vector 6163 (vector
6002 ;; Number. 6164 ;; Number.
6003 (prog1 6165 (prog1
6004 (read cur) 6166 (setq number (read cur))
6005 (end-of-line) 6167 (end-of-line)
6006 (setq p (point)) 6168 (setq p (point))
6007 (narrow-to-region (point) 6169 (narrow-to-region (point)
@@ -6038,7 +6200,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
6038 (match-end 1)) 6200 (match-end 1))
6039 ;; If there was no message-id, we just fake one 6201 ;; If there was no message-id, we just fake one
6040 ;; to make subsequent routines simpler. 6202 ;; to make subsequent routines simpler.
6041 (nnheader-generate-fake-message-id)))) 6203 (nnheader-generate-fake-message-id number))))
6042 ;; References. 6204 ;; References.
6043 (progn 6205 (progn
6044 (goto-char p) 6206 (goto-char p)
@@ -6185,8 +6347,8 @@ Return a list of headers that match SEQUENCE (see
6185(defun gnus-article-get-xrefs () 6347(defun gnus-article-get-xrefs ()
6186 "Fill in the Xref value in `gnus-current-headers', if necessary. 6348 "Fill in the Xref value in `gnus-current-headers', if necessary.
6187This is meant to be called in `gnus-article-internal-prepare-hook'." 6349This is meant to be called in `gnus-article-internal-prepare-hook'."
6188 (let ((headers (save-excursion (set-buffer gnus-summary-buffer) 6350 (let ((headers (with-current-buffer gnus-summary-buffer
6189 gnus-current-headers))) 6351 gnus-current-headers)))
6190 (or (not gnus-use-cross-reference) 6352 (or (not gnus-use-cross-reference)
6191 (not headers) 6353 (not headers)
6192 (and (mail-header-xref headers) 6354 (and (mail-header-xref headers)
@@ -6201,7 +6363,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'."
6201 (looking-at "Xref:")) 6363 (looking-at "Xref:"))
6202 (search-forward "\nXref:" nil t)) 6364 (search-forward "\nXref:" nil t))
6203 (goto-char (1+ (match-end 0))) 6365 (goto-char (1+ (match-end 0)))
6204 (setq xref (buffer-substring (point) (gnus-point-at-eol))) 6366 (setq xref (buffer-substring (point) (point-at-eol)))
6205 (mail-header-set-xref headers xref))))))) 6367 (mail-header-set-xref headers xref)))))))
6206 6368
6207(defun gnus-summary-insert-subject (id &optional old-header use-old-header) 6369(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
@@ -6229,9 +6391,9 @@ the subject line on."
6229 (goto-char (gnus-data-pos d)) 6391 (goto-char (gnus-data-pos d))
6230 (gnus-data-remove 6392 (gnus-data-remove
6231 number 6393 number
6232 (- (gnus-point-at-bol) 6394 (- (point-at-bol)
6233 (prog1 6395 (prog1
6234 (1+ (gnus-point-at-eol)) 6396 (1+ (point-at-eol))
6235 (gnus-delete-line)))))) 6397 (gnus-delete-line))))))
6236 ;; Remove list identifiers from subject. 6398 ;; Remove list identifiers from subject.
6237 (when gnus-list-identifiers 6399 (when gnus-list-identifiers
@@ -6345,8 +6507,7 @@ executed with point over the summary line of the articles."
6345(defun gnus-summary-process-mark-set (set) 6507(defun gnus-summary-process-mark-set (set)
6346 "Make SET into the current process marked articles." 6508 "Make SET into the current process marked articles."
6347 (gnus-summary-unmark-all-processable) 6509 (gnus-summary-unmark-all-processable)
6348 (while set 6510 (mapc 'gnus-summary-set-process-mark set))
6349 (gnus-summary-set-process-mark (pop set))))
6350 6511
6351;;; Searching and stuff 6512;;; Searching and stuff
6352 6513
@@ -6362,8 +6523,7 @@ If optional argument BACKWARD is non-nil, search backward instead."
6362(defun gnus-summary-best-group (&optional exclude-group) 6523(defun gnus-summary-best-group (&optional exclude-group)
6363 "Find the name of the best unread group. 6524 "Find the name of the best unread group.
6364If EXCLUDE-GROUP, do not go to this group." 6525If EXCLUDE-GROUP, do not go to this group."
6365 (save-excursion 6526 (with-current-buffer gnus-group-buffer
6366 (set-buffer gnus-group-buffer)
6367 (save-excursion 6527 (save-excursion
6368 (gnus-group-best-unread-group exclude-group)))) 6528 (gnus-group-best-unread-group exclude-group))))
6369 6529
@@ -6494,7 +6654,7 @@ displayed, no centering will be performed."
6494 ((< (window-height) 7) 1) 6654 ((< (window-height) 7) 1)
6495 (t (if (numberp gnus-auto-center-summary) 6655 (t (if (numberp gnus-auto-center-summary)
6496 gnus-auto-center-summary 6656 gnus-auto-center-summary
6497 2)))) 6657 (/ (1- (window-height)) 2)))))
6498 (height (1- (window-height))) 6658 (height (1- (window-height)))
6499 (bottom (save-excursion (goto-char (point-max)) 6659 (bottom (save-excursion (goto-char (point-max))
6500 (forward-line (- height)) 6660 (forward-line (- height))
@@ -6508,7 +6668,7 @@ displayed, no centering will be performed."
6508 (let ((top-pos (save-excursion (forward-line (- top)) (point)))) 6668 (let ((top-pos (save-excursion (forward-line (- top)) (point))))
6509 (if (> bottom top-pos) 6669 (if (> bottom top-pos)
6510 ;; Keep the second line from the top visible 6670 ;; Keep the second line from the top visible
6511 (set-window-start window top-pos t) 6671 (set-window-start window top-pos)
6512 ;; Try to keep the bottom line visible; if it's partially 6672 ;; Try to keep the bottom line visible; if it's partially
6513 ;; obscured, either scroll one more line to make it fully 6673 ;; obscured, either scroll one more line to make it fully
6514 ;; visible, or revert to using TOP-POS. 6674 ;; visible, or revert to using TOP-POS.
@@ -6552,7 +6712,8 @@ displayed, no centering will be performed."
6552(defun gnus-list-of-unread-articles (group) 6712(defun gnus-list-of-unread-articles (group)
6553 (let* ((read (gnus-info-read (gnus-get-info group))) 6713 (let* ((read (gnus-info-read (gnus-get-info group)))
6554 (active (or (gnus-active group) (gnus-activate-group group))) 6714 (active (or (gnus-active group) (gnus-activate-group group)))
6555 (last (cdr active)) 6715 (last (or (cdr active)
6716 (error "Group %s couldn't be activated " group)))
6556 (bottom (if gnus-newsgroup-maximum-articles 6717 (bottom (if gnus-newsgroup-maximum-articles
6557 (max (car active) 6718 (max (car active)
6558 (- last gnus-newsgroup-maximum-articles -1)) 6719 (- last gnus-newsgroup-maximum-articles -1))
@@ -6752,8 +6913,7 @@ The prefix argument ALL means to select all articles."
6752 (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) 6913 (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
6753 (let ((headers gnus-newsgroup-headers)) 6914 (let ((headers gnus-newsgroup-headers))
6754 ;; Set the new ranges of read articles. 6915 ;; Set the new ranges of read articles.
6755 (save-excursion 6916 (with-current-buffer gnus-group-buffer
6756 (set-buffer gnus-group-buffer)
6757 (gnus-undo-force-boundary)) 6917 (gnus-undo-force-boundary))
6758 (gnus-update-read-articles 6918 (gnus-update-read-articles
6759 group (gnus-sorted-union 6919 group (gnus-sorted-union
@@ -6813,8 +6973,13 @@ If FORCE (the prefix), also save the .newsrc file(s)."
6813 (gnus-run-hooks 'gnus-summary-prepare-exit-hook) 6973 (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
6814 ;; If we have several article buffers, we kill them at exit. 6974 ;; If we have several article buffers, we kill them at exit.
6815 (unless gnus-single-article-buffer 6975 (unless gnus-single-article-buffer
6816 (gnus-kill-buffer gnus-original-article-buffer) 6976 (when (gnus-buffer-live-p gnus-article-buffer)
6817 (setq gnus-article-current nil)) 6977 (with-current-buffer gnus-article-buffer
6978 ;; Don't kill sticky article buffers
6979 (unless (eq major-mode 'gnus-sticky-article-mode)
6980 (gnus-kill-buffer gnus-article-buffer)
6981 (setq gnus-article-current nil))))
6982 (gnus-kill-buffer gnus-original-article-buffer))
6818 (when gnus-use-cache 6983 (when gnus-use-cache
6819 (gnus-cache-possibly-remove-articles) 6984 (gnus-cache-possibly-remove-articles)
6820 (gnus-cache-save-buffers)) 6985 (gnus-cache-save-buffers))
@@ -6838,6 +7003,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
6838 (gnus-group-jump-to-group group)) 7003 (gnus-group-jump-to-group group))
6839 (gnus-run-hooks 'gnus-summary-exit-hook) 7004 (gnus-run-hooks 'gnus-summary-exit-hook)
6840 (unless (or quit-config 7005 (unless (or quit-config
7006 (not gnus-summary-next-group-on-exit)
6841 ;; If this group has disappeared from the summary 7007 ;; If this group has disappeared from the summary
6842 ;; buffer, don't skip forwards. 7008 ;; buffer, don't skip forwards.
6843 (not (string= group (gnus-group-group-name)))) 7009 (not (string= group (gnus-group-group-name))))
@@ -6845,11 +7011,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
6845 (setq group-point (point)) 7011 (setq group-point (point))
6846 (if temporary 7012 (if temporary
6847 nil ;Nothing to do. 7013 nil ;Nothing to do.
6848 ;; If we have several article buffers, we kill them at exit.
6849 (unless gnus-single-article-buffer
6850 (gnus-kill-buffer gnus-article-buffer)
6851 (gnus-kill-buffer gnus-original-article-buffer)
6852 (setq gnus-article-current nil))
6853 (set-buffer buf) 7014 (set-buffer buf)
6854 (if (not gnus-kill-summary-on-exit) 7015 (if (not gnus-kill-summary-on-exit)
6855 (progn 7016 (progn
@@ -6864,12 +7025,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
6864 (gnus-summary-clear-local-variables)) 7025 (gnus-summary-clear-local-variables))
6865 (when (get-buffer gnus-article-buffer) 7026 (when (get-buffer gnus-article-buffer)
6866 (bury-buffer gnus-article-buffer)) 7027 (bury-buffer gnus-article-buffer))
6867 ;; We clear the global counterparts of the buffer-local
6868 ;; variables as well, just to be on the safe side.
6869 (set-buffer gnus-group-buffer)
6870 (gnus-summary-clear-local-variables)
6871 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6872 (gnus-summary-clear-local-variables))
6873 ;; Return to group mode buffer. 7028 ;; Return to group mode buffer.
6874 (when (eq mode 'gnus-summary-mode) 7029 (when (eq mode 'gnus-summary-mode)
6875 (gnus-kill-buffer buf))) 7030 (gnus-kill-buffer buf)))
@@ -6919,10 +7074,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
6919 (gnus-summary-clear-local-variables) 7074 (gnus-summary-clear-local-variables)
6920 (let ((gnus-summary-local-variables gnus-newsgroup-variables)) 7075 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6921 (gnus-summary-clear-local-variables)) 7076 (gnus-summary-clear-local-variables))
6922 (set-buffer gnus-group-buffer)
6923 (gnus-summary-clear-local-variables)
6924 (let ((gnus-summary-local-variables gnus-newsgroup-variables))
6925 (gnus-summary-clear-local-variables))
6926 (gnus-kill-buffer gnus-summary-buffer)) 7077 (gnus-kill-buffer gnus-summary-buffer))
6927 (unless gnus-single-article-buffer 7078 (unless gnus-single-article-buffer
6928 (setq gnus-article-current nil)) 7079 (setq gnus-article-current nil))
@@ -6961,19 +7112,26 @@ The state which existed when entering the ephemeral is reset."
6961 (gnus-set-global-variables)))) 7112 (gnus-set-global-variables))))
6962 (if (or (eq (cdr quit-config) 'article) 7113 (if (or (eq (cdr quit-config) 'article)
6963 (eq (cdr quit-config) 'pick)) 7114 (eq (cdr quit-config) 'pick))
6964 (progn 7115 (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
6965 ;; The current article may be from the ephemeral group 7116 (gnus-configure-windows 'pick 'force)
6966 ;; thus it is best that we reload this article 7117 (gnus-configure-windows (cdr quit-config) 'force))
6967 ;;
6968 ;; If we're exiting from a large digest, this can be
6969 ;; extremely slow. So, it's better not to reload it. -- jh.
6970 ;;(gnus-summary-show-article)
6971 (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
6972 (gnus-configure-windows 'pick 'force)
6973 (gnus-configure-windows (cdr quit-config) 'force)))
6974 (gnus-configure-windows (cdr quit-config) 'force)) 7118 (gnus-configure-windows (cdr quit-config) 'force))
6975 (when (eq major-mode 'gnus-summary-mode) 7119 (when (eq major-mode 'gnus-summary-mode)
6976 (gnus-summary-next-subject 1 nil t) 7120 (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect
7121 next-unread-noselect))
7122 (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit
7123 'next-noselect)
7124 (gnus-summary-next-subject 1 nil t))
7125 ((eq gnus-auto-select-on-ephemeral-exit
7126 'next-unread-noselect)
7127 (gnus-summary-next-subject 1 t t))))
7128 ;; Hide the article buffer which displays the article different
7129 ;; from the one that the cursor points to in the summary buffer.
7130 (gnus-configure-windows 'summary 'force))
7131 (cond ((eq gnus-auto-select-on-ephemeral-exit 'next)
7132 (gnus-summary-next-subject 1))
7133 ((eq gnus-auto-select-on-ephemeral-exit 'next-unread)
7134 (gnus-summary-next-subject 1 t))))
6977 (gnus-summary-recenter) 7135 (gnus-summary-recenter)
6978 (gnus-summary-position-point)))) 7136 (gnus-summary-position-point))))
6979 7137
@@ -7004,7 +7162,7 @@ The state which existed when entering the ephemeral is reset."
7004 (if (null arg) (not gnus-dead-summary-mode) 7162 (if (null arg) (not gnus-dead-summary-mode)
7005 (> (prefix-numeric-value arg) 0))) 7163 (> (prefix-numeric-value arg) 0)))
7006 (when gnus-dead-summary-mode 7164 (when gnus-dead-summary-mode
7007 (gnus-add-minor-mode 7165 (add-minor-mode
7008 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map)))) 7166 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
7009 7167
7010(defun gnus-deaden-summary () 7168(defun gnus-deaden-summary ()
@@ -7012,8 +7170,7 @@ The state which existed when entering the ephemeral is reset."
7012 ;; Kill any previous dead summary buffer. 7170 ;; Kill any previous dead summary buffer.
7013 (when (and gnus-dead-summary 7171 (when (and gnus-dead-summary
7014 (buffer-name gnus-dead-summary)) 7172 (buffer-name gnus-dead-summary))
7015 (save-excursion 7173 (with-current-buffer gnus-dead-summary
7016 (set-buffer gnus-dead-summary)
7017 (when gnus-dead-summary-mode 7174 (when gnus-dead-summary-mode
7018 (kill-buffer (current-buffer))))) 7175 (kill-buffer (current-buffer)))))
7019 ;; Make this the current dead summary. 7176 ;; Make this the current dead summary.
@@ -7032,8 +7189,7 @@ The state which existed when entering the ephemeral is reset."
7032 (save-excursion 7189 (save-excursion
7033 (when (and (buffer-name buffer) 7190 (when (and (buffer-name buffer)
7034 (not gnus-single-article-buffer)) 7191 (not gnus-single-article-buffer))
7035 (save-excursion 7192 (with-current-buffer buffer
7036 (set-buffer buffer)
7037 (gnus-kill-buffer gnus-article-buffer) 7193 (gnus-kill-buffer gnus-article-buffer)
7038 (gnus-kill-buffer gnus-original-article-buffer))) 7194 (gnus-kill-buffer gnus-original-article-buffer)))
7039 (cond 7195 (cond
@@ -7073,7 +7229,7 @@ in."
7073 (when current-prefix-arg 7229 (when current-prefix-arg
7074 (completing-read 7230 (completing-read
7075 "FAQ dir: " (and (listp gnus-group-faq-directory) 7231 "FAQ dir: " (and (listp gnus-group-faq-directory)
7076 (mapcar (lambda (file) (list file)) 7232 (mapcar 'list
7077 gnus-group-faq-directory)))))) 7233 gnus-group-faq-directory))))))
7078 (let (gnus-faq-buffer) 7234 (let (gnus-faq-buffer)
7079 (when (setq gnus-faq-buffer 7235 (when (setq gnus-faq-buffer
@@ -7287,15 +7443,15 @@ Given a prefix, will force an `article' buffer configuration."
7287 7443
7288(defun gnus-summary-display-article (article &optional all-header) 7444(defun gnus-summary-display-article (article &optional all-header)
7289 "Display ARTICLE in article buffer." 7445 "Display ARTICLE in article buffer."
7290 (when (gnus-buffer-live-p gnus-article-buffer) 7446 (unless (and (gnus-buffer-live-p gnus-article-buffer)
7291 (with-current-buffer gnus-article-buffer 7447 (with-current-buffer gnus-article-buffer
7292 (mm-enable-multibyte))) 7448 (eq major-mode 'gnus-article-mode)))
7449 (gnus-article-setup-buffer))
7293 (gnus-set-global-variables) 7450 (gnus-set-global-variables)
7294 (when (gnus-buffer-live-p gnus-article-buffer) 7451 (with-current-buffer gnus-article-buffer
7295 (with-current-buffer gnus-article-buffer 7452 (setq gnus-article-charset gnus-newsgroup-charset)
7296 (setq gnus-article-charset gnus-newsgroup-charset) 7453 (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
7297 (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) 7454 (mm-enable-multibyte))
7298 (mm-enable-multibyte)))
7299 (if (null article) 7455 (if (null article)
7300 nil 7456 nil
7301 (prog1 7457 (prog1
@@ -7402,8 +7558,7 @@ If BACKWARD, the previous article is selected instead of the next."
7402 (gnus-summary-jump-to-group gnus-newsgroup-name)) 7558 (gnus-summary-jump-to-group gnus-newsgroup-name))
7403 (let ((cmd last-command-char) 7559 (let ((cmd last-command-char)
7404 (point 7560 (point
7405 (save-excursion 7561 (with-current-buffer gnus-group-buffer
7406 (set-buffer gnus-group-buffer)
7407 (point))) 7562 (point)))
7408 (group 7563 (group
7409 (if (eq gnus-keep-same-level 'best) 7564 (if (eq gnus-keep-same-level 'best)
@@ -7456,7 +7611,7 @@ If BACKWARD, the previous article is selected instead of the next."
7456 (format " (Type %s for %s [%s])" 7611 (format " (Type %s for %s [%s])"
7457 (single-key-description cmd) 7612 (single-key-description cmd)
7458 (gnus-group-decoded-name group) 7613 (gnus-group-decoded-name group)
7459 (car (gnus-gethash group gnus-newsrc-hashtb))) 7614 (gnus-group-unread group))
7460 (format " (Type %s to exit %s)" 7615 (format " (Type %s to exit %s)"
7461 (single-key-description cmd) 7616 (single-key-description cmd)
7462 (gnus-group-decoded-name gnus-newsgroup-name))))) 7617 (gnus-group-decoded-name gnus-newsgroup-name)))))
@@ -7844,6 +7999,123 @@ If NOT-MATCHING, excluding articles that have authors that match a regexp."
7844 current-prefix-arg)) 7999 current-prefix-arg))
7845 (gnus-summary-limit-to-subject from "from" not-matching)) 8000 (gnus-summary-limit-to-subject from "from" not-matching))
7846 8001
8002(defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
8003 "Limit the summary buffer to articles with the given RECIPIENT.
8004
8005If NOT-MATCHING, exclude RECIPIENT.
8006
8007To and Cc headers are checked. You need to include them in
8008`nnmail-extra-headers'."
8009 ;; Unlike `rmail-summary-by-recipients', doesn't include From.
8010 (interactive
8011 (list (read-string (format "%s recipient (regexp): "
8012 (if current-prefix-arg "Exclude" "Limit to")))
8013 current-prefix-arg))
8014 (when (not (equal "" recipient))
8015 (prog1 (let* ((to
8016 (if (memq 'To nnmail-extra-headers)
8017 (gnus-summary-find-matching
8018 (cons 'extra 'To) recipient 'all nil nil
8019 not-matching)
8020 (gnus-message
8021 1 "`To' isn't present in `nnmail-extra-headers'")
8022 (sit-for 1)
8023 nil))
8024 (cc
8025 (if (memq 'Cc nnmail-extra-headers)
8026 (gnus-summary-find-matching
8027 (cons 'extra 'Cc) recipient 'all nil nil
8028 not-matching)
8029 (gnus-message
8030 1 "`Cc' isn't present in `nnmail-extra-headers'")
8031 (sit-for 1)
8032 nil))
8033 (articles
8034 (if not-matching
8035 ;; We need the numbers that are in both lists:
8036 (mapcar (lambda (a)
8037 (and (memq a to) a))
8038 cc)
8039 (nconc to cc))))
8040 (unless articles
8041 (error "Found no matches for \"%s\"" recipient))
8042 (gnus-summary-limit articles))
8043 (gnus-summary-position-point))))
8044
8045(defun gnus-summary-limit-to-address (address &optional not-matching)
8046 "Limit the summary buffer to articles with the given ADDRESS.
8047
8048If NOT-MATCHING, exclude ADDRESS.
8049
8050To, Cc and From headers are checked. You need to include `To' and `Cc'
8051in `nnmail-extra-headers'."
8052 (interactive
8053 (list (read-string (format "%s address (regexp): "
8054 (if current-prefix-arg "Exclude" "Limit to")))
8055 current-prefix-arg))
8056 (when (not (equal "" address))
8057 (prog1 (let* ((to
8058 (if (memq 'To nnmail-extra-headers)
8059 (gnus-summary-find-matching
8060 (cons 'extra 'To) address 'all nil nil
8061 not-matching)
8062 (gnus-message
8063 1 "`To' isn't present in `nnmail-extra-headers'")
8064 (sit-for 1)
8065 t))
8066 (cc
8067 (if (memq 'Cc nnmail-extra-headers)
8068 (gnus-summary-find-matching
8069 (cons 'extra 'Cc) address 'all nil nil
8070 not-matching)
8071 (gnus-message
8072 1 "`Cc' isn't present in `nnmail-extra-headers'")
8073 (sit-for 1)
8074 t))
8075 (from
8076 (gnus-summary-find-matching "from" address
8077 'all nil nil not-matching))
8078 (articles
8079 (if not-matching
8080 ;; We need the numbers that are in all lists:
8081 (if (eq cc t)
8082 (if (eq to t)
8083 from
8084 (mapcar (lambda (a) (car (memq a from))) to))
8085 (if (eq to t)
8086 (mapcar (lambda (a) (car (memq a from))) cc)
8087 (mapcar (lambda (a) (car (memq a from)))
8088 (mapcar (lambda (a) (car (memq a to)))
8089 cc))))
8090 (nconc (if (eq to t) nil to)
8091 (if (eq cc t) nil cc)
8092 from))))
8093 (unless articles
8094 (error "Found no matches for \"%s\"" address))
8095 (gnus-summary-limit articles))
8096 (gnus-summary-position-point))))
8097
8098(defun gnus-summary-limit-strange-charsets-predicate (header)
8099 (let ((string (concat (mail-header-subject header)
8100 (mail-header-from header)))
8101 charset found)
8102 (dotimes (i (1- (length string)))
8103 (setq charset (format "%s" (char-charset (aref string (1+ i)))))
8104 (when (string-match "unicode\\|big\\|japanese" charset)
8105 (setq found t)))
8106 found))
8107
8108(defun gnus-summary-limit-to-predicate (predicate)
8109 "Limit to articles where PREDICATE returns non-nil.
8110PREDICATE will be called with the header structures of the
8111articles."
8112 (let ((articles nil)
8113 (case-fold-search t))
8114 (dolist (header gnus-newsgroup-headers)
8115 (when (funcall predicate header)
8116 (push (mail-header-number header) articles)))
8117 (gnus-summary-limit (nreverse articles))))
8118
7847(defun gnus-summary-limit-to-age (age &optional younger-p) 8119(defun gnus-summary-limit-to-age (age &optional younger-p)
7848 "Limit the summary buffer to articles that are older than (or equal) AGE days. 8120 "Limit the summary buffer to articles that are older than (or equal) AGE days.
7849If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to 8121If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
@@ -7862,10 +8134,9 @@ articles that are younger than AGE days."
7862 (if (numberp days) 8134 (if (numberp days)
7863 (progn 8135 (progn
7864 (setq days-got t) 8136 (setq days-got t)
7865 (if (< days 0) 8137 (when (< days 0)
7866 (progn 8138 (setq younger (not younger))
7867 (setq younger (not younger)) 8139 (setq days (* days -1))))
7868 (setq days (* days -1)))))
7869 (message "Please enter a number.") 8140 (message "Please enter a number.")
7870 (sleep-for 1))) 8141 (sleep-for 1)))
7871 (list days younger))) 8142 (list days younger)))
@@ -7950,6 +8221,81 @@ If ALL is non-nil, limit strictly to unread articles."
7950 gnus-duplicate-mark gnus-souped-mark) 8221 gnus-duplicate-mark gnus-souped-mark)
7951 'reverse))) 8222 'reverse)))
7952 8223
8224(defun gnus-summary-limit-to-headers (match &optional reverse)
8225 "Limit the summary buffer to articles that have headers that match MATCH.
8226If REVERSE (the prefix), limit to articles that don't match."
8227 (interactive "sMatch headers (regexp): \nP")
8228 (gnus-summary-limit-to-bodies match reverse t))
8229
8230(defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
8231 "Limit the summary buffer to articles that have bodies that match MATCH.
8232If REVERSE (the prefix), limit to articles that don't match."
8233 (interactive "sMatch body (regexp): \nP")
8234 (let ((articles nil)
8235 (gnus-select-article-hook nil) ;Disable hook.
8236 (gnus-article-prepare-hook nil)
8237 (gnus-use-article-prefetch nil)
8238 (gnus-keep-backlog nil)
8239 (gnus-break-pages nil)
8240 (gnus-summary-display-arrow nil)
8241 (gnus-updated-mode-lines nil)
8242 (gnus-auto-center-summary nil)
8243 (gnus-display-mime-function nil))
8244 (dolist (data gnus-newsgroup-data)
8245 (let (gnus-mark-article-hook)
8246 (gnus-summary-select-article t t nil (gnus-data-number data)))
8247 (save-excursion
8248 (set-buffer gnus-article-buffer)
8249 (article-goto-body)
8250 (let* ((case-fold-search t)
8251 (found (if headersp
8252 (re-search-backward match nil t)
8253 (re-search-forward match nil t))))
8254 (when (or (and found
8255 (not reverse))
8256 (and (not found)
8257 reverse))
8258 (push (gnus-data-number data) articles)))))
8259 (if (not articles)
8260 (message "No messages matched")
8261 (gnus-summary-limit articles)))
8262 (gnus-summary-position-point))
8263
8264(defun gnus-summary-limit-to-singletons (&optional threadsp)
8265 "Limit the summary buffer to articles that aren't part on any thread.
8266If THREADSP (the prefix), limit to articles that are in threads."
8267 (interactive "P")
8268 (let ((articles nil)
8269 thread-articles
8270 threads)
8271 (dolist (thread gnus-newsgroup-threads)
8272 (if (stringp (car thread))
8273 (dolist (thread (cdr thread))
8274 (push thread threads))
8275 (push thread threads)))
8276 (dolist (thread threads)
8277 (setq thread-articles (gnus-articles-in-thread thread))
8278 (when (or (and threadsp
8279 (> (length thread-articles) 1))
8280 (and (not threadsp)
8281 (= (length thread-articles) 1)))
8282 (setq articles (nconc thread-articles articles))))
8283 (if (not articles)
8284 (message "No messages matched")
8285 (gnus-summary-limit articles))
8286 (gnus-summary-position-point)))
8287
8288(defun gnus-summary-limit-to-replied (&optional unreplied)
8289 "Limit the summary buffer to replied articles.
8290If UNREPLIED (the prefix), limit to unreplied articles."
8291 (interactive "P")
8292 (if unreplied
8293 (gnus-summary-limit
8294 (gnus-set-difference gnus-newsgroup-articles
8295 gnus-newsgroup-replied))
8296 (gnus-summary-limit gnus-newsgroup-replied))
8297 (gnus-summary-position-point))
8298
7953(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) 8299(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
7954(make-obsolete 'gnus-summary-delete-marked-with 8300(make-obsolete 'gnus-summary-delete-marked-with
7955 'gnus-summary-limit-exclude-marks) 8301 'gnus-summary-limit-exclude-marks)
@@ -8035,6 +8381,14 @@ article."
8035 (gnus-message 3 "No dormant articles for this group") 8381 (gnus-message 3 "No dormant articles for this group")
8036 (gnus-summary-goto-subjects gnus-newsgroup-dormant)))) 8382 (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
8037 8383
8384(defun gnus-summary-insert-ticked-articles ()
8385 "Insert ticked articles for this group into the current buffer."
8386 (interactive)
8387 (let ((gnus-verbose (max 6 gnus-verbose)))
8388 (if (not gnus-newsgroup-marked)
8389 (gnus-message 3 "No ticked articles for this group")
8390 (gnus-summary-goto-subjects gnus-newsgroup-marked))))
8391
8038(defun gnus-summary-limit-include-dormant () 8392(defun gnus-summary-limit-include-dormant ()
8039 "Display all the hidden articles that are marked as dormant. 8393 "Display all the hidden articles that are marked as dormant.
8040Note that this command only works on a subset of the articles currently 8394Note that this command only works on a subset of the articles currently
@@ -8295,13 +8649,12 @@ fetch-old-headers verbiage, and so on."
8295 (and gnus-newsgroup-display 8649 (and gnus-newsgroup-display
8296 (not (funcall gnus-newsgroup-display))) 8650 (not (funcall gnus-newsgroup-display)))
8297 ;; Check NoCeM things. 8651 ;; Check NoCeM things.
8298 (if (and gnus-use-nocem 8652 (when (and gnus-use-nocem
8299 (gnus-nocem-unwanted-article-p 8653 (gnus-nocem-unwanted-article-p
8300 (mail-header-id (car thread)))) 8654 (mail-header-id (car thread))))
8301 (progn 8655 (setq gnus-newsgroup-unreads
8302 (setq gnus-newsgroup-unreads 8656 (delq number gnus-newsgroup-unreads))
8303 (delq number gnus-newsgroup-unreads)) 8657 t)))
8304 t))))
8305 ;; Nope, invisible article. 8658 ;; Nope, invisible article.
8306 0 8659 0
8307 ;; Ok, this article is to be visible, so we add it to the limit 8660 ;; Ok, this article is to be visible, so we add it to the limit
@@ -8513,8 +8866,7 @@ to guess what the document format is."
8513 (let* ((name (format "%s-%d" 8866 (let* ((name (format "%s-%d"
8514 (gnus-group-prefixed-name 8867 (gnus-group-prefixed-name
8515 gnus-newsgroup-name (list 'nndoc "")) 8868 gnus-newsgroup-name (list 'nndoc ""))
8516 (save-excursion 8869 (with-current-buffer gnus-summary-buffer
8517 (set-buffer gnus-summary-buffer)
8518 gnus-current-article))) 8870 gnus-current-article)))
8519 (ogroup gnus-newsgroup-name) 8871 (ogroup gnus-newsgroup-name)
8520 (params (append (gnus-info-params (gnus-get-info ogroup)) 8872 (params (append (gnus-info-params (gnus-get-info ogroup))
@@ -8572,12 +8924,11 @@ This will allow you to read digests and other similar
8572documents as newsgroups. 8924documents as newsgroups.
8573Obeys the standard process/prefix convention." 8925Obeys the standard process/prefix convention."
8574 (interactive "P") 8926 (interactive "P")
8575 (let* ((articles (gnus-summary-work-articles n)) 8927 (let* ((ogroup gnus-newsgroup-name)
8576 (ogroup gnus-newsgroup-name)
8577 (params (append (gnus-info-params (gnus-get-info ogroup)) 8928 (params (append (gnus-info-params (gnus-get-info ogroup))
8578 (list (cons 'to-group ogroup)))) 8929 (list (cons 'to-group ogroup))))
8579 article group egroup groups vgroup) 8930 group egroup groups vgroup)
8580 (while (setq article (pop articles)) 8931 (dolist (article (gnus-summary-work-articles n))
8581 (setq group (format "%s-%d" gnus-newsgroup-name article)) 8932 (setq group (format "%s-%d" gnus-newsgroup-name article))
8582 (gnus-summary-remove-process-mark article) 8933 (gnus-summary-remove-process-mark article)
8583 (when (gnus-summary-display-article article) 8934 (when (gnus-summary-display-article article)
@@ -8588,7 +8939,7 @@ Obeys the standard process/prefix convention."
8588 ;; the wrong guess. 8939 ;; the wrong guess.
8589 (message-narrow-to-head) 8940 (message-narrow-to-head)
8590 (goto-char (point-min)) 8941 (goto-char (point-min))
8591 (delete-matching-lines "^\\(Path\\):\\|^From ") 8942 (delete-matching-lines "^Path:\\|^From ")
8592 (widen) 8943 (widen)
8593 (if (setq egroup 8944 (if (setq egroup
8594 (gnus-group-read-ephemeral-group 8945 (gnus-group-read-ephemeral-group
@@ -8627,6 +8978,20 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch."
8627 (widen) 8978 (widen)
8628 (isearch-forward regexp-p)))) 8979 (isearch-forward regexp-p))))
8629 8980
8981(defun gnus-summary-repeat-search-article-forward ()
8982 "Repeat the previous search forwards."
8983 (interactive)
8984 (unless gnus-last-search-regexp
8985 (error "No previous search"))
8986 (gnus-summary-search-article-forward gnus-last-search-regexp))
8987
8988(defun gnus-summary-repeat-search-article-backward ()
8989 "Repeat the previous search backwards."
8990 (interactive)
8991 (unless gnus-last-search-regexp
8992 (error "No previous search"))
8993 (gnus-summary-search-article-forward gnus-last-search-regexp t))
8994
8630(defun gnus-summary-search-article-forward (regexp &optional backward) 8995(defun gnus-summary-search-article-forward (regexp &optional backward)
8631 "Search for an article containing REGEXP forward. 8996 "Search for an article containing REGEXP forward.
8632If BACKWARD, search backward instead." 8997If BACKWARD, search backward instead."
@@ -8929,8 +9294,7 @@ strokes are `C-u g'."
8929 (or (cdr (assq arg gnus-summary-show-article-charset-alist)) 9294 (or (cdr (assq arg gnus-summary-show-article-charset-alist))
8930 (mm-read-coding-system 9295 (mm-read-coding-system
8931 "View as charset: " ;; actually it is coding system. 9296 "View as charset: " ;; actually it is coding system.
8932 (save-excursion 9297 (with-current-buffer gnus-article-buffer
8933 (set-buffer gnus-article-buffer)
8934 (mm-detect-coding-region (point) (point-max)))))) 9298 (mm-detect-coding-region (point) (point-max))))))
8935 (gnus-newsgroup-ignored-charsets 'gnus-all)) 9299 (gnus-newsgroup-ignored-charsets 'gnus-all))
8936 (gnus-summary-select-article nil 'force) 9300 (gnus-summary-select-article nil 'force)
@@ -9054,8 +9418,8 @@ If ARG is a negative number, hide the unwanted header lines."
9054 9418
9055(defun gnus-summary-caesar-message (&optional arg) 9419(defun gnus-summary-caesar-message (&optional arg)
9056 "Caesar rotate the current article by 13. 9420 "Caesar rotate the current article by 13.
9057The numerical prefix specifies how many places to rotate each letter 9421With a non-numerical prefix, also rotate headers. A numerical
9058forward." 9422prefix specifies how many places to rotate each letter forward."
9059 (interactive "P") 9423 (interactive "P")
9060 (gnus-summary-select-article) 9424 (gnus-summary-select-article)
9061 (let ((mail-header-separator "")) 9425 (let ((mail-header-separator ""))
@@ -9064,14 +9428,38 @@ forward."
9064 (widen) 9428 (widen)
9065 (let ((start (window-start)) 9429 (let ((start (window-start))
9066 buffer-read-only) 9430 buffer-read-only)
9067 (message-caesar-buffer-body arg) 9431 (if (equal arg '(4))
9432 (message-caesar-buffer-body nil t)
9433 (message-caesar-buffer-body arg))
9068 (set-window-start (get-buffer-window (current-buffer)) start))))) 9434 (set-window-start (get-buffer-window (current-buffer)) start)))))
9069 ;; Create buttons and stuff... 9435 ;; Create buttons and stuff...
9070 (gnus-treat-article nil)) 9436 (gnus-treat-article nil))
9071 9437
9072(autoload 'unmorse-region "morse" 9438(defun gnus-summary-idna-message (&optional arg)
9073 "Convert morse coded text in region to ordinary ASCII text." 9439 "Decode IDNA encoded domain names in the current articles.
9074 t) 9440IDNA encoded domain names looks like `xn--bar'. If a string
9441remain unencoded after running this function, it is likely an
9442invalid IDNA string (`xn--bar' is invalid).
9443
9444You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
9445installed for this command to work."
9446 (interactive "P")
9447 (if (not (and (condition-case nil (require 'idna)
9448 (file-error))
9449 (mm-coding-system-p 'utf-8)
9450 (executable-find (symbol-value 'idna-program))))
9451 (gnus-message
9452 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
9453 (gnus-summary-select-article)
9454 (let ((mail-header-separator ""))
9455 (gnus-eval-in-buffer-window gnus-article-buffer
9456 (save-restriction
9457 (widen)
9458 (let ((start (window-start))
9459 buffer-read-only)
9460 (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
9461 (replace-match (idna-to-unicode (match-string 1))))
9462 (set-window-start (get-buffer-window (current-buffer)) start)))))))
9075 9463
9076(defun gnus-summary-morse-message (&optional arg) 9464(defun gnus-summary-morse-message (&optional arg)
9077 "Morse decode the current article." 9465 "Morse decode the current article."
@@ -9088,7 +9476,7 @@ forward."
9088 (when (message-goto-body) 9476 (when (message-goto-body)
9089 (gnus-narrow-to-body)) 9477 (gnus-narrow-to-body))
9090 (goto-char (point-min)) 9478 (goto-char (point-min))
9091 (while (re-search-forward "·" (point-max) t) 9479 (while (search-forward "·" (point-max) t)
9092 (replace-match ".")) 9480 (replace-match "."))
9093 (unmorse-region (point-min) (point-max)) 9481 (unmorse-region (point-min) (point-max))
9094 (widen) 9482 (widen)
@@ -9141,14 +9529,16 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9141 (let ((articles (gnus-summary-work-articles n)) 9529 (let ((articles (gnus-summary-work-articles n))
9142 (prefix (if (gnus-check-backend-function 9530 (prefix (if (gnus-check-backend-function
9143 'request-move-article gnus-newsgroup-name) 9531 'request-move-article gnus-newsgroup-name)
9144 (gnus-group-real-prefix gnus-newsgroup-name) 9532 (funcall gnus-move-group-prefix-function
9533 gnus-newsgroup-name)
9145 "")) 9534 ""))
9146 (names '((move "Move" "Moving") 9535 (names '((move "Move" "Moving")
9147 (copy "Copy" "Copying") 9536 (copy "Copy" "Copying")
9148 (crosspost "Crosspost" "Crossposting"))) 9537 (crosspost "Crosspost" "Crossposting")))
9149 (copy-buf (save-excursion 9538 (copy-buf (save-excursion
9150 (nnheader-set-temp-buffer " *copy article*"))) 9539 (nnheader-set-temp-buffer " *copy article*")))
9151 art-group to-method new-xref article to-groups) 9540 art-group to-method new-xref article to-groups
9541 articles-to-update-marks encoded)
9152 (unless (assq action names) 9542 (unless (assq action names)
9153 (error "Unknown action %s" action)) 9543 (error "Unknown action %s" action))
9154 ;; Read the newsgroup name. 9544 ;; Read the newsgroup name.
@@ -9166,15 +9556,27 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9166 (gnus-article-prepare-hook nil) 9556 (gnus-article-prepare-hook nil)
9167 (gnus-mark-article-hook nil)) 9557 (gnus-mark-article-hook nil))
9168 (gnus-summary-select-article nil nil nil (car articles)))) 9558 (gnus-summary-select-article nil nil nil (car articles))))
9169 (setq to-newsgroup 9559 (setq to-newsgroup (gnus-read-move-group-name
9170 (gnus-read-move-group-name 9560 (cadr (assq action names))
9171 (cadr (assq action names)) 9561 (symbol-value
9172 (symbol-value (intern (format "gnus-current-%s-group" action))) 9562 (intern (format "gnus-current-%s-group" action)))
9173 articles prefix)) 9563 articles prefix)
9174 (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) 9564 encoded to-newsgroup
9175 (setq to-method (or select-method 9565 to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
9176 (gnus-server-to-method 9566 (set (intern (format "gnus-current-%s-group" action))
9177 (gnus-group-method to-newsgroup)))) 9567 (mm-decode-coding-string
9568 to-newsgroup
9569 (gnus-group-name-charset to-method to-newsgroup))))
9570 (unless to-method
9571 (setq to-method (or select-method
9572 (gnus-server-to-method
9573 (gnus-group-method to-newsgroup)))))
9574 (setq to-newsgroup
9575 (or encoded
9576 (and to-newsgroup
9577 (mm-encode-coding-string
9578 to-newsgroup
9579 (gnus-group-name-charset to-method to-newsgroup)))))
9178 ;; Check the method we are to move this article to... 9580 ;; Check the method we are to move this article to...
9179 (unless (gnus-check-backend-function 9581 (unless (gnus-check-backend-function
9180 'request-accept-article (car to-method)) 9582 'request-accept-article (car to-method))
@@ -9183,7 +9585,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9183 (error "Can't open server %s" (car to-method))) 9585 (error "Can't open server %s" (car to-method)))
9184 (gnus-message 6 "%s to %s: %s..." 9586 (gnus-message 6 "%s to %s: %s..."
9185 (caddr (assq action names)) 9587 (caddr (assq action names))
9186 (or (car select-method) to-newsgroup) articles) 9588 (or (car select-method)
9589 (gnus-group-decoded-name to-newsgroup))
9590 articles)
9187 (while articles 9591 (while articles
9188 (setq article (pop articles)) 9592 (setq article (pop articles))
9189 (setq 9593 (setq
@@ -9193,20 +9597,30 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9193 ((eq action 'move) 9597 ((eq action 'move)
9194 ;; Remove this article from future suppression. 9598 ;; Remove this article from future suppression.
9195 (gnus-dup-unsuppress-article article) 9599 (gnus-dup-unsuppress-article article)
9196 (gnus-request-move-article 9600 (let* ((from-method (gnus-find-method-for-group
9197 article ; Article to move 9601 gnus-newsgroup-name))
9198 gnus-newsgroup-name ; From newsgroup 9602 (to-method (or select-method
9199 (nth 1 (gnus-find-method-for-group 9603 (gnus-find-method-for-group to-newsgroup)))
9200 gnus-newsgroup-name)) ; Server 9604 (move-is-internal (gnus-method-equal from-method to-method)))
9201 (list 'gnus-request-accept-article 9605 (gnus-request-move-article
9202 to-newsgroup (list 'quote select-method) 9606 article ; Article to move
9203 (not articles) t) ; Accept form 9607 gnus-newsgroup-name ; From newsgroup
9204 (not articles))) ; Only save nov last time 9608 (nth 1 (gnus-find-method-for-group
9609 gnus-newsgroup-name)) ; Server
9610 (list 'gnus-request-accept-article
9611 to-newsgroup (list 'quote select-method)
9612 (not articles) t) ; Accept form
9613 (not articles) ; Only save nov last time
9614 move-is-internal))) ; is this move internal?
9205 ;; Copy the article. 9615 ;; Copy the article.
9206 ((eq action 'copy) 9616 ((eq action 'copy)
9207 (save-excursion 9617 (save-excursion
9208 (set-buffer copy-buf) 9618 (set-buffer copy-buf)
9209 (when (gnus-request-article-this-buffer article gnus-newsgroup-name) 9619 (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
9620 (save-restriction
9621 (nnheader-narrow-to-headers)
9622 (dolist (hdr gnus-copy-article-ignored-headers)
9623 (message-remove-header hdr t)))
9210 (gnus-request-accept-article 9624 (gnus-request-accept-article
9211 to-newsgroup select-method (not articles) t)))) 9625 to-newsgroup select-method (not articles) t))))
9212 ;; Crosspost the article. 9626 ;; Crosspost the article.
@@ -9259,9 +9673,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9259 (t 9673 (t
9260 (let* ((pto-group (gnus-group-prefixed-name 9674 (let* ((pto-group (gnus-group-prefixed-name
9261 (car art-group) to-method)) 9675 (car art-group) to-method))
9262 (entry 9676 (info (gnus-get-info pto-group))
9263 (gnus-gethash pto-group gnus-newsrc-hashtb))
9264 (info (nth 2 entry))
9265 (to-group (gnus-info-group info)) 9677 (to-group (gnus-info-group info))
9266 to-marks) 9678 to-marks)
9267 ;; Update the group that has been moved to. 9679 ;; Update the group that has been moved to.
@@ -9353,7 +9765,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9353 (gnus-summary-goto-subject article) 9765 (gnus-summary-goto-subject article)
9354 (when (eq action 'move) 9766 (when (eq action 'move)
9355 (gnus-summary-mark-article article gnus-canceled-mark)))) 9767 (gnus-summary-mark-article article gnus-canceled-mark))))
9356 (gnus-summary-remove-process-mark article)) 9768 (push article articles-to-update-marks))
9769
9770 (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
9357 ;; Re-activate all groups that have been moved to. 9771 ;; Re-activate all groups that have been moved to.
9358 (save-excursion 9772 (save-excursion
9359 (set-buffer gnus-group-buffer) 9773 (set-buffer gnus-group-buffer)
@@ -9629,10 +10043,10 @@ confirmation before the articles are deleted."
9629 (unless (memq (car articles) not-deleted) 10043 (unless (memq (car articles) not-deleted)
9630 (gnus-summary-mark-article (car articles) gnus-canceled-mark)) 10044 (gnus-summary-mark-article (car articles) gnus-canceled-mark))
9631 (let* ((article (car articles)) 10045 (let* ((article (car articles))
9632 (id (mail-header-id (gnus-data-header 10046 (ghead (gnus-data-header
9633 (assoc article (gnus-data-list nil)))))) 10047 (assoc article (gnus-data-list nil)))))
9634 (run-hook-with-args 'gnus-summary-article-delete-hook 10048 (run-hook-with-args 'gnus-summary-article-delete-hook
9635 'delete id gnus-newsgroup-name nil 10049 'delete ghead gnus-newsgroup-name nil
9636 nil)) 10050 nil))
9637 (setq articles (cdr articles))) 10051 (setq articles (cdr articles)))
9638 (when not-deleted 10052 (when not-deleted
@@ -9705,7 +10119,16 @@ groups."
9705 (message-options message-options) 10119 (message-options message-options)
9706 (message-options-set-recipient) 10120 (message-options-set-recipient)
9707 (mail-parse-ignored-charsets 10121 (mail-parse-ignored-charsets
9708 ',gnus-newsgroup-ignored-charsets)) 10122 ',gnus-newsgroup-ignored-charsets)
10123 (rfc2047-header-encoding-alist
10124 ',(let ((charset (gnus-group-name-charset
10125 (gnus-find-method-for-group
10126 gnus-newsgroup-name)
10127 gnus-newsgroup-name)))
10128 (append (list (cons "Newsgroups" charset)
10129 (cons "Followup-To" charset)
10130 (cons "Xref" charset))
10131 rfc2047-header-encoding-alist))))
9709 ,(if (not raw) '(progn 10132 ,(if (not raw) '(progn
9710 (mml-to-mime) 10133 (mml-to-mime)
9711 (mml-destroy-buffers) 10134 (mml-destroy-buffers)
@@ -10013,8 +10436,7 @@ ARTICLE can also be a list of articles."
10013 ;; (article-number . line-number-in-body). 10436 ;; (article-number . line-number-in-body).
10014 (push 10437 (push
10015 (cons article 10438 (cons article
10016 (save-excursion 10439 (with-current-buffer gnus-article-buffer
10017 (set-buffer gnus-article-buffer)
10018 (count-lines 10440 (count-lines
10019 (min (point) 10441 (min (point)
10020 (save-excursion 10442 (save-excursion
@@ -10051,13 +10473,15 @@ the actual number of articles marked is returned."
10051 (gnus-summary-goto-subject article) 10473 (gnus-summary-goto-subject article)
10052 (gnus-summary-update-secondary-mark article))) 10474 (gnus-summary-update-secondary-mark article)))
10053 10475
10054(defun gnus-summary-remove-process-mark (article) 10476(defun gnus-summary-remove-process-mark (&rest articles)
10055 "Remove the process mark from ARTICLE and update the summary line." 10477 "Remove the process mark from ARTICLES and update the summary line."
10056 (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) 10478 (dolist (article articles)
10057 (when (gnus-summary-goto-subject article) 10479 (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
10058 (gnus-summary-show-thread) 10480 (when (gnus-summary-goto-subject article)
10059 (gnus-summary-goto-subject article) 10481 (gnus-summary-show-thread)
10060 (gnus-summary-update-secondary-mark article))) 10482 (gnus-summary-goto-subject article)
10483 (gnus-summary-update-secondary-mark article)))
10484 t)
10061 10485
10062(defun gnus-summary-set-saved-mark (article) 10486(defun gnus-summary-set-saved-mark (article)
10063 "Set the process mark on ARTICLE and update the summary line." 10487 "Set the process mark on ARTICLE and update the summary line."
@@ -10258,7 +10682,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
10258(defun gnus-summary-update-mark (mark type) 10682(defun gnus-summary-update-mark (mark type)
10259 (let ((forward (cdr (assq type gnus-summary-mark-positions))) 10683 (let ((forward (cdr (assq type gnus-summary-mark-positions)))
10260 (buffer-read-only nil)) 10684 (buffer-read-only nil))
10261 (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) 10685 (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
10262 (when forward 10686 (when forward
10263 (when (looking-at "\r") 10687 (when (looking-at "\r")
10264 (incf forward)) 10688 (incf forward))
@@ -10501,9 +10925,8 @@ even ticked and dormant ones."
10501 (goto-char (point-min)) 10925 (goto-char (point-min))
10502 (push gnus-newsgroup-limit gnus-newsgroup-limits) 10926 (push gnus-newsgroup-limit gnus-newsgroup-limits)
10503 (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit)) 10927 (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
10504 (mapcar (lambda (x) (push (mail-header-number x) 10928 (dolist (x headers)
10505 gnus-newsgroup-limit)) 10929 (push (mail-header-number x) gnus-newsgroup-limit))
10506 headers)
10507 (gnus-summary-prepare-unthreaded (nreverse headers)) 10930 (gnus-summary-prepare-unthreaded (nreverse headers))
10508 (goto-char (point-min)) 10931 (goto-char (point-min))
10509 (gnus-summary-position-point) 10932 (gnus-summary-position-point)
@@ -10628,6 +11051,15 @@ read."
10628 (gnus-summary-catchup all)) 11051 (gnus-summary-catchup all))
10629 (gnus-summary-next-group)) 11052 (gnus-summary-next-group))
10630 11053
11054(defun gnus-summary-catchup-and-goto-prev-group (&optional all)
11055 "Mark all articles in this group as read and select the previous group.
11056If given a prefix, mark all articles, unread as well as ticked, as
11057read."
11058 (interactive "P")
11059 (save-excursion
11060 (gnus-summary-catchup all))
11061 (gnus-summary-next-group nil nil t))
11062
10631;;; 11063;;;
10632;;; with article 11064;;; with article
10633;;; 11065;;;
@@ -10720,41 +11152,51 @@ is non-nil or the Subject: of both articles are the same."
10720 (error "The current newsgroup does not support article editing")) 11152 (error "The current newsgroup does not support article editing"))
10721 (unless (<= (length gnus-newsgroup-processable) 1) 11153 (unless (<= (length gnus-newsgroup-processable) 1)
10722 (error "No more than one article may be marked")) 11154 (error "No more than one article may be marked"))
10723 (save-window-excursion 11155 (let ((child (gnus-summary-article-number))
10724 (let ((gnus-article-buffer " *reparent*") 11156 ;; First grab the marked article, otherwise one line up.
10725 (current-article (gnus-summary-article-number)) 11157 (parent (if (not (null gnus-newsgroup-processable))
10726 ;; First grab the marked article, otherwise one line up. 11158 (car gnus-newsgroup-processable)
10727 (parent-article (if (not (null gnus-newsgroup-processable)) 11159 (save-excursion
10728 (car gnus-newsgroup-processable) 11160 (if (eq (forward-line -1) 0)
10729 (save-excursion 11161 (gnus-summary-article-number)
10730 (if (eq (forward-line -1) 0) 11162 (error "Beginning of summary buffer"))))))
10731 (gnus-summary-article-number) 11163 (gnus-summary-reparent-children parent (list child))))
10732 (error "Beginning of summary buffer")))))) 11164
10733 (unless (not (eq current-article parent-article)) 11165(defun gnus-summary-reparent-children (parent children)
10734 (error "An article may not be self-referential")) 11166 "Make PARENT the parent of CHILDREN.
10735 (let ((message-id (mail-header-id 11167When called interactively, PARENT is the current article and CHILDREN
10736 (gnus-summary-article-header parent-article)))) 11168are the process-marked articles."
10737 (unless (and message-id (not (equal message-id ""))) 11169 (interactive
10738 (error "No message-id in desired parent")) 11170 (list (gnus-summary-article-number)
10739 (gnus-with-article current-article 11171 (gnus-summary-work-articles nil)))
10740 (save-restriction 11172 (dolist (child children)
10741 (goto-char (point-min)) 11173 (save-window-excursion
10742 (message-narrow-to-head) 11174 (let ((gnus-article-buffer " *reparent*"))
10743 (if (re-search-forward "^References: " nil t) 11175 (unless (not (eq parent child))
10744 (progn 11176 (error "An article may not be self-referential"))
10745 (re-search-forward "^[^ \t]" nil t) 11177 (let ((message-id (mail-header-id
10746 (forward-line -1) 11178 (gnus-summary-article-header parent))))
10747 (end-of-line) 11179 (unless (and message-id (not (equal message-id "")))
10748 (insert " " message-id)) 11180 (error "No message-id in desired parent"))
10749 (insert "References: " message-id "\n")))) 11181 (gnus-with-article child
10750 (set-buffer gnus-summary-buffer) 11182 (save-restriction
10751 (gnus-summary-unmark-all-processable) 11183 (goto-char (point-min))
10752 (gnus-summary-update-article current-article) 11184 (message-narrow-to-head)
10753 (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) 11185 (if (re-search-forward "^References: " nil t)
11186 (progn
11187 (re-search-forward "^[^ \t]" nil t)
11188 (forward-line -1)
11189 (end-of-line)
11190 (insert " " message-id))
11191 (insert "References: " message-id "\n"))))
11192 (set-buffer gnus-summary-buffer)
11193 (gnus-summary-unmark-all-processable)
11194 (gnus-summary-update-article child)
11195 (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
10754 (gnus-summary-update-secondary-mark (cdr gnus-article-current))) 11196 (gnus-summary-update-secondary-mark (cdr gnus-article-current)))
10755 (gnus-summary-rethread-current) 11197 (gnus-summary-rethread-current)
10756 (gnus-message 3 "Article %d is now the child of article %d" 11198 (gnus-message 3 "Article %d is now the child of article %d"
10757 current-article parent-article))))) 11199 child parent))))))
10758 11200
10759(defun gnus-summary-toggle-threads (&optional arg) 11201(defun gnus-summary-toggle-threads (&optional arg)
10760 "Toggle showing conversation threads. 11202 "Toggle showing conversation threads.
@@ -10783,7 +11225,7 @@ Returns nil if no thread was there to be shown."
10783 (interactive) 11225 (interactive)
10784 (let ((buffer-read-only nil) 11226 (let ((buffer-read-only nil)
10785 (orig (point)) 11227 (orig (point))
10786 (end (gnus-point-at-eol)) 11228 (end (point-at-eol))
10787 ;; Leave point at bol 11229 ;; Leave point at bol
10788 (beg (progn (beginning-of-line) (point)))) 11230 (beg (progn (beginning-of-line) (point))))
10789 (prog1 11231 (prog1
@@ -10947,14 +11389,21 @@ taken."
10947 (while (gnus-summary-go-up-thread)) 11389 (while (gnus-summary-go-up-thread))
10948 (gnus-summary-article-number)) 11390 (gnus-summary-article-number))
10949 11391
11392(defun gnus-summary-expire-thread ()
11393 "Mark articles under current thread as expired."
11394 (interactive)
11395 (gnus-summary-kill-thread 0))
11396
10950(defun gnus-summary-kill-thread (&optional unmark) 11397(defun gnus-summary-kill-thread (&optional unmark)
10951 "Mark articles under current thread as read. 11398 "Mark articles under current thread as read.
10952If the prefix argument is positive, remove any kinds of marks. 11399If the prefix argument is positive, remove any kinds of marks.
11400If the prefix argument is zero, mark thread as expired.
10953If the prefix argument is negative, tick articles instead." 11401If the prefix argument is negative, tick articles instead."
10954 (interactive "P") 11402 (interactive "P")
10955 (when unmark 11403 (when unmark
10956 (setq unmark (prefix-numeric-value unmark))) 11404 (setq unmark (prefix-numeric-value unmark)))
10957 (let ((articles (gnus-summary-articles-in-thread))) 11405 (let ((articles (gnus-summary-articles-in-thread))
11406 (hide (or (null unmark) (= unmark 0))))
10958 (save-excursion 11407 (save-excursion
10959 ;; Expand the thread. 11408 ;; Expand the thread.
10960 (gnus-summary-show-thread) 11409 (gnus-summary-show-thread)
@@ -10965,15 +11414,17 @@ If the prefix argument is negative, tick articles instead."
10965 (gnus-summary-mark-article-as-read gnus-killed-mark)) 11414 (gnus-summary-mark-article-as-read gnus-killed-mark))
10966 ((> unmark 0) 11415 ((> unmark 0)
10967 (gnus-summary-mark-article-as-unread gnus-unread-mark)) 11416 (gnus-summary-mark-article-as-unread gnus-unread-mark))
11417 ((= unmark 0)
11418 (gnus-summary-mark-article-as-unread gnus-expirable-mark))
10968 (t 11419 (t
10969 (gnus-summary-mark-article-as-unread gnus-ticked-mark))) 11420 (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
10970 (setq articles (cdr articles)))) 11421 (setq articles (cdr articles))))
10971 ;; Hide killed subtrees. 11422 ;; Hide killed subtrees when hide is true.
10972 (and (null unmark) 11423 (and hide
10973 gnus-thread-hide-killed 11424 gnus-thread-hide-killed
10974 (gnus-summary-hide-thread)) 11425 (gnus-summary-hide-thread))
10975 ;; If marked as read, go to next unread subject. 11426 ;; If hide is t, go to next unread subject.
10976 (when (null unmark) 11427 (when hide
10977 ;; Go to next unread subject. 11428 ;; Go to next unread subject.
10978 (gnus-summary-next-subject 1 t))) 11429 (gnus-summary-next-subject 1 t)))
10979 (gnus-set-mode-line 'summary)) 11430 (gnus-set-mode-line 'summary))
@@ -10999,6 +11450,13 @@ Argument REVERSE means reverse order."
10999 (interactive "P") 11450 (interactive "P")
11000 (gnus-summary-sort 'author reverse)) 11451 (gnus-summary-sort 'author reverse))
11001 11452
11453(defun gnus-summary-sort-by-recipient (&optional reverse)
11454 "Sort the summary buffer by recipient name alphabetically.
11455If `case-fold-search' is non-nil, case of letters is ignored.
11456Argument REVERSE means reverse order."
11457 (interactive "P")
11458 (gnus-summary-sort 'recipient reverse))
11459
11002(defun gnus-summary-sort-by-subject (&optional reverse) 11460(defun gnus-summary-sort-by-subject (&optional reverse)
11003 "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. 11461 "Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
11004If `case-fold-search' is non-nil, case of letters is ignored. 11462If `case-fold-search' is non-nil, case of letters is ignored.
@@ -11287,46 +11745,51 @@ save those articles instead."
11287 (format "these %d articles" (length articles)) 11745 (format "these %d articles" (length articles))
11288 "this article"))) 11746 "this article")))
11289 (to-newsgroup 11747 (to-newsgroup
11290 (cond 11748 (let (active group)
11291 ((null split-name) 11749 (when (or (null split-name) (= 1 (length split-name)))
11292 (gnus-completing-read-with-default 11750 (setq active (gnus-make-hashtable (length gnus-active-hashtb)))
11293 default prom 11751 (mapatoms (lambda (symbol)
11294 gnus-active-hashtb 11752 (setq group (symbol-name symbol))
11295 'gnus-valid-move-group-p 11753 (when (string-match "[^\000-\177]" group)
11296 nil prefix 11754 (setq group (gnus-group-decoded-name group)))
11297 'gnus-group-history)) 11755 (set (intern group active) group))
11298 ((= 1 (length split-name)) 11756 gnus-active-hashtb))
11299 (gnus-completing-read-with-default 11757 (cond
11300 (car split-name) prom 11758 ((null split-name)
11301 gnus-active-hashtb 11759 (gnus-completing-read-with-default
11302 'gnus-valid-move-group-p 11760 default prom active 'gnus-valid-move-group-p nil prefix
11303 nil nil 11761 'gnus-group-history))
11304 'gnus-group-history)) 11762 ((= 1 (length split-name))
11305 (t 11763 (gnus-completing-read-with-default
11306 (gnus-completing-read-with-default 11764 (car split-name) prom active 'gnus-valid-move-group-p nil nil
11307 nil prom 11765 'gnus-group-history))
11308 (mapcar (lambda (el) (list el)) 11766 (t
11309 (nreverse split-name)) 11767 (gnus-completing-read-with-default
11310 nil nil nil 11768 nil prom (mapcar 'list (nreverse split-name)) nil nil nil
11311 'gnus-group-history)))) 11769 'gnus-group-history)))))
11312 (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) 11770 (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
11771 encoded)
11313 (when to-newsgroup 11772 (when to-newsgroup
11314 (if (or (string= to-newsgroup "") 11773 (if (or (string= to-newsgroup "")
11315 (string= to-newsgroup prefix)) 11774 (string= to-newsgroup prefix))
11316 (setq to-newsgroup default)) 11775 (setq to-newsgroup default))
11317 (unless to-newsgroup 11776 (unless to-newsgroup
11318 (error "No group name entered")) 11777 (error "No group name entered"))
11319 (or (gnus-active to-newsgroup) 11778 (setq encoded (mm-encode-coding-string
11320 (gnus-activate-group to-newsgroup nil nil to-method) 11779 to-newsgroup
11780 (gnus-group-name-charset to-method to-newsgroup)))
11781 (or (gnus-active encoded)
11782 (gnus-activate-group encoded nil nil to-method)
11321 (if (gnus-y-or-n-p (format "No such group: %s. Create it? " 11783 (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
11322 to-newsgroup)) 11784 to-newsgroup))
11323 (or (and (gnus-request-create-group to-newsgroup to-method) 11785 (or (and (gnus-request-create-group encoded to-method)
11324 (gnus-activate-group 11786 (gnus-activate-group encoded nil nil to-method)
11325 to-newsgroup nil nil to-method) 11787 (gnus-subscribe-group encoded))
11326 (gnus-subscribe-group to-newsgroup))
11327 (error "Couldn't create group %s" to-newsgroup))) 11788 (error "Couldn't create group %s" to-newsgroup)))
11328 (error "No such group: %s" to-newsgroup))) 11789 (error "No such group: %s" to-newsgroup))
11329 to-newsgroup)) 11790 encoded)))
11791
11792(defvar gnus-summary-save-parts-counter)
11330 11793
11331(defun gnus-summary-save-parts (type dir n &optional reverse) 11794(defun gnus-summary-save-parts (type dir n &optional reverse)
11332 "Save parts matching TYPE to DIR. 11795 "Save parts matching TYPE to DIR.
@@ -11350,7 +11813,8 @@ If REVERSE, save parts that do not match TYPE."
11350 (let ((handles (or gnus-article-mime-handles 11813 (let ((handles (or gnus-article-mime-handles
11351 (mm-dissect-buffer nil gnus-article-loose-mime) 11814 (mm-dissect-buffer nil gnus-article-loose-mime)
11352 (and gnus-article-emulate-mime 11815 (and gnus-article-emulate-mime
11353 (mm-uu-dissect))))) 11816 (mm-uu-dissect))))
11817 (gnus-summary-save-parts-counter 1))
11354 (when handles 11818 (when handles
11355 (gnus-summary-save-parts-1 type dir handles reverse) 11819 (gnus-summary-save-parts-1 type dir handles reverse)
11356 (unless gnus-article-mime-handles ;; Don't destroy this case. 11820 (unless gnus-article-mime-handles ;; Don't destroy this case.
@@ -11372,10 +11836,11 @@ If REVERSE, save parts that do not match TYPE."
11372 (mm-handle-disposition handle) 'filename) 11836 (mm-handle-disposition handle) 'filename)
11373 (mail-content-type-get 11837 (mail-content-type-get
11374 (mm-handle-type handle) 'name) 11838 (mm-handle-type handle) 'name)
11375 (concat gnus-newsgroup-name 11839 (format "%s.%d.%d" gnus-newsgroup-name
11376 "." (number-to-string 11840 (cdr gnus-article-current)
11377 (cdr gnus-article-current)))))) 11841 gnus-summary-save-parts-counter))))
11378 dir))) 11842 dir)))
11843 (incf gnus-summary-save-parts-counter)
11379 (unless (file-exists-p file) 11844 (unless (file-exists-p file)
11380 (mm-save-part-to-file handle file)))))) 11845 (mm-save-part-to-file handle file))))))
11381 11846
@@ -11414,7 +11879,7 @@ If REVERSE, save parts that do not match TYPE."
11414 (lambda (f) 11879 (lambda (f)
11415 (if (equal f " ") 11880 (if (equal f " ")
11416 f 11881 f
11417 (mm-quote-arg f))) 11882 (shell-quote-argument f)))
11418 files " "))))) 11883 files " ")))))
11419 (setq ps (cdr ps))))) 11884 (setq ps (cdr ps)))))
11420 (if (and gnus-view-pseudos (not not-view)) 11885 (if (and gnus-view-pseudos (not not-view))
@@ -11530,11 +11995,14 @@ If REVERSE, save parts that do not match TYPE."
11530 () ; Malformed head. 11995 () ; Malformed head.
11531 (unless (gnus-summary-article-sparse-p (mail-header-number header)) 11996 (unless (gnus-summary-article-sparse-p (mail-header-number header))
11532 (when (and (stringp id) 11997 (when (and (stringp id)
11533 (not (string= (gnus-group-real-name group) 11998 (or
11534 (car where)))) 11999 (not (string= (gnus-group-real-name group)
11535 ;; If we fetched by Message-ID and the article came 12000 (car where)))
11536 ;; from a different group, we fudge some bogus article 12001 (not (gnus-server-equal gnus-override-method
11537 ;; numbers for this article. 12002 (gnus-group-method group)))))
12003 ;; If we fetched by Message-ID and the article came from
12004 ;; a different group (or server), we fudge some bogus
12005 ;; article numbers for this article.
11538 (mail-header-set-number header gnus-reffed-article-number)) 12006 (mail-header-set-number header gnus-reffed-article-number))
11539 (save-excursion 12007 (save-excursion
11540 (set-buffer gnus-summary-buffer) 12008 (set-buffer gnus-summary-buffer)
@@ -11566,8 +12034,8 @@ If REVERSE, save parts that do not match TYPE."
11566 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. 12034 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
11567 (when gnus-summary-selected-face 12035 (when gnus-summary-selected-face
11568 (save-excursion 12036 (save-excursion
11569 (let* ((beg (gnus-point-at-bol)) 12037 (let* ((beg (point-at-bol))
11570 (end (gnus-point-at-eol)) 12038 (end (point-at-eol))
11571 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. 12039 ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
11572 (from (if (get-text-property beg gnus-mouse-face-prop) 12040 (from (if (get-text-property beg gnus-mouse-face-prop)
11573 beg 12041 beg
@@ -11616,7 +12084,7 @@ If REVERSE, save parts that do not match TYPE."
11616 12084
11617(defun gnus-summary-highlight-line () 12085(defun gnus-summary-highlight-line ()
11618 "Highlight current line according to `gnus-summary-highlight'." 12086 "Highlight current line according to `gnus-summary-highlight'."
11619 (let* ((beg (gnus-point-at-bol)) 12087 (let* ((beg (point-at-bol))
11620 (article (or (gnus-summary-article-number) gnus-current-article)) 12088 (article (or (gnus-summary-article-number) gnus-current-article))
11621 (score (or (cdr (assq article 12089 (score (or (cdr (assq article
11622 gnus-newsgroup-scored)) 12090 gnus-newsgroup-scored))
@@ -11632,7 +12100,7 @@ If REVERSE, save parts that do not match TYPE."
11632 (let ((face (funcall (gnus-summary-highlight-line-0)))) 12100 (let ((face (funcall (gnus-summary-highlight-line-0))))
11633 (unless (eq face (get-text-property beg 'face)) 12101 (unless (eq face (get-text-property beg 'face))
11634 (gnus-put-text-property-excluding-characters-with-faces 12102 (gnus-put-text-property-excluding-characters-with-faces
11635 beg (gnus-point-at-eol) 'face 12103 beg (point-at-eol) 'face
11636 (setq face (if (boundp face) (symbol-value face) face))) 12104 (setq face (if (boundp face) (symbol-value face) face)))
11637 (when gnus-summary-highlight-line-function 12105 (when gnus-summary-highlight-line-function
11638 (funcall gnus-summary-highlight-line-function article face)))))) 12106 (funcall gnus-summary-highlight-line-function article face))))))
@@ -11640,11 +12108,10 @@ If REVERSE, save parts that do not match TYPE."
11640(defun gnus-update-read-articles (group unread &optional compute) 12108(defun gnus-update-read-articles (group unread &optional compute)
11641 "Update the list of read articles in GROUP. 12109 "Update the list of read articles in GROUP.
11642UNREAD is a sorted list." 12110UNREAD is a sorted list."
11643 (let* ((active (or gnus-newsgroup-active (gnus-active group))) 12111 (let ((active (or gnus-newsgroup-active (gnus-active group)))
11644 (entry (gnus-gethash group gnus-newsrc-hashtb)) 12112 (info (gnus-get-info group))
11645 (info (nth 2 entry)) 12113 (prev 1)
11646 (prev 1) 12114 read)
11647 read)
11648 (if (or (not info) (not active)) 12115 (if (or (not info) (not active))
11649 ;; There is no info on this group if it was, in fact, 12116 ;; There is no info on this group if it was, in fact,
11650 ;; killed. Gnus stores no information on killed groups, so 12117 ;; killed. Gnus stores no information on killed groups, so
@@ -11712,8 +12179,7 @@ UNREAD is a sorted list."
11712 (dolist (buffer (buffer-list)) 12179 (dolist (buffer (buffer-list))
11713 (when (and (setq buffer (buffer-name buffer)) 12180 (when (and (setq buffer (buffer-name buffer))
11714 (string-match "Summary" buffer) 12181 (string-match "Summary" buffer)
11715 (save-excursion 12182 (with-current-buffer buffer
11716 (set-buffer buffer)
11717 ;; We check that this is, indeed, a summary buffer. 12183 ;; We check that this is, indeed, a summary buffer.
11718 (and (eq major-mode 'gnus-summary-mode) 12184 (and (eq major-mode 'gnus-summary-mode)
11719 ;; Also make sure this isn't bogus. 12185 ;; Also make sure this isn't bogus.
@@ -11774,7 +12240,7 @@ treated as multipart/mixed."
11774 (insert "Mime-Version: 1.0\n") 12240 (insert "Mime-Version: 1.0\n")
11775 (widen) 12241 (widen)
11776 (when (search-forward "\n--" nil t) 12242 (when (search-forward "\n--" nil t)
11777 (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) 12243 (let ((separator (buffer-substring (point) (point-at-eol))))
11778 (message-narrow-to-head) 12244 (message-narrow-to-head)
11779 (message-remove-header "Content-Type") 12245 (message-remove-header "Content-Type")
11780 (goto-char (point-max)) 12246 (goto-char (point-max))
@@ -11885,12 +12351,24 @@ returned."
11885 (when gnus-suppress-duplicates 12351 (when gnus-suppress-duplicates
11886 (gnus-dup-suppress-articles)) 12352 (gnus-dup-suppress-articles))
11887 12353
11888 ;; We might want to build some more threads first. 12354 (if (and gnus-fetch-old-headers
11889 (when (and gnus-fetch-old-headers 12355 (eq gnus-headers-retrieved-by 'nov))
11890 (eq gnus-headers-retrieved-by 'nov)) 12356 ;; We might want to build some more threads first.
11891 (if (eq gnus-fetch-old-headers 'invisible) 12357 (if (eq gnus-fetch-old-headers 'invisible)
11892 (gnus-build-all-threads) 12358 (gnus-build-all-threads)
11893 (gnus-build-old-threads))) 12359 (gnus-build-old-threads))
12360 ;; Mark the inserted articles that are unread as unread.
12361 (setq gnus-newsgroup-unreads
12362 (gnus-sorted-nunion
12363 gnus-newsgroup-unreads
12364 (gnus-sorted-nintersection
12365 (gnus-list-of-unread-articles gnus-newsgroup-name)
12366 articles)))
12367 ;; Mark the inserted articles as selected so that the information
12368 ;; of the marks having been changed by a user may be updated when
12369 ;; exiting this group. See `gnus-summary-update-info'.
12370 (dolist (art articles)
12371 (setq gnus-newsgroup-unselected (delq art gnus-newsgroup-unselected))))
11894 ;; Let the Gnus agent mark articles as read. 12372 ;; Let the Gnus agent mark articles as read.
11895 (when gnus-agent 12373 (when gnus-agent
11896 (gnus-agent-get-undownloaded-list)) 12374 (gnus-agent-get-undownloaded-list))
@@ -11950,8 +12428,7 @@ If ALL is a number, fetch this number of articles."
11950 (read-string 12428 (read-string
11951 (format 12429 (format
11952 "How many articles from %s (%s %d): " 12430 "How many articles from %s (%s %d): "
11953 (gnus-limit-string 12431 (gnus-group-decoded-name gnus-newsgroup-name)
11954 (gnus-group-decoded-name gnus-newsgroup-name) 35)
11955 (if initial "max" "default") 12432 (if initial "max" "default")
11956 len) 12433 len)
11957 (if initial 12434 (if initial
@@ -11994,7 +12471,7 @@ If ALL is a number, fetch this number of articles."
11994 (push i new) 12471 (push i new)
11995 (decf i)) 12472 (decf i))
11996 (if (not new) 12473 (if (not new)
11997 (message "No gnus is bad news.") 12474 (message "No gnus is bad news")
11998 (gnus-summary-insert-articles new) 12475 (gnus-summary-insert-articles new)
11999 (setq gnus-newsgroup-unreads 12476 (setq gnus-newsgroup-unreads
12000 (gnus-sorted-nunion gnus-newsgroup-unreads new)) 12477 (gnus-sorted-nunion gnus-newsgroup-unreads new))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 3d85d4ccf5c..a05520ea1fd 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -105,16 +105,16 @@ See Info node `(gnus)Formatting Variables'."
105 105
106(defun gnus-group-topic-name () 106(defun gnus-group-topic-name ()
107 "The name of the topic on the current line." 107 "The name of the topic on the current line."
108 (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) 108 (let ((topic (get-text-property (point-at-bol) 'gnus-topic)))
109 (and topic (symbol-name topic)))) 109 (and topic (symbol-name topic))))
110 110
111(defun gnus-group-topic-level () 111(defun gnus-group-topic-level ()
112 "The level of the topic on the current line." 112 "The level of the topic on the current line."
113 (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) 113 (get-text-property (point-at-bol) 'gnus-topic-level))
114 114
115(defun gnus-group-topic-unread () 115(defun gnus-group-topic-unread ()
116 "The number of unread articles in topic on the current line." 116 "The number of unread articles in topic on the current line."
117 (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) 117 (get-text-property (point-at-bol) 'gnus-topic-unread))
118 118
119(defun gnus-topic-unread (topic) 119(defun gnus-topic-unread (topic)
120 "Return the number of unread articles in TOPIC." 120 "Return the number of unread articles in TOPIC."
@@ -127,7 +127,7 @@ See Info node `(gnus)Formatting Variables'."
127 127
128(defun gnus-topic-visible-p () 128(defun gnus-topic-visible-p ()
129 "Return non-nil if the current topic is visible." 129 "Return non-nil if the current topic is visible."
130 (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) 130 (get-text-property (point-at-bol) 'gnus-topic-visible))
131 131
132(defun gnus-topic-articles-in-topic (entries) 132(defun gnus-topic-articles-in-topic (entries)
133 (let ((total 0) 133 (let ((total 0)
@@ -167,9 +167,11 @@ See Info node `(gnus)Formatting Variables'."
167 (list (completing-read "Go to topic: " 167 (list (completing-read "Go to topic: "
168 (mapcar 'list (gnus-topic-list)) 168 (mapcar 'list (gnus-topic-list))
169 nil t))) 169 nil t)))
170 (dolist (topic (gnus-current-topics topic)) 170 (let ((buffer-read-only nil))
171 (gnus-topic-goto-topic topic) 171 (dolist (topic (gnus-current-topics topic))
172 (gnus-topic-fold t)) 172 (unless (gnus-topic-goto-topic topic)
173 (gnus-topic-goto-missing-topic topic)
174 (gnus-topic-display-missing-topic topic))))
173 (gnus-topic-goto-topic topic)) 175 (gnus-topic-goto-topic topic))
174 176
175(defun gnus-current-topic () 177(defun gnus-current-topic ()
@@ -196,9 +198,7 @@ If TOPIC, start with that topic."
196 198
197(defun gnus-group-active-topic-p () 199(defun gnus-group-active-topic-p ()
198 "Say whether the current topic comes from the active topics." 200 "Say whether the current topic comes from the active topics."
199 (save-excursion 201 (get-text-property (point-at-bol) 'gnus-active))
200 (beginning-of-line)
201 (get-text-property (point) 'gnus-active)))
202 202
203(defun gnus-topic-find-groups (topic &optional level all lowest recursive) 203(defun gnus-topic-find-groups (topic &optional level all lowest recursive)
204 "Return entries for all visible groups in TOPIC. 204 "Return entries for all visible groups in TOPIC.
@@ -210,7 +210,7 @@ If RECURSIVE is t, return groups in its subtopics too."
210 ;; We go through the newsrc to look for matches. 210 ;; We go through the newsrc to look for matches.
211 (while groups 211 (while groups
212 (when (setq group (pop groups)) 212 (when (setq group (pop groups))
213 (setq entry (gnus-gethash group gnus-newsrc-hashtb) 213 (setq entry (gnus-group-entry group)
214 info (nth 2 entry) 214 info (nth 2 entry)
215 params (gnus-info-params info) 215 params (gnus-info-params info)
216 active (gnus-active group) 216 active (gnus-active group)
@@ -244,13 +244,12 @@ If RECURSIVE is t, return groups in its subtopics too."
244 (when recursive 244 (when recursive
245 (if (eq recursive t) 245 (if (eq recursive t)
246 (setq recursive (cdr (gnus-topic-find-topology topic)))) 246 (setq recursive (cdr (gnus-topic-find-topology topic))))
247 (mapcar (lambda (topic-topology) 247 (dolist (topic-topology (cdr recursive))
248 (setq visible-groups 248 (setq visible-groups
249 (nconc visible-groups 249 (nconc visible-groups
250 (gnus-topic-find-groups 250 (gnus-topic-find-groups
251 (caar topic-topology) 251 (caar topic-topology)
252 level all lowest topic-topology)))) 252 level all lowest topic-topology)))))
253 (cdr recursive)))
254 visible-groups)) 253 visible-groups))
255 254
256(defun gnus-topic-goto-previous-topic (n) 255(defun gnus-topic-goto-previous-topic (n)
@@ -351,7 +350,7 @@ If RECURSIVE is t, return groups in its subtopics too."
351 (setq topology gnus-topic-topology 350 (setq topology gnus-topic-topology
352 gnus-tmp-topics nil)) 351 gnus-tmp-topics nil))
353 (push (caar topology) gnus-tmp-topics) 352 (push (caar topology) gnus-tmp-topics)
354 (mapcar 'gnus-topic-list (cdr topology)) 353 (mapc 'gnus-topic-list (cdr topology))
355 gnus-tmp-topics) 354 gnus-tmp-topics)
356 355
357;;; Topic parameter jazz 356;;; Topic parameter jazz
@@ -378,39 +377,50 @@ If RECURSIVE is t, return groups in its subtopics too."
378 (format "(gnus-topic-set-parameters %S '%S)" topic parameters)))) 377 (format "(gnus-topic-set-parameters %S '%S)" topic parameters))))
379 378
380(defun gnus-group-topic-parameters (group) 379(defun gnus-group-topic-parameters (group)
381 "Compute the group parameters for GROUP taking into account inheritance from topics." 380 "Compute the group parameters for GROUP in topic mode.
381Possibly inherit parameters from topics above GROUP."
382 (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) 382 (let ((params-list (copy-sequence (gnus-group-get-parameter group))))
383 (save-excursion 383 (save-excursion
384 (nconc params-list 384 (gnus-topic-hierarchical-parameters
385 (gnus-topic-hierarchical-parameters 385 ;; First we try to go to the group within the group buffer and find the
386 ;; First we try to go to the group within the group 386 ;; topic for the group that way. This hopefully copes well with groups
387 ;; buffer and find the topic for the group that way. 387 ;; that are in more than one topic. Failing that (i.e. when the group
388 ;; This hopefully copes well with groups that are in 388 ;; isn't visible in the group buffer) we find a topic for the group via
389 ;; more than one topic. Failing that (i.e. when the 389 ;; gnus-group-topic.
390 ;; group isn't visible in the group buffer) we find a 390 (or (and (gnus-group-goto-group group)
391 ;; topic for the group via gnus-group-topic. 391 (gnus-current-topic))
392 (or (and (gnus-group-goto-group group) 392 (gnus-group-topic group))
393 (gnus-current-topic)) 393 params-list))))
394 (gnus-group-topic group))))))) 394
395 395(defun gnus-topic-hierarchical-parameters (topic &optional group-params-list)
396(defun gnus-topic-hierarchical-parameters (topic) 396 "Compute the topic parameters for TOPIC.
397 "Return a topic list computed for TOPIC." 397Possibly inherit parameters from topics above TOPIC.
398 (let ((topics (gnus-current-topics topic)) 398If optional argument GROUP-PARAMS-LIST is non-nil, use it as the basis for
399 params-list param out params) 399inheritance."
400 (while topics 400 (let ((params-list
401 (push (gnus-topic-parameters (pop topics)) params-list)) 401 ;; We probably have lots of nil elements here, so we remove them.
402 ;; We probably have lots of nil elements here, so 402 ;; Probably faster than doing this "properly".
403 ;; we remove them. Probably faster than doing this "properly". 403 (delq nil (cons group-params-list
404 (setq params-list (delq nil params-list)) 404 (mapcar 'gnus-topic-parameters
405 (gnus-current-topics topic)))))
406 param out params)
405 ;; Now we have all the parameters, so we go through them 407 ;; Now we have all the parameters, so we go through them
406 ;; and do inheritance in the obvious way. 408 ;; and do inheritance in the obvious way.
407 (while (setq params (pop params-list)) 409 (let (posting-style)
408 (while (setq param (pop params)) 410 (while (setq params (pop params-list))
409 (when (atom param) 411 (while (setq param (pop params))
410 (setq param (cons param t))) 412 (when (atom param)
411 ;; Override any old versions of this param. 413 (setq param (cons param t)))
412 (gnus-pull (car param) out) 414 (cond ((eq (car param) 'posting-style)
413 (push param out))) 415 (let ((param (cdr param))
416 elt)
417 (while (setq elt (pop param))
418 (unless (assoc (car elt) posting-style)
419 (push elt posting-style)))))
420 (t
421 (unless (assq (car param) out)
422 (push param out))))))
423 (and posting-style (push (cons 'posting-style posting-style) out)))
414 ;; Return the resulting parameter list. 424 ;; Return the resulting parameter list.
415 out)) 425 out))
416 426
@@ -465,7 +475,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
465 (gnus-make-hashtable-from-killed)) 475 (gnus-make-hashtable-from-killed))
466 (gnus-group-prepare-flat-list-dead 476 (gnus-group-prepare-flat-list-dead
467 (gnus-remove-if (lambda (group) 477 (gnus-remove-if (lambda (group)
468 (or (gnus-gethash group gnus-newsrc-hashtb) 478 (or (gnus-group-entry group)
469 (gnus-gethash group gnus-killed-hashtb))) 479 (gnus-gethash group gnus-killed-hashtb)))
470 not-in-list) 480 not-in-list)
471 gnus-level-killed ?K regexp))) 481 gnus-level-killed ?K regexp)))
@@ -727,6 +737,9 @@ articles in the topic and its subtopics."
727 (not (gnus-topic-goto-missing-topic (caadr parent)))) 737 (not (gnus-topic-goto-missing-topic (caadr parent))))
728 (gnus-topic-display-missing-topic (caadr parent)))) 738 (gnus-topic-display-missing-topic (caadr parent))))
729 (gnus-topic-goto-missing-topic topic) 739 (gnus-topic-goto-missing-topic topic)
740 ;; Skip past all groups in the topic we're in.
741 (while (gnus-group-group-name)
742 (forward-line 1))
730 (let* ((top (gnus-topic-find-topology topic)) 743 (let* ((top (gnus-topic-find-topology topic))
731 (children (cddr top)) 744 (children (cddr top))
732 (type (cadr top)) 745 (type (cadr top))
@@ -848,8 +861,7 @@ articles in the topic and its subtopics."
848 (pop topics))) 861 (pop topics)))
849 ;; Go through all living groups and make sure that 862 ;; Go through all living groups and make sure that
850 ;; they belong to some topic. 863 ;; they belong to some topic.
851 (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) 864 (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist)))
852 gnus-topic-alist)))
853 (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) 865 (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
854 (newsrc (cdr gnus-newsrc-alist)) 866 (newsrc (cdr gnus-newsrc-alist))
855 group) 867 group)
@@ -863,7 +875,7 @@ articles in the topic and its subtopics."
863 (while (setq topic (pop alist)) 875 (while (setq topic (pop alist))
864 (while (cdr topic) 876 (while (cdr topic)
865 (if (and (cadr topic) 877 (if (and (cadr topic)
866 (gnus-gethash (cadr topic) gnus-newsrc-hashtb)) 878 (gnus-group-entry (cadr topic)))
867 (setq topic (cdr topic)) 879 (setq topic (cdr topic))
868 (setcdr topic (cddr topic))))))) 880 (setcdr topic (cddr topic)))))))
869 881
@@ -893,7 +905,7 @@ articles in the topic and its subtopics."
893 (let ((topic-name (pop topic)) 905 (let ((topic-name (pop topic))
894 group filtered-topic) 906 group filtered-topic)
895 (while (setq group (pop topic)) 907 (while (setq group (pop topic))
896 (when (and (or (gnus-gethash group gnus-active-hashtb) 908 (when (and (or (gnus-active group)
897 (gnus-info-method (gnus-get-info group))) 909 (gnus-info-method (gnus-get-info group)))
898 (not (gnus-gethash group gnus-killed-hashtb))) 910 (not (gnus-gethash group gnus-killed-hashtb)))
899 (push group filtered-topic))) 911 (push group filtered-topic)))
@@ -1142,7 +1154,7 @@ articles in the topic and its subtopics."
1142 (when (gnus-visual-p 'topic-menu 'menu) 1154 (when (gnus-visual-p 'topic-menu 'menu)
1143 (gnus-topic-make-menu-bar)) 1155 (gnus-topic-make-menu-bar))
1144 (gnus-set-format 'topic t) 1156 (gnus-set-format 'topic t)
1145 (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) 1157 (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
1146 (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) 1158 (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
1147 (set (make-local-variable 'gnus-group-prepare-function) 1159 (set (make-local-variable 'gnus-group-prepare-function)
1148 'gnus-group-prepare-topics) 1160 'gnus-group-prepare-topics)
@@ -1297,15 +1309,13 @@ If COPYP, copy the groups instead."
1297 entry) 1309 entry)
1298 (if (and (not groups) (not copyp) start-topic) 1310 (if (and (not groups) (not copyp) start-topic)
1299 (gnus-topic-move start-topic topic) 1311 (gnus-topic-move start-topic topic)
1300 (mapcar 1312 (dolist (g groups)
1301 (lambda (g) 1313 (gnus-group-remove-mark g use-marked)
1302 (gnus-group-remove-mark g use-marked) 1314 (when (and
1303 (when (and 1315 (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
1304 (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) 1316 (not copyp))
1305 (not copyp)) 1317 (setcdr entry (gnus-delete-first g (cdr entry))))
1306 (setcdr entry (gnus-delete-first g (cdr entry)))) 1318 (nconc topicl (list g)))
1307 (nconc topicl (list g)))
1308 groups)
1309 (gnus-topic-enter-dribble) 1319 (gnus-topic-enter-dribble)
1310 (if start-group 1320 (if start-group
1311 (gnus-group-goto-group start-group) 1321 (gnus-group-goto-group start-group)
@@ -1318,7 +1328,7 @@ If COPYP, copy the groups instead."
1318 (let ((use-marked (and (not n) (not (gnus-region-active-p)) 1328 (let ((use-marked (and (not n) (not (gnus-region-active-p))
1319 gnus-group-marked t)) 1329 gnus-group-marked t))
1320 (groups (gnus-group-process-prefix n))) 1330 (groups (gnus-group-process-prefix n)))
1321 (mapcar 1331 (mapc
1322 (lambda (group) 1332 (lambda (group)
1323 (gnus-group-remove-mark group use-marked) 1333 (gnus-group-remove-mark group use-marked)
1324 (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) 1334 (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
@@ -1735,9 +1745,7 @@ If REVERSE, reverse the sorting order."
1735 (if (gnus-topic-find-topology to current-top 0);; Don't care the level 1745 (if (gnus-topic-find-topology to current-top 0);; Don't care the level
1736 (error "Can't move `%s' to its sub-level" current)) 1746 (error "Can't move `%s' to its sub-level" current))
1737 (gnus-topic-find-topology current nil nil 'delete) 1747 (gnus-topic-find-topology current nil nil 'delete)
1738 (while (cdr to-top) 1748 (setcdr (last to-top) (list current-top))
1739 (setq to-top (cdr to-top)))
1740 (setcdr to-top (list current-top))
1741 (gnus-topic-enter-dribble) 1749 (gnus-topic-enter-dribble)
1742 (gnus-group-list-groups) 1750 (gnus-group-list-groups)
1743 (gnus-topic-goto-topic current))) 1751 (gnus-topic-goto-topic current)))
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 47106a49aa5..855b527b883 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -50,7 +50,6 @@
50 50
51(require 'gnus-util) 51(require 'gnus-util)
52(require 'gnus) 52(require 'gnus)
53(require 'custom)
54 53
55(defgroup gnus-undo nil 54(defgroup gnus-undo nil
56 "Undoing in Gnus buffers." 55 "Undoing in Gnus buffers."
@@ -113,7 +112,7 @@
113 ;; Set up the menu. 112 ;; Set up the menu.
114 (when (gnus-visual-p 'undo-menu 'menu) 113 (when (gnus-visual-p 'undo-menu 'menu)
115 (gnus-undo-make-menu-bar)) 114 (gnus-undo-make-menu-bar))
116 (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) 115 (add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
117 (gnus-make-local-hook 'post-command-hook) 116 (gnus-make-local-hook 'post-command-hook)
118 (add-hook 'post-command-hook 'gnus-undo-boundary nil t) 117 (add-hook 'post-command-hook 'gnus-undo-boundary nil t)
119 (gnus-run-hooks 'gnus-undo-mode-hook))) 118 (gnus-run-hooks 'gnus-undo-mode-hook)))
@@ -187,8 +186,7 @@ A numeric argument serves as a repeat count."
187 (error "Nothing further to undo")) 186 (error "Nothing further to undo"))
188 (setq gnus-undo-actions (delq action gnus-undo-actions)) 187 (setq gnus-undo-actions (delq action gnus-undo-actions))
189 (setq gnus-undo-boundary t) 188 (setq gnus-undo-boundary t)
190 (while action 189 (mapc 'funcall action)))
191 (funcall (pop action)))))
192 190
193(provide 'gnus-undo) 191(provide 'gnus-undo)
194 192
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 3d3e4148c2d..cf174d90ac8 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -31,11 +31,10 @@
31;; Gnus first. 31;; Gnus first.
32 32
33;; [Unfortunately, it does depend on other parts of Gnus, e.g. the 33;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
34;; autoloads below...] 34;; autoloads and defvars below...]
35 35
36;;; Code: 36;;; Code:
37 37
38(require 'custom)
39(eval-when-compile 38(eval-when-compile
40 (require 'cl) 39 (require 'cl)
41 ;; Fixme: this should be a gnus variable, not nnmail-. 40 ;; Fixme: this should be a gnus variable, not nnmail-.
@@ -67,7 +66,7 @@
67 ;; (replace-in-string "foo" "/*$" "/") 66 ;; (replace-in-string "foo" "/*$" "/")
68 ;; (replace-in-string "xe" "\\(x\\)?" "") 67 ;; (replace-in-string "xe" "\\(x\\)?" "")
69 ((fboundp 'replace-regexp-in-string) 68 ((fboundp 'replace-regexp-in-string)
70 (defun gnus-replace-in-string (string regexp newtext &optional literal) 69 (defun gnus-replace-in-string (string regexp newtext &optional literal)
71 "Replace all matches for REGEXP with NEWTEXT in STRING. 70 "Replace all matches for REGEXP with NEWTEXT in STRING.
72If LITERAL is non-nil, insert NEWTEXT literally. Return a new 71If LITERAL is non-nil, insert NEWTEXT literally. Return a new
73string containing the replacements. 72string containing the replacements.
@@ -75,25 +74,7 @@ string containing the replacements.
75This is a compatibility function for different Emacsen." 74This is a compatibility function for different Emacsen."
76 (replace-regexp-in-string regexp newtext string nil literal))) 75 (replace-regexp-in-string regexp newtext string nil literal)))
77 ((fboundp 'replace-in-string) 76 ((fboundp 'replace-in-string)
78 (defalias 'gnus-replace-in-string 'replace-in-string)) 77 (defalias 'gnus-replace-in-string 'replace-in-string))))
79 (t
80 (defun gnus-replace-in-string (string regexp newtext &optional literal)
81 "Replace all matches for REGEXP with NEWTEXT in STRING.
82If LITERAL is non-nil, insert NEWTEXT literally. Return a new
83string containing the replacements.
84
85This is a compatibility function for different Emacsen."
86 (let ((start 0) tail)
87 (while (string-match regexp string start)
88 (setq tail (- (length string) (match-end 0)))
89 (setq string (replace-match newtext nil literal string))
90 (setq start (- (length string) tail))))
91 string))))
92
93;;; bring in the netrc functions as aliases
94(defalias 'gnus-netrc-get 'netrc-get)
95(defalias 'gnus-netrc-machine 'netrc-machine)
96(defalias 'gnus-parse-netrc 'netrc-parse)
97 78
98(defun gnus-boundp (variable) 79(defun gnus-boundp (variable)
99 "Return non-nil if VARIABLE is bound and non-nil." 80 "Return non-nil if VARIABLE is bound and non-nil."
@@ -128,15 +109,6 @@ This is a compatibility function for different Emacsen."
128 (set symbol nil)) 109 (set symbol nil))
129 symbol)) 110 symbol))
130 111
131;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
132;; to limit the length of a string. This function is necessary since
133;; `(substr "abc" 0 30)' pukes with "Args out of range".
134;; Fixme: Why not `truncate-string-to-width'?
135(defsubst gnus-limit-string (str width)
136 (if (> (length str) width)
137 (substring str 0 width)
138 str))
139
140(defsubst gnus-goto-char (point) 112(defsubst gnus-goto-char (point)
141 (and point (goto-char point))) 113 (and point (goto-char point)))
142 114
@@ -146,16 +118,6 @@ This is a compatibility function for different Emacsen."
146 (funcall (if (stringp buffer) 'get-buffer 'buffer-name) 118 (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
147 buffer)))) 119 buffer))))
148 120
149(defalias 'gnus-point-at-bol
150 (if (fboundp 'point-at-bol)
151 'point-at-bol
152 'line-beginning-position))
153
154(defalias 'gnus-point-at-eol
155 (if (fboundp 'point-at-eol)
156 'point-at-eol
157 'line-end-position))
158
159;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and 121;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
160;; XEmacs. In Emacs we don't need to call `make-local-hook' first. 122;; XEmacs. In Emacs we don't need to call `make-local-hook' first.
161;; It's harmless, though, so the main purpose of this alias is to shut 123;; It's harmless, though, so the main purpose of this alias is to shut
@@ -180,7 +142,7 @@ This is a compatibility function for different Emacsen."
180 142
181;; Delete the current line (and the next N lines). 143;; Delete the current line (and the next N lines).
182(defmacro gnus-delete-line (&optional n) 144(defmacro gnus-delete-line (&optional n)
183 `(delete-region (gnus-point-at-bol) 145 `(delete-region (point-at-bol)
184 (progn (forward-line ,(or n 1)) (point)))) 146 (progn (forward-line ,(or n 1)) (point))))
185 147
186(defun gnus-byte-code (func) 148(defun gnus-byte-code (func)
@@ -235,8 +197,7 @@ is slower."
235 "Return the value of the header FIELD of current article." 197 "Return the value of the header FIELD of current article."
236 (save-excursion 198 (save-excursion
237 (save-restriction 199 (save-restriction
238 (let ((case-fold-search t) 200 (let ((inhibit-point-motion-hooks t))
239 (inhibit-point-motion-hooks t))
240 (nnheader-narrow-to-headers) 201 (nnheader-narrow-to-headers)
241 (message-fetch-field field))))) 202 (message-fetch-field field)))))
242 203
@@ -248,7 +209,7 @@ is slower."
248 209
249(defun gnus-goto-colon () 210(defun gnus-goto-colon ()
250 (beginning-of-line) 211 (beginning-of-line)
251 (let ((eol (gnus-point-at-eol))) 212 (let ((eol (point-at-eol)))
252 (goto-char (or (text-property-any (point) eol 'gnus-position t) 213 (goto-char (or (text-property-any (point) eol 'gnus-position t)
253 (search-forward ":" eol t) 214 (search-forward ":" eol t)
254 (point))))) 215 (point)))))
@@ -263,12 +224,15 @@ is slower."
263 224
264(defun gnus-remove-text-with-property (prop) 225(defun gnus-remove-text-with-property (prop)
265 "Delete all text in the current buffer with text property PROP." 226 "Delete all text in the current buffer with text property PROP."
266 (save-excursion 227 (let ((start (point-min))
267 (goto-char (point-min)) 228 end)
268 (while (not (eobp)) 229 (unless (get-text-property start prop)
269 (while (get-text-property (point) prop) 230 (setq start (next-single-property-change start prop)))
270 (delete-char 1)) 231 (while start
271 (goto-char (next-single-property-change (point) prop nil (point-max)))))) 232 (setq end (text-property-any start (point-max) prop nil))
233 (delete-region start (or end (point-max)))
234 (setq start (when end
235 (next-single-property-change start prop))))))
272 236
273(defun gnus-newsgroup-directory-form (newsgroup) 237(defun gnus-newsgroup-directory-form (newsgroup)
274 "Make hierarchical directory name from NEWSGROUP name." 238 "Make hierarchical directory name from NEWSGROUP name."
@@ -501,6 +465,79 @@ jabbering all the time."
501 :group 'gnus-start 465 :group 'gnus-start
502 :type 'integer) 466 :type 'integer)
503 467
468(defcustom gnus-add-timestamp-to-message nil
469 "Non-nil means add timestamps to messages that Gnus issues.
470If it is `log', add timestamps to only the messages that go into the
471\"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer).
472If it is neither nil nor `log', add timestamps not only to log messages
473but also to the ones displayed in the echo area."
474 :version "23.0" ;; No Gnus
475 :group 'gnus-various
476 :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
477 (const :tag "Logged messages only" log)
478 (sexp :tag "All messages"
479 :match (lambda (widget value) value)
480 :value t)
481 (const :tag "No timestamp" nil)))
482
483(eval-when-compile
484 (defmacro gnus-message-with-timestamp-1 (format-string args)
485 (let ((timestamp '((format-time-string "%Y%m%dT%H%M%S" time)
486 "." (format "%03d" (/ (nth 2 time) 1000)) "> ")))
487 (if (featurep 'xemacs)
488 `(let (str time)
489 (if (or (and (null ,format-string) (null ,args))
490 (progn
491 (setq str (apply 'format ,format-string ,args))
492 (zerop (length str))))
493 (prog1
494 (and ,format-string str)
495 (clear-message nil))
496 (cond ((eq gnus-add-timestamp-to-message 'log)
497 (setq time (current-time))
498 (display-message 'no-log str)
499 (log-message 'message (concat ,@timestamp str)))
500 (gnus-add-timestamp-to-message
501 (setq time (current-time))
502 (display-message 'message (concat ,@timestamp str)))
503 (t
504 (display-message 'message str))))
505 str)
506 `(let (str time)
507 (cond ((eq gnus-add-timestamp-to-message 'log)
508 (setq str (let (message-log-max)
509 (apply 'message ,format-string ,args)))
510 (when (and message-log-max
511 (> message-log-max 0)
512 (/= (length str) 0))
513 (setq time (current-time))
514 (with-current-buffer (get-buffer-create "*Messages*")
515 (goto-char (point-max))
516 (insert ,@timestamp str "\n")
517 (forward-line (- message-log-max))
518 (delete-region (point-min) (point))
519 (goto-char (point-max))))
520 str)
521 (gnus-add-timestamp-to-message
522 (if (or (and (null ,format-string) (null ,args))
523 (progn
524 (setq str (apply 'format ,format-string ,args))
525 (zerop (length str))))
526 (prog1
527 (and ,format-string str)
528 (message nil))
529 (setq time (current-time))
530 (message "%s" (concat ,@timestamp str))
531 str))
532 (t
533 (apply 'message ,format-string ,args))))))))
534
535(defun gnus-message-with-timestamp (format-string &rest args)
536 "Display message with timestamp. Arguments are the same as `message'.
537The `gnus-add-timestamp-to-message' variable controls how to add
538timestamp to message."
539 (gnus-message-with-timestamp-1 format-string args))
540
504(defun gnus-message (level &rest args) 541(defun gnus-message (level &rest args)
505 "If LEVEL is lower than `gnus-verbose' print ARGS using `message'. 542 "If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
506 543
@@ -509,7 +546,9 @@ Guideline for numbers:
509that take a long time, 7 - not very important messages on stuff, 9 - messages 546that take a long time, 7 - not very important messages on stuff, 9 - messages
510inside loops." 547inside loops."
511 (if (<= level gnus-verbose) 548 (if (<= level gnus-verbose)
512 (apply 'message args) 549 (if gnus-add-timestamp-to-message
550 (apply 'gnus-message-with-timestamp args)
551 (apply 'message args))
513 ;; We have to do this format thingy here even if the result isn't 552 ;; We have to do this format thingy here even if the result isn't
514 ;; shown - the return value has to be the same as the return value 553 ;; shown - the return value has to be the same as the return value
515 ;; from `message'. 554 ;; from `message'.
@@ -530,12 +569,23 @@ ARGS are passed to `message'."
530(defun gnus-split-references (references) 569(defun gnus-split-references (references)
531 "Return a list of Message-IDs in REFERENCES." 570 "Return a list of Message-IDs in REFERENCES."
532 (let ((beg 0) 571 (let ((beg 0)
572 (references (or references ""))
533 ids) 573 ids)
534 (while (string-match "<[^<]+[^< \t]" references beg) 574 (while (string-match "<[^<]+[^< \t]" references beg)
535 (push (substring references (match-beginning 0) (setq beg (match-end 0))) 575 (push (substring references (match-beginning 0) (setq beg (match-end 0)))
536 ids)) 576 ids))
537 (nreverse ids))) 577 (nreverse ids)))
538 578
579(defun gnus-extract-references (references)
580 "Return a list of Message-IDs in REFERENCES (in In-Reply-To
581 format), trimmed to only contain the Message-IDs."
582 (let ((ids (gnus-split-references references))
583 refs)
584 (dolist (id ids)
585 (when (string-match "<[^<>]+>" id)
586 (push (match-string 0 id) refs)))
587 refs))
588
539(defsubst gnus-parent-id (references &optional n) 589(defsubst gnus-parent-id (references &optional n)
540 "Return the last Message-ID in REFERENCES. 590 "Return the last Message-ID in REFERENCES.
541If N, return the Nth ancestor instead." 591If N, return the Nth ancestor instead."
@@ -709,11 +759,11 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and
709`print-level' to nil. See also `gnus-bind-print-variables'." 759`print-level' to nil. See also `gnus-bind-print-variables'."
710 (gnus-bind-print-variables (prin1-to-string form))) 760 (gnus-bind-print-variables (prin1-to-string form)))
711 761
712(defun gnus-pp (form) 762(defun gnus-pp (form &optional stream)
713 "Use `pp' on FORM in the current buffer. 763 "Use `pp' on FORM in the current buffer.
714Bind `print-quoted' and `print-readably' to t, and `print-length' and 764Bind `print-quoted' and `print-readably' to t, and `print-length' and
715`print-level' to nil. See also `gnus-bind-print-variables'." 765`print-level' to nil. See also `gnus-bind-print-variables'."
716 (gnus-bind-print-variables (pp form (current-buffer)))) 766 (gnus-bind-print-variables (pp form (or stream (current-buffer)))))
717 767
718(defun gnus-pp-to-string (form) 768(defun gnus-pp-to-string (form)
719 "The same as `pp-to-string'. 769 "The same as `pp-to-string'.
@@ -732,9 +782,9 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and
732 782
733(defun gnus-write-buffer (file) 783(defun gnus-write-buffer (file)
734 "Write the current buffer's contents to FILE." 784 "Write the current buffer's contents to FILE."
735 ;; Make sure the directory exists.
736 (gnus-make-directory (file-name-directory file))
737 (let ((file-name-coding-system nnmail-pathname-coding-system)) 785 (let ((file-name-coding-system nnmail-pathname-coding-system))
786 ;; Make sure the directory exists.
787 (gnus-make-directory (file-name-directory file))
738 ;; Write the buffer. 788 ;; Write the buffer.
739 (write-region (point-min) (point-max) file nil 'quietly))) 789 (write-region (point-min) (point-max) file nil 'quietly)))
740 790
@@ -1149,8 +1199,12 @@ Return the modified alist."
1149 t)) 1199 t))
1150 1200
1151(defun gnus-write-active-file (file hashtb &optional full-names) 1201(defun gnus-write-active-file (file hashtb &optional full-names)
1202 ;; `coding-system-for-write' should be `raw-text' or equivalent.
1152 (let ((coding-system-for-write nnmail-active-file-coding-system)) 1203 (let ((coding-system-for-write nnmail-active-file-coding-system))
1153 (with-temp-file file 1204 (with-temp-file file
1205 ;; The buffer should be in the unibyte mode because group names
1206 ;; are ASCII text or encoded non-ASCII text (i.e., unibyte).
1207 (mm-disable-multibyte)
1154 (mapatoms 1208 (mapatoms
1155 (lambda (sym) 1209 (lambda (sym)
1156 (when (and sym 1210 (when (and sym
@@ -1236,6 +1290,13 @@ Return the modified alist."
1236 (remove-text-properties start end properties object)) 1290 (remove-text-properties start end properties object))
1237 t)) 1291 t))
1238 1292
1293(defun gnus-string-remove-all-properties (string)
1294 (condition-case ()
1295 (let ((s string))
1296 (set-text-properties 0 (length string) nil string)
1297 s)
1298 (error string)))
1299
1239;; This might use `compare-strings' to reduce consing in the 1300;; This might use `compare-strings' to reduce consing in the
1240;; case-insensitive case, but it has to cope with null args. 1301;; case-insensitive case, but it has to cope with null args.
1241;; (`string-equal' uses symbol print names.) 1302;; (`string-equal' uses symbol print names.)
@@ -1350,32 +1411,12 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1350 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) 1411 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
1351 (error "Invalid predicate specifier: %s" spec))))) 1412 (error "Invalid predicate specifier: %s" spec)))))
1352 1413
1353(defun gnus-local-map-property (map)
1354 "Return a list suitable for a text property list specifying keymap MAP."
1355 (cond
1356 ((featurep 'xemacs)
1357 (list 'keymap map))
1358 ((>= emacs-major-version 21)
1359 (list 'keymap map))
1360 (t
1361 (list 'local-map map))))
1362
1363(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
1364 require-match initial-contents
1365 history default)
1366 "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
1367 `(completing-read ,prompt ,table ,predicate ,require-match
1368 ,initial-contents ,history
1369 ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2))
1370 ()
1371 (list default))))
1372
1373(defun gnus-completing-read (prompt table &optional predicate require-match 1414(defun gnus-completing-read (prompt table &optional predicate require-match
1374 history) 1415 history)
1375 (when (and history 1416 (when (and history
1376 (not (boundp history))) 1417 (not (boundp history)))
1377 (set history nil)) 1418 (set history nil))
1378 (gnus-completing-read-maybe-default 1419 (completing-read
1379 (if (symbol-value history) 1420 (if (symbol-value history)
1380 (concat prompt " (" (car (symbol-value history)) "): ") 1421 (concat prompt " (" (car (symbol-value history)) "): ")
1381 (concat prompt ": ")) 1422 (concat prompt ": "))
@@ -1616,13 +1657,16 @@ predicate on the elements."
1616 ((or (featurep 'sxemacs) (featurep 'xemacs)) 1657 ((or (featurep 'sxemacs) (featurep 'xemacs))
1617 ;; XEmacs or SXEmacs: 1658 ;; XEmacs or SXEmacs:
1618 (concat emacsname "/" emacs-program-version 1659 (concat emacsname "/" emacs-program-version
1619 " (" 1660 (let (plst)
1620 (when (and (memq 'codename lst) 1661 (when (memq 'codename lst)
1621 codename) 1662 (push codename plst))
1622 (concat codename 1663 (when system-v
1623 (when system-v ", "))) 1664 (push system-v plst))
1624 (when system-v system-v) 1665 (unless (featurep 'mule)
1625 ")")) 1666 (push "no MULE" plst))
1667 (when (> (length plst) 0)
1668 (concat
1669 " (" (mapconcat 'identity (reverse plst) ", ") ")")))))
1626 (t emacs-version)))) 1670 (t emacs-version))))
1627 1671
1628(defun gnus-rename-file (old-path new-path &optional trim) 1672(defun gnus-rename-file (old-path new-path &optional trim)
@@ -1646,6 +1690,11 @@ empty directories from OLD-PATH."
1646 (file-truename 1690 (file-truename
1647 (concat old-dir ".."))))))))) 1691 (concat old-dir "..")))))))))
1648 1692
1693(defun gnus-set-file-modes (filename mode)
1694 "Wrapper for set-file-modes."
1695 (ignore-errors
1696 (set-file-modes filename mode)))
1697
1649(if (fboundp 'set-process-query-on-exit-flag) 1698(if (fboundp 'set-process-query-on-exit-flag)
1650 (defalias 'gnus-set-process-query-on-exit-flag 1699 (defalias 'gnus-set-process-query-on-exit-flag
1651 'set-process-query-on-exit-flag) 1700 'set-process-query-on-exit-flag)
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 86253f0deef..20937562096 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -393,7 +393,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
393 (list current-prefix-arg 393 (list current-prefix-arg
394 (read-file-name 394 (read-file-name
395 (if gnus-uu-save-separate-articles 395 (if gnus-uu-save-separate-articles
396 "Save articles is dir: " 396 "Save articles in dir: "
397 "Save articles in file: ") 397 "Save articles in file: ")
398 gnus-uu-default-dir 398 gnus-uu-default-dir
399 gnus-uu-default-dir))) 399 gnus-uu-default-dir)))
@@ -482,11 +482,24 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
482 (setq message-forward-as-mime (not message-forward-as-mime) 482 (setq message-forward-as-mime (not message-forward-as-mime)
483 n nil)) 483 n nil))
484 (let ((gnus-article-reply (gnus-summary-work-articles n))) 484 (let ((gnus-article-reply (gnus-summary-work-articles n)))
485 (when (and (not n)
486 (= (length gnus-article-reply) 1))
487 ;; The case where neither a number of articles nor a region is
488 ;; specified.
489 (gnus-summary-top-thread)
490 (setq gnus-article-reply (nreverse (gnus-uu-find-articles-matching))))
485 (gnus-setup-message 'forward 491 (gnus-setup-message 'forward
486 (setq gnus-uu-digest-from-subject nil) 492 (setq gnus-uu-digest-from-subject nil)
487 (setq gnus-uu-digest-buffer 493 (setq gnus-uu-digest-buffer
488 (gnus-get-buffer-create " *gnus-uu-forward*")) 494 (gnus-get-buffer-create " *gnus-uu-forward*"))
489 (gnus-uu-decode-save n file) 495 ;; Specify articles to be forwarded. Note that they should be
496 ;; reversed; see `gnus-uu-get-list-of-articles'.
497 (let ((gnus-newsgroup-processable (reverse gnus-article-reply)))
498 (gnus-uu-decode-save n file)
499 (setq gnus-article-reply gnus-newsgroup-processable))
500 ;; Restore the value of `gnus-newsgroup-processable' to which
501 ;; it should be set when it is not `let'-bound.
502 (setq gnus-newsgroup-processable (reverse gnus-article-reply))
490 (switch-to-buffer gnus-uu-digest-buffer) 503 (switch-to-buffer gnus-uu-digest-buffer)
491 (let ((fs gnus-uu-digest-from-subject)) 504 (let ((fs gnus-uu-digest-from-subject))
492 (when fs 505 (when fs
@@ -511,11 +524,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
511 "Various")))) 524 "Various"))))
512 (goto-char (point-min)) 525 (goto-char (point-min))
513 (when (re-search-forward "^Subject: ") 526 (when (re-search-forward "^Subject: ")
514 (delete-region (point) (gnus-point-at-eol)) 527 (delete-region (point) (point-at-eol))
515 (insert subject)) 528 (insert subject))
516 (goto-char (point-min)) 529 (goto-char (point-min))
517 (when (re-search-forward "^From:") 530 (when (re-search-forward "^From:")
518 (delete-region (point) (gnus-point-at-eol)) 531 (delete-region (point) (point-at-eol))
519 (insert " " from)) 532 (insert " " from))
520 (let ((message-forward-decoded-p t)) 533 (let ((message-forward-decoded-p t))
521 (message-forward post t)))) 534 (message-forward post t))))
@@ -530,19 +543,19 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
530 543
531(defun gnus-message-process-mark (unmarkp new-marked) 544(defun gnus-message-process-mark (unmarkp new-marked)
532 (let ((old (- (length gnus-newsgroup-processable) (length new-marked)))) 545 (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
533 (message "%d mark%s %s%s" 546 (gnus-message 6 "%d mark%s %s%s"
534 (length new-marked) 547 (length new-marked)
535 (if (= (length new-marked) 1) "" "s") 548 (if (= (length new-marked) 1) "" "s")
536 (if unmarkp "removed" "added") 549 (if unmarkp "removed" "added")
537 (cond 550 (cond
538 ((and (zerop old) 551 ((and (zerop old)
539 (not unmarkp)) 552 (not unmarkp))
540 "") 553 "")
541 (unmarkp 554 (unmarkp
542 (format ", %d remain marked" 555 (format ", %d remain marked"
543 (length gnus-newsgroup-processable))) 556 (length gnus-newsgroup-processable)))
544 (t 557 (t
545 (format ", %d already marked" old)))))) 558 (format ", %d already marked" old))))))
546 559
547(defun gnus-new-processable (unmarkp articles) 560(defun gnus-new-processable (unmarkp articles)
548 (if unmarkp 561 (if unmarkp
@@ -570,16 +583,18 @@ When called interactively, prompt for REGEXP."
570 (interactive "sUnmark (regexp): ") 583 (interactive "sUnmark (regexp): ")
571 (gnus-uu-mark-by-regexp regexp t)) 584 (gnus-uu-mark-by-regexp regexp t))
572 585
573(defun gnus-uu-mark-series () 586(defun gnus-uu-mark-series (&optional silent)
574 "Mark the current series with the process mark." 587 "Mark the current series with the process mark."
575 (interactive) 588 (interactive)
576 (let* ((articles (gnus-uu-find-articles-matching)) 589 (let* ((articles (gnus-uu-find-articles-matching))
577 (l (length articles))) 590 (l (length articles)))
578 (while articles 591 (while articles
579 (gnus-summary-set-process-mark (car articles)) 592 (gnus-summary-set-process-mark (car articles))
580 (setq articles (cdr articles))) 593 (setq articles (cdr articles)))
581 (message "Marked %d articles" l)) 594 (unless silent
582 (gnus-summary-position-point)) 595 (gnus-message 6 "Marked %d articles" l))
596 (gnus-summary-position-point)
597 l))
583 598
584(defun gnus-uu-mark-region (beg end &optional unmark) 599(defun gnus-uu-mark-region (beg end &optional unmark)
585 "Set the process mark on all articles between point and mark." 600 "Set the process mark on all articles between point and mark."
@@ -687,14 +702,16 @@ When called interactively, prompt for REGEXP."
687 (setq gnus-newsgroup-processable nil) 702 (setq gnus-newsgroup-processable nil)
688 (save-excursion 703 (save-excursion
689 (let ((data gnus-newsgroup-data) 704 (let ((data gnus-newsgroup-data)
705 (count 0)
690 number) 706 number)
691 (while data 707 (while data
692 (when (and (not (memq (setq number (gnus-data-number (car data))) 708 (when (and (not (memq (setq number (gnus-data-number (car data)))
693 gnus-newsgroup-processable)) 709 gnus-newsgroup-processable))
694 (vectorp (gnus-data-header (car data)))) 710 (vectorp (gnus-data-header (car data))))
695 (gnus-summary-goto-subject number) 711 (gnus-summary-goto-subject number)
696 (gnus-uu-mark-series)) 712 (setq count (+ count (gnus-uu-mark-series t))))
697 (setq data (cdr data))))) 713 (setq data (cdr data)))
714 (gnus-message 6 "Marked %d articles" count)))
698 (gnus-summary-position-point)) 715 (gnus-summary-position-point))
699 716
700;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. 717;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
@@ -852,7 +869,7 @@ When called interactively, prompt for REGEXP."
852 (save-restriction 869 (save-restriction
853 (set-buffer buffer) 870 (set-buffer buffer)
854 (let (buffer-read-only) 871 (let (buffer-read-only)
855 (gnus-set-text-properties (point-min) (point-max) nil) 872 (set-text-properties (point-min) (point-max) nil)
856 ;; These two are necessary for XEmacs 19.12 fascism. 873 ;; These two are necessary for XEmacs 19.12 fascism.
857 (put-text-property (point-min) (point-max) 'invisible nil) 874 (put-text-property (point-min) (point-max) 'invisible nil)
858 (put-text-property (point-min) (point-max) 'intangible nil)) 875 (put-text-property (point-min) (point-max) 'intangible nil))
@@ -862,7 +879,7 @@ When called interactively, prompt for REGEXP."
862 (mm-enable-multibyte) 879 (mm-enable-multibyte)
863 (mime-to-mml)) 880 (mime-to-mml))
864 (goto-char (point-min)) 881 (goto-char (point-min))
865 (re-search-forward "\n\n") 882 (search-forward "\n\n")
866 (unless (and message-forward-as-mime gnus-uu-digest-buffer) 883 (unless (and message-forward-as-mime gnus-uu-digest-buffer)
867 ;; Quote all 30-dash lines. 884 ;; Quote all 30-dash lines.
868 (save-excursion 885 (save-excursion
@@ -1153,7 +1170,7 @@ When called interactively, prompt for REGEXP."
1153 1170
1154 ;; Expand numbers, sort, and return the list of article 1171 ;; Expand numbers, sort, and return the list of article
1155 ;; numbers. 1172 ;; numbers.
1156 (mapcar (lambda (sub) (cdr sub)) 1173 (mapcar 'cdr
1157 (sort (gnus-uu-expand-numbers 1174 (sort (gnus-uu-expand-numbers
1158 list-of-subjects 1175 list-of-subjects
1159 (not do-not-translate)) 1176 (not do-not-translate))
@@ -1406,7 +1423,7 @@ When called interactively, prompt for REGEXP."
1406 (setq part (match-string 0 subject)) 1423 (setq part (match-string 0 subject))
1407 (setq subject (substring subject (match-end 0))))) 1424 (setq subject (substring subject (match-end 0)))))
1408 (or part 1425 (or part
1409 (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject) 1426 (while (string-match "[0-9]+[^0-9]+[0-9]+" subject)
1410 (setq part (match-string 0 subject)) 1427 (setq part (match-string 0 subject))
1411 (setq subject (substring subject (match-end 0))))) 1428 (setq subject (substring subject (match-end 0)))))
1412 (or part ""))) 1429 (or part "")))
@@ -1708,8 +1725,7 @@ Gnus might fail to display all of it.")
1708(defun gnus-uu-check-correct-stripped-uucode (start end) 1725(defun gnus-uu-check-correct-stripped-uucode (start end)
1709 (save-excursion 1726 (save-excursion
1710 (let (found beg length) 1727 (let (found beg length)
1711 (if (not gnus-uu-correct-stripped-uucode) 1728 (unless gnus-uu-correct-stripped-uucode
1712 ()
1713 (goto-char start) 1729 (goto-char start)
1714 1730
1715 (if (re-search-forward " \\|`" end t) 1731 (if (re-search-forward " \\|`" end t)
@@ -1722,19 +1738,15 @@ Gnus might fail to display all of it.")
1722 (forward-line 1)))) 1738 (forward-line 1))))
1723 1739
1724 (while (not (eobp)) 1740 (while (not (eobp))
1725 (if (looking-at (concat gnus-uu-begin-string "\\|" 1741 (unless (looking-at (concat gnus-uu-begin-string "\\|"
1726 gnus-uu-end-string)) 1742 gnus-uu-end-string))
1727 ()
1728 (when (not found) 1743 (when (not found)
1729 (beginning-of-line) 1744 (setq length (- (point-at-eol) (point-at-bol))))
1730 (setq beg (point))
1731 (end-of-line)
1732 (setq length (- (point) beg)))
1733 (setq found t) 1745 (setq found t)
1734 (beginning-of-line) 1746 (beginning-of-line)
1735 (setq beg (point)) 1747 (setq beg (point))
1736 (end-of-line) 1748 (end-of-line)
1737 (when (not (= length (- (point) beg))) 1749 (unless (= length (- (point) beg))
1738 (insert (make-string (- length (- (point) beg)) ? )))) 1750 (insert (make-string (- length (- (point) beg)) ? ))))
1739 (forward-line 1))))))) 1751 (forward-line 1)))))))
1740 1752
@@ -1759,7 +1771,7 @@ Gnus might fail to display all of it.")
1759 1771
1760 (setq gnus-uu-work-dir 1772 (setq gnus-uu-work-dir
1761 (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) 1773 (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
1762 (set-file-modes gnus-uu-work-dir 448) 1774 (gnus-set-file-modes gnus-uu-work-dir 448)
1763 (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) 1775 (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
1764 (push (cons gnus-newsgroup-name gnus-uu-work-dir) 1776 (push (cons gnus-newsgroup-name gnus-uu-work-dir)
1765 gnus-uu-tmp-alist)))) 1777 gnus-uu-tmp-alist))))
@@ -1779,7 +1791,7 @@ Gnus might fail to display all of it.")
1779;; that the filename will be treated as a single argument when the shell 1791;; that the filename will be treated as a single argument when the shell
1780;; executes the command. 1792;; executes the command.
1781(defun gnus-uu-command (action file) 1793(defun gnus-uu-command (action file)
1782 (let ((quoted-file (mm-quote-arg file))) 1794 (let ((quoted-file (shell-quote-argument file)))
1783 (if (string-match "%s" action) 1795 (if (string-match "%s" action)
1784 (format action quoted-file) 1796 (format action quoted-file)
1785 (concat action " " quoted-file)))) 1797 (concat action " " quoted-file))))
@@ -1903,7 +1915,7 @@ The user will be asked for a file name."
1903 (when (gnus-uu-post-encode-file "uuencode" path file-name) 1915 (when (gnus-uu-post-encode-file "uuencode" path file-name)
1904 (goto-char (point-min)) 1916 (goto-char (point-min))
1905 (forward-line 1) 1917 (forward-line 1)
1906 (while (re-search-forward " " nil t) 1918 (while (search-forward " " nil t)
1907 (replace-match "`")) 1919 (replace-match "`"))
1908 t)) 1920 t))
1909 1921
@@ -2034,8 +2046,7 @@ If no file has been included, the user will be asked for a file."
2034 (goto-char (point-min)) 2046 (goto-char (point-min))
2035 (re-search-forward 2047 (re-search-forward
2036 (concat "^" (regexp-quote mail-header-separator) "$") nil t) 2048 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
2037 (beginning-of-line) 2049 (setq header (buffer-substring (point-min) (point-at-bol)))
2038 (setq header (buffer-substring (point-min) (point)))
2039 2050
2040 (goto-char (point-min)) 2051 (goto-char (point-min))
2041 (when gnus-uu-post-separate-description 2052 (when gnus-uu-post-separate-description
@@ -2111,8 +2122,7 @@ If no file has been included, the user will be asked for a file."
2111 2122
2112 (when (not gnus-uu-post-separate-description) 2123 (when (not gnus-uu-post-separate-description)
2113 (set-buffer-modified-p nil) 2124 (set-buffer-modified-p nil)
2114 (when (fboundp 'bury-buffer) 2125 (bury-buffer))))
2115 (bury-buffer)))))
2116 2126
2117(provide 'gnus-uu) 2127(provide 'gnus-uu)
2118 2128
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 7e1609cc196..60cc5247d05 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -120,6 +120,10 @@ used to display Gnus windows."
120 (vertical 1.0 120 (vertical 1.0
121 (summary 0.25) 121 (summary 0.25)
122 (edit-score 1.0 point))) 122 (edit-score 1.0 point)))
123 (edit-server
124 (vertical 1.0
125 (server 0.5)
126 (edit-form 1.0 point)))
123 (post 127 (post
124 (vertical 1.0 128 (vertical 1.0
125 (post 1.0 point))) 129 (post 1.0 point)))
@@ -166,8 +170,12 @@ used to display Gnus windows."
166 (article 0.5) 170 (article 0.5)
167 (message 1.0 point))) 171 (message 1.0 point)))
168 (display-term 172 (display-term
169 (vertical 1.0 173 (vertical 1.0
170 ("*display*" 1.0)))) 174 ("*display*" 1.0)))
175 (mml-preview
176 (vertical 1.0
177 (message 0.5)
178 (mml-preview 1.0 point))))
171 "Window configuration for all possible Gnus buffers. 179 "Window configuration for all possible Gnus buffers.
172See the Gnus manual for an explanation of the syntax used.") 180See the Gnus manual for an explanation of the syntax used.")
173 181
@@ -195,7 +203,8 @@ See the Gnus manual for an explanation of the syntax used.")
195 (info . gnus-info-buffer) 203 (info . gnus-info-buffer)
196 (category . gnus-category-buffer) 204 (category . gnus-category-buffer)
197 (article-copy . gnus-article-copy) 205 (article-copy . gnus-article-copy)
198 (draft . gnus-draft-buffer)) 206 (draft . gnus-draft-buffer)
207 (mml-preview . mml-preview-buffer))
199 "Mapping from short symbols to buffer names or buffer variables.") 208 "Mapping from short symbols to buffer names or buffer variables.")
200 209
201(defcustom gnus-configure-windows-hook nil 210(defcustom gnus-configure-windows-hook nil
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 6fe8b1c3cbe..83e105135ac 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -289,10 +289,10 @@ is restarted, and sometimes reloaded."
289 :link '(custom-manual "(gnus)Exiting Gnus") 289 :link '(custom-manual "(gnus)Exiting Gnus")
290 :group 'gnus) 290 :group 'gnus)
291 291
292(defconst gnus-version-number "5.11" 292(defconst gnus-version-number "0.7"
293 "Version number for this version of Gnus.") 293 "Version number for this version of Gnus.")
294 294
295(defconst gnus-version (format "Gnus v%s" gnus-version-number) 295(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
296 "Version string for this version of Gnus.") 296 "Version string for this version of Gnus.")
297 297
298(defcustom gnus-inhibit-startup-message nil 298(defcustom gnus-inhibit-startup-message nil
@@ -310,9 +310,6 @@ be set in `.emacs' instead."
310(unless (fboundp 'gnus-group-remove-excess-properties) 310(unless (fboundp 'gnus-group-remove-excess-properties)
311 (defalias 'gnus-group-remove-excess-properties 'ignore)) 311 (defalias 'gnus-group-remove-excess-properties 'ignore))
312 312
313(unless (fboundp 'gnus-set-text-properties)
314 (defalias 'gnus-set-text-properties 'set-text-properties))
315
316(unless (featurep 'gnus-xmas) 313(unless (featurep 'gnus-xmas)
317 (defalias 'gnus-make-overlay 'make-overlay) 314 (defalias 'gnus-make-overlay 'make-overlay)
318 (defalias 'gnus-delete-overlay 'delete-overlay) 315 (defalias 'gnus-delete-overlay 'delete-overlay)
@@ -323,7 +320,6 @@ be set in `.emacs' instead."
323 (defalias 'gnus-overlay-end 'overlay-end) 320 (defalias 'gnus-overlay-end 'overlay-end)
324 (defalias 'gnus-extent-detached-p 'ignore) 321 (defalias 'gnus-extent-detached-p 'ignore)
325 (defalias 'gnus-extent-start-open 'ignore) 322 (defalias 'gnus-extent-start-open 'ignore)
326 (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
327 (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) 323 (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
328 (defalias 'gnus-character-to-event 'identity) 324 (defalias 'gnus-character-to-event 'identity)
329 (defalias 'gnus-assq-delete-all 'assq-delete-all) 325 (defalias 'gnus-assq-delete-all 'assq-delete-all)
@@ -563,7 +559,7 @@ be set in `.emacs' instead."
563(defface gnus-group-mail-1 559(defface gnus-group-mail-1
564 '((((class color) 560 '((((class color)
565 (background dark)) 561 (background dark))
566 (:foreground "aquamarine1" :bold t)) 562 (:foreground "#e1ffe1" :bold t))
567 (((class color) 563 (((class color)
568 (background light)) 564 (background light))
569 (:foreground "DeepPink3" :bold t)) 565 (:foreground "DeepPink3" :bold t))
@@ -577,7 +573,7 @@ be set in `.emacs' instead."
577(defface gnus-group-mail-1-empty 573(defface gnus-group-mail-1-empty
578 '((((class color) 574 '((((class color)
579 (background dark)) 575 (background dark))
580 (:foreground "aquamarine1")) 576 (:foreground "#e1ffe1"))
581 (((class color) 577 (((class color)
582 (background light)) 578 (background light))
583 (:foreground "DeepPink3")) 579 (:foreground "DeepPink3"))
@@ -591,7 +587,7 @@ be set in `.emacs' instead."
591(defface gnus-group-mail-2 587(defface gnus-group-mail-2
592 '((((class color) 588 '((((class color)
593 (background dark)) 589 (background dark))
594 (:foreground "aquamarine2" :bold t)) 590 (:foreground "DarkSeaGreen1" :bold t))
595 (((class color) 591 (((class color)
596 (background light)) 592 (background light))
597 (:foreground "HotPink3" :bold t)) 593 (:foreground "HotPink3" :bold t))
@@ -605,7 +601,7 @@ be set in `.emacs' instead."
605(defface gnus-group-mail-2-empty 601(defface gnus-group-mail-2-empty
606 '((((class color) 602 '((((class color)
607 (background dark)) 603 (background dark))
608 (:foreground "aquamarine2")) 604 (:foreground "DarkSeaGreen1"))
609 (((class color) 605 (((class color)
610 (background light)) 606 (background light))
611 (:foreground "HotPink3")) 607 (:foreground "HotPink3"))
@@ -619,7 +615,7 @@ be set in `.emacs' instead."
619(defface gnus-group-mail-3 615(defface gnus-group-mail-3
620 '((((class color) 616 '((((class color)
621 (background dark)) 617 (background dark))
622 (:foreground "aquamarine3" :bold t)) 618 (:foreground "aquamarine1" :bold t))
623 (((class color) 619 (((class color)
624 (background light)) 620 (background light))
625 (:foreground "magenta4" :bold t)) 621 (:foreground "magenta4" :bold t))
@@ -633,7 +629,7 @@ be set in `.emacs' instead."
633(defface gnus-group-mail-3-empty 629(defface gnus-group-mail-3-empty
634 '((((class color) 630 '((((class color)
635 (background dark)) 631 (background dark))
636 (:foreground "aquamarine3")) 632 (:foreground "aquamarine1"))
637 (((class color) 633 (((class color)
638 (background light)) 634 (background light))
639 (:foreground "magenta4")) 635 (:foreground "magenta4"))
@@ -647,7 +643,7 @@ be set in `.emacs' instead."
647(defface gnus-group-mail-low 643(defface gnus-group-mail-low
648 '((((class color) 644 '((((class color)
649 (background dark)) 645 (background dark))
650 (:foreground "aquamarine4" :bold t)) 646 (:foreground "aquamarine2" :bold t))
651 (((class color) 647 (((class color)
652 (background light)) 648 (background light))
653 (:foreground "DeepPink4" :bold t)) 649 (:foreground "DeepPink4" :bold t))
@@ -661,7 +657,7 @@ be set in `.emacs' instead."
661(defface gnus-group-mail-low-empty 657(defface gnus-group-mail-low-empty
662 '((((class color) 658 '((((class color)
663 (background dark)) 659 (background dark))
664 (:foreground "aquamarine4")) 660 (:foreground "aquamarine2"))
665 (((class color) 661 (((class color)
666 (background light)) 662 (background light))
667 (:foreground "DeepPink4")) 663 (:foreground "DeepPink4"))
@@ -923,7 +919,7 @@ be set in `.emacs' instead."
923(defface gnus-splash 919(defface gnus-splash
924 '((((class color) 920 '((((class color)
925 (background dark)) 921 (background dark))
926 (:foreground "#888888")) 922 (:foreground "#cccccc"))
927 (((class color) 923 (((class color)
928 (background light)) 924 (background light))
929 (:foreground "#888888")) 925 (:foreground "#888888"))
@@ -978,12 +974,12 @@ be set in `.emacs' instead."
978 (storm "#666699" "#99ccff") 974 (storm "#666699" "#99ccff")
979 (pdino "#9999cc" "#99ccff") 975 (pdino "#9999cc" "#99ccff")
980 (purp "#9999cc" "#666699") 976 (purp "#9999cc" "#666699")
981 (no "#000000" "#ff0000") 977 (no "#ff0000" "#ffff00")
982 (neutral "#b4b4b4" "#878787") 978 (neutral "#b4b4b4" "#878787")
983 (september "#bf9900" "#ffcc00")) 979 (september "#bf9900" "#ffcc00"))
984 "Color alist used for the Gnus logo.") 980 "Color alist used for the Gnus logo.")
985 981
986(defcustom gnus-logo-color-style 'oort 982(defcustom gnus-logo-color-style 'no
987 "*Color styles used for the Gnus logo." 983 "*Color styles used for the Gnus logo."
988 :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) 984 :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
989 gnus-logo-color-alist)) 985 gnus-logo-color-alist))
@@ -1034,23 +1030,23 @@ be set in `.emacs' instead."
1034 (t 1030 (t
1035 (insert 1031 (insert
1036 (format " %s 1032 (format " %s
1037 _ ___ _ _ 1033 _ ___ _ _
1038 _ ___ __ ___ __ _ ___ 1034 _ ___ __ ___ __ _ ___
1039 __ _ ___ __ ___ 1035 __ _ ___ __ ___
1040 _ ___ _ 1036 _ ___ _
1041 _ _ __ _ 1037 _ _ __ _
1042 ___ __ _ 1038 ___ __ _
1043 __ _ 1039 __ _
1044 _ _ _ 1040 _ _ _
1045 _ _ _ 1041 _ _ _
1046 _ _ _ 1042 _ _ _
1047 __ ___ 1043 __ ___
1048 _ _ _ _ 1044 _ _ _ _
1049 _ _ 1045 _ _
1050 _ _ 1046 _ _
1051 _ _ 1047 _ _
1052 _ 1048 _
1053 __ 1049 __
1054 1050
1055" 1051"
1056 "")) 1052 ""))
@@ -1294,12 +1290,30 @@ see the manual for details."
1294 1290
1295(defcustom gnus-message-archive-method "archive" 1291(defcustom gnus-message-archive-method "archive"
1296 "*Method used for archiving messages you've sent. 1292 "*Method used for archiving messages you've sent.
1297This should be a mail method." 1293This should be a mail method.
1294
1295See also `gnus-update-message-archive-method'."
1298 :group 'gnus-server 1296 :group 'gnus-server
1299 :group 'gnus-message 1297 :group 'gnus-message
1300 :type '(choice (const :tag "Default archive method" "archive") 1298 :type '(choice (const :tag "Default archive method" "archive")
1301 gnus-select-method)) 1299 gnus-select-method))
1302 1300
1301(defcustom gnus-update-message-archive-method nil
1302 "Non-nil means always update the saved \"archive\" method.
1303
1304The archive method is initially set according to the value of
1305`gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file
1306so that it may be used as a real method of the server which is named
1307\"archive\" ever since. If it once has been saved, it will never be
1308updated if the value of this variable is nil, even if you change the
1309value of `gnus-message-archive-method' afterward. If you want the
1310saved \"archive\" method to be updated whenever you change the value of
1311`gnus-message-archive-method', set this variable to a non-nil value."
1312 :version "23.0" ;; No Gnus
1313 :group 'gnus-server
1314 :group 'gnus-message
1315 :type 'boolean)
1316
1303(defcustom gnus-message-archive-group nil 1317(defcustom gnus-message-archive-group nil
1304 "*Name of the group in which to save the messages you've written. 1318 "*Name of the group in which to save the messages you've written.
1305This can either be a string; a list of strings; or an alist 1319This can either be a string; a list of strings; or an alist
@@ -1566,11 +1580,6 @@ cache to the full extent of the law."
1566 :group 'gnus-meta 1580 :group 'gnus-meta
1567 :type 'boolean) 1581 :type 'boolean)
1568 1582
1569(defcustom gnus-use-grouplens nil
1570 "*If non-nil, use GroupLens ratings."
1571 :group 'gnus-meta
1572 :type 'boolean)
1573
1574(defcustom gnus-keep-backlog 20 1583(defcustom gnus-keep-backlog 20
1575 "*If non-nil, Gnus will keep read articles for later re-retrieval. 1584 "*If non-nil, Gnus will keep read articles for later re-retrieval.
1576If it is a number N, then Gnus will only keep the last N articles 1585If it is a number N, then Gnus will only keep the last N articles
@@ -2007,6 +2016,42 @@ When a spam group is entered, all unread articles are marked as
2007spam. There is other behavior associated with ham and no 2016spam. There is other behavior associated with ham and no
2008classification when spam.el is loaded - see the manual.") 2017classification when spam.el is loaded - see the manual.")
2009 2018
2019 (gnus-define-group-parameter
2020 spam-resend-to
2021 :type list
2022 :function-document
2023 "The address to get spam resent (through spam-report-resend)."
2024 :variable gnus-spam-resend-to
2025 :variable-default nil
2026 :variable-document
2027 "The address to get spam resent (through spam-report-resend)."
2028 :variable-group spam
2029 :variable-type '(repeat
2030 (list :tag "Group address for resending spam"
2031 (regexp :tag "Group")
2032 (string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)")))
2033 :parameter-type 'string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)"
2034 :parameter-document
2035 "The address to get spam resent (through spam-report-resend).")
2036
2037 (gnus-define-group-parameter
2038 ham-resend-to
2039 :type list
2040 :function-document
2041 "The address to get ham resent (through spam-report-resend)."
2042 :variable gnus-ham-resend-to
2043 :variable-default nil
2044 :variable-document
2045 "The address to get ham resent (through spam-report-resend)."
2046 :variable-group spam
2047 :variable-type '(repeat
2048 (list :tag "Group address for resending ham"
2049 (regexp :tag "Group")
2050 (string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)")))
2051 :parameter-type 'string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)"
2052 :parameter-document
2053 "The address to get ham resent (through spam-report-resend).")
2054
2010 (defvar gnus-group-spam-exit-processor-ifile "ifile" 2055 (defvar gnus-group-spam-exit-processor-ifile "ifile"
2011 "OBSOLETE: The ifile summary exit spam processor.") 2056 "OBSOLETE: The ifile summary exit spam processor.")
2012 2057
@@ -2063,6 +2108,27 @@ Only applicable to non-spam (unclassified and ham) groups.")
2063 :value nil 2108 :value nil
2064 (list :tag "Spam Summary Exit Processor Choices" 2109 (list :tag "Spam Summary Exit Processor Choices"
2065 (set 2110 (set
2111 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
2112 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
2113 (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter))
2114 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
2115 (const :tag "Spam: Resend Message"(spam spam-use-resend))
2116 (const :tag "Spam: ifile" (spam spam-use-ifile))
2117 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
2118 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
2119 (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin))
2120 (const :tag "Spam: CRM114" (spam spam-use-crm114))
2121 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
2122 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
2123 (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter))
2124 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
2125 (const :tag "Ham: Resend Message" (ham spam-use-resend))
2126 (const :tag "Ham: ifile" (ham spam-use-ifile))
2127 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))
2128 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
2129 (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin))
2130 (const :tag "Ham: CRM114" (ham spam-use-crm114))
2131 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
2066 (variable-item gnus-group-spam-exit-processor-ifile) 2132 (variable-item gnus-group-spam-exit-processor-ifile)
2067 (variable-item gnus-group-spam-exit-processor-stat) 2133 (variable-item gnus-group-spam-exit-processor-stat)
2068 (variable-item gnus-group-spam-exit-processor-bogofilter) 2134 (variable-item gnus-group-spam-exit-processor-bogofilter)
@@ -2075,20 +2141,7 @@ Only applicable to non-spam (unclassified and ham) groups.")
2075 (variable-item gnus-group-ham-exit-processor-whitelist) 2141 (variable-item gnus-group-ham-exit-processor-whitelist)
2076 (variable-item gnus-group-ham-exit-processor-BBDB) 2142 (variable-item gnus-group-ham-exit-processor-BBDB)
2077 (variable-item gnus-group-ham-exit-processor-spamoracle) 2143 (variable-item gnus-group-ham-exit-processor-spamoracle)
2078 (variable-item gnus-group-ham-exit-processor-copy) 2144 (variable-item gnus-group-ham-exit-processor-copy))))
2079 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
2080 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
2081 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
2082 (const :tag "Spam: ifile" (spam spam-use-ifile))
2083 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
2084 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
2085 (const :tag "Ham: ifile" (ham spam-use-ifile))
2086 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
2087 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
2088 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
2089 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
2090 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
2091 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
2092 :function-document 2145 :function-document
2093 "Which spam or ham processors will be applied when the summary is exited." 2146 "Which spam or ham processors will be applied when the summary is exited."
2094 :variable gnus-spam-process-newsgroups 2147 :variable gnus-spam-process-newsgroups
@@ -2105,6 +2158,27 @@ spam processing, associated with the appropriate processor."
2105 (regexp :tag "Group Regexp") 2158 (regexp :tag "Group Regexp")
2106 (set 2159 (set
2107 :tag "Spam/Ham Summary Exit Processor" 2160 :tag "Spam/Ham Summary Exit Processor"
2161 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
2162 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
2163 (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter))
2164 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
2165 (const :tag "Spam: Resend Message"(spam spam-use-resend))
2166 (const :tag "Spam: ifile" (spam spam-use-ifile))
2167 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
2168 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
2169 (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin))
2170 (const :tag "Spam: CRM114" (spam spam-use-crm114))
2171 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
2172 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
2173 (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter))
2174 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
2175 (const :tag "Ham: Resend Message" (ham spam-use-resend))
2176 (const :tag "Ham: ifile" (ham spam-use-ifile))
2177 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
2178 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))
2179 (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin))
2180 (const :tag "Ham: CRM114" (ham spam-use-crm114))
2181 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
2108 (variable-item gnus-group-spam-exit-processor-ifile) 2182 (variable-item gnus-group-spam-exit-processor-ifile)
2109 (variable-item gnus-group-spam-exit-processor-stat) 2183 (variable-item gnus-group-spam-exit-processor-stat)
2110 (variable-item gnus-group-spam-exit-processor-bogofilter) 2184 (variable-item gnus-group-spam-exit-processor-bogofilter)
@@ -2117,20 +2191,7 @@ spam processing, associated with the appropriate processor."
2117 (variable-item gnus-group-ham-exit-processor-whitelist) 2191 (variable-item gnus-group-ham-exit-processor-whitelist)
2118 (variable-item gnus-group-ham-exit-processor-BBDB) 2192 (variable-item gnus-group-ham-exit-processor-BBDB)
2119 (variable-item gnus-group-ham-exit-processor-spamoracle) 2193 (variable-item gnus-group-ham-exit-processor-spamoracle)
2120 (variable-item gnus-group-ham-exit-processor-copy) 2194 (variable-item gnus-group-ham-exit-processor-copy))))
2121 (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
2122 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
2123 (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
2124 (const :tag "Spam: ifile" (spam spam-use-ifile))
2125 (const :tag "Spam: Spam-stat" (spam spam-use-stat))
2126 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
2127 (const :tag "Ham: ifile" (ham spam-use-ifile))
2128 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
2129 (const :tag "Ham: Spam-stat" (ham spam-use-stat))
2130 (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
2131 (const :tag "Ham: BBDB" (ham spam-use-BBDB))
2132 (const :tag "Ham: Copy" (ham spam-use-ham-copy))
2133 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
2134 2195
2135 :parameter-document 2196 :parameter-document
2136 "Which spam or ham processors will be applied when the summary is exited.") 2197 "Which spam or ham processors will be applied when the summary is exited.")
@@ -2169,12 +2230,18 @@ spam-autodetect-recheck-messages is set.")
2169 (const default) 2230 (const default)
2170 (set :tag "Use specific methods" 2231 (set :tag "Use specific methods"
2171 (variable-item spam-use-blacklist) 2232 (variable-item spam-use-blacklist)
2233 (variable-item spam-use-gmane-xref)
2172 (variable-item spam-use-regex-headers) 2234 (variable-item spam-use-regex-headers)
2173 (variable-item spam-use-regex-body) 2235 (variable-item spam-use-regex-body)
2174 (variable-item spam-use-whitelist) 2236 (variable-item spam-use-whitelist)
2175 (variable-item spam-use-BBDB) 2237 (variable-item spam-use-BBDB)
2176 (variable-item spam-use-ifile) 2238 (variable-item spam-use-ifile)
2177 (variable-item spam-use-spamoracle) 2239 (variable-item spam-use-spamoracle)
2240 (variable-item spam-use-crm114)
2241 (variable-item spam-use-spamassassin)
2242 (variable-item spam-use-spamassassin-headers)
2243 (variable-item spam-use-bsfilter)
2244 (variable-item spam-use-bsfilter-headers)
2178 (variable-item spam-use-stat) 2245 (variable-item spam-use-stat)
2179 (variable-item spam-use-blackholes) 2246 (variable-item spam-use-blackholes)
2180 (variable-item spam-use-hashcash) 2247 (variable-item spam-use-hashcash)
@@ -2200,15 +2267,21 @@ set."
2200 (const default) 2267 (const default)
2201 (set :tag "Use specific methods" 2268 (set :tag "Use specific methods"
2202 (variable-item spam-use-blacklist) 2269 (variable-item spam-use-blacklist)
2270 (variable-item spam-use-gmane-xref)
2203 (variable-item spam-use-regex-headers) 2271 (variable-item spam-use-regex-headers)
2204 (variable-item spam-use-regex-body) 2272 (variable-item spam-use-regex-body)
2205 (variable-item spam-use-whitelist) 2273 (variable-item spam-use-whitelist)
2206 (variable-item spam-use-BBDB) 2274 (variable-item spam-use-BBDB)
2207 (variable-item spam-use-ifile) 2275 (variable-item spam-use-ifile)
2208 (variable-item spam-use-spamoracle) 2276 (variable-item spam-use-spamoracle)
2277 (variable-item spam-use-crm114)
2209 (variable-item spam-use-stat) 2278 (variable-item spam-use-stat)
2210 (variable-item spam-use-blackholes) 2279 (variable-item spam-use-blackholes)
2211 (variable-item spam-use-hashcash) 2280 (variable-item spam-use-hashcash)
2281 (variable-item spam-use-spamassassin)
2282 (variable-item spam-use-spamassassin-headers)
2283 (variable-item spam-use-bsfilter)
2284 (variable-item spam-use-bsfilter-headers)
2212 (variable-item spam-use-bogofilter-headers) 2285 (variable-item spam-use-bogofilter-headers)
2213 (variable-item spam-use-bogofilter))))) 2286 (variable-item spam-use-bogofilter)))))
2214 :parameter-document 2287 :parameter-document
@@ -2387,8 +2460,7 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
2387 summary-menu group-menu article-menu 2460 summary-menu group-menu article-menu
2388 tree-highlight menu highlight 2461 tree-highlight menu highlight
2389 browse-menu server-menu 2462 browse-menu server-menu
2390 page-marker tree-menu binary-menu pick-menu 2463 page-marker tree-menu binary-menu pick-menu)
2391 grouplens-menu)
2392 "*Enable visual features. 2464 "*Enable visual features.
2393If `visual' is disabled, there will be no menus and few faces. Most of 2465If `visual' is disabled, there will be no menus and few faces. Most of
2394the visual customization options below will be ignored. Gnus will use 2466the visual customization options below will be ignored. Gnus will use
@@ -2402,8 +2474,7 @@ instance, to switch off all visual things except menus, you can say:
2402Valid elements include `summary-highlight', `group-highlight', 2474Valid elements include `summary-highlight', `group-highlight',
2403`article-highlight', `mouse-face', `summary-menu', `group-menu', 2475`article-highlight', `mouse-face', `summary-menu', `group-menu',
2404`article-menu', `tree-highlight', `menu', `highlight', `browse-menu', 2476`article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
2405`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu', 2477`server-menu', `page-marker', `tree-menu', `binary-menu', and`pick-menu'."
2406and `grouplens-menu'."
2407 :group 'gnus-meta 2478 :group 'gnus-meta
2408 :group 'gnus-visual 2479 :group 'gnus-visual
2409 :type '(set (const summary-highlight) 2480 :type '(set (const summary-highlight)
@@ -2421,8 +2492,7 @@ and `grouplens-menu'."
2421 (const page-marker) 2492 (const page-marker)
2422 (const tree-menu) 2493 (const tree-menu)
2423 (const binary-menu) 2494 (const binary-menu)
2424 (const pick-menu) 2495 (const pick-menu)))
2425 (const grouplens-menu)))
2426 2496
2427;; Byte-compiler warning. 2497;; Byte-compiler warning.
2428(defvar gnus-visual) 2498(defvar gnus-visual)
@@ -2527,7 +2597,7 @@ a string, be sure to use a valid format, see RFC 2616."
2527 (const codename :tag "Emacs codename"))) 2597 (const codename :tag "Emacs codename")))
2528 (string))) 2598 (string)))
2529 2599
2530;; Convert old (No Gnus < 2005-01-10, v5-10 < 2005-09-05) symbol type values: 2600;; Convert old (< 2005-01-10) symbol type values:
2531(when (symbolp gnus-user-agent) 2601(when (symbolp gnus-user-agent)
2532 (setq gnus-user-agent 2602 (setq gnus-user-agent
2533 (cond ((eq gnus-user-agent 'emacs-gnus-config) 2603 (cond ((eq gnus-user-agent 'emacs-gnus-config)
@@ -2642,7 +2712,6 @@ such as a mark that says whether an article is stored in the cache
2642(defvar gnus-headers-retrieved-by nil) 2712(defvar gnus-headers-retrieved-by nil)
2643(defvar gnus-article-reply nil) 2713(defvar gnus-article-reply nil)
2644(defvar gnus-override-method nil) 2714(defvar gnus-override-method nil)
2645(defvar gnus-article-check-size nil)
2646(defvar gnus-opened-servers nil) 2715(defvar gnus-opened-servers nil)
2647 2716
2648(defvar gnus-current-kill-article nil) 2717(defvar gnus-current-kill-article nil)
@@ -2737,7 +2806,7 @@ gnus-registry.el will populate this if it's loaded.")
2737 2806
2738 ;; This little mapcar goes through the list below and marks the 2807 ;; This little mapcar goes through the list below and marks the
2739 ;; symbols in question as autoloaded functions. 2808 ;; symbols in question as autoloaded functions.
2740 (mapcar 2809 (mapc
2741 (lambda (package) 2810 (lambda (package)
2742 (let ((interactive (nth 1 (memq ':interactive package)))) 2811 (let ((interactive (nth 1 (memq ':interactive package))))
2743 (mapcar 2812 (mapcar
@@ -2836,7 +2905,7 @@ gnus-registry.el will populate this if it's loaded.")
2836 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view 2905 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2837 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view 2906 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2838 gnus-uu-decode-binhex-view gnus-uu-unmark-thread 2907 gnus-uu-decode-binhex-view gnus-uu-unmark-thread
2839 gnus-uu-mark-over gnus-uu-post-news) 2908 gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable)
2840 ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) 2909 ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
2841 ("gnus-msg" (gnus-summary-send-map keymap) 2910 ("gnus-msg" (gnus-summary-send-map keymap)
2842 gnus-article-mail gnus-copy-article-buffer gnus-extended-version) 2911 gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
@@ -2854,8 +2923,6 @@ gnus-registry.el will populate this if it's loaded.")
2854 gnus-summary-post-forward gnus-summary-wide-reply-with-original 2923 gnus-summary-post-forward gnus-summary-wide-reply-with-original
2855 gnus-summary-post-forward) 2924 gnus-summary-post-forward)
2856 ("gnus-picon" :interactive t gnus-treat-from-picon) 2925 ("gnus-picon" :interactive t gnus-treat-from-picon)
2857 ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
2858 gnus-grouplens-mode)
2859 ("smiley" :interactive t smiley-region) 2926 ("smiley" :interactive t smiley-region)
2860 ("gnus-win" gnus-configure-windows gnus-add-configuration) 2927 ("gnus-win" gnus-configure-windows gnus-add-configuration)
2861 ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group 2928 ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
@@ -2890,14 +2957,15 @@ gnus-registry.el will populate this if it's loaded.")
2890 gnus-article-hide-pem gnus-article-hide-signature 2957 gnus-article-hide-pem gnus-article-hide-signature
2891 gnus-article-strip-leading-blank-lines gnus-article-date-local 2958 gnus-article-strip-leading-blank-lines gnus-article-date-local
2892 gnus-article-date-original gnus-article-date-lapsed 2959 gnus-article-date-original gnus-article-date-lapsed
2893;; gnus-article-show-all-headers 2960 ;;gnus-article-show-all-headers
2894 gnus-article-edit-mode gnus-article-edit-article 2961 gnus-article-edit-mode gnus-article-edit-article
2895 gnus-article-edit-done gnus-article-decode-encoded-words 2962 gnus-article-edit-done gnus-article-decode-encoded-words
2896 gnus-start-date-timer gnus-stop-date-timer 2963 gnus-start-date-timer gnus-stop-date-timer
2897 gnus-mime-view-all-parts) 2964 gnus-mime-view-all-parts)
2898 ("gnus-int" gnus-request-type) 2965 ("gnus-int" gnus-request-type)
2899 ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 2966 ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
2900 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) 2967 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch
2968 gnus-check-reasonable-setup)
2901 ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article 2969 ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
2902 gnus-dup-enter-articles) 2970 gnus-dup-enter-articles)
2903 ("gnus-range" gnus-copy-sequence) 2971 ("gnus-range" gnus-copy-sequence)
@@ -2967,7 +3035,6 @@ with some simple extensions.
2967%z Article zcore (character) 3035%z Article zcore (character)
2968%t Number of articles under the current thread (number). 3036%t Number of articles under the current thread (number).
2969%e Whether the thread is empty or not (character). 3037%e Whether the thread is empty or not (character).
2970%l GroupLens score (string).
2971%V Total thread score (number). 3038%V Total thread score (number).
2972%P The line number (number). 3039%P The line number (number).
2973%O Download mark (character). 3040%O Download mark (character).
@@ -3146,11 +3213,9 @@ Return nil if not defined."
3146 3213
3147(defun gnus-shutdown (symbol) 3214(defun gnus-shutdown (symbol)
3148 "Shut down everything that waits for SYMBOL." 3215 "Shut down everything that waits for SYMBOL."
3149 (let ((alist gnus-shutdown-alist) 3216 (dolist (entry gnus-shutdown-alist)
3150 entry) 3217 (when (memq symbol (cdr entry))
3151 (while (setq entry (pop alist)) 3218 (funcall (car entry)))))
3152 (when (memq symbol (cdr entry))
3153 (funcall (car entry))))))
3154 3219
3155 3220
3156;;; 3221;;;
@@ -3416,7 +3481,7 @@ that that variable is buffer-local to the summary buffers."
3416(defun gnus-generate-new-group-name (leaf) 3481(defun gnus-generate-new-group-name (leaf)
3417 (let ((name leaf) 3482 (let ((name leaf)
3418 (num 0)) 3483 (num 0))
3419 (while (gnus-gethash name gnus-newsrc-hashtb) 3484 (while (gnus-group-entry name)
3420 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) 3485 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3421 name)) 3486 name))
3422 3487
@@ -3459,30 +3524,27 @@ that that variable is buffer-local to the summary buffers."
3459 3524
3460 ;; Perhaps it is already in the cache. 3525 ;; Perhaps it is already in the cache.
3461 (mapc (lambda (name-method) 3526 (mapc (lambda (name-method)
3462 (if (equal (cdr name-method) method) 3527 (if (equal (cdr name-method) method)
3463 (throw 'server-name (car name-method)))) 3528 (throw 'server-name (car name-method))))
3464 gnus-server-method-cache) 3529 gnus-server-method-cache)
3465 3530
3466 (mapc 3531 (mapc
3467 (lambda (server-alist) 3532 (lambda (server-alist)
3468 (mapc (lambda (name-method) 3533 (mapc (lambda (name-method)
3469 (when (gnus-methods-equal-p (cdr name-method) method) 3534 (when (gnus-methods-equal-p (cdr name-method) method)
3470 (unless (member name-method gnus-server-method-cache) 3535 (unless (member name-method gnus-server-method-cache)
3471 (push name-method gnus-server-method-cache)) 3536 (push name-method gnus-server-method-cache))
3472 (throw 'server-name (car name-method)))) 3537 (throw 'server-name (car name-method))))
3473 server-alist)) 3538 server-alist))
3474 (let ((alists (list gnus-server-alist 3539 (list gnus-server-alist
3475 gnus-predefined-server-alist))) 3540 gnus-predefined-server-alist))
3476 (if gnus-select-method
3477 (push (list (cons "native" gnus-select-method)) alists))
3478 alists))
3479 3541
3480 (let* ((name (if (member (cadr method) '(nil "")) 3542 (let* ((name (if (member (cadr method) '(nil ""))
3481 (format "%s" (car method)) 3543 (format "%s" (car method))
3482 (format "%s:%s" (car method) (cadr method)))) 3544 (format "%s:%s" (car method) (cadr method))))
3483 (name-method (cons name method))) 3545 (name-method (cons name method)))
3484 (unless (member name-method gnus-server-method-cache) 3546 (unless (member name-method gnus-server-method-cache)
3485 (push name-method gnus-server-method-cache)) 3547 (push name-method gnus-server-method-cache))
3486 name))) 3548 name)))
3487 3549
3488(defsubst gnus-server-to-method (server) 3550(defsubst gnus-server-to-method (server)
@@ -3795,7 +3857,7 @@ The function `gnus-group-find-parameter' will do that for you."
3795 (if simple-results 3857 (if simple-results
3796 ;; Found results; return them. 3858 ;; Found results; return them.
3797 (car simple-results) 3859 (car simple-results)
3798 ;; We didn't found it there, try `gnus-parameters'. 3860 ;; We didn't find it there, try `gnus-parameters'.
3799 (let ((result nil) 3861 (let ((result nil)
3800 (head nil) 3862 (head nil)
3801 (tail gnus-parameters)) 3863 (tail gnus-parameters))
@@ -4082,12 +4144,12 @@ If NEWSGROUP is nil, return the global kill file name instead."
4082 (and (not group) 4144 (and (not group)
4083 gnus-select-method) 4145 gnus-select-method)
4084 (and (not (gnus-group-entry group)) 4146 (and (not (gnus-group-entry group))
4085 ;; Killed or otherwise unknown group. 4147 ;; Killed or otherwise unknown group.
4086 (or 4148 (or
4087 ;; If we know a virtual server by that name, return its method. 4149 ;; If we know a virtual server by that name, return its method.
4088 (gnus-server-to-method (gnus-group-server group)) 4150 (gnus-server-to-method (gnus-group-server group))
4089 ;; Guess a new method as last resort. 4151 ;; Guess a new method as last resort.
4090 (gnus-group-name-to-method group))) 4152 (gnus-group-name-to-method group)))
4091 (let ((info (or info (gnus-get-info group))) 4153 (let ((info (or info (gnus-get-info group)))
4092 method) 4154 method)
4093 (if (or (not info) 4155 (if (or (not info)
@@ -4193,10 +4255,10 @@ Allow completion over sensible values."
4193 "Say whether METHOD is covered by the agent." 4255 "Say whether METHOD is covered by the agent."
4194 (or (eq (car gnus-agent-method-p-cache) method) 4256 (or (eq (car gnus-agent-method-p-cache) method)
4195 (setq gnus-agent-method-p-cache 4257 (setq gnus-agent-method-p-cache
4196 (cons method 4258 (cons method
4197 (member (if (stringp method) 4259 (member (if (stringp method)
4198 method 4260 method
4199 (gnus-method-to-server method)) gnus-agent-covered-methods)))) 4261 (gnus-method-to-server method)) gnus-agent-covered-methods))))
4200 (cdr gnus-agent-method-p-cache)) 4262 (cdr gnus-agent-method-p-cache))
4201 4263
4202(defun gnus-online (method) 4264(defun gnus-online (method)
diff --git a/lisp/gnus/hashcash.el b/lisp/gnus/hashcash.el
new file mode 100644
index 00000000000..737178b8218
--- /dev/null
+++ b/lisp/gnus/hashcash.el
@@ -0,0 +1,370 @@
1;;; hashcash.el --- Add hashcash payments to email
2
3;; Copyright (C) 2003, 2004, 2005, 2007 Free Software Foundation
4
5;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
6;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
7;; Keywords: mail, hashcash
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; The hashcash binary is at http://www.hashcash.org/.
29;;
30;; Call mail-add-payment to add a hashcash payment to a mail message
31;; in the current buffer.
32;;
33;; Call mail-add-payment-async after writing the addresses but before
34;; writing the mail to start calculating the hashcash payment
35;; asynchronously.
36;;
37;; The easiest way to do this automatically for all outgoing mail
38;; is to set `message-generate-hashcash' to t. If you want more
39;; control, try the following hooks.
40;;
41;; To automatically add payments to all outgoing mail when sending:
42;; (add-hook 'message-send-hook 'mail-add-payment)
43;;
44;; To start calculations automatically when addresses are prefilled:
45;; (add-hook 'message-setup-hook 'mail-add-payment-async)
46;;
47;; To check whether calculations are done before sending:
48;; (add-hook 'message-send-hook 'hashcash-wait-or-cancel)
49
50;;; Code:
51
52(defgroup hashcash nil
53 "Hashcash configuration."
54 :group 'mail)
55
56(defcustom hashcash-default-payment 20
57 "*The default number of bits to pay to unknown users.
58If this is zero, no payment header will be generated.
59See `hashcash-payment-alist'."
60 :type 'integer
61 :group 'hashcash)
62
63(defcustom hashcash-payment-alist '()
64 "*An association list mapping email addresses to payment amounts.
65Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
66ADDR is the email address of the intended recipient and AMOUNT is
67the value of hashcash payment to be made to that user. STRING, if
68present, is the string to be hashed; if not present ADDR will be used."
69 :type '(repeat (choice (list :tag "Normal"
70 (string :name "Address")
71 (integer :name "Amount"))
72 (list :tag "Replace hash input"
73 (string :name "Address")
74 (string :name "Hash input")
75 (integer :name "Amount"))))
76 :group 'hashcash)
77
78(defcustom hashcash-default-accept-payment 20
79 "*The default minimum number of bits to accept on incoming payments."
80 :type 'integer
81 :group 'hashcash)
82
83(defcustom hashcash-accept-resources `((,user-mail-address nil))
84 "*An association list mapping hashcash resources to payment amounts.
85Resources named here are to be accepted in incoming payments. If the
86corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
87is used instead."
88 :group 'hashcash)
89
90(defcustom hashcash-path (executable-find "hashcash")
91 "*The path to the hashcash binary."
92 :group 'hashcash)
93
94(defcustom hashcash-extra-generate-parameters nil
95 "*A list of parameter strings passed to `hashcash-path' when minting.
96For example, you may want to set this to '(\"-Z2\") to reduce header length."
97 :type '(repeat string)
98 :group 'hashcash)
99
100(defcustom hashcash-double-spend-database "hashcash.db"
101 "*The path to the double-spending database."
102 :group 'hashcash)
103
104(defcustom hashcash-in-news nil
105 "*Specifies whether or not hashcash payments should be made to newsgroups."
106 :type 'boolean
107 :group 'hashcash)
108
109(defvar hashcash-process-alist nil
110 "Alist of asynchronous hashcash processes and buffers.")
111
112(require 'mail-utils)
113
114(eval-and-compile
115 (if (fboundp 'point-at-bol)
116 (defalias 'hashcash-point-at-bol 'point-at-bol)
117 (defalias 'hashcash-point-at-bol 'line-beginning-position))
118
119 (if (fboundp 'point-at-eol)
120 (defalias 'hashcash-point-at-eol 'point-at-eol)
121 (defalias 'hashcash-point-at-eol 'line-end-position)))
122
123(defun hashcash-strip-quoted-names (addr)
124 (setq addr (mail-strip-quoted-names addr))
125 (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
126 (concat (match-string 1 addr) (match-string 2 addr))
127 addr))
128
129(defun hashcash-token-substring ()
130 (save-excursion
131 (let ((token ""))
132 (loop
133 (setq token
134 (concat token (buffer-substring (point) (hashcash-point-at-eol))))
135 (goto-char (hashcash-point-at-eol))
136 (forward-char 1)
137 (unless (looking-at "[ \t]") (return token))
138 (while (looking-at "[ \t]") (forward-char 1))))))
139
140(defun hashcash-payment-required (addr)
141 "Return the hashcash payment value required for the given address."
142 (let ((val (assoc addr hashcash-payment-alist)))
143 (or (nth 2 val) (nth 1 val) hashcash-default-payment)))
144
145(defun hashcash-payment-to (addr)
146 "Return the string with which hashcash payments should collide."
147 (let ((val (assoc addr hashcash-payment-alist)))
148 (or (nth 1 val) (nth 0 val) addr)))
149
150(defun hashcash-generate-payment (str val)
151 "Generate a hashcash payment by finding a VAL-bit collison on STR."
152 (if (and (> val 0)
153 hashcash-path)
154 (save-excursion
155 (set-buffer (get-buffer-create " *hashcash*"))
156 (erase-buffer)
157 (apply 'call-process hashcash-path nil t nil
158 "-m" "-q" "-b" (number-to-string val) str
159 hashcash-extra-generate-parameters)
160 (goto-char (point-min))
161 (hashcash-token-substring))
162 (error "No `hashcash' binary found")))
163
164(defun hashcash-generate-payment-async (str val callback)
165 "Generate a hashcash payment by finding a VAL-bit collison on STR.
166Return immediately. Call CALLBACK with process and result when ready."
167 (if (and (> val 0)
168 hashcash-path)
169 (let ((process (apply 'start-process "hashcash" nil
170 hashcash-path "-m" "-q"
171 "-b" (number-to-string val) str
172 hashcash-extra-generate-parameters)))
173 (setq hashcash-process-alist (cons
174 (cons process (current-buffer))
175 hashcash-process-alist))
176 (set-process-filter process `(lambda (process output)
177 (funcall ,callback process output))))
178 (funcall callback nil nil)))
179
180(defun hashcash-check-payment (token str val)
181 "Check the validity of a hashcash payment."
182 (if hashcash-path
183 (zerop (call-process hashcash-path nil nil nil "-c"
184 "-d" "-f" hashcash-double-spend-database
185 "-b" (number-to-string val)
186 "-r" str
187 token))
188 (progn
189 (message "No hashcash binary found")
190 (sleep-for 1)
191 nil)))
192
193(defun hashcash-version (token)
194 "Find the format version of a hashcash token."
195 ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx
196 ;; This carries its own version number embedded in the token,
197 ;; so no further format number changes should be necessary
198 ;; in the X-Payment header.
199 ;;
200 ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx
201 ;; You need to upgrade your hashcash binary.
202 ;;
203 ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx
204 ;; This is no longer supported.
205 (cond ((equal (aref token 1) ?:) 1.2)
206 ((equal (aref token 6) ?:) 1.1)
207 (t (error "Unknown hashcash format version"))))
208
209(defun hashcash-already-paid-p (recipient)
210 "Check for hashcash token to RECIPIENT in current buffer."
211 (save-excursion
212 (save-restriction
213 (message-narrow-to-headers-or-head)
214 (let ((token (message-fetch-field "x-hashcash"))
215 (case-fold-search t))
216 (and (stringp token)
217 (string-match (regexp-quote recipient) token))))))
218
219;;;###autoload
220(defun hashcash-insert-payment (arg)
221 "Insert X-Payment and X-Hashcash headers with a payment for ARG"
222 (interactive "sPay to: ")
223 (unless (hashcash-already-paid-p arg)
224 (let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
225 (hashcash-payment-required arg))))
226 (when pay
227 (insert-before-markers "X-Hashcash: " pay "\n")))))
228
229;;;###autoload
230(defun hashcash-insert-payment-async (arg)
231 "Insert X-Payment and X-Hashcash headers with a payment for ARG
232Only start calculation. Results are inserted when ready."
233 (interactive "sPay to: ")
234 (unless (hashcash-already-paid-p arg)
235 (hashcash-generate-payment-async
236 (hashcash-payment-to arg)
237 (hashcash-payment-required arg)
238 `(lambda (process payment)
239 (hashcash-insert-payment-async-2 ,(current-buffer) process payment)))))
240
241(defun hashcash-insert-payment-async-2 (buffer process pay)
242 (when (buffer-live-p buffer)
243 (with-current-buffer buffer
244 (save-excursion
245 (save-restriction
246 (setq hashcash-process-alist (delq
247 (assq process hashcash-process-alist)
248 hashcash-process-alist))
249 (message-goto-eoh)
250 (when pay
251 (insert-before-markers "X-Hashcash: " pay)))))))
252
253(defun hashcash-cancel-async (&optional buffer)
254 "Delete any hashcash processes associated with BUFFER.
255BUFFER defaults to the current buffer."
256 (interactive)
257 (unless buffer (setq buffer (current-buffer)))
258 (let (entry)
259 (while (setq entry (rassq buffer hashcash-process-alist))
260 (delete-process (car entry))
261 (setq hashcash-process-alist
262 (delq entry hashcash-process-alist)))))
263
264(defun hashcash-wait-async (&optional buffer)
265 "Wait for asynchronous hashcash processes in BUFFER to finish.
266BUFFER defaults to the current buffer."
267 (interactive)
268 (unless buffer (setq buffer (current-buffer)))
269 (let (entry)
270 (while (setq entry (rassq buffer hashcash-process-alist))
271 (accept-process-output (car entry)))))
272
273(defun hashcash-processes-running-p (buffer)
274 "Return non-nil if hashcash processes in BUFFER are still running."
275 (rassq buffer hashcash-process-alist))
276
277(defun hashcash-wait-or-cancel ()
278 "Ask user whether to wait for hashcash processes to finish."
279 (interactive)
280 (when (hashcash-processes-running-p (current-buffer))
281 (if (y-or-n-p
282 "Hashcash process(es) still running; wait for them to finish? ")
283 (hashcash-wait-async)
284 (hashcash-cancel-async))))
285
286;;;###autoload
287(defun hashcash-verify-payment (token &optional resource amount)
288 "Verify a hashcash payment"
289 (let* ((split (split-string token ":"))
290 (key (if (< (hashcash-version token) 1.2)
291 (nth 1 split)
292 (case (string-to-number (nth 0 split))
293 (0 (nth 2 split))
294 (1 (nth 3 split))))))
295 (cond ((null resource)
296 (let ((elt (assoc key hashcash-accept-resources)))
297 (and elt (hashcash-check-payment token (car elt)
298 (or (cadr elt) hashcash-default-accept-payment)))))
299 ((equal token key)
300 (hashcash-check-payment token resource
301 (or amount hashcash-default-accept-payment)))
302 (t nil))))
303
304;;;###autoload
305(defun mail-add-payment (&optional arg async)
306 "Add X-Payment: and X-Hashcash: headers with a hashcash payment
307for each recipient address. Prefix arg sets default payment temporarily.
308Set ASYNC to t to start asynchronous calculation. (See
309`mail-add-payment-async')."
310 (interactive "P")
311 (let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
312 hashcash-default-payment))
313 (addrlist nil))
314 (save-excursion
315 (save-restriction
316 (message-narrow-to-headers)
317 (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
318 (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
319 (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
320 nil t))))
321 (when to
322 (setq addrlist (split-string to ",[ \t\n]*")))
323 (when cc
324 (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
325 (when (and hashcash-in-news ng)
326 (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
327 (when addrlist
328 (mapc (if async
329 #'hashcash-insert-payment-async
330 #'hashcash-insert-payment)
331 addrlist)))))
332 t)
333
334;;;###autoload
335(defun mail-add-payment-async (&optional arg)
336 "Add X-Payment: and X-Hashcash: headers with a hashcash payment
337for each recipient address. Prefix arg sets default payment temporarily.
338Calculation is asynchronous."
339 (interactive "P")
340 (mail-add-payment arg t))
341
342;;;###autoload
343(defun mail-check-payment (&optional arg)
344 "Look for a valid X-Payment: or X-Hashcash: header.
345Prefix arg sets default accept amount temporarily."
346 (interactive "P")
347 (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
348 hashcash-default-accept-payment))
349 (version (hashcash-version (hashcash-generate-payment "x" 1))))
350 (save-excursion
351 (goto-char (point-min))
352 (search-forward "\n\n")
353 (beginning-of-line)
354 (let ((end (point))
355 (ok nil))
356 (goto-char (point-min))
357 (while (and (not ok) (search-forward "X-Payment: hashcash " end t))
358 (let ((value (split-string (hashcash-token-substring) " ")))
359 (when (equal (car value) (number-to-string version))
360 (setq ok (hashcash-verify-payment (cadr value))))))
361 (goto-char (point-min))
362 (while (and (not ok) (search-forward "X-Hashcash: " end t))
363 (setq ok (hashcash-verify-payment (hashcash-token-substring))))
364 (when ok
365 (message "Payment valid"))
366 ok))))
367
368(provide 'hashcash)
369
370;;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62
diff --git a/lisp/gnus/hmac-def.el b/lisp/gnus/hmac-def.el
new file mode 100644
index 00000000000..58491ec4f4a
--- /dev/null
+++ b/lisp/gnus/hmac-def.el
@@ -0,0 +1,86 @@
1;;; hmac-def.el --- A macro for defining HMAC functions.
2
3;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
4
5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6;; Keywords: HMAC, RFC 2104
7
8;; This file is part of FLIM (Faithful Library about Internet Message).
9
10;; This program is free software; you can redistribute it and/or
11;; modify it under the terms of the GNU General Public License as
12;; published by the Free Software Foundation; either version 3, or
13;; (at your option) any later version.
14
15;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with this program; see the file COPYING. If not, write to
22;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This program is implemented from RFC 2104,
28;; "HMAC: Keyed-Hashing for Message Authentication".
29
30;;; Code:
31
32(defmacro define-hmac-function (name H B L &optional bit)
33 "Define a function NAME(TEXT KEY) which computes HMAC with function H.
34
35HMAC function is H(KEY XOR opad, H(KEY XOR ipad, TEXT)):
36
37H is a cryptographic hash function, such as SHA1 and MD5, which takes
38a string and return a digest of it (in binary form).
39B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.)
40L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.)
41If BIT is non-nil, truncate output to specified bits."
42 `(defun ,name (text key)
43 ,(concat "Compute "
44 (upcase (symbol-name name))
45 " over TEXT with KEY.")
46 (let ((key-xor-ipad (make-string ,B ?\x36))
47 (key-xor-opad (make-string ,B ?\x5C))
48 (len (length key))
49 (pos 0))
50 (unwind-protect
51 (progn
52 ;; if `key' is longer than the block size, apply hash function
53 ;; to `key' and use the result as a real `key'.
54 (if (> len ,B)
55 (setq key (,H key)
56 len ,L))
57 (while (< pos len)
58 (aset key-xor-ipad pos (logxor (aref key pos) ?\x36))
59 (aset key-xor-opad pos (logxor (aref key pos) ?\x5C))
60 (setq pos (1+ pos)))
61 (setq key-xor-ipad (unwind-protect
62 (concat key-xor-ipad text)
63 (fillarray key-xor-ipad 0))
64 key-xor-ipad (unwind-protect
65 (,H key-xor-ipad)
66 (fillarray key-xor-ipad 0))
67 key-xor-opad (unwind-protect
68 (concat key-xor-opad key-xor-ipad)
69 (fillarray key-xor-opad 0))
70 key-xor-opad (unwind-protect
71 (,H key-xor-opad)
72 (fillarray key-xor-opad 0)))
73 ;; now `key-xor-opad' contains
74 ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)).
75 ,(if (and bit (< (/ bit 8) L))
76 `(substring key-xor-opad 0 ,(/ bit 8))
77 ;; return a copy of `key-xor-opad'.
78 `(concat key-xor-opad)))
79 ;; cleanup.
80 (fillarray key-xor-ipad 0)
81 (fillarray key-xor-opad 0)))))
82
83(provide 'hmac-def)
84
85;;; arch-tag: 645adcef-b835-4900-a10a-11f636c982b9
86;;; hmac-def.el ends here
diff --git a/lisp/gnus/hmac-md5.el b/lisp/gnus/hmac-md5.el
new file mode 100644
index 00000000000..21fc91992ad
--- /dev/null
+++ b/lisp/gnus/hmac-md5.el
@@ -0,0 +1,85 @@
1;;; hmac-md5.el --- Compute HMAC-MD5.
2
3;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
4
5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
7
8;; This file is part of FLIM (Faithful Library about Internet Message).
9
10;; This program is free software; you can redistribute it and/or
11;; modify it under the terms of the GNU General Public License as
12;; published by the Free Software Foundation; either version 3, or
13;; (at your option) any later version.
14
15;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with this program; see the file COPYING. If not, write to
22;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
28;;
29;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
30;; => "9294727a3638bb1c13f48ef8158bfc9d"
31;;
32;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe"))
33;; => "750c783e6ab0b503eaa86e310a5db738"
34;;
35;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa)))
36;; => "56be34521d144c88dbb8c733f0e8b3f6"
37;;
38;; (encode-hex-string
39;; (hmac-md5
40;; (make-string 50 ?\xcd)
41;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
42;; => "697eaf0aca3a3aea3a75164746ffaa79"
43;;
44;; (encode-hex-string
45;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
46;; => "56461ef2342edc00f9bab995690efd4c"
47;;
48;; (encode-hex-string
49;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
50;; => "56461ef2342edc00f9bab995"
51;;
52;; (encode-hex-string
53;; (hmac-md5
54;; "Test Using Larger Than Block-Size Key - Hash Key First"
55;; (make-string 80 ?\xaa)))
56;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
57;;
58;; (encode-hex-string
59;; (hmac-md5
60;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
61;; (make-string 80 ?\xaa)))
62;; => "6f630fad67cda0ee1fb1f562db3aa53e"
63
64;;; Code:
65
66(eval-when-compile (require 'hmac-def))
67(require 'hex-util) ; (decode-hex-string STRING)
68(require 'md5) ; expects (md5 STRING)
69
70(defun md5-binary (string)
71 "Return the MD5 of STRING in binary form."
72 (if (condition-case nil
73 ;; `md5' of v21 takes 4th arg CODING (and 5th arg NOERROR).
74 (md5 "" nil nil 'binary) ; => "d41d8cd98f00b204e9800998ecf8427e"
75 (wrong-number-of-arguments nil))
76 (decode-hex-string (md5 string nil nil 'binary))
77 (decode-hex-string (md5 string))))
78
79(define-hmac-function hmac-md5 md5-binary 64 16) ; => (hmac-md5 TEXT KEY)
80(define-hmac-function hmac-md5-96 md5-binary 64 16 96)
81
82(provide 'hmac-md5)
83
84;;; arch-tag: 0ab3f4f6-3d4b-4167-a9fa-635b7fed7f27
85;;; hmac-md5.el ends here
diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el
index 9f0916f797b..6de2904adb4 100644
--- a/lisp/gnus/html2text.el
+++ b/lisp/gnus/html2text.el
@@ -43,8 +43,42 @@
43(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr))) 43(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
44 44
45(defvar html2text-replace-list 45(defvar html2text-replace-list
46 '(("&nbsp;" . " ") ("&gt;" . ">") ("&lt;" . "<") ("&quot;" . "\"") 46 '(("&acute;" . "`")
47 ("&amp;" . "&") ("&apos;" . "'")) 47 ("&amp;" . "&")
48 ("&apos;" . "'")
49 ("&brvbar;" . "|")
50 ("&cent;" . "c")
51 ("&circ;" . "^")
52 ("&copy;" . "(C)")
53 ("&curren;" . "(#)")
54 ("&deg;" . "degree")
55 ("&divide;" . "/")
56 ("&euro;" . "e")
57 ("&frac12;" . "1/2")
58 ("&gt;" . ">")
59 ("&iquest;" . "?")
60 ("&laquo;" . "<<")
61 ("&ldquo" . "\"")
62 ("&lsaquo;" . "(")
63 ("&lsquo;" . "`")
64 ("&lt;" . "<")
65 ("&mdash;" . "--")
66 ("&nbsp;" . " ")
67 ("&ndash;" . "-")
68 ("&permil;" . "%%")
69 ("&plusmn;" . "+-")
70 ("&pound;" . "£")
71 ("&quot;" . "\"")
72 ("&raquo;" . ">>")
73 ("&rdquo" . "\"")
74 ("&reg;" . "(R)")
75 ("&rsaquo;" . ")")
76 ("&rsquo;" . "'")
77 ("&sect;" . "§")
78 ("&sup1;" . "^1")
79 ("&sup2;" . "^2")
80 ("&sup3;" . "^3")
81 ("&tilde;" . "~"))
48 "The map of entity to text. 82 "The map of entity to text.
49 83
50This is an alist were each element is a dotted pair consisting of an 84This is an alist were each element is a dotted pair consisting of an
@@ -229,12 +263,12 @@ formatting, and then moved afterward.")
229 (goto-char p1) 263 (goto-char p1)
230 (let ((item-nr 0) 264 (let ((item-nr 0)
231 (items 0)) 265 (items 0))
232 (while (re-search-forward "<li>" p2 t) 266 (while (search-forward "<li>" p2 t)
233 (setq items (1+ items))) 267 (setq items (1+ items)))
234 (goto-char p1) 268 (goto-char p1)
235 (while (< item-nr items) 269 (while (< item-nr items)
236 (setq item-nr (1+ item-nr)) 270 (setq item-nr (1+ item-nr))
237 (re-search-forward "<li>" (point-max) t) 271 (search-forward "<li>" (point-max) t)
238 (cond 272 (cond
239 ((string= list-type "ul") (insert " o ")) 273 ((string= list-type "ul") (insert " o "))
240 ((string= list-type "ol") (insert (format " %s: " item-nr))) 274 ((string= list-type "ol") (insert (format " %s: " item-nr)))
@@ -244,7 +278,7 @@ formatting, and then moved afterward.")
244 (goto-char p1) 278 (goto-char p1)
245 (let ((items 0) 279 (let ((items 0)
246 (item-nr 0)) 280 (item-nr 0))
247 (while (re-search-forward "<dt>" p2 t) 281 (while (search-forward "<dt>" p2 t)
248 (setq items (1+ items))) 282 (setq items (1+ items)))
249 (goto-char p1) 283 (goto-char p1)
250 (while (< item-nr items) 284 (while (< item-nr items)
@@ -342,8 +376,7 @@ formatting, and then moved afterward.")
342 376
343(defun html2text-fix-paragraph (p1 p2) 377(defun html2text-fix-paragraph (p1 p2)
344 (goto-char p1) 378 (goto-char p1)
345 (let ((has-br-line) 379 (let ((refill-start)
346 (refill-start)
347 (refill-stop)) 380 (refill-stop))
348 (when (re-search-forward "<br>$" p2 t) 381 (when (re-search-forward "<br>$" p2 t)
349 (goto-char p1) 382 (goto-char p1)
diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el
index a02762804f7..81d66aa3093 100644
--- a/lisp/gnus/ietf-drums.el
+++ b/lisp/gnus/ietf-drums.el
@@ -99,14 +99,14 @@ backslash and doublequote.")
99 (push c out))) 99 (push c out)))
100 (range 100 (range
101 (while (<= b c) 101 (while (<= b c)
102 (push (mm-make-char 'ascii b) out) 102 (push (make-char 'ascii b) out)
103 (incf b)) 103 (incf b))
104 (setq range nil)) 104 (setq range nil))
105 ((= i (length token)) 105 ((= i (length token))
106 (push (mm-make-char 'ascii c) out)) 106 (push (make-char 'ascii c) out))
107 (t 107 (t
108 (when b 108 (when b
109 (push (mm-make-char 'ascii b) out)) 109 (push (make-char 'ascii b) out))
110 (setq b c)))) 110 (setq b c))))
111 (nreverse out))) 111 (nreverse out)))
112 112
@@ -200,7 +200,9 @@ backslash and doublequote.")
200 (buffer-substring 200 (buffer-substring
201 (1+ (point)) 201 (1+ (point))
202 (progn (forward-sexp 1) (1- (point)))))))) 202 (progn (forward-sexp 1) (1- (point))))))))
203 (t (error "Unknown symbol: %c" c)))) 203 (t
204 (message "Unknown symbol: %c" c)
205 (forward-char 1))))
204 ;; If we found no display-name, then we look for comments. 206 ;; If we found no display-name, then we look for comments.
205 (if display-name 207 (if display-name
206 (setq display-string 208 (setq display-string
@@ -213,8 +215,10 @@ backslash and doublequote.")
213 (ietf-drums-get-comment string))) 215 (ietf-drums-get-comment string)))
214 (cons mailbox display-string))))) 216 (cons mailbox display-string)))))
215 217
216(defun ietf-drums-parse-addresses (string) 218(defun ietf-drums-parse-addresses (string &optional rawp)
217 "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." 219 "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs.
220If RAWP, don't actually parse the addresses, but instead return
221a list of address strings."
218 (if (null string) 222 (if (null string)
219 nil 223 nil
220 (with-temp-buffer 224 (with-temp-buffer
@@ -231,20 +235,24 @@ backslash and doublequote.")
231 (skip-chars-forward "^,")))) 235 (skip-chars-forward "^,"))))
232 ((eq c ?,) 236 ((eq c ?,)
233 (setq address 237 (setq address
234 (condition-case nil 238 (if rawp
235 (ietf-drums-parse-address 239 (buffer-substring beg (point))
236 (buffer-substring beg (point))) 240 (condition-case nil
237 (error nil))) 241 (ietf-drums-parse-address
242 (buffer-substring beg (point)))
243 (error nil))))
238 (if address (push address pairs)) 244 (if address (push address pairs))
239 (forward-char 1) 245 (forward-char 1)
240 (setq beg (point))) 246 (setq beg (point)))
241 (t 247 (t
242 (forward-char 1)))) 248 (forward-char 1))))
243 (setq address 249 (setq address
244 (condition-case nil 250 (if rawp
245 (ietf-drums-parse-address 251 (buffer-substring beg (point))
246 (buffer-substring beg (point))) 252 (condition-case nil
247 (error nil))) 253 (ietf-drums-parse-address
254 (buffer-substring beg (point)))
255 (error nil))))
248 (if address (push address pairs)) 256 (if address (push address pairs))
249 (nreverse pairs))))) 257 (nreverse pairs)))))
250 258
@@ -274,6 +282,11 @@ backslash and doublequote.")
274 (concat "\"" string "\"") 282 (concat "\"" string "\"")
275 string)) 283 string))
276 284
285(defun ietf-drums-make-address (name address)
286 (if name
287 (concat (ietf-drums-quote-string name) " <" address ">")
288 address))
289
277(provide 'ietf-drums) 290(provide 'ietf-drums)
278 291
279;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9 292;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el
index f60801e9ba8..7643ef4a53d 100644
--- a/lisp/gnus/imap.el
+++ b/lisp/gnus/imap.el
@@ -74,13 +74,13 @@
74;; explanatory for someone that know IMAP. All functions have 74;; explanatory for someone that know IMAP. All functions have
75;; additional documentation on how to invoke them. 75;; additional documentation on how to invoke them.
76;; 76;;
77;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP 77;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented
78;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 78;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
79;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, 79;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
80;; LOGINDISABLED) (with use of external library starttls.el and 80;; LOGINDISABLED) (with use of external library starttls.el and
81;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 81;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731
82;; (with use of external program `imtest'). It also takes advantage of 82;; (with use of external program `imtest'), RFC2971 (ID). It also
83;; the UNSELECT extension in Cyrus IMAPD. 83;; takes advantage of the UNSELECT extension in Cyrus IMAPD.
84;; 84;;
85;; Without the work of John McClary Prevost and Jim Radford this library 85;; Without the work of John McClary Prevost and Jim Radford this library
86;; would not have seen the light of day. Many thanks. 86;; would not have seen the light of day. Many thanks.
@@ -140,29 +140,19 @@
140 140
141(eval-when-compile (require 'cl)) 141(eval-when-compile (require 'cl))
142(eval-and-compile 142(eval-and-compile
143 (autoload 'base64-decode-string "base64")
144 (autoload 'base64-encode-string "base64")
145 (autoload 'starttls-open-stream "starttls") 143 (autoload 'starttls-open-stream "starttls")
146 (autoload 'starttls-negotiate "starttls") 144 (autoload 'starttls-negotiate "starttls")
145 (autoload 'sasl-find-mechanism "sasl")
147 (autoload 'digest-md5-parse-digest-challenge "digest-md5") 146 (autoload 'digest-md5-parse-digest-challenge "digest-md5")
148 (autoload 'digest-md5-digest-response "digest-md5") 147 (autoload 'digest-md5-digest-response "digest-md5")
149 (autoload 'digest-md5-digest-uri "digest-md5") 148 (autoload 'digest-md5-digest-uri "digest-md5")
150 (autoload 'digest-md5-challenge "digest-md5") 149 (autoload 'digest-md5-challenge "digest-md5")
151 (autoload 'rfc2104-hash "rfc2104") 150 (autoload 'rfc2104-hash "rfc2104")
152 (autoload 'md5 "md5")
153 (autoload 'utf7-encode "utf7") 151 (autoload 'utf7-encode "utf7")
154 (autoload 'utf7-decode "utf7") 152 (autoload 'utf7-decode "utf7")
155 (autoload 'format-spec "format-spec") 153 (autoload 'format-spec "format-spec")
156 (autoload 'format-spec-make "format-spec") 154 (autoload 'format-spec-make "format-spec")
157 (autoload 'open-tls-stream "tls") 155 (autoload 'open-tls-stream "tls"))
158 ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These
159 ;; days we have point-at-eol anyhow.
160 (if (fboundp 'point-at-eol)
161 (defalias 'imap-point-at-eol 'point-at-eol)
162 (defun imap-point-at-eol ()
163 (save-excursion
164 (end-of-line)
165 (point)))))
166 156
167;; User variables. 157;; User variables.
168 158
@@ -311,6 +301,7 @@ stream.")
311 kerberos4 301 kerberos4
312 digest-md5 302 digest-md5
313 cram-md5 303 cram-md5
304 ;;sasl
314 login 305 login
315 anonymous) 306 anonymous)
316 "Priority of authenticators to consider when authenticating to server.") 307 "Priority of authenticators to consider when authenticating to server.")
@@ -318,6 +309,7 @@ stream.")
318(defvar imap-authenticator-alist 309(defvar imap-authenticator-alist
319 '((gssapi imap-gssapi-auth-p imap-gssapi-auth) 310 '((gssapi imap-gssapi-auth-p imap-gssapi-auth)
320 (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth) 311 (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth)
312 (sasl imap-sasl-auth-p imap-sasl-auth)
321 (cram-md5 imap-cram-md5-p imap-cram-md5-auth) 313 (cram-md5 imap-cram-md5-p imap-cram-md5-auth)
322 (login imap-login-p imap-login-auth) 314 (login imap-login-p imap-login-auth)
323 (anonymous imap-anonymous-p imap-anonymous-auth) 315 (anonymous imap-anonymous-p imap-anonymous-auth)
@@ -333,6 +325,13 @@ for doing the actual authentication.")
333(defvar imap-error nil 325(defvar imap-error nil
334 "Error codes from the last command.") 326 "Error codes from the last command.")
335 327
328(defvar imap-logout-timeout nil
329 "Close server immediately if it can't logout in this number of seconds.
330If it is nil, never close server until logout completes. Normally,
331the value of this variable will be bound to a certain value to which
332an application program that uses this module specifies on a per-server
333basis.")
334
336;; Internal constants. Change these and die. 335;; Internal constants. Change these and die.
337 336
338(defconst imap-default-port 143) 337(defconst imap-default-port 143)
@@ -353,6 +352,7 @@ for doing the actual authentication.")
353 imap-current-target-mailbox 352 imap-current-target-mailbox
354 imap-message-data 353 imap-message-data
355 imap-capability 354 imap-capability
355 imap-id
356 imap-namespace 356 imap-namespace
357 imap-state 357 imap-state
358 imap-reached-tag 358 imap-reached-tag
@@ -408,6 +408,10 @@ and `examine'.")
408(defvar imap-capability nil 408(defvar imap-capability nil
409 "Capability for server.") 409 "Capability for server.")
410 410
411(defvar imap-id nil
412 "Identity of server.
413See RFC 2971.")
414
411(defvar imap-namespace nil 415(defvar imap-namespace nil
412 "Namespace for current server.") 416 "Namespace for current server.")
413 417
@@ -557,7 +561,7 @@ sure of changing the value of `foo'."
557 (not (string-match "failed" response)))) 561 (not (string-match "failed" response))))
558 (setq done process) 562 (setq done process)
559 (if (memq (process-status process) '(open run)) 563 (if (memq (process-status process) '(open run))
560 (imap-send-command "LOGOUT")) 564 (imap-logout))
561 (delete-process process) 565 (delete-process process)
562 nil))))) 566 nil)))))
563 done)) 567 done))
@@ -632,7 +636,7 @@ sure of changing the value of `foo'."
632 (not (string-match "failed" response)))) 636 (not (string-match "failed" response))))
633 (setq done process) 637 (setq done process)
634 (if (memq (process-status process) '(open run)) 638 (if (memq (process-status process) '(open run))
635 (imap-send-command "LOGOUT")) 639 (imap-logout))
636 (delete-process process) 640 (delete-process process)
637 nil))))) 641 nil)))))
638 done)) 642 done))
@@ -915,14 +919,27 @@ Returns t if login was successful, nil otherwise."
915 (and (not (imap-capability 'LOGINDISABLED buffer)) 919 (and (not (imap-capability 'LOGINDISABLED buffer))
916 (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))) 920 (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
917 921
922(defun imap-quote-specials (string)
923 (with-temp-buffer
924 (insert string)
925 (goto-char (point-min))
926 (while (re-search-forward "[\\\"]" nil t)
927 (forward-char -1)
928 (insert "\\")
929 (forward-char 1))
930 (buffer-string)))
931
918(defun imap-login-auth (buffer) 932(defun imap-login-auth (buffer)
919 "Login to server using the LOGIN command." 933 "Login to server using the LOGIN command."
920 (message "imap: Plaintext authentication...") 934 (message "imap: Plaintext authentication...")
921 (imap-interactive-login buffer 935 (imap-interactive-login buffer
922 (lambda (user passwd) 936 (lambda (user passwd)
923 (imap-ok-p (imap-send-command-wait 937 (imap-ok-p (imap-send-command-wait
924 (concat "LOGIN \"" user "\" \"" 938 (concat "LOGIN \""
925 passwd "\"")))))) 939 (imap-quote-specials user)
940 "\" \""
941 (imap-quote-specials passwd)
942 "\""))))))
926 943
927(defun imap-anonymous-p (buffer) 944(defun imap-anonymous-p (buffer)
928 t) 945 t)
@@ -934,6 +951,66 @@ Returns t if login was successful, nil otherwise."
934 (concat "LOGIN anonymous \"" (concat (user-login-name) "@" 951 (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
935 (system-name)) "\""))))) 952 (system-name)) "\"")))))
936 953
954;;; Compiler directives.
955
956(defvar imap-sasl-client)
957(defvar imap-sasl-step)
958
959(defun imap-sasl-make-mechanisms (buffer)
960 (let ((mecs '()))
961 (mapc (lambda (sym)
962 (let ((name (symbol-name sym)))
963 (if (and (> (length name) 5)
964 (string-equal "AUTH=" (substring name 0 5 )))
965 (setq mecs (cons (substring name 5) mecs)))))
966 (imap-capability nil buffer))
967 mecs))
968
969(defun imap-sasl-auth-p (buffer)
970 (and (condition-case ()
971 (require 'sasl)
972 (error nil))
973 (sasl-find-mechanism (imap-sasl-make-mechanisms buffer))))
974
975(defun imap-sasl-auth (buffer)
976 "Login to server using the SASL method."
977 (message "imap: Authenticating using SASL...")
978 (with-current-buffer buffer
979 (make-local-variable 'imap-username)
980 (make-local-variable 'imap-sasl-client)
981 (make-local-variable 'imap-sasl-step)
982 (let ((mechanism (sasl-find-mechanism (imap-sasl-make-mechanisms buffer)))
983 logged user)
984 (while (not logged)
985 (setq user (or imap-username
986 (read-from-minibuffer
987 (concat "IMAP username for " imap-server " using SASL "
988 (sasl-mechanism-name mechanism) ": ")
989 (or user imap-default-user))))
990 (when user
991 (setq imap-sasl-client (sasl-make-client mechanism user "imap2" imap-server)
992 imap-sasl-step (sasl-next-step imap-sasl-client nil))
993 (let ((tag (imap-send-command
994 (if (sasl-step-data imap-sasl-step)
995 (format "AUTHENTICATE %s %s"
996 (sasl-mechanism-name mechanism)
997 (sasl-step-data imap-sasl-step))
998 (format "AUTHENTICATE %s" (sasl-mechanism-name mechanism)))
999 buffer)))
1000 (while (eq (imap-wait-for-tag tag) 'INCOMPLETE)
1001 (sasl-step-set-data imap-sasl-step (base64-decode-string imap-continuation))
1002 (setq imap-continuation nil
1003 imap-sasl-step (sasl-next-step imap-sasl-client imap-sasl-step))
1004 (imap-send-command-1 (if (sasl-step-data imap-sasl-step)
1005 (base64-encode-string (sasl-step-data imap-sasl-step) t)
1006 "")))
1007 (if (imap-ok-p (imap-wait-for-tag tag))
1008 (setq imap-username user
1009 logged t)
1010 (message "Login failed...")
1011 (sit-for 1)))))
1012 logged)))
1013
937(defun imap-digest-md5-p (buffer) 1014(defun imap-digest-md5-p (buffer)
938 (and (imap-capability 'AUTH=DIGEST-MD5 buffer) 1015 (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
939 (condition-case () 1016 (condition-case ()
@@ -1006,7 +1083,7 @@ necessary. If nil, the buffer name is generated."
1006 (with-current-buffer (get-buffer-create buffer) 1083 (with-current-buffer (get-buffer-create buffer)
1007 (if (imap-opened buffer) 1084 (if (imap-opened buffer)
1008 (imap-close buffer)) 1085 (imap-close buffer))
1009 (mapcar 'make-local-variable imap-local-variables) 1086 (mapc 'make-local-variable imap-local-variables)
1010 (imap-disable-multibyte) 1087 (imap-disable-multibyte)
1011 (buffer-disable-undo) 1088 (buffer-disable-undo)
1012 (setq imap-server (or server imap-server)) 1089 (setq imap-server (or server imap-server))
@@ -1029,7 +1106,7 @@ necessary. If nil, the buffer name is generated."
1029 (if (not (eq imap-default-stream stream)) 1106 (if (not (eq imap-default-stream stream))
1030 (with-current-buffer (get-buffer-create 1107 (with-current-buffer (get-buffer-create
1031 (generate-new-buffer-name " *temp*")) 1108 (generate-new-buffer-name " *temp*"))
1032 (mapcar 'make-local-variable imap-local-variables) 1109 (mapc 'make-local-variable imap-local-variables)
1033 (imap-disable-multibyte) 1110 (imap-disable-multibyte)
1034 (buffer-disable-undo) 1111 (buffer-disable-undo)
1035 (setq imap-server (or server imap-server)) 1112 (setq imap-server (or server imap-server))
@@ -1084,7 +1161,7 @@ password is remembered in the buffer."
1084 (with-current-buffer (or buffer (current-buffer)) 1161 (with-current-buffer (or buffer (current-buffer))
1085 (if (not (eq imap-state 'nonauth)) 1162 (if (not (eq imap-state 'nonauth))
1086 (or (eq imap-state 'auth) 1163 (or (eq imap-state 'auth)
1087 (eq imap-state 'select) 1164 (eq imap-state 'selected)
1088 (eq imap-state 'examine)) 1165 (eq imap-state 'examine))
1089 (make-local-variable 'imap-username) 1166 (make-local-variable 'imap-username)
1090 (make-local-variable 'imap-password) 1167 (make-local-variable 'imap-password)
@@ -1118,7 +1195,7 @@ If BUFFER is nil, the current buffer is used."
1118 (with-current-buffer (or buffer (current-buffer)) 1195 (with-current-buffer (or buffer (current-buffer))
1119 (when (imap-opened) 1196 (when (imap-opened)
1120 (condition-case nil 1197 (condition-case nil
1121 (imap-send-command-wait "LOGOUT") 1198 (imap-logout-wait)
1122 (quit nil))) 1199 (quit nil)))
1123 (when (and imap-process 1200 (when (and imap-process
1124 (memq (process-status imap-process) '(open run))) 1201 (memq (process-status imap-process) '(open run)))
@@ -1141,6 +1218,26 @@ If BUFFER is nil, the current buffer is assumed."
1141 (memq (intern (upcase (symbol-name identifier))) imap-capability) 1218 (memq (intern (upcase (symbol-name identifier))) imap-capability)
1142 imap-capability))) 1219 imap-capability)))
1143 1220
1221(defun imap-id (&optional list-of-values buffer)
1222 "Identify client to server in BUFFER, and return server identity.
1223LIST-OF-VALUES is nil, or a plist with identifier and value
1224strings to send to the server to identify the client.
1225
1226Return a list of identifiers which server in BUFFER support, or
1227nil if it doesn't support ID or returns no information.
1228
1229If BUFFER is nil, the current buffer is assumed."
1230 (with-current-buffer (or buffer (current-buffer))
1231 (when (and (imap-capability 'ID)
1232 (imap-ok-p (imap-send-command-wait
1233 (if (null list-of-values)
1234 "ID NIL"
1235 (concat "ID (" (mapconcat (lambda (el)
1236 (concat "\"" el "\""))
1237 list-of-values
1238 " ") ")")))))
1239 imap-id)))
1240
1144(defun imap-namespace (&optional buffer) 1241(defun imap-namespace (&optional buffer)
1145 "Return a namespace hierarchy at server in BUFFER. 1242 "Return a namespace hierarchy at server in BUFFER.
1146If BUFFER is nil, the current buffer is assumed." 1243If BUFFER is nil, the current buffer is assumed."
@@ -1153,6 +1250,28 @@ If BUFFER is nil, the current buffer is assumed."
1153(defun imap-send-command-wait (command &optional buffer) 1250(defun imap-send-command-wait (command &optional buffer)
1154 (imap-wait-for-tag (imap-send-command command buffer) buffer)) 1251 (imap-wait-for-tag (imap-send-command command buffer) buffer))
1155 1252
1253(defun imap-logout (&optional buffer)
1254 (or buffer (setq buffer (current-buffer)))
1255 (if imap-logout-timeout
1256 (with-timeout (imap-logout-timeout
1257 (condition-case nil
1258 (with-current-buffer buffer
1259 (delete-process imap-process))
1260 (error)))
1261 (imap-send-command "LOGOUT" buffer))
1262 (imap-send-command "LOGOUT" buffer)))
1263
1264(defun imap-logout-wait (&optional buffer)
1265 (or buffer (setq buffer (current-buffer)))
1266 (if imap-logout-timeout
1267 (with-timeout (imap-logout-timeout
1268 (condition-case nil
1269 (with-current-buffer buffer
1270 (delete-process imap-process))
1271 (error)))
1272 (imap-send-command-wait "LOGOUT" buffer))
1273 (imap-send-command-wait "LOGOUT" buffer)))
1274
1156 1275
1157;; Mailbox functions: 1276;; Mailbox functions:
1158 1277
@@ -2106,6 +2225,8 @@ Return nil if no complete line has arrived."
2106 (read (concat "(" (upcase (buffer-substring 2225 (read (concat "(" (upcase (buffer-substring
2107 (point) (point-max))) 2226 (point) (point-max)))
2108 ")")))) 2227 ")"))))
2228 (ID (setq imap-id (read (buffer-substring (point)
2229 (point-max)))))
2109 (ACL (imap-parse-acl)) 2230 (ACL (imap-parse-acl))
2110 (t (case (prog1 (read (current-buffer)) 2231 (t (case (prog1 (read (current-buffer))
2111 (imap-forward)) 2232 (imap-forward))
@@ -2460,7 +2581,7 @@ Return nil if no complete line has arrived."
2460 ;; next line for Courier IMAP bug. 2581 ;; next line for Courier IMAP bug.
2461 (skip-chars-forward " ") 2582 (skip-chars-forward " ")
2462 (point))) 2583 (point)))
2463 (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) 2584 (> (skip-chars-forward "^ )" (point-at-eol)) 0))
2464 (push (buffer-substring start (point)) flag-list)) 2585 (push (buffer-substring start (point)) flag-list))
2465 (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list") 2586 (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
2466 (imap-forward) 2587 (imap-forward)
@@ -2740,99 +2861,99 @@ Return nil if no complete line has arrived."
2740(when imap-debug ; (untrace-all) 2861(when imap-debug ; (untrace-all)
2741 (require 'trace) 2862 (require 'trace)
2742 (buffer-disable-undo (get-buffer-create imap-debug-buffer)) 2863 (buffer-disable-undo (get-buffer-create imap-debug-buffer))
2743 (mapcar (lambda (f) (trace-function-background f imap-debug-buffer)) 2864 (mapc (lambda (f) (trace-function-background f imap-debug-buffer))
2744 '( 2865 '(
2745 imap-utf7-encode 2866 imap-utf7-encode
2746 imap-utf7-decode 2867 imap-utf7-decode
2747 imap-error-text 2868 imap-error-text
2748 imap-kerberos4s-p 2869 imap-kerberos4s-p
2749 imap-kerberos4-open 2870 imap-kerberos4-open
2750 imap-ssl-p 2871 imap-ssl-p
2751 imap-ssl-open 2872 imap-ssl-open
2752 imap-network-p 2873 imap-network-p
2753 imap-network-open 2874 imap-network-open
2754 imap-interactive-login 2875 imap-interactive-login
2755 imap-kerberos4a-p 2876 imap-kerberos4a-p
2756 imap-kerberos4-auth 2877 imap-kerberos4-auth
2757 imap-cram-md5-p 2878 imap-cram-md5-p
2758 imap-cram-md5-auth 2879 imap-cram-md5-auth
2759 imap-login-p 2880 imap-login-p
2760 imap-login-auth 2881 imap-login-auth
2761 imap-anonymous-p 2882 imap-anonymous-p
2762 imap-anonymous-auth 2883 imap-anonymous-auth
2763 imap-open-1 2884 imap-open-1
2764 imap-open 2885 imap-open
2765 imap-opened 2886 imap-opened
2766 imap-authenticate 2887 imap-authenticate
2767 imap-close 2888 imap-close
2768 imap-capability 2889 imap-capability
2769 imap-namespace 2890 imap-namespace
2770 imap-send-command-wait 2891 imap-send-command-wait
2771 imap-mailbox-put 2892 imap-mailbox-put
2772 imap-mailbox-get 2893 imap-mailbox-get
2773 imap-mailbox-map-1 2894 imap-mailbox-map-1
2774 imap-mailbox-map 2895 imap-mailbox-map
2775 imap-current-mailbox 2896 imap-current-mailbox
2776 imap-current-mailbox-p-1 2897 imap-current-mailbox-p-1
2777 imap-current-mailbox-p 2898 imap-current-mailbox-p
2778 imap-mailbox-select-1 2899 imap-mailbox-select-1
2779 imap-mailbox-select 2900 imap-mailbox-select
2780 imap-mailbox-examine-1 2901 imap-mailbox-examine-1
2781 imap-mailbox-examine 2902 imap-mailbox-examine
2782 imap-mailbox-unselect 2903 imap-mailbox-unselect
2783 imap-mailbox-expunge 2904 imap-mailbox-expunge
2784 imap-mailbox-close 2905 imap-mailbox-close
2785 imap-mailbox-create-1 2906 imap-mailbox-create-1
2786 imap-mailbox-create 2907 imap-mailbox-create
2787 imap-mailbox-delete 2908 imap-mailbox-delete
2788 imap-mailbox-rename 2909 imap-mailbox-rename
2789 imap-mailbox-lsub 2910 imap-mailbox-lsub
2790 imap-mailbox-list 2911 imap-mailbox-list
2791 imap-mailbox-subscribe 2912 imap-mailbox-subscribe
2792 imap-mailbox-unsubscribe 2913 imap-mailbox-unsubscribe
2793 imap-mailbox-status 2914 imap-mailbox-status
2794 imap-mailbox-acl-get 2915 imap-mailbox-acl-get
2795 imap-mailbox-acl-set 2916 imap-mailbox-acl-set
2796 imap-mailbox-acl-delete 2917 imap-mailbox-acl-delete
2797 imap-current-message 2918 imap-current-message
2798 imap-list-to-message-set 2919 imap-list-to-message-set
2799 imap-fetch-asynch 2920 imap-fetch-asynch
2800 imap-fetch 2921 imap-fetch
2801 imap-message-put 2922 imap-message-put
2802 imap-message-get 2923 imap-message-get
2803 imap-message-map 2924 imap-message-map
2804 imap-search 2925 imap-search
2805 imap-message-flag-permanent-p 2926 imap-message-flag-permanent-p
2806 imap-message-flags-set 2927 imap-message-flags-set
2807 imap-message-flags-del 2928 imap-message-flags-del
2808 imap-message-flags-add 2929 imap-message-flags-add
2809 imap-message-copyuid-1 2930 imap-message-copyuid-1
2810 imap-message-copyuid 2931 imap-message-copyuid
2811 imap-message-copy 2932 imap-message-copy
2812 imap-message-appenduid-1 2933 imap-message-appenduid-1
2813 imap-message-appenduid 2934 imap-message-appenduid
2814 imap-message-append 2935 imap-message-append
2815 imap-body-lines 2936 imap-body-lines
2816 imap-envelope-from 2937 imap-envelope-from
2817 imap-send-command-1 2938 imap-send-command-1
2818 imap-send-command 2939 imap-send-command
2819 imap-wait-for-tag 2940 imap-wait-for-tag
2820 imap-sentinel 2941 imap-sentinel
2821 imap-find-next-line 2942 imap-find-next-line
2822 imap-arrival-filter 2943 imap-arrival-filter
2823 imap-parse-greeting 2944 imap-parse-greeting
2824 imap-parse-response 2945 imap-parse-response
2825 imap-parse-resp-text 2946 imap-parse-resp-text
2826 imap-parse-resp-text-code 2947 imap-parse-resp-text-code
2827 imap-parse-data-list 2948 imap-parse-data-list
2828 imap-parse-fetch 2949 imap-parse-fetch
2829 imap-parse-status 2950 imap-parse-status
2830 imap-parse-acl 2951 imap-parse-acl
2831 imap-parse-flag-list 2952 imap-parse-flag-list
2832 imap-parse-envelope 2953 imap-parse-envelope
2833 imap-parse-body-extension 2954 imap-parse-body-extension
2834 imap-parse-body 2955 imap-parse-body
2835 ))) 2956 )))
2836 2957
2837(provide 'imap) 2958(provide 'imap)
2838 2959
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 7ee6ac7f744..d0b4d10d680 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -110,23 +110,20 @@ converted to the compressed format."
110 (throw 'found-file-to-convert t)) 110 (throw 'found-file-to-convert t))
111 111
112 (erase-buffer) 112 (erase-buffer)
113 (let ((compressed nil)) 113 (let (article-id day-of-download comp-list compressed)
114 (mapcar (lambda (pair) 114 (while alist
115 (let* ((article-id (car pair)) 115 (setq article-id (caar alist)
116 (day-of-download (cdr pair)) 116 day-of-download (cdar alist)
117 (comp-list (assq day-of-download compressed))) 117 comp-list (assq day-of-download compressed)
118 (if comp-list 118 alist (cdr alist))
119 (setcdr comp-list 119 (if comp-list
120 (cons article-id (cdr comp-list))) 120 (setcdr comp-list (cons article-id (cdr comp-list)))
121 (setq compressed 121 (push (list day-of-download article-id) compressed)))
122 (cons (list day-of-download article-id) 122 (setq alist compressed)
123 compressed))) 123 (while alist
124 nil)) alist) 124 (setq comp-list (pop alist))
125 (mapcar (lambda (comp-list) 125 (setcdr comp-list
126 (setcdr comp-list 126 (gnus-compress-sequence (nreverse (cdr comp-list)))))
127 (gnus-compress-sequence
128 (nreverse (cdr comp-list)))))
129 compressed)
130 (princ compressed (current-buffer))) 127 (princ compressed (current-buffer)))
131 (insert "\n2\n") 128 (insert "\n2\n")
132 (write-file file) 129 (write-file file)
diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el
index d9f3d08537b..9868370ce6d 100644
--- a/lisp/gnus/mail-parse.el
+++ b/lisp/gnus/mail-parse.el
@@ -59,6 +59,7 @@
59(defalias 'mail-header-parse-date 'ietf-drums-parse-date) 59(defalias 'mail-header-parse-date 'ietf-drums-parse-date)
60(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header) 60(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header)
61(defalias 'mail-quote-string 'ietf-drums-quote-string) 61(defalias 'mail-quote-string 'ietf-drums-quote-string)
62(defalias 'mail-header-make-address 'ietf-drums-make-address)
62 63
63(defalias 'mail-header-fold-field 'rfc2047-fold-field) 64(defalias 'mail-header-fold-field 'rfc2047-fold-field)
64(defalias 'mail-header-unfold-field 'rfc2047-unfold-field) 65(defalias 'mail-header-unfold-field 'rfc2047-unfold-field)
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 0dc77f59e96..abf32756498 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -34,8 +34,7 @@
34(eval-and-compile 34(eval-and-compile
35 (autoload 'pop3-movemail "pop3") 35 (autoload 'pop3-movemail "pop3")
36 (autoload 'pop3-get-message-count "pop3") 36 (autoload 'pop3-get-message-count "pop3")
37 (autoload 'nnheader-cancel-timer "nnheader") 37 (autoload 'nnheader-cancel-timer "nnheader"))
38 (autoload 'nnheader-run-at-time "nnheader"))
39(require 'format-spec) 38(require 'format-spec)
40(require 'mm-util) 39(require 'mm-util)
41(require 'message) ;; for `message-directory' 40(require 'message) ;; for `message-directory'
@@ -111,7 +110,7 @@ See Info node `(gnus)Mail Source Specifiers'."
111 (const :format "" :value :port) 110 (const :format "" :value :port)
112 (choice :tag "Port" 111 (choice :tag "Port"
113 :value "pop3" 112 :value "pop3"
114 (number :format "%v") 113 (integer :format "%v")
115 (string :format "%v"))) 114 (string :format "%v")))
116 (group :inline t 115 (group :inline t
117 (const :format "" :value :user) 116 (const :format "" :value :user)
@@ -127,13 +126,15 @@ See Info node `(gnus)Mail Source Specifiers'."
127 (choice :tag "Prescript" 126 (choice :tag "Prescript"
128 :value nil 127 :value nil
129 (string :format "%v") 128 (string :format "%v")
130 (function :format "%v"))) 129 (function :format "%v")
130 (const :tag "None" nil)))
131 (group :inline t 131 (group :inline t
132 (const :format "" :value :postscript) 132 (const :format "" :value :postscript)
133 (choice :tag "Postscript" 133 (choice :tag "Postscript"
134 :value nil 134 :value nil
135 (string :format "%v") 135 (string :format "%v")
136 (function :format "%v"))) 136 (function :format "%v")
137 (const :tag "None" nil)))
137 (group :inline t 138 (group :inline t
138 (const :format "" :value :function) 139 (const :format "" :value :function)
139 (function :tag "Function")) 140 (function :tag "Function"))
@@ -146,7 +147,14 @@ See Info node `(gnus)Mail Source Specifiers'."
146 (const apop))) 147 (const apop)))
147 (group :inline t 148 (group :inline t
148 (const :format "" :value :plugged) 149 (const :format "" :value :plugged)
149 (boolean :tag "Plugged")))) 150 (boolean :tag "Plugged"))
151 (group :inline t
152 (const :format "" :value :stream)
153 (choice :tag "Stream"
154 :value nil
155 (const :tag "Clear" nil)
156 (const starttls)
157 (const :tag "SSL/TLS" ssl)))))
150 (cons :tag "Maildir (qmail, postfix...)" 158 (cons :tag "Maildir (qmail, postfix...)"
151 (const :format "" maildir) 159 (const :format "" maildir)
152 (checklist :tag "Options" :greedy t 160 (checklist :tag "Options" :greedy t
@@ -166,7 +174,7 @@ See Info node `(gnus)Mail Source Specifiers'."
166 (const :format "" :value :port) 174 (const :format "" :value :port)
167 (choice :tag "Port" 175 (choice :tag "Port"
168 :value 143 176 :value 143
169 number string)) 177 integer string))
170 (group :inline t 178 (group :inline t
171 (const :format "" :value :user) 179 (const :format "" :value :user)
172 (string :tag "User")) 180 (string :tag "User"))
@@ -210,17 +218,17 @@ See Info node `(gnus)Mail Source Specifiers'."
210 (const :format "" webmail) 218 (const :format "" webmail)
211 (checklist :tag "Options" :greedy t 219 (checklist :tag "Options" :greedy t
212 (group :inline t 220 (group :inline t
213 (const :format "" :value :subtype) 221 (const :format "" :value :subtype)
214 ;; Should be generated from 222 ;; Should be generated from
215 ;; `webmail-type-definition', but we 223 ;; `webmail-type-definition', but we
216 ;; can't require webmail without W3. 224 ;; can't require webmail without W3.
217 (choice :tag "Subtype" 225 (choice :tag "Subtype"
218 :value hotmail 226 :value hotmail
219 (const hotmail) 227 (const hotmail)
220 (const yahoo) 228 (const yahoo)
221 (const netaddress) 229 (const netaddress)
222 (const netscape) 230 (const netscape)
223 (const my-deja))) 231 (const my-deja)))
224 (group :inline t 232 (group :inline t
225 (const :format "" :value :user) 233 (const :format "" :value :user)
226 (string :tag "User")) 234 (string :tag "User"))
@@ -269,7 +277,7 @@ If non-nil, this maildrop will be checked periodically for new mail."
269 :group 'mail-source 277 :group 'mail-source
270 :type 'integer) 278 :type 'integer)
271 279
272(defcustom mail-source-delete-incoming t 280(defcustom mail-source-delete-incoming nil
273 "*If non-nil, delete incoming files after handling. 281 "*If non-nil, delete incoming files after handling.
274If t, delete immediately, if nil, never delete. If a positive number, delete 282If t, delete immediately, if nil, never delete. If a positive number, delete
275files older than number of days." 283files older than number of days."
@@ -350,7 +358,8 @@ Common keywords should be listed here.")
350 (:program) 358 (:program)
351 (:function) 359 (:function)
352 (:password) 360 (:password)
353 (:authentication password)) 361 (:authentication password)
362 (:stream nil))
354 (maildir 363 (maildir
355 (:path (or (getenv "MAILDIR") "~/Maildir/")) 364 (:path (or (getenv "MAILDIR") "~/Maildir/"))
356 (:subdirs ("cur" "new")) 365 (:subdirs ("cur" "new"))
@@ -502,7 +511,8 @@ Return the number of files that were found."
502 (when (file-exists-p mail-source-crash-box) 511 (when (file-exists-p mail-source-crash-box)
503 (message "Processing mail from %s..." mail-source-crash-box) 512 (message "Processing mail from %s..." mail-source-crash-box)
504 (setq found (mail-source-callback 513 (setq found (mail-source-callback
505 callback mail-source-crash-box))) 514 callback mail-source-crash-box))
515 (mail-source-delete-crash-box))
506 (+ found 516 (+ found
507 (if (or debug-on-quit debug-on-error) 517 (if (or debug-on-quit debug-on-error)
508 (funcall function source callback) 518 (funcall function source callback)
@@ -552,33 +562,33 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
552 (delete-file ffile)))))) 562 (delete-file ffile))))))
553 563
554(defun mail-source-callback (callback info) 564(defun mail-source-callback (callback info)
555 "Call CALLBACK on the mail file, and then remove the mail file. 565 "Call CALLBACK on the mail file. Pass INFO on to CALLBACK."
556Pass INFO on to CALLBACK."
557 (if (or (not (file-exists-p mail-source-crash-box)) 566 (if (or (not (file-exists-p mail-source-crash-box))
558 (zerop (nth 7 (file-attributes mail-source-crash-box)))) 567 (zerop (nth 7 (file-attributes mail-source-crash-box))))
559 (progn 568 (progn
560 (when (file-exists-p mail-source-crash-box) 569 (when (file-exists-p mail-source-crash-box)
561 (delete-file mail-source-crash-box)) 570 (delete-file mail-source-crash-box))
562 0) 571 0)
563 (prog1 572 (funcall callback mail-source-crash-box info)))
564 (funcall callback mail-source-crash-box info) 573
565 (when (file-exists-p mail-source-crash-box) 574(defun mail-source-delete-crash-box ()
566 ;; Delete or move the incoming mail out of the way. 575 (when (file-exists-p mail-source-crash-box)
567 (if (eq mail-source-delete-incoming t) 576 ;; Delete or move the incoming mail out of the way.
568 (delete-file mail-source-crash-box) 577 (if (eq mail-source-delete-incoming t)
569 (let ((incoming 578 (delete-file mail-source-crash-box)
570 (mm-make-temp-file 579 (let ((incoming
571 (expand-file-name 580 (mm-make-temp-file
572 mail-source-incoming-file-prefix 581 (expand-file-name
573 mail-source-directory)))) 582 mail-source-incoming-file-prefix
574 (unless (file-exists-p (file-name-directory incoming)) 583 mail-source-directory))))
575 (make-directory (file-name-directory incoming) t)) 584 (unless (file-exists-p (file-name-directory incoming))
576 (rename-file mail-source-crash-box incoming t) 585 (make-directory (file-name-directory incoming) t))
577 ;; remove old incoming files? 586 (rename-file mail-source-crash-box incoming t)
578 (when (natnump mail-source-delete-incoming) 587 ;; remove old incoming files?
579 (mail-source-delete-old-incoming 588 (when (natnump mail-source-delete-incoming)
580 mail-source-delete-incoming 589 (mail-source-delete-old-incoming
581 mail-source-delete-old-incoming-confirm)))))))) 590 mail-source-delete-incoming
591 mail-source-delete-old-incoming-confirm))))))
582 592
583(defun mail-source-movemail (from to) 593(defun mail-source-movemail (from to)
584 "Move FROM to TO using movemail." 594 "Move FROM to TO using movemail."
@@ -670,12 +680,20 @@ Pass INFO on to CALLBACK."
670 (sleep-for delay))) 680 (sleep-for delay)))
671 681
672(defun mail-source-call-script (script) 682(defun mail-source-call-script (script)
673 (let ((background nil)) 683 (let ((background nil)
684 (stderr (get-buffer-create " *mail-source-stderr*"))
685 result)
674 (when (string-match "& *$" script) 686 (when (string-match "& *$" script)
675 (setq script (substring script 0 (match-beginning 0)) 687 (setq script (substring script 0 (match-beginning 0))
676 background 0)) 688 background 0))
677 (call-process shell-file-name nil background nil 689 (setq result
678 shell-command-switch script))) 690 (call-process shell-file-name nil background nil
691 shell-command-switch script))
692 (when (and result
693 (not (zerop result)))
694 (set-buffer stderr)
695 (message "Mail source error: %s" (buffer-string)))
696 (kill-buffer stderr)))
679 697
680;;; 698;;;
681;;; Different fetchers 699;;; Different fetchers
@@ -692,7 +710,8 @@ Pass INFO on to CALLBACK."
692 (prog1 710 (prog1
693 (mail-source-callback callback path) 711 (mail-source-callback callback path)
694 (mail-source-run-script 712 (mail-source-run-script
695 postscript (format-spec-make ?t mail-source-crash-box))) 713 postscript (format-spec-make ?t mail-source-crash-box))
714 (mail-source-delete-crash-box))
696 0)))) 715 0))))
697 716
698(defun mail-source-fetch-directory (source callback) 717(defun mail-source-fetch-directory (source callback)
@@ -707,13 +726,15 @@ Pass INFO on to CALLBACK."
707 (when (and (file-regular-p file) 726 (when (and (file-regular-p file)
708 (funcall predicate file) 727 (funcall predicate file)
709 (mail-source-movemail file mail-source-crash-box)) 728 (mail-source-movemail file mail-source-crash-box))
710 (incf found (mail-source-callback callback file)))) 729 (incf found (mail-source-callback callback file))
711 (mail-source-run-script postscript (format-spec-make ?t path)) 730 (mail-source-run-script postscript (format-spec-make ?t path))
731 (mail-source-delete-crash-box)))
712 found))) 732 found)))
713 733
714(defun mail-source-fetch-pop (source callback) 734(defun mail-source-fetch-pop (source callback)
715 "Fetcher for single-file sources." 735 "Fetcher for single-file sources."
716 (mail-source-bind (pop source) 736 (mail-source-bind (pop source)
737 ;; fixme: deal with stream type in format specs
717 (mail-source-run-script 738 (mail-source-run-script
718 prescript 739 prescript
719 (format-spec-make ?p password ?t mail-source-crash-box 740 (format-spec-make ?p password ?t mail-source-crash-box
@@ -748,7 +769,8 @@ Pass INFO on to CALLBACK."
748 (pop3-mailhost server) 769 (pop3-mailhost server)
749 (pop3-port port) 770 (pop3-port port)
750 (pop3-authentication-scheme 771 (pop3-authentication-scheme
751 (if (eq authentication 'apop) 'apop 'pass))) 772 (if (eq authentication 'apop) 'apop 'pass))
773 (pop3-stream-type stream))
752 (if (or debug-on-quit debug-on-error) 774 (if (or debug-on-quit debug-on-error)
753 (save-excursion (pop3-movemail mail-source-crash-box)) 775 (save-excursion (pop3-movemail mail-source-crash-box))
754 (condition-case err 776 (condition-case err
@@ -773,7 +795,8 @@ Pass INFO on to CALLBACK."
773 (mail-source-run-script 795 (mail-source-run-script
774 postscript 796 postscript
775 (format-spec-make ?p password ?t mail-source-crash-box 797 (format-spec-make ?p password ?t mail-source-crash-box
776 ?s server ?P port ?u user)))) 798 ?s server ?P port ?u user))
799 (mail-source-delete-crash-box)))
777 ;; We nix out the password in case the error 800 ;; We nix out the password in case the error
778 ;; was because of a wrong password being given. 801 ;; was because of a wrong password being given.
779 (setq mail-source-password-cache 802 (setq mail-source-password-cache
@@ -865,11 +888,6 @@ See the Gnus manual for details."
865(defvar mail-source-report-new-mail-timer nil) 888(defvar mail-source-report-new-mail-timer nil)
866(defvar mail-source-report-new-mail-idle-timer nil) 889(defvar mail-source-report-new-mail-idle-timer nil)
867 890
868(eval-when-compile
869 (if (featurep 'xemacs)
870 (require 'timer-funcs)
871 (require 'timer)))
872
873(defun mail-source-start-idle-timer () 891(defun mail-source-start-idle-timer ()
874 ;; Start our idle timer if necessary, so we delay the check until the 892 ;; Start our idle timer if necessary, so we delay the check until the
875 ;; user isn't typing. 893 ;; user isn't typing.
@@ -912,7 +930,7 @@ This only works when `display-time' is enabled."
912 (setq display-time-mail-function #'mail-source-new-mail-p) 930 (setq display-time-mail-function #'mail-source-new-mail-p)
913 ;; Set up the main timer. 931 ;; Set up the main timer.
914 (setq mail-source-report-new-mail-timer 932 (setq mail-source-report-new-mail-timer
915 (nnheader-run-at-time 933 (run-at-time
916 (* 60 mail-source-report-new-mail-interval) 934 (* 60 mail-source-report-new-mail-interval)
917 (* 60 mail-source-report-new-mail-interval) 935 (* 60 mail-source-report-new-mail-interval)
918 #'mail-source-start-idle-timer)) 936 #'mail-source-start-idle-timer))
@@ -957,7 +975,8 @@ This only works when `display-time' is enabled."
957 ;; MMDF mail format 975 ;; MMDF mail format
958 (insert "\001\001\001\001\n")) 976 (insert "\001\001\001\001\n"))
959 (delete-file file))))) 977 (delete-file file)))))
960 (incf found (mail-source-callback callback file)))))) 978 (incf found (mail-source-callback callback file))
979 (mail-source-delete-crash-box)))))
961 found))) 980 found)))
962 981
963(eval-and-compile 982(eval-and-compile
@@ -1018,11 +1037,13 @@ This only works when `display-time' is enabled."
1018 (insert "From imap " (current-time-string) "\n") 1037 (insert "From imap " (current-time-string) "\n")
1019 (save-excursion 1038 (save-excursion
1020 (insert str "\n\n")) 1039 (insert str "\n\n"))
1021 (while (re-search-forward "^From " nil t) 1040 (while (let ((case-fold-search nil))
1041 (re-search-forward "^From " nil t))
1022 (replace-match ">From ")) 1042 (replace-match ">From "))
1023 (goto-char (point-max)))) 1043 (goto-char (point-max))))
1024 (nnheader-ms-strip-cr)) 1044 (nnheader-ms-strip-cr))
1025 (incf found (mail-source-callback callback server)) 1045 (incf found (mail-source-callback callback server))
1046 (mail-source-delete-crash-box)
1026 (when (and remove fetchflag) 1047 (when (and remove fetchflag)
1027 (setq remove (nreverse remove)) 1048 (setq remove (nreverse remove))
1028 (imap-message-flags-add 1049 (imap-message-flags-add
@@ -1068,7 +1089,8 @@ This only works when `display-time' is enabled."
1068 (push (cons (format "webmail:%s:%s" subtype user) password) 1089 (push (cons (format "webmail:%s:%s" subtype user) password)
1069 mail-source-password-cache))) 1090 mail-source-password-cache)))
1070 (webmail-fetch mail-source-crash-box subtype user password) 1091 (webmail-fetch mail-source-crash-box subtype user password)
1071 (mail-source-callback callback (symbol-name subtype))))) 1092 (mail-source-callback callback (symbol-name subtype))
1093 (mail-source-delete-crash-box))))
1072 1094
1073(provide 'mail-source) 1095(provide 'mail-source)
1074 1096
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index e8b624aa546..6839a6472b7 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -254,7 +254,11 @@
254 ("html" 254 ("html"
255 (viewer . mm-w3-prepare-buffer) 255 (viewer . mm-w3-prepare-buffer)
256 (test . (fboundp 'w3-prepare-buffer)) 256 (test . (fboundp 'w3-prepare-buffer))
257 (type . "text/html"))) 257 (type . "text/html"))
258 ("dns"
259 (viewer . dns-mode)
260 (test . (fboundp 'dns-mode))
261 (type . "text/dns")))
258 ("video" 262 ("video"
259 ("mpeg" 263 ("mpeg"
260 (viewer . "mpeg_play %s") 264 (viewer . "mpeg_play %s")
@@ -852,6 +856,7 @@ this type is returned."
852 (".sit" . "application/x-stuffit") 856 (".sit" . "application/x-stuffit")
853 (".siv" . "application/sieve") 857 (".siv" . "application/sieve")
854 (".snd" . "audio/basic") 858 (".snd" . "audio/basic")
859 (".soa" . "text/dns")
855 (".src" . "application/x-wais-source") 860 (".src" . "application/x-wais-source")
856 (".tar" . "archive/tar") 861 (".tar" . "archive/tar")
857 (".tcl" . "application/x-tcl") 862 (".tcl" . "application/x-tcl")
diff --git a/lisp/gnus/md4.el b/lisp/gnus/md4.el
new file mode 100644
index 00000000000..aa9bc543203
--- /dev/null
+++ b/lisp/gnus/md4.el
@@ -0,0 +1,228 @@
1;;; md4.el --- MD4 Message Digest Algorithm.
2
3;; Copyright (C) 2004 Free Software Foundation, Inc.
4;; Copyright (C) 2001 Taro Kawagishi
5;; Author: Taro Kawagishi <tarok@transpulse.org>
6;; Keywords: MD4
7;; Version: 1.00
8;; Created: February 2001
9
10;; This file is part of FLIM (Faithful Library about Internet Message).
11
12;; This program is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 3, or (at your option)
15;; any later version.
16;;
17;; This program is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21;;
22;; You should have received a copy of the GNU General Public License
23;; along with this program; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Code:
28
29;;;
30;;; MD4 hash calculation
31
32(defvar md4-buffer (make-vector 4 '(0 . 0))
33 "work buffer of four 32-bit integers")
34
35(defun md4 (in n)
36 "Returns the MD4 hash string of 16 bytes long for a string IN of N
37bytes long. N is required to handle strings containing character 0."
38 (let (m
39 (b (cons 0 (* n 8)))
40 (i 0)
41 (buf (make-string 128 0)) c4)
42 ;; initial values
43 (aset md4-buffer 0 '(26437 . 8961)) ;0x67452301
44 (aset md4-buffer 1 '(61389 . 43913)) ;0xefcdab89
45 (aset md4-buffer 2 '(39098 . 56574)) ;0x98badcfe
46 (aset md4-buffer 3 '(4146 . 21622)) ;0x10325476
47
48 ;; process the string in 64 bits chunks
49 (while (> n 64)
50 (setq m (md4-copy64 (substring in 0 64)))
51 (md4-64 m)
52 (setq in (substring in 64))
53 (setq n (- n 64)))
54
55 ;; process the rest of the string (length is now n <= 64)
56 (setq i 0)
57 (while (< i n)
58 (aset buf i (aref in i))
59 (setq i (1+ i)))
60 (aset buf n 128) ;0x80
61 (if (<= n 55)
62 (progn
63 (setq c4 (md4-pack-int32 b))
64 (aset buf 56 (aref c4 0))
65 (aset buf 57 (aref c4 1))
66 (aset buf 58 (aref c4 2))
67 (aset buf 59 (aref c4 3))
68 (setq m (md4-copy64 buf))
69 (md4-64 m))
70 ;; else
71 (setq c4 (md4-pack-int32 b))
72 (aset buf 120 (aref c4 0))
73 (aset buf 121 (aref c4 1))
74 (aset buf 122 (aref c4 2))
75 (aset buf 123 (aref c4 3))
76 (setq m (md4-copy64 buf))
77 (md4-64 m)
78 (setq m (md4-copy64 (substring buf 64)))
79 (md4-64 m)))
80
81 (concat (md4-pack-int32 (aref md4-buffer 0))
82 (md4-pack-int32 (aref md4-buffer 1))
83 (md4-pack-int32 (aref md4-buffer 2))
84 (md4-pack-int32 (aref md4-buffer 3))))
85
86(defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z)))
87(defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z)))
88(defsubst md4-H (x y z) (logxor x y z))
89
90(defmacro md4-make-step (name func)
91 `(defun ,name (a b c d xk s ac)
92 (let*
93 ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac)))
94 (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
95 (h2 (logand 65535 (+ h1 (lsh l1 -16))))
96 (l2 (logand 65535 l1))
97 ;; cyclic shift of 32 bits integer
98 (h3 (logand 65535 (if (> s 15)
99 (+ (lsh h2 (- s 32)) (lsh l2 (- s 16)))
100 (+ (lsh h2 s) (lsh l2 (- s 16))))))
101 (l3 (logand 65535 (if (> s 15)
102 (+ (lsh l2 (- s 32)) (lsh h2 (- s 16)))
103 (+ (lsh l2 s) (lsh h2 (- s 16)))))))
104 (cons h3 l3))))
105
106(md4-make-step md4-round1 md4-F)
107(md4-make-step md4-round2 md4-G)
108(md4-make-step md4-round3 md4-H)
109
110(defsubst md4-add (x y)
111 "Return 32-bit sum of 32-bit integers X and Y."
112 (let ((h (+ (car x) (car y)))
113 (l (+ (cdr x) (cdr y))))
114 (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l))))
115
116(defsubst md4-and (x y)
117 (cons (logand (car x) (car y)) (logand (cdr x) (cdr y))))
118
119(defun md4-64 (m)
120 "Calculate md4 of 64 bytes chunk M which is represented as 16 pairs of
12132 bits integers. The resulting md4 value is placed in md4-buffer."
122 (let ((a (aref md4-buffer 0))
123 (b (aref md4-buffer 1))
124 (c (aref md4-buffer 2))
125 (d (aref md4-buffer 3)))
126 (setq a (md4-round1 a b c d (aref m 0) 3 '(0 . 0))
127 d (md4-round1 d a b c (aref m 1) 7 '(0 . 0))
128 c (md4-round1 c d a b (aref m 2) 11 '(0 . 0))
129 b (md4-round1 b c d a (aref m 3) 19 '(0 . 0))
130 a (md4-round1 a b c d (aref m 4) 3 '(0 . 0))
131 d (md4-round1 d a b c (aref m 5) 7 '(0 . 0))
132 c (md4-round1 c d a b (aref m 6) 11 '(0 . 0))
133 b (md4-round1 b c d a (aref m 7) 19 '(0 . 0))
134 a (md4-round1 a b c d (aref m 8) 3 '(0 . 0))
135 d (md4-round1 d a b c (aref m 9) 7 '(0 . 0))
136 c (md4-round1 c d a b (aref m 10) 11 '(0 . 0))
137 b (md4-round1 b c d a (aref m 11) 19 '(0 . 0))
138 a (md4-round1 a b c d (aref m 12) 3 '(0 . 0))
139 d (md4-round1 d a b c (aref m 13) 7 '(0 . 0))
140 c (md4-round1 c d a b (aref m 14) 11 '(0 . 0))
141 b (md4-round1 b c d a (aref m 15) 19 '(0 . 0))
142
143 a (md4-round2 a b c d (aref m 0) 3 '(23170 . 31129)) ;0x5A827999
144 d (md4-round2 d a b c (aref m 4) 5 '(23170 . 31129))
145 c (md4-round2 c d a b (aref m 8) 9 '(23170 . 31129))
146 b (md4-round2 b c d a (aref m 12) 13 '(23170 . 31129))
147 a (md4-round2 a b c d (aref m 1) 3 '(23170 . 31129))
148 d (md4-round2 d a b c (aref m 5) 5 '(23170 . 31129))
149 c (md4-round2 c d a b (aref m 9) 9 '(23170 . 31129))
150 b (md4-round2 b c d a (aref m 13) 13 '(23170 . 31129))
151 a (md4-round2 a b c d (aref m 2) 3 '(23170 . 31129))
152 d (md4-round2 d a b c (aref m 6) 5 '(23170 . 31129))
153 c (md4-round2 c d a b (aref m 10) 9 '(23170 . 31129))
154 b (md4-round2 b c d a (aref m 14) 13 '(23170 . 31129))
155 a (md4-round2 a b c d (aref m 3) 3 '(23170 . 31129))
156 d (md4-round2 d a b c (aref m 7) 5 '(23170 . 31129))
157 c (md4-round2 c d a b (aref m 11) 9 '(23170 . 31129))
158 b (md4-round2 b c d a (aref m 15) 13 '(23170 . 31129))
159
160 a (md4-round3 a b c d (aref m 0) 3 '(28377 . 60321)) ;0x6ED9EBA1
161 d (md4-round3 d a b c (aref m 8) 9 '(28377 . 60321))
162 c (md4-round3 c d a b (aref m 4) 11 '(28377 . 60321))
163 b (md4-round3 b c d a (aref m 12) 15 '(28377 . 60321))
164 a (md4-round3 a b c d (aref m 2) 3 '(28377 . 60321))
165 d (md4-round3 d a b c (aref m 10) 9 '(28377 . 60321))
166 c (md4-round3 c d a b (aref m 6) 11 '(28377 . 60321))
167 b (md4-round3 b c d a (aref m 14) 15 '(28377 . 60321))
168 a (md4-round3 a b c d (aref m 1) 3 '(28377 . 60321))
169 d (md4-round3 d a b c (aref m 9) 9 '(28377 . 60321))
170 c (md4-round3 c d a b (aref m 5) 11 '(28377 . 60321))
171 b (md4-round3 b c d a (aref m 13) 15 '(28377 . 60321))
172 a (md4-round3 a b c d (aref m 3) 3 '(28377 . 60321))
173 d (md4-round3 d a b c (aref m 11) 9 '(28377 . 60321))
174 c (md4-round3 c d a b (aref m 7) 11 '(28377 . 60321))
175 b (md4-round3 b c d a (aref m 15) 15 '(28377 . 60321)))
176
177 (aset md4-buffer 0 (md4-add a (aref md4-buffer 0)))
178 (aset md4-buffer 1 (md4-add b (aref md4-buffer 1)))
179 (aset md4-buffer 2 (md4-add c (aref md4-buffer 2)))
180 (aset md4-buffer 3 (md4-add d (aref md4-buffer 3)))
181 ))
182
183(defun md4-copy64 (seq)
184 "Unpack a 64 bytes string into 16 pairs of 32 bits integers."
185 (let ((int32s (make-vector 16 0)) (i 0) j)
186 (while (< i 16)
187 (setq j (* i 4))
188 (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8))
189 (+ (aref seq j) (lsh (aref seq (1+ j)) 8))))
190 (setq i (1+ i)))
191 int32s))
192
193;;;
194;;; sub functions
195
196(defun md4-pack-int16 (int16)
197 "Pack 16 bits integer in 2 bytes string as little endian."
198 (let ((str (make-string 2 0)))
199 (aset str 0 (logand int16 255))
200 (aset str 1 (lsh int16 -8))
201 str))
202
203(defun md4-pack-int32 (int32)
204 "Pack 32 bits integer in a 4 bytes string as little endian. A 32 bits
205integer is represented as a pair of two 16 bits integers (cons high low)."
206 (let ((str (make-string 4 0))
207 (h (car int32)) (l (cdr int32)))
208 (aset str 0 (logand l 255))
209 (aset str 1 (lsh l -8))
210 (aset str 2 (logand h 255))
211 (aset str 3 (lsh h -8))
212 str))
213
214(defun md4-unpack-int16 (str)
215 (if (eq 2 (length str))
216 (+ (lsh (aref str 1) 8) (aref str 0))
217 (error "%s is not 2 bytes long" str)))
218
219(defun md4-unpack-int32 (str)
220 (if (eq 4 (length str))
221 (cons (+ (lsh (aref str 3) 8) (aref str 2))
222 (+ (lsh (aref str 1) 8) (aref str 0)))
223 (error "%s is not 4 bytes long" str)))
224
225(provide 'md4)
226
227;;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e
228;;; md4.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 419fd07727c..de8e0754036 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -35,6 +35,7 @@
35 (require 'cl) 35 (require 'cl)
36 (defvar gnus-message-group-art) 36 (defvar gnus-message-group-art)
37 (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary 37 (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
38(require 'hashcash)
38(require 'canlock) 39(require 'canlock)
39(require 'mailheader) 40(require 'mailheader)
40(require 'gmm-utils) 41(require 'gmm-utils)
@@ -48,10 +49,8 @@
48(require 'mail-parse) 49(require 'mail-parse)
49(require 'mml) 50(require 'mml)
50(require 'rfc822) 51(require 'rfc822)
51(eval-and-compile 52(require 'ecomplete)
52 (autoload 'gnus-find-method-for-group "gnus") 53
53 (autoload 'nnvirtual-find-group-art "nnvirtual")
54 (autoload 'gnus-group-decoded-name "gnus-group"))
55 54
56(defgroup message '((user-mail-address custom-variable) 55(defgroup message '((user-mail-address custom-variable)
57 (user-full-name custom-variable)) 56 (user-full-name custom-variable))
@@ -156,7 +155,6 @@ If this variable is nil, no such courtesy message will be added."
156 :group 'message-interface 155 :group 'message-interface
157 :type 'regexp) 156 :type 'regexp)
158 157
159;;;###autoload
160(defcustom message-from-style 'default 158(defcustom message-from-style 'default
161 "*Specifies how \"From\" headers look. 159 "*Specifies how \"From\" headers look.
162 160
@@ -211,7 +209,7 @@ Also see `message-required-news-headers' and
211 :link '(custom-manual "(message)Message Headers") 209 :link '(custom-manual "(message)Message Headers")
212 :type '(repeat sexp)) 210 :type '(repeat sexp))
213 211
214(defcustom message-draft-headers '(References From) 212(defcustom message-draft-headers '(References From Date)
215 "*Headers to be generated when saving a draft message." 213 "*Headers to be generated when saving a draft message."
216 :version "22.1" 214 :version "22.1"
217 :group 'message-news 215 :group 'message-news
@@ -271,7 +269,7 @@ included. Organization and User-Agent are optional."
271 :link '(custom-manual "(message)Mail Headers") 269 :link '(custom-manual "(message)Mail Headers")
272 :type 'regexp) 270 :type 'regexp)
273 271
274(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:" 272(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
275 "*Header lines matching this regexp will be deleted before posting. 273 "*Header lines matching this regexp will be deleted before posting.
276It's best to delete old Path and Date headers before posting to avoid 274It's best to delete old Path and Date headers before posting to avoid
277any confusion." 275any confusion."
@@ -304,7 +302,7 @@ used."
304 :version "22.1" 302 :version "22.1"
305 :type '(choice (const :tag "never" nil) 303 :type '(choice (const :tag "never" nil)
306 (const :tag "always strip" t) 304 (const :tag "always strip" t)
307 (const ask)) 305 (const ask))
308 :link '(custom-manual "(message)Message Headers") 306 :link '(custom-manual "(message)Message Headers")
309 :group 'message-various) 307 :group 'message-various)
310 308
@@ -411,7 +409,6 @@ for `message-cross-post-insert-note'."
411 409
412;;; End of variables adopted from `message-utils.el'. 410;;; End of variables adopted from `message-utils.el'.
413 411
414;;;###autoload
415(defcustom message-signature-separator "^-- *$" 412(defcustom message-signature-separator "^-- *$"
416 "Regexp matching the signature separator." 413 "Regexp matching the signature separator."
417 :type 'regexp 414 :type 'regexp
@@ -470,6 +467,13 @@ function
470 :link '(custom-manual "(message)Message Buffers") 467 :link '(custom-manual "(message)Message Buffers")
471 :type 'boolean) 468 :type 'boolean)
472 469
470(defcustom message-kill-buffer-query t
471 "*Non-nil means that killing a modified message buffer has to be confirmed.
472This is used by `message-kill-buffer'."
473 :version "23.0" ;; No Gnus
474 :group 'message-buffers
475 :type 'boolean)
476
473(eval-when-compile 477(eval-when-compile
474 (defvar gnus-local-organization)) 478 (defvar gnus-local-organization))
475(defcustom message-user-organization 479(defcustom message-user-organization
@@ -484,8 +488,14 @@ If t, use `message-user-organization-file'."
484 :type '(choice string 488 :type '(choice string
485 (const :tag "consult file" t))) 489 (const :tag "consult file" t)))
486 490
487;;;###autoload 491(defcustom message-user-organization-file
488(defcustom message-user-organization-file "/usr/lib/news/organization" 492 (let (orgfile)
493 (dolist (f (list "/etc/organization"
494 "/etc/news/organization"
495 "/usr/lib/news/organization"))
496 (when (file-readable-p f)
497 (setq orgfile f)))
498 orgfile)
489 "*Local news organization file." 499 "*Local news organization file."
490 :type 'file 500 :type 'file
491 :link '(custom-manual "(message)News Headers") 501 :link '(custom-manual "(message)News Headers")
@@ -578,15 +588,13 @@ Done before generating the new subject of a forward."
578 (if (string-match "[[:digit:]]" "1") ;; support POSIX? 588 (if (string-match "[[:digit:]]" "1") ;; support POSIX?
579 "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" 589 "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
580 ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. 590 ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
581 (let ((old-table (syntax-table)) 591 (let (non-word-constituents)
582 non-word-constituents) 592 (with-syntax-table text-mode-syntax-table
583 (set-syntax-table text-mode-syntax-table) 593 (setq non-word-constituents
584 (setq non-word-constituents 594 (concat
585 (concat 595 (if (string-match "\\w" "-") "" "-")
586 (if (string-match "\\w" "-") "" "-") 596 (if (string-match "\\w" "_") "" "_")
587 (if (string-match "\\w" "_") "" "_") 597 (if (string-match "\\w" ".") "" "."))))
588 (if (string-match "\\w" ".") "" ".")))
589 (set-syntax-table old-table)
590 (if (equal non-word-constituents "") 598 (if (equal non-word-constituents "")
591 "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" 599 "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
592 (concat "\\([ \t]*\\(\\w\\|[" 600 (concat "\\([ \t]*\\(\\w\\|["
@@ -596,7 +604,13 @@ Done before generating the new subject of a forward."
596 :version "22.1" 604 :version "22.1"
597 :group 'message-insertion 605 :group 'message-insertion
598 :link '(custom-manual "(message)Insertion Variables") 606 :link '(custom-manual "(message)Insertion Variables")
599 :type 'regexp) 607 :type 'regexp
608 :set (lambda (symbol value)
609 (prog1
610 (custom-set-default symbol value)
611 (if (boundp 'gnus-message-cite-prefix-regexp)
612 (setq gnus-message-cite-prefix-regexp
613 (concat "^\\(?:" value "\\)"))))))
600 614
601(defcustom message-cancel-message "I am canceling my own article.\n" 615(defcustom message-cancel-message "I am canceling my own article.\n"
602 "Message to be inserted in the cancel message." 616 "Message to be inserted in the cancel message."
@@ -605,8 +619,20 @@ Done before generating the new subject of a forward."
605 :type 'string) 619 :type 'string)
606 620
607;; Useful to set in site-init.el 621;; Useful to set in site-init.el
608;;;###autoload 622(defcustom message-send-mail-function
609(defcustom message-send-mail-function 'message-send-mail-with-sendmail 623 (let ((program (if (boundp 'sendmail-program)
624 ;; see paths.el
625 sendmail-program)))
626 (cond
627 ((and program
628 (string-match "/" program) ;; Skip path
629 (file-executable-p program))
630 'message-send-mail-with-sendmail)
631 ((and program
632 (executable-find program))
633 'message-send-mail-with-sendmail)
634 (t
635 'smtpmail-send-it)))
610 "Function to call to send the current buffer as mail. 636 "Function to call to send the current buffer as mail.
611The headers should be delimited by a line whose contents match the 637The headers should be delimited by a line whose contents match the
612variable `mail-header-separator'. 638variable `mail-header-separator'.
@@ -660,6 +686,12 @@ and respond with new To and Cc headers."
660 :link '(custom-manual "(message)Followup") 686 :link '(custom-manual "(message)Followup")
661 :type '(choice function (const nil))) 687 :type '(choice function (const nil)))
662 688
689(defcustom message-extra-wide-headers nil
690 "If non-nil, a list of additional address headers.
691These are used when composing a wide reply."
692 :group 'message-sending
693 :type '(repeat string))
694
663(defcustom message-use-followup-to 'ask 695(defcustom message-use-followup-to 'ask
664 "*Specifies what to do with Followup-To header. 696 "*Specifies what to do with Followup-To header.
665If nil, always ignore the header. If it is t, use its value, but 697If nil, always ignore the header. If it is t, use its value, but
@@ -756,6 +788,14 @@ If this is nil, use `user-mail-address'. If it is the symbol
756 :link '(custom-manual "(message)Mail Variables") 788 :link '(custom-manual "(message)Mail Variables")
757 :group 'message-sending) 789 :group 'message-sending)
758 790
791(defcustom message-sendmail-extra-arguments nil
792 "Additional arguments to `sendmail-program'."
793 ;; E.g. '("-a" "account") for msmtp
794 :version "23.0" ;; No Gnus
795 :type '(repeat string)
796 ;; :link '(custom-manual "(message)Mail Variables")
797 :group 'message-sending)
798
759;; qmail-related stuff 799;; qmail-related stuff
760(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" 800(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
761 "Location of the qmail-inject program." 801 "Location of the qmail-inject program."
@@ -776,11 +816,6 @@ might set this variable to '(\"-f\" \"you@some.where\")."
776 :type '(choice (function) 816 :type '(choice (function)
777 (repeat string))) 817 (repeat string)))
778 818
779(defvar message-cater-to-broken-inn t
780 "Non-nil means Gnus should not fold the `References' header.
781Folding `References' makes ancient versions of INN create incorrect
782NOV lines.")
783
784(eval-when-compile 819(eval-when-compile
785 (defvar gnus-post-method) 820 (defvar gnus-post-method)
786 (defvar gnus-select-method)) 821 (defvar gnus-select-method))
@@ -817,9 +852,18 @@ will not have a visible effect for those headers."
817 :group 'message-headers 852 :group 'message-headers
818 :link '(custom-manual "(message)Message Headers") 853 :link '(custom-manual "(message)Message Headers")
819 :type '(choice (const :tag "None" nil) 854 :type '(choice (const :tag "None" nil)
820 (const :tag "References" '(references)) 855 (const :tag "References" '(references))
821 (const :tag "All" t) 856 (const :tag "All" t)
822 (repeat (sexp :tag "Header")))) 857 (repeat (sexp :tag "Header"))))
858
859(defcustom message-fill-column 72
860 "Column beyond which automatic line-wrapping should happen.
861Local value for message buffers. If non-nil, also turn on
862auto-fill in message buffers."
863 :group 'message-various
864 ;; :link '(custom-manual "(message)Message Headers")
865 :type '(choice (const :tag "Don't turn on auto fill" nil)
866 (integer)))
823 867
824(defcustom message-setup-hook nil 868(defcustom message-setup-hook nil
825 "Normal hook, run each time a new outgoing message is initialized. 869 "Normal hook, run each time a new outgoing message is initialized.
@@ -866,31 +910,71 @@ the signature is inserted."
866 :version "22.1" 910 :version "22.1"
867 :group 'message-various) 911 :group 'message-various)
868 912
869;;;###autoload
870(defcustom message-citation-line-function 'message-insert-citation-line 913(defcustom message-citation-line-function 'message-insert-citation-line
871 "*Function called to insert the \"Whomever writes:\" line. 914 "*Function called to insert the \"Whomever writes:\" line.
872 915
916Predefined functions include `message-insert-citation-line' and
917`message-insert-formated-citation-line' (see the variable
918`message-citation-line-format').
919
873Note that Gnus provides a feature where the reader can click on 920Note that Gnus provides a feature where the reader can click on
874`writes:' to hide the cited text. If you change this line too much, 921`writes:' to hide the cited text. If you change this line too much,
875people who read your message will have to change their Gnus 922people who read your message will have to change their Gnus
876configuration. See the variable `gnus-cite-attribution-suffix'." 923configuration. See the variable `gnus-cite-attribution-suffix'."
877 :type 'function 924 :type '(choice
925 (function-item :tag "plain" message-insert-citation-line)
926 (function-item :tag "formatted" message-insert-formated-citation-line)
927 (function :tag "Other"))
878 :link '(custom-manual "(message)Insertion Variables") 928 :link '(custom-manual "(message)Insertion Variables")
879 :group 'message-insertion) 929 :group 'message-insertion)
880 930
881;;;###autoload 931(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
932 "Format of the \"Whomever writes:\" line.
933
934The string is formatted using `format-spec'. The following
935constructs are replaced:
936
937 %f The full From, e.g. \"John Doe <john.doe@example.invalid>\".
938 %n The mail address, e.g. \"john.doe@example.invalid\".
939 %N The real name if present, e.g.: \"John Doe\", else fall
940 back to the mail address.
941 %F The first name if present, e.g.: \"John\".
942 %L The last name if present, e.g.: \"Doe\".
943
944All other format specifiers are passed to `format-time-string'
945which is called using the date from the article your replying to.
946Extracting the first (%F) and last name (%L) is done
947heuristically, so you should always check it yourself.
948
949Please also read the note in the documentation of
950`message-citation-line-function'."
951 :type '(choice (const :tag "Plain" "%f writes:")
952 (const :tag "Include date" "On %a, %b %d %Y, %n wrote:")
953 string)
954 :link '(custom-manual "(message)Insertion Variables")
955 :version "23.0" ;; No Gnus
956 :group 'message-insertion)
957
882(defcustom message-yank-prefix "> " 958(defcustom message-yank-prefix "> "
883 "*Prefix inserted on the lines of yanked messages. 959 "*Prefix inserted on the lines of yanked messages.
884Fix `message-cite-prefix-regexp' if it is set to an abnormal value. 960Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
885See also `message-yank-cited-prefix'." 961See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
886 :type 'string 962 :type 'string
887 :link '(custom-manual "(message)Insertion Variables") 963 :link '(custom-manual "(message)Insertion Variables")
888 :group 'message-insertion) 964 :group 'message-insertion)
889 965
890(defcustom message-yank-cited-prefix ">" 966(defcustom message-yank-cited-prefix ">"
891 "*Prefix inserted on cited or empty lines of yanked messages. 967 "*Prefix inserted on cited lines of yanked messages.
892Fix `message-cite-prefix-regexp' if it is set to an abnormal value. 968Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
893See also `message-yank-prefix'." 969See also `message-yank-prefix' and `message-yank-empty-prefix'."
970 :version "22.1"
971 :type 'string
972 :link '(custom-manual "(message)Insertion Variables")
973 :group 'message-insertion)
974
975(defcustom message-yank-empty-prefix ">"
976 "*Prefix inserted on empty lines of yanked messages.
977See also `message-yank-prefix' and `message-yank-cited-prefix'."
894 :version "22.1" 978 :version "22.1"
895 :type 'string 979 :type 'string
896 :link '(custom-manual "(message)Insertion Variables") 980 :link '(custom-manual "(message)Insertion Variables")
@@ -903,12 +987,11 @@ Used by `message-yank-original' via `message-yank-cite'."
903 :link '(custom-manual "(message)Insertion Variables") 987 :link '(custom-manual "(message)Insertion Variables")
904 :type 'integer) 988 :type 'integer)
905 989
906;;;###autoload
907(defcustom message-cite-function 'message-cite-original 990(defcustom message-cite-function 'message-cite-original
908 "*Function for citing an original message. 991 "*Function for citing an original message.
909Predefined functions include `message-cite-original' and 992Predefined functions include `message-cite-original' and
910`message-cite-original-without-signature'. 993`message-cite-original-without-signature'.
911Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." 994Note that these functions use `mail-citation-hook' if that is non-nil."
912 :type '(radio (function-item message-cite-original) 995 :type '(radio (function-item message-cite-original)
913 (function-item message-cite-original-without-signature) 996 (function-item message-cite-original-without-signature)
914 (function-item sc-cite-original) 997 (function-item sc-cite-original)
@@ -916,7 +999,6 @@ Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
916 :link '(custom-manual "(message)Insertion Variables") 999 :link '(custom-manual "(message)Insertion Variables")
917 :group 'message-insertion) 1000 :group 'message-insertion)
918 1001
919;;;###autoload
920(defcustom message-indent-citation-function 'message-indent-citation 1002(defcustom message-indent-citation-function 'message-indent-citation
921 "*Function for modifying a citation just inserted in the mail buffer. 1003 "*Function for modifying a citation just inserted in the mail buffer.
922This can also be a list of functions. Each function can find the 1004This can also be a list of functions. Each function can find the
@@ -926,7 +1008,6 @@ point and mark around the citation text as modified."
926 :link '(custom-manual "(message)Insertion Variables") 1008 :link '(custom-manual "(message)Insertion Variables")
927 :group 'message-insertion) 1009 :group 'message-insertion)
928 1010
929;;;###autoload
930(defcustom message-signature t 1011(defcustom message-signature t
931 "*String to be inserted at the end of the message buffer. 1012 "*String to be inserted at the end of the message buffer.
932If t, the `message-signature-file' file will be inserted instead. 1013If t, the `message-signature-file' file will be inserted instead.
@@ -936,16 +1017,26 @@ If a form, the result from the form will be used instead."
936 :link '(custom-manual "(message)Insertion Variables") 1017 :link '(custom-manual "(message)Insertion Variables")
937 :group 'message-insertion) 1018 :group 'message-insertion)
938 1019
939;;;###autoload
940(defcustom message-signature-file "~/.signature" 1020(defcustom message-signature-file "~/.signature"
941 "*Name of file containing the text inserted at end of message buffer. 1021 "*Name of file containing the text inserted at end of message buffer.
942Ignored if the named file doesn't exist. 1022Ignored if the named file doesn't exist.
943If nil, don't insert a signature." 1023If nil, don't insert a signature.
1024If a path is specified, the value of `message-signature-directory' is ignored,
1025even if set."
944 :type '(choice file (const :tags "None" nil)) 1026 :type '(choice file (const :tags "None" nil))
945 :link '(custom-manual "(message)Insertion Variables") 1027 :link '(custom-manual "(message)Insertion Variables")
946 :group 'message-insertion) 1028 :group 'message-insertion)
947 1029
948;;;###autoload 1030(defcustom message-signature-directory nil
1031 "*Name of directory containing signature files.
1032Comes in handy if you have many such files, handled via posting styles for
1033instance.
1034If nil, `message-signature-file' is expected to specify the directory if
1035needed."
1036 :type '(choice string (const :tags "None" nil))
1037 :link '(custom-manual "(message)Insertion Variables")
1038 :group 'message-insertion)
1039
949(defcustom message-signature-insert-empty-line t 1040(defcustom message-signature-insert-empty-line t
950 "*If non-nil, insert an empty line before the signature separator." 1041 "*If non-nil, insert an empty line before the signature separator."
951 :version "22.1" 1042 :version "22.1"
@@ -1075,13 +1166,25 @@ the prefix.")
1075 1166
1076(defcustom message-mail-alias-type 'abbrev 1167(defcustom message-mail-alias-type 'abbrev
1077 "*What alias expansion type to use in Message buffers. 1168 "*What alias expansion type to use in Message buffers.
1078The default is `abbrev', which uses mailabbrev. nil switches 1169The default is `abbrev', which uses mailabbrev. `ecomplete' uses
1079mail aliases off." 1170an electric completion mode. nil switches mail aliases off.
1171This can also be a list of values."
1080 :group 'message 1172 :group 'message
1081 :link '(custom-manual "(message)Mail Aliases") 1173 :link '(custom-manual "(message)Mail Aliases")
1082 :type '(choice (const :tag "Use Mailabbrev" abbrev) 1174 :type '(choice (const :tag "Use Mailabbrev" abbrev)
1175 (const :tag "Use ecomplete" ecomplete)
1083 (const :tag "No expansion" nil))) 1176 (const :tag "No expansion" nil)))
1084 1177
1178(defcustom message-self-insert-commands '(self-insert-command)
1179 "List of `self-insert-command's used to trigger ecomplete.
1180When one of those commands is invoked to enter a character in To or Cc
1181header, ecomplete will suggest the candidates of recipients (see also
1182`message-mail-alias-type'). If you use some tool to enter non-ASCII
1183text and it replaces `self-insert-command' with the other command, e.g.
1184`egg-self-insert-command', you may want to add it to this list."
1185 :group 'message-various
1186 :type '(repeat function))
1187
1085(defcustom message-auto-save-directory 1188(defcustom message-auto-save-directory
1086 (file-name-as-directory (nnheader-concat message-directory "drafts")) 1189 (file-name-as-directory (nnheader-concat message-directory "drafts"))
1087 "*Directory where Message auto-saves buffers if Gnus isn't running. 1190 "*Directory where Message auto-saves buffers if Gnus isn't running.
@@ -1101,13 +1204,18 @@ If nil, you might be asked to input the charset."
1101 1204
1102(defcustom message-dont-reply-to-names 1205(defcustom message-dont-reply-to-names
1103 (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) 1206 (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
1104 "*A regexp specifying addresses to prune when doing wide replies. 1207 "*Addresses to prune when doing wide replies.
1105A value of nil means exclude your own user name only." 1208This can be a regexp or a list of regexps. Also, a value of nil means
1209exclude your own user name only."
1106 :version "21.1" 1210 :version "21.1"
1107 :group 'message 1211 :group 'message
1108 :link '(custom-manual "(message)Wide Reply") 1212 :link '(custom-manual "(message)Wide Reply")
1109 :type '(choice (const :tag "Yourself" nil) 1213 :type '(choice (const :tag "Yourself" nil)
1110 regexp)) 1214 regexp
1215 (repeat :tag "Regexp List" regexp)))
1216
1217(defsubst message-dont-reply-to-names ()
1218 (gmm-regexp-concat message-dont-reply-to-names))
1111 1219
1112(defvar message-shoot-gnksa-feet nil 1220(defvar message-shoot-gnksa-feet nil
1113 "*A list of GNKSA feet you are allowed to shoot. 1221 "*A list of GNKSA feet you are allowed to shoot.
@@ -1119,20 +1227,34 @@ candidates:
1119`quoted-text-only' Allow you to post quoted text only; 1227`quoted-text-only' Allow you to post quoted text only;
1120`multiple-copies' Allow you to post multiple copies; 1228`multiple-copies' Allow you to post multiple copies;
1121`cancel-messages' Allow you to cancel or supersede messages from 1229`cancel-messages' Allow you to cancel or supersede messages from
1122 your other email addresses.") 1230 your other email addresses.")
1123 1231
1124(defsubst message-gnksa-enable-p (feature) 1232(defsubst message-gnksa-enable-p (feature)
1125 (or (not (listp message-shoot-gnksa-feet)) 1233 (or (not (listp message-shoot-gnksa-feet))
1126 (memq feature message-shoot-gnksa-feet))) 1234 (memq feature message-shoot-gnksa-feet)))
1127 1235
1128(defcustom message-hidden-headers nil 1236(defcustom message-hidden-headers '("^References:" "^Face:" "^X-Face:"
1237 "^X-Draft-From:")
1129 "Regexp of headers to be hidden when composing new messages. 1238 "Regexp of headers to be hidden when composing new messages.
1130This can also be a list of regexps to match headers. Or a list 1239This can also be a list of regexps to match headers. Or a list
1131starting with `not' and followed by regexps." 1240starting with `not' and followed by regexps."
1132 :version "22.1" 1241 :version "22.1"
1133 :group 'message 1242 :group 'message
1134 :link '(custom-manual "(message)Message Headers") 1243 :link '(custom-manual "(message)Message Headers")
1135 :type '(repeat regexp)) 1244 :type '(choice
1245 :format "%{%t%}: %[Value Type%] %v"
1246 (regexp :menu-tag "regexp" :format "regexp\n%t: %v")
1247 (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i"
1248 (regexp :format "%t: %v"))
1249 (cons :menu-tag "(not regexp ...)" :format "(not regexp ...)\n%v"
1250 (const not)
1251 (repeat :format "%v%i"
1252 (regexp :format "%t: %v")))))
1253
1254(defcustom message-cite-articles-with-x-no-archive t
1255 "If non-nil, cite text from articles that has X-No-Archive set."
1256 :group 'message
1257 :type 'boolean)
1136 1258
1137;;; Internal variables. 1259;;; Internal variables.
1138;;; Well, not really internal. 1260;;; Well, not really internal.
@@ -1148,7 +1270,7 @@ starting with `not' and followed by regexps."
1148(defface message-header-to 1270(defface message-header-to
1149 '((((class color) 1271 '((((class color)
1150 (background dark)) 1272 (background dark))
1151 (:foreground "green2" :bold t)) 1273 (:foreground "DarkOliveGreen1" :bold t))
1152 (((class color) 1274 (((class color)
1153 (background light)) 1275 (background light))
1154 (:foreground "MidnightBlue" :bold t)) 1276 (:foreground "MidnightBlue" :bold t))
@@ -1162,7 +1284,7 @@ starting with `not' and followed by regexps."
1162(defface message-header-cc 1284(defface message-header-cc
1163 '((((class color) 1285 '((((class color)
1164 (background dark)) 1286 (background dark))
1165 (:foreground "green4" :bold t)) 1287 (:foreground "chartreuse1" :bold t))
1166 (((class color) 1288 (((class color)
1167 (background light)) 1289 (background light))
1168 (:foreground "MidnightBlue")) 1290 (:foreground "MidnightBlue"))
@@ -1176,7 +1298,7 @@ starting with `not' and followed by regexps."
1176(defface message-header-subject 1298(defface message-header-subject
1177 '((((class color) 1299 '((((class color)
1178 (background dark)) 1300 (background dark))
1179 (:foreground "green3")) 1301 (:foreground "OliveDrab1"))
1180 (((class color) 1302 (((class color)
1181 (background light)) 1303 (background light))
1182 (:foreground "navy blue" :bold t)) 1304 (:foreground "navy blue" :bold t))
@@ -1204,7 +1326,7 @@ starting with `not' and followed by regexps."
1204(defface message-header-other 1326(defface message-header-other
1205 '((((class color) 1327 '((((class color)
1206 (background dark)) 1328 (background dark))
1207 (:foreground "#b00000")) 1329 (:foreground "VioletRed1"))
1208 (((class color) 1330 (((class color)
1209 (background light)) 1331 (background light))
1210 (:foreground "steel blue")) 1332 (:foreground "steel blue"))
@@ -1218,7 +1340,7 @@ starting with `not' and followed by regexps."
1218(defface message-header-name 1340(defface message-header-name
1219 '((((class color) 1341 '((((class color)
1220 (background dark)) 1342 (background dark))
1221 (:foreground "DarkGreen")) 1343 (:foreground "green"))
1222 (((class color) 1344 (((class color)
1223 (background light)) 1345 (background light))
1224 (:foreground "cornflower blue")) 1346 (:foreground "cornflower blue"))
@@ -1232,7 +1354,7 @@ starting with `not' and followed by regexps."
1232(defface message-header-xheader 1354(defface message-header-xheader
1233 '((((class color) 1355 '((((class color)
1234 (background dark)) 1356 (background dark))
1235 (:foreground "blue")) 1357 (:foreground "DeepSkyBlue1"))
1236 (((class color) 1358 (((class color)
1237 (background light)) 1359 (background light))
1238 (:foreground "blue")) 1360 (:foreground "blue"))
@@ -1246,7 +1368,7 @@ starting with `not' and followed by regexps."
1246(defface message-separator 1368(defface message-separator
1247 '((((class color) 1369 '((((class color)
1248 (background dark)) 1370 (background dark))
1249 (:foreground "blue3")) 1371 (:foreground "LightSkyBlue1"))
1250 (((class color) 1372 (((class color)
1251 (background light)) 1373 (background light))
1252 (:foreground "brown")) 1374 (:foreground "brown"))
@@ -1260,7 +1382,7 @@ starting with `not' and followed by regexps."
1260(defface message-cited-text 1382(defface message-cited-text
1261 '((((class color) 1383 '((((class color)
1262 (background dark)) 1384 (background dark))
1263 (:foreground "red")) 1385 (:foreground "LightPink1"))
1264 (((class color) 1386 (((class color)
1265 (background light)) 1387 (background light))
1266 (:foreground "red")) 1388 (:foreground "red"))
@@ -1274,7 +1396,7 @@ starting with `not' and followed by regexps."
1274(defface message-mml 1396(defface message-mml
1275 '((((class color) 1397 '((((class color)
1276 (background dark)) 1398 (background dark))
1277 (:foreground "ForestGreen")) 1399 (:foreground "MediumSpringGreen"))
1278 (((class color) 1400 (((class color)
1279 (background light)) 1401 (background light))
1280 (:foreground "ForestGreen")) 1402 (:foreground "ForestGreen"))
@@ -1322,13 +1444,13 @@ starting with `not' and followed by regexps."
1322 (1 'message-header-name) 1444 (1 'message-header-name)
1323 (2 'message-header-newsgroups nil t)) 1445 (2 'message-header-newsgroups nil t))
1324 (,(message-font-lock-make-header-matcher 1446 (,(message-font-lock-make-header-matcher
1325 (concat "^\\([A-Z][^: \n\t]+:\\)" content)) 1447 (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
1326 (1 'message-header-name) 1448 (1 'message-header-name)
1327 (2 'message-header-other nil t)) 1449 (2 'message-header-xheader))
1328 (,(message-font-lock-make-header-matcher 1450 (,(message-font-lock-make-header-matcher
1329 (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) 1451 (concat "^\\([A-Z][^: \n\t]+:\\)" content))
1330 (1 'message-header-name) 1452 (1 'message-header-name)
1331 (2 'message-header-name)) 1453 (2 'message-header-other nil t))
1332 ,@(if (and mail-header-separator 1454 ,@(if (and mail-header-separator
1333 (not (equal mail-header-separator ""))) 1455 (not (equal mail-header-separator "")))
1334 `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") 1456 `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
@@ -1350,10 +1472,10 @@ starting with `not' and followed by regexps."
1350(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) 1472(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
1351 1473
1352(defvar message-face-alist 1474(defvar message-face-alist
1353 '((bold . bold-region) 1475 '((bold . message-bold-region)
1354 (underline . underline-region) 1476 (underline . underline-region)
1355 (default . (lambda (b e) 1477 (default . (lambda (b e)
1356 (unbold-region b e) 1478 (message-unbold-region b e)
1357 (ununderline-region b e)))) 1479 (ununderline-region b e))))
1358 "Alist of mail and news faces for facemenu. 1480 "Alist of mail and news faces for facemenu.
1359The cdr of each entry is a function for applying the face to a region.") 1481The cdr of each entry is a function for applying the face to a region.")
@@ -1493,6 +1615,19 @@ functionality to work."
1493 (const :tag "Never" nil) 1615 (const :tag "Never" nil)
1494 (const :tag "Always" t))) 1616 (const :tag "Always" t)))
1495 1617
1618(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
1619 "*Whether to generate X-Hashcash: headers.
1620If `t', always generate hashcash headers. If `opportunistic',
1621only generate hashcash headers if it can be done without the user
1622waiting (i.e., only asynchronously).
1623
1624You must have the \"hashcash\" binary installed, see `hashcash-path'."
1625 :group 'message-headers
1626 :link '(custom-manual "(message)Mail Headers")
1627 :type '(choice (const :tag "Always" t)
1628 (const :tag "Never" nil)
1629 (const :tag "Opportunistic" opportunistic)))
1630
1496;;; Internal variables. 1631;;; Internal variables.
1497 1632
1498(defvar message-sending-message "Sending...") 1633(defvar message-sending-message "Sending...")
@@ -1575,10 +1710,17 @@ functionality to work."
1575 "^|? *---+ +Message text follows: +---+ *|?$") 1710 "^|? *---+ +Message text follows: +---+ *|?$")
1576 "A regexp that matches the separator before the text of a failed message.") 1711 "A regexp that matches the separator before the text of a failed message.")
1577 1712
1713(defvar message-field-fillers
1714 '((To message-fill-field-address)
1715 (Cc message-fill-field-address)
1716 (From message-fill-field-address))
1717 "Alist of header names/filler functions.")
1718
1578(defvar message-header-format-alist 1719(defvar message-header-format-alist
1579 `((Newsgroups) 1720 `((From)
1580 (To . message-fill-address) 1721 (Newsgroups)
1581 (Cc . message-fill-address) 1722 (To)
1723 (Cc)
1582 (Subject) 1724 (Subject)
1583 (In-Reply-To) 1725 (In-Reply-To)
1584 (Fcc) 1726 (Fcc)
@@ -1622,28 +1764,32 @@ functionality to work."
1622 :type 'regexp) 1764 :type 'regexp)
1623 1765
1624(eval-and-compile 1766(eval-and-compile
1767 (autoload 'gnus-alive-p "gnus-util")
1768 (autoload 'gnus-delay-article "gnus-delay")
1769 (autoload 'gnus-extract-address-components "gnus-util")
1770 (autoload 'gnus-find-method-for-group "gnus")
1771 (autoload 'gnus-group-decoded-name "gnus-group")
1772 (autoload 'gnus-group-name-charset "gnus-group")
1773 (autoload 'gnus-group-name-decode "gnus-group")
1774 (autoload 'gnus-groups-from-server "gnus")
1775 (autoload 'gnus-make-local-hook "gnus-util")
1776 (autoload 'gnus-open-server "gnus-int")
1777 (autoload 'gnus-output-to-mail "gnus-util")
1778 (autoload 'gnus-output-to-rmail "gnus-util")
1779 (autoload 'gnus-request-post "gnus-int")
1780 (autoload 'gnus-select-frame-set-input-focus "gnus-util")
1781 (autoload 'gnus-server-string "gnus")
1625 (autoload 'idna-to-ascii "idna") 1782 (autoload 'idna-to-ascii "idna")
1626 (autoload 'message-setup-toolbar "messagexmas") 1783 (autoload 'message-setup-toolbar "messagexmas")
1627 (autoload 'mh-new-draft-name "mh-comp") 1784 (autoload 'mh-new-draft-name "mh-comp")
1628 (autoload 'mh-send-letter "mh-comp") 1785 (autoload 'mh-send-letter "mh-comp")
1629 (autoload 'gnus-point-at-eol "gnus-util")
1630 (autoload 'gnus-point-at-bol "gnus-util")
1631 (autoload 'gnus-output-to-rmail "gnus-util")
1632 (autoload 'gnus-output-to-mail "gnus-util")
1633 (autoload 'nndraft-request-associate-buffer "nndraft") 1786 (autoload 'nndraft-request-associate-buffer "nndraft")
1634 (autoload 'nndraft-request-expire-articles "nndraft") 1787 (autoload 'nndraft-request-expire-articles "nndraft")
1635 (autoload 'gnus-open-server "gnus-int") 1788 (autoload 'nnvirtual-find-group-art "nnvirtual")
1636 (autoload 'gnus-request-post "gnus-int") 1789 (autoload 'rmail-dont-reply-to "mail-utils")
1637 (autoload 'gnus-alive-p "gnus-util") 1790 (autoload 'rmail-msg-is-pruned "rmail")
1638 (autoload 'gnus-server-string "gnus") 1791 (autoload 'rmail-msg-restore-non-pruned-header "rmail")
1639 (autoload 'gnus-group-name-charset "gnus-group") 1792 (autoload 'rmail-output "rmailout"))
1640 (autoload 'gnus-group-name-decode "gnus-group")
1641 (autoload 'gnus-groups-from-server "gnus")
1642 (autoload 'rmail-output "rmailout")
1643 (autoload 'gnus-delay-article "gnus-delay")
1644 (autoload 'gnus-make-local-hook "gnus-util")
1645 (autoload 'gnus-extract-address-components "gnus-util")
1646 (autoload 'gnus-select-frame-set-input-focus "gnus-util"))
1647 1793
1648 1794
1649 1795
@@ -1723,12 +1869,10 @@ is used by default."
1723The buffer is expected to be narrowed to just the header of the message; 1869The buffer is expected to be narrowed to just the header of the message;
1724see `message-narrow-to-headers-or-head'." 1870see `message-narrow-to-headers-or-head'."
1725 (let* ((inhibit-point-motion-hooks t) 1871 (let* ((inhibit-point-motion-hooks t)
1726 (case-fold-search t)
1727 (value (mail-fetch-field header nil (not not-all)))) 1872 (value (mail-fetch-field header nil (not not-all))))
1728 (when value 1873 (when value
1729 (while (string-match "\n[\t ]+" value) 1874 (while (string-match "\n[\t ]+" value)
1730 (setq value (replace-match " " t t value))) 1875 (setq value (replace-match " " t t value)))
1731 (set-text-properties 0 (length value) nil value)
1732 value))) 1876 value)))
1733 1877
1734(defun message-field-value (header &optional not-all) 1878(defun message-field-value (header &optional not-all)
@@ -1741,14 +1885,14 @@ see `message-narrow-to-headers-or-head'."
1741(defun message-narrow-to-field () 1885(defun message-narrow-to-field ()
1742 "Narrow the buffer to the header on the current line." 1886 "Narrow the buffer to the header on the current line."
1743 (beginning-of-line) 1887 (beginning-of-line)
1888 (while (looking-at "[ \t]")
1889 (forward-line -1))
1744 (narrow-to-region 1890 (narrow-to-region
1745 (point) 1891 (point)
1746 (progn 1892 (progn
1747 (forward-line 1) 1893 (forward-line 1)
1748 (if (re-search-forward "^[^ \n\t]" nil t) 1894 (if (re-search-forward "^[^ \n\t]" nil t)
1749 (progn 1895 (point-at-bol)
1750 (beginning-of-line)
1751 (point))
1752 (point-max)))) 1896 (point-max))))
1753 (goto-char (point-min))) 1897 (goto-char (point-min)))
1754 1898
@@ -1964,28 +2108,30 @@ Leading \"Re: \" is not stripped by this function. Use the function
1964 " (was: " 2108 " (was: "
1965 old-subject ")\n"))))))))) 2109 old-subject ")\n")))))))))
1966 2110
1967(defun message-mark-inserted-region (beg end) 2111(defun message-mark-inserted-region (beg end &optional verbatim)
1968 "Mark some region in the current article with enclosing tags. 2112 "Mark some region in the current article with enclosing tags.
1969See `message-mark-insert-begin' and `message-mark-insert-end'." 2113See `message-mark-insert-begin' and `message-mark-insert-end'.
1970 (interactive "r") 2114If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
2115 (interactive "r\nP")
1971 (save-excursion 2116 (save-excursion
1972 ;; add to the end of the region first, otherwise end would be invalid 2117 ;; add to the end of the region first, otherwise end would be invalid
1973 (goto-char end) 2118 (goto-char end)
1974 (insert message-mark-insert-end) 2119 (insert (if verbatim "#v-\n" message-mark-insert-end))
1975 (goto-char beg) 2120 (goto-char beg)
1976 (insert message-mark-insert-begin))) 2121 (insert (if verbatim "#v+\n" message-mark-insert-begin))))
1977 2122
1978(defun message-mark-insert-file (file) 2123(defun message-mark-insert-file (file &optional verbatim)
1979 "Insert FILE at point, marking it with enclosing tags. 2124 "Insert FILE at point, marking it with enclosing tags.
1980See `message-mark-insert-begin' and `message-mark-insert-end'." 2125See `message-mark-insert-begin' and `message-mark-insert-end'.
1981 (interactive "fFile to insert: ") 2126If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
2127 (interactive "fFile to insert: \nP")
1982 ;; reverse insertion to get correct result. 2128 ;; reverse insertion to get correct result.
1983 (let ((p (point))) 2129 (let ((p (point)))
1984 (insert message-mark-insert-end) 2130 (insert (if verbatim "#v-\n" message-mark-insert-end))
1985 (goto-char p) 2131 (goto-char p)
1986 (insert-file-contents file) 2132 (insert-file-contents file)
1987 (goto-char p) 2133 (goto-char p)
1988 (insert message-mark-insert-begin))) 2134 (insert (if verbatim "#v+\n" message-mark-insert-begin))))
1989 2135
1990(defun message-add-archive-header () 2136(defun message-add-archive-header ()
1991 "Insert \"X-No-Archive: Yes\" in the header and a note in the body. 2137 "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
@@ -2304,6 +2450,14 @@ Point is left at the beginning of the narrowed-to region."
2304 (1+ max))))) 2450 (1+ max)))))
2305 (message-sort-headers-1)))) 2451 (message-sort-headers-1))))
2306 2452
2453(defun message-kill-address ()
2454 "Kill the address under point."
2455 (interactive)
2456 (let ((start (point)))
2457 (message-skip-to-next-address)
2458 (kill-region start (point))))
2459
2460
2307(defun message-info (&optional arg) 2461(defun message-info (&optional arg)
2308 "Display the Message manual. 2462 "Display the Message manual.
2309 2463
@@ -2365,6 +2519,7 @@ Prefixed with two \\[universal-argument]'s, display the PGG manual."
2365 (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) 2519 (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
2366 (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) 2520 (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
2367 (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) 2521 (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
2522 (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
2368 2523
2369 (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) 2524 (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
2370 (define-key message-mode-map "\C-c\M-n" 2525 (define-key message-mode-map "\C-c\M-n"
@@ -2385,18 +2540,20 @@ Prefixed with two \\[universal-argument]'s, display the PGG manual."
2385 (define-key message-mode-map "\C-c\C-d" 'message-dont-send) 2540 (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
2386 (define-key message-mode-map "\C-c\n" 'gnus-delay-article) 2541 (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
2387 2542
2543 (define-key message-mode-map "\C-c\M-k" 'message-kill-address)
2388 (define-key message-mode-map "\C-c\C-e" 'message-elide-region) 2544 (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
2389 (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) 2545 (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
2390 (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) 2546 (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
2391 (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) 2547 (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
2392 ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
2393 (define-key message-mode-map [remap split-line] 'message-split-line) 2548 (define-key message-mode-map [remap split-line] 'message-split-line)
2394 2549
2395 (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) 2550 (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
2396 2551
2397 (define-key message-mode-map "\C-a" 'message-beginning-of-line) 2552 (define-key message-mode-map "\C-a" 'message-beginning-of-line)
2398 (define-key message-mode-map "\t" 'message-tab) 2553 (define-key message-mode-map "\t" 'message-tab)
2399 (define-key message-mode-map "\M-;" 'comment-region)) 2554 (define-key message-mode-map "\M-;" 'comment-region)
2555
2556 (define-key message-mode-map "\M-n" 'message-display-abbrev))
2400 2557
2401(easy-menu-define 2558(easy-menu-define
2402 message-mode-menu message-mode-map "Message Menu." 2559 message-mode-menu message-mode-map "Message Menu."
@@ -2477,7 +2634,8 @@ Prefixed with two \\[universal-argument]'s, display the PGG manual."
2477 ;; ["Followup-To (with note in body)" message-cross-post-followup-to t] 2634 ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
2478 ["Crosspost / Followup-To..." message-cross-post-followup-to t] 2635 ["Crosspost / Followup-To..." message-cross-post-followup-to t]
2479 ["Distribution" message-goto-distribution t] 2636 ["Distribution" message-goto-distribution t]
2480 ["X-No-Archive:" message-add-archive-header t ] 2637 ["Expires" message-insert-expires t ]
2638 ["X-No-Archive" message-add-archive-header t ]
2481 "----" 2639 "----"
2482 ;; (typical) mailing-lists stuff 2640 ;; (typical) mailing-lists stuff
2483 ["Fetch To" message-insert-to 2641 ["Fetch To" message-insert-to
@@ -2497,6 +2655,8 @@ Prefixed with two \\[universal-argument]'s, display the PGG manual."
2497 "----" 2655 "----"
2498 ["Sort Headers" message-sort-headers t] 2656 ["Sort Headers" message-sort-headers t]
2499 ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t] 2657 ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
2658 ;; We hide `message-hidden-headers' by narrowing the buffer.
2659 ["Show Hidden Headers" widen t]
2500 ["Goto Body" message-goto-body t] 2660 ["Goto Body" message-goto-body t]
2501 ["Goto Signature" message-goto-signature t])) 2661 ["Goto Signature" message-goto-signature t]))
2502 2662
@@ -2555,19 +2715,23 @@ These properties are essential to work, so we should never strip them."
2555 (get-text-property pos 'egg-lang) 2715 (get-text-property pos 'egg-lang)
2556 (get-text-property pos 'egg-start))))) 2716 (get-text-property pos 'egg-start)))))
2557 2717
2718(defsubst message-mail-alias-type-p (type)
2719 (if (atom message-mail-alias-type)
2720 (eq message-mail-alias-type type)
2721 (memq type message-mail-alias-type)))
2722
2558(defun message-strip-forbidden-properties (begin end &optional old-length) 2723(defun message-strip-forbidden-properties (begin end &optional old-length)
2559 "Strip forbidden properties between BEGIN and END, ignoring the third arg. 2724 "Strip forbidden properties between BEGIN and END, ignoring the third arg.
2560This function is intended to be called from `after-change-functions'. 2725This function is intended to be called from `after-change-functions'.
2561See also `message-forbidden-properties'." 2726See also `message-forbidden-properties'."
2727 (when (and (message-mail-alias-type-p 'ecomplete)
2728 (memq this-command message-self-insert-commands))
2729 (message-display-abbrev))
2562 (when (and message-strip-special-text-properties 2730 (when (and message-strip-special-text-properties
2563 (message-tamago-not-in-use-p begin)) 2731 (message-tamago-not-in-use-p begin))
2564 (let ((buffer-read-only nil) 2732 (let ((buffer-read-only nil)
2565 (inhibit-read-only t)) 2733 (inhibit-read-only t))
2566 (while (not (= begin end)) 2734 (remove-text-properties begin end message-forbidden-properties))))
2567 (when (not (get-text-property begin 'message-hidden))
2568 (remove-text-properties begin (1+ begin)
2569 message-forbidden-properties))
2570 (incf begin)))))
2571 2735
2572;;;###autoload 2736;;;###autoload
2573(define-derived-mode message-mode text-mode "Message" 2737(define-derived-mode message-mode text-mode "Message"
@@ -2581,9 +2745,10 @@ C-c C-f move to a header field (and create it if there isn't):
2581 C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To 2745 C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To
2582 C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups 2746 C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups
2583 C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution 2747 C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
2584 C-c C-f C-o move to From (\"Originator\") 2748 C-c C-f C-o move to From (\"Originator\")
2585 C-c C-f C-f move to Followup-To 2749 C-c C-f C-f move to Followup-To
2586 C-c C-f C-m move to Mail-Followup-To 2750 C-c C-f C-m move to Mail-Followup-To
2751 C-c C-f C-e move to Expires
2587 C-c C-f C-i cycle through Importance values 2752 C-c C-f C-i cycle through Importance values
2588 C-c C-f s change subject and append \"(was: <Old Subject>)\" 2753 C-c C-f s change subject and append \"(was: <Old Subject>)\"
2589 C-c C-f x crossposting with FollowUp-To header and note in body 2754 C-c C-f x crossposting with FollowUp-To header and note in body
@@ -2632,6 +2797,9 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
2632 (set (make-local-variable 'message-checksum) nil) 2797 (set (make-local-variable 'message-checksum) nil)
2633 (set (make-local-variable 'message-mime-part) 0) 2798 (set (make-local-variable 'message-mime-part) 0)
2634 (message-setup-fill-variables) 2799 (message-setup-fill-variables)
2800 (when message-fill-column
2801 (setq fill-column message-fill-column)
2802 (turn-on-auto-fill))
2635 ;; Allow using comment commands to add/remove quoting. 2803 ;; Allow using comment commands to add/remove quoting.
2636 ;; (set (make-local-variable 'comment-start) message-yank-prefix) 2804 ;; (set (make-local-variable 'comment-start) message-yank-prefix)
2637 (when message-yank-prefix 2805 (when message-yank-prefix
@@ -2651,11 +2819,14 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
2651 (add-hook 'after-change-functions 'message-strip-forbidden-properties 2819 (add-hook 'after-change-functions 'message-strip-forbidden-properties
2652 nil 'local) 2820 nil 'local)
2653 ;; Allow mail alias things. 2821 ;; Allow mail alias things.
2654 (when (eq message-mail-alias-type 'abbrev) 2822 (cond
2823 ((message-mail-alias-type-p 'abbrev)
2655 (if (fboundp 'mail-abbrevs-setup) 2824 (if (fboundp 'mail-abbrevs-setup)
2656 (mail-abbrevs-setup) 2825 (mail-abbrevs-setup)
2657 (if (fboundp 'mail-aliases-setup) ; warning avoidance 2826 (if (fboundp 'mail-aliases-setup) ; warning avoidance
2658 (mail-aliases-setup)))) 2827 (mail-aliases-setup))))
2828 ((message-mail-alias-type-p 'ecomplete)
2829 (ecomplete-setup)))
2659 (unless buffer-file-name 2830 (unless buffer-file-name
2660 (message-set-auto-save-file-name)) 2831 (message-set-auto-save-file-name))
2661 (unless (buffer-base-buffer) 2832 (unless (buffer-base-buffer)
@@ -2845,11 +3016,11 @@ If the original author requested not to be sent mail, don't insert unless the
2845prefix FORCE is given." 3016prefix FORCE is given."
2846 (interactive "P") 3017 (interactive "P")
2847 (let* ((mct (message-fetch-reply-field "mail-copies-to")) 3018 (let* ((mct (message-fetch-reply-field "mail-copies-to"))
2848 (dont (and mct (or (equal (downcase mct) "never") 3019 (dont (and mct (or (equal (downcase mct) "never")
2849 (equal (downcase mct) "nobody")))) 3020 (equal (downcase mct) "nobody"))))
2850 (to (or (message-fetch-reply-field "mail-reply-to") 3021 (to (or (message-fetch-reply-field "mail-reply-to")
2851 (message-fetch-reply-field "reply-to") 3022 (message-fetch-reply-field "reply-to")
2852 (message-fetch-reply-field "from")))) 3023 (message-fetch-reply-field "from"))))
2853 (when (and dont to) 3024 (when (and dont to)
2854 (message 3025 (message
2855 (if force 3026 (if force
@@ -2889,21 +3060,21 @@ or in the synonym headers, defined by `message-header-synonyms'."
2889 ;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)") 3060 ;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)")
2890 (dolist (header headers) 3061 (dolist (header headers)
2891 (let* ((header-name (symbol-name (car header))) 3062 (let* ((header-name (symbol-name (car header)))
2892 (new-header (cdr header)) 3063 (new-header (cdr header))
2893 (synonyms (loop for synonym in message-header-synonyms 3064 (synonyms (loop for synonym in message-header-synonyms
2894 when (memq (car header) synonym) return synonym)) 3065 when (memq (car header) synonym) return synonym))
2895 (old-header 3066 (old-header
2896 (loop for synonym in synonyms 3067 (loop for synonym in synonyms
2897 for old-header = (mail-fetch-field (symbol-name synonym)) 3068 for old-header = (mail-fetch-field (symbol-name synonym))
2898 when (and old-header (string-match new-header old-header)) 3069 when (and old-header (string-match new-header old-header))
2899 return synonym))) 3070 return synonym)))
2900 (if old-header 3071 (if old-header
2901 (message "already have `%s' in `%s'" new-header old-header) 3072 (message "already have `%s' in `%s'" new-header old-header)
2902 (when (and (message-position-on-field header-name) 3073 (when (and (message-position-on-field header-name)
2903 (setq old-header (mail-fetch-field header-name)) 3074 (setq old-header (mail-fetch-field header-name))
2904 (not (string-match "\\` *\\'" old-header))) 3075 (not (string-match "\\` *\\'" old-header)))
2905 (insert ", ")) 3076 (insert ", "))
2906 (insert new-header))))) 3077 (insert new-header)))))
2907 3078
2908(defun message-widen-reply () 3079(defun message-widen-reply ()
2909 "Widen the reply to include maximum recipients." 3080 "Widen the reply to include maximum recipients."
@@ -2961,22 +3132,30 @@ or in the synonym headers, defined by `message-header-synonyms'."
2961 (when (message-goto-signature) 3132 (when (message-goto-signature)
2962 (forward-line -2))) 3133 (forward-line -2)))
2963 3134
2964(defun message-kill-to-signature () 3135(defun message-kill-to-signature (&optional arg)
2965 "Deletes all text up to the signature." 3136 "Kill all text up to the signature.
2966 (interactive) 3137If a numberic argument or prefix arg is given, leave that number
2967 (let ((point (point))) 3138of lines before the signature intact."
2968 (message-goto-signature) 3139 (interactive "P")
2969 (unless (eobp) 3140 (save-excursion
2970 (end-of-line -1)) 3141 (save-restriction
2971 (kill-region point (point)) 3142 (let ((point (point)))
2972 (unless (bolp) 3143 (narrow-to-region point (point-max))
2973 (insert "\n")))) 3144 (message-goto-signature)
3145 (unless (eobp)
3146 (if (and arg (numberp arg))
3147 (forward-line (- -1 arg))
3148 (end-of-line -1)))
3149 (unless (= point (point))
3150 (kill-region point (point))
3151 (unless (bolp)
3152 (insert "\n")))))))
2974 3153
2975(defun message-newline-and-reformat (&optional arg not-break) 3154(defun message-newline-and-reformat (&optional arg not-break)
2976 "Insert four newlines, and then reformat if inside quoted text. 3155 "Insert four newlines, and then reformat if inside quoted text.
2977Prefix arg means justify as well." 3156Prefix arg means justify as well."
2978 (interactive (list (if current-prefix-arg 'full))) 3157 (interactive (list (if current-prefix-arg 'full)))
2979 (let (quoted point beg end leading-space bolp) 3158 (let (quoted point beg end leading-space bolp fill-paragraph-function)
2980 (setq point (point)) 3159 (setq point (point))
2981 (beginning-of-line) 3160 (beginning-of-line)
2982 (setq beg (point)) 3161 (setq beg (point))
@@ -3061,22 +3240,22 @@ Prefix arg means justify as well."
3061 (if point (goto-char point))))) 3240 (if point (goto-char point)))))
3062 3241
3063(defun message-fill-paragraph (&optional arg) 3242(defun message-fill-paragraph (&optional arg)
3064 "Like `fill-paragraph'." 3243 "Message specific function to fill a paragraph.
3244This function is used as the value of `fill-paragraph-function' in
3245Message buffers and is not meant to be called directly."
3065 (interactive (list (if current-prefix-arg 'full))) 3246 (interactive (list (if current-prefix-arg 'full)))
3066 (if (if (boundp 'filladapt-mode) filladapt-mode) 3247 (if (if (boundp 'filladapt-mode) filladapt-mode)
3067 nil 3248 nil
3068 (message-newline-and-reformat arg t) 3249 (if (message-point-in-header-p)
3250 (message-fill-field)
3251 (message-newline-and-reformat arg t))
3069 t)) 3252 t))
3070 3253
3071;; Is it better to use `mail-header-end'?
3072(defun message-point-in-header-p () 3254(defun message-point-in-header-p ()
3073 "Return t if point is in the header." 3255 "Return t if point is in the header."
3074 (save-excursion 3256 (save-excursion
3075 (let ((p (point))) 3257 (not (re-search-backward
3076 (goto-char (point-min)) 3258 (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
3077 (not (re-search-forward
3078 (concat "^" (regexp-quote mail-header-separator) "\n")
3079 p t)))))
3080 3259
3081(defun message-do-auto-fill () 3260(defun message-do-auto-fill ()
3082 "Like `do-auto-fill', but don't fill in message header." 3261 "Like `do-auto-fill', but don't fill in message header."
@@ -3101,13 +3280,21 @@ Prefix arg means justify as well."
3101 ((listp message-signature) 3280 ((listp message-signature)
3102 (eval message-signature)) 3281 (eval message-signature))
3103 (t message-signature))) 3282 (t message-signature)))
3104 (signature 3283 signature-file)
3284 (setq signature
3105 (cond ((stringp signature) 3285 (cond ((stringp signature)
3106 signature) 3286 signature)
3107 ((and (eq t signature) 3287 ((and (eq t signature) message-signature-file)
3108 message-signature-file 3288 (setq signature-file
3109 (file-exists-p message-signature-file)) 3289 (if (and message-signature-directory
3110 signature)))) 3290 ;; don't actually use the signature directory
3291 ;; if message-signature-file contains a path.
3292 (not (file-name-directory
3293 message-signature-file)))
3294 (nnheader-concat message-signature-directory
3295 message-signature-file)
3296 message-signature-file))
3297 (file-exists-p signature-file))))
3111 (when signature 3298 (when signature
3112 (goto-char (point-max)) 3299 (goto-char (point-max))
3113 ;; Insert the signature. 3300 ;; Insert the signature.
@@ -3117,7 +3304,7 @@ Prefix arg means justify as well."
3117 (insert "\n")) 3304 (insert "\n"))
3118 (insert "-- \n") 3305 (insert "-- \n")
3119 (if (eq signature t) 3306 (if (eq signature t)
3120 (insert-file-contents message-signature-file) 3307 (insert-file-contents signature-file)
3121 (insert signature)) 3308 (insert signature))
3122 (goto-char (point-max)) 3309 (goto-char (point-max))
3123 (or (bolp) (insert "\n"))))) 3310 (or (bolp) (insert "\n")))))
@@ -3222,17 +3409,17 @@ text was killed."
3222 (substring table ?a (+ ?a n)) 3409 (substring table ?a (+ ?a n))
3223 (substring table (+ ?a 26) 255)))) 3410 (substring table (+ ?a 26) 255))))
3224 3411
3225(defun message-caesar-buffer-body (&optional rotnum) 3412(defun message-caesar-buffer-body (&optional rotnum wide)
3226 "Caesar rotate all letters in the current buffer by 13 places. 3413 "Caesar rotate all letters in the current buffer by 13 places.
3227Used to encode/decode possibly offensive messages (commonly in rec.humor). 3414Used to encode/decode possibly offensive messages (commonly in rec.humor).
3228With prefix arg, specifies the number of places to rotate each letter forward. 3415With prefix arg, specifies the number of places to rotate each letter forward.
3229Mail and USENET news headers are not rotated." 3416Mail and USENET news headers are not rotated unless WIDE is non-nil."
3230 (interactive (if current-prefix-arg 3417 (interactive (if current-prefix-arg
3231 (list (prefix-numeric-value current-prefix-arg)) 3418 (list (prefix-numeric-value current-prefix-arg))
3232 (list nil))) 3419 (list nil)))
3233 (save-excursion 3420 (save-excursion
3234 (save-restriction 3421 (save-restriction
3235 (when (message-goto-body) 3422 (when (and (not wide) (message-goto-body))
3236 (narrow-to-region (point) (point-max))) 3423 (narrow-to-region (point) (point-max)))
3237 (message-caesar-region (point-min) (point-max) rotnum)))) 3424 (message-caesar-region (point-min) (point-max) rotnum))))
3238 3425
@@ -3279,14 +3466,15 @@ Numeric argument means justify as well."
3279 (let ((fill-prefix message-yank-prefix)) 3466 (let ((fill-prefix message-yank-prefix))
3280 (fill-individual-paragraphs (point) (point-max) justifyp)))) 3467 (fill-individual-paragraphs (point) (point-max) justifyp))))
3281 3468
3282(defun message-indent-citation () 3469(defun message-indent-citation (&optional start end yank-only)
3283 "Modify text just inserted from a message to be cited. 3470 "Modify text just inserted from a message to be cited.
3284The inserted text should be the region. 3471The inserted text should be the region.
3285When this function returns, the region is again around the modified text. 3472When this function returns, the region is again around the modified text.
3286 3473
3287Normally, indent each nonblank line `message-indentation-spaces' spaces. 3474Normally, indent each nonblank line `message-indentation-spaces' spaces.
3288However, if `message-yank-prefix' is non-nil, insert that prefix on each line." 3475However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
3289 (let ((start (point))) 3476 (unless start (setq start (point)))
3477 (unless yank-only
3290 ;; Remove unwanted headers. 3478 ;; Remove unwanted headers.
3291 (when message-ignored-cited-headers 3479 (when message-ignored-cited-headers
3292 (let (all-removed) 3480 (let (all-removed)
@@ -3314,18 +3502,53 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
3314 (insert "\n")) 3502 (insert "\n"))
3315 (while (and (zerop (forward-line -1)) 3503 (while (and (zerop (forward-line -1))
3316 (looking-at "$")) 3504 (looking-at "$"))
3317 (message-delete-line)) 3505 (message-delete-line)))
3318 ;; Do the indentation. 3506 ;; Do the indentation.
3319 (if (null message-yank-prefix) 3507 (if (null message-yank-prefix)
3320 (indent-rigidly start (mark t) message-indentation-spaces) 3508 (indent-rigidly start (or end (mark t)) message-indentation-spaces)
3321 (save-excursion 3509 (save-excursion
3322 (goto-char start) 3510 (goto-char start)
3323 (while (< (point) (mark t)) 3511 (while (< (point) (or end (mark t)))
3324 (if (or (looking-at ">") (looking-at "^$")) 3512 (cond ((looking-at ">")
3325 (insert message-yank-cited-prefix) 3513 (insert message-yank-cited-prefix))
3326 (insert message-yank-prefix)) 3514 ((looking-at "^$")
3327 (forward-line 1)))) 3515 (insert message-yank-empty-prefix))
3328 (goto-char start))) 3516 (t
3517 (insert message-yank-prefix)))
3518 (forward-line 1))))
3519 (goto-char start))
3520
3521(defun message-remove-blank-cited-lines (&optional remove)
3522 "Remove cited lines containing only blanks.
3523If REMOVE is non-nil, remove newlines, too.
3524
3525To use this automatically, you may add this function to
3526`gnus-message-setup-hook'."
3527 (interactive "P")
3528 (let ((citexp
3529 (concat
3530 "^\\("
3531 (if (boundp 'message-yank-cited-prefix)
3532 (concat message-yank-cited-prefix "\\|"))
3533 message-yank-prefix
3534 "\\)+ *$"
3535 (if remove "\n" ""))))
3536 (gnus-message 8 "removing `%s'" citexp)
3537 (save-excursion
3538 (message-goto-body)
3539 (while (re-search-forward citexp nil t)
3540 (replace-match "")))))
3541
3542(defvar message-cite-reply-above nil
3543 "If non-nil, start own text above the quote.
3544
3545Note: Top posting is bad netiquette. Don't use it unless you
3546really must. You probably want to set variable only for specific
3547groups, e.g. using `gnus-posting-styles':
3548
3549 (eval (set (make-local-variable 'message-cite-reply-above) t))
3550
3551This variable has no effect in news postings.")
3329 3552
3330(defun message-yank-original (&optional arg) 3553(defun message-yank-original (&optional arg)
3331 "Insert the message being replied to, if any. 3554 "Insert the message being replied to, if any.
@@ -3338,9 +3561,22 @@ This function uses `message-cite-function' to do the actual citing.
3338Just \\[universal-argument] as argument means don't indent, insert no 3561Just \\[universal-argument] as argument means don't indent, insert no
3339prefix, and don't delete any headers." 3562prefix, and don't delete any headers."
3340 (interactive "P") 3563 (interactive "P")
3341 (let ((modified (buffer-modified-p))) 3564 (let ((modified (buffer-modified-p))
3565 body-text)
3342 (when (and message-reply-buffer 3566 (when (and message-reply-buffer
3343 message-cite-function) 3567 message-cite-function)
3568 (when message-cite-reply-above
3569 (if (and (not (message-news-p))
3570 (or (eq message-cite-reply-above 'is-evil)
3571 (y-or-n-p "\
3572Top posting is bad netiquette. Please don't top post unless you really must.
3573Really top post? ")))
3574 (save-excursion
3575 (setq body-text
3576 (buffer-substring (message-goto-body)
3577 (point-max)))
3578 (delete-region (message-goto-body) (point-max)))
3579 (set (make-local-variable 'message-cite-reply-above) nil)))
3344 (delete-windows-on message-reply-buffer t) 3580 (delete-windows-on message-reply-buffer t)
3345 (push-mark (save-excursion 3581 (push-mark (save-excursion
3346 (insert-buffer-substring message-reply-buffer) 3582 (insert-buffer-substring message-reply-buffer)
@@ -3354,6 +3590,13 @@ prefix, and don't delete any headers."
3354 (goto-char (mark t)) 3590 (goto-char (mark t))
3355 (insert-before-markers ?\n) 3591 (insert-before-markers ?\n)
3356 (goto-char pt)))) 3592 (goto-char pt))))
3593 (when message-cite-reply-above
3594 (message-goto-body)
3595 (insert body-text)
3596 (insert (if (bolp) "\n" "\n\n"))
3597 (message-goto-body))
3598 ;; Add a `message-setup-very-last-hook' here?
3599 ;; Add `gnus-article-highlight-citation' here?
3357 (unless modified 3600 (unless modified
3358 (setq message-checksum (message-checksum)))))) 3601 (setq message-checksum (message-checksum))))))
3359 3602
@@ -3375,59 +3618,20 @@ prefix, and don't delete any headers."
3375 (push (buffer-name buffer) buffers)))) 3618 (push (buffer-name buffer) buffers))))
3376 (nreverse buffers))) 3619 (nreverse buffers)))
3377 3620
3378(defun message-cite-original-without-signature () 3621(eval-when-compile (defvar mail-citation-hook)) ; Compiler directive
3379 "Cite function in the standard Message manner."
3380 (let* ((start (point))
3381 (end (mark t))
3382 (functions
3383 (when message-indent-citation-function
3384 (if (listp message-indent-citation-function)
3385 message-indent-citation-function
3386 (list message-indent-citation-function))))
3387 ;; This function may be called by `gnus-summary-yank-message' and
3388 ;; may insert a different article from the original. So, we will
3389 ;; modify the value of `message-reply-headers' with that article.
3390 (message-reply-headers
3391 (save-restriction
3392 (narrow-to-region start end)
3393 (message-narrow-to-head-1)
3394 (vector 0
3395 (or (message-fetch-field "subject") "none")
3396 (or (message-fetch-field "from") "nobody")
3397 (message-fetch-field "date")
3398 (message-fetch-field "message-id" t)
3399 (message-fetch-field "references")
3400 0 0 ""))))
3401 (mml-quote-region start end)
3402 ;; Allow undoing.
3403 (undo-boundary)
3404 (goto-char end)
3405 (when (re-search-backward message-signature-separator start t)
3406 ;; Also peel off any blank lines before the signature.
3407 (forward-line -1)
3408 (while (looking-at "^[ \t]*$")
3409 (forward-line -1))
3410 (forward-line 1)
3411 (delete-region (point) end)
3412 (unless (search-backward "\n\n" start t)
3413 ;; Insert a blank line if it is peeled off.
3414 (insert "\n")))
3415 (goto-char start)
3416 (while functions
3417 (funcall (pop functions)))
3418 (when message-citation-line-function
3419 (unless (bolp)
3420 (insert "\n"))
3421 (funcall message-citation-line-function))))
3422 3622
3423(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive 3623(defun message-cite-original-1 (strip-signature)
3424(defun message-cite-original () 3624 "Cite an original message.
3425 "Cite function in the standard Message manner." 3625If STRIP-SIGNATURE is non-nil, strips off the signature from the
3626original message.
3627
3628This function uses `mail-citation-hook' if that is non-nil."
3426 (if (and (boundp 'mail-citation-hook) 3629 (if (and (boundp 'mail-citation-hook)
3427 mail-citation-hook) 3630 mail-citation-hook)
3428 (run-hooks 'mail-citation-hook) 3631 (run-hooks 'mail-citation-hook)
3429 (let* ((start (point)) 3632 (let* ((start (point))
3430 (end (mark t)) 3633 (end (mark t))
3634 (x-no-archive nil)
3431 (functions 3635 (functions
3432 (when message-indent-citation-function 3636 (when message-indent-citation-function
3433 (if (listp message-indent-citation-function) 3637 (if (listp message-indent-citation-function)
@@ -3440,6 +3644,7 @@ prefix, and don't delete any headers."
3440 (save-restriction 3644 (save-restriction
3441 (narrow-to-region start end) 3645 (narrow-to-region start end)
3442 (message-narrow-to-head-1) 3646 (message-narrow-to-head-1)
3647 (setq x-no-archive (message-fetch-field "x-no-archive"))
3443 (vector 0 3648 (vector 0
3444 (or (message-fetch-field "subject") "none") 3649 (or (message-fetch-field "subject") "none")
3445 (or (message-fetch-field "from") "nobody") 3650 (or (message-fetch-field "from") "nobody")
@@ -3448,13 +3653,129 @@ prefix, and don't delete any headers."
3448 (message-fetch-field "references") 3653 (message-fetch-field "references")
3449 0 0 "")))) 3654 0 0 ""))))
3450 (mml-quote-region start end) 3655 (mml-quote-region start end)
3656 (when strip-signature
3657 ;; Allow undoing.
3658 (undo-boundary)
3659 (goto-char end)
3660 (when (re-search-backward message-signature-separator start t)
3661 ;; Also peel off any blank lines before the signature.
3662 (forward-line -1)
3663 (while (looking-at "^[ \t]*$")
3664 (forward-line -1))
3665 (forward-line 1)
3666 (delete-region (point) end)
3667 (unless (search-backward "\n\n" start t)
3668 ;; Insert a blank line if it is peeled off.
3669 (insert "\n"))))
3451 (goto-char start) 3670 (goto-char start)
3452 (while functions 3671 (mapc 'funcall functions)
3453 (funcall (pop functions)))
3454 (when message-citation-line-function 3672 (when message-citation-line-function
3455 (unless (bolp) 3673 (unless (bolp)
3456 (insert "\n")) 3674 (insert "\n"))
3457 (funcall message-citation-line-function))))) 3675 (funcall message-citation-line-function))
3676 (when (and x-no-archive
3677 (not message-cite-articles-with-x-no-archive)
3678 (string-match "yes" x-no-archive))
3679 (undo-boundary)
3680 (delete-region (point) (mark t))
3681 (insert "> [Quoted text removed due to X-No-Archive]\n")
3682 (push-mark)
3683 (forward-line -1)))))
3684
3685(defun message-cite-original ()
3686 "Cite function in the standard Message manner."
3687 (message-cite-original-1 nil))
3688
3689(defun message-insert-formated-citation-line (&optional from date)
3690 "Function that inserts a formated citation line.
3691
3692See `message-citation-line-format'."
3693 ;; The optional args are for testing/debugging. They will disappear later.
3694 ;; Example:
3695 ;; (with-temp-buffer
3696 ;; (message-insert-formated-citation-line
3697 ;; "John Doe <john.doe@example.invalid>"
3698 ;; (current-time))
3699 ;; (buffer-string))
3700 (when (or message-reply-headers (and from date))
3701 (unless from
3702 (setq from (mail-header-from message-reply-headers)))
3703 (let* ((data (condition-case ()
3704 (funcall (if (boundp gnus-extract-address-components)
3705 gnus-extract-address-components
3706 'mail-extract-address-components)
3707 from)
3708 (error nil)))
3709 (name (car data))
3710 (fname name)
3711 (lname name)
3712 (net (car (cdr data)))
3713 (name-or-net (or (car data)
3714 (car (cdr data)) from))
3715 (replydate
3716 (or
3717 date
3718 ;; We need Gnus functionality if the user wants date or time from
3719 ;; the original article:
3720 (when (string-match "%[^fnNFL]" message-citation-line-format)
3721 (autoload 'gnus-date-get-time "gnus-util")
3722 (gnus-date-get-time (mail-header-date message-reply-headers)))))
3723 (flist
3724 (let ((i ?A) lst)
3725 (when (stringp name)
3726 ;; Guess first name and last name:
3727 (cond ((string-match
3728 "\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name)
3729 (setq fname (nth 0 (split-string name "[ \t]+"))
3730 lname (nth 1 (split-string name "[ \t]+"))))
3731 ((string-match
3732 "\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name)
3733 (setq fname (nth 1 (split-string name "[ \t,]+"))
3734 lname (nth 0 (split-string name "[ \t,]+"))))
3735 ((string-match
3736 "\\`\\(\\w\\|[-.]\\)+\\'" name)
3737 (setq fname name
3738 lname ""))))
3739 ;; The following letters are not used in `format-time-string':
3740 (push ?E lst) (push "<E>" lst)
3741 (push ?F lst) (push fname lst)
3742 ;; We might want to use "" instead of "<X>" later.
3743 (push ?J lst) (push "<J>" lst)
3744 (push ?K lst) (push "<K>" lst)
3745 (push ?L lst) (push lname lst)
3746 (push ?N lst) (push name-or-net lst)
3747 (push ?O lst) (push "<O>" lst)
3748 (push ?P lst) (push "<P>" lst)
3749 (push ?Q lst) (push "<Q>" lst)
3750 (push ?f lst) (push from lst)
3751 (push ?i lst) (push "<i>" lst)
3752 (push ?n lst) (push net lst)
3753 (push ?o lst) (push "<o>" lst)
3754 (push ?q lst) (push "<q>" lst)
3755 (push ?t lst) (push "<t>" lst)
3756 (push ?v lst) (push "<v>" lst)
3757 ;; Delegate the rest to `format-time-string':
3758 (while (<= i ?z)
3759 (when (and (not (memq i lst))
3760 ;; Skip (Z,a)
3761 (or (<= i ?Z)
3762 (>= i ?a)))
3763 (push i lst)
3764 (push (condition-case nil
3765 (progn (format-time-string (format "%%%c" i)
3766 replydate))
3767 (format ">%c<" i))
3768 lst))
3769 (setq i (1+ i)))
3770 (reverse lst)))
3771 (spec (apply 'format-spec-make flist)))
3772 (insert (format-spec message-citation-line-format spec)))
3773 (newline)))
3774
3775(defun message-cite-original-without-signature ()
3776 "Cite function in the standard Message manner.
3777This function strips off the signature from the original message."
3778 (message-cite-original-1 t))
3458 3779
3459(defun message-insert-citation-line () 3780(defun message-insert-citation-line ()
3460 "Insert a simple citation line." 3781 "Insert a simple citation line."
@@ -3548,6 +3869,7 @@ Instead, just auto-save the buffer and then bury it."
3548 "Kill the current buffer." 3869 "Kill the current buffer."
3549 (interactive) 3870 (interactive)
3550 (when (or (not (buffer-modified-p)) 3871 (when (or (not (buffer-modified-p))
3872 (not message-kill-buffer-query)
3551 (yes-or-no-p "Message modified; kill anyway? ")) 3873 (yes-or-no-p "Message modified; kill anyway? "))
3552 (let ((actions message-kill-actions) 3874 (let ((actions message-kill-actions)
3553 (draft-article message-draft-article) 3875 (draft-article message-draft-article)
@@ -3640,6 +3962,9 @@ It should typically alter the sending method in some way or other."
3640 (save-excursion 3962 (save-excursion
3641 (run-hooks 'message-sent-hook)) 3963 (run-hooks 'message-sent-hook))
3642 (message "Sending...done") 3964 (message "Sending...done")
3965 ;; Do ecomplete address snarfing.
3966 (when (message-mail-alias-type-p 'ecomplete)
3967 (message-put-addresses-in-ecomplete))
3643 ;; Mark the buffer as unmodified and delete auto-save. 3968 ;; Mark the buffer as unmodified and delete auto-save.
3644 (set-buffer-modified-p nil) 3969 (set-buffer-modified-p nil)
3645 (delete-auto-save-file-if-necessary t) 3970 (delete-auto-save-file-if-necessary t)
@@ -3667,16 +3992,31 @@ It should typically alter the sending method in some way or other."
3667(put 'message-check 'lisp-indent-function 1) 3992(put 'message-check 'lisp-indent-function 1)
3668(put 'message-check 'edebug-form-spec '(form body)) 3993(put 'message-check 'edebug-form-spec '(form body))
3669 3994
3670(defun message-text-with-property (prop) 3995(defun message-text-with-property (prop &optional start end reverse)
3671 "Return a list of all points where the text has PROP." 3996 "Return a list of start and end positions where the text has PROP.
3672 (let ((points nil) 3997START and END bound the search, they default to `point-min' and
3673 (point (point-min))) 3998`point-max' respectively. If REVERSE is non-nil, find text which does
3674 (save-excursion 3999not have PROP."
3675 (while (< point (point-max)) 4000 (unless start
3676 (when (get-text-property point prop) 4001 (setq start (point-min)))
3677 (push point points)) 4002 (unless end
3678 (incf point))) 4003 (setq end (point-max)))
3679 (nreverse points))) 4004 (let (next regions)
4005 (if reverse
4006 (while (and start
4007 (setq start (text-property-any start end prop nil)))
4008 (setq next (next-single-property-change start prop nil end))
4009 (push (cons start (or next end)) regions)
4010 (setq start next))
4011 (while (and start
4012 (or (get-text-property start prop)
4013 (and (setq start (next-single-property-change
4014 start prop nil end))
4015 (get-text-property start prop))))
4016 (setq next (text-property-any start end prop nil))
4017 (push (cons start (or next end)) regions)
4018 (setq start next)))
4019 (nreverse regions)))
3680 4020
3681(defun message-fix-before-sending () 4021(defun message-fix-before-sending ()
3682 "Do various things to make the message nice before sending it." 4022 "Do various things to make the message nice before sending it."
@@ -3685,44 +4025,49 @@ It should typically alter the sending method in some way or other."
3685 (unless (bolp) 4025 (unless (bolp)
3686 (insert "\n")) 4026 (insert "\n"))
3687 ;; Make the hidden headers visible. 4027 ;; Make the hidden headers visible.
3688 (let ((points (message-text-with-property 'message-hidden))) 4028 (widen)
3689 (when points 4029 ;; Sort headers before sending the message.
3690 (goto-char (car points)) 4030 (message-sort-headers)
3691 (dolist (point points)
3692 (add-text-properties point (1+ point)
3693 '(invisible nil intangible nil)))))
3694 ;; Make invisible text visible. 4031 ;; Make invisible text visible.
3695 ;; It doesn't seem as if this is useful, since the invisible property 4032 ;; It doesn't seem as if this is useful, since the invisible property
3696 ;; is clobbered by an after-change hook anyhow. 4033 ;; is clobbered by an after-change hook anyhow.
3697 (message-check 'invisible-text 4034 (message-check 'invisible-text
3698 (let ((points (message-text-with-property 'invisible))) 4035 (let ((regions (message-text-with-property 'invisible))
3699 (when points 4036 from to)
3700 (goto-char (car points)) 4037 (when regions
3701 (dolist (point points) 4038 (while regions
3702 (put-text-property point (1+ point) 'invisible nil) 4039 (setq from (caar regions)
3703 (message-overlay-put (message-make-overlay point (1+ point)) 4040 to (cdar regions)
4041 regions (cdr regions))
4042 (put-text-property from to 'invisible nil)
4043 (message-overlay-put (message-make-overlay from to)
3704 'face 'highlight)) 4044 'face 'highlight))
3705 (unless (yes-or-no-p 4045 (unless (yes-or-no-p
3706 "Invisible text found and made visible; continue sending? ") 4046 "Invisible text found and made visible; continue sending? ")
3707 (error "Invisible text found and made visible"))))) 4047 (error "Invisible text found and made visible")))))
3708 (message-check 'illegible-text 4048 (message-check 'illegible-text
3709 (let (found choice) 4049 (let (char found choice)
3710 (message-goto-body) 4050 (message-goto-body)
3711 (skip-chars-forward mm-7bit-chars) 4051 (while (progn
3712 (while (not (eobp)) 4052 (skip-chars-forward mm-7bit-chars)
3713 (when (let ((char (char-after))) 4053 (when (get-text-property (point) 'no-illegible-text)
3714 (or (< (mm-char-int char) 128) 4054 ;; There is a signed or encrypted raw message part
3715 (and (mm-multibyte-p) 4055 ;; that is considered to be safe.
3716 (memq (char-charset char) 4056 (goto-char (or (next-single-property-change
3717 '(eight-bit-control eight-bit-graphic 4057 (point) 'no-illegible-text)
3718 control-1)) 4058 (point-max))))
3719 (not (get-text-property 4059 (setq char (char-after)))
3720 (point) 'untranslated-utf-8))))) 4060 (when (or (< (mm-char-int char) 128)
4061 (and (mm-multibyte-p)
4062 (memq (char-charset char)
4063 '(eight-bit-control eight-bit-graphic
4064 control-1))
4065 (not (get-text-property
4066 (point) 'untranslated-utf-8))))
3721 (message-overlay-put (message-make-overlay (point) (1+ (point))) 4067 (message-overlay-put (message-make-overlay (point) (1+ (point)))
3722 'face 'highlight) 4068 'face 'highlight)
3723 (setq found t)) 4069 (setq found t))
3724 (forward-char) 4070 (forward-char))
3725 (skip-chars-forward mm-7bit-chars))
3726 (when found 4071 (when found
3727 (setq choice 4072 (setq choice
3728 (gnus-multiple-choice 4073 (gnus-multiple-choice
@@ -3773,16 +4118,15 @@ It should typically alter the sending method in some way or other."
3773(defun message-do-actions (actions) 4118(defun message-do-actions (actions)
3774 "Perform all actions in ACTIONS." 4119 "Perform all actions in ACTIONS."
3775 ;; Now perform actions on successful sending. 4120 ;; Now perform actions on successful sending.
3776 (while actions 4121 (dolist (action actions)
3777 (ignore-errors 4122 (ignore-errors
3778 (cond 4123 (cond
3779 ;; A simple function. 4124 ;; A simple function.
3780 ((functionp (car actions)) 4125 ((functionp action)
3781 (funcall (car actions))) 4126 (funcall action))
3782 ;; Something to be evaled. 4127 ;; Something to be evaled.
3783 (t 4128 (t
3784 (eval (car actions))))) 4129 (eval action))))))
3785 (pop actions)))
3786 4130
3787(defun message-send-mail-partially () 4131(defun message-send-mail-partially ()
3788 "Send mail as message/partial." 4132 "Send mail as message/partial."
@@ -3867,6 +4211,15 @@ It should typically alter the sending method in some way or other."
3867 (gnus-setup-posting-charset nil) 4211 (gnus-setup-posting-charset nil)
3868 message-posting-charset)) 4212 message-posting-charset))
3869 (headers message-required-mail-headers)) 4213 (headers message-required-mail-headers))
4214 (when (and message-generate-hashcash
4215 (not (eq message-generate-hashcash 'opportunistic)))
4216 (message "Generating hashcash...")
4217 ;; Wait for calculations already started to finish...
4218 (hashcash-wait-async)
4219 ;; ...and do calculations not already done. mail-add-payment
4220 ;; will leave existing X-Hashcash headers alone.
4221 (mail-add-payment)
4222 (message "Generating hashcash...done"))
3870 (save-restriction 4223 (save-restriction
3871 (message-narrow-to-headers) 4224 (message-narrow-to-headers)
3872 ;; Generate the Mail-Followup-To header if the header is not there... 4225 ;; Generate the Mail-Followup-To header if the header is not there...
@@ -4003,8 +4356,7 @@ If you always want Gnus to send messages in one piece, set
4003 (when (eval message-mailer-swallows-blank-line) 4356 (when (eval message-mailer-swallows-blank-line)
4004 (newline)) 4357 (newline))
4005 (when message-interactive 4358 (when message-interactive
4006 (save-excursion 4359 (with-current-buffer errbuf
4007 (set-buffer errbuf)
4008 (erase-buffer)))) 4360 (erase-buffer))))
4009 (let* ((default-directory "/") 4361 (let* ((default-directory "/")
4010 (coding-system-for-write message-send-coding-system) 4362 (coding-system-for-write message-send-coding-system)
@@ -4022,6 +4374,7 @@ If you always want Gnus to send messages in one piece, set
4022 "/usr/ucblib/sendmail") 4374 "/usr/ucblib/sendmail")
4023 (t "fakemail")) 4375 (t "fakemail"))
4024 nil errbuf nil "-oi") 4376 nil errbuf nil "-oi")
4377 message-sendmail-extra-arguments
4025 ;; Always specify who from, 4378 ;; Always specify who from,
4026 ;; since some systems have broken sendmails. 4379 ;; since some systems have broken sendmails.
4027 ;; But some systems are more broken with -f, so 4380 ;; But some systems are more broken with -f, so
@@ -4045,7 +4398,7 @@ If you always want Gnus to send messages in one piece, set
4045 (save-excursion 4398 (save-excursion
4046 (set-buffer errbuf) 4399 (set-buffer errbuf)
4047 (goto-char (point-min)) 4400 (goto-char (point-min))
4048 (while (re-search-forward "\n\n* *" nil t) 4401 (while (re-search-forward "\n+ *" nil t)
4049 (replace-match "; ")) 4402 (replace-match "; "))
4050 (if (not (zerop (buffer-size))) 4403 (if (not (zerop (buffer-size)))
4051 (error "Sending...failed to %s" 4404 (error "Sending...failed to %s"
@@ -4086,9 +4439,9 @@ to find out how to use this."
4086 ;; free for -inject-arguments -- a big win for the user and for us 4439 ;; free for -inject-arguments -- a big win for the user and for us
4087 ;; since we don't have to play that double-guessing game and the user 4440 ;; since we don't have to play that double-guessing game and the user
4088 ;; gets full control (no gestapo'ish -f's, for instance). --sj 4441 ;; gets full control (no gestapo'ish -f's, for instance). --sj
4089 (if (functionp message-qmail-inject-args) 4442 (if (functionp message-qmail-inject-args)
4090 (funcall message-qmail-inject-args) 4443 (funcall message-qmail-inject-args)
4091 message-qmail-inject-args))) 4444 message-qmail-inject-args)))
4092 ;; qmail-inject doesn't say anything on it's stdout/stderr, 4445 ;; qmail-inject doesn't say anything on it's stdout/stderr,
4093 ;; we have to look at the retval instead 4446 ;; we have to look at the retval instead
4094 (0 nil) 4447 (0 nil)
@@ -4753,29 +5106,27 @@ Otherwise, generate and save a value for `canlock-password' first."
4753 (when (re-search-forward ",+$" nil t) 5106 (when (re-search-forward ",+$" nil t)
4754 (replace-match "" t t)))))) 5107 (replace-match "" t t))))))
4755 5108
4756(eval-when-compile (require 'parse-time))
4757(defun message-make-date (&optional now) 5109(defun message-make-date (&optional now)
4758 "Make a valid data header. 5110 "Make a valid data header.
4759If NOW, use that time instead." 5111If NOW, use that time instead."
4760 (require 'parse-time) 5112 (let ((system-time-locale "C"))
4761 (let* ((now (or now (current-time))) 5113 (format-time-string "%a, %d %b %Y %T %z" now)))
4762 (zone (nth 8 (decode-time now))) 5114
4763 (sign "+")) 5115(defun message-insert-expires (days)
4764 (when (< zone 0) 5116 "Insert the Expires header. Expiry in DAYS days."
4765 (setq sign "-") 5117 (interactive "NExpire article in how many days? ")
4766 (setq zone (- zone))) 5118 (save-excursion
4767 (concat 5119 (message-position-on-field "Expires" "X-Draft-From")
4768 ;; The day name of the %a spec is locale-specific. Pfff. 5120 (insert (message-make-expires-date days))))
4769 (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now)) 5121
4770 parse-time-weekdays)))) 5122(defun message-make-expires-date (days)
4771 (format-time-string "%d" now) 5123 "Make date string for the Expires header. Expiry in DAYS days.
4772 ;; The month name of the %b spec is locale-specific. Pfff. 5124
4773 (format " %s " 5125In posting styles use `(\"Expires\" (make-expires-date 30))'."
4774 (capitalize (car (rassoc (nth 4 (decode-time now)) 5126 (let* ((cur (decode-time (current-time)))
4775 parse-time-months)))) 5127 (nday (+ days (nth 3 cur))))
4776 (format-time-string "%Y %H:%M:%S " now) 5128 (setf (nth 3 cur) nday)
4777 ;; We do all of this because XEmacs doesn't have the %z spec. 5129 (message-make-date (apply 'encode-time cur))))
4778 (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
4779 5130
4780(defun message-make-message-id () 5131(defun message-make-message-id ()
4781 "Make a unique Message-ID." 5132 "Make a unique Message-ID."
@@ -4940,14 +5291,14 @@ If NOW, use that time instead."
4940 (concat message-user-path "!" login-name)) 5291 (concat message-user-path "!" login-name))
4941 (t login-name)))) 5292 (t login-name))))
4942 5293
4943(defun message-make-from () 5294(defun message-make-from (&optional name address )
4944 "Make a From header." 5295 "Make a From header."
4945 (let* ((style message-from-style) 5296 (let* ((style message-from-style)
4946 (login (message-make-address)) 5297 (login (or address (message-make-address)))
4947 (fullname 5298 (fullname (or name
4948 (or (and (boundp 'user-full-name) 5299 (and (boundp 'user-full-name)
4949 user-full-name) 5300 user-full-name)
4950 (user-full-name)))) 5301 (user-full-name))))
4951 (when (string= fullname "&") 5302 (when (string= fullname "&")
4952 (setq fullname (user-login-name))) 5303 (setq fullname (user-login-name)))
4953 (with-temp-buffer 5304 (with-temp-buffer
@@ -4968,15 +5319,15 @@ If NOW, use that time instead."
4968 (string-match "[\\()]" tmp))))) 5319 (string-match "[\\()]" tmp)))))
4969 (insert fullname) 5320 (insert fullname)
4970 (goto-char (point-min)) 5321 (goto-char (point-min))
4971 ;; Look for a character that cannot appear unquoted 5322 ;; Look for a character that cannot appear unquoted
4972 ;; according to RFC 822. 5323 ;; according to RFC 822.
4973 (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) 5324 (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
4974 ;; Quote fullname, escaping specials. 5325 ;; Quote fullname, escaping specials.
4975 (goto-char (point-min)) 5326 (goto-char (point-min))
4976 (insert "\"") 5327 (insert "\"")
4977 (while (re-search-forward "[\"\\]" nil 1) 5328 (while (re-search-forward "[\"\\]" nil 1)
4978 (replace-match "\\\\\\&" t)) 5329 (replace-match "\\\\\\&" t))
4979 (insert "\"")) 5330 (insert "\""))
4980 (insert " <" login ">")) 5331 (insert " <" login ">"))
4981 (t ; 'parens or default 5332 (t ; 'parens or default
4982 (insert login " (") 5333 (insert login " (")
@@ -5279,19 +5630,21 @@ Headers already prepared in the buffer are not modified."
5279 (if formatter 5630 (if formatter
5280 (funcall formatter header value) 5631 (funcall formatter header value)
5281 (insert header-string ": " value)) 5632 (insert header-string ": " value))
5633 (goto-char (message-fill-field))
5282 ;; We check whether the value was ended by a 5634 ;; We check whether the value was ended by a
5283 ;; newline. If now, we insert one. 5635 ;; newline. If not, we insert one.
5284 (unless (bolp) 5636 (unless (bolp)
5285 (insert "\n")) 5637 (insert "\n"))
5286 (forward-line -1))) 5638 (forward-line -1)))
5287 ;; The value of this header was empty, so we clear 5639 ;; The value of this header was empty, so we clear
5288 ;; totally and insert the new value. 5640 ;; totally and insert the new value.
5289 (delete-region (point) (gnus-point-at-eol)) 5641 (delete-region (point) (point-at-eol))
5290 ;; If the header is optional, and the header was 5642 ;; If the header is optional, and the header was
5291 ;; empty, we con't insert it anyway. 5643 ;; empty, we can't insert it anyway.
5292 (unless optionalp 5644 (unless optionalp
5293 (push header-string message-inserted-headers) 5645 (push header-string message-inserted-headers)
5294 (insert value))) 5646 (insert value)
5647 (message-fill-field)))
5295 ;; Add the deletable property to the headers that require it. 5648 ;; Add the deletable property to the headers that require it.
5296 (and (memq header message-deletable-headers) 5649 (and (memq header message-deletable-headers)
5297 (progn (beginning-of-line) (looking-at "[^:]+: ")) 5650 (progn (beginning-of-line) (looking-at "[^:]+: "))
@@ -5347,35 +5700,29 @@ Headers already prepared in the buffer are not modified."
5347;;; Setting up a message buffer 5700;;; Setting up a message buffer
5348;;; 5701;;;
5349 5702
5703(defun message-skip-to-next-address ()
5704 (let ((end (save-excursion
5705 (message-next-header)
5706 (point)))
5707 quoted char)
5708 (when (looking-at ",")
5709 (forward-char 1))
5710 (while (and (not (= (point) end))
5711 (or (not (eq char ?,))
5712 quoted))
5713 (skip-chars-forward "^,\"" (point-max))
5714 (when (eq (setq char (following-char)) ?\")
5715 (setq quoted (not quoted)))
5716 (unless (= (point) end)
5717 (forward-char 1)))
5718 (skip-chars-forward " \t\n")))
5719
5350(defun message-fill-address (header value) 5720(defun message-fill-address (header value)
5351 (save-restriction 5721 (insert (capitalize (symbol-name header))
5352 (narrow-to-region (point) (point)) 5722 ": "
5353 (insert (capitalize (symbol-name header)) 5723 (if (consp value) (car value) value)
5354 ": " 5724 "\n")
5355 (if (consp value) (car value) value) 5725 (message-fill-field-address))
5356 "\n")
5357 (narrow-to-region (point-min) (1- (point-max)))
5358 (let (quoted last)
5359 (goto-char (point-min))
5360 (while (not (eobp))
5361 (skip-chars-forward "^,\"" (point-max))
5362 (if (or (eq (char-after) ?,)
5363 (eobp))
5364 (when (not quoted)
5365 (if (and (> (current-column) 78)
5366 last)
5367 (progn
5368 (save-excursion
5369 (goto-char last)
5370 (insert "\n\t"))
5371 (setq last (1+ (point))))
5372 (setq last (1+ (point)))))
5373 (setq quoted (not quoted)))
5374 (unless (eobp)
5375 (forward-char 1))))
5376 (goto-char (point-max))
5377 (widen)
5378 (forward-line 1)))
5379 5726
5380(defun message-split-line () 5727(defun message-split-line ()
5381 "Split current line, moving portion beyond point vertically down. 5728 "Split current line, moving portion beyond point vertically down.
@@ -5386,26 +5733,56 @@ If the current line has `message-yank-prefix', insert it on the new line."
5386 (error 5733 (error
5387 (split-line)))) 5734 (split-line))))
5388 5735
5389(defun message-fill-header (header value) 5736(defun message-insert-header (header value)
5737 (insert (capitalize (symbol-name header))
5738 ": "
5739 (if (consp value) (car value) value)))
5740
5741(defun message-field-name ()
5742 (save-excursion
5743 (goto-char (point-min))
5744 (when (looking-at "\\([^:]+\\):")
5745 (intern (capitalize (match-string 1))))))
5746
5747(defun message-fill-field ()
5748 (save-excursion
5749 (save-restriction
5750 (message-narrow-to-field)
5751 (let ((field-name (message-field-name)))
5752 (funcall (or (cadr (assq field-name message-field-fillers))
5753 'message-fill-field-general)))
5754 (point-max))))
5755
5756(defun message-fill-field-address ()
5757 (while (not (eobp))
5758 (message-skip-to-next-address)
5759 (let (last)
5760 (if (and (> (current-column) 78)
5761 last)
5762 (progn
5763 (save-excursion
5764 (goto-char last)
5765 (insert "\n\t"))
5766 (setq last (1+ (point))))
5767 (setq last (1+ (point)))))))
5768
5769(defun message-fill-field-general ()
5390 (let ((begin (point)) 5770 (let ((begin (point))
5391 (fill-column 78) 5771 (fill-column 78)
5392 (fill-prefix "\t")) 5772 (fill-prefix "\t"))
5393 (insert (capitalize (symbol-name header)) 5773 (while (and (search-forward "\n" nil t)
5394 ": " 5774 (not (eobp)))
5395 (if (consp value) (car value) value) 5775 (replace-match " " t t))
5396 "\n") 5776 (fill-region-as-paragraph begin (point-max))
5397 (save-restriction 5777 ;; Tapdance around looong Message-IDs.
5398 (narrow-to-region begin (point)) 5778 (forward-line -1)
5399 (fill-region-as-paragraph begin (point)) 5779 (when (looking-at "[ \t]*$")
5400 ;; Tapdance around looong Message-IDs. 5780 (message-delete-line))
5401 (forward-line -1) 5781 (goto-char begin)
5402 (when (looking-at "[ \t]*$") 5782 (search-forward ":" nil t)
5403 (message-delete-line)) 5783 (when (looking-at "\n[ \t]+")
5404 (goto-char begin) 5784 (replace-match " " t t))
5405 (re-search-forward ":" nil t) 5785 (goto-char (point-max))))
5406 (when (looking-at "\n[ \t]+")
5407 (replace-match " " t t))
5408 (goto-char (point-max)))))
5409 5786
5410(defun message-shorten-1 (list cut surplus) 5787(defun message-shorten-1 (list cut surplus)
5411 "Cut SURPLUS elements out of LIST, beginning with CUTth one." 5788 "Cut SURPLUS elements out of LIST, beginning with CUTth one."
@@ -5414,8 +5791,9 @@ If the current line has `message-yank-prefix', insert it on the new line."
5414 5791
5415(defun message-shorten-references (header references) 5792(defun message-shorten-references (header references)
5416 "Trim REFERENCES to be 21 Message-ID long or less, and fold them. 5793 "Trim REFERENCES to be 21 Message-ID long or less, and fold them.
5417If folding is disallowed, also check that the REFERENCES are less 5794When sending via news, also check that the REFERENCES are less
5418than 988 characters long, and if they are not, trim them until they are." 5795than 988 characters long, and if they are not, trim them until
5796they are."
5419 (let ((maxcount 21) 5797 (let ((maxcount 21)
5420 (count 0) 5798 (count 0)
5421 (cut 2) 5799 (cut 2)
@@ -5437,33 +5815,26 @@ than 988 characters long, and if they are not, trim them until they are."
5437 (message-shorten-1 refs cut surplus) 5815 (message-shorten-1 refs cut surplus)
5438 (decf count surplus))) 5816 (decf count surplus)))
5439 5817
5440 ;; If folding is disallowed, make sure the total length (including 5818 ;; When sending via news, make sure the total folded length will
5441 ;; the spaces between) will be less than MAXSIZE characters. 5819 ;; be less than 998 characters. This is to cater to broken INN
5820 ;; 2.3 which counts the total number of characters in a header
5821 ;; rather than the physical line length of each line, as it should.
5442 ;; 5822 ;;
5443 ;; Only disallow folding for News messages. At this point the headers 5823 ;; This hack should be removed when it's believed than INN 2.3 is
5444 ;; have not been generated, thus we use message-this-is-news directly. 5824 ;; no longer widely used.
5445 (when (and message-this-is-news message-cater-to-broken-inn) 5825 ;;
5446 (let ((maxsize 988) 5826 ;; At this point the headers have not been generated, thus we use
5447 (totalsize (+ (apply #'+ (mapcar #'length refs)) 5827 ;; message-this-is-news directly.
5448 (1- count))) 5828 (when message-this-is-news
5449 (surplus 0) 5829 (while (< 998
5450 (ptr (nthcdr (1- cut) refs))) 5830 (with-temp-buffer
5451 ;; Decide how many elements to cut off... 5831 (message-insert-header
5452 (while (> totalsize maxsize) 5832 header (mapconcat #'identity refs " "))
5453 (decf totalsize (1+ (length (car ptr)))) 5833 (buffer-size)))
5454 (incf surplus) 5834 (message-shorten-1 refs cut 1)))
5455 (setq ptr (cdr ptr)))
5456 ;; ...and do it.
5457 (when (> surplus 0)
5458 (message-shorten-1 refs cut surplus))))
5459
5460 ;; Finally, collect the references back into a string and insert 5835 ;; Finally, collect the references back into a string and insert
5461 ;; it into the buffer. 5836 ;; it into the buffer.
5462 (let ((refstring (mapconcat #'identity refs " "))) 5837 (message-insert-header header (mapconcat #'identity refs " "))))
5463 (if (and message-this-is-news message-cater-to-broken-inn)
5464 (insert (capitalize (symbol-name header)) ": "
5465 refstring "\n")
5466 (message-fill-header header refstring)))))
5467 5838
5468(defun message-position-point () 5839(defun message-position-point ()
5469 "Move point to where the user probably wants to find it." 5840 "Move point to where the user probably wants to find it."
@@ -5513,7 +5884,7 @@ between beginning of field and beginning of line."
5513 (message-point-in-header-p)) 5884 (message-point-in-header-p))
5514 (let* ((here (point)) 5885 (let* ((here (point))
5515 (bol (progn (beginning-of-line n) (point))) 5886 (bol (progn (beginning-of-line n) (point)))
5516 (eol (gnus-point-at-eol)) 5887 (eol (point-at-eol))
5517 (eoh (re-search-forward ": *" eol t))) 5888 (eoh (re-search-forward ": *" eol t)))
5518 (goto-char 5889 (goto-char
5519 (if (and eoh (or (< eoh here) (= bol here))) 5890 (if (and eoh (or (< eoh here) (= bol here)))
@@ -5726,12 +6097,7 @@ are not included."
5726 (when message-default-headers 6097 (when message-default-headers
5727 (insert message-default-headers) 6098 (insert message-default-headers)
5728 (or (bolp) (insert ?\n))) 6099 (or (bolp) (insert ?\n)))
5729 (put-text-property 6100 (insert mail-header-separator "\n")
5730 (point)
5731 (progn
5732 (insert mail-header-separator "\n")
5733 (1- (point)))
5734 'read-only nil)
5735 (forward-line -1) 6101 (forward-line -1)
5736 (when (message-news-p) 6102 (when (message-news-p)
5737 (when message-default-news-headers 6103 (when message-default-news-headers
@@ -5762,6 +6128,9 @@ are not included."
5762 (run-hooks 'message-header-setup-hook)) 6128 (run-hooks 'message-header-setup-hook))
5763 (set-buffer-modified-p nil) 6129 (set-buffer-modified-p nil)
5764 (setq buffer-undo-list nil) 6130 (setq buffer-undo-list nil)
6131 (when message-generate-hashcash
6132 ;; Generate hashcash headers for recipients already known
6133 (mail-add-payment-async))
5765 (run-hooks 'message-setup-hook) 6134 (run-hooks 'message-setup-hook)
5766 ;; Do this last to give it precedence over posting styles, etc. 6135 ;; Do this last to give it precedence over posting styles, etc.
5767 (when (message-mail-p) 6136 (when (message-mail-p)
@@ -5864,8 +6233,8 @@ is a function used to switch to and display the mail buffer."
5864 (Subject . ,(or subject "")))))) 6233 (Subject . ,(or subject ""))))))
5865 6234
5866(defun message-get-reply-headers (wide &optional to-address address-headers) 6235(defun message-get-reply-headers (wide &optional to-address address-headers)
5867 (let (follow-to mct never-mct to cc author mft recipients) 6236 (let (follow-to mct never-mct to cc author mft recipients extra)
5868 ;; Find all relevant headers we need. 6237 ;; Find all relevant headers we need.
5869 (save-restriction 6238 (save-restriction
5870 (message-narrow-to-headers-or-head) 6239 (message-narrow-to-headers-or-head)
5871 ;; Gmane renames "To". Look at "Original-To", too, if it is present in 6240 ;; Gmane renames "To". Look at "Original-To", too, if it is present in
@@ -5876,6 +6245,11 @@ is a function used to switch to and display the mail buffer."
5876 return t) 6245 return t)
5877 (message-fetch-field "original-to"))) 6246 (message-fetch-field "original-to")))
5878 cc (message-fetch-field "cc") 6247 cc (message-fetch-field "cc")
6248 extra (when message-extra-wide-headers
6249 (mapconcat 'identity
6250 (mapcar 'message-fetch-field
6251 message-extra-wide-headers)
6252 ", "))
5879 mct (message-fetch-field "mail-copies-to") 6253 mct (message-fetch-field "mail-copies-to")
5880 author (or (message-fetch-field "mail-reply-to") 6254 author (or (message-fetch-field "mail-reply-to")
5881 (message-fetch-field "reply-to") 6255 (message-fetch-field "reply-to")
@@ -5938,8 +6312,9 @@ want to get rid of this query permanently.")))
5938 (if mct (setq recipients (concat recipients ", " mct)))) 6312 (if mct (setq recipients (concat recipients ", " mct))))
5939 (t 6313 (t
5940 (setq recipients (if never-mct "" (concat ", " author))) 6314 (setq recipients (if never-mct "" (concat ", " author)))
5941 (if to (setq recipients (concat recipients ", " to))) 6315 (if to (setq recipients (concat recipients ", " to)))
5942 (if cc (setq recipients (concat recipients ", " cc))) 6316 (if cc (setq recipients (concat recipients ", " cc)))
6317 (if extra (setq recipients (concat recipients ", " extra)))
5943 (if mct (setq recipients (concat recipients ", " mct))))) 6318 (if mct (setq recipients (concat recipients ", " mct)))))
5944 (if (>= (length recipients) 2) 6319 (if (>= (length recipients) 2)
5945 ;; Strip the leading ", ". 6320 ;; Strip the leading ", ".
@@ -5948,7 +6323,7 @@ want to get rid of this query permanently.")))
5948 (while (string-match "[ \t][ \t]+" recipients) 6323 (while (string-match "[ \t][ \t]+" recipients)
5949 (setq recipients (replace-match " " t t recipients))) 6324 (setq recipients (replace-match " " t t recipients)))
5950 ;; Remove addresses that match `rmail-dont-reply-to-names'. 6325 ;; Remove addresses that match `rmail-dont-reply-to-names'.
5951 (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) 6326 (let ((rmail-dont-reply-to-names (message-dont-reply-to-names)))
5952 (setq recipients (rmail-dont-reply-to recipients))) 6327 (setq recipients (rmail-dont-reply-to recipients)))
5953 ;; Perhaps "Mail-Copies-To: never" removed the only address? 6328 ;; Perhaps "Mail-Copies-To: never" removed the only address?
5954 (if (string-equal recipients "") 6329 (if (string-equal recipients "")
@@ -6233,16 +6608,16 @@ regexp to match all of yours addresses."
6233 ;; Email address in From field equals to our address 6608 ;; Email address in From field equals to our address
6234 (and (setq from (message-fetch-field "from")) 6609 (and (setq from (message-fetch-field "from"))
6235 (string-equal 6610 (string-equal
6236 (downcase (cadr (mail-extract-address-components from))) 6611 (downcase (car (mail-header-parse-address from)))
6237 (downcase (cadr (mail-extract-address-components 6612 (downcase (car (mail-header-parse-address
6238 (message-make-from)))))) 6613 (message-make-from))))))
6239 ;; Email address in From field matches 6614 ;; Email address in From field matches
6240 ;; 'message-alternative-emails' regexp 6615 ;; 'message-alternative-emails' regexp
6241 (and from 6616 (and from
6242 message-alternative-emails 6617 message-alternative-emails
6243 (string-match 6618 (string-match
6244 message-alternative-emails 6619 message-alternative-emails
6245 (cadr (mail-extract-address-components from)))))))))) 6620 (car (mail-header-parse-address from))))))))))
6246 6621
6247;;;###autoload 6622;;;###autoload
6248(defun message-cancel-news (&optional arg) 6623(defun message-cancel-news (&optional arg)
@@ -6382,7 +6757,9 @@ news, Source is the list of newsgroups is was posted to."
6382 (prefix 6757 (prefix
6383 (if group 6758 (if group
6384 (gnus-group-decoded-name group) 6759 (gnus-group-decoded-name group)
6385 (or (and from (car (gnus-extract-address-components from))) 6760 (or (and from (or
6761 (car (gnus-extract-address-components from))
6762 (cadr (gnus-extract-address-components from))))
6386 "(nowhere)")))) 6763 "(nowhere)"))))
6387 (concat "[" 6764 (concat "["
6388 (if message-forward-decoded-p 6765 (if message-forward-decoded-p
@@ -6428,18 +6805,17 @@ the message."
6428 subject 6805 subject
6429 (mail-decode-encoded-word-string subject)) 6806 (mail-decode-encoded-word-string subject))
6430 "")) 6807 ""))
6431 (if message-wash-forwarded-subjects 6808 (when message-wash-forwarded-subjects
6432 (setq subject (message-wash-subject subject))) 6809 (setq subject (message-wash-subject subject)))
6433 ;; Make sure funcs is a list. 6810 ;; Make sure funcs is a list.
6434 (and funcs 6811 (and funcs
6435 (not (listp funcs)) 6812 (not (listp funcs))
6436 (setq funcs (list funcs))) 6813 (setq funcs (list funcs)))
6437 ;; Apply funcs in order, passing subject generated by previous 6814 ;; Apply funcs in order, passing subject generated by previous
6438 ;; func to the next one. 6815 ;; func to the next one.
6439 (while funcs 6816 (dolist (func funcs)
6440 (when (functionp (car funcs)) 6817 (when (functionp func)
6441 (setq subject (funcall (car funcs) subject))) 6818 (setq subject (funcall func subject))))
6442 (setq funcs (cdr funcs)))
6443 subject)))) 6819 subject))))
6444 6820
6445(eval-when-compile 6821(eval-when-compile
@@ -6482,17 +6858,24 @@ Optional DIGEST will use digest to forward."
6482 (setq e (point)) 6858 (setq e (point))
6483 (insert 6859 (insert
6484 "\n-------------------- End of forwarded message --------------------\n") 6860 "\n-------------------- End of forwarded message --------------------\n")
6485 (when message-forward-ignored-headers 6861 (message-remove-ignored-headers b e)))
6486 (save-restriction 6862
6487 (narrow-to-region b e) 6863(defun message-remove-ignored-headers (b e)
6488 (goto-char b) 6864 (when message-forward-ignored-headers
6489 (narrow-to-region (point) 6865 (save-restriction
6490 (or (search-forward "\n\n" nil t) (point))) 6866 (narrow-to-region b e)
6491 (message-remove-header message-forward-ignored-headers t))))) 6867 (goto-char b)
6868 (narrow-to-region (point)
6869 (or (search-forward "\n\n" nil t) (point)))
6870 (let ((ignored (if (stringp message-forward-ignored-headers)
6871 (list message-forward-ignored-headers)
6872 message-forward-ignored-headers)))
6873 (dolist (elem ignored)
6874 (message-remove-header elem t))))))
6492 6875
6493(defun message-forward-make-body-mime (forward-buffer) 6876(defun message-forward-make-body-mime (forward-buffer)
6494 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") 6877 (let ((b (point)))
6495 (let ((b (point)) e) 6878 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
6496 (save-restriction 6879 (save-restriction
6497 (narrow-to-region (point) (point)) 6880 (narrow-to-region (point) (point))
6498 (mml-insert-buffer forward-buffer) 6881 (mml-insert-buffer forward-buffer)
@@ -6500,8 +6883,11 @@ Optional DIGEST will use digest to forward."
6500 (when (looking-at "From ") 6883 (when (looking-at "From ")
6501 (replace-match "X-From-Line: ")) 6884 (replace-match "X-From-Line: "))
6502 (goto-char (point-max))) 6885 (goto-char (point-max)))
6503 (setq e (point)) 6886 (insert "<#/part>\n")
6504 (insert "<#/part>\n"))) 6887 ;; Consider there is no illegible text.
6888 (add-text-properties
6889 b (point)
6890 `(no-illegible-text t rear-nonsticky t start-open t))))
6505 6891
6506(defun message-forward-make-body-mml (forward-buffer) 6892(defun message-forward-make-body-mml (forward-buffer)
6507 (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") 6893 (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
@@ -6530,12 +6916,7 @@ Optional DIGEST will use digest to forward."
6530 (insert "<#/mml>\n") 6916 (insert "<#/mml>\n")
6531 (when (and (not message-forward-decoded-p) 6917 (when (and (not message-forward-decoded-p)
6532 message-forward-ignored-headers) 6918 message-forward-ignored-headers)
6533 (save-restriction 6919 (message-remove-ignored-headers b e))))
6534 (narrow-to-region b e)
6535 (goto-char b)
6536 (narrow-to-region (point)
6537 (or (search-forward "\n\n" nil t) (point)))
6538 (message-remove-header message-forward-ignored-headers t)))))
6539 6920
6540(defun message-forward-make-body-digest-plain (forward-buffer) 6921(defun message-forward-make-body-digest-plain (forward-buffer)
6541 (insert 6922 (insert
@@ -6564,6 +6945,62 @@ Optional DIGEST will use digest to forward."
6564 (message-forward-make-body-digest-mime forward-buffer) 6945 (message-forward-make-body-digest-mime forward-buffer)
6565 (message-forward-make-body-digest-plain forward-buffer))) 6946 (message-forward-make-body-digest-plain forward-buffer)))
6566 6947
6948(eval-and-compile
6949 (autoload 'mm-uu-dissect-text-parts "mm-uu")
6950 (autoload 'mm-uu-dissect "mm-uu"))
6951
6952(defun message-signed-or-encrypted-p (&optional dont-emulate-mime handles)
6953 "Say whether the current buffer contains signed or encrypted message.
6954If DONT-EMULATE-MIME is nil, this function does the MIME emulation on
6955messages that don't conform to PGP/MIME described in RFC2015. HANDLES
6956is for the internal use."
6957 (unless handles
6958 (let ((mm-decrypt-option 'never)
6959 (mm-verify-option 'never))
6960 (if (setq handles (mm-dissect-buffer nil t))
6961 (unless dont-emulate-mime
6962 (mm-uu-dissect-text-parts handles))
6963 (unless dont-emulate-mime
6964 (setq handles (mm-uu-dissect))))))
6965 ;; Check text/plain message in which there is a signed or encrypted
6966 ;; body that has been encoded by B or Q.
6967 (unless (or handles dont-emulate-mime)
6968 (let ((cur (current-buffer))
6969 (mm-decrypt-option 'never)
6970 (mm-verify-option 'never))
6971 (with-temp-buffer
6972 (insert-buffer-substring cur)
6973 (when (setq handles (mm-dissect-buffer t t))
6974 (if (and (prog1
6975 (bufferp (car handles))
6976 (mm-destroy-parts handles))
6977 (equal (mm-handle-media-type handles) "text/plain"))
6978 (progn
6979 (mm-decode-content-transfer-encoding
6980 (mm-handle-encoding handles))
6981 (setq handles (mm-uu-dissect)))
6982 (setq handles nil))))))
6983 (when handles
6984 (prog1
6985 (catch 'found
6986 (dolist (handle (if (stringp (car handles))
6987 (if (member (car handles)
6988 '("multipart/signed"
6989 "multipart/encrypted"))
6990 (throw 'found t)
6991 (cdr handles))
6992 (list handles)))
6993 (if (stringp (car handle))
6994 (when (message-signed-or-encrypted-p dont-emulate-mime handle)
6995 (throw 'found t))
6996 (when (and (bufferp (car handle))
6997 (equal (mm-handle-media-type handle)
6998 "message/rfc822"))
6999 (with-current-buffer (mm-handle-buffer handle)
7000 (when (message-signed-or-encrypted-p dont-emulate-mime)
7001 (throw 'found t)))))))
7002 (mm-destroy-parts handles))))
7003
6567;;;###autoload 7004;;;###autoload
6568(defun message-forward-make-body (forward-buffer &optional digest) 7005(defun message-forward-make-body (forward-buffer &optional digest)
6569 ;; Put point where we want it before inserting the forwarded 7006 ;; Put point where we want it before inserting the forwarded
@@ -6576,11 +7013,13 @@ Optional DIGEST will use digest to forward."
6576 (if message-forward-as-mime 7013 (if message-forward-as-mime
6577 (if (and message-forward-show-mml 7014 (if (and message-forward-show-mml
6578 (not (and (eq message-forward-show-mml 'best) 7015 (not (and (eq message-forward-show-mml 'best)
7016 ;; Use the raw form in the body if it contains
7017 ;; signed or encrypted message so as not to be
7018 ;; destroyed by re-encoding.
6579 (with-current-buffer forward-buffer 7019 (with-current-buffer forward-buffer
6580 (goto-char (point-min)) 7020 (condition-case nil
6581 (re-search-forward 7021 (message-signed-or-encrypted-p)
6582 "Content-Type: *multipart/\\(signed\\|encrypted\\)" 7022 (error t))))))
6583 nil t)))))
6584 (message-forward-make-body-mml forward-buffer) 7023 (message-forward-make-body-mml forward-buffer)
6585 (message-forward-make-body-mime forward-buffer)) 7024 (message-forward-make-body-mime forward-buffer))
6586 (message-forward-make-body-plain forward-buffer))) 7025 (message-forward-make-body-plain forward-buffer)))
@@ -6590,8 +7029,6 @@ Optional DIGEST will use digest to forward."
6590(defun message-forward-rmail-make-body (forward-buffer) 7029(defun message-forward-rmail-make-body (forward-buffer)
6591 (save-window-excursion 7030 (save-window-excursion
6592 (set-buffer forward-buffer) 7031 (set-buffer forward-buffer)
6593 ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
6594 ;; 20. FIXIT, or we drop support for rmail in Emacs 20.
6595 (if (rmail-msg-is-pruned) 7032 (if (rmail-msg-is-pruned)
6596 (rmail-msg-restore-non-pruned-header))) 7033 (rmail-msg-restore-non-pruned-header)))
6597 (message-forward-make-body forward-buffer)) 7034 (message-forward-make-body forward-buffer))
@@ -6621,6 +7058,7 @@ Optional DIGEST will use digest to forward."
6621 (set-buffer (get-buffer-create " *message resend*")) 7058 (set-buffer (get-buffer-create " *message resend*"))
6622 (erase-buffer)) 7059 (erase-buffer))
6623 (let ((message-this-is-mail t) 7060 (let ((message-this-is-mail t)
7061 message-generate-hashcash
6624 message-setup-hook) 7062 message-setup-hook)
6625 (message-setup `((To . ,address)))) 7063 (message-setup `((To . ,address))))
6626 ;; Insert our usual headers. 7064 ;; Insert our usual headers.
@@ -6658,6 +7096,7 @@ Optional DIGEST will use digest to forward."
6658 ;; Send it. 7096 ;; Send it.
6659 (let ((message-inhibit-body-encoding t) 7097 (let ((message-inhibit-body-encoding t)
6660 message-required-mail-headers 7098 message-required-mail-headers
7099 message-generate-hashcash
6661 rfc2047-encode-encoded-words) 7100 rfc2047-encode-encoded-words)
6662 (message-send-mail)) 7101 (message-send-mail))
6663 (kill-buffer (current-buffer))) 7102 (kill-buffer (current-buffer)))
@@ -6772,7 +7211,7 @@ you."
6772;; This code should be moved to underline.el (from which it is stolen). 7211;; This code should be moved to underline.el (from which it is stolen).
6773 7212
6774;;;###autoload 7213;;;###autoload
6775(defun bold-region (start end) 7214(defun message-bold-region (start end)
6776 "Bold all nonblank characters in the region. 7215 "Bold all nonblank characters in the region.
6777Works by overstriking characters. 7216Works by overstriking characters.
6778Called from program, takes two arguments START and END 7217Called from program, takes two arguments START and END
@@ -6788,7 +7227,7 @@ which specify the range to operate on."
6788 (forward-char 1))))) 7227 (forward-char 1)))))
6789 7228
6790;;;###autoload 7229;;;###autoload
6791(defun unbold-region (start end) 7230(defun message-unbold-region (start end)
6792 "Remove all boldness (overstruck characters) in the region. 7231 "Remove all boldness (overstruck characters) in the region.
6793Called from program, takes two arguments START and END 7232Called from program, takes two arguments START and END
6794which specify the range to operate on." 7233which specify the range to operate on."
@@ -6797,7 +7236,7 @@ which specify the range to operate on."
6797 (let ((end1 (make-marker))) 7236 (let ((end1 (make-marker)))
6798 (move-marker end1 (max start end)) 7237 (move-marker end1 (max start end))
6799 (goto-char (min start end)) 7238 (goto-char (min start end))
6800 (while (re-search-forward "\b" end1 t) 7239 (while (search-forward "\b" end1 t)
6801 (if (eq (char-after) (char-after (- (point) 2))) 7240 (if (eq (char-after) (char-after (- (point) 2)))
6802 (delete-char -2)))))) 7241 (delete-char -2))))))
6803 7242
@@ -6847,7 +7286,7 @@ Pre-defined symbols include `message-tool-bar-gnome' and
6847 (const :tag "Retro look" message-tool-bar-retro) 7286 (const :tag "Retro look" message-tool-bar-retro)
6848 (repeat :tag "User defined list" gmm-tool-bar-item) 7287 (repeat :tag "User defined list" gmm-tool-bar-item)
6849 (symbol)) 7288 (symbol))
6850 :version "22.1" ;; Gnus 5.10.9 7289 :version "23.0" ;; No Gnus
6851 :initialize 'custom-initialize-default 7290 :initialize 'custom-initialize-default
6852 :set 'message-tool-bar-update 7291 :set 'message-tool-bar-update
6853 :group 'message) 7292 :group 'message)
@@ -6866,7 +7305,7 @@ Pre-defined symbols include `message-tool-bar-gnome' and
6866 (message-kill-buffer "close") ;; stock_cancel 7305 (message-kill-buffer "close") ;; stock_cancel
6867 (mml-attach-file "attach" mml-mode-map) 7306 (mml-attach-file "attach" mml-mode-map)
6868 (mml-preview "mail/preview" mml-mode-map) 7307 (mml-preview "mail/preview" mml-mode-map)
6869 ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) 7308 (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
6870 (message-insert-importance-high "important" nil :visible nil) 7309 (message-insert-importance-high "important" nil :visible nil)
6871 (message-insert-importance-low "unimportant" nil :visible nil) 7310 (message-insert-importance-low "unimportant" nil :visible nil)
6872 (message-insert-disposition-notification-to "receipt" nil :visible nil) 7311 (message-insert-disposition-notification-to "receipt" nil :visible nil)
@@ -6876,7 +7315,7 @@ Pre-defined symbols include `message-tool-bar-gnome' and
6876 7315
6877See `gmm-tool-bar-from-list' for details on the format of the list." 7316See `gmm-tool-bar-from-list' for details on the format of the list."
6878 :type '(repeat gmm-tool-bar-item) 7317 :type '(repeat gmm-tool-bar-item)
6879 :version "22.1" ;; Gnus 5.10.9 7318 :version "23.0" ;; No Gnus
6880 :initialize 'custom-initialize-default 7319 :initialize 'custom-initialize-default
6881 :set 'message-tool-bar-update 7320 :set 'message-tool-bar-update
6882 :group 'message) 7321 :group 'message)
@@ -6896,7 +7335,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list."
6896 7335
6897See `gmm-tool-bar-from-list' for details on the format of the list." 7336See `gmm-tool-bar-from-list' for details on the format of the list."
6898 :type '(repeat gmm-tool-bar-item) 7337 :type '(repeat gmm-tool-bar-item)
6899 :version "22.1" ;; Gnus 5.10.9 7338 :version "23.0" ;; No Gnus
6900 :initialize 'custom-initialize-default 7339 :initialize 'custom-initialize-default
6901 :set 'message-tool-bar-update 7340 :set 'message-tool-bar-update
6902 :group 'message) 7341 :group 'message)
@@ -6909,7 +7348,7 @@ These items are not displayed on the message mode tool bar.
6909 7348
6910See `gmm-tool-bar-from-list' for the format of the list." 7349See `gmm-tool-bar-from-list' for the format of the list."
6911 :type 'gmm-tool-bar-zap-list 7350 :type 'gmm-tool-bar-zap-list
6912 :version "22.1" ;; Gnus 5.10.9 7351 :version "23.0" ;; No Gnus
6913 :initialize 'custom-initialize-default 7352 :initialize 'custom-initialize-default
6914 :set 'message-tool-bar-update 7353 :set 'message-tool-bar-update
6915 :group 'message) 7354 :group 'message)
@@ -6956,6 +7395,13 @@ When FORCE, rebuild the tool bar."
6956 :group 'message 7395 :group 'message
6957 :type '(alist :key-type regexp :value-type function)) 7396 :type '(alist :key-type regexp :value-type function))
6958 7397
7398(defcustom message-expand-name-databases
7399 (list 'bbdb 'eudc)
7400 "List of databases to try for name completion (`message-expand-name').
7401Each element is a symbol and can be `bbdb' or `eudc'."
7402 :group 'message
7403 :type '(set (const bbdb) (const eudc)))
7404
6959(defcustom message-tab-body-function nil 7405(defcustom message-tab-body-function nil
6960 "*Function to execute when `message-tab' (TAB) is executed in the body. 7406 "*Function to execute when `message-tab' (TAB) is executed in the body.
6961If nil, the function bound in `text-mode-map' or `global-map' is executed." 7407If nil, the function bound in `text-mode-map' or `global-map' is executed."
@@ -7036,9 +7482,15 @@ those headers."
7036 (delete-region (point) (progn (forward-line 3) (point)))))))))) 7482 (delete-region (point) (progn (forward-line 3) (point))))))))))
7037 7483
7038(defun message-expand-name () 7484(defun message-expand-name ()
7039 (if (fboundp 'bbdb-complete-name) 7485 (cond ((and (memq 'eudc message-expand-name-databases)
7040 (bbdb-complete-name) 7486 (boundp 'eudc-protocol)
7041 (expand-abbrev))) 7487 eudc-protocol)
7488 (eudc-expand-inline))
7489 ((and (memq 'bbdb message-expand-name-databases)
7490 (fboundp 'bbdb-complete-name))
7491 (bbdb-complete-name))
7492 (t
7493 (expand-abbrev))))
7042 7494
7043;;; Help stuff. 7495;;; Help stuff.
7044 7496
@@ -7053,7 +7505,7 @@ The following arguments may contain lists of values."
7053 (with-output-to-temp-buffer " *MESSAGE information message*" 7505 (with-output-to-temp-buffer " *MESSAGE information message*"
7054 (set-buffer " *MESSAGE information message*") 7506 (set-buffer " *MESSAGE information message*")
7055 (fundamental-mode) ; for Emacs 20.4+ 7507 (fundamental-mode) ; for Emacs 20.4+
7056 (mapcar 'princ text) 7508 (mapc 'princ text)
7057 (goto-char (point-min)))) 7509 (goto-char (point-min))))
7058 (funcall ask question)) 7510 (funcall ask question))
7059 (funcall ask question))) 7511 (funcall ask question)))
@@ -7164,7 +7616,7 @@ regexp VARSTR."
7164address in `message-alternative-emails', looking at To, Cc and 7616address in `message-alternative-emails', looking at To, Cc and
7165From headers in the original article." 7617From headers in the original article."
7166 (require 'mail-utils) 7618 (require 'mail-utils)
7167 (let* ((fields '("To" "Cc")) 7619 (let* ((fields '("To" "Cc" "From"))
7168 (emails 7620 (emails
7169 (split-string 7621 (split-string
7170 (mail-strip-quoted-names 7622 (mail-strip-quoted-names
@@ -7179,7 +7631,8 @@ From headers in the original article."
7179 (unless (or (not email) (equal email user-mail-address)) 7631 (unless (or (not email) (equal email user-mail-address))
7180 (message-remove-header "From") 7632 (message-remove-header "From")
7181 (goto-char (point-max)) 7633 (goto-char (point-max))
7182 (insert "From: " email "\n")))) 7634 (insert "From: " (let ((user-mail-address email)) (message-make-from))
7635 "\n"))))
7183 7636
7184(defun message-options-get (symbol) 7637(defun message-options-get (symbol)
7185 (cdr (assq symbol message-options))) 7638 (cdr (assq symbol message-options)))
@@ -7218,7 +7671,8 @@ From headers in the original article."
7218 (list message-hidden-headers) 7671 (list message-hidden-headers)
7219 message-hidden-headers)) 7672 message-hidden-headers))
7220 (inhibit-point-motion-hooks t) 7673 (inhibit-point-motion-hooks t)
7221 (after-change-functions nil)) 7674 (after-change-functions nil)
7675 (end-of-headers 0))
7222 (when regexps 7676 (when regexps
7223 (save-excursion 7677 (save-excursion
7224 (save-restriction 7678 (save-restriction
@@ -7227,11 +7681,17 @@ From headers in the original article."
7227 (while (not (eobp)) 7681 (while (not (eobp))
7228 (if (not (message-hide-header-p regexps)) 7682 (if (not (message-hide-header-p regexps))
7229 (message-next-header) 7683 (message-next-header)
7230 (let ((begin (point))) 7684 (let ((begin (point))
7685 header header-len)
7231 (message-next-header) 7686 (message-next-header)
7232 (add-text-properties 7687 (setq header (buffer-substring begin (point))
7233 begin (point) 7688 header-len (- (point) begin))
7234 '(invisible t message-hidden t)))))))))) 7689 (delete-region begin (point))
7690 (goto-char (1+ end-of-headers))
7691 (insert header)
7692 (setq end-of-headers
7693 (+ end-of-headers header-len))))))))
7694 (narrow-to-region (1+ end-of-headers) (point-max))))
7235 7695
7236(defun message-hide-header-p (regexps) 7696(defun message-hide-header-p (regexps)
7237 (let ((result nil) 7697 (let ((result nil)
@@ -7245,6 +7705,39 @@ From headers in the original article."
7245 (not result) 7705 (not result)
7246 result))) 7706 result)))
7247 7707
7708(defun message-put-addresses-in-ecomplete ()
7709 (dolist (header '("to" "cc" "from" "reply-to"))
7710 (let ((value (message-field-value header)))
7711 (dolist (string (mail-header-parse-addresses value 'raw))
7712 (setq string
7713 (gnus-replace-in-string
7714 (gnus-replace-in-string string "^ +\\| +$" "") "\n" ""))
7715 (ecomplete-add-item 'mail (car (mail-header-parse-address string))
7716 string))))
7717 (ecomplete-save))
7718
7719(defun message-display-abbrev (&optional choose)
7720 "Display the next possible abbrev for the text before point."
7721 (interactive (list t))
7722 (when (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? ))
7723 (message-point-in-header-p)
7724 (save-excursion
7725 (beginning-of-line)
7726 (while (and (memq (char-after) '(?\t ? ))
7727 (zerop (forward-line -1))))
7728 (looking-at "To:\\|Cc:")))
7729 (let* ((end (point))
7730 (start (save-excursion
7731 (and (re-search-backward "[\n\t ]" nil t)
7732 (1+ (point)))))
7733 (word (when start (buffer-substring start end)))
7734 (match (when (and word
7735 (not (zerop (length word))))
7736 (ecomplete-display-matches 'mail word choose))))
7737 (when (and choose match)
7738 (delete-region start end)
7739 (insert match)))))
7740
7248(when (featurep 'xemacs) 7741(when (featurep 'xemacs)
7249 (require 'messagexmas) 7742 (require 'messagexmas)
7250 (message-xmas-redefine)) 7743 (message-xmas-redefine))
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 0872008e48d..80e910ffab6 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -26,10 +26,6 @@
26 26
27;;; Code: 27;;; Code:
28 28
29(eval-and-compile
30 (or (fboundp 'base64-decode-region)
31 (require 'base64)))
32
33(eval-when-compile 29(eval-when-compile
34 (defvar mm-uu-decode-function) 30 (defvar mm-uu-decode-function)
35 (defvar mm-uu-binhex-decode-function)) 31 (defvar mm-uu-binhex-decode-function))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index f8de1a77f71..14e5c255d2a 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -33,7 +33,6 @@
33 (require 'term)) 33 (require 'term))
34 34
35(eval-and-compile 35(eval-and-compile
36 (autoload 'executable-find "executable")
37 (autoload 'mm-inline-partial "mm-partial") 36 (autoload 'mm-inline-partial "mm-partial")
38 (autoload 'mm-inline-external-body "mm-extern") 37 (autoload 'mm-inline-external-body "mm-extern")
39 (autoload 'mm-extern-cache-contents "mm-extern") 38 (autoload 'mm-extern-cache-contents "mm-extern")
@@ -231,6 +230,7 @@ before the external MIME handler is invoked."
231 (fboundp 'diff-mode))) 230 (fboundp 'diff-mode)))
232 ("application/emacs-lisp" mm-display-elisp-inline identity) 231 ("application/emacs-lisp" mm-display-elisp-inline identity)
233 ("application/x-emacs-lisp" mm-display-elisp-inline identity) 232 ("application/x-emacs-lisp" mm-display-elisp-inline identity)
233 ("text/dns" mm-display-dns-inline identity)
234 ("text/html" 234 ("text/html"
235 mm-inline-text-html 235 mm-inline-text-html
236 (lambda (handle) 236 (lambda (handle)
@@ -299,9 +299,9 @@ when selecting a different article."
299 :group 'mime-display) 299 :group 'mime-display)
300 300
301(defcustom mm-automatic-display 301(defcustom mm-automatic-display
302 '("text/plain" "text/enriched" "text/richtext" "text/html" 302 '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim"
303 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" 303 "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
304 "message/rfc822" "text/x-patch" "application/pgp-signature" 304 "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
305 "application/emacs-lisp" "application/x-emacs-lisp" 305 "application/emacs-lisp" "application/x-emacs-lisp"
306 "application/x-pkcs7-signature" 306 "application/x-pkcs7-signature"
307 "application/pkcs7-signature" "application/x-pkcs7-mime" 307 "application/pkcs7-signature" "application/x-pkcs7-mime"
@@ -364,20 +364,34 @@ enables you to choose manually one of two types those mails include."
364 :type 'boolean 364 :type 'boolean
365 :group 'mime-display) 365 :group 'mime-display)
366 366
367(defvar mm-file-name-rewrite-functions 367(defcustom mm-file-name-rewrite-functions
368 '(mm-file-name-delete-control mm-file-name-delete-gotchas) 368 '(mm-file-name-delete-control mm-file-name-delete-gotchas)
369 "*List of functions used for rewriting file names of MIME parts. 369 "List of functions used for rewriting file names of MIME parts.
370Each function takes a file name as input and returns a file name. 370Each function takes a file name as input and returns a file name.
371 371
372Ready-made functions include 372Ready-made functions include `mm-file-name-delete-control',
373`mm-file-name-delete-control' 373`mm-file-name-delete-gotchas' (you should not remove these two
374`mm-file-name-delete-gotchas' 374functions), `mm-file-name-delete-whitespace',
375`mm-file-name-delete-whitespace', 375`mm-file-name-trim-whitespace', `mm-file-name-collapse-whitespace',
376`mm-file-name-trim-whitespace', 376`mm-file-name-replace-whitespace', `capitalize', `downcase',
377`mm-file-name-collapse-whitespace', 377`upcase', and `upcase-initials'."
378`mm-file-name-replace-whitespace', 378 :type '(list (set :inline t
379`capitalize', `downcase', `upcase', and 379 (const mm-file-name-delete-control)
380`upcase-initials'.") 380 (const mm-file-name-delete-gotchas)
381 (const mm-file-name-delete-whitespace)
382 (const mm-file-name-trim-whitespace)
383 (const mm-file-name-collapse-whitespace)
384 (const mm-file-name-replace-whitespace)
385 (const capitalize)
386 (const downcase)
387 (const upcase)
388 (const upcase-initials)
389 (repeat :inline t
390 :tag "Function"
391 function)))
392 :version "23.0" ;; No Gnus
393 :group 'mime-display)
394
381 395
382(defvar mm-path-name-rewrite-functions nil 396(defvar mm-path-name-rewrite-functions nil
383 "*List of functions for rewriting the full file names of MIME parts. 397 "*List of functions for rewriting the full file names of MIME parts.
@@ -436,7 +450,11 @@ If not set, `default-directory' will be used."
436(defcustom mm-verify-option 'never 450(defcustom mm-verify-option 'never
437 "Option of verifying signed parts. 451 "Option of verifying signed parts.
438`never', not verify; `always', always verify; 452`never', not verify; `always', always verify;
439`known', only verify known protocols. Otherwise, ask user." 453`known', only verify known protocols. Otherwise, ask user.
454
455When set to `always' or `known', you should add
456\"multipart/signed\" to `gnus-buttonized-mime-types' to see
457result of the verification."
440 :version "22.1" 458 :version "22.1"
441 :type '(choice (item always) 459 :type '(choice (item always)
442 (item never) 460 (item never)
@@ -548,15 +566,11 @@ Postpone undisplaying of viewers for types in
548 ;; solution, avoids most of them. 566 ;; solution, avoids most of them.
549 (if from 567 (if from
550 (setq from (cadr (mail-extract-address-components from)))))) 568 (setq from (cadr (mail-extract-address-components from))))))
551 (when cte
552 (setq cte (mail-header-strip cte)))
553 (if (or (not ctl) 569 (if (or (not ctl)
554 (not (string-match "/" (car ctl)))) 570 (not (string-match "/" (car ctl))))
555 (mm-dissect-singlepart 571 (mm-dissect-singlepart
556 (list mm-dissect-default-type) 572 (list mm-dissect-default-type)
557 (and cte (intern (downcase (mail-header-remove-whitespace 573 (and cte (intern (downcase (mail-header-strip cte))))
558 (mail-header-remove-comments
559 cte)))))
560 no-strict-mime 574 no-strict-mime
561 (and cd (mail-header-parse-content-disposition cd)) 575 (and cd (mail-header-parse-content-disposition cd))
562 description) 576 description)
@@ -589,9 +603,7 @@ Postpone undisplaying of viewers for types in
589 (mm-possibly-verify-or-decrypt 603 (mm-possibly-verify-or-decrypt
590 (mm-dissect-singlepart 604 (mm-dissect-singlepart
591 ctl 605 ctl
592 (and cte (intern (downcase (mail-header-remove-whitespace 606 (and cte (intern (downcase (mail-header-strip cte))))
593 (mail-header-remove-comments
594 cte)))))
595 no-strict-mime 607 no-strict-mime
596 (and cd (mail-header-parse-content-disposition cd)) 608 (and cd (mail-header-parse-content-disposition cd))
597 description id) 609 description id)
@@ -922,16 +934,16 @@ external if displayed external."
922 (string= total "'%s'") 934 (string= total "'%s'")
923 (string= total "\"%s\"")) 935 (string= total "\"%s\""))
924 (setq uses-stdin nil) 936 (setq uses-stdin nil)
925 (push (mm-quote-arg 937 (push (shell-quote-argument
926 (gnus-map-function mm-path-name-rewrite-functions file)) out)) 938 (gnus-map-function mm-path-name-rewrite-functions file)) out))
927 ((string= total "%t") 939 ((string= total "%t")
928 (push (mm-quote-arg (car type-list)) out)) 940 (push (shell-quote-argument (car type-list)) out))
929 (t 941 (t
930 (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out)))) 942 (push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out))))
931 (push (substring method beg (length method)) out) 943 (push (substring method beg (length method)) out)
932 (when uses-stdin 944 (when uses-stdin
933 (push "<" out) 945 (push "<" out)
934 (push (mm-quote-arg 946 (push (shell-quote-argument
935 (gnus-map-function mm-path-name-rewrite-functions file)) 947 (gnus-map-function mm-path-name-rewrite-functions file))
936 out)) 948 out))
937 (mapconcat 'identity (nreverse out) ""))) 949 (mapconcat 'identity (nreverse out) "")))
@@ -1136,16 +1148,26 @@ are ignored."
1136 "Insert the contents of HANDLE in the current buffer. 1148 "Insert the contents of HANDLE in the current buffer.
1137If NO-CACHE is non-nil, cached contents of a message/external-body part 1149If NO-CACHE is non-nil, cached contents of a message/external-body part
1138are ignored." 1150are ignored."
1139 (save-excursion 1151 (let ((text (cond ((eq (mail-content-type-get (mm-handle-type handle)
1140 (insert 1152 'charset)
1141 (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset) 1153 'gnus-decoded)
1142 'gnus-decoded) 1154 (with-current-buffer (mm-handle-buffer handle)
1143 (with-current-buffer (mm-handle-buffer handle) 1155 (buffer-string)))
1144 (buffer-string))) 1156 ((mm-multibyte-p)
1145 ((mm-multibyte-p) 1157 (mm-string-to-multibyte (mm-get-part handle no-cache)))
1146 (mm-string-to-multibyte (mm-get-part handle no-cache))) 1158 (t
1147 (t 1159 (mm-get-part handle no-cache)))))
1148 (mm-get-part handle no-cache)))))) 1160 (save-restriction
1161 (widen)
1162 (goto-char
1163 (prog1
1164 (point)
1165 (if (and (eq (get-char-property (max (point-min) (1- (point))) 'face)
1166 'mm-uu-extract)
1167 (eq (get-char-property 0 'face text) 'mm-uu-extract))
1168 ;; Separate the extracted parts that have the same faces.
1169 (insert "\n" text)
1170 (insert text)))))))
1149 1171
1150(defun mm-file-name-delete-whitespace (file-name) 1172(defun mm-file-name-delete-whitespace (file-name)
1151 "Remove all whitespace characters from FILE-NAME." 1173 "Remove all whitespace characters from FILE-NAME."
@@ -1185,8 +1207,9 @@ string if you do not like underscores."
1185 (setq filename (gnus-replace-in-string filename "[<>|]" "")) 1207 (setq filename (gnus-replace-in-string filename "[<>|]" ""))
1186 (gnus-replace-in-string filename "^[.-]+" "")) 1208 (gnus-replace-in-string filename "^[.-]+" ""))
1187 1209
1188(defun mm-save-part (handle) 1210(defun mm-save-part (handle &optional prompt)
1189 "Write HANDLE to a file." 1211 "Write HANDLE to a file.
1212PROMPT overrides the default one used to ask user for a file name."
1190 (let ((filename (or (mail-content-type-get 1213 (let ((filename (or (mail-content-type-get
1191 (mm-handle-disposition handle) 'filename) 1214 (mm-handle-disposition handle) 'filename)
1192 (mail-content-type-get 1215 (mail-content-type-get
@@ -1197,7 +1220,7 @@ string if you do not like underscores."
1197 (file-name-nondirectory filename)))) 1220 (file-name-nondirectory filename))))
1198 (setq file 1221 (setq file
1199 (mm-with-multibyte 1222 (mm-with-multibyte
1200 (read-file-name "Save MIME part to: " 1223 (read-file-name (or prompt "Save MIME part to: ")
1201 (or mm-default-directory default-directory) 1224 (or mm-default-directory default-directory)
1202 nil nil (or filename "")))) 1225 nil nil (or filename ""))))
1203 (setq mm-default-directory (file-name-directory file)) 1226 (setq mm-default-directory (file-name-directory file))
@@ -1211,17 +1234,13 @@ string if you do not like underscores."
1211(defun mm-save-part-to-file (handle file) 1234(defun mm-save-part-to-file (handle file)
1212 (mm-with-unibyte-buffer 1235 (mm-with-unibyte-buffer
1213 (mm-insert-part handle) 1236 (mm-insert-part handle)
1214 (let ((coding-system-for-write 'binary) 1237 (let ((current-file-modes (default-file-modes)))
1215 (current-file-modes (default-file-modes)) 1238 (set-default-file-modes mm-attachment-file-modes)
1239 (unwind-protect
1216 ;; Don't re-compress .gz & al. Arguably we should make 1240 ;; Don't re-compress .gz & al. Arguably we should make
1217 ;; `file-name-handler-alist' nil, but that would chop 1241 ;; `file-name-handler-alist' nil, but that would chop
1218 ;; ange-ftp, which is reasonable to use here. 1242 ;; ange-ftp, which is reasonable to use here.
1219 (inhibit-file-name-operation 'write-region) 1243 (mm-write-region (point-min) (point-max) file nil nil nil 'binary t)
1220 (inhibit-file-name-handlers
1221 (cons 'jka-compr-handler inhibit-file-name-handlers)))
1222 (set-default-file-modes mm-attachment-file-modes)
1223 (unwind-protect
1224 (write-region (point-min) (point-max) file)
1225 (set-default-file-modes current-file-modes))))) 1244 (set-default-file-modes current-file-modes)))))
1226 1245
1227(defun mm-pipe-part (handle) 1246(defun mm-pipe-part (handle)
@@ -1517,7 +1536,7 @@ If RECURSIVE, search recursively."
1517 (format "protocol=%s" protocol)))))) 1536 (format "protocol=%s" protocol))))))
1518 (save-excursion 1537 (save-excursion
1519 (if func 1538 (if func
1520 (funcall func parts ctl) 1539 (setq parts (funcall func parts ctl))
1521 (mm-set-handle-multipart-parameter 1540 (mm-set-handle-multipart-parameter
1522 mm-security-handle 'gnus-details 1541 mm-security-handle 'gnus-details
1523 (format "Unknown sign protocol (%s)" protocol)))))) 1542 (format "Unknown sign protocol (%s)" protocol))))))
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 1fa3e6967e7..f59ca10d783 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -34,8 +34,7 @@
34(require 'mm-decode) 34(require 'mm-decode)
35 35
36(defun mm-partial-find-parts (id &optional art) 36(defun mm-partial-find-parts (id &optional art)
37 (let ((headers (save-excursion 37 (let ((headers (with-current-buffer gnus-summary-buffer
38 (set-buffer gnus-summary-buffer)
39 gnus-newsgroup-headers)) 38 gnus-newsgroup-headers))
40 phandles header) 39 phandles header)
41 (while (setq header (pop headers)) 40 (while (setq header (pop headers))
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index dedc03a2edf..a143089750c 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -35,14 +35,6 @@
35(require 'mm-util) 35(require 'mm-util)
36(require 'gnus) 36(require 'gnus)
37 37
38(eval-and-compile
39 (autoload 'executable-find "executable"))
40
41(eval-when-compile
42 (if (featurep 'xemacs)
43 (require 'timer-funcs)
44 (require 'timer)))
45
46(defvar url-current-object) 38(defvar url-current-object)
47(defvar url-package-name) 39(defvar url-package-name)
48(defvar url-package-version) 40(defvar url-package-version)
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 04a600abf25..7187aaba253 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -30,7 +30,14 @@
30(require 'mail-prsvr) 30(require 'mail-prsvr)
31 31
32(eval-and-compile 32(eval-and-compile
33 (mapcar 33 (if (featurep 'xemacs)
34 (unless (ignore-errors
35 (require 'timer-funcs))
36 (require 'timer))
37 (require 'timer)))
38
39(eval-and-compile
40 (mapc
34 (lambda (elem) 41 (lambda (elem)
35 (let ((nfunc (intern (format "mm-%s" (car elem))))) 42 (let ((nfunc (intern (format "mm-%s" (car elem)))))
36 (if (fboundp (car elem)) 43 (if (fboundp (car elem))
@@ -41,9 +48,6 @@
41 (coding-system-equal . equal) 48 (coding-system-equal . equal)
42 (annotationp . ignore) 49 (annotationp . ignore)
43 (set-buffer-file-coding-system . ignore) 50 (set-buffer-file-coding-system . ignore)
44 (make-char
45 . (lambda (charset int)
46 (int-to-char int)))
47 (read-charset 51 (read-charset
48 . (lambda (prompt) 52 . (lambda (prompt)
49 "Return a charset." 53 "Return a charset."
@@ -67,6 +71,10 @@
67 (aset string idx to)) 71 (aset string idx to))
68 (setq idx (1+ idx))) 72 (setq idx (1+ idx)))
69 string))) 73 string)))
74 (replace-in-string
75 . (lambda (string regexp rep &optional literal)
76 "See `replace-regexp-in-string', only the order of args differs."
77 (replace-regexp-in-string regexp rep string nil literal)))
70 (string-as-unibyte . identity) 78 (string-as-unibyte . identity)
71 (string-make-unibyte . identity) 79 (string-make-unibyte . identity)
72 ;; string-as-multibyte often doesn't really do what you think it does. 80 ;; string-as-multibyte often doesn't really do what you think it does.
@@ -90,7 +98,22 @@
90 (string-as-multibyte . identity) 98 (string-as-multibyte . identity)
91 (multibyte-string-p . ignore) 99 (multibyte-string-p . ignore)
92 (insert-byte . insert-char) 100 (insert-byte . insert-char)
93 (multibyte-char-to-unibyte . identity)))) 101 (multibyte-char-to-unibyte . identity)
102 (special-display-p
103 . (lambda (buffer-name)
104 "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
105 (and special-display-function
106 (or (and (member buffer-name special-display-buffer-names) t)
107 (cdr (assoc buffer-name special-display-buffer-names))
108 (catch 'return
109 (dolist (elem special-display-regexps)
110 (and (stringp elem)
111 (string-match elem buffer-name)
112 (throw 'return t))
113 (and (consp elem)
114 (stringp (car elem))
115 (string-match (car elem) buffer-name)
116 (throw 'return (cdr elem))))))))))))
94 117
95(eval-and-compile 118(eval-and-compile
96 (if (featurep 'xemacs) 119 (if (featurep 'xemacs)
@@ -120,32 +143,6 @@
120 (defalias 'mm-decode-coding-region 'decode-coding-region) 143 (defalias 'mm-decode-coding-region 'decode-coding-region)
121 (defalias 'mm-encode-coding-region 'encode-coding-region))) 144 (defalias 'mm-encode-coding-region 'encode-coding-region)))
122 145
123(eval-and-compile
124 (cond
125 ((fboundp 'replace-in-string)
126 (defalias 'mm-replace-in-string 'replace-in-string))
127 ((fboundp 'replace-regexp-in-string)
128 (defun mm-replace-in-string (string regexp newtext &optional literal)
129 "Replace all matches for REGEXP with NEWTEXT in STRING.
130If LITERAL is non-nil, insert NEWTEXT literally. Return a new
131string containing the replacements.
132
133This is a compatibility function for different Emacsen."
134 (replace-regexp-in-string regexp newtext string nil literal)))
135 (t
136 (defun mm-replace-in-string (string regexp newtext &optional literal)
137 "Replace all matches for REGEXP with NEWTEXT in STRING.
138If LITERAL is non-nil, insert NEWTEXT literally. Return a new
139string containing the replacements.
140
141This is a compatibility function for different Emacsen."
142 (let ((start 0) tail)
143 (while (string-match regexp string start)
144 (setq tail (- (length string) (match-end 0)))
145 (setq string (replace-match newtext nil literal string))
146 (setq start (- (length string) tail))))
147 string))))
148
149(defalias 'mm-string-to-multibyte 146(defalias 'mm-string-to-multibyte
150 (cond 147 (cond
151 ((featurep 'xemacs) 148 ((featurep 'xemacs)
@@ -262,6 +259,10 @@ the alias. Else windows-NUMBER is used."
262 ,@(when (and (not (mm-coding-system-p 'gbk)) 259 ,@(when (and (not (mm-coding-system-p 'gbk))
263 (mm-coding-system-p 'cp936)) 260 (mm-coding-system-p 'cp936))
264 '((gbk . cp936))) 261 '((gbk . cp936)))
262 ;; ISO8859-1 is a bogus name for ISO-8859-1
263 ,@(when (and (not (mm-coding-system-p 'iso8859-1))
264 (mm-coding-system-p 'iso-8859-1))
265 '((iso8859-1 . iso-8859-1)))
265 ) 266 )
266 "A mapping from unknown or invalid charset names to the real charset names. 267 "A mapping from unknown or invalid charset names to the real charset names.
267 268
@@ -378,7 +379,9 @@ Unless LIST is given, `mm-codepage-ibm-list' is used."
378(mm-setup-codepage-ibm) 379(mm-setup-codepage-ibm)
379 380
380(defcustom mm-charset-override-alist 381(defcustom mm-charset-override-alist
381 `((iso-8859-1 . windows-1252)) 382 '((iso-8859-1 . windows-1252)
383 (iso-8859-8 . windows-1255)
384 (iso-8859-9 . windows-1254))
382 "A mapping from undesired charset names to their replacement. 385 "A mapping from undesired charset names to their replacement.
383 386
384You may add pairs like (iso-8859-1 . windows-1252) here, 387You may add pairs like (iso-8859-1 . windows-1252) here,
@@ -386,6 +389,8 @@ i.e. treat iso-8859-1 as windows-1252. windows-1252 is a
386superset of iso-8859-1." 389superset of iso-8859-1."
387 :type '(list (set :inline t 390 :type '(list (set :inline t
388 (const (iso-8859-1 . windows-1252)) 391 (const (iso-8859-1 . windows-1252))
392 (const (iso-8859-8 . windows-1255))
393 (const (iso-8859-9 . windows-1254))
389 (const (undecided . windows-1252))) 394 (const (undecided . windows-1252)))
390 (repeat :inline t 395 (repeat :inline t
391 :tag "Other options" 396 :tag "Other options"
@@ -721,9 +726,6 @@ only be used for decoding, not for encoding."
721 (message "Unknown charset: %s" charset))) 726 (message "Unknown charset: %s" charset)))
722 cs)))) 727 cs))))
723 728
724(defsubst mm-replace-chars-in-string (string from to)
725 (mm-subst-char-in-string from to string))
726
727(eval-and-compile 729(eval-and-compile
728 (defvar mm-emacs-mule (and (not (featurep 'xemacs)) 730 (defvar mm-emacs-mule (and (not (featurep 'xemacs))
729 (boundp 'default-enable-multibyte-characters) 731 (boundp 'default-enable-multibyte-characters)
@@ -907,7 +909,7 @@ But this is very much a corner case, so don't worry about it."
907 909
908 ;; Load the Latin Unity library, if available. 910 ;; Load the Latin Unity library, if available.
909 (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) 911 (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity"))
910 (ignore-errors (require 'latin-unity))) 912 (require 'latin-unity))
911 913
912 ;; Now, can we use it? 914 ;; Now, can we use it?
913 (if (featurep 'latin-unity) 915 (if (featurep 'latin-unity)
@@ -1010,8 +1012,8 @@ charset, and a longer list means no appropriate charset."
1010 (memq 'iso-8859-15 charsets) 1012 (memq 'iso-8859-15 charsets)
1011 (memq 'iso-8859-15 hack-charsets) 1013 (memq 'iso-8859-15 hack-charsets)
1012 (save-excursion (mm-iso-8859-x-to-15-region b e))) 1014 (save-excursion (mm-iso-8859-x-to-15-region b e)))
1013 (mapcar (lambda (x) (setq charsets (delq (car x) charsets))) 1015 (dolist (x mm-iso-8859-15-compatible)
1014 mm-iso-8859-15-compatible)) 1016 (setq charsets (delq (car x) charsets))))
1015 (if (and (memq 'iso-2022-jp-2 charsets) 1017 (if (and (memq 'iso-2022-jp-2 charsets)
1016 (memq 'iso-2022-jp-2 hack-charsets)) 1018 (memq 'iso-2022-jp-2 hack-charsets))
1017 (setq charsets (delq 'iso-2022-jp charsets))) 1019 (setq charsets (delq 'iso-2022-jp charsets)))
@@ -1093,10 +1095,10 @@ Emacs 23 (unicode)."
1093 ;; Remove composition since the base charsets have been included. 1095 ;; Remove composition since the base charsets have been included.
1094 ;; Remove eight-bit-*, treat them as ascii. 1096 ;; Remove eight-bit-*, treat them as ascii.
1095 (let ((css (find-charset-region b e))) 1097 (let ((css (find-charset-region b e)))
1096 (mapcar (lambda (cs) (setq css (delq cs css))) 1098 (dolist (cs
1097 '(composition eight-bit-control eight-bit-graphic 1099 '(composition eight-bit-control eight-bit-graphic control-1)
1098 control-1)) 1100 css)
1099 css)) 1101 (setq css (delq cs css)))))
1100 (t 1102 (t
1101 ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. 1103 ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
1102 (save-excursion 1104 (save-excursion
@@ -1119,21 +1121,6 @@ Emacs 23 (unicode)."
1119 mm-mime-mule-charset-alist))))) 1121 mm-mime-mule-charset-alist)))))
1120 (list 'ascii (or charset 'latin-iso8859-1))))))))) 1122 (list 'ascii (or charset 'latin-iso8859-1)))))))))
1121 1123
1122(if (fboundp 'shell-quote-argument)
1123 (defalias 'mm-quote-arg 'shell-quote-argument)
1124 (defun mm-quote-arg (arg)
1125 "Return a version of ARG that is safe to evaluate in a shell."
1126 (let ((pos 0) new-pos accum)
1127 ;; *** bug: we don't handle newline characters properly
1128 (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
1129 (push (substring arg pos new-pos) accum)
1130 (push "\\" accum)
1131 (push (list (aref arg new-pos)) accum)
1132 (setq pos (1+ new-pos)))
1133 (if (= pos 0)
1134 arg
1135 (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))))
1136
1137(defun mm-auto-mode-alist () 1124(defun mm-auto-mode-alist ()
1138 "Return an `auto-mode-alist' with only the .gz (etc) thingies." 1125 "Return an `auto-mode-alist' with only the .gz (etc) thingies."
1139 (let ((alist auto-mode-alist) 1126 (let ((alist auto-mode-alist)
@@ -1145,7 +1132,7 @@ Emacs 23 (unicode)."
1145 (nreverse out))) 1132 (nreverse out)))
1146 1133
1147(defvar mm-inhibit-file-name-handlers 1134(defvar mm-inhibit-file-name-handlers
1148 '(jka-compr-handler image-file-handler) 1135 '(jka-compr-handler image-file-handler epa-file-handler)
1149 "A list of handlers doing (un)compression (etc) thingies.") 1136 "A list of handlers doing (un)compression (etc) thingies.")
1150 1137
1151(defun mm-insert-file-contents (filename &optional visit beg end replace 1138(defun mm-insert-file-contents (filename &optional visit beg end replace
@@ -1231,7 +1218,7 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
1231 (>= (length def) 4) 1218 (>= (length def) 4)
1232 (eq (nth 3 def) 'suffix))))) 1219 (eq (nth 3 def) 'suffix)))))
1233 (defalias 'mm-make-temp-file 'make-temp-file) 1220 (defalias 'mm-make-temp-file 'make-temp-file)
1234 ;; Stolen (and modified for Emacs 20 and XEmacs) from Emacs 22. 1221 ;; Stolen (and modified for XEmacs) from Emacs 22.
1235 (defun mm-make-temp-file (prefix &optional dir-flag suffix) 1222 (defun mm-make-temp-file (prefix &optional dir-flag suffix)
1236 "Create a temporary file. 1223 "Create a temporary file.
1237The returned file name (created by appending some random characters at the end 1224The returned file name (created by appending some random characters at the end
@@ -1271,10 +1258,9 @@ If SUFFIX is non-nil, add that at the end of the file name."
1271 nil 'excl)) 1258 nil 'excl))
1272 nil) 1259 nil)
1273 (file-already-exists t) 1260 (file-already-exists t)
1274 ;; The Emacs 20 and XEmacs versions of 1261 ;; The XEmacs version of `make-directory' issues
1275 ;; `make-directory' issue `file-error'. 1262 ;; `file-error'.
1276 (file-error (or (and (or (featurep 'xemacs) 1263 (file-error (or (and (featurep 'xemacs)
1277 (= emacs-major-version 20))
1278 (file-exists-p file)) 1264 (file-exists-p file))
1279 (signal (car err) (cdr err))))) 1265 (signal (car err) (cdr err)))))
1280 ;; the file was somehow created by someone else between 1266 ;; the file was somehow created by someone else between
@@ -1322,6 +1308,187 @@ If SUFFIX is non-nil, add that at the end of the file name."
1322 (let ((cs (mm-detect-coding-region start end))) 1308 (let ((cs (mm-detect-coding-region start end)))
1323 cs))) 1309 cs)))
1324 1310
1311(eval-when-compile
1312 (unless (fboundp 'coding-system-to-mime-charset)
1313 (defalias 'coding-system-to-mime-charset 'ignore)))
1314
1315(defun mm-coding-system-to-mime-charset (coding-system)
1316 "Return the MIME charset corresponding to CODING-SYSTEM.
1317To make this function work with XEmacs, the APEL package is required."
1318 (when coding-system
1319 (or (and (fboundp 'coding-system-get)
1320 (or (coding-system-get coding-system :mime-charset)
1321 (coding-system-get coding-system 'mime-charset)))
1322 (and (featurep 'xemacs)
1323 (or (and (fboundp 'coding-system-to-mime-charset)
1324 (not (eq (symbol-function 'coding-system-to-mime-charset)
1325 'ignore)))
1326 (and (condition-case nil
1327 (require 'mcharset)
1328 (error nil))
1329 (fboundp 'coding-system-to-mime-charset)))
1330 (coding-system-to-mime-charset coding-system)))))
1331
1332(eval-when-compile
1333 (require 'jka-compr))
1334
1335(defun mm-decompress-buffer (filename &optional inplace force)
1336 "Decompress buffer's contents, depending on jka-compr.
1337Only when FORCE is t or `auto-compression-mode' is enabled and FILENAME
1338agrees with `jka-compr-compression-info-list', decompression is done.
1339Signal an error if FORCE is neither nil nor t and compressed data are
1340not decompressed because `auto-compression-mode' is disabled.
1341If INPLACE is nil, return decompressed data or nil without modifying
1342the buffer. Otherwise, replace the buffer's contents with the
1343decompressed data. The buffer's multibyteness must be turned off."
1344 (when (and filename
1345 (if force
1346 (prog1 t (require 'jka-compr))
1347 (and (fboundp 'jka-compr-installed-p)
1348 (jka-compr-installed-p))))
1349 (let ((info (jka-compr-get-compression-info filename)))
1350 (when info
1351 (unless (or (memq force (list nil t))
1352 (jka-compr-installed-p))
1353 (error ""))
1354 (let ((prog (jka-compr-info-uncompress-program info))
1355 (args (jka-compr-info-uncompress-args info))
1356 (msg (format "%s %s..."
1357 (jka-compr-info-uncompress-message info)
1358 filename))
1359 (err-file (jka-compr-make-temp-name))
1360 (cur (current-buffer))
1361 (coding-system-for-read mm-binary-coding-system)
1362 (coding-system-for-write mm-binary-coding-system)
1363 retval err-msg)
1364 (message "%s" msg)
1365 (mm-with-unibyte-buffer
1366 (insert-buffer-substring cur)
1367 (condition-case err
1368 (progn
1369 (unless (memq (apply 'call-process-region
1370 (point-min) (point-max)
1371 prog t (list t err-file) nil args)
1372 jka-compr-acceptable-retval-list)
1373 (erase-buffer)
1374 (insert (mapconcat
1375 'identity
1376 (delete "" (split-string
1377 (prog2
1378 (insert-file-contents err-file)
1379 (buffer-string)
1380 (erase-buffer))))
1381 " ")
1382 "\n")
1383 (setq err-msg
1384 (format "Error while executing \"%s %s < %s\""
1385 prog (mapconcat 'identity args " ")
1386 filename)))
1387 (setq retval (buffer-string)))
1388 (error
1389 (setq err-msg (error-message-string err)))))
1390 (when (file-exists-p err-file)
1391 (ignore-errors (jka-compr-delete-temp-file err-file)))
1392 (when inplace
1393 (unless err-msg
1394 (delete-region (point-min) (point-max))
1395 (insert retval))
1396 (setq retval nil))
1397 (message "%s" (or err-msg (concat msg "done")))
1398 retval)))))
1399
1400(eval-when-compile
1401 (unless (fboundp 'coding-system-name)
1402 (defalias 'coding-system-name 'ignore))
1403 (unless (fboundp 'find-file-coding-system-for-read-from-filename)
1404 (defalias 'find-file-coding-system-for-read-from-filename 'ignore))
1405 (unless (fboundp 'find-operation-coding-system)
1406 (defalias 'find-operation-coding-system 'ignore)))
1407
1408(defun mm-find-buffer-file-coding-system (&optional filename)
1409 "Find coding system used to decode the contents of the current buffer.
1410This function looks for the coding system magic cookie or examines the
1411coding system specified by `file-coding-system-alist' being associated
1412with FILENAME which defaults to `buffer-file-name'. Data compressed by
1413gzip, bzip2, etc. are allowed."
1414 (unless filename
1415 (setq filename buffer-file-name))
1416 (save-excursion
1417 (let ((decomp (unless ;; No worth to examine charset of tar files.
1418 (and filename
1419 (string-match
1420 "\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"
1421 filename))
1422 (mm-decompress-buffer filename nil t))))
1423 (when decomp
1424 (set-buffer (let (default-enable-multibyte-characters)
1425 (generate-new-buffer " *temp*")))
1426 (insert decomp)
1427 (setq filename (file-name-sans-extension filename)))
1428 (goto-char (point-min))
1429 (prog1
1430 (cond
1431 ((boundp 'set-auto-coding-function) ;; Emacs
1432 (if filename
1433 (or (funcall (symbol-value 'set-auto-coding-function)
1434 filename (- (point-max) (point-min)))
1435 (car (find-operation-coding-system 'insert-file-contents
1436 filename)))
1437 (let (auto-coding-alist)
1438 (condition-case nil
1439 (funcall (symbol-value 'set-auto-coding-function)
1440 nil (- (point-max) (point-min)))
1441 (error nil)))))
1442 ((featurep 'file-coding) ;; XEmacs
1443 (let ((case-fold-search t)
1444 (end (point-at-eol))
1445 codesys start)
1446 (or
1447 (and (re-search-forward "-\\*-+[\t ]*" end t)
1448 (progn
1449 (setq start (match-end 0))
1450 (re-search-forward "[\t ]*-+\\*-" end t))
1451 (progn
1452 (setq end (match-beginning 0))
1453 (goto-char start)
1454 (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)")
1455 (re-search-forward
1456 "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)"
1457 end t)))
1458 (find-coding-system (setq codesys
1459 (intern (match-string 1))))
1460 codesys)
1461 (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:"
1462 nil t)
1463 (progn
1464 (setq start (match-end 0))
1465 (re-search-forward "^[\t ]*;+[\t ]*End:" nil t))
1466 (progn
1467 (setq end (match-beginning 0))
1468 (goto-char start)
1469 (re-search-forward
1470 "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)"
1471 end t))
1472 (find-coding-system (setq codesys
1473 (intern (match-string 1))))
1474 codesys)
1475 (and (progn
1476 (goto-char (point-min))
1477 (setq case-fold-search nil)
1478 (re-search-forward "^;;;coding system: "
1479 ;;(+ (point-min) 3000) t))
1480 nil t))
1481 (looking-at "[^\t\n\r ]+")
1482 (find-coding-system
1483 (setq codesys (intern (match-string 0))))
1484 codesys)
1485 (and filename
1486 (setq codesys
1487 (find-file-coding-system-for-read-from-filename
1488 filename))
1489 (coding-system-name (coding-system-base codesys)))))))
1490 (when decomp
1491 (kill-buffer (current-buffer)))))))
1325 1492
1326(provide 'mm-util) 1493(provide 'mm-util)
1327 1494
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 81d8088535f..c7f6b16a1c8 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -68,9 +68,6 @@ decoder, such as hexbin."
68 68
69(defvar mm-uu-yenc-decode-function 'yenc-decode-region) 69(defvar mm-uu-yenc-decode-function 'yenc-decode-region)
70 70
71(defvar mm-uu-pgp-beginning-signature
72 "^-----BEGIN PGP SIGNATURE-----")
73
74(defvar mm-uu-beginning-regexp nil) 71(defvar mm-uu-beginning-regexp nil)
75 72
76(defvar mm-dissect-disposition "inline" 73(defvar mm-dissect-disposition "inline"
@@ -90,19 +87,25 @@ This can be either \"inline\" or \"attachment\".")
90 :type 'regexp 87 :type 'regexp
91 :group 'gnus-article-mime) 88 :group 'gnus-article-mime)
92 89
90(defcustom mm-uu-tex-groups-regexp "\\.tex\\>"
91 "*Regexp matching TeX groups."
92 :version "23.0"
93 :type 'regexp
94 :group 'gnus-article-mime)
95
93(defvar mm-uu-type-alist 96(defvar mm-uu-type-alist
94 '((postscript 97 '((postscript
95 "^%!PS-" 98 "^%!PS-"
96 "^%%EOF$" 99 "^%%EOF$"
97 mm-uu-postscript-extract 100 mm-uu-postscript-extract
98 nil) 101 nil)
99 (uu 102 (uu ;; Maybe we should have a more strict test here.
100 "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+" 103 "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
101 "^end[ \t]*$" 104 "^end[ \t]*$"
102 mm-uu-uu-extract 105 mm-uu-uu-extract
103 mm-uu-uu-filename) 106 mm-uu-uu-filename)
104 (binhex 107 (binhex
105 "^:...............................................................$" 108 "^:.\\{63,63\\}$"
106 ":$" 109 ":$"
107 mm-uu-binhex-extract 110 mm-uu-binhex-extract
108 nil 111 nil
@@ -157,7 +160,35 @@ This can be either \"inline\" or \"attachment\".")
157 nil 160 nil
158 mm-uu-diff-extract 161 mm-uu-diff-extract
159 nil 162 nil
160 mm-uu-diff-test)) 163 mm-uu-diff-test)
164 (message-marks
165 ;; Text enclosed with tags similar to `message-mark-insert-begin' and
166 ;; `message-mark-insert-end'. Don't use those variables to avoid
167 ;; dependency on `message.el'.
168 "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$"
169 "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$"
170 (lambda () (mm-uu-verbatim-marks-extract 0 -1 1 -1))
171 nil)
172 ;; Omitting [a-z8<] leads to false positives (bogus signature separators
173 ;; and mailing list banners).
174 (insert-marks
175 "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
176 "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
177 (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
178 nil)
179 (verbatim-marks
180 ;; slrn-style verbatim marks, see
181 ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81
182 "^#v\\+"
183 "^#v\\-$"
184 (lambda () (mm-uu-verbatim-marks-extract 0 0))
185 nil)
186 (LaTeX
187 "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
188 "^\\\\end{document}"
189 mm-uu-latex-extract
190 nil
191 mm-uu-latex-test))
161 "A list of specifications for non-MIME attachments. 192 "A list of specifications for non-MIME attachments.
162Each element consist of the following entries: label, 193Each element consist of the following entries: label,
163start-regexp, end-regexp, extract-function, test-function. 194start-regexp, end-regexp, extract-function, test-function.
@@ -201,9 +232,45 @@ To disable dissecting shar codes, for instance, add
201(defsubst mm-uu-function-2 (entry) 232(defsubst mm-uu-function-2 (entry)
202 (nth 5 entry)) 233 (nth 5 entry))
203 234
204(defun mm-uu-copy-to-buffer (&optional from to) 235;; In Emacs 22, we could use `min-colors' in the face definition. But Emacs
236;; 21 and XEmacs don't support it.
237(defcustom mm-uu-hide-markers
238 (< 16 (or (and (fboundp 'defined-colors)
239 (length (defined-colors)))
240 (and (fboundp 'device-color-cells)
241 (device-color-cells))
242 0))
243 "If non-nil, hide verbatim markers.
244The value should be nil on displays where the face
245`mm-uu-extract' isn't distinguishable to the face `default'."
246 :type '(choice (const :tag "Hide" t)
247 (const :tag "Don't hide" nil))
248 :version "23.0" ;; No Gnus
249 :group 'gnus-article-mime)
250
251(defface mm-uu-extract '(;; Colors from `gnus-cite-3' plus background:
252 (((class color)
253 (background dark))
254 (:foreground "light yellow"
255 :background "dark green"))
256 (((class color)
257 (background light))
258 (:foreground "dark green"
259 :background "light yellow"))
260 (t
261 ()))
262 "Face for extracted buffers."
263 ;; See `mm-uu-verbatim-marks-extract'.
264 :version "23.0" ;; No Gnus
265 :group 'gnus-article-mime)
266
267(defun mm-uu-copy-to-buffer (&optional from to properties)
205 "Copy the contents of the current buffer to a fresh buffer. 268 "Copy the contents of the current buffer to a fresh buffer.
206Return that buffer." 269Return that buffer.
270
271If PROPERTIES is non-nil, PROPERTIES are applied to the buffer,
272see `set-text-properties'. If PROPERTIES equals t, this means to
273apply the face `mm-uu-extract'."
207 (let ((obuf (current-buffer)) 274 (let ((obuf (current-buffer))
208 (coding-system 275 (coding-system
209 ;; Might not exist in non-MULE XEmacs 276 ;; Might not exist in non-MULE XEmacs
@@ -212,6 +279,11 @@ Return that buffer."
212 (with-current-buffer (generate-new-buffer " *mm-uu*") 279 (with-current-buffer (generate-new-buffer " *mm-uu*")
213 (setq buffer-file-coding-system coding-system) 280 (setq buffer-file-coding-system coding-system)
214 (insert-buffer-substring obuf from to) 281 (insert-buffer-substring obuf from to)
282 (cond ((eq properties t)
283 (set-text-properties (point-min) (point-max)
284 '(face mm-uu-extract)))
285 (properties
286 (set-text-properties (point-min) (point-max) properties)))
215 (current-buffer)))) 287 (current-buffer))))
216 288
217(defun mm-uu-configure-p (key val) 289(defun mm-uu-configure-p (key val)
@@ -267,6 +339,35 @@ Return that buffer."
267 (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) 339 (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
268 '("application/postscript"))) 340 '("application/postscript")))
269 341
342(defun mm-uu-verbatim-marks-extract (start-offset end-offset
343 &optional
344 start-hide
345 end-hide)
346 (let ((start (or (and mm-uu-hide-markers
347 start-hide)
348 start-offset
349 1))
350 (end (or (and mm-uu-hide-markers
351 end-hide)
352 end-offset
353 -1)))
354 (mm-make-handle
355 (mm-uu-copy-to-buffer
356 (progn (goto-char start-point)
357 (forward-line start)
358 (point))
359 (progn (goto-char end-point)
360 (forward-line end)
361 (point))
362 t)
363 '("text/x-verbatim" (charset . gnus-decoded)))))
364
365(defun mm-uu-latex-extract ()
366 (mm-make-handle
367 (mm-uu-copy-to-buffer start-point end-point t)
368 ;; application/x-tex?
369 '("text/x-verbatim" (charset . gnus-decoded))))
370
270(defun mm-uu-emacs-sources-extract () 371(defun mm-uu-emacs-sources-extract ()
271 (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) 372 (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
272 '("application/emacs-lisp" (charset . gnus-decoded)) 373 '("application/emacs-lisp" (charset . gnus-decoded))
@@ -292,6 +393,11 @@ Return that buffer."
292 mm-uu-diff-groups-regexp 393 mm-uu-diff-groups-regexp
293 (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name))) 394 (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
294 395
396(defun mm-uu-latex-test ()
397 (and gnus-newsgroup-name
398 mm-uu-tex-groups-regexp
399 (string-match mm-uu-tex-groups-regexp gnus-newsgroup-name)))
400
295(defun mm-uu-forward-extract () 401(defun mm-uu-forward-extract ()
296 (mm-make-handle (mm-uu-copy-to-buffer 402 (mm-make-handle (mm-uu-copy-to-buffer
297 (progn (goto-char start-point) (forward-line) (point)) 403 (progn (goto-char start-point) (forward-line) (point))
@@ -369,30 +475,16 @@ Return that buffer."
369 (progn 475 (progn
370 (mml2015-clean-buffer) 476 (mml2015-clean-buffer)
371 (let ((coding-system-for-write (or gnus-newsgroup-charset 477 (let ((coding-system-for-write (or gnus-newsgroup-charset
372 'iso-8859-1))) 478 'iso-8859-1))
479 (coding-system-for-read (or gnus-newsgroup-charset
480 'iso-8859-1)))
373 (funcall (mml2015-clear-verify-function)))) 481 (funcall (mml2015-clear-verify-function))))
374 (when (and mml2015-use (null (mml2015-clear-verify-function))) 482 (when (and mml2015-use (null (mml2015-clear-verify-function)))
375 (mm-set-handle-multipart-parameter 483 (mm-set-handle-multipart-parameter
376 mm-security-handle 'gnus-details 484 mm-security-handle 'gnus-details
377 (format "Clear verification not supported by `%s'.\n" mml2015-use)))) 485 (format "Clear verification not supported by `%s'.\n" mml2015-use)))
378 (goto-char (point-min)) 486 (mml2015-extract-cleartext-signature))
379 (forward-line) 487 (list (mm-make-handle buf mm-uu-text-plain-type)))))
380 ;; We need to be careful not to strip beyond the armor headers.
381 ;; Previously, an attacker could replace the text inside our
382 ;; markup with trailing garbage by injecting whitespace into the
383 ;; message.
384 (while (looking-at "Hash:") ; The only header allowed in cleartext
385 (forward-line)) ; signatures according to RFC2440.
386 (when (looking-at "[\t ]*$")
387 (forward-line))
388 (delete-region (point-min) (point))
389 (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
390 (delete-region (match-beginning 0) (point-max)))
391 (goto-char (point-min))
392 (while (re-search-forward "^- " nil t)
393 (replace-match "" t t)
394 (forward-line 1)))
395 (list (mm-make-handle buf mm-uu-text-plain-type))))
396 488
397(defun mm-uu-pgp-signed-extract () 489(defun mm-uu-pgp-signed-extract ()
398 (let ((mm-security-handle (list (format "multipart/signed")))) 490 (let ((mm-security-handle (list (format "multipart/signed"))))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index c8a672928c0..ffaf0ed68ba 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -30,15 +30,14 @@
30(require 'mailcap) 30(require 'mailcap)
31(require 'mm-bodies) 31(require 'mm-bodies)
32(require 'mm-decode) 32(require 'mm-decode)
33(require 'smime)
33 34
34(eval-and-compile 35(eval-and-compile
35 (autoload 'gnus-article-prepare-display "gnus-art") 36 (autoload 'gnus-article-prepare-display "gnus-art")
36 (autoload 'vcard-parse-string "vcard") 37 (autoload 'vcard-parse-string "vcard")
37 (autoload 'vcard-format-string "vcard") 38 (autoload 'vcard-format-string "vcard")
38 (autoload 'fill-flowed "flow-fill") 39 (autoload 'fill-flowed "flow-fill")
39 (autoload 'html2text "html2text" nil t) 40 (autoload 'html2text "html2text" nil t))
40 (unless (fboundp 'diff-mode)
41 (autoload 'diff-mode "diff-mode" "" t nil)))
42 41
43(defvar gnus-article-mime-handles) 42(defvar gnus-article-mime-handles)
44(defvar gnus-newsgroup-charset) 43(defvar gnus-newsgroup-charset)
@@ -73,7 +72,7 @@
73 "The attributes of washer types for text/html.") 72 "The attributes of washer types for text/html.")
74 73
75(defcustom mm-fill-flowed t 74(defcustom mm-fill-flowed t
76 "If non-nil an format=flowed article will be displayed flowed." 75 "If non-nil a format=flowed article will be displayed flowed."
77 :type 'boolean 76 :type 'boolean
78 :version "22.1" 77 :version "22.1"
79 :group 'mime-display) 78 :group 'mime-display)
@@ -140,26 +139,26 @@
140 (charset (mail-content-type-get 139 (charset (mail-content-type-get
141 (mm-handle-type handle) 'charset))) 140 (mm-handle-type handle) 'charset)))
142 (save-excursion 141 (save-excursion
143 (insert text) 142 (insert (if charset (mm-decode-string text charset) text))
144 (save-restriction 143 (save-restriction
145 (narrow-to-region b (point)) 144 (narrow-to-region b (point))
146 (goto-char (point-min)) 145 (unless charset
147 (if (or (and (boundp 'w3-meta-content-type-charset-regexp) 146 (goto-char (point-min))
148 (re-search-forward 147 (when (or (and (boundp 'w3-meta-content-type-charset-regexp)
149 w3-meta-content-type-charset-regexp nil t)) 148 (re-search-forward
150 (and (boundp 'w3-meta-charset-content-type-regexp) 149 w3-meta-content-type-charset-regexp nil t))
151 (re-search-forward 150 (and (boundp 'w3-meta-charset-content-type-regexp)
152 w3-meta-charset-content-type-regexp nil t))) 151 (re-search-forward
152 w3-meta-charset-content-type-regexp nil t)))
153 (setq charset 153 (setq charset
154 (or (let ((bsubstr (buffer-substring-no-properties 154 (let ((bsubstr (buffer-substring-no-properties
155 (match-beginning 2) 155 (match-beginning 2)
156 (match-end 2)))) 156 (match-end 2))))
157 (if (fboundp 'w3-coding-system-for-mime-charset) 157 (if (fboundp 'w3-coding-system-for-mime-charset)
158 (w3-coding-system-for-mime-charset bsubstr) 158 (w3-coding-system-for-mime-charset bsubstr)
159 (mm-charset-to-coding-system bsubstr))) 159 (mm-charset-to-coding-system bsubstr))))
160 charset))) 160 (delete-region (point-min) (point-max))
161 (delete-region (point-min) (point-max)) 161 (insert (mm-decode-string text charset))))
162 (insert (mm-decode-string text charset))
163 (save-window-excursion 162 (save-window-excursion
164 (save-restriction 163 (save-restriction
165 (let ((w3-strict-width width) 164 (let ((w3-strict-width width)
@@ -189,12 +188,12 @@
189 handle 188 handle
190 `(lambda () 189 `(lambda ()
191 (let (buffer-read-only) 190 (let (buffer-read-only)
192 (if (functionp 'remove-specifier) 191 ,@(if (functionp 'remove-specifier)
193 (mapcar (lambda (prop) 192 '((mapcar (lambda (prop)
194 (remove-specifier 193 (remove-specifier
195 (face-property 'default prop) 194 (face-property 'default prop)
196 (current-buffer))) 195 (current-buffer)))
197 '(background background-pixmap foreground))) 196 '(background background-pixmap foreground))))
198 (delete-region ,(point-min-marker) 197 (delete-region ,(point-min-marker)
199 ,(point-max-marker))))))))) 198 ,(point-max-marker)))))))))
200 199
@@ -263,13 +262,7 @@
263 (mm-handle-set-undisplayer 262 (mm-handle-set-undisplayer
264 handle 263 handle
265 `(lambda () 264 `(lambda ()
266 (let (buffer-read-only) 265 (let ((inhibit-read-only t))
267 (if (functionp 'remove-specifier)
268 (mapcar (lambda (prop)
269 (remove-specifier
270 (face-property 'default prop)
271 (current-buffer)))
272 '(background background-pixmap foreground)))
273 (delete-region ,(point-min-marker) 266 (delete-region ,(point-min-marker)
274 ,(point-max-marker))))))))) 267 ,(point-max-marker)))))))))
275 268
@@ -428,7 +421,8 @@
428 (save-restriction 421 (save-restriction
429 (narrow-to-region b (point)) 422 (narrow-to-region b (point))
430 (goto-char b) 423 (goto-char b)
431 (fill-flowed) 424 (fill-flowed nil (equal (cdr (assoc 'delsp (mm-handle-type handle)))
425 "yes"))
432 (goto-char (point-max)))) 426 (goto-char (point-max))))
433 (save-restriction 427 (save-restriction
434 (narrow-to-region b (point)) 428 (narrow-to-region b (point))
@@ -448,6 +442,8 @@
448 "Insert TEXT inline from HANDLE." 442 "Insert TEXT inline from HANDLE."
449 (let ((b (point))) 443 (let ((b (point)))
450 (insert text) 444 (insert text)
445 (unless (bolp)
446 (insert "\n"))
451 (mm-handle-set-undisplayer 447 (mm-handle-set-undisplayer
452 handle 448 handle
453 `(lambda () 449 `(lambda ()
@@ -530,38 +526,55 @@
530 (delete-region ,(point-min-marker) ,(point-max-marker))))))))) 526 (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
531 527
532(defun mm-display-inline-fontify (handle mode) 528(defun mm-display-inline-fontify (handle mode)
533 (let (text) 529 (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset))
530 text coding-system)
531 (unless (eq charset 'gnus-decoded)
532 (mm-with-unibyte-buffer
533 (mm-insert-part handle)
534 (mm-decompress-buffer
535 (or (mail-content-type-get (mm-handle-disposition handle) 'name)
536 (mail-content-type-get (mm-handle-disposition handle) 'filename))
537 t t)
538 (unless charset
539 (setq coding-system (mm-find-buffer-file-coding-system)))
540 (setq text (buffer-string))))
534 ;; XEmacs @#$@ version of font-lock refuses to fully turn itself 541 ;; XEmacs @#$@ version of font-lock refuses to fully turn itself
535 ;; on for buffers whose name begins with " ". That's why we use 542 ;; on for buffers whose name begins with " ". That's why we use
536 ;; save-current-buffer/get-buffer-create rather than 543 ;; `with-current-buffer'/`generate-new-buffer' rather than
537 ;; with-temp-buffer. 544 ;; `with-temp-buffer'.
538 (save-current-buffer 545 (with-current-buffer (generate-new-buffer "*fontification*")
539 (set-buffer (generate-new-buffer "*fontification*")) 546 (buffer-disable-undo)
540 (unwind-protect 547 (mm-enable-multibyte)
541 (progn 548 (insert (cond ((eq charset 'gnus-decoded)
542 (buffer-disable-undo) 549 (with-current-buffer (mm-handle-buffer handle)
543 (mm-insert-part handle) 550 (buffer-string)))
544 (require 'font-lock) 551 (coding-system
545 (let ((font-lock-maximum-size nil) 552 (mm-decode-coding-string text coding-system))
546 ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. 553 (charset
547 (font-lock-mode-hook nil) 554 (mm-decode-string text charset))
548 (font-lock-support-mode nil) 555 (t
549 ;; I find font-lock a bit too verbose. 556 text)))
550 (font-lock-verbose nil)) 557 (require 'font-lock)
551 (funcall mode) 558 (let ((font-lock-maximum-size nil)
552 ;; The mode function might have already turned on font-lock. 559 ;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
553 (unless (symbol-value 'font-lock-mode) 560 (font-lock-mode-hook nil)
554 (font-lock-fontify-buffer))) 561 (font-lock-support-mode nil)
555 ;; By default, XEmacs font-lock uses non-duplicable text 562 ;; I find font-lock a bit too verbose.
556 ;; properties. This code forces all the text properties 563 (font-lock-verbose nil))
557 ;; to be copied along with the text. 564 (funcall mode)
558 (when (fboundp 'extent-list) 565 ;; The mode function might have already turned on font-lock.
559 (map-extents (lambda (ext ignored) 566 (unless (symbol-value 'font-lock-mode)
560 (set-extent-property ext 'duplicable t) 567 (font-lock-fontify-buffer)))
561 nil) 568 ;; By default, XEmacs font-lock uses non-duplicable text
562 nil nil nil nil nil 'text-prop)) 569 ;; properties. This code forces all the text properties
563 (setq text (buffer-string))) 570 ;; to be copied along with the text.
564 (kill-buffer (current-buffer)))) 571 (when (fboundp 'extent-list)
572 (map-extents (lambda (ext ignored)
573 (set-extent-property ext 'duplicable t)
574 nil)
575 nil nil nil nil nil 'text-prop))
576 (setq text (buffer-string))
577 (kill-buffer (current-buffer)))
565 (mm-insert-inline handle text))) 578 (mm-insert-inline handle text)))
566 579
567;; Shouldn't these functions check whether the user even wants to use 580;; Shouldn't these functions check whether the user even wants to use
@@ -575,27 +588,28 @@
575(defun mm-display-elisp-inline (handle) 588(defun mm-display-elisp-inline (handle)
576 (mm-display-inline-fontify handle 'emacs-lisp-mode)) 589 (mm-display-inline-fontify handle 'emacs-lisp-mode))
577 590
591(defun mm-display-dns-inline (handle)
592 (mm-display-inline-fontify handle 'dns-mode))
593
578;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) 594;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
579;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } 595;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
580(defvar mm-pkcs7-signed-magic 596(defvar mm-pkcs7-signed-magic
581 (mm-string-as-unibyte 597 (mm-string-as-unibyte
582 (apply 'concat 598 (mapconcat 'char-to-string
583 (mapcar 'char-to-string 599 (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
584 (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c 600 ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
585 ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e 601 ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
586 ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 602 ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02) "")))
587 ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))
588 603
589;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) 604;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
590;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } 605;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
591(defvar mm-pkcs7-enveloped-magic 606(defvar mm-pkcs7-enveloped-magic
592 (mm-string-as-unibyte 607 (mm-string-as-unibyte
593 (apply 'concat 608 (mapconcat 'char-to-string
594 (mapcar 'char-to-string 609 (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
595 (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c 610 ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
596 ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e 611 ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
597 ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 612 ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03) "")))
598 ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))
599 613
600(defun mm-view-pkcs7-get-type (handle) 614(defun mm-view-pkcs7-get-type (handle)
601 (mm-with-unibyte-buffer 615 (mm-with-unibyte-buffer
@@ -614,23 +628,26 @@
614 (otherwise (error "Unknown or unimplemented PKCS#7 type")))) 628 (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
615 629
616(defun mm-view-pkcs7-verify (handle) 630(defun mm-view-pkcs7-verify (handle)
617 ;; A bogus implementation of PKCS#7. FIXME:: 631 (let ((verified nil))
618 (mm-insert-part handle) 632 (with-temp-buffer
619 (goto-char (point-min)) 633 (insert "MIME-Version: 1.0\n")
620 (if (search-forward "Content-Type: " nil t) 634 (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
621 (delete-region (point-min) (match-beginning 0))) 635 (insert-buffer-substring (mm-handle-buffer handle))
622 (goto-char (point-max)) 636 (setq verified (smime-verify-region (point-min) (point-max))))
623 (if (re-search-backward "--\r?\n?" nil t) 637 (goto-char (point-min))
624 (delete-region (match-end 0) (point-max))) 638 (mm-insert-part handle)
639 (if (search-forward "Content-Type: " nil t)
640 (delete-region (point-min) (match-beginning 0)))
641 (goto-char (point-max))
642 (if (re-search-backward "--\r?\n?" nil t)
643 (delete-region (match-end 0) (point-max)))
644 (unless verified
645 (insert-buffer-substring smime-details-buffer)))
625 (goto-char (point-min)) 646 (goto-char (point-min))
626 (while (search-forward "\r\n" nil t) 647 (while (search-forward "\r\n" nil t)
627 (replace-match "\n")) 648 (replace-match "\n"))
628 (message "Verify signed PKCS#7 message is unimplemented.")
629 (sit-for 1)
630 t) 649 t)
631 650
632(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro)
633
634(defun mm-view-pkcs7-decrypt (handle) 651(defun mm-view-pkcs7-decrypt (handle)
635 (insert-buffer-substring (mm-handle-buffer handle)) 652 (insert-buffer-substring (mm-handle-buffer handle))
636 (goto-char (point-min)) 653 (goto-char (point-min))
@@ -641,10 +658,9 @@
641 (if (= (length smime-keys) 1) 658 (if (= (length smime-keys) 1)
642 (cadar smime-keys) 659 (cadar smime-keys)
643 (smime-get-key-by-email 660 (smime-get-key-by-email
644 (gnus-completing-read-maybe-default 661 (completing-read
645 (concat "Decipher using key" 662 (concat "Decipher using key"
646 (if smime-keys 663 (if smime-keys (concat "(default " (caar smime-keys) "): ")
647 (concat " (default " (caar smime-keys) "): ")
648 ": ")) 664 ": "))
649 smime-keys nil nil nil nil (car-safe (car-safe smime-keys)))))) 665 smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
650 (goto-char (point-min)) 666 (goto-char (point-min))
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 68df6b64c4b..29bc0d41a1b 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -26,14 +26,20 @@
26 26
27;;; Code: 27;;; Code:
28 28
29(require 'mml-smime)
30(eval-when-compile (require 'cl)) 29(eval-when-compile (require 'cl))
30(require 'password)
31(autoload 'mml2015-sign "mml2015") 31(autoload 'mml2015-sign "mml2015")
32(autoload 'mml2015-encrypt "mml2015") 32(autoload 'mml2015-encrypt "mml2015")
33(autoload 'mml1991-sign "mml1991") 33(autoload 'mml1991-sign "mml1991")
34(autoload 'mml1991-encrypt "mml1991") 34(autoload 'mml1991-encrypt "mml1991")
35(autoload 'message-goto-body "message") 35(autoload 'message-goto-body "message")
36(autoload 'mml-insert-tag "mml") 36(autoload 'mml-insert-tag "mml")
37(autoload 'mml-smime-sign "mml-smime")
38(autoload 'mml-smime-encrypt "mml-smime")
39(autoload 'mml-smime-sign-query "mml-smime")
40(autoload 'mml-smime-encrypt-query "mml-smime")
41(autoload 'mml-smime-verify "mml-smime")
42(autoload 'mml-smime-verify-test "mml-smime")
37 43
38(defvar mml-sign-alist 44(defvar mml-sign-alist
39 '(("smime" mml-smime-sign-buffer mml-smime-sign-query) 45 '(("smime" mml-smime-sign-buffer mml-smime-sign-query)
@@ -96,6 +102,23 @@ details."
96 (choice (const :tag "Separate" separate) 102 (choice (const :tag "Separate" separate)
97 (const :tag "Combined" combined))))) 103 (const :tag "Combined" combined)))))
98 104
105(defcustom mml-secure-verbose nil
106 "If non-nil, ask the user about the current operation more verbosely."
107 :group 'message
108 :type 'boolean)
109
110(defcustom mml-secure-cache-passphrase password-cache
111 "If t, cache passphrase."
112 :group 'message
113 :type 'boolean)
114
115(defcustom mml-secure-passphrase-cache-expiry password-cache-expiry
116 "How many seconds the passphrase is cached.
117Whether the passphrase is cached at all is controlled by
118`mml-secure-cache-passphrase'."
119 :group 'message
120 :type 'integer)
121
99;;; Configuration/helper functions 122;;; Configuration/helper functions
100 123
101(defun mml-signencrypt-style (method &optional style) 124(defun mml-signencrypt-style (method &optional style)
@@ -249,6 +272,13 @@ Use METHOD if given. Else use `mml-secure-method' or
249;; defuns that add the proper <#secure ...> tag to the top of the message body 272;; defuns that add the proper <#secure ...> tag to the top of the message body
250(defun mml-secure-message (method &optional modesym) 273(defun mml-secure-message (method &optional modesym)
251 (let ((mode (prin1-to-string modesym)) 274 (let ((mode (prin1-to-string modesym))
275 (tags (append
276 (if (or (eq modesym 'sign)
277 (eq modesym 'signencrypt))
278 (funcall (nth 2 (assoc method mml-sign-alist))))
279 (if (or (eq modesym 'encrypt)
280 (eq modesym 'signencrypt))
281 (funcall (nth 2 (assoc method mml-encrypt-alist))))))
252 insert-loc) 282 insert-loc)
253 (mml-unsecure-message) 283 (mml-unsecure-message)
254 (save-excursion 284 (save-excursion
@@ -257,8 +287,8 @@ Use METHOD if given. Else use `mml-secure-method' or
257 (concat "^" (regexp-quote mail-header-separator) "\n") nil t) 287 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
258 (goto-char (setq insert-loc (match-end 0))) 288 (goto-char (setq insert-loc (match-end 0)))
259 (unless (looking-at "<#secure") 289 (unless (looking-at "<#secure")
260 (mml-insert-tag 290 (apply 'mml-insert-tag
261 'secure 'method method 'mode mode))) 291 'secure 'method method 'mode mode tags)))
262 (t (error 292 (t (error
263 "The message is corrupted. No mail header separator")))) 293 "The message is corrupted. No mail header separator"))))
264 (when (eql insert-loc (point)) 294 (when (eql insert-loc (point))
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 3762c2303b3..c00ac416b8b 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -31,10 +31,82 @@
31 31
32(require 'smime) 32(require 'smime)
33(require 'mm-decode) 33(require 'mm-decode)
34(require 'mml-sec)
34(autoload 'message-narrow-to-headers "message") 35(autoload 'message-narrow-to-headers "message")
35(autoload 'message-fetch-field "message") 36(autoload 'message-fetch-field "message")
36 37
38(defvar mml-smime-use 'openssl)
39
40(defvar mml-smime-function-alist
41 '((openssl mml-smime-openssl-sign
42 mml-smime-openssl-encrypt
43 mml-smime-openssl-sign-query
44 mml-smime-openssl-encrypt-query
45 mml-smime-openssl-verify
46 mml-smime-openssl-verify-test)
47 (epg mml-smime-epg-sign
48 mml-smime-epg-encrypt
49 nil
50 nil
51 mml-smime-epg-verify
52 mml-smime-epg-verify-test)))
53
54(defcustom mml-smime-verbose mml-secure-verbose
55 "If non-nil, ask the user about the current operation more verbosely."
56 :group 'mime-security
57 :type 'boolean)
58
59(defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase
60 "If t, cache passphrase."
61 :group 'mime-security
62 :type 'boolean)
63
64(defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
65 "How many seconds the passphrase is cached.
66Whether the passphrase is cached at all is controlled by
67`mml-smime-cache-passphrase'."
68 :group 'mime-security
69 :type 'integer)
70
71(defcustom mml-smime-signers nil
72 "A list of your own key ID which will be used to sign a message."
73 :group 'mime-security
74 :type '(repeat (string :tag "Key ID")))
75
37(defun mml-smime-sign (cont) 76(defun mml-smime-sign (cont)
77 (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))
78 (if func
79 (funcall func cont)
80 (error "Cannot find sign function"))))
81
82(defun mml-smime-encrypt (cont)
83 (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist))))
84 (if func
85 (funcall func cont)
86 (error "Cannot find encrypt function"))))
87
88(defun mml-smime-sign-query ()
89 (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist))))
90 (if func
91 (funcall func))))
92
93(defun mml-smime-encrypt-query ()
94 (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist))))
95 (if func
96 (funcall func))))
97
98(defun mml-smime-verify (handle ctl)
99 (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist))))
100 (if func
101 (funcall func handle ctl)
102 handle)))
103
104(defun mml-smime-verify-test (handle ctl)
105 (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist))))
106 (if func
107 (funcall func handle ctl))))
108
109(defun mml-smime-openssl-sign (cont)
38 (when (null smime-keys) 110 (when (null smime-keys)
39 (customize-variable 'smime-keys) 111 (customize-variable 'smime-keys)
40 (error "No S/MIME keys configured, use customize to add your key")) 112 (error "No S/MIME keys configured, use customize to add your key"))
@@ -44,7 +116,7 @@
44 (replace-match "\n" t t)) 116 (replace-match "\n" t t))
45 (goto-char (point-max))) 117 (goto-char (point-max)))
46 118
47(defun mml-smime-encrypt (cont) 119(defun mml-smime-openssl-encrypt (cont)
48 (let (certnames certfiles tmp file tmpfiles) 120 (let (certnames certfiles tmp file tmpfiles)
49 ;; xxx tmp files are always an security issue 121 ;; xxx tmp files are always an security issue
50 (while (setq tmp (pop cont)) 122 (while (setq tmp (pop cont))
@@ -70,7 +142,7 @@
70 nil)) 142 nil))
71 (goto-char (point-max))) 143 (goto-char (point-max)))
72 144
73(defun mml-smime-sign-query () 145(defun mml-smime-openssl-sign-query ()
74 ;; query information (what certificate) from user when MML tag is 146 ;; query information (what certificate) from user when MML tag is
75 ;; added, for use later by the signing process 147 ;; added, for use later by the signing process
76 (when (null smime-keys) 148 (when (null smime-keys)
@@ -123,22 +195,42 @@
123 (quit)) 195 (quit))
124 result)) 196 result))
125 197
126(defun mml-smime-encrypt-query () 198(defun mml-smime-get-ldap-cert ()
127 ;; todo: add ldap support (xemacs ldap api?) 199 ;; todo: deal with comma separated multiple recipients
200 (let (result who bad cert)
201 (condition-case ()
202 (while (not result)
203 (setq who (read-from-minibuffer
204 (format "%sLookup certificate for: " (or bad ""))
205 (cadr (funcall gnus-extract-address-components
206 (or (save-excursion
207 (save-restriction
208 (message-narrow-to-headers)
209 (message-fetch-field "to")))
210 "")))))
211 (if (setq cert (smime-cert-by-ldap who))
212 (setq result (list 'certfile (buffer-name cert)))
213 (setq bad (format "`%s' not found. " who))))
214 (quit))
215 result))
216
217(defun mml-smime-openssl-encrypt-query ()
128 ;; todo: try dns/ldap automatically first, before prompting user 218 ;; todo: try dns/ldap automatically first, before prompting user
129 (let (certs done) 219 (let (certs done)
130 (while (not done) 220 (while (not done)
131 (ecase (read (gnus-completing-read-with-default 221 (ecase (read (gnus-completing-read-with-default
132 "dns" "Fetch certificate from" 222 "ldap" "Fetch certificate from"
133 '(("dns") ("file")) nil t)) 223 '(("dns") ("ldap") ("file")) nil t))
134 (dns (setq certs (append certs 224 (dns (setq certs (append certs
135 (mml-smime-get-dns-cert)))) 225 (mml-smime-get-dns-cert))))
226 (ldap (setq certs (append certs
227 (mml-smime-get-ldap-cert))))
136 (file (setq certs (append certs 228 (file (setq certs (append certs
137 (mml-smime-get-file-cert))))) 229 (mml-smime-get-file-cert)))))
138 (setq done (not (y-or-n-p "Add more recipients? ")))) 230 (setq done (not (y-or-n-p "Add more recipients? "))))
139 certs)) 231 certs))
140 232
141(defun mml-smime-verify (handle ctl) 233(defun mml-smime-openssl-verify (handle ctl)
142 (with-temp-buffer 234 (with-temp-buffer
143 (insert-buffer-substring (mm-handle-multipart-original-buffer ctl)) 235 (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
144 (goto-char (point-min)) 236 (goto-char (point-min))
@@ -203,9 +295,249 @@
203 (buffer-string) "\n"))))) 295 (buffer-string) "\n")))))
204 handle) 296 handle)
205 297
206(defun mml-smime-verify-test (handle ctl) 298(defun mml-smime-openssl-verify-test (handle ctl)
207 smime-openssl-program) 299 smime-openssl-program)
208 300
301(eval-and-compile
302 (autoload 'epg-make-context "epg"))
303
304(eval-when-compile
305 (defvar epg-user-id-alist)
306 (defvar epg-digest-algorithm-alist)
307 (defvar inhibit-redisplay)
308 (autoload 'epg-context-set-armor "epg")
309 (autoload 'epg-context-set-signers "epg")
310 (autoload 'epg-context-result-for "epg")
311 (autoload 'epg-new-signature-digest-algorithm "epg")
312 (autoload 'epg-verify-result-to-string "epg")
313 (autoload 'epg-list-keys "epg")
314 (autoload 'epg-decrypt-string "epg")
315 (autoload 'epg-verify-string "epg")
316 (autoload 'epg-sign-string "epg")
317 (autoload 'epg-encrypt-string "epg")
318 (autoload 'epg-passphrase-callback-function "epg")
319 (autoload 'epg-context-set-passphrase-callback "epg")
320 (autoload 'epg-configuration "epg-config")
321 (autoload 'epg-expand-group "epg-config")
322 (autoload 'epa-select-keys "epa"))
323
324(eval-when-compile
325 (defvar password-cache-expiry)
326 (autoload 'password-read "password")
327 (autoload 'password-cache-add "password")
328 (autoload 'password-cache-remove "password"))
329
330(defvar mml-smime-epg-secret-key-id-list nil)
331
332(defun mml-smime-epg-passphrase-callback (context key-id ignore)
333 (if (eq key-id 'SYM)
334 (epg-passphrase-callback-function context key-id nil)
335 (let* (entry
336 (passphrase
337 (password-read
338 (if (eq key-id 'PIN)
339 "Passphrase for PIN: "
340 (if (setq entry (assoc key-id epg-user-id-alist))
341 (format "Passphrase for %s %s: " key-id (cdr entry))
342 (format "Passphrase for %s: " key-id)))
343 (if (eq key-id 'PIN)
344 "PIN"
345 key-id))))
346 (when passphrase
347 (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
348 (password-cache-add key-id passphrase))
349 (setq mml-smime-epg-secret-key-id-list
350 (cons key-id mml-smime-epg-secret-key-id-list))
351 (copy-sequence passphrase)))))
352
353(defun mml-smime-epg-find-usable-key (keys usage)
354 (catch 'found
355 (while keys
356 (let ((pointer (epg-key-sub-key-list (car keys))))
357 (while pointer
358 (if (and (memq usage (epg-sub-key-capability (car pointer)))
359 (not (memq (epg-sub-key-validity (car pointer))
360 '(revoked expired))))
361 (throw 'found (car keys)))
362 (setq pointer (cdr pointer))))
363 (setq keys (cdr keys)))))
364
365(defun mml-smime-epg-sign (cont)
366 (let* ((inhibit-redisplay t)
367 (context (epg-make-context 'CMS))
368 (boundary (mml-compute-boundary cont))
369 signer-key
370 (signers
371 (or (message-options-get 'mml-smime-epg-signers)
372 (message-options-set
373 'mml-smime-epg-signers
374 (if mml-smime-verbose
375 (epa-select-keys context "\
376Select keys for signing.
377If no one is selected, default secret key is used. "
378 mml-smime-signers t)
379 (if mml-smime-signers
380 (mapcar
381 (lambda (signer)
382 (setq signer-key (mml-smime-epg-find-usable-key
383 (epg-list-keys context signer t)
384 'sign))
385 (unless (or signer-key
386 (y-or-n-p
387 (format "No secret key for %s; skip it? "
388 signer)))
389 (error "No secret key for %s" signer))
390 signer-key)
391 mml-smime-signers))))))
392 signature micalg)
393 (epg-context-set-signers context signers)
394 (if mml-smime-cache-passphrase
395 (epg-context-set-passphrase-callback
396 context
397 #'mml-smime-epg-passphrase-callback))
398 (condition-case error
399 (setq signature (epg-sign-string context
400 (mm-replace-in-string (buffer-string)
401 "\n" "\r\n")
402 t)
403 mml-smime-epg-secret-key-id-list nil)
404 (error
405 (while mml-smime-epg-secret-key-id-list
406 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
407 (setq mml-smime-epg-secret-key-id-list
408 (cdr mml-smime-epg-secret-key-id-list)))
409 (signal (car error) (cdr error))))
410 (if (epg-context-result-for context 'sign)
411 (setq micalg (epg-new-signature-digest-algorithm
412 (car (epg-context-result-for context 'sign)))))
413 (goto-char (point-min))
414 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
415 boundary))
416 (if micalg
417 (insert (format "\tmicalg=%s; "
418 (downcase
419 (cdr (assq micalg
420 epg-digest-algorithm-alist))))))
421 (insert "protocol=\"application/pkcs7-signature\"\n")
422 (insert (format "\n--%s\n" boundary))
423 (goto-char (point-max))
424 (insert (format "\n--%s\n" boundary))
425 (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
426Content-Transfer-Encoding: base64
427Content-Disposition: attachment; filename=smime.p7s
428
429")
430 (insert (base64-encode-string signature) "\n")
431 (goto-char (point-max))
432 (insert (format "--%s--\n" boundary))
433 (goto-char (point-max))))
434
435(defun mml-smime-epg-encrypt (cont)
436 (let ((inhibit-redisplay t)
437 (context (epg-make-context 'CMS))
438 (config (epg-configuration))
439 (recipients (message-options-get 'mml-smime-epg-recipients))
440 cipher signers
441 (boundary (mml-compute-boundary cont))
442 recipient-key)
443 (unless recipients
444 (setq recipients
445 (apply #'nconc
446 (mapcar
447 (lambda (recipient)
448 (or (epg-expand-group config recipient)
449 (list recipient)))
450 (split-string
451 (or (message-options-get 'message-recipients)
452 (message-options-set 'message-recipients
453 (read-string "Recipients: ")))
454 "[ \f\t\n\r\v,]+"))))
455 (if mml-smime-verbose
456 (setq recipients
457 (epa-select-keys context "\
458Select recipients for encryption.
459If no one is selected, symmetric encryption will be performed. "
460 recipients))
461 (setq recipients
462 (mapcar
463 (lambda (recipient)
464 (setq recipient-key (mml-smime-epg-find-usable-key
465 (epg-list-keys context recipient)
466 'encrypt))
467 (unless (or recipient-key
468 (y-or-n-p
469 (format "No public key for %s; skip it? "
470 recipient)))
471 (error "No public key for %s" recipient))
472 recipient-key)
473 recipients))
474 (unless recipients
475 (error "No recipient specified")))
476 (message-options-set 'mml-smime-epg-recipients recipients))
477 (if mml-smime-cache-passphrase
478 (epg-context-set-passphrase-callback
479 context
480 #'mml-smime-epg-passphrase-callback))
481 (condition-case error
482 (setq cipher
483 (epg-encrypt-string context (buffer-string) recipients)
484 mml-smime-epg-secret-key-id-list nil)
485 (error
486 (while mml-smime-epg-secret-key-id-list
487 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
488 (setq mml-smime-epg-secret-key-id-list
489 (cdr mml-smime-epg-secret-key-id-list)))
490 (signal (car error) (cdr error))))
491 (delete-region (point-min) (point-max))
492 (goto-char (point-min))
493 (insert "\
494Content-Type: application/pkcs7-mime;
495 smime-type=enveloped-data;
496 name=smime.p7m
497Content-Transfer-Encoding: base64
498Content-Disposition: attachment; filename=smime.p7m
499
500")
501 (insert (base64-encode-string cipher))
502 (goto-char (point-max))))
503
504(defun mml-smime-epg-verify (handle ctl)
505 (catch 'error
506 (let ((inhibit-redisplay t)
507 context plain signature-file part signature)
508 (when (or (null (setq part (mm-find-raw-part-by-type
509 ctl (or (mm-handle-multipart-ctl-parameter
510 ctl 'protocol)
511 "application/pkcs7-signature")
512 t)))
513 (null (setq signature (mm-find-part-by-type
514 (cdr handle)
515 "application/pkcs7-signature"
516 nil t))))
517 (mm-set-handle-multipart-parameter
518 mm-security-handle 'gnus-info "Corrupted")
519 (throw 'error handle))
520 (setq part (mm-replace-in-string part "\n" "\r\n" t)
521 context (epg-make-context 'CMS))
522 (condition-case error
523 (setq plain (epg-verify-string context (mm-get-part signature) part))
524 (error
525 (mm-set-handle-multipart-parameter
526 mm-security-handle 'gnus-info "Failed")
527 (if (eq (car error) 'quit)
528 (mm-set-handle-multipart-parameter
529 mm-security-handle 'gnus-details "Quit.")
530 (mm-set-handle-multipart-parameter
531 mm-security-handle 'gnus-details (format "%S" error)))
532 (throw 'error handle)))
533 (mm-set-handle-multipart-parameter
534 mm-security-handle 'gnus-info
535 (epg-verify-result-to-string (epg-context-result-for context 'verify)))
536 handle)))
537
538(defun mml-smime-epg-verify-test (handle ctl)
539 t)
540
209(provide 'mml-smime) 541(provide 'mml-smime)
210 542
211;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2 543;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 0c60bed409f..6657414f2db 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -35,9 +35,9 @@
35(eval-and-compile 35(eval-and-compile
36 (autoload 'message-make-message-id "message") 36 (autoload 'message-make-message-id "message")
37 (autoload 'gnus-setup-posting-charset "gnus-msg") 37 (autoload 'gnus-setup-posting-charset "gnus-msg")
38 (autoload 'gnus-add-minor-mode "gnus-ems")
39 (autoload 'gnus-make-local-hook "gnus-util") 38 (autoload 'gnus-make-local-hook "gnus-util")
40 (autoload 'message-fetch-field "message") 39 (autoload 'message-fetch-field "message")
40 (autoload 'message-mark-active-p "message")
41 (autoload 'message-info "message") 41 (autoload 'message-info "message")
42 (autoload 'fill-flowed-encode "flow-fill") 42 (autoload 'fill-flowed-encode "flow-fill")
43 (autoload 'message-posting-charset "message") 43 (autoload 'message-posting-charset "message")
@@ -70,6 +70,46 @@ These parameters are generated in Content-Disposition header if exists."
70 :type '(repeat (symbol :tag "Parameter")) 70 :type '(repeat (symbol :tag "Parameter"))
71 :group 'message) 71 :group 'message)
72 72
73(defcustom mml-content-disposition-alist
74 '((text (rtf . "attachment") (t . "inline"))
75 (t . "attachment"))
76 "Alist of MIME types or regexps matching file names and default dispositions.
77Each element should be one of the following three forms:
78
79 (REGEXP . DISPOSITION)
80 (SUPERTYPE (SUBTYPE . DISPOSITION) (SUBTYPE . DISPOSITION)...)
81 (TYPE . DISPOSITION)
82
83Where REGEXP is a string which matches the file name (if any) of an
84attachment, SUPERTYPE, SUBTYPE and TYPE should be symbols which are a
85MIME supertype (e.g., text), a MIME subtype (e.g., plain) and a MIME
86type (e.g., text/plain) respectively, and DISPOSITION should be either
87the string \"attachment\" or the string \"inline\". The value t for
88SUPERTYPE, SUBTYPE or TYPE matches any of those types. The first
89match found will be used."
90 :version "23.0" ;; No Gnus
91 :type (let ((dispositions '(radio :format "DISPOSITION: %v"
92 :value "attachment"
93 (const :format "%v " "attachment")
94 (const :format "%v\n" "inline"))))
95 `(repeat
96 :offset 0
97 (choice :format "%[Value Menu%]%v"
98 (cons :tag "(REGEXP . DISPOSITION)" :extra-offset 4
99 (regexp :tag "REGEXP" :value ".*")
100 ,dispositions)
101 (cons :tag "(SUPERTYPE (SUBTYPE . DISPOSITION)...)"
102 :indent 0
103 (symbol :tag " SUPERTYPE" :value text)
104 (repeat :format "%v%i\n" :offset 0 :extra-offset 4
105 (cons :format "%v" :extra-offset 5
106 (symbol :tag "SUBTYPE" :value t)
107 ,dispositions)))
108 (cons :tag "(TYPE . DISPOSITION)" :extra-offset 4
109 (symbol :tag "TYPE" :value t)
110 ,dispositions))))
111 :group 'message)
112
73(defcustom mml-insert-mime-headers-always nil 113(defcustom mml-insert-mime-headers-always nil
74 "If non-nil, always put Content-Type: text/plain at top of empty parts. 114 "If non-nil, always put Content-Type: text/plain at top of empty parts.
75It is necessary to work against a bug in certain clients." 115It is necessary to work against a bug in certain clients."
@@ -154,19 +194,15 @@ part. This is for the internal use, you should never modify the value.")
154 194
155(defun mml-destroy-buffers () 195(defun mml-destroy-buffers ()
156 (let (kill-buffer-hook) 196 (let (kill-buffer-hook)
157 (mapcar 'kill-buffer mml-buffer-list) 197 (mapc 'kill-buffer mml-buffer-list)
158 (setq mml-buffer-list nil))) 198 (setq mml-buffer-list nil)))
159 199
160(defun mml-parse () 200(defun mml-parse ()
161 "Parse the current buffer as an MML document." 201 "Parse the current buffer as an MML document."
162 (save-excursion 202 (save-excursion
163 (goto-char (point-min)) 203 (goto-char (point-min))
164 (let ((table (syntax-table))) 204 (with-syntax-table mml-syntax-table
165 (unwind-protect 205 (mml-parse-1))))
166 (progn
167 (set-syntax-table mml-syntax-table)
168 (mml-parse-1))
169 (set-syntax-table table)))))
170 206
171(defun mml-parse-1 () 207(defun mml-parse-1 ()
172 "Parse the current buffer as an MML document." 208 "Parse the current buffer as an MML document."
@@ -181,6 +217,8 @@ part. This is for the internal use, you should never modify the value.")
181 ;; included in the message 217 ;; included in the message
182 (let* (secure-mode 218 (let* (secure-mode
183 (taginfo (mml-read-tag)) 219 (taginfo (mml-read-tag))
220 (keyfile (cdr (assq 'keyfile taginfo)))
221 (certfile (cdr (assq 'certfile taginfo)))
184 (recipients (cdr (assq 'recipients taginfo))) 222 (recipients (cdr (assq 'recipients taginfo)))
185 (sender (cdr (assq 'sender taginfo))) 223 (sender (cdr (assq 'sender taginfo)))
186 (location (cdr (assq 'tag-location taginfo))) 224 (location (cdr (assq 'tag-location taginfo)))
@@ -188,9 +226,8 @@ part. This is for the internal use, you should never modify the value.")
188 (method (cdr (assq 'method taginfo))) 226 (method (cdr (assq 'method taginfo)))
189 tags) 227 tags)
190 (save-excursion 228 (save-excursion
191 (if 229 (if (re-search-forward
192 (re-search-forward 230 "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t)
193 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
194 (setq secure-mode "multipart") 231 (setq secure-mode "multipart")
195 (setq secure-mode "part"))) 232 (setq secure-mode "part")))
196 (save-excursion 233 (save-excursion
@@ -205,6 +242,10 @@ part. This is for the internal use, you should never modify the value.")
205 (setq tags (list "sign" method "encrypt" method)))) 242 (setq tags (list "sign" method "encrypt" method))))
206 (eval `(mml-insert-tag ,secure-mode 243 (eval `(mml-insert-tag ,secure-mode
207 ,@tags 244 ,@tags
245 ,(if keyfile "keyfile")
246 ,keyfile
247 ,(if certfile "certfile")
248 ,certfile
208 ,(if recipients "recipients") 249 ,(if recipients "recipients")
209 ,recipients 250 ,recipients
210 ,(if sender "sender") 251 ,(if sender "sender")
@@ -427,21 +468,24 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
427 (or (mm-default-file-encoding filename) 468 (or (mm-default-file-encoding filename)
428 "application/octet-stream") 469 "application/octet-stream")
429 "text/plain"))) 470 "text/plain")))
430 coded encoding charset flowed) 471 (charset (cdr (assq 'charset cont)))
472 (coding (mm-charset-to-coding-system charset))
473 encoding flowed coded)
474 (cond ((eq coding 'ascii)
475 (setq charset nil
476 coding nil))
477 (charset
478 (setq charset (intern (downcase charset)))))
431 (if (and (not raw) 479 (if (and (not raw)
432 (member (car (split-string type "/")) '("text" "message"))) 480 (member (car (split-string type "/")) '("text" "message")))
433 (progn 481 (progn
434 (with-temp-buffer 482 (with-temp-buffer
435 (setq charset (mm-charset-to-coding-system
436 (cdr (assq 'charset cont))))
437 (when (eq charset 'ascii)
438 (setq charset nil))
439 (cond 483 (cond
440 ((cdr (assq 'buffer cont)) 484 ((cdr (assq 'buffer cont))
441 (insert-buffer-substring (cdr (assq 'buffer cont)))) 485 (insert-buffer-substring (cdr (assq 'buffer cont))))
442 ((and filename 486 ((and filename
443 (not (equal (cdr (assq 'nofile cont)) "yes"))) 487 (not (equal (cdr (assq 'nofile cont)) "yes")))
444 (let ((coding-system-for-read charset)) 488 (let ((coding-system-for-read coding))
445 (mm-insert-file-contents filename))) 489 (mm-insert-file-contents filename)))
446 ((eq 'mml (car cont)) 490 ((eq 'mml (car cont))
447 (insert (cdr (assq 'contents cont)))) 491 (insert (cdr (assq 'contents cont))))
@@ -491,7 +535,13 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
491 ;; insert a "; format=flowed" string unless the 535 ;; insert a "; format=flowed" string unless the
492 ;; user has already specified it. 536 ;; user has already specified it.
493 (setq flowed (null (assq 'format cont))))) 537 (setq flowed (null (assq 'format cont)))))
494 (setq charset (mm-encode-body charset)) 538 ;; Prefer `utf-8' for text/calendar parts.
539 (if (or charset
540 (not (string= type "text/calendar")))
541 (setq charset (mm-encode-body charset))
542 (let ((mm-coding-system-priorities
543 (cons 'utf-8 mm-coding-system-priorities)))
544 (setq charset (mm-encode-body))))
495 (setq encoding (mm-body-encoding 545 (setq encoding (mm-body-encoding
496 charset (cdr (assq 'encoding cont)))))) 546 charset (cdr (assq 'encoding cont))))))
497 (setq coded (buffer-string))) 547 (setq coded (buffer-string)))
@@ -507,7 +557,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
507 ((and filename 557 ((and filename
508 (not (equal (cdr (assq 'nofile cont)) "yes"))) 558 (not (equal (cdr (assq 'nofile cont)) "yes")))
509 (let ((coding-system-for-read mm-binary-coding-system)) 559 (let ((coding-system-for-read mm-binary-coding-system))
510 (mm-insert-file-contents filename nil nil nil nil t))) 560 (mm-insert-file-contents filename nil nil nil nil t))
561 (unless charset
562 (setq charset (mm-coding-system-to-mime-charset
563 (mm-find-buffer-file-coding-system
564 filename)))))
511 (t 565 (t
512 (let ((contents (cdr (assq 'contents cont)))) 566 (let ((contents (cdr (assq 'contents cont))))
513 (if (if (featurep 'xemacs) 567 (if (if (featurep 'xemacs)
@@ -517,7 +571,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
517 (mm-enable-multibyte) 571 (mm-enable-multibyte)
518 (insert contents) 572 (insert contents)
519 (unless raw 573 (unless raw
520 (setq charset (mm-encode-body)))) 574 (setq charset (mm-encode-body charset))))
521 (insert contents))))) 575 (insert contents)))))
522 (setq encoding (mm-encode-buffer type) 576 (setq encoding (mm-encode-buffer type)
523 coded (mm-string-as-multibyte (buffer-string)))) 577 coded (mm-string-as-multibyte (buffer-string))))
@@ -648,7 +702,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
648 (incf mml-multipart-number))) 702 (incf mml-multipart-number)))
649 (throw 'not-unique nil)))) 703 (throw 'not-unique nil))))
650 ((eq (car cont) 'multipart) 704 ((eq (car cont) 'multipart)
651 (mapcar 'mml-compute-boundary-1 (cddr cont)))) 705 (mapc 'mml-compute-boundary-1 (cddr cont))))
652 t)) 706 t))
653 707
654(defun mml-make-boundary (number) 708(defun mml-make-boundary (number)
@@ -658,6 +712,30 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
658 "") 712 "")
659 mml-base-boundary)) 713 mml-base-boundary))
660 714
715(defun mml-content-disposition (type &optional filename)
716 "Return a default disposition name suitable to TYPE or FILENAME."
717 (let ((defs mml-content-disposition-alist)
718 disposition def types)
719 (while (and (not disposition) defs)
720 (setq def (pop defs))
721 (cond ((stringp (car def))
722 (when (and filename
723 (string-match (car def) filename))
724 (setq disposition (cdr def))))
725 ((consp (cdr def))
726 (when (string= (car (setq types (split-string type "/")))
727 (car def))
728 (setq type (cadr types)
729 types (cdr def))
730 (while (and (not disposition) types)
731 (setq def (pop types))
732 (when (or (eq (car def) t) (string= type (car def)))
733 (setq disposition (cdr def))))))
734 (t
735 (when (or (eq (car def) t) (string= type (car def)))
736 (setq disposition (cdr def))))))
737 (or disposition "attachment")))
738
661(defun mml-insert-mime-headers (cont type charset encoding flowed) 739(defun mml-insert-mime-headers (cont type charset encoding flowed)
662 (let (parameters id disposition description) 740 (let (parameters id disposition description)
663 (setq parameters 741 (setq parameters
@@ -688,7 +766,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
688 cont mml-content-disposition-parameters)) 766 cont mml-content-disposition-parameters))
689 (when (or (setq disposition (cdr (assq 'disposition cont))) 767 (when (or (setq disposition (cdr (assq 'disposition cont)))
690 parameters) 768 parameters)
691 (insert "Content-Disposition: " (or disposition "inline")) 769 (insert "Content-Disposition: "
770 (or disposition
771 (mml-content-disposition type (cdr (assq 'filename cont)))))
692 (when parameters 772 (when parameters
693 (mml-insert-parameter-string 773 (mml-insert-parameter-string
694 cont mml-content-disposition-parameters)) 774 cont mml-content-disposition-parameters))
@@ -809,7 +889,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer."
809 (goto-char (point-max)) 889 (goto-char (point-max))
810 (insert "<#/mml>\n")) 890 (insert "<#/mml>\n"))
811 ((stringp (car handle)) 891 ((stringp (car handle))
812 (mapcar 'mml-insert-mime (cdr handle)) 892 (mapc 'mml-insert-mime (cdr handle))
813 (insert "<#/multipart>\n")) 893 (insert "<#/multipart>\n"))
814 (textp 894 (textp
815 (let ((charset (mail-content-type-get 895 (let ((charset (mail-content-type-get
@@ -1004,9 +1084,18 @@ See Info node `(emacs-mime)Composing'.
1004;;; inserting stuff to the buffer. 1084;;; inserting stuff to the buffer.
1005;;; 1085;;;
1006 1086
1087(defcustom mml-default-directory mm-default-directory
1088 "The default directory where mml will find files.
1089If not set, `default-directory' will be used."
1090 :type '(choice directory (const :tag "Default" nil))
1091 :version "23.0" ;; No Gnus
1092 :group 'message)
1093
1007(defun mml-minibuffer-read-file (prompt) 1094(defun mml-minibuffer-read-file (prompt)
1008 (let* ((completion-ignored-extensions nil) 1095 (let* ((completion-ignored-extensions nil)
1009 (file (read-file-name prompt nil nil t))) 1096 (file (read-file-name prompt
1097 (or mml-default-directory default-directory)
1098 nil t)))
1010 ;; Prevent some common errors. This is inspired by similar code in 1099 ;; Prevent some common errors. This is inspired by similar code in
1011 ;; VM. 1100 ;; VM.
1012 (when (file-directory-p file) 1101 (when (file-directory-p file)
@@ -1038,16 +1127,13 @@ See Info node `(emacs-mime)Composing'.
1038 (setq description nil)) 1127 (setq description nil))
1039 description)) 1128 description))
1040 1129
1041(defun mml-minibuffer-read-disposition (type &optional default) 1130(defun mml-minibuffer-read-disposition (type &optional default filename)
1042 (unless default (setq default 1131 (unless default
1043 (if (and (string-match "\\`text/" type) 1132 (setq default (mml-content-disposition type filename)))
1044 (not (string-match "\\`text/rtf\\'" type)))
1045 "inline"
1046 "attachment")))
1047 (let ((disposition (completing-read 1133 (let ((disposition (completing-read
1048 (format "Disposition (default %s): " default) 1134 (format "Disposition (default %s): " default)
1049 '(("attachment") ("inline") ("")) 1135 '(("attachment") ("inline") (""))
1050 nil t nil nil default))) 1136 nil t nil nil default)))
1051 (if (not (equal disposition "")) 1137 (if (not (equal disposition ""))
1052 disposition 1138 disposition
1053 default))) 1139 default)))
@@ -1139,7 +1225,7 @@ body) or \"attachment\" (separate from the body)."
1139 (let* ((file (mml-minibuffer-read-file "Attach file: ")) 1225 (let* ((file (mml-minibuffer-read-file "Attach file: "))
1140 (type (mml-minibuffer-read-type file)) 1226 (type (mml-minibuffer-read-type file))
1141 (description (mml-minibuffer-read-description)) 1227 (description (mml-minibuffer-read-description))
1142 (disposition (mml-minibuffer-read-disposition type))) 1228 (disposition (mml-minibuffer-read-disposition type nil file)))
1143 (list file type description disposition))) 1229 (list file type description disposition)))
1144 (save-excursion 1230 (save-excursion
1145 (unless (message-in-body-p) (goto-char (point-max))) 1231 (unless (message-in-body-p) (goto-char (point-max)))
@@ -1170,7 +1256,7 @@ Ask for type, description or disposition according to
1170 (when (memq 'description mml-dnd-attach-options) 1256 (when (memq 'description mml-dnd-attach-options)
1171 (setq description (mml-minibuffer-read-description))) 1257 (setq description (mml-minibuffer-read-description)))
1172 (when (memq 'disposition mml-dnd-attach-options) 1258 (when (memq 'disposition mml-dnd-attach-options)
1173 (setq disposition (mml-minibuffer-read-disposition type))) 1259 (setq disposition (mml-minibuffer-read-disposition type nil file)))
1174 (mml-attach-file file type description disposition))))) 1260 (mml-attach-file file type description disposition)))))
1175 1261
1176(defun mml-attach-buffer (buffer &optional type description) 1262(defun mml-attach-buffer (buffer &optional type description)
@@ -1227,10 +1313,20 @@ Should be adopted if code in `message-send-mail' is changed."
1227 (message-position-on-field "Mail-Followup-To" "X-Draft-From") 1313 (message-position-on-field "Mail-Followup-To" "X-Draft-From")
1228 (insert (message-make-mail-followup-to)))) 1314 (insert (message-make-mail-followup-to))))
1229 1315
1316(defvar mml-preview-buffer nil)
1317
1230(defun mml-preview (&optional raw) 1318(defun mml-preview (&optional raw)
1231 "Display current buffer with Gnus, in a new buffer. 1319 "Display current buffer with Gnus, in a new buffer.
1232If RAW, display a raw encoded MIME message." 1320If RAW, display a raw encoded MIME message.
1321
1322The window layout for the preview buffer is controled by the variables
1323`special-display-buffer-names', `special-display-regexps', or
1324`gnus-buffer-configuration' (the first match made will be used),
1325or the `pop-to-buffer' function."
1233 (interactive "P") 1326 (interactive "P")
1327 (setq mml-preview-buffer (generate-new-buffer
1328 (concat (if raw "*Raw MIME preview of "
1329 "*MIME preview of ") (buffer-name))))
1234 (save-excursion 1330 (save-excursion
1235 (let* ((buf (current-buffer)) 1331 (let* ((buf (current-buffer))
1236 (message-options message-options) 1332 (message-options message-options)
@@ -1242,13 +1338,13 @@ If RAW, display a raw encoded MIME message."
1242 (message-fetch-field "Newsgroups"))) 1338 (message-fetch-field "Newsgroups")))
1243 message-posting-charset))) 1339 message-posting-charset)))
1244 (message-options-set-recipient) 1340 (message-options-set-recipient)
1245 (pop-to-buffer (generate-new-buffer
1246 (concat (if raw "*Raw MIME preview of "
1247 "*MIME preview of ") (buffer-name))))
1248 (when (boundp 'gnus-buffers) 1341 (when (boundp 'gnus-buffers)
1249 (push (current-buffer) gnus-buffers)) 1342 (push mml-preview-buffer gnus-buffers))
1250 (erase-buffer) 1343 (save-restriction
1251 (insert-buffer-substring buf) 1344 (widen)
1345 (set-buffer mml-preview-buffer)
1346 (erase-buffer)
1347 (insert-buffer-substring buf))
1252 (mml-preview-insert-mail-followup-to) 1348 (mml-preview-insert-mail-followup-to)
1253 (let ((message-deletable-headers (if (message-news-p) 1349 (let ((message-deletable-headers (if (message-news-p)
1254 nil 1350 nil
@@ -1261,6 +1357,7 @@ If RAW, display a raw encoded MIME message."
1261 (concat "^" (regexp-quote mail-header-separator) "\n") nil t) 1357 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
1262 (replace-match "\n")) 1358 (replace-match "\n"))
1263 (let ((mail-header-separator ""));; mail-header-separator is removed. 1359 (let ((mail-header-separator ""));; mail-header-separator is removed.
1360 (message-sort-headers)
1264 (mml-to-mime)) 1361 (mml-to-mime))
1265 (if raw 1362 (if raw
1266 (when (fboundp 'set-buffer-multibyte) 1363 (when (fboundp 'set-buffer-multibyte)
@@ -1293,7 +1390,15 @@ If RAW, display a raw encoded MIME message."
1293 (lambda (event) 1390 (lambda (event)
1294 (interactive "@e") 1391 (interactive "@e")
1295 (widget-button-press (widget-event-point event) event))) 1392 (widget-button-press (widget-event-point event) event)))
1296 (goto-char (point-min))))) 1393 ;; FIXME: Buffer is in article mode, but most tool bar commands won't
1394 ;; work. Maybe only keep the following icons: search, print, quit
1395 (goto-char (point-min))))
1396 (if (and (not (mm-special-display-p (buffer-name mml-preview-buffer)))
1397 (boundp 'gnus-buffer-configuration)
1398 (assq 'mml-preview gnus-buffer-configuration))
1399 (let ((gnus-message-buffer (current-buffer)))
1400 (gnus-configure-windows 'mml-preview))
1401 (pop-to-buffer mml-preview-buffer)))
1297 1402
1298(defun mml-validate () 1403(defun mml-validate ()
1299 "Validate the current MML document." 1404 "Validate the current MML document."
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 104fb9cfaa3..f6d2dcc7ad5 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -3,7 +3,7 @@
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007 Free Software Foundation, Inc. 4;; 2005, 2006, 2007 Free Software Foundation, Inc.
5 5
6;; Author: Sascha Lüdecke <sascha@meta-x.de>, 6;; Author: Sascha Ldecke <sascha@meta-x.de>,
7;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue) 7;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
8;; Keywords PGP 8;; Keywords PGP
9 9
@@ -32,6 +32,8 @@
32 (require 'cl) 32 (require 'cl)
33 (require 'mm-util)) 33 (require 'mm-util))
34 34
35(require 'mml-sec)
36
35(defvar mc-pgp-always-sign) 37(defvar mc-pgp-always-sign)
36 38
37(autoload 'quoted-printable-decode-region "qp") 39(autoload 'quoted-printable-decode-region "qp")
@@ -46,9 +48,28 @@
46 (gpg mml1991-gpg-sign 48 (gpg mml1991-gpg-sign
47 mml1991-gpg-encrypt) 49 mml1991-gpg-encrypt)
48 (pgg mml1991-pgg-sign 50 (pgg mml1991-pgg-sign
49 mml1991-pgg-encrypt)) 51 mml1991-pgg-encrypt)
52 (epg mml1991-epg-sign
53 mml1991-epg-encrypt))
50 "Alist of PGP functions.") 54 "Alist of PGP functions.")
51 55
56(defvar mml1991-verbose mml-secure-verbose
57 "If non-nil, ask the user about the current operation more verbosely.")
58
59(defvar mml1991-cache-passphrase mml-secure-cache-passphrase
60 "If t, cache passphrase.")
61
62(defvar mml1991-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
63 "How many seconds the passphrase is cached.
64Whether the passphrase is cached at all is controlled by
65`mml1991-cache-passphrase'.")
66
67(defvar mml1991-signers nil
68 "A list of your own key ID which will be used to sign a message.")
69
70(defvar mml1991-encrypt-to-self nil
71 "If t, add your own key ID to recipient list when encryption.")
72
52;;; mailcrypt wrapper 73;;; mailcrypt wrapper
53 74
54(eval-and-compile 75(eval-and-compile
@@ -290,6 +311,183 @@
290 (insert-buffer-substring pgg-output-buffer) 311 (insert-buffer-substring pgg-output-buffer)
291 t) 312 t)
292 313
314;; epg wrapper
315
316(eval-and-compile
317 (autoload 'epg-make-context "epg"))
318
319(eval-when-compile
320 (defvar epg-user-id-alist)
321 (autoload 'epg-passphrase-callback-function "epg")
322 (autoload 'epa-select-keys "epa")
323 (autoload 'epg-list-keys "epg")
324 (autoload 'epg-context-set-armor "epg")
325 (autoload 'epg-context-set-textmode "epg")
326 (autoload 'epg-context-set-signers "epg")
327 (autoload 'epg-context-set-passphrase-callback "epg")
328 (autoload 'epg-sign-string "epg")
329 (autoload 'epg-encrypt-string "epg")
330 (autoload 'epg-configuration "epg-config")
331 (autoload 'epg-expand-group "epg-config"))
332
333(eval-when-compile
334 (defvar password-cache-expiry)
335 (autoload 'password-read "password")
336 (autoload 'password-cache-add "password")
337 (autoload 'password-cache-remove "password"))
338
339(defvar mml1991-epg-secret-key-id-list nil)
340
341(defun mml1991-epg-passphrase-callback (context key-id ignore)
342 (if (eq key-id 'SYM)
343 (epg-passphrase-callback-function context key-id nil)
344 (let* ((entry (assoc key-id epg-user-id-alist))
345 (passphrase
346 (password-read
347 (format "GnuPG passphrase for %s: "
348 (if entry
349 (cdr entry)
350 key-id))
351 (if (eq key-id 'PIN)
352 "PIN"
353 key-id))))
354 (when passphrase
355 (let ((password-cache-expiry mml1991-passphrase-cache-expiry))
356 (password-cache-add key-id passphrase))
357 (setq mml1991-epg-secret-key-id-list
358 (cons key-id mml1991-epg-secret-key-id-list))
359 (copy-sequence passphrase)))))
360
361(defun mml1991-epg-sign (cont)
362 (let ((context (epg-make-context))
363 headers cte signers signature)
364 (if mml1991-verbose
365 (setq signers (epa-select-keys context "Select keys for signing.
366If no one is selected, default secret key is used. "
367 mml1991-signers t))
368 (if mml1991-signers
369 (setq signers (mapcar (lambda (name)
370 (car (epg-list-keys context name t)))
371 mml1991-signers))))
372 (epg-context-set-armor context t)
373 (epg-context-set-textmode context t)
374 (epg-context-set-signers context signers)
375 (if mml1991-cache-passphrase
376 (epg-context-set-passphrase-callback
377 context
378 #'mml1991-epg-passphrase-callback))
379 ;; Don't sign headers.
380 (goto-char (point-min))
381 (when (re-search-forward "^$" nil t)
382 (setq headers (buffer-substring (point-min) (point)))
383 (save-restriction
384 (narrow-to-region (point-min) (point))
385 (setq cte (mail-fetch-field "content-transfer-encoding")))
386 (forward-line 1)
387 (delete-region (point-min) (point))
388 (when cte
389 (setq cte (intern (downcase cte)))
390 (mm-decode-content-transfer-encoding cte)))
391 (condition-case error
392 (setq signature (epg-sign-string context (buffer-string) 'clear)
393 mml1991-epg-secret-key-id-list nil)
394 (error
395 (while mml1991-epg-secret-key-id-list
396 (password-cache-remove (car mml1991-epg-secret-key-id-list))
397 (setq mml1991-epg-secret-key-id-list
398 (cdr mml1991-epg-secret-key-id-list)))
399 (signal (car error) (cdr error))))
400 (delete-region (point-min) (point-max))
401 (mm-with-unibyte-current-buffer
402 (insert signature)
403 (goto-char (point-min))
404 (while (re-search-forward "\r+$" nil t)
405 (replace-match "" t t))
406 (when cte
407 (mm-encode-content-transfer-encoding cte))
408 (goto-char (point-min))
409 (when headers
410 (insert headers))
411 (insert "\n"))
412 t))
413
414(defun mml1991-epg-encrypt (cont &optional sign)
415 (goto-char (point-min))
416 (when (re-search-forward "^$" nil t)
417 (let ((cte (save-restriction
418 (narrow-to-region (point-min) (point))
419 (mail-fetch-field "content-transfer-encoding"))))
420 ;; Strip MIME headers since it will be ASCII armoured.
421 (forward-line 1)
422 (delete-region (point-min) (point))
423 (when cte
424 (mm-decode-content-transfer-encoding (intern (downcase cte))))))
425 (let ((context (epg-make-context))
426 (recipients
427 (if (message-options-get 'message-recipients)
428 (split-string
429 (message-options-get 'message-recipients)
430 "[ \f\t\n\r\v,]+")))
431 cipher signers config)
432 ;; We should remove this check if epg-0.0.6 is released.
433 (if (and (condition-case nil
434 (require 'epg-config)
435 (error))
436 (functionp #'epg-expand-group))
437 (setq config (epg-configuration)
438 recipients
439 (apply #'nconc
440 (mapcar (lambda (recipient)
441 (or (epg-expand-group config recipient)
442 (list recipient)))
443 recipients))))
444 (if mml1991-verbose
445 (setq recipients
446 (epa-select-keys context "Select recipients for encryption.
447If no one is selected, symmetric encryption will be performed. "
448 recipients))
449 (setq recipients
450 (delq nil (mapcar (lambda (name)
451 (car (epg-list-keys context name)))
452 recipients))))
453 (if mml1991-encrypt-to-self
454 (if mml1991-signers
455 (setq recipients
456 (nconc recipients
457 (mapcar (lambda (name)
458 (car (epg-list-keys context name)))
459 mml1991-signers)))
460 (error "mml1991-signers not set")))
461 (when sign
462 (if mml1991-verbose
463 (setq signers (epa-select-keys context "Select keys for signing.
464If no one is selected, default secret key is used. "
465 mml1991-signers t))
466 (if mml1991-signers
467 (setq signers (mapcar (lambda (name)
468 (car (epg-list-keys context name t)))
469 mml1991-signers))))
470 (epg-context-set-signers context signers))
471 (epg-context-set-armor context t)
472 (epg-context-set-textmode context t)
473 (if mml1991-cache-passphrase
474 (epg-context-set-passphrase-callback
475 context
476 #'mml1991-epg-passphrase-callback))
477 (condition-case error
478 (setq cipher
479 (epg-encrypt-string context (buffer-string) recipients sign)
480 mml1991-epg-secret-key-id-list nil)
481 (error
482 (while mml1991-epg-secret-key-id-list
483 (password-cache-remove (car mml1991-epg-secret-key-id-list))
484 (setq mml1991-epg-secret-key-id-list
485 (cdr mml1991-epg-secret-key-id-list)))
486 (signal (car error) (cdr error))))
487 (delete-region (point-min) (point-max))
488 (insert "\n" cipher))
489 t)
490
293;;;###autoload 491;;;###autoload
294(defun mml1991-encrypt (cont &optional sign) 492(defun mml1991-encrypt (cont &optional sign)
295 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist)))) 493 (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 4edf595faae..1760e4615ce 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -34,13 +34,23 @@
34(require 'mm-decode) 34(require 'mm-decode)
35(require 'mm-util) 35(require 'mm-util)
36(require 'mml) 36(require 'mml)
37(require 'mml-sec)
37 38
38(defvar mc-pgp-always-sign) 39(defvar mc-pgp-always-sign)
39 40
40(defvar mml2015-use (or 41(defvar mml2015-use (or
42 (condition-case nil
43 (progn
44 (require 'epg-config)
45 (epg-check-configuration (epg-configuration))
46 'epg)
47 (error))
41 (progn 48 (progn
42 (ignore-errors 49 (ignore-errors
43 (require 'pgg)) 50 ;; Avoid the "Recursive load suspected" error
51 ;; in Emacs 21.1.
52 (let ((recursive-load-depth-limit 100))
53 (require 'pgg)))
44 (and (fboundp 'pgg-sign-region) 54 (and (fboundp 'pgg-sign-region)
45 'pgg)) 55 'pgg))
46 (progn 56 (progn
@@ -54,7 +64,8 @@
54 (fboundp 'mc-sign-generic) 64 (fboundp 'mc-sign-generic)
55 (fboundp 'mc-cleanup-recipient-headers) 65 (fboundp 'mc-cleanup-recipient-headers)
56 'mailcrypt))) 66 'mailcrypt)))
57 "The package used for PGP/MIME.") 67 "The package used for PGP/MIME.
68Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.")
58 69
59;; Something is not RFC2015. 70;; Something is not RFC2015.
60(defvar mml2015-function-alist 71(defvar mml2015-function-alist
@@ -75,7 +86,13 @@
75 mml2015-pgg-verify 86 mml2015-pgg-verify
76 mml2015-pgg-decrypt 87 mml2015-pgg-decrypt
77 mml2015-pgg-clear-verify 88 mml2015-pgg-clear-verify
78 mml2015-pgg-clear-decrypt)) 89 mml2015-pgg-clear-decrypt)
90 (epg mml2015-epg-sign
91 mml2015-epg-encrypt
92 mml2015-epg-verify
93 mml2015-epg-decrypt
94 mml2015-epg-clear-verify
95 mml2015-epg-clear-decrypt))
79 "Alist of PGP/MIME functions.") 96 "Alist of PGP/MIME functions.")
80 97
81(defvar mml2015-result-buffer nil) 98(defvar mml2015-result-buffer nil)
@@ -92,6 +109,60 @@
92 :type '(repeat (cons (regexp :tag "GnuPG output regexp") 109 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
93 (boolean :tag "Trust key")))) 110 (boolean :tag "Trust key"))))
94 111
112(defcustom mml2015-verbose mml-secure-verbose
113 "If non-nil, ask the user about the current operation more verbosely."
114 :group 'mime-security
115 :type 'boolean)
116
117(defcustom mml2015-cache-passphrase mml-secure-cache-passphrase
118 "If t, cache passphrase."
119 :group 'mime-security
120 :type 'boolean)
121
122(defcustom mml2015-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
123 "How many seconds the passphrase is cached.
124Whether the passphrase is cached at all is controlled by
125`mml2015-cache-passphrase'."
126 :group 'mime-security
127 :type 'integer)
128
129(defcustom mml2015-signers nil
130 "A list of your own key ID which will be used to sign a message."
131 :group 'mime-security
132 :type '(repeat (string :tag "Key ID")))
133
134(defcustom mml2015-encrypt-to-self nil
135 "If t, add your own key ID to recipient list when encryption."
136 :group 'mime-security
137 :type 'boolean)
138
139(defcustom mml2015-always-trust t
140 "If t, GnuPG skip key validation on encryption."
141 :group 'mime-security
142 :type 'boolean)
143
144;; Extract plaintext from cleartext signature. IMO, this kind of task
145;; should be done by GnuPG rather than Elisp, but older PGP backends
146;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG.
147(defun mml2015-extract-cleartext-signature ()
148 (goto-char (point-min))
149 (forward-line)
150 ;; We need to be careful not to strip beyond the armor headers.
151 ;; Previously, an attacker could replace the text inside our
152 ;; markup with trailing garbage by injecting whitespace into the
153 ;; message.
154 (while (looking-at "Hash:") ; The only header allowed in cleartext
155 (forward-line)) ; signatures according to RFC2440.
156 (when (looking-at "[\t ]*$")
157 (forward-line))
158 (delete-region (point-min) (point))
159 (if (re-search-forward "^-----BEGIN PGP SIGNATURE-----" nil t)
160 (delete-region (match-beginning 0) (point-max)))
161 (goto-char (point-min))
162 (while (re-search-forward "^- " nil t)
163 (replace-match "" t t)
164 (forward-line 1)))
165
95;;; mailcrypt wrapper 166;;; mailcrypt wrapper
96 167
97(eval-and-compile 168(eval-and-compile
@@ -278,7 +349,8 @@
278 (mm-set-handle-multipart-parameter 349 (mm-set-handle-multipart-parameter
279 mm-security-handle 'gnus-info "OK") 350 mm-security-handle 'gnus-info "OK")
280 (mm-set-handle-multipart-parameter 351 (mm-set-handle-multipart-parameter
281 mm-security-handle 'gnus-info "Failed")))) 352 mm-security-handle 'gnus-info "Failed")))
353 (mml2015-extract-cleartext-signature))
282 354
283(defun mml2015-mailcrypt-sign (cont) 355(defun mml2015-mailcrypt-sign (cont)
284 (mc-sign-generic (message-options-get 'message-sender) 356 (mc-sign-generic (message-options-get 'message-sender)
@@ -475,9 +547,8 @@
475 (with-temp-buffer 547 (with-temp-buffer
476 (setq message (current-buffer)) 548 (setq message (current-buffer))
477 (insert part) 549 (insert part)
478 ;; Convert <LF> to <CR><LF> in verify mode. Sign and 550 ;; Convert <LF> to <CR><LF> in signed text. If --textmode is
479 ;; clearsign use --textmode. The conversion is not necessary. 551 ;; specified when signing, the conversion is not necessary.
480 ;; In clearverify, the conversion is not necessary either.
481 (goto-char (point-min)) 552 (goto-char (point-min))
482 (end-of-line) 553 (end-of-line)
483 (while (not (eobp)) 554 (while (not (eobp))
@@ -545,7 +616,8 @@
545 (with-current-buffer mml2015-result-buffer 616 (with-current-buffer mml2015-result-buffer
546 (mml2015-gpg-extract-signature-details))) 617 (mml2015-gpg-extract-signature-details)))
547 (mm-set-handle-multipart-parameter 618 (mm-set-handle-multipart-parameter
548 mm-security-handle 'gnus-info "Failed"))) 619 mm-security-handle 'gnus-info "Failed"))
620 (mml2015-extract-cleartext-signature))
549 621
550(defun mml2015-gpg-sign (cont) 622(defun mml2015-gpg-sign (cont)
551 (let ((boundary (mml-compute-boundary cont)) 623 (let ((boundary (mml-compute-boundary cont))
@@ -734,9 +806,8 @@
734 handle) 806 handle)
735 (with-temp-buffer 807 (with-temp-buffer
736 (insert part) 808 (insert part)
737 ;; Convert <LF> to <CR><LF> in verify mode. Sign and 809 ;; Convert <LF> to <CR><LF> in signed text. If --textmode is
738 ;; clearsign use --textmode. The conversion is not necessary. 810 ;; specified when signing, the conversion is not necessary.
739 ;; In clearverify, the conversion is not necessary either.
740 (goto-char (point-min)) 811 (goto-char (point-min))
741 (end-of-line) 812 (end-of-line)
742 (while (not (eobp)) 813 (while (not (eobp))
@@ -809,7 +880,8 @@
809 (with-current-buffer pgg-errors-buffer 880 (with-current-buffer pgg-errors-buffer
810 (mml2015-gpg-extract-signature-details))) 881 (mml2015-gpg-extract-signature-details)))
811 (mm-set-handle-multipart-parameter 882 (mm-set-handle-multipart-parameter
812 mm-security-handle 'gnus-info "Failed")))) 883 mm-security-handle 'gnus-info "Failed")))
884 (mml2015-extract-cleartext-signature))
813 885
814(defun mml2015-pgg-sign (cont) 886(defun mml2015-pgg-sign (cont)
815 (let ((pgg-errors-buffer mml2015-result-buffer) 887 (let ((pgg-errors-buffer mml2015-result-buffer)
@@ -871,6 +943,397 @@
871 (insert (format "--%s--\n" boundary)) 943 (insert (format "--%s--\n" boundary))
872 (goto-char (point-max)))) 944 (goto-char (point-max))))
873 945
946;;; epg wrapper
947
948(eval-and-compile
949 (autoload 'epg-make-context "epg"))
950
951(eval-when-compile
952 (defvar epg-user-id-alist)
953 (defvar epg-digest-algorithm-alist)
954 (defvar inhibit-redisplay)
955 (autoload 'epg-context-set-armor "epg")
956 (autoload 'epg-context-set-textmode "epg")
957 (autoload 'epg-context-set-signers "epg")
958 (autoload 'epg-context-result-for "epg")
959 (autoload 'epg-new-signature-digest-algorithm "epg")
960 (autoload 'epg-verify-result-to-string "epg")
961 (autoload 'epg-list-keys "epg")
962 (autoload 'epg-decrypt-string "epg")
963 (autoload 'epg-verify-string "epg")
964 (autoload 'epg-sign-string "epg")
965 (autoload 'epg-encrypt-string "epg")
966 (autoload 'epg-passphrase-callback-function "epg")
967 (autoload 'epg-context-set-passphrase-callback "epg")
968 (autoload 'epg-key-sub-key-list "epg")
969 (autoload 'epg-sub-key-capability "epg")
970 (autoload 'epg-sub-key-validity "epg")
971 (autoload 'epg-configuration "epg-config")
972 (autoload 'epg-expand-group "epg-config")
973 (autoload 'epa-select-keys "epa"))
974
975(eval-when-compile
976 (defvar password-cache-expiry)
977 (autoload 'password-read "password")
978 (autoload 'password-cache-add "password")
979 (autoload 'password-cache-remove "password"))
980
981(defvar mml2015-epg-secret-key-id-list nil)
982
983(defun mml2015-epg-passphrase-callback (context key-id ignore)
984 (if (eq key-id 'SYM)
985 (epg-passphrase-callback-function context key-id nil)
986 (let* (entry
987 (passphrase
988 (password-read
989 (if (eq key-id 'PIN)
990 "Passphrase for PIN: "
991 (if (setq entry (assoc key-id epg-user-id-alist))
992 (format "Passphrase for %s %s: " key-id (cdr entry))
993 (format "Passphrase for %s: " key-id)))
994 (if (eq key-id 'PIN)
995 "PIN"
996 key-id))))
997 (when passphrase
998 (let ((password-cache-expiry mml2015-passphrase-cache-expiry))
999 (password-cache-add key-id passphrase))
1000 (setq mml2015-epg-secret-key-id-list
1001 (cons key-id mml2015-epg-secret-key-id-list))
1002 (copy-sequence passphrase)))))
1003
1004(defun mml2015-epg-find-usable-key (keys usage)
1005 (catch 'found
1006 (while keys
1007 (let ((pointer (epg-key-sub-key-list (car keys))))
1008 (while pointer
1009 (if (and (memq usage (epg-sub-key-capability (car pointer)))
1010 (not (memq (epg-sub-key-validity (car pointer))
1011 '(revoked expired))))
1012 (throw 'found (car keys)))
1013 (setq pointer (cdr pointer))))
1014 (setq keys (cdr keys)))))
1015
1016(defun mml2015-epg-decrypt (handle ctl)
1017 (catch 'error
1018 (let ((inhibit-redisplay t)
1019 context plain child handles result decrypt-status)
1020 (unless (setq child (mm-find-part-by-type
1021 (cdr handle)
1022 "application/octet-stream" nil t))
1023 (mm-set-handle-multipart-parameter
1024 mm-security-handle 'gnus-info "Corrupted")
1025 (throw 'error handle))
1026 (setq context (epg-make-context))
1027 (if mml2015-cache-passphrase
1028 (epg-context-set-passphrase-callback
1029 context
1030 #'mml2015-epg-passphrase-callback))
1031 (condition-case error
1032 (setq plain (epg-decrypt-string context (mm-get-part child))
1033 mml2015-epg-secret-key-id-list nil)
1034 (error
1035 (while mml2015-epg-secret-key-id-list
1036 (password-cache-remove (car mml2015-epg-secret-key-id-list))
1037 (setq mml2015-epg-secret-key-id-list
1038 (cdr mml2015-epg-secret-key-id-list)))
1039 (mm-set-handle-multipart-parameter
1040 mm-security-handle 'gnus-info "Failed")
1041 (if (eq (car error) 'quit)
1042 (mm-set-handle-multipart-parameter
1043 mm-security-handle 'gnus-details "Quit.")
1044 (mm-set-handle-multipart-parameter
1045 mm-security-handle 'gnus-details (mml2015-format-error error)))
1046 (throw 'error handle)))
1047 (with-temp-buffer
1048 (insert plain)
1049 (goto-char (point-min))
1050 (while (search-forward "\r\n" nil t)
1051 (replace-match "\n" t t))
1052 (setq handles (mm-dissect-buffer t))
1053 (mm-destroy-parts handle)
1054 (if (epg-context-result-for context 'verify)
1055 (mm-set-handle-multipart-parameter
1056 mm-security-handle 'gnus-info
1057 (concat "OK\n"
1058 (epg-verify-result-to-string
1059 (epg-context-result-for context 'verify))))
1060 (mm-set-handle-multipart-parameter
1061 mm-security-handle 'gnus-info "OK"))
1062 (if (stringp (car handles))
1063 (mm-set-handle-multipart-parameter
1064 mm-security-handle 'gnus-details
1065 (mm-handle-multipart-ctl-parameter handles 'gnus-details))))
1066 (if (listp (car handles))
1067 handles
1068 (list handles)))))
1069
1070(defun mml2015-epg-clear-decrypt ()
1071 (let ((inhibit-redisplay t)
1072 (context (epg-make-context))
1073 plain)
1074 (if mml2015-cache-passphrase
1075 (epg-context-set-passphrase-callback
1076 context
1077 #'mml2015-epg-passphrase-callback))
1078 (condition-case error
1079 (setq plain (epg-decrypt-string context (buffer-string))
1080 mml2015-epg-secret-key-id-list nil)
1081 (error
1082 (while mml2015-epg-secret-key-id-list
1083 (password-cache-remove (car mml2015-epg-secret-key-id-list))
1084 (setq mml2015-epg-secret-key-id-list
1085 (cdr mml2015-epg-secret-key-id-list)))
1086 (mm-set-handle-multipart-parameter
1087 mm-security-handle 'gnus-info "Failed")
1088 (if (eq (car error) 'quit)
1089 (mm-set-handle-multipart-parameter
1090 mm-security-handle 'gnus-details "Quit.")
1091 (mm-set-handle-multipart-parameter
1092 mm-security-handle 'gnus-details (mml2015-format-error error)))))
1093 (when plain
1094 (erase-buffer)
1095 ;; Treat data which epg returns as a unibyte string.
1096 (mm-disable-multibyte)
1097 (insert plain)
1098 (goto-char (point-min))
1099 (while (search-forward "\r\n" nil t)
1100 (replace-match "\n" t t))
1101 (mm-set-handle-multipart-parameter
1102 mm-security-handle 'gnus-info "OK")
1103 (if (epg-context-result-for context 'verify)
1104 (mm-set-handle-multipart-parameter
1105 mm-security-handle 'gnus-details
1106 (epg-verify-result-to-string
1107 (epg-context-result-for context 'verify)))))))
1108
1109(defun mml2015-epg-verify (handle ctl)
1110 (catch 'error
1111 (let ((inhibit-redisplay t)
1112 context plain signature-file part signature)
1113 (when (or (null (setq part (mm-find-raw-part-by-type
1114 ctl (or (mm-handle-multipart-ctl-parameter
1115 ctl 'protocol)
1116 "application/pgp-signature")
1117 t)))
1118 (null (setq signature (mm-find-part-by-type
1119 (cdr handle) "application/pgp-signature"
1120 nil t))))
1121 (mm-set-handle-multipart-parameter
1122 mm-security-handle 'gnus-info "Corrupted")
1123 (throw 'error handle))
1124 (setq part (mm-replace-in-string part "\n" "\r\n" t)
1125 signature (mm-get-part signature)
1126 context (epg-make-context))
1127 (condition-case error
1128 (setq plain (epg-verify-string context signature part))
1129 (error
1130 (mm-set-handle-multipart-parameter
1131 mm-security-handle 'gnus-info "Failed")
1132 (if (eq (car error) 'quit)
1133 (mm-set-handle-multipart-parameter
1134 mm-security-handle 'gnus-details "Quit.")
1135 (mm-set-handle-multipart-parameter
1136 mm-security-handle 'gnus-details (mml2015-format-error error)))
1137 (throw 'error handle)))
1138 (mm-set-handle-multipart-parameter
1139 mm-security-handle 'gnus-info
1140 (epg-verify-result-to-string (epg-context-result-for context 'verify)))
1141 handle)))
1142
1143(defun mml2015-epg-clear-verify ()
1144 (let ((inhibit-redisplay t)
1145 (context (epg-make-context))
1146 (signature (mm-encode-coding-string (buffer-string)
1147 coding-system-for-write))
1148 plain)
1149 (condition-case error
1150 (setq plain (epg-verify-string context signature))
1151 (error
1152 (mm-set-handle-multipart-parameter
1153 mm-security-handle 'gnus-info "Failed")
1154 (if (eq (car error) 'quit)
1155 (mm-set-handle-multipart-parameter
1156 mm-security-handle 'gnus-details "Quit.")
1157 (mm-set-handle-multipart-parameter
1158 mm-security-handle 'gnus-details (mml2015-format-error error)))))
1159 (if plain
1160 (progn
1161 (mm-set-handle-multipart-parameter
1162 mm-security-handle 'gnus-info
1163 (epg-verify-result-to-string
1164 (epg-context-result-for context 'verify)))
1165 (delete-region (point-min) (point-max))
1166 (insert (mm-decode-coding-string plain coding-system-for-read)))
1167 (mml2015-extract-cleartext-signature))))
1168
1169(defun mml2015-epg-sign (cont)
1170 (let* ((inhibit-redisplay t)
1171 (context (epg-make-context))
1172 (boundary (mml-compute-boundary cont))
1173 signer-key
1174 (signers
1175 (or (message-options-get 'mml2015-epg-signers)
1176 (message-options-set
1177 'mml2015-epg-signers
1178 (if mml2015-verbose
1179 (epa-select-keys context "\
1180Select keys for signing.
1181If no one is selected, default secret key is used. "
1182 mml2015-signers t)
1183 (if mml2015-signers
1184 (mapcar
1185 (lambda (signer)
1186 (setq signer-key (mml2015-epg-find-usable-key
1187 (epg-list-keys context signer t)
1188 'sign))
1189 (unless (or signer-key
1190 (y-or-n-p
1191 (format "No secret key for %s; skip it? "
1192 signer)))
1193 (error "No secret key for %s" signer))
1194 signer-key)
1195 mml2015-signers))))))
1196 signature micalg)
1197 (epg-context-set-armor context t)
1198 (epg-context-set-textmode context t)
1199 (epg-context-set-signers context signers)
1200 (if mml2015-cache-passphrase
1201 (epg-context-set-passphrase-callback
1202 context
1203 #'mml2015-epg-passphrase-callback))
1204 (condition-case error
1205 (setq signature (epg-sign-string context (buffer-string) t)
1206 mml2015-epg-secret-key-id-list nil)
1207 (error
1208 (while mml2015-epg-secret-key-id-list
1209 (password-cache-remove (car mml2015-epg-secret-key-id-list))
1210 (setq mml2015-epg-secret-key-id-list
1211 (cdr mml2015-epg-secret-key-id-list)))
1212 (signal (car error) (cdr error))))
1213 (if (epg-context-result-for context 'sign)
1214 (setq micalg (epg-new-signature-digest-algorithm
1215 (car (epg-context-result-for context 'sign)))))
1216 (goto-char (point-min))
1217 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
1218 boundary))
1219 (if micalg
1220 (insert (format "\tmicalg=pgp-%s; "
1221 (downcase
1222 (cdr (assq micalg
1223 epg-digest-algorithm-alist))))))
1224 (insert "protocol=\"application/pgp-signature\"\n")
1225 (insert (format "\n--%s\n" boundary))
1226 (goto-char (point-max))
1227 (insert (format "\n--%s\n" boundary))
1228 (insert "Content-Type: application/pgp-signature\n\n")
1229 (insert signature)
1230 (goto-char (point-max))
1231 (insert (format "--%s--\n" boundary))
1232 (goto-char (point-max))))
1233
1234(defun mml2015-epg-encrypt (cont &optional sign)
1235 (let ((inhibit-redisplay t)
1236 (context (epg-make-context))
1237 (config (epg-configuration))
1238 (recipients (message-options-get 'mml2015-epg-recipients))
1239 cipher signers
1240 (boundary (mml-compute-boundary cont))
1241 recipient-key signer-key)
1242 (unless recipients
1243 (setq recipients
1244 (apply #'nconc
1245 (mapcar
1246 (lambda (recipient)
1247 (or (epg-expand-group config recipient)
1248 (list (concat "<" recipient ">"))))
1249 (split-string
1250 (or (message-options-get 'message-recipients)
1251 (message-options-set 'message-recipients
1252 (read-string "Recipients: ")))
1253 "[ \f\t\n\r\v,]+"))))
1254 (when mml2015-encrypt-to-self
1255 (unless mml2015-signers
1256 (error "mml2015-signers not set"))
1257 (setq recipients (nconc recipients mml2015-signers)))
1258 (if mml2015-verbose
1259 (setq recipients
1260 (epa-select-keys context "\
1261Select recipients for encryption.
1262If no one is selected, symmetric encryption will be performed. "
1263 recipients))
1264 (setq recipients
1265 (mapcar
1266 (lambda (recipient)
1267 (setq recipient-key (mml2015-epg-find-usable-key
1268 (epg-list-keys context recipient)
1269 'encrypt))
1270 (unless (or recipient-key
1271 (y-or-n-p
1272 (format "No public key for %s; skip it? "
1273 recipient)))
1274 (error "No public key for %s" recipient))
1275 recipient-key)
1276 recipients))
1277 (unless recipients
1278 (error "No recipient specified")))
1279 (message-options-set 'mml2015-epg-recipients recipients))
1280 (when sign
1281 (setq signers
1282 (or (message-options-get 'mml2015-epg-signers)
1283 (message-options-set
1284 'mml2015-epg-signers
1285 (if mml2015-verbose
1286 (epa-select-keys context "\
1287Select keys for signing.
1288If no one is selected, default secret key is used. "
1289 mml2015-signers t)
1290 (if mml2015-signers
1291 (mapcar
1292 (lambda (signer)
1293 (setq signer-key (mml2015-epg-find-usable-key
1294 (epg-list-keys context signer t)
1295 'sign))
1296 (unless (or signer-key
1297 (y-or-n-p
1298 (format
1299 "No secret key for %s; skip it? "
1300 signer)))
1301 (error "No secret key for %s" signer))
1302 signer-key)
1303 mml2015-signers))))))
1304 (epg-context-set-signers context signers))
1305 (epg-context-set-armor context t)
1306 (epg-context-set-textmode context t)
1307 (if mml2015-cache-passphrase
1308 (epg-context-set-passphrase-callback
1309 context
1310 #'mml2015-epg-passphrase-callback))
1311 (condition-case error
1312 (setq cipher
1313 (epg-encrypt-string context (buffer-string) recipients sign
1314 mml2015-always-trust)
1315 mml2015-epg-secret-key-id-list nil)
1316 (error
1317 (while mml2015-epg-secret-key-id-list
1318 (password-cache-remove (car mml2015-epg-secret-key-id-list))
1319 (setq mml2015-epg-secret-key-id-list
1320 (cdr mml2015-epg-secret-key-id-list)))
1321 (signal (car error) (cdr error))))
1322 (delete-region (point-min) (point-max))
1323 (goto-char (point-min))
1324 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
1325 boundary))
1326 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
1327 (insert (format "--%s\n" boundary))
1328 (insert "Content-Type: application/pgp-encrypted\n\n")
1329 (insert "Version: 1\n\n")
1330 (insert (format "--%s\n" boundary))
1331 (insert "Content-Type: application/octet-stream\n\n")
1332 (insert cipher)
1333 (goto-char (point-max))
1334 (insert (format "--%s--\n" boundary))
1335 (goto-char (point-max))))
1336
874;;; General wrapper 1337;;; General wrapper
875 1338
876(defun mml2015-clean-buffer () 1339(defun mml2015-clean-buffer ()
@@ -879,7 +1342,7 @@
879 (erase-buffer) 1342 (erase-buffer)
880 t) 1343 t)
881 (setq mml2015-result-buffer 1344 (setq mml2015-result-buffer
882 (gnus-get-buffer-create "*MML2015 Result*")) 1345 (gnus-get-buffer-create " *MML2015 Result*"))
883 nil)) 1346 nil))
884 1347
885(defsubst mml2015-clear-decrypt-function () 1348(defsubst mml2015-clear-decrypt-function ()
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 7d11329f81f..0c1dbc6817e 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -121,7 +121,7 @@
121 (gnus-request-accept-article "nndraft:queue" nil t t)) 121 (gnus-request-accept-article "nndraft:queue" nil t t))
122 122
123(deffoo nnagent-request-set-mark (group action server) 123(deffoo nnagent-request-set-mark (group action server)
124 (with-temp-buffer 124 (mm-with-unibyte-buffer
125 (insert "(gnus-agent-synchronize-group-flags \"" 125 (insert "(gnus-agent-synchronize-group-flags \""
126 group 126 group
127 "\" '") 127 "\" '")
@@ -130,7 +130,17 @@
130 (gnus-method-to-server gnus-command-method) 130 (gnus-method-to-server gnus-command-method)
131 "\"") 131 "\"")
132 (insert ")\n") 132 (insert ")\n")
133 (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) 133 (let ((coding-system-for-write nnheader-file-coding-system))
134 (write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
135 t 'silent)))
136 ;; Also set the marks for the original back end that keeps marks in
137 ;; the local system.
138 (let ((gnus-agent nil))
139 (when (and (memq (car gnus-command-method) '(nntp))
140 (gnus-check-backend-function 'request-set-mark
141 (car gnus-command-method)))
142 (funcall (gnus-get-function gnus-command-method 'request-set-mark)
143 group action server)))
134 nil) 144 nil)
135 145
136(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) 146(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old)
@@ -148,7 +158,8 @@
148 (pop arts))) 158 (pop arts)))
149 (set-buffer nntp-server-buffer) 159 (set-buffer nntp-server-buffer)
150 (erase-buffer) 160 (erase-buffer)
151 (nnheader-insert-nov-file file (car articles)) 161 (let ((file-name-coding-system nnmail-pathname-coding-system))
162 (nnheader-insert-nov-file file (car articles)))
152 (goto-char (point-min)) 163 (goto-char (point-min))
153 (gnus-parse-without-error 164 (gnus-parse-without-error
154 (while (and arts (not (eobp))) 165 (while (and arts (not (eobp)))
@@ -214,10 +225,10 @@
214 (list (nnagent-server server)))) 225 (list (nnagent-server server))))
215 226
216(deffoo nnagent-request-move-article 227(deffoo nnagent-request-move-article
217 (article group server accept-form &optional last) 228 (article group server accept-form &optional last move-is-internal)
218 (nnoo-parent-function 'nnagent 'nnml-request-move-article 229 (nnoo-parent-function 'nnagent 'nnml-request-move-article
219 (list article group (nnagent-server server) 230 (list article group (nnagent-server server)
220 accept-form last))) 231 accept-form last move-is-internal)))
221 232
222(deffoo nnagent-request-rename-group (group new-name &optional server) 233(deffoo nnagent-request-rename-group (group new-name &optional server)
223 (nnoo-parent-function 'nnagent 'nnml-request-rename-group 234 (nnoo-parent-function 'nnagent 'nnml-request-rename-group
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 3f0631c152d..38d4a7227c2 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -70,9 +70,6 @@
70 70
71(defvoo nnbabyl-previous-buffer-mode nil) 71(defvoo nnbabyl-previous-buffer-mode nil)
72 72
73(eval-and-compile
74 (autoload 'gnus-set-text-properties "gnus-ems"))
75
76 73
77 74
78;;; Interface functions 75;;; Interface functions
@@ -271,7 +268,7 @@
271 268
272 (save-excursion 269 (save-excursion
273 (set-buffer nnbabyl-mbox-buffer) 270 (set-buffer nnbabyl-mbox-buffer)
274 (gnus-set-text-properties (point-min) (point-max) nil) 271 (set-text-properties (point-min) (point-max) nil)
275 (while (and articles is-old) 272 (while (and articles is-old)
276 (goto-char (point-min)) 273 (goto-char (point-min))
277 (when (search-forward (nnbabyl-article-string (car articles)) nil t) 274 (when (search-forward (nnbabyl-article-string (car articles)) nil t)
@@ -308,7 +305,7 @@
308 (nconc rest articles)))) 305 (nconc rest articles))))
309 306
310(deffoo nnbabyl-request-move-article 307(deffoo nnbabyl-request-move-article
311 (article group server accept-form &optional last) 308 (article group server accept-form &optional last move-is-internal)
312 (let ((buf (get-buffer-create " *nnbabyl move*")) 309 (let ((buf (get-buffer-create " *nnbabyl move*"))
313 result) 310 result)
314 (and 311 (and
diff --git a/lisp/gnus/nndb.el b/lisp/gnus/nndb.el
index e8421cb2074..70d395ba986 100644
--- a/lisp/gnus/nndb.el
+++ b/lisp/gnus/nndb.el
@@ -241,7 +241,7 @@ expiry mechanism."
241 (nndb-request-expire-articles-local articles group server force))) 241 (nndb-request-expire-articles-local articles group server force)))
242 242
243(deffoo nndb-request-move-article 243(deffoo nndb-request-move-article
244 (article group server accept-form &optional last) 244 (article group server accept-form &optional last move-is-internal)
245 "Move ARTICLE (a number) from GROUP on SERVER. 245 "Move ARTICLE (a number) from GROUP on SERVER.
246Evals ACCEPT-FORM in current buffer, where the article is. 246Evals ACCEPT-FORM in current buffer, where the article is.
247Optional LAST is ignored." 247Optional LAST is ignored."
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index eaa425239d2..015c0643893 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -606,7 +606,7 @@ all. This may very well take some time.")
606 (nconc rest articles))) 606 (nconc rest articles)))
607 607
608(deffoo nndiary-request-move-article 608(deffoo nndiary-request-move-article
609 (article group server accept-form &optional last) 609 (article group server accept-form &optional last move-is-internal)
610 (let ((buf (get-buffer-create " *nndiary move*")) 610 (let ((buf (get-buffer-create " *nndiary move*"))
611 result) 611 result)
612 (nndiary-possibly-change-directory group server) 612 (nndiary-possibly-change-directory group server)
@@ -875,7 +875,7 @@ all. This may very well take some time.")
875 (search-forward id nil t)) ; We find the ID. 875 (search-forward id nil t)) ; We find the ID.
876 ;; And the id is in the fourth field. 876 ;; And the id is in the fourth field.
877 (if (not (and (search-backward "\t" nil t 4) 877 (if (not (and (search-backward "\t" nil t 4)
878 (not (search-backward"\t" (gnus-point-at-bol) t)))) 878 (not (search-backward"\t" (point-at-bol) t))))
879 (forward-line 1) 879 (forward-line 1)
880 (beginning-of-line) 880 (beginning-of-line)
881 (setq found t) 881 (setq found t)
@@ -1096,9 +1096,7 @@ all. This may very well take some time.")
1096 (push (list group 1096 (push (list group
1097 (cons (or (caar files) (1+ last)) 1097 (cons (or (caar files) (1+ last))
1098 (max last 1098 (max last
1099 (or (let ((f files)) 1099 (or (caar (last files))
1100 (while (cdr f) (setq f (cdr f)))
1101 (caar f))
1102 0)))) 1100 0))))
1103 nndiary-group-alist))) 1101 nndiary-group-alist)))
1104 1102
@@ -1577,13 +1575,11 @@ all. This may very well take some time.")
1577 1575
1578;; The end... =============================================================== 1576;; The end... ===============================================================
1579 1577
1580(mapcar 1578(dolist (header nndiary-headers)
1581 (lambda (elt) 1579 (setq header (intern (format "X-Diary-%s" (car header))))
1582 (let ((header (intern (format "X-Diary-%s" (car elt))))) 1580 ;; Required for building NOV databases and some other stuff.
1583 ;; Required for building NOV databases and some other stuff 1581 (add-to-list 'gnus-extra-headers header)
1584 (add-to-list 'gnus-extra-headers header) 1582 (add-to-list 'nnmail-extra-headers header))
1585 (add-to-list 'nnmail-extra-headers header)))
1586 nndiary-headers)
1587 1583
1588(unless (assoc "nndiary" gnus-valid-select-methods) 1584(unless (assoc "nndiary" gnus-valid-select-methods)
1589 (gnus-declare-backend "nndiary" 'post-mail 'respool 'address)) 1585 (gnus-declare-backend "nndiary" 'post-mail 'respool 'address))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index ea32a8f4183..1de9a2083b0 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -122,7 +122,7 @@ from the document.")
122 (subtype digest guess)) 122 (subtype digest guess))
123 (lanl-gov-announce 123 (lanl-gov-announce
124 (article-begin . "^\\\\\\\\\n") 124 (article-begin . "^\\\\\\\\\n")
125 (head-begin . "^Paper.*:") 125 (head-begin . "^\\(Paper.*:\\|arXiv:\\)")
126 (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") 126 (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
127 (body-begin . "") 127 (body-begin . "")
128 (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)") 128 (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)")
@@ -624,25 +624,28 @@ from the document.")
624 624
625(defun nndoc-lanl-gov-announce-type-p () 625(defun nndoc-lanl-gov-announce-type-p ()
626 (when (let ((case-fold-search nil)) 626 (when (let ((case-fold-search nil))
627 (re-search-forward "^\\\\\\\\\nPaper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+" nil t)) 627 (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+\\|arXiv:\\)" nil t))
628 t)) 628 t))
629 629
630(defun nndoc-transform-lanl-gov-announce (article) 630(defun nndoc-transform-lanl-gov-announce (article)
631 (goto-char (point-max)) 631 (let ((case-fold-search nil))
632 (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) 632 (goto-char (point-max))
633 (replace-match "\n\nGet it at \\1 (\\2)" t nil)) 633 (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
634 (goto-char (point-min)) 634 (replace-match "\n\nGet it at \\1 (\\2)" t nil))
635 (while (re-search-forward "^\\\\\\\\$" nil t)
636 (replace-match "" t nil))
637 (goto-char (point-min))
638 (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t)
639 (replace-match "Date: \\1 (revised) " t nil))
640 (goto-char (point-min))
641 (unless (re-search-forward "^From" nil t)
642 (goto-char (point-min)) 635 (goto-char (point-min))
643 (when (re-search-forward "^Authors?: \\(.*\\)" nil t) 636 (while (re-search-forward "^\\\\\\\\$" nil t)
637 (replace-match "" t nil))
638 (goto-char (point-min))
639 (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t)
640 (replace-match "Date: \\1 (revised) " t nil))
641 (goto-char (point-min))
642 (unless (re-search-forward "^From" nil t)
644 (goto-char (point-min)) 643 (goto-char (point-min))
645 (insert "From: " (match-string 1) "\n")))) 644 (when (re-search-forward "^Authors?: \\(.*\\)" nil t)
645 (goto-char (point-min))
646 (insert "From: " (match-string 1) "\n")))
647 (when (re-search-forward "^arXiv:" nil t)
648 (replace-match "Paper: arXiv:" t nil))))
646 649
647(defun nndoc-generate-lanl-gov-head (article) 650(defun nndoc-generate-lanl-gov-head (article)
648 (let ((entry (cdr (assq article nndoc-dissection-alist))) 651 (let ((entry (cdr (assq article nndoc-dissection-alist)))
@@ -653,8 +656,8 @@ from the document.")
653 (save-restriction 656 (save-restriction
654 (narrow-to-region (car entry) (nth 1 entry)) 657 (narrow-to-region (car entry) (nth 1 entry))
655 (goto-char (point-min)) 658 (goto-char (point-min))
656 (when (looking-at "^Paper.*: \\([a-zA-Z-\\.]+/[0-9]+\\)") 659 (when (looking-at "^\\(Paper.*: \\|arXiv:\\)\\([0-9a-zA-Z-\\./]+\\)")
657 (setq subject (concat " (" (match-string 1) ")")) 660 (setq subject (concat " (" (match-string 2) ")"))
658 (when (re-search-forward "^From: \\(.*\\)" nil t) 661 (when (re-search-forward "^From: \\(.*\\)" nil t)
659 (setq from (concat "<" 662 (setq from (concat "<"
660 (cadr (funcall gnus-extract-address-components 663 (cadr (funcall gnus-extract-address-components
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 37bd3c1aa96..7fc0993a520 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -42,6 +42,11 @@
42 "Where nndraft will store its files." 42 "Where nndraft will store its files."
43 nnmh-directory) 43 nnmh-directory)
44 44
45(defvar nndraft-required-headers '(Date)
46 "*Headers to be generated when saving a draft message.
47The headers in this variable and the ones in `message-required-headers'
48are generated if and only if they are also in `message-draft-headers'.")
49
45 50
46 51
47(defvoo nndraft-current-group "" nil nnmh-current-group) 52(defvoo nndraft-current-group "" nil nnmh-current-group)
@@ -156,7 +161,7 @@
156 (save-excursion 161 (save-excursion
157 (message-generate-headers 162 (message-generate-headers
158 (message-headers-to-generate 163 (message-headers-to-generate
159 message-required-headers message-draft-headers nil)))) 164 nndraft-required-headers message-draft-headers nil))))
160 165
161(deffoo nndraft-request-associate-buffer (group) 166(deffoo nndraft-request-associate-buffer (group)
162 "Associate the current buffer with some article in the draft group." 167 "Associate the current buffer with some article in the draft group."
@@ -199,8 +204,8 @@
199 'nnmh-request-group 204 'nnmh-request-group
200 (list group server dont-check))) 205 (list group server dont-check)))
201 206
202(deffoo nndraft-request-move-article (article group server 207(deffoo nndraft-request-move-article (article group server accept-form
203 accept-form &optional last) 208 &optional last move-is-internal)
204 (nndraft-possibly-change-group group) 209 (nndraft-possibly-change-group group)
205 (let ((buf (get-buffer-create " *nndraft move*")) 210 (let ((buf (get-buffer-create " *nndraft move*"))
206 result) 211 result)
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 8d1fa98d81f..143ddcfdf62 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -423,7 +423,7 @@ included.")
423 (if (numberp article) 423 (if (numberp article)
424 (if (setq fname (cadr (assq article nneething-map))) 424 (if (setq fname (cadr (assq article nneething-map)))
425 (expand-file-name fname dir) 425 (expand-file-name fname dir)
426 (mm-make-temp-file (expand-file-name "nneething" dir))) 426 (make-temp-name (expand-file-name "nneething" dir)))
427 (expand-file-name article dir)))) 427 (expand-file-name article dir))))
428 428
429(provide 'nneething) 429(provide 'nneething)
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 4127f11463e..bf82791fea6 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -203,7 +203,7 @@ the group. Then the marks file will be regenerated properly by Gnus.")
203 (goto-char (match-end 0)) 203 (goto-char (match-end 0))
204 (setq num (string-to-number 204 (setq num (string-to-number
205 (buffer-substring 205 (buffer-substring
206 (point) (gnus-point-at-eol)))) 206 (point) (point-at-eol))))
207 (goto-char start) 207 (goto-char start)
208 (< num article))) 208 (< num article)))
209 ;; Check that we are before an article with a 209 ;; Check that we are before an article with a
@@ -213,7 +213,7 @@ the group. Then the marks file will be regenerated properly by Gnus.")
213 (progn 213 (progn
214 (setq num (string-to-number 214 (setq num (string-to-number
215 (buffer-substring 215 (buffer-substring
216 (point) (gnus-point-at-eol)))) 216 (point) (point-at-eol))))
217 (> num article)) 217 (> num article))
218 ;; Discard any article numbers before the one we're 218 ;; Discard any article numbers before the one we're
219 ;; now looking at. 219 ;; now looking at.
@@ -287,31 +287,36 @@ the group. Then the marks file will be regenerated properly by Gnus.")
287 (if (search-forward (concat "\n" nnfolder-article-marker) 287 (if (search-forward (concat "\n" nnfolder-article-marker)
288 nil t) 288 nil t)
289 (string-to-number (buffer-substring 289 (string-to-number (buffer-substring
290 (point) (gnus-point-at-eol))) 290 (point) (point-at-eol)))
291 -1)))))))) 291 -1))))))))
292 292
293(deffoo nnfolder-request-group (group &optional server dont-check) 293(deffoo nnfolder-request-group (group &optional server dont-check)
294 (nnfolder-possibly-change-group group server t) 294 (nnfolder-possibly-change-group group server t)
295 (save-excursion 295 (save-excursion
296 (if (not (assoc group nnfolder-group-alist)) 296 (cond ((not (assoc group nnfolder-group-alist))
297 (nnheader-report 'nnfolder "No such group: %s" group) 297 (nnheader-report 'nnfolder "No such group: %s" group))
298 (if dont-check 298 ((file-directory-p (nnfolder-group-pathname group))
299 (progn 299 (nnheader-report 'nnfolder "%s is a directory"
300 (nnheader-report 'nnfolder "Selected group %s" group) 300 (file-name-as-directory
301 t) 301 (let ((nnmail-pathname-coding-system nil))
302 (let* ((active (assoc group nnfolder-group-alist)) 302 (nnfolder-group-pathname group)))))
303 (group (car active)) 303 (dont-check
304 (range (cadr active))) 304 (nnheader-report 'nnfolder "Selected group %s" group)
305 (cond 305 t)
306 ((null active) 306 (t
307 (nnheader-report 'nnfolder "No such group: %s" group)) 307 (let* ((active (assoc group nnfolder-group-alist))
308 ((null nnfolder-current-group) 308 (group (car active))
309 (nnheader-report 'nnfolder "Empty group: %s" group)) 309 (range (cadr active)))
310 (t 310 (cond
311 (nnheader-report 'nnfolder "Selected group %s" group) 311 ((null active)
312 (nnheader-insert "211 %d %d %d %s\n" 312 (nnheader-report 'nnfolder "No such group: %s" group))
313 (1+ (- (cdr range) (car range))) 313 ((null nnfolder-current-group)
314 (car range) (cdr range) group)))))))) 314 (nnheader-report 'nnfolder "Empty group: %s" group))
315 (t
316 (nnheader-report 'nnfolder "Selected group %s" group)
317 (nnheader-insert "211 %d %d %d %s\n"
318 (1+ (- (cdr range) (car range)))
319 (car range) (cdr range) group))))))))
315 320
316(deffoo nnfolder-request-scan (&optional group server) 321(deffoo nnfolder-request-scan (&optional group server)
317 (nnfolder-possibly-change-group nil server) 322 (nnfolder-possibly-change-group nil server)
@@ -371,13 +376,21 @@ the group. Then the marks file will be regenerated properly by Gnus.")
371(deffoo nnfolder-request-create-group (group &optional server args) 376(deffoo nnfolder-request-create-group (group &optional server args)
372 (nnfolder-possibly-change-group nil server) 377 (nnfolder-possibly-change-group nil server)
373 (nnmail-activate 'nnfolder) 378 (nnmail-activate 'nnfolder)
374 (when (and group 379 (cond ((zerop (length group))
375 (not (assoc group nnfolder-group-alist))) 380 (nnheader-report 'nnfolder "Invalid (empty) group name"))
376 (push (list group (cons 1 0)) nnfolder-group-alist) 381 ((file-directory-p (nnfolder-group-pathname group))
377 (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) 382 (nnheader-report 'nnfolder "%s is a directory"
378 (save-current-buffer 383 (file-name-as-directory
379 (nnfolder-read-folder group))) 384 (let ((nnmail-pathname-coding-system nil))
380 t) 385 (nnfolder-group-pathname group)))))
386 ((assoc group nnfolder-group-alist)
387 t)
388 (t
389 (push (list group (cons 1 0)) nnfolder-group-alist)
390 (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
391 (save-current-buffer
392 (nnfolder-read-folder group))
393 t)))
381 394
382(deffoo nnfolder-request-list (&optional server) 395(deffoo nnfolder-request-list (&optional server)
383 (nnfolder-possibly-change-group nil server) 396 (nnfolder-possibly-change-group nil server)
@@ -416,16 +429,17 @@ the group. Then the marks file will be regenerated properly by Gnus.")
416 ;; The article numbers are increasing, so this result is sorted. 429 ;; The article numbers are increasing, so this result is sorted.
417 (nreverse numbers))))) 430 (nreverse numbers)))))
418 431
419(deffoo nnfolder-request-expire-articles 432(deffoo nnfolder-request-expire-articles (articles newsgroup
420 (articles newsgroup &optional server force) 433 &optional server force)
421 (nnfolder-possibly-change-group newsgroup server) 434 (nnfolder-possibly-change-group newsgroup server)
422 (let* ((is-old t) 435 (let ((is-old t)
423 ;; The articles we have deleted so far. 436 ;; The articles we have deleted so far.
424 (deleted-articles nil) 437 (deleted-articles nil)
425 ;; The articles that really exist and will 438 ;; The articles that really exist and will
426 ;; be expired if they are old enough. 439 ;; be expired if they are old enough.
427 (maybe-expirable 440 (maybe-expirable
428 (gnus-sorted-intersection articles (nnfolder-existing-articles)))) 441 (gnus-sorted-intersection articles (nnfolder-existing-articles)))
442 target)
429 (nnmail-activate 'nnfolder) 443 (nnmail-activate 'nnfolder)
430 444
431 (save-excursion 445 (save-excursion
@@ -445,21 +459,28 @@ the group. Then the marks file will be regenerated properly by Gnus.")
445 (buffer-substring 459 (buffer-substring
446 (point) (progn (end-of-line) (point))) 460 (point) (progn (end-of-line) (point)))
447 force nnfolder-inhibit-expiry)) 461 force nnfolder-inhibit-expiry))
448 (unless (eq nnmail-expiry-target 'delete) 462 (setq target nnmail-expiry-target)
463 (unless (eq target 'delete)
449 (with-temp-buffer 464 (with-temp-buffer
450 (nnfolder-request-article (car maybe-expirable) 465 (nnfolder-request-article (car maybe-expirable)
451 newsgroup server (current-buffer)) 466 newsgroup server (current-buffer))
452 (let ((nnfolder-current-directory nil)) 467 (let ((nnfolder-current-directory nil))
453 (nnmail-expiry-target-group 468 (when (functionp target)
454 nnmail-expiry-target newsgroup))) 469 (setq target (funcall target newsgroup)))
470 (if (and target
471 (or (gnus-request-group target)
472 (gnus-request-create-group target)))
473 (nnmail-expiry-target-group target newsgroup)
474 (setq target nil))))
455 (nnfolder-possibly-change-group newsgroup server)) 475 (nnfolder-possibly-change-group newsgroup server))
456 (nnheader-message 5 "Deleting article %d in %s..." 476 (when target
457 (car maybe-expirable) newsgroup) 477 (nnheader-message 5 "Deleting article %d in %s..."
458 (nnfolder-delete-mail) 478 (car maybe-expirable) newsgroup)
459 (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) 479 (nnfolder-delete-mail)
460 (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) 480 (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
461 ;; Must remember which articles were actually deleted 481 (nnfolder-nov-delete-article newsgroup (car maybe-expirable)))
462 (push (car maybe-expirable) deleted-articles))) 482 ;; Must remember which articles were actually deleted
483 (push (car maybe-expirable) deleted-articles))))
463 (setq maybe-expirable (cdr maybe-expirable))) 484 (setq maybe-expirable (cdr maybe-expirable)))
464 (unless nnfolder-inhibit-expiry 485 (unless nnfolder-inhibit-expiry
465 (nnheader-message 5 "Deleting articles...done")) 486 (nnheader-message 5 "Deleting articles...done"))
@@ -468,8 +489,8 @@ the group. Then the marks file will be regenerated properly by Gnus.")
468 (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) 489 (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
469 (gnus-sorted-difference articles (nreverse deleted-articles))))) 490 (gnus-sorted-difference articles (nreverse deleted-articles)))))
470 491
471(deffoo nnfolder-request-move-article (article group server 492(deffoo nnfolder-request-move-article (article group server accept-form
472 accept-form &optional last) 493 &optional last move-is-internal)
473 (save-excursion 494 (save-excursion
474 (let ((buf (get-buffer-create " *nnfolder move*")) 495 (let ((buf (get-buffer-create " *nnfolder move*"))
475 result) 496 result)
@@ -1029,9 +1050,7 @@ This command does not work if you use short group names."
1029 (when (not (message-mail-file-mbox-p file)) 1050 (when (not (message-mail-file-mbox-p file))
1030 (ignore-errors 1051 (ignore-errors
1031 (delete-file file))))) 1052 (delete-file file)))))
1032 (let ((files (directory-files nnfolder-directory)) 1053 (dolist (file (directory-files nnfolder-directory))
1033 file)
1034 (while (setq file (pop files))
1035 (when (and (not (backup-file-name-p file)) 1054 (when (and (not (backup-file-name-p file))
1036 (message-mail-file-mbox-p 1055 (message-mail-file-mbox-p
1037 (nnheader-concat nnfolder-directory file))) 1056 (nnheader-concat nnfolder-directory file)))
@@ -1046,7 +1065,7 @@ This command does not work if you use short group names."
1046 (nnfolder-possibly-change-folder file) 1065 (nnfolder-possibly-change-folder file)
1047 (nnfolder-possibly-change-group file) 1066 (nnfolder-possibly-change-group file)
1048 (nnfolder-close-group file)))) 1067 (nnfolder-close-group file))))
1049 (nnheader-message 5 ""))) 1068 (nnheader-message 5 ""))
1050 1069
1051(defun nnfolder-group-pathname (group) 1070(defun nnfolder-group-pathname (group)
1052 "Make file name for GROUP." 1071 "Make file name for GROUP."
@@ -1073,7 +1092,8 @@ This command does not work if you use short group names."
1073 (gnus-make-directory (file-name-directory (buffer-file-name))) 1092 (gnus-make-directory (file-name-directory (buffer-file-name)))
1074 (let ((coding-system-for-write 1093 (let ((coding-system-for-write
1075 (or nnfolder-file-coding-system-for-write 1094 (or nnfolder-file-coding-system-for-write
1076 nnfolder-file-coding-system))) 1095 nnfolder-file-coding-system))
1096 (copyright-update nil))
1077 (save-buffer))) 1097 (save-buffer)))
1078 (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) 1098 (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
1079 (nnfolder-save-nov))) 1099 (nnfolder-save-nov)))
@@ -1197,16 +1217,16 @@ This command does not work if you use short group names."
1197 (nnheader-message 8 "Updating marks for %s..." group) 1217 (nnheader-message 8 "Updating marks for %s..." group)
1198 (nnfolder-open-marks group server) 1218 (nnfolder-open-marks group server)
1199 ;; Update info using `nnfolder-marks'. 1219 ;; Update info using `nnfolder-marks'.
1200 (mapcar (lambda (pred) 1220 (mapc (lambda (pred)
1201 (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) 1221 (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
1202 (gnus-info-set-marks 1222 (gnus-info-set-marks
1203 info 1223 info
1204 (gnus-update-alist-soft 1224 (gnus-update-alist-soft
1205 (cdr pred) 1225 (cdr pred)
1206 (cdr (assq (cdr pred) nnfolder-marks)) 1226 (cdr (assq (cdr pred) nnfolder-marks))
1207 (gnus-info-marks info)) 1227 (gnus-info-marks info))
1208 t))) 1228 t)))
1209 gnus-article-mark-lists) 1229 gnus-article-mark-lists)
1210 (let ((seen (cdr (assq 'read nnfolder-marks)))) 1230 (let ((seen (cdr (assq 'read nnfolder-marks))))
1211 (gnus-info-set-read info 1231 (gnus-info-set-read info
1212 (if (and (integerp (car seen)) 1232 (if (and (integerp (car seen))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index aa19967b412..031d2c3d0fb 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -115,7 +115,6 @@ on your system, you could say something like:
115 (autoload 'nnmail-message-id "nnmail") 115 (autoload 'nnmail-message-id "nnmail")
116 (autoload 'mail-position-on-field "sendmail") 116 (autoload 'mail-position-on-field "sendmail")
117 (autoload 'message-remove-header "message") 117 (autoload 'message-remove-header "message")
118 (autoload 'gnus-point-at-eol "gnus-util")
119 (autoload 'gnus-buffer-live-p "gnus-util")) 118 (autoload 'gnus-buffer-live-p "gnus-util"))
120 119
121;;; Header access macros. 120;;; Header access macros.
@@ -209,9 +208,9 @@ on your system, you could say something like:
209 "Return the extra headers in HEADER." 208 "Return the extra headers in HEADER."
210 `(aref ,header 9)) 209 `(aref ,header 9))
211 210
212(defmacro mail-header-set-extra (header extra) 211(defun mail-header-set-extra (header extra)
213 "Set the extra headers in HEADER to EXTRA." 212 "Set the extra headers in HEADER to EXTRA."
214 `(aset ,header 9 ',extra)) 213 (aset header 9 extra))
215 214
216(defsubst make-mail-header (&optional init) 215(defsubst make-mail-header (&optional init)
217 "Create a new mail header structure initialized with INIT." 216 "Create a new mail header structure initialized with INIT."
@@ -227,12 +226,16 @@ on your system, you could say something like:
227 226
228(defvar nnheader-fake-message-id 1) 227(defvar nnheader-fake-message-id 1)
229 228
230(defsubst nnheader-generate-fake-message-id () 229(defsubst nnheader-generate-fake-message-id (&optional number)
231 (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) 230 (if (numberp number)
231 (format "fake+none+%s+%d" gnus-newsgroup-name number)
232 (format "fake+none+%s+%s"
233 gnus-newsgroup-name
234 (int-to-string (incf nnheader-fake-message-id)))))
232 235
233(defsubst nnheader-fake-message-id-p (id) 236(defsubst nnheader-fake-message-id-p (id)
234 (save-match-data ; regular message-id's are <.*> 237 (save-match-data ; regular message-id's are <.*>
235 (string-match "\\`fake\\+none\\+[0-9]+\\'" id))) 238 (string-match "\\`fake\\+none\\+.*\\+[0-9]+\\'" id)))
236 239
237;; Parsing headers and NOV lines. 240;; Parsing headers and NOV lines.
238 241
@@ -243,7 +246,7 @@ on your system, you could say something like:
243 246
244(defsubst nnheader-header-value () 247(defsubst nnheader-header-value ()
245 (skip-chars-forward " \t") 248 (skip-chars-forward " \t")
246 (buffer-substring (point) (gnus-point-at-eol))) 249 (buffer-substring (point) (point-at-eol)))
247 250
248(defun nnheader-parse-naked-head (&optional number) 251(defun nnheader-parse-naked-head (&optional number)
249 ;; This function unfolds continuation lines in this buffer 252 ;; This function unfolds continuation lines in this buffer
@@ -289,12 +292,12 @@ on your system, you could say something like:
289 (goto-char p) 292 (goto-char p)
290 (if (search-forward "\nmessage-id:" nil t) 293 (if (search-forward "\nmessage-id:" nil t)
291 (buffer-substring 294 (buffer-substring
292 (1- (or (search-forward "<" (gnus-point-at-eol) t) 295 (1- (or (search-forward "<" (point-at-eol) t)
293 (point))) 296 (point)))
294 (or (search-forward ">" (gnus-point-at-eol) t) (point))) 297 (or (search-forward ">" (point-at-eol) t) (point)))
295 ;; If there was no message-id, we just fake one to make 298 ;; If there was no message-id, we just fake one to make
296 ;; subsequent routines simpler. 299 ;; subsequent routines simpler.
297 (nnheader-generate-fake-message-id))) 300 (nnheader-generate-fake-message-id number)))
298 ;; References. 301 ;; References.
299 (progn 302 (progn
300 (goto-char p) 303 (goto-char p)
@@ -392,20 +395,29 @@ on your system, you could say something like:
392 out))) 395 out)))
393 out)) 396 out))
394 397
395(defmacro nnheader-nov-read-message-id () 398(eval-and-compile
396 '(let ((id (nnheader-nov-field))) 399 (defvar nnheader-uniquify-message-id nil))
400
401(defmacro nnheader-nov-read-message-id (&optional number)
402 `(let ((id (nnheader-nov-field)))
397 (if (string-match "^<[^>]+>$" id) 403 (if (string-match "^<[^>]+>$" id)
398 id 404 ,(if nnheader-uniquify-message-id
399 (nnheader-generate-fake-message-id)))) 405 `(if (string-match "__[^@]+@" id)
406 (concat (substring id 0 (match-beginning 0))
407 (substring id (1- (match-end 0))))
408 id)
409 'id)
410 (nnheader-generate-fake-message-id ,number))))
400 411
401(defun nnheader-parse-nov () 412(defun nnheader-parse-nov ()
402 (let ((eol (gnus-point-at-eol))) 413 (let ((eol (point-at-eol))
414 (number (nnheader-nov-read-integer)))
403 (vector 415 (vector
404 (nnheader-nov-read-integer) ; number 416 number ; number
405 (nnheader-nov-field) ; subject 417 (nnheader-nov-field) ; subject
406 (nnheader-nov-field) ; from 418 (nnheader-nov-field) ; from
407 (nnheader-nov-field) ; date 419 (nnheader-nov-field) ; date
408 (nnheader-nov-read-message-id) ; id 420 (nnheader-nov-read-message-id number) ; id
409 (nnheader-nov-field) ; refs 421 (nnheader-nov-field) ; refs
410 (nnheader-nov-read-integer) ; chars 422 (nnheader-nov-read-integer) ; chars
411 (nnheader-nov-read-integer) ; lines 423 (nnheader-nov-read-integer) ; lines
@@ -628,7 +640,7 @@ the line could be found."
628 ;; This is invalid, but not all articles have Message-IDs. 640 ;; This is invalid, but not all articles have Message-IDs.
629 () 641 ()
630 (mail-position-on-field "References") 642 (mail-position-on-field "References")
631 (let ((begin (gnus-point-at-bol)) 643 (let ((begin (point-at-bol))
632 (fill-column 78) 644 (fill-column 78)
633 (fill-prefix "\t")) 645 (fill-prefix "\t"))
634 (when references 646 (when references
@@ -662,6 +674,14 @@ the line could be found."
662 (point-max))) 674 (point-max)))
663 (goto-char (point-min))) 675 (goto-char (point-min)))
664 676
677(defun nnheader-get-lines-and-char ()
678 "Return the number of lines and chars in the article body."
679 (goto-char (point-min))
680 (if (not (re-search-forward "\n\r?\n" nil t))
681 (list 0 0)
682 (list (count-lines (point) (point-max))
683 (- (point-max) (point)))))
684
665(defun nnheader-remove-body () 685(defun nnheader-remove-body ()
666 "Remove the body from an article in this current buffer." 686 "Remove the body from an article in this current buffer."
667 (goto-char (point-min)) 687 (goto-char (point-min))
@@ -701,8 +721,7 @@ the line could be found."
701 721
702(defvar nnheader-directory-files-is-safe 722(defvar nnheader-directory-files-is-safe
703 (or (eq system-type 'windows-nt) 723 (or (eq system-type 'windows-nt)
704 (and (not (featurep 'xemacs)) 724 (not (featurep 'xemacs)))
705 (> emacs-major-version 20)))
706 "If non-nil, Gnus believes `directory-files' is safe. 725 "If non-nil, Gnus believes `directory-files' is safe.
707It has been reported numerous times that `directory-files' fails with 726It has been reported numerous times that `directory-files' fails with
708an alarming frequency on NFS mounted file systems. If it is nil, 727an alarming frequency on NFS mounted file systems. If it is nil,
@@ -848,7 +867,9 @@ without formatting."
848 "Message if the Gnus backends are talkative." 867 "Message if the Gnus backends are talkative."
849 (if (or (not (numberp gnus-verbose-backends)) 868 (if (or (not (numberp gnus-verbose-backends))
850 (<= level gnus-verbose-backends)) 869 (<= level gnus-verbose-backends))
851 (apply 'message args) 870 (if gnus-add-timestamp-to-message
871 (apply 'gnus-message-with-timestamp args)
872 (apply 'message args))
852 (apply 'format args))) 873 (apply 'format args)))
853 874
854(defun nnheader-be-verbose (level) 875(defun nnheader-be-verbose (level)
@@ -972,6 +993,7 @@ See `find-file-noselect' for the arguments."
972 (after-insert-file-functions nil) 993 (after-insert-file-functions nil)
973 (enable-local-eval nil) 994 (enable-local-eval nil)
974 (coding-system-for-read nnheader-file-coding-system) 995 (coding-system-for-read nnheader-file-coding-system)
996 (version-control 'never)
975 (ffh (if (boundp 'find-file-hook) 997 (ffh (if (boundp 'find-file-hook)
976 'find-file-hook 998 'find-file-hook
977 'find-file-hooks)) 999 'find-file-hooks))
@@ -1033,7 +1055,6 @@ See `find-file-noselect' for the arguments."
1033 "Strip all \r's from the current buffer." 1055 "Strip all \r's from the current buffer."
1034 (nnheader-skeleton-replace "\r")) 1056 (nnheader-skeleton-replace "\r"))
1035 1057
1036(defalias 'nnheader-run-at-time 'run-at-time)
1037(defalias 'nnheader-cancel-timer 'cancel-timer) 1058(defalias 'nnheader-cancel-timer 'cancel-timer)
1038(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) 1059(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
1039(defalias 'nnheader-string-as-multibyte 'string-as-multibyte) 1060(defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ba23280658a..28938e4c0a6 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -250,10 +250,15 @@ it O(n). If p is small, then the default is probably faster."
250 :type 'boolean 250 :type 'boolean
251 :group 'nnimap) 251 :group 'nnimap)
252 252
253(defvoo nnimap-need-unselect-to-notice-new-mail nil 253(defvoo nnimap-need-unselect-to-notice-new-mail t
254 "Unselect mailboxes before looking for new mail in them. 254 "Unselect mailboxes before looking for new mail in them.
255Some servers seem to need this under some circumstances.") 255Some servers seem to need this under some circumstances.")
256 256
257(defvoo nnimap-logout-timeout nil
258 "Close server immediately if it can't logout in this number of seconds.
259If it is nil, never close server until logout completes. This variable
260overrides `imap-logout-timeout' on a per-server basis.")
261
257;; Authorization / Privacy variables 262;; Authorization / Privacy variables
258 263
259(defvoo nnimap-auth-method nil 264(defvoo nnimap-auth-method nil
@@ -417,6 +422,43 @@ just like \"ticked\" articles, in other IMAP clients.")
417If this is 'imap-mailbox-lsub, then use a server-side subscription list to 422If this is 'imap-mailbox-lsub, then use a server-side subscription list to
418restrict visible folders.") 423restrict visible folders.")
419 424
425(defcustom nnimap-id nil
426 "Plist with client identity to send to server upon login.
427Nil means no information is sent, symbol `no' to disable ID query
428alltogheter, or plist with identifier-value pairs to send to
429server. RFC 2971 describes the list as follows:
430
431 Any string may be sent as a field, but the following are defined to
432 describe certain values that might be sent. Implementations are free
433 to send none, any, or all of these. Strings are not case-sensitive.
434 Field strings MUST NOT be longer than 30 octets. Value strings MUST
435 NOT be longer than 1024 octets. Implementations MUST NOT send more
436 than 30 field-value pairs.
437
438 name Name of the program
439 version Version number of the program
440 os Name of the operating system
441 os-version Version of the operating system
442 vendor Vendor of the client/server
443 support-url URL to contact for support
444 address Postal address of contact/vendor
445 date Date program was released, specified as a date-time
446 in IMAP4rev1
447 command Command used to start the program
448 arguments Arguments supplied on the command line, if any
449 if any
450 environment Description of environment, i.e., UNIX environment
451 variables or Windows registry settings
452
453 Implementations MUST NOT send the same field name more than once.
454
455An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number
456\"os\" system-configuration \"vendor\" \"GNU\")."
457 :group 'nnimap
458 :type '(choice (const :tag "No information" nil)
459 (const :tag "Disable ID query" no)
460 (plist :key-type string :value-type string)))
461
420(defcustom nnimap-debug nil 462(defcustom nnimap-debug nil
421 "If non-nil, random debug spews are placed in *nnimap-debug* buffer. 463 "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
422Note that username, passwords and other privacy sensitive 464Note that username, passwords and other privacy sensitive
@@ -451,6 +493,14 @@ variable unless you are comfortable with that."
451 "Return buffer for SERVER, if nil use current server." 493 "Return buffer for SERVER, if nil use current server."
452 (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) 494 (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
453 495
496(defun nnimap-remove-server-from-buffer-alist (server list)
497 "Remove SERVER from LIST."
498 (let (l)
499 (dolist (e list)
500 (unless (equal server (car-safe e))
501 (push e l)))
502 l))
503
454(defun nnimap-possibly-change-server (server) 504(defun nnimap-possibly-change-server (server)
455 "Return buffer for SERVER, changing the current server as a side-effect. 505 "Return buffer for SERVER, changing the current server as a side-effect.
456If SERVER is nil, uses the current server." 506If SERVER is nil, uses the current server."
@@ -569,7 +619,7 @@ If EXAMINE is non-nil the group is selected read-only."
569 (with-temp-buffer 619 (with-temp-buffer
570 (buffer-disable-undo) 620 (buffer-disable-undo)
571 (insert headers) 621 (insert headers)
572 (let ((head (nnheader-parse-naked-head))) 622 (let ((head (nnheader-parse-naked-head uid)))
573 (mail-header-set-number head uid) 623 (mail-header-set-number head uid)
574 (mail-header-set-chars head chars) 624 (mail-header-set-chars head chars)
575 (mail-header-set-lines head lines) 625 (mail-header-set-lines head lines)
@@ -730,6 +780,8 @@ If EXAMINE is non-nil the group is selected read-only."
730 'nov))) 780 'nov)))
731 781
732(defun nnimap-open-connection (server) 782(defun nnimap-open-connection (server)
783 ;; Note: `nnimap-open-server' that calls this function binds
784 ;; `imap-logout-timeout' to `nnimap-logout-timeout'.
733 (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream 785 (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
734 nnimap-authenticator nnimap-server-buffer)) 786 nnimap-authenticator nnimap-server-buffer))
735 (nnheader-report 'nnimap "Can't open connection to server %s" server) 787 (nnheader-report 'nnimap "Can't open connection to server %s" server)
@@ -739,26 +791,35 @@ If EXAMINE is non-nil the group is selected read-only."
739 (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) 791 (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
740 (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'." 792 (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'."
741 nnimap-authinfo-file) 793 nnimap-authinfo-file)
742 (gnus-parse-netrc nnimap-authinfo-file))) 794 (netrc-parse nnimap-authinfo-file)))
743 (port (if nnimap-server-port 795 (port (if nnimap-server-port
744 (int-to-string nnimap-server-port) 796 (int-to-string nnimap-server-port)
745 "imap")) 797 "imap"))
746 (alist (or (gnus-netrc-machine list server port "imap") 798 (user (netrc-machine-user-or-password
747 (gnus-netrc-machine list server port "imaps") 799 "login"
748 (gnus-netrc-machine list 800 list
749 (or nnimap-server-address 801 (list server
750 nnimap-address) 802 (or nnimap-server-address
751 port "imap") 803 nnimap-address))
752 (gnus-netrc-machine list 804 (list port)
753 (or nnimap-server-address 805 (list "imap" "imaps")))
754 nnimap-address) 806 (passwd (netrc-machine-user-or-password
755 port "imaps"))) 807 "password"
756 (user (gnus-netrc-get alist "login")) 808 list
757 (passwd (gnus-netrc-get alist "password"))) 809 (list server
810 (or nnimap-server-address
811 nnimap-address))
812 (list port)
813 (list "imap" "imaps"))))
758 (if (imap-authenticate user passwd nnimap-server-buffer) 814 (if (imap-authenticate user passwd nnimap-server-buffer)
759 (prog1 815 (prog2
816 (setq nnimap-server-buffer-alist
817 (nnimap-remove-server-from-buffer-alist
818 server
819 nnimap-server-buffer-alist))
760 (push (list server nnimap-server-buffer) 820 (push (list server nnimap-server-buffer)
761 nnimap-server-buffer-alist) 821 nnimap-server-buffer-alist)
822 (imap-id nnimap-id nnimap-server-buffer)
762 (nnimap-possibly-change-server server)) 823 (nnimap-possibly-change-server server))
763 (imap-close nnimap-server-buffer) 824 (imap-close nnimap-server-buffer)
764 (kill-buffer nnimap-server-buffer) 825 (kill-buffer nnimap-server-buffer)
@@ -782,14 +843,15 @@ If EXAMINE is non-nil the group is selected read-only."
782 (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs)))) 843 (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
783 (with-current-buffer (get-buffer-create nnimap-server-buffer) 844 (with-current-buffer (get-buffer-create nnimap-server-buffer)
784 (nnoo-change-server 'nnimap server defs)) 845 (nnoo-change-server 'nnimap server defs))
785 (or (and nnimap-server-buffer 846 (let ((imap-logout-timeout nnimap-logout-timeout))
786 (imap-opened nnimap-server-buffer) 847 (or (and nnimap-server-buffer
787 (if (with-current-buffer nnimap-server-buffer 848 (imap-opened nnimap-server-buffer)
788 (memq imap-state '(auth select examine))) 849 (if (with-current-buffer nnimap-server-buffer
789 t 850 (memq imap-state '(auth selected examine)))
790 (imap-close nnimap-server-buffer) 851 t
791 (nnimap-open-connection server))) 852 (imap-close nnimap-server-buffer)
792 (nnimap-open-connection server)))) 853 (nnimap-open-connection server)))
854 (nnimap-open-connection server)))))
793 855
794(deffoo nnimap-server-opened (&optional server) 856(deffoo nnimap-server-opened (&optional server)
795 "Whether SERVER is opened. 857 "Whether SERVER is opened.
@@ -804,7 +866,8 @@ SERVER is nil, it is treated as the current server."
804(deffoo nnimap-close-server (&optional server) 866(deffoo nnimap-close-server (&optional server)
805 "Close connection to server and free all resources connected to it. 867 "Close connection to server and free all resources connected to it.
806Return nil if the server couldn't be closed for some reason." 868Return nil if the server couldn't be closed for some reason."
807 (let ((server (or server nnimap-current-server))) 869 (let ((server (or server nnimap-current-server))
870 (imap-logout-timeout nnimap-logout-timeout))
808 (when (or (nnimap-server-opened server) 871 (when (or (nnimap-server-opened server)
809 (imap-opened (nnimap-get-server-buffer server))) 872 (imap-opened (nnimap-get-server-buffer server)))
810 (imap-close (nnimap-get-server-buffer server)) 873 (imap-close (nnimap-get-server-buffer server))
@@ -812,7 +875,9 @@ Return nil if the server couldn't be closed for some reason."
812 (setq nnimap-server-buffer nil 875 (setq nnimap-server-buffer nil
813 nnimap-current-server nil 876 nnimap-current-server nil
814 nnimap-server-buffer-alist 877 nnimap-server-buffer-alist
815 (delq server nnimap-server-buffer-alist))) 878 (nnimap-remove-server-from-buffer-alist
879 server
880 nnimap-server-buffer-alist)))
816 (nnoo-close-server 'nnimap server))) 881 (nnoo-close-server 'nnimap server)))
817 882
818(deffoo nnimap-request-close () 883(deffoo nnimap-request-close ()
@@ -820,8 +885,8 @@ Return nil if the server couldn't be closed for some reason."
820All buffers that have been created by that 885All buffers that have been created by that
821backend should be killed. (Not the nntp-server-buffer, though.) This 886backend should be killed. (Not the nntp-server-buffer, though.) This
822function is generally only called when Gnus is shutting down." 887function is generally only called when Gnus is shutting down."
823 (mapcar (lambda (server) (nnimap-close-server (car server))) 888 (mapc (lambda (server) (nnimap-close-server (car server)))
824 nnimap-server-buffer-alist) 889 nnimap-server-buffer-alist)
825 (setq nnimap-server-buffer-alist nil)) 890 (setq nnimap-server-buffer-alist nil))
826 891
827(deffoo nnimap-status-message (&optional server) 892(deffoo nnimap-status-message (&optional server)
@@ -1142,20 +1207,19 @@ function is generally only called when Gnus is shutting down."
1142 seen)) 1207 seen))
1143 (gnus-info-set-read info seen))) 1208 (gnus-info-set-read info seen)))
1144 1209
1145 (mapcar (lambda (pred) 1210 (dolist (pred gnus-article-mark-lists)
1146 (when (or (eq (cdr pred) 'recent) 1211 (when (or (eq (cdr pred) 'recent)
1147 (and (nnimap-mark-permanent-p (cdr pred)) 1212 (and (nnimap-mark-permanent-p (cdr pred))
1148 (member (nnimap-mark-to-flag (cdr pred)) 1213 (member (nnimap-mark-to-flag (cdr pred))
1149 (imap-mailbox-get 'flags)))) 1214 (imap-mailbox-get 'flags))))
1150 (gnus-info-set-marks 1215 (gnus-info-set-marks
1151 info 1216 info
1152 (gnus-update-alist-soft 1217 (gnus-update-alist-soft
1153 (cdr pred) 1218 (cdr pred)
1154 (gnus-compress-sequence 1219 (gnus-compress-sequence
1155 (imap-search (nnimap-mark-to-predicate (cdr pred)))) 1220 (imap-search (nnimap-mark-to-predicate (cdr pred))))
1156 (gnus-info-marks info)) 1221 (gnus-info-marks info))
1157 t))) 1222 t)))
1158 gnus-article-mark-lists)
1159 1223
1160 (when nnimap-importantize-dormant 1224 (when nnimap-importantize-dormant
1161 ;; nnimap mark dormant article as ticked too (for other clients) 1225 ;; nnimap mark dormant article as ticked too (for other clients)
@@ -1207,11 +1271,11 @@ function is generally only called when Gnus is shutting down."
1207 (if (memq 'dormant cmdmarks) 1271 (if (memq 'dormant cmdmarks)
1208 (setq cmdmarks (cons 'tick cmdmarks)))) 1272 (setq cmdmarks (cons 'tick cmdmarks))))
1209 ;; remove stuff we are forbidden to store 1273 ;; remove stuff we are forbidden to store
1210 (mapcar (lambda (mark) 1274 (mapc (lambda (mark)
1211 (if (imap-message-flag-permanent-p 1275 (if (imap-message-flag-permanent-p
1212 (nnimap-mark-to-flag mark)) 1276 (nnimap-mark-to-flag mark))
1213 (setq marks (cons mark marks)))) 1277 (setq marks (cons mark marks))))
1214 cmdmarks) 1278 cmdmarks)
1215 (when (and range marks) 1279 (when (and range marks)
1216 (cond ((eq what 'del) 1280 (cond ((eq what 'del)
1217 (imap-message-flags-del 1281 (imap-message-flags-del
@@ -1472,8 +1536,8 @@ function is generally only called when Gnus is shutting down."
1472 ;; return articles not deleted 1536 ;; return articles not deleted
1473 articles) 1537 articles)
1474 1538
1475(deffoo nnimap-request-move-article (article group server 1539(deffoo nnimap-request-move-article (article group server accept-form
1476 accept-form &optional last) 1540 &optional last move-is-internal)
1477 (when (nnimap-possibly-change-server server) 1541 (when (nnimap-possibly-change-server server)
1478 (save-excursion 1542 (save-excursion
1479 (let ((buf (get-buffer-create " *nnimap move*")) 1543 (let ((buf (get-buffer-create " *nnimap move*"))
@@ -1481,7 +1545,13 @@ function is generally only called when Gnus is shutting down."
1481 (nnimap-current-move-group group) 1545 (nnimap-current-move-group group)
1482 (nnimap-current-move-server nnimap-current-server) 1546 (nnimap-current-move-server nnimap-current-server)
1483 result) 1547 result)
1484 (and (nnimap-request-article article group server) 1548 (gnus-message 10 "nnimap-request-move-article: this is an %s move"
1549 (if move-is-internal
1550 "internal"
1551 "external"))
1552 ;; request the article only when the move is NOT internal
1553 (and (or move-is-internal
1554 (nnimap-request-article article group server))
1485 (save-excursion 1555 (save-excursion
1486 (set-buffer buf) 1556 (set-buffer buf)
1487 (buffer-disable-undo (current-buffer)) 1557 (buffer-disable-undo (current-buffer))
@@ -1558,21 +1628,21 @@ function is generally only called when Gnus is shutting down."
1558 (error "Your server does not support ACL editing")) 1628 (error "Your server does not support ACL editing"))
1559 (with-current-buffer nnimap-server-buffer 1629 (with-current-buffer nnimap-server-buffer
1560 ;; delete all removed identifiers 1630 ;; delete all removed identifiers
1561 (mapcar (lambda (old-acl) 1631 (mapc (lambda (old-acl)
1562 (unless (assoc (car old-acl) new-acls) 1632 (unless (assoc (car old-acl) new-acls)
1563 (or (imap-mailbox-acl-delete (car old-acl) mailbox) 1633 (or (imap-mailbox-acl-delete (car old-acl) mailbox)
1564 (error "Can't delete ACL for %s" (car old-acl))))) 1634 (error "Can't delete ACL for %s" (car old-acl)))))
1565 old-acls) 1635 old-acls)
1566 ;; set all changed acl's 1636 ;; set all changed acl's
1567 (mapcar (lambda (new-acl) 1637 (mapc (lambda (new-acl)
1568 (let ((new-rights (cdr new-acl)) 1638 (let ((new-rights (cdr new-acl))
1569 (old-rights (cdr (assoc (car new-acl) old-acls)))) 1639 (old-rights (cdr (assoc (car new-acl) old-acls))))
1570 (unless (and old-rights new-rights 1640 (unless (and old-rights new-rights
1571 (string= old-rights new-rights)) 1641 (string= old-rights new-rights))
1572 (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) 1642 (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
1573 (error "Can't set ACL for %s to %s" (car new-acl) 1643 (error "Can't set ACL for %s to %s" (car new-acl)
1574 new-rights))))) 1644 new-rights)))))
1575 new-acls) 1645 new-acls)
1576 t))) 1646 t)))
1577 1647
1578 1648
@@ -1651,64 +1721,64 @@ be used in a STORE FLAGS command."
1651(when nnimap-debug 1721(when nnimap-debug
1652 (require 'trace) 1722 (require 'trace)
1653 (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) 1723 (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
1654 (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer)) 1724 (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer))
1655 '( 1725 '(
1656 nnimap-possibly-change-server 1726 nnimap-possibly-change-server
1657 nnimap-verify-uidvalidity 1727 nnimap-verify-uidvalidity
1658 nnimap-find-minmax-uid 1728 nnimap-find-minmax-uid
1659 nnimap-before-find-minmax-bugworkaround 1729 nnimap-before-find-minmax-bugworkaround
1660 nnimap-possibly-change-group 1730 nnimap-possibly-change-group
1661 ;;nnimap-replace-whitespace 1731 ;;nnimap-replace-whitespace
1662 nnimap-retrieve-headers-progress 1732 nnimap-retrieve-headers-progress
1663 nnimap-retrieve-which-headers 1733 nnimap-retrieve-which-headers
1664 nnimap-group-overview-filename 1734 nnimap-group-overview-filename
1665 nnimap-retrieve-headers-from-file 1735 nnimap-retrieve-headers-from-file
1666 nnimap-retrieve-headers-from-server 1736 nnimap-retrieve-headers-from-server
1667 nnimap-retrieve-headers 1737 nnimap-retrieve-headers
1668 nnimap-open-connection 1738 nnimap-open-connection
1669 nnimap-open-server 1739 nnimap-open-server
1670 nnimap-server-opened 1740 nnimap-server-opened
1671 nnimap-close-server 1741 nnimap-close-server
1672 nnimap-request-close 1742 nnimap-request-close
1673 nnimap-status-message 1743 nnimap-status-message
1674 ;;nnimap-demule 1744 ;;nnimap-demule
1675 nnimap-request-article-part 1745 nnimap-request-article-part
1676 nnimap-request-article 1746 nnimap-request-article
1677 nnimap-request-head 1747 nnimap-request-head
1678 nnimap-request-body 1748 nnimap-request-body
1679 nnimap-request-group 1749 nnimap-request-group
1680 nnimap-close-group 1750 nnimap-close-group
1681 nnimap-pattern-to-list-arguments 1751 nnimap-pattern-to-list-arguments
1682 nnimap-request-list 1752 nnimap-request-list
1683 nnimap-request-post 1753 nnimap-request-post
1684 nnimap-retrieve-groups 1754 nnimap-retrieve-groups
1685 nnimap-request-update-info-internal 1755 nnimap-request-update-info-internal
1686 nnimap-request-type 1756 nnimap-request-type
1687 nnimap-request-set-mark 1757 nnimap-request-set-mark
1688 nnimap-split-to-groups 1758 nnimap-split-to-groups
1689 nnimap-split-find-rule 1759 nnimap-split-find-rule
1690 nnimap-split-find-inbox 1760 nnimap-split-find-inbox
1691 nnimap-split-articles 1761 nnimap-split-articles
1692 nnimap-request-scan 1762 nnimap-request-scan
1693 nnimap-request-newgroups 1763 nnimap-request-newgroups
1694 nnimap-request-create-group 1764 nnimap-request-create-group
1695 nnimap-time-substract 1765 nnimap-time-substract
1696 nnimap-date-days-ago 1766 nnimap-date-days-ago
1697 nnimap-request-expire-articles-progress 1767 nnimap-request-expire-articles-progress
1698 nnimap-request-expire-articles 1768 nnimap-request-expire-articles
1699 nnimap-request-move-article 1769 nnimap-request-move-article
1700 nnimap-request-accept-article 1770 nnimap-request-accept-article
1701 nnimap-request-delete-group 1771 nnimap-request-delete-group
1702 nnimap-request-rename-group 1772 nnimap-request-rename-group
1703 gnus-group-nnimap-expunge 1773 gnus-group-nnimap-expunge
1704 gnus-group-nnimap-edit-acl 1774 gnus-group-nnimap-edit-acl
1705 gnus-group-nnimap-edit-acl-done 1775 gnus-group-nnimap-edit-acl-done
1706 nnimap-group-mode-hook 1776 nnimap-group-mode-hook
1707 nnimap-mark-to-predicate 1777 nnimap-mark-to-predicate
1708 nnimap-mark-to-flag-1 1778 nnimap-mark-to-flag-1
1709 nnimap-mark-to-flag 1779 nnimap-mark-to-flag
1710 nnimap-mark-permanent-p 1780 nnimap-mark-permanent-p
1711 ))) 1781 )))
1712 1782
1713(provide 'nnimap) 1783(provide 'nnimap)
1714 1784
diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el
index 7c7fb5a54ab..78e35c410bb 100644
--- a/lisp/gnus/nnkiboze.el
+++ b/lisp/gnus/nnkiboze.el
@@ -227,7 +227,7 @@ Finds out what articles are to be part of the nnkiboze groups."
227 "." gnus-score-file-suffix)))))) 227 "." gnus-score-file-suffix))))))
228 228
229(defun nnkiboze-generate-group (group &optional inhibit-list-groups) 229(defun nnkiboze-generate-group (group &optional inhibit-list-groups)
230 (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) 230 (let* ((info (gnus-get-info group))
231 (newsrc-file (concat nnkiboze-directory 231 (newsrc-file (concat nnkiboze-directory
232 (nnheader-translate-file-chars 232 (nnheader-translate-file-chars
233 (concat group ".newsrc")))) 233 (concat group ".newsrc"))))
@@ -269,8 +269,7 @@ Finds out what articles are to be part of the nnkiboze groups."
269 (numberp (car (symbol-value group))) ; It is active 269 (numberp (car (symbol-value group))) ; It is active
270 (or (> nnkiboze-level 7) 270 (or (> nnkiboze-level 7)
271 (and (setq glevel 271 (and (setq glevel
272 (nth 1 (nth 2 (gnus-gethash 272 (gnus-info-level (gnus-get-info gname)))
273 gname gnus-newsrc-hashtb))))
274 (>= nnkiboze-level glevel))) 273 (>= nnkiboze-level glevel)))
275 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes 274 (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
276 (push (cons gname (1- (car (symbol-value group)))) 275 (push (cons gname (1- (car (symbol-value group))))
@@ -282,8 +281,7 @@ Finds out what articles are to be part of the nnkiboze groups."
282 ;; number that has been kibozed in GROUP in this kiboze group. 281 ;; number that has been kibozed in GROUP in this kiboze group.
283 (setq newsrc nnkiboze-newsrc) 282 (setq newsrc nnkiboze-newsrc)
284 (while newsrc 283 (while newsrc
285 (if (not (setq active (gnus-gethash 284 (if (not (setq active (gnus-active (caar newsrc))))
286 (caar newsrc) gnus-active-hashtb)))
287 ;; This group isn't active after all, so we remove it from 285 ;; This group isn't active after all, so we remove it from
288 ;; the list of component groups. 286 ;; the list of component groups.
289 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) 287 (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
@@ -294,8 +292,7 @@ Finds out what articles are to be part of the nnkiboze groups."
294 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) 292 (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
295 (setq ginfo (gnus-get-info (gnus-group-group-name)) 293 (setq ginfo (gnus-get-info (gnus-group-group-name))
296 orig-info (gnus-copy-sequence ginfo) 294 orig-info (gnus-copy-sequence ginfo)
297 num-unread (car (gnus-gethash (caar newsrc) 295 num-unread (gnus-group-unread (caar newsrc)))
298 gnus-newsrc-hashtb)))
299 (unwind-protect 296 (unwind-protect
300 (progn 297 (progn
301 ;; We set all list of article marks to nil. Since we operate 298 ;; We set all list of article marks to nil. Since we operate
@@ -338,8 +335,7 @@ Finds out what articles are to be part of the nnkiboze groups."
338 ;; Restore the proper info. 335 ;; Restore the proper info.
339 (when ginfo 336 (when ginfo
340 (setcdr ginfo (cdr orig-info))) 337 (setcdr ginfo (cdr orig-info)))
341 (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) 338 (setcar (gnus-group-entry (caar newsrc)) num-unread)))
342 num-unread)))
343 (setcdr (car newsrc) (cdr active)) 339 (setcdr (car newsrc) (cdr active))
344 (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) 340 (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
345 (setq newsrc (cdr newsrc))))) 341 (setq newsrc (cdr newsrc)))))
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 35f5476f9b4..7608660f019 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -32,7 +32,6 @@
32(require 'gnus) ; for macro gnus-kill-buffer, at least 32(require 'gnus) ; for macro gnus-kill-buffer, at least
33(require 'nnheader) 33(require 'nnheader)
34(require 'message) 34(require 'message)
35(require 'custom)
36(require 'gnus-util) 35(require 'gnus-util)
37(require 'mail-source) 36(require 'mail-source)
38(require 'mm-util) 37(require 'mm-util)
@@ -298,7 +297,10 @@ Eg.
298\(add-hook 'nnmail-read-incoming-hook 297\(add-hook 'nnmail-read-incoming-hook
299 (lambda () 298 (lambda ()
300 (call-process \"/local/bin/mailsend\" nil nil nil 299 (call-process \"/local/bin/mailsend\" nil nil nil
301 \"read\" nnmail-spool-file))) 300 \"read\"
301 ;; The incoming mail box file.
302 (expand-file-name (user-login-name)
303 rmail-spool-directory))))
302 304
303If you have xwatch running, this will alert it that mail has been 305If you have xwatch running, this will alert it that mail has been
304read. 306read.
@@ -412,13 +414,13 @@ This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
412 (const :format "" &) 414 (const :format "" &)
413 (editable-list :inline t nnmail-split-fancy)) 415 (editable-list :inline t nnmail-split-fancy))
414 (list :tag "Function with fixed arguments (:)" 416 (list :tag "Function with fixed arguments (:)"
415 :value (: nil) 417 :value (:)
416 (const :format "" :value :) 418 (const :format "" :value :)
417 function 419 function
418 (editable-list :inline t (sexp :tag "Arg")) 420 (editable-list :inline t (sexp :tag "Arg"))
419 ) 421 )
420 (list :tag "Function with split arguments (!)" 422 (list :tag "Function with split arguments (!)"
421 :value (! nil) 423 :value (!)
422 (const :format "" !) 424 (const :format "" !)
423 function 425 function
424 (editable-list :inline t nnmail-split-fancy)) 426 (editable-list :inline t nnmail-split-fancy))
@@ -476,7 +478,7 @@ FIELD must match a complete field name. VALUE must match a complete
476word according to the `nnmail-split-fancy-syntax-table' syntax table. 478word according to the `nnmail-split-fancy-syntax-table' syntax table.
477You can use \".*\" in the regexps to match partial field names or words. 479You can use \".*\" in the regexps to match partial field names or words.
478 480
479FIELD and VALUE can also be lisp symbols, in that case they are expanded 481FIELD and VALUE can also be Lisp symbols, in that case they are expanded
480as specified in `nnmail-split-abbrev-alist'. 482as specified in `nnmail-split-abbrev-alist'.
481 483
482GROUP can contain \\& and \\N which will substitute from matching 484GROUP can contain \\& and \\N which will substitute from matching
@@ -660,9 +662,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
660 (expand-file-name group dir) 662 (expand-file-name group dir)
661 ;; If not, we translate dots into slashes. 663 ;; If not, we translate dots into slashes.
662 (expand-file-name 664 (expand-file-name
663 (mm-encode-coding-string 665 (nnheader-replace-chars-in-string group ?. ?/)
664 (nnheader-replace-chars-in-string group ?. ?/)
665 nnmail-pathname-coding-system)
666 dir)))) 666 dir))))
667 (or file ""))) 667 (or file "")))
668 668
@@ -687,7 +687,7 @@ nn*-request-list should have been called before calling this function."
687 (while (not (eobp)) 687 (while (not (eobp))
688 (condition-case err 688 (condition-case err
689 (progn 689 (progn
690 (narrow-to-region (point) (gnus-point-at-eol)) 690 (narrow-to-region (point) (point-at-eol))
691 (setq group (read buffer)) 691 (setq group (read buffer))
692 (unless (stringp group) 692 (unless (stringp group)
693 (setq group (symbol-name group))) 693 (setq group (symbol-name group)))
@@ -1047,6 +1047,9 @@ If SOURCE is a directory spec, try to return the group name component."
1047 (nnmail-check-duplication message-id func artnum-func)) 1047 (nnmail-check-duplication message-id func artnum-func))
1048 1)) 1048 1))
1049 1049
1050(defvar nnmail-group-names-not-encoded-p nil
1051 "Non-nil means group names are not encoded.")
1052
1050(defun nnmail-split-incoming (incoming func &optional exit-func 1053(defun nnmail-split-incoming (incoming func &optional exit-func
1051 group artnum-func) 1054 group artnum-func)
1052 "Go through the entire INCOMING file and pick out each individual mail. 1055 "Go through the entire INCOMING file and pick out each individual mail.
@@ -1056,7 +1059,8 @@ FUNC will be called with the buffer narrowed to each mail."
1056 (nnmail-split-methods (if (and group 1059 (nnmail-split-methods (if (and group
1057 (not nnmail-resplit-incoming)) 1060 (not nnmail-resplit-incoming))
1058 (list (list group "")) 1061 (list (list group ""))
1059 nnmail-split-methods))) 1062 nnmail-split-methods))
1063 (nnmail-group-names-not-encoded-p t))
1060 (save-excursion 1064 (save-excursion
1061 ;; Insert the incoming file. 1065 ;; Insert the incoming file.
1062 (set-buffer (get-buffer-create nnmail-article-buffer)) 1066 (set-buffer (get-buffer-create nnmail-article-buffer))
@@ -1125,7 +1129,7 @@ FUNC will be called with the group name to determine the article number."
1125 (while (not (eobp)) 1129 (while (not (eobp))
1126 (unless (< (move-to-column nnmail-split-header-length-limit) 1130 (unless (< (move-to-column nnmail-split-header-length-limit)
1127 nnmail-split-header-length-limit) 1131 nnmail-split-header-length-limit)
1128 (delete-region (point) (gnus-point-at-eol))) 1132 (delete-region (point) (point-at-eol)))
1129 (forward-line 1)) 1133 (forward-line 1))
1130 ;; Allow washing. 1134 ;; Allow washing.
1131 (goto-char (point-min)) 1135 (goto-char (point-min))
@@ -1247,11 +1251,11 @@ Return the number of characters in the body."
1247 (progn (forward-line 1) (point)))) 1251 (progn (forward-line 1) (point))))
1248 (insert (format "Xref: %s" (system-name))) 1252 (insert (format "Xref: %s" (system-name)))
1249 (while group-alist 1253 (while group-alist
1250 (insert (format " %s:%d" 1254 (insert (if (mm-multibyte-p)
1251 (mm-encode-coding-string 1255 (mm-string-as-multibyte
1252 (caar group-alist) 1256 (format " %s:%d" (caar group-alist) (cdar group-alist)))
1253 nnmail-pathname-coding-system) 1257 (mm-string-as-unibyte
1254 (cdar group-alist))) 1258 (format " %s:%d" (caar group-alist) (cdar group-alist)))))
1255 (setq group-alist (cdr group-alist))) 1259 (setq group-alist (cdr group-alist)))
1256 (insert "\n"))) 1260 (insert "\n")))
1257 1261
@@ -1285,10 +1289,20 @@ Return the number of characters in the body."
1285 "Translate TAB characters into SPACE characters." 1289 "Translate TAB characters into SPACE characters."
1286 (subst-char-in-region (point-min) (point-max) ?\t ? t)) 1290 (subst-char-in-region (point-min) (point-max) ?\t ? t))
1287 1291
1288(defun nnmail-fix-eudora-headers () 1292(defcustom nnmail-broken-references-mailers
1289 "Eudora has a broken References line, but an OK In-Reply-To." 1293 "^X-Mailer:.*\\(Eudora\\|Pegasus\\)"
1294 "Header line matching mailer producing bogus References lines.
1295See `nnmail-ignore-broken-references'."
1296 :group 'nnmail-prepare
1297 :version "23.0" ;; No Gnus
1298 :type 'regexp)
1299
1300(defun nnmail-ignore-broken-references ()
1301 "Ignore the References line and use In-Reply-To
1302
1303Eudora has a broken References line, but an OK In-Reply-To."
1290 (goto-char (point-min)) 1304 (goto-char (point-min))
1291 (when (re-search-forward "^X-Mailer:.*Eudora" nil t) 1305 (when (re-search-forward nnmail-broken-references-mailers nil t)
1292 (goto-char (point-min)) 1306 (goto-char (point-min))
1293 (when (re-search-forward "^References:" nil t) 1307 (when (re-search-forward "^References:" nil t)
1294 (beginning-of-line) 1308 (beginning-of-line)
@@ -1297,8 +1311,11 @@ Return the number of characters in the body."
1297 (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) 1311 (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
1298 (replace-match "\\1" t)))) 1312 (replace-match "\\1" t))))
1299 1313
1314(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
1315(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
1316
1300(custom-add-option 'nnmail-prepare-incoming-header-hook 1317(custom-add-option 'nnmail-prepare-incoming-header-hook
1301 'nnmail-fix-eudora-headers) 1318 'nnmail-ignore-broken-references)
1302 1319
1303;;; Utility functions 1320;;; Utility functions
1304 1321
@@ -1327,12 +1344,8 @@ to actually put the message in the right group."
1327(defun nnmail-split-fancy () 1344(defun nnmail-split-fancy ()
1328 "Fancy splitting method. 1345 "Fancy splitting method.
1329See the documentation for the variable `nnmail-split-fancy' for details." 1346See the documentation for the variable `nnmail-split-fancy' for details."
1330 (let ((syntab (syntax-table))) 1347 (with-syntax-table nnmail-split-fancy-syntax-table
1331 (unwind-protect 1348 (nnmail-split-it nnmail-split-fancy)))
1332 (progn
1333 (set-syntax-table nnmail-split-fancy-syntax-table)
1334 (nnmail-split-it nnmail-split-fancy))
1335 (set-syntax-table syntab))))
1336 1349
1337(defvar nnmail-split-cache nil) 1350(defvar nnmail-split-cache nil)
1338;; Alist of split expressions their equivalent regexps. 1351;; Alist of split expressions their equivalent regexps.
@@ -1644,7 +1657,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
1644 (skip-chars-forward "^\n\r\t") 1657 (skip-chars-forward "^\n\r\t")
1645 (unless (looking-at "[\r\n]") 1658 (unless (looking-at "[\r\n]")
1646 (forward-char 1) 1659 (forward-char 1)
1647 (buffer-substring (point) (gnus-point-at-eol))))))) 1660 (buffer-substring (point) (point-at-eol)))))))
1648 1661
1649;; Function for nnmail-split-fancy: look up all references in the 1662;; Function for nnmail-split-fancy: look up all references in the
1650;; cache and if a match is found, return that group. 1663;; cache and if a match is found, return that group.
@@ -1672,12 +1685,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1672 (setq references (nreverse (gnus-split-references refstr))) 1685 (setq references (nreverse (gnus-split-references refstr)))
1673 (unless (gnus-buffer-live-p nnmail-cache-buffer) 1686 (unless (gnus-buffer-live-p nnmail-cache-buffer)
1674 (nnmail-cache-open)) 1687 (nnmail-cache-open))
1675 (mapcar (lambda (x) 1688 (dolist (x references)
1676 (setq res (or (nnmail-cache-fetch-group x) res)) 1689 (setq res (or (nnmail-cache-fetch-group x) res))
1677 (when (or (member res '("delayed" "drafts" "queue")) 1690 (when (or (member res '("delayed" "drafts" "queue"))
1678 (and regexp res (string-match regexp res))) 1691 (and regexp res (string-match regexp res)))
1679 (setq res nil))) 1692 (setq res nil)))
1680 references)
1681 res))) 1693 res)))
1682 1694
1683(defun nnmail-cache-id-exists-p (id) 1695(defun nnmail-cache-id-exists-p (id)
@@ -1902,7 +1914,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1902 (or (string-match (cadr regexp-target-pair) from) 1914 (or (string-match (cadr regexp-target-pair) from)
1903 (and (string-match (cadr regexp-target-pair) to) 1915 (and (string-match (cadr regexp-target-pair) to)
1904 (let ((rmail-dont-reply-to-names 1916 (let ((rmail-dont-reply-to-names
1905 message-dont-reply-to-names)) 1917 (message-dont-reply-to-names)))
1906 (equal (rmail-dont-reply-to from) ""))))) 1918 (equal (rmail-dont-reply-to from) "")))))
1907 (setq target (format-time-string (caddr regexp-target-pair) date))) 1919 (setq target (format-time-string (caddr regexp-target-pair) date)))
1908 ((and (not (equal header 'to-from)) 1920 ((and (not (equal header 'to-from))
@@ -1995,14 +2007,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1995 (with-output-to-temp-buffer "*nnmail split history*" 2007 (with-output-to-temp-buffer "*nnmail split history*"
1996 (with-current-buffer standard-output 2008 (with-current-buffer standard-output
1997 (fundamental-mode)) ; for Emacs 20.4+ 2009 (fundamental-mode)) ; for Emacs 20.4+
1998 (let ((history nnmail-split-history) 2010 (dolist (elem nnmail-split-history)
1999 elem)
2000 (while (setq elem (pop history))
2001 (princ (mapconcat (lambda (ga) 2011 (princ (mapconcat (lambda (ga)
2002 (concat (car ga) ":" (int-to-string (cdr ga)))) 2012 (concat (car ga) ":" (int-to-string (cdr ga))))
2003 elem 2013 elem
2004 ", ")) 2014 ", "))
2005 (princ "\n"))))) 2015 (princ "\n"))))
2006 2016
2007(defun nnmail-purge-split-history (group) 2017(defun nnmail-purge-split-history (group)
2008 "Remove all instances of GROUP from `nnmail-split-history'." 2018 "Remove all instances of GROUP from `nnmail-split-history'."
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 6769c902e2b..04b6af72aed 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -41,6 +41,8 @@
41;; copying, restoring, etc. 41;; copying, restoring, etc.
42;; 42;;
43;; Todo: 43;; Todo:
44;; * When moving an article for expiry, copy all the marks except 'expire
45;; from the original article.
44;; * Add a hook for when moving messages from new/ to cur/, to support 46;; * Add a hook for when moving messages from new/ to cur/, to support
45;; nnmail's duplicate detection. 47;; nnmail's duplicate detection.
46;; * Improve generated Xrefs, so crossposts are detectable. 48;; * Improve generated Xrefs, so crossposts are detectable.
@@ -54,6 +56,7 @@
54 (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0) 56 (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
55 (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0) 57 (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
56 (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0) 58 (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
59 (put 'nnmaildir--condcase 'lisp-indent-function 2)
57 ) 60 )
58] 61]
59 62
@@ -229,7 +232,6 @@ by nnmaildir-request-article.")
229(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov")) 232(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
230(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks")) 233(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
231(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num")) 234(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
232(defmacro nnmaildir--num-file (dir) `(concat ,dir ":"))
233 235
234(defmacro nnmaildir--unlink (file-arg) 236(defmacro nnmaildir--unlink (file-arg)
235 `(let ((file ,file-arg)) 237 `(let ((file ,file-arg))
@@ -237,20 +239,36 @@ by nnmaildir-request-article.")
237(defun nnmaildir--mkdir (dir) 239(defun nnmaildir--mkdir (dir)
238 (or (file-exists-p (file-name-as-directory dir)) 240 (or (file-exists-p (file-name-as-directory dir))
239 (make-directory-internal (directory-file-name dir)))) 241 (make-directory-internal (directory-file-name dir))))
242(defun nnmaildir--mkfile (file)
243 (write-region "" nil file nil 'no-message))
240(defun nnmaildir--delete-dir-files (dir ls) 244(defun nnmaildir--delete-dir-files (dir ls)
241 (when (file-attributes dir) 245 (when (file-attributes dir)
242 (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort)) 246 (mapc 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
243 (delete-directory dir))) 247 (delete-directory dir)))
244 248
245(defun nnmaildir--group-maxnum (server group) 249(defun nnmaildir--group-maxnum (server group)
246 (if (zerop (nnmaildir--grp-count group)) 0 250 (catch 'return
247 (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server) 251 (if (zerop (nnmaildir--grp-count group)) (throw 'return 0))
248 (nnmaildir--grp-name group)))) 252 (let ((dir (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
249 (setq x (nnmaildir--nndir x) 253 (nnmaildir--grp-name group)))
250 x (nnmaildir--num-dir x) 254 (number-opened 1)
251 x (nnmaildir--num-file x) 255 attr ino-opened nlink number-linked)
252 x (file-attributes x)) 256 (setq dir (nnmaildir--nndir dir)
253 (if x (1- (nth 1 x)) 0)))) 257 dir (nnmaildir--num-dir dir))
258 (while t
259 (setq attr (file-attributes
260 (concat dir (number-to-string number-opened))))
261 (or attr (throw 'return (1- number-opened)))
262 (setq ino-opened (nth 10 attr)
263 nlink (nth 1 attr)
264 number-linked (+ number-opened nlink))
265 (if (or (< nlink 1) (< number-linked nlink))
266 (signal 'error '("Arithmetic overflow")))
267 (setq attr (file-attributes
268 (concat dir (number-to-string number-linked))))
269 (or attr (throw 'return (1- number-linked)))
270 (if (/= ino-opened (nth 10 attr))
271 (setq number-opened number-linked))))))
254 272
255;; Make the given server, if non-nil, be the current server. Then make the 273;; Make the given server, if non-nil, be the current server. Then make the
256;; given group, if non-nil, be the current group of the current server. Then 274;; given group, if non-nil, be the current group of the current server. Then
@@ -287,6 +305,64 @@ by nnmaildir-request-article.")
287 (setq pos (match-end 0)))) 305 (setq pos (match-end 0))))
288 string) 306 string)
289 307
308(defmacro nnmaildir--condcase (errsym body &rest handler)
309 `(condition-case ,errsym
310 (let ((system-messages-locale "C")) ,body)
311 (error . ,handler)))
312
313(defun nnmaildir--emlink-p (err)
314 (and (eq (car err) 'file-error)
315 (string= (downcase (caddr err)) "too many links")))
316
317(defun nnmaildir--enoent-p (err)
318 (and (eq (car err) 'file-error)
319 (string= (downcase (caddr err)) "no such file or directory")))
320
321(defun nnmaildir--eexist-p (err)
322 (eq (car err) 'file-already-exists))
323
324(defun nnmaildir--new-number (nndir)
325 "Allocate a new article number by atomically creating a file under NNDIR."
326 (let ((numdir (nnmaildir--num-dir nndir))
327 (make-new-file t)
328 (number-open 1)
329 number-link previous-number-link path-open path-link ino-open)
330 (nnmaildir--mkdir numdir)
331 (catch 'return
332 (while t
333 (setq path-open (concat numdir (number-to-string number-open)))
334 (if (not make-new-file)
335 (setq previous-number-link number-link)
336 (nnmaildir--mkfile path-open)
337 ;; If Emacs had O_CREAT|O_EXCL, we could return number-open here.
338 (setq make-new-file nil
339 previous-number-link 0))
340 (let* ((attr (file-attributes path-open))
341 (nlink (nth 1 attr)))
342 (setq ino-open (nth 10 attr)
343 number-link (+ number-open nlink))
344 (if (or (< nlink 1) (< number-link nlink))
345 (signal 'error '("Arithmetic overflow"))))
346 (if (= number-link previous-number-link)
347 ;; We've already tried this number, in the previous loop iteration,
348 ;; and failed.
349 (signal 'error `("Corrupt internal nnmaildir data" ,path-open)))
350 (setq path-link (concat numdir (number-to-string number-link)))
351 (nnmaildir--condcase err
352 (progn
353 (add-name-to-file path-open path-link)
354 (throw 'return number-link))
355 (cond
356 ((nnmaildir--emlink-p err)
357 (setq make-new-file t
358 number-open number-link))
359 ((nnmaildir--eexist-p err)
360 (let ((attr (file-attributes path-link)))
361 (if (/= (nth 10 attr) ino-open)
362 (setq number-open number-link
363 number-link 0))))
364 (t (signal (car err) (cdr err)))))))))
365
290(defun nnmaildir--update-nov (server group article) 366(defun nnmaildir--update-nov (server group article)
291 (let ((nnheader-file-coding-system 'binary) 367 (let ((nnheader-file-coding-system 'binary)
292 (srv-dir (nnmaildir--srv-dir server)) 368 (srv-dir (nnmaildir--srv-dir server))
@@ -398,30 +474,7 @@ by nnmaildir-request-article.")
398 nnmaildir--extra) 474 nnmaildir--extra)
399 num (nnmaildir--art-num article)) 475 num (nnmaildir--art-num article))
400 (unless num 476 (unless num
401 ;; Allocate a new article number. 477 (setq num (nnmaildir--new-number dir))
402 (erase-buffer)
403 (setq numdir (nnmaildir--num-dir dir)
404 file (nnmaildir--num-file numdir)
405 num -1)
406 (nnmaildir--mkdir numdir)
407 (write-region "" nil file nil 'no-message)
408 (while file
409 ;; Get the number of links to file.
410 (setq attr (nth 1 (file-attributes file)))
411 (if (= attr num)
412 ;; We've already tried this number, in the previous loop
413 ;; iteration, and failed.
414 (signal 'error `("Corrupt internal nnmaildir data" ,numdir)))
415 ;; If attr is 123, try to link file to "123". This atomically
416 ;; increases the link count and creates the "123" link, failing
417 ;; if that link was already created by another Gnus, just after
418 ;; we stat()ed file.
419 (condition-case nil
420 (progn
421 (add-name-to-file file (concat numdir (format "%x" attr)))
422 (setq file nil)) ;; Stop looping.
423 (file-already-exists nil))
424 (setq num attr))
425 (setf (nnmaildir--art-num article) num)) 478 (setf (nnmaildir--art-num article) num))
426 ;; Store this new NOV data in a file 479 ;; Store this new NOV data in a file
427 (erase-buffer) 480 (erase-buffer)
@@ -683,8 +736,7 @@ by nnmaildir-request-article.")
683 group (make-nnmaildir--grp :name gname :index 0)) 736 group (make-nnmaildir--grp :name gname :index 0))
684 (nnmaildir--mkdir nndir) 737 (nnmaildir--mkdir nndir)
685 (nnmaildir--mkdir (nnmaildir--nov-dir nndir)) 738 (nnmaildir--mkdir (nnmaildir--nov-dir nndir))
686 (nnmaildir--mkdir (nnmaildir--marks-dir nndir)) 739 (nnmaildir--mkdir (nnmaildir--marks-dir nndir)))
687 (write-region "" nil (concat nndir "markfile") nil 'no-message))
688 (setq read-only (nnmaildir--param pgname 'read-only) 740 (setq read-only (nnmaildir--param pgname 'read-only)
689 ls (or (nnmaildir--param pgname 'directory-files) srv-ls)) 741 ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
690 (unless read-only 742 (unless read-only
@@ -693,12 +745,10 @@ by nnmaildir-request-article.")
693 (setf (nnmaildir--srv-error nnmaildir--cur-server) 745 (setf (nnmaildir--srv-error nnmaildir--cur-server)
694 (concat "Maildir spans filesystems: " absdir)) 746 (concat "Maildir spans filesystems: " absdir))
695 (throw 'return nil)) 747 (throw 'return nil))
696 (mapcar 748 (dolist (file (funcall ls tdir 'full "\\`[^.]" 'nosort))
697 (lambda (file) 749 (setq x (file-attributes file))
698 (setq x (file-attributes file)) 750 (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago))
699 (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago)) 751 (delete-file file))))
700 (delete-file file)))
701 (funcall ls tdir 'full "\\`[^.]" 'nosort)))
702 (or scan-msgs 752 (or scan-msgs
703 isnew 753 isnew
704 (throw 'return t)) 754 (throw 'return t))
@@ -707,12 +757,10 @@ by nnmaildir-request-article.")
707 (setq nattr nil)) 757 (setq nattr nil))
708 (if read-only (setq dir (and (or isnew nattr) ndir)) 758 (if read-only (setq dir (and (or isnew nattr) ndir))
709 (when (or isnew nattr) 759 (when (or isnew nattr)
710 (mapcar 760 (dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
711 (lambda (file) 761 (setq x (concat ndir file))
712 (let ((path (concat ndir file))) 762 (and (time-less-p (nth 5 (file-attributes x)) (current-time))
713 (and (time-less-p (nth 5 (file-attributes path)) (current-time)) 763 (rename-file x (concat cdir file ":2,"))))
714 (rename-file path (concat cdir file ":2,")))))
715 (funcall ls ndir nil "\\`[^.]" 'nosort))
716 (setf (nnmaildir--grp-new group) nattr)) 764 (setf (nnmaildir--grp-new group) nattr))
717 (setq cattr (nth 5 (file-attributes cdir))) 765 (setq cattr (nth 5 (file-attributes cdir)))
718 (if (equal cattr (nnmaildir--grp-cur group)) 766 (if (equal cattr (nnmaildir--grp-cur group))
@@ -737,13 +785,11 @@ by nnmaildir-request-article.")
737 cdir (nnmaildir--marks-dir nndir) 785 cdir (nnmaildir--marks-dir nndir)
738 ndir (nnmaildir--subdir cdir "tick") 786 ndir (nnmaildir--subdir cdir "tick")
739 cdir (nnmaildir--subdir cdir "read")) 787 cdir (nnmaildir--subdir cdir "read"))
740 (mapcar 788 (dolist (file files)
741 (lambda (file) 789 (setq file (car file))
742 (setq file (car file)) 790 (if (or (not (file-exists-p (concat cdir file)))
743 (if (or (not (file-exists-p (concat cdir file))) 791 (file-exists-p (concat ndir file)))
744 (file-exists-p (concat ndir file))) 792 (setq num (1+ num)))))
745 (setq num (1+ num))))
746 files))
747 (setf (nnmaildir--grp-cache group) (make-vector num nil)) 793 (setf (nnmaildir--grp-cache group) (make-vector num nil))
748 (let ((inhibit-quit t)) 794 (let ((inhibit-quit t))
749 (set (intern gname groups) group)) 795 (set (intern gname groups) group))
@@ -757,12 +803,10 @@ by nnmaildir-request-article.")
757 files (delq nil files) 803 files (delq nil files)
758 files (mapcar 'nnmaildir--parse-filename files) 804 files (mapcar 'nnmaildir--parse-filename files)
759 files (sort files 'nnmaildir--sort-files)) 805 files (sort files 'nnmaildir--sort-files))
760 (mapcar 806 (dolist (file files)
761 (lambda (file) 807 (setq file (if (consp file) file (aref file 3))
762 (setq file (if (consp file) file (aref file 3)) 808 x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
763 x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) 809 (nnmaildir--grp-add-art nnmaildir--cur-server group x))
764 (nnmaildir--grp-add-art nnmaildir--cur-server group x))
765 files)
766 (if read-only (setf (nnmaildir--grp-new group) nattr) 810 (if read-only (setf (nnmaildir--grp-new group) nattr)
767 (setf (nnmaildir--grp-cur group) cattr))) 811 (setf (nnmaildir--grp-cur group) cattr)))
768 t)) 812 t))
@@ -809,19 +853,18 @@ by nnmaildir-request-article.")
809 dirs)) 853 dirs))
810 seen (nnmaildir--up2-1 (length dirs)) 854 seen (nnmaildir--up2-1 (length dirs))
811 seen (make-vector seen 0)) 855 seen (make-vector seen 0))
812 (mapcar 856 (dolist (grp-dir dirs)
813 (lambda (grp-dir) 857 (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
814 (if (nnmaildir--scan grp-dir scan-group groups method srv-dir 858 srv-ls)
815 srv-ls) 859 (intern grp-dir seen)))
816 (intern grp-dir seen)))
817 dirs)
818 (setq x nil) 860 (setq x nil)
819 (mapatoms (lambda (group) 861 (mapatoms (lambda (group)
820 (setq group (symbol-name group)) 862 (setq group (symbol-name group))
821 (unless (intern-soft group seen) 863 (unless (intern-soft group seen)
822 (setq x (cons group x)))) 864 (setq x (cons group x))))
823 groups) 865 groups)
824 (mapcar (lambda (grp) (unintern grp groups)) x) 866 (dolist (grp x)
867 (unintern grp groups))
825 (setf (nnmaildir--srv-mtime nnmaildir--cur-server) 868 (setf (nnmaildir--srv-mtime nnmaildir--cur-server)
826 (nth 5 (file-attributes srv-dir)))) 869 (nth 5 (file-attributes srv-dir))))
827 (and scan-group 870 (and scan-group
@@ -857,19 +900,17 @@ by nnmaildir-request-article.")
857 (nnmaildir--prepare server nil) 900 (nnmaildir--prepare server nil)
858 (nnmaildir--with-nntp-buffer 901 (nnmaildir--with-nntp-buffer
859 (erase-buffer) 902 (erase-buffer)
860 (mapcar 903 (dolist (gname groups)
861 (lambda (gname) 904 (setq group (nnmaildir--prepare nil gname))
862 (setq group (nnmaildir--prepare nil gname)) 905 (if (null group) (insert "411 no such news group\n")
863 (if (null group) (insert "411 no such news group\n") 906 (insert "211 ")
864 (insert "211 ") 907 (princ (nnmaildir--grp-count group) nntp-server-buffer)
865 (princ (nnmaildir--grp-count group) nntp-server-buffer) 908 (insert " ")
866 (insert " ") 909 (princ (nnmaildir--grp-min group) nntp-server-buffer)
867 (princ (nnmaildir--grp-min group) nntp-server-buffer) 910 (insert " ")
868 (insert " ") 911 (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
869 (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) 912 nntp-server-buffer)
870 nntp-server-buffer) 913 (insert " " gname "\n")))))
871 (insert " " gname "\n")))
872 groups)))
873 'group) 914 'group)
874 915
875(defun nnmaildir-request-update-info (gname info &optional server) 916(defun nnmaildir-request-update-info (gname info &optional server)
@@ -909,33 +950,29 @@ by nnmaildir-request-article.")
909 new-mmth (nnmaildir--up2-1 (length markdirs)) 950 new-mmth (nnmaildir--up2-1 (length markdirs))
910 new-mmth (make-vector new-mmth 0) 951 new-mmth (make-vector new-mmth 0)
911 old-mmth (nnmaildir--grp-mmth group)) 952 old-mmth (nnmaildir--grp-mmth group))
912 (mapcar 953 (dolist (mark markdirs)
913 (lambda (mark) 954 (setq markdir (nnmaildir--subdir dir mark)
914 (setq markdir (nnmaildir--subdir dir mark) 955 mark-sym (intern mark)
915 mark-sym (intern mark) 956 ranges nil)
916 ranges nil) 957 (catch 'got-ranges
917 (catch 'got-ranges 958 (if (memq mark-sym never-marks) (throw 'got-ranges nil))
918 (if (memq mark-sym never-marks) (throw 'got-ranges nil)) 959 (when (memq mark-sym always-marks)
919 (when (memq mark-sym always-marks) 960 (setq ranges existing)
920 (setq ranges existing) 961 (throw 'got-ranges nil))
921 (throw 'got-ranges nil)) 962 (setq mtime (nth 5 (file-attributes markdir)))
922 (setq mtime (nth 5 (file-attributes markdir))) 963 (set (intern mark new-mmth) mtime)
923 (set (intern mark new-mmth) mtime) 964 (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
924 (when (equal mtime (symbol-value (intern-soft mark old-mmth))) 965 (setq ranges (assq mark-sym old-marks))
925 (setq ranges (assq mark-sym old-marks)) 966 (if ranges (setq ranges (cdr ranges)))
926 (if ranges (setq ranges (cdr ranges))) 967 (throw 'got-ranges nil))
927 (throw 'got-ranges nil)) 968 (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
928 (mapcar 969 (setq article (nnmaildir--flist-art flist prefix))
929 (lambda (prefix) 970 (if article
930 (setq article (nnmaildir--flist-art flist prefix)) 971 (setq ranges
931 (if article 972 (gnus-add-to-range ranges
932 (setq ranges 973 `(,(nnmaildir--art-num article)))))))
933 (gnus-add-to-range ranges 974 (if (eq mark-sym 'read) (setq read ranges)
934 `(,(nnmaildir--art-num article)))))) 975 (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
935 (funcall ls markdir nil "\\`[^.]" 'nosort)))
936 (if (eq mark-sym 'read) (setq read ranges)
937 (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
938 markdirs)
939 (gnus-info-set-read info (gnus-range-add read missing)) 976 (gnus-info-set-read info (gnus-range-add read missing))
940 (gnus-info-set-marks info marks 'extend) 977 (gnus-info-set-marks info marks 'extend)
941 (setf (nnmaildir--grp-mmth group) new-mmth) 978 (setf (nnmaildir--grp-mmth group) new-mmth)
@@ -1087,10 +1124,10 @@ by nnmaildir-request-article.")
1087 (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls) 1124 (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls)
1088 (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls)) 1125 (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls))
1089 (setq dir (nnmaildir--nndir grp-dir)) 1126 (setq dir (nnmaildir--nndir grp-dir))
1090 (mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls)) 1127 (dolist (subdir `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir)
1091 `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir) 1128 ,@(funcall ls (nnmaildir--marks-dir dir)
1092 ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]" 1129 'full "\\`[^.]" 'nosort)))
1093 'nosort))) 1130 (nnmaildir--delete-dir-files subdir ls))
1094 (setq dir (nnmaildir--nndir grp-dir)) 1131 (setq dir (nnmaildir--nndir grp-dir))
1095 (nnmaildir--unlink (concat dir "markfile")) 1132 (nnmaildir--unlink (concat dir "markfile"))
1096 (nnmaildir--unlink (concat dir "markfile{new}")) 1133 (nnmaildir--unlink (concat dir "markfile{new}"))
@@ -1144,11 +1181,9 @@ by nnmaildir-request-article.")
1144 (nnmaildir--nlist-iterate nlist 'all insert-nov)) 1181 (nnmaildir--nlist-iterate nlist 'all insert-nov))
1145 ((null articles)) 1182 ((null articles))
1146 ((stringp (car articles)) 1183 ((stringp (car articles))
1147 (mapcar 1184 (dolist (msgid articles)
1148 (lambda (msgid) 1185 (setq article (nnmaildir--mlist-art mlist msgid))
1149 (setq article (nnmaildir--mlist-art mlist msgid)) 1186 (if article (funcall insert-nov article))))
1150 (if article (funcall insert-nov article)))
1151 articles))
1152 (t 1187 (t
1153 (if fetch-old 1188 (if fetch-old
1154 ;; Assume the article range list is sorted ascending 1189 ;; Assume the article range list is sorted ascending
@@ -1254,7 +1289,7 @@ by nnmaildir-request-article.")
1254 t))) 1289 t)))
1255 1290
1256(defun nnmaildir-request-move-article (article gname server accept-form 1291(defun nnmaildir-request-move-article (article gname server accept-form
1257 &optional last) 1292 &optional last move-is-internal)
1258 (let ((group (nnmaildir--prepare server gname)) 1293 (let ((group (nnmaildir--prepare server gname))
1259 pgname suffix result nnmaildir--file deactivate-mark) 1294 pgname suffix result nnmaildir--file deactivate-mark)
1260 (catch 'return 1295 (catch 'return
@@ -1339,8 +1374,7 @@ by nnmaildir-request-article.")
1339 nnmaildir--cur-server) 1374 nnmaildir--cur-server)
1340 "24-hour timer expired") 1375 "24-hour timer expired")
1341 (throw 'return nil)))) 1376 (throw 'return nil))))
1342 (condition-case nil 1377 (condition-case nil (add-name-to-file nnmaildir--file tmpfile)
1343 (add-name-to-file nnmaildir--file tmpfile)
1344 (error 1378 (error
1345 (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil 1379 (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil
1346 'excl) 1380 'excl)
@@ -1470,7 +1504,12 @@ by nnmaildir-request-article.")
1470 (not (string-equal target pgname))) ;; Move it. 1504 (not (string-equal target pgname))) ;; Move it.
1471 (erase-buffer) 1505 (erase-buffer)
1472 (nnheader-insert-file-contents nnmaildir--file) 1506 (nnheader-insert-file-contents nnmaildir--file)
1473 (gnus-request-accept-article target nil nil 'no-encode)) 1507 (let ((group-art (gnus-request-accept-article
1508 target nil nil 'no-encode)))
1509 (when (consp group-art)
1510 ;; Maybe also copy: dormant forward reply save tick
1511 ;; (gnus-add-mark? gnus-request-set-mark?)
1512 (gnus-group-mark-article-read target (cdr group-art)))))
1474 (if (equal target pgname) 1513 (if (equal target pgname)
1475 ;; Leave it here. 1514 ;; Leave it here.
1476 (setq didnt (cons (nnmaildir--art-num article) didnt)) 1515 (setq didnt (cons (nnmaildir--art-num article) didnt))
@@ -1484,8 +1523,8 @@ by nnmaildir-request-article.")
1484 (coding-system-for-write nnheader-file-coding-system) 1523 (coding-system-for-write nnheader-file-coding-system)
1485 (buffer-file-coding-system nil) 1524 (buffer-file-coding-system nil)
1486 (file-coding-system-alist nil) 1525 (file-coding-system-alist nil)
1487 del-mark del-action add-action set-action marksdir markfile nlist 1526 del-mark del-action add-action set-action marksdir nlist
1488 ranges begin end article all-marks todo-marks did-marks mdir mfile 1527 ranges begin end article all-marks todo-marks mdir mfile
1489 pgname ls permarkfile deactivate-mark) 1528 pgname ls permarkfile deactivate-mark)
1490 (setq del-mark 1529 (setq del-mark
1491 (lambda (mark) 1530 (lambda (mark)
@@ -1500,17 +1539,19 @@ by nnmaildir-request-article.")
1500 (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) 1539 (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
1501 permarkfile (concat mdir ":") 1540 permarkfile (concat mdir ":")
1502 mfile (concat mdir (nnmaildir--art-prefix article))) 1541 mfile (concat mdir (nnmaildir--art-prefix article)))
1503 (unless (memq mark did-marks) 1542 (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
1504 (setq did-marks (cons mark did-marks)) 1543 (cond
1505 (nnmaildir--mkdir mdir) 1544 ((nnmaildir--eexist-p err))
1506 (unless (file-attributes permarkfile) 1545 ((nnmaildir--enoent-p err)
1507 (condition-case nil 1546 (nnmaildir--mkdir mdir)
1508 (add-name-to-file markfile permarkfile) 1547 (nnmaildir--mkfile permarkfile)
1509 (file-error 1548 (add-name-to-file permarkfile mfile))
1510 ;; AFS can't make hard links in separate directories 1549 ((nnmaildir--emlink-p err)
1511 (write-region "" nil permarkfile nil 'no-message))))) 1550 (let ((permarkfilenew (concat permarkfile "{new}")))
1512 (unless (file-exists-p mfile) 1551 (nnmaildir--mkfile permarkfilenew)
1513 (add-name-to-file permarkfile mfile))) 1552 (rename-file permarkfilenew permarkfile 'replace)
1553 (add-name-to-file permarkfile mfile)))
1554 (t (signal (car err) (cdr err))))))
1514 todo-marks)) 1555 todo-marks))
1515 set-action (lambda (article) 1556 set-action (lambda (article)
1516 (funcall add-action) 1557 (funcall add-action)
@@ -1522,32 +1563,29 @@ by nnmaildir-request-article.")
1522 (unless group 1563 (unless group
1523 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1564 (setf (nnmaildir--srv-error nnmaildir--cur-server)
1524 (concat "No such group: " gname)) 1565 (concat "No such group: " gname))
1525 (mapcar (lambda (action) 1566 (dolist (action actions)
1526 (setq ranges (gnus-range-add ranges (car action)))) 1567 (setq ranges (gnus-range-add ranges (car action))))
1527 actions)
1528 (throw 'return ranges)) 1568 (throw 'return ranges))
1529 (setq nlist (nnmaildir--grp-nlist group) 1569 (setq nlist (nnmaildir--grp-nlist group)
1530 marksdir (nnmaildir--srv-dir nnmaildir--cur-server) 1570 marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
1531 marksdir (nnmaildir--srvgrp-dir marksdir gname) 1571 marksdir (nnmaildir--srvgrp-dir marksdir gname)
1532 marksdir (nnmaildir--nndir marksdir) 1572 marksdir (nnmaildir--nndir marksdir)
1533 markfile (concat marksdir "markfile")
1534 marksdir (nnmaildir--marks-dir marksdir) 1573 marksdir (nnmaildir--marks-dir marksdir)
1535 gname (nnmaildir--grp-name group) 1574 gname (nnmaildir--grp-name group)
1536 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1575 pgname (nnmaildir--pgname nnmaildir--cur-server gname)
1537 ls (nnmaildir--group-ls nnmaildir--cur-server pgname) 1576 ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
1538 all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) 1577 all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
1539 all-marks (mapcar 'intern all-marks)) 1578 all-marks (mapcar 'intern all-marks))
1540 (mapcar 1579 (dolist (action actions)
1541 (lambda (action) 1580 (setq ranges (car action)
1542 (setq ranges (car action) 1581 todo-marks (caddr action))
1543 todo-marks (caddr action)) 1582 (dolist (mark todo-marks)
1544 (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks) 1583 (add-to-list 'all-marks mark))
1545 (if (numberp (cdr ranges)) (setq ranges (list ranges))) 1584 (if (numberp (cdr ranges)) (setq ranges (list ranges)))
1546 (nnmaildir--nlist-iterate nlist ranges 1585 (nnmaildir--nlist-iterate nlist ranges
1547 (cond ((eq 'del (cadr action)) del-action) 1586 (cond ((eq 'del (cadr action)) del-action)
1548 ((eq 'add (cadr action)) add-action) 1587 ((eq 'add (cadr action)) add-action)
1549 (t set-action)))) 1588 (t set-action))))
1550 actions)
1551 nil))) 1589 nil)))
1552 1590
1553(defun nnmaildir-close-group (gname &optional server) 1591(defun nnmaildir-close-group (gname &optional server)
@@ -1576,22 +1614,16 @@ by nnmaildir-request-article.")
1576 flist (nnmaildir--up2-1 (length files)) 1614 flist (nnmaildir--up2-1 (length files))
1577 flist (make-vector flist 0)) 1615 flist (make-vector flist 0))
1578 (save-match-data 1616 (save-match-data
1579 (mapcar 1617 (dolist (file files)
1580 (lambda (file) 1618 (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
1581 (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) 1619 (intern (match-string 1 file) flist)))
1582 (intern (match-string 1 file) flist)) 1620 (dolist (dir dirs)
1583 files)) 1621 (setq files (cdr dir)
1584 (mapcar 1622 dir (file-name-as-directory (car dir)))
1585 (lambda (dir) 1623 (dolist (file files)
1586 (setq files (cdr dir) 1624 (unless (or (intern-soft file flist) (string= file ":"))
1587 dir (file-name-as-directory (car dir))) 1625 (setq file (concat dir file))
1588 (mapcar 1626 (delete-file file))))
1589 (lambda (file)
1590 (unless (or (intern-soft file flist) (string= file ":"))
1591 (setq file (concat dir file))
1592 (delete-file file)))
1593 files))
1594 dirs)
1595 t))) 1627 t)))
1596 1628
1597(defun nnmaildir-close-server (&optional server) 1629(defun nnmaildir-close-server (&optional server)
@@ -1608,7 +1640,7 @@ by nnmaildir-request-article.")
1608 (mapatoms (lambda (server) 1640 (mapatoms (lambda (server)
1609 (setq servers (cons (symbol-name server) servers))) 1641 (setq servers (cons (symbol-name server) servers)))
1610 nnmaildir--servers) 1642 nnmaildir--servers)
1611 (mapcar 'nnmaildir-close-server servers) 1643 (mapc 'nnmaildir-close-server servers)
1612 (setq buffer (get-buffer " *nnmaildir work*")) 1644 (setq buffer (get-buffer " *nnmaildir work*"))
1613 (if buffer (kill-buffer buffer)) 1645 (if buffer (kill-buffer buffer))
1614 (setq buffer (get-buffer " *nnmaildir nov*")) 1646 (setq buffer (get-buffer " *nnmaildir nov*"))
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index fd8ec27d225..d7dddc96362 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -284,7 +284,7 @@
284 (nconc rest articles)))) 284 (nconc rest articles))))
285 285
286(deffoo nnmbox-request-move-article 286(deffoo nnmbox-request-move-article
287 (article group server accept-form &optional last) 287 (article group server accept-form &optional last move-is-internal)
288 (let ((buf (get-buffer-create " *nnmbox move*")) 288 (let ((buf (get-buffer-create " *nnmbox move*"))
289 result) 289 result)
290 (and 290 (and
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 3eeea7487dc..a7735edc513 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -176,7 +176,7 @@ as unread by Gnus.")
176 (nnheader-re-read-dir pathname) 176 (nnheader-re-read-dir pathname)
177 (setq dir 177 (setq dir
178 (sort 178 (sort
179 (mapcar (lambda (name) (string-to-number name)) 179 (mapcar 'string-to-number
180 (directory-files pathname nil "^[0-9]+$" t)) 180 (directory-files pathname nil "^[0-9]+$" t))
181 '<)) 181 '<))
182 (cond 182 (cond
@@ -211,7 +211,6 @@ as unread by Gnus.")
211 (setq dir (expand-file-name dir)) 211 (setq dir (expand-file-name dir))
212 ;; Recurse down all directories. 212 ;; Recurse down all directories.
213 (let ((dirs (and (file-readable-p dir) 213 (let ((dirs (and (file-readable-p dir)
214 (> (nth 1 (file-attributes (file-chase-links dir))) 2)
215 (nnheader-directory-files dir t nil t))) 214 (nnheader-directory-files dir t nil t)))
216 rdir) 215 rdir)
217 ;; Recurse down directories. 216 ;; Recurse down directories.
@@ -223,9 +222,8 @@ as unread by Gnus.")
223 (nnmh-request-list-1 rdir)))) 222 (nnmh-request-list-1 rdir))))
224 ;; For each directory, generate an active file line. 223 ;; For each directory, generate an active file line.
225 (unless (string= (expand-file-name nnmh-toplev) dir) 224 (unless (string= (expand-file-name nnmh-toplev) dir)
226 (let ((files (mapcar 225 (let ((files (mapcar 'string-to-number
227 (lambda (name) (string-to-number name)) 226 (directory-files dir nil "^[0-9]+$" t))))
228 (directory-files dir nil "^[0-9]+$" t))))
229 (when files 227 (when files
230 (save-excursion 228 (save-excursion
231 (set-buffer nntp-server-buffer) 229 (set-buffer nntp-server-buffer)
@@ -290,8 +288,8 @@ as unread by Gnus.")
290(deffoo nnmh-close-group (group &optional server) 288(deffoo nnmh-close-group (group &optional server)
291 t) 289 t)
292 290
293(deffoo nnmh-request-move-article (article group server 291(deffoo nnmh-request-move-article (article group server accept-form
294 accept-form &optional last) 292 &optional last move-is-internal)
295 (let ((buf (get-buffer-create " *nnmh move*")) 293 (let ((buf (get-buffer-create " *nnmh move*"))
296 result) 294 result)
297 (and 295 (and
@@ -356,11 +354,9 @@ as unread by Gnus.")
356 nnmh-group-alist) 354 nnmh-group-alist)
357 (nnmh-possibly-create-directory group) 355 (nnmh-possibly-create-directory group)
358 (nnmh-possibly-change-directory group server) 356 (nnmh-possibly-change-directory group server)
359 (let ((articles (mapcar 357 (let ((articles (mapcar 'string-to-number
360 (lambda (file) 358 (directory-files
361 (string-to-number file)) 359 nnmh-current-directory nil "^[0-9]+$"))))
362 (directory-files
363 nnmh-current-directory nil "^[0-9]+$"))))
364 (when articles 360 (when articles
365 (setcar active (apply 'min articles)) 361 (setcar active (apply 'min articles))
366 (setcdr active (apply 'max articles)))))) 362 (setcdr active (apply 'max articles))))))
@@ -484,10 +480,8 @@ as unread by Gnus.")
484 (gnus-make-directory dir)) 480 (gnus-make-directory dir))
485 ;; Find the highest number in the group. 481 ;; Find the highest number in the group.
486 (let ((files (sort 482 (let ((files (sort
487 (mapcar 483 (mapcar 'string-to-number
488 (lambda (f) 484 (directory-files dir nil "^[0-9]+$"))
489 (string-to-number f))
490 (directory-files dir nil "^[0-9]+$"))
491 '>))) 485 '>)))
492 (when files 486 (when files
493 (setcdr active (car files))))) 487 (setcdr active (car files)))))
@@ -509,7 +503,7 @@ as unread by Gnus.")
509 ;; articles in this folder. The articles that are "new" will be 503 ;; articles in this folder. The articles that are "new" will be
510 ;; marked as unread by Gnus. 504 ;; marked as unread by Gnus.
511 (let* ((dir nnmh-current-directory) 505 (let* ((dir nnmh-current-directory)
512 (files (sort (mapcar (function (lambda (name) (string-to-number name))) 506 (files (sort (mapcar 'string-to-number
513 (directory-files nnmh-current-directory 507 (directory-files nnmh-current-directory
514 nil "^[0-9]+$" t)) 508 nil "^[0-9]+$" t))
515 '<)) 509 '<))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 8396c174a3f..6f45b0b6fa0 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -3,8 +3,9 @@
3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5 5
6;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS) 6;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
7;; Lars Magne Ingebrigtsen <larsi@gnus.org> 7;; Simon Josefsson <simon@josefsson.org> (adding MARKS)
8;; Lars Magne Ingebrigtsen <larsi@gnus.org>
8;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 9;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
9;; Keywords: news, mail 10;; Keywords: news, mail
10 11
@@ -40,7 +41,8 @@
40(eval-when-compile (require 'cl)) 41(eval-when-compile (require 'cl))
41 42
42(eval-and-compile 43(eval-and-compile
43 (autoload 'gnus-article-unpropagatable-p "gnus-sum")) 44 (autoload 'gnus-article-unpropagatable-p "gnus-sum")
45 (autoload 'gnus-backlog-remove-article "gnus-bcklg"))
44 46
45(nnoo-declare nnml) 47(nnoo-declare nnml)
46 48
@@ -83,7 +85,18 @@ marks file will be regenerated properly by Gnus.")
83 "If non-nil, inhibit expiry.") 85 "If non-nil, inhibit expiry.")
84 86
85(defvoo nnml-use-compressed-files nil 87(defvoo nnml-use-compressed-files nil
86 "If non-nil, allow using compressed message files.") 88 "If non-nil, allow using compressed message files.
89
90If it is a string, use it as the file extension which specifies
91the compression program. You can set it to \".bz2\" if your Emacs
92supports auto-compression using the bzip2 program. A value of t
93is equivalent to \".gz\".")
94
95(defvoo nnml-compressed-files-size-threshold 1000
96 "Default size threshold for compressed message files.
97Message files with bodies larger than that many characters will
98be automatically compressed if `nnml-use-compressed-files' is
99non-nil.")
87 100
88 101
89 102
@@ -116,6 +129,37 @@ marks file will be regenerated properly by Gnus.")
116 129
117(nnoo-define-basics nnml) 130(nnoo-define-basics nnml)
118 131
132(eval-when-compile
133 (defsubst nnml-group-name-charset (group server-or-method)
134 (gnus-group-name-charset
135 (if (stringp server-or-method)
136 (gnus-server-to-method
137 (if (string-match "\\+" server-or-method)
138 (concat (substring server-or-method 0 (match-beginning 0))
139 ":" (substring server-or-method (match-end 0)))
140 (concat "nnml:" server-or-method)))
141 (or server-or-method gnus-command-method '(nnml "")))
142 group)))
143
144(defun nnml-decoded-group-name (group &optional server-or-method)
145 "Return a decoded group name of GROUP on SERVER-OR-METHOD."
146 (if nnmail-group-names-not-encoded-p
147 group
148 (mm-decode-coding-string
149 group
150 (nnml-group-name-charset group server-or-method))))
151
152(defun nnml-encoded-group-name (group &optional server-or-method)
153 "Return an encoded group name of GROUP on SERVER-OR-METHOD."
154 (mm-encode-coding-string
155 group
156 (nnml-group-name-charset group server-or-method)))
157
158(defun nnml-group-pathname (group &optional file server)
159 "Return an absolute file name of FILE for GROUP on SERVER."
160 (nnmail-group-pathname (inline (nnml-decoded-group-name group server))
161 nnml-directory file))
162
119(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old) 163(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
120 (when (nnml-possibly-change-directory group server) 164 (when (nnml-possibly-change-directory group server)
121 (save-excursion 165 (save-excursion
@@ -188,14 +232,12 @@ marks file will be regenerated properly by Gnus.")
188 (file-name-coding-system nnmail-pathname-coding-system) 232 (file-name-coding-system nnmail-pathname-coding-system)
189 path gpath group-num) 233 path gpath group-num)
190 (if (stringp id) 234 (if (stringp id)
191 (when (and (setq group-num (nnml-find-group-number id)) 235 (when (and (setq group-num (nnml-find-group-number id server))
192 (cdr 236 (cdr
193 (assq (cdr group-num) 237 (assq (cdr group-num)
194 (nnheader-article-to-file-alist 238 (nnheader-article-to-file-alist
195 (setq gpath 239 (setq gpath (nnml-group-pathname (car group-num)
196 (nnmail-group-pathname 240 nil server))))))
197 (car group-num)
198 nnml-directory))))))
199 (setq path (concat gpath (int-to-string (cdr group-num))))) 241 (setq path (concat gpath (int-to-string (cdr group-num)))))
200 (setq path (nnml-article-to-file id))) 242 (setq path (nnml-article-to-file id)))
201 (cond 243 (cond
@@ -252,19 +294,23 @@ marks file will be regenerated properly by Gnus.")
252 (nnml-possibly-change-directory nil server) 294 (nnml-possibly-change-directory nil server)
253 (nnmail-activate 'nnml) 295 (nnmail-activate 'nnml)
254 (cond 296 (cond
297 ((let ((file (directory-file-name (nnml-group-pathname group nil server)))
298 (file-name-coding-system nnmail-pathname-coding-system))
299 (and (file-exists-p file)
300 (not (file-directory-p file))))
301 (nnheader-report 'nnml "%s is a file"
302 (directory-file-name (nnml-group-pathname group
303 nil server))))
255 ((assoc group nnml-group-alist) 304 ((assoc group nnml-group-alist)
256 t) 305 t)
257 ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
258 (not (file-directory-p (nnmail-group-pathname group nnml-directory))))
259 (nnheader-report 'nnml "%s is a file"
260 (nnmail-group-pathname group nnml-directory)))
261 (t 306 (t
262 (let (active) 307 (let (active)
263 (push (list group (setq active (cons 1 0))) 308 (push (list group (setq active (cons 1 0)))
264 nnml-group-alist) 309 nnml-group-alist)
265 (nnml-possibly-create-directory group) 310 (nnml-possibly-create-directory group server)
266 (nnml-possibly-change-directory group server) 311 (nnml-possibly-change-directory group server)
267 (let ((articles (nnml-directory-articles nnml-current-directory))) 312 (let* ((file-name-coding-system nnmail-pathname-coding-system)
313 (articles (nnml-directory-articles nnml-current-directory)))
268 (when articles 314 (when articles
269 (setcar active (apply 'min articles)) 315 (setcar active (apply 'min articles))
270 (setcdr active (apply 'max articles)))) 316 (setcdr active (apply 'max articles))))
@@ -288,10 +334,12 @@ marks file will be regenerated properly by Gnus.")
288 334
289(deffoo nnml-request-expire-articles (articles group &optional server force) 335(deffoo nnml-request-expire-articles (articles group &optional server force)
290 (nnml-possibly-change-directory group server) 336 (nnml-possibly-change-directory group server)
291 (let ((active-articles 337 (let* ((file-name-coding-system nnmail-pathname-coding-system)
292 (nnml-directory-articles nnml-current-directory)) 338 (active-articles
293 (is-old t) 339 (nnml-directory-articles nnml-current-directory))
294 article rest mod-time number) 340 (is-old t)
341 (decoded (nnml-decoded-group-name group server))
342 article rest mod-time number target)
295 (nnmail-activate 'nnml) 343 (nnmail-activate 'nnml)
296 344
297 (setq active-articles (sort active-articles '<)) 345 (setq active-articles (sort active-articles '<))
@@ -308,23 +356,33 @@ marks file will be regenerated properly by Gnus.")
308 nnml-inhibit-expiry))) 356 nnml-inhibit-expiry)))
309 (progn 357 (progn
310 ;; Allow a special target group. 358 ;; Allow a special target group.
311 (unless (eq nnmail-expiry-target 'delete) 359 (setq target nnmail-expiry-target)
360 (unless (eq target 'delete)
312 (with-temp-buffer 361 (with-temp-buffer
313 (nnml-request-article number group server (current-buffer)) 362 (nnml-request-article number group server (current-buffer))
314 (let (nnml-current-directory 363 (let (nnml-current-directory
315 nnml-current-group 364 nnml-current-group
316 nnml-article-file-alist) 365 nnml-article-file-alist)
317 (nnmail-expiry-target-group nnmail-expiry-target group))) 366 (when (functionp target)
367 (setq target (funcall target group)))
368 (if (and target
369 (or (gnus-request-group target)
370 (gnus-request-create-group target)))
371 (nnmail-expiry-target-group target group)
372 (setq target nil))))
318 ;; Maybe directory is changed during nnmail-expiry-target-group. 373 ;; Maybe directory is changed during nnmail-expiry-target-group.
319 (nnml-possibly-change-directory group server)) 374 (nnml-possibly-change-directory group server))
320 (nnheader-message 5 "Deleting article %s in %s" 375 (if target
321 number group) 376 (progn
322 (condition-case () 377 (nnheader-message 5 "Deleting article %s in %s"
323 (funcall nnmail-delete-file-function article) 378 number decoded)
324 (file-error 379 (condition-case ()
325 (push number rest))) 380 (funcall nnmail-delete-file-function article)
326 (setq active-articles (delq number active-articles)) 381 (file-error
327 (nnml-nov-delete-article group number)) 382 (push number rest)))
383 (setq active-articles (delq number active-articles))
384 (nnml-nov-delete-article group number))
385 (push number rest)))
328 (push number rest))) 386 (push number rest)))
329 (let ((active (nth 1 (assoc group nnml-group-alist)))) 387 (let ((active (nth 1 (assoc group nnml-group-alist))))
330 (when active 388 (when active
@@ -336,8 +394,9 @@ marks file will be regenerated properly by Gnus.")
336 (nconc rest articles))) 394 (nconc rest articles)))
337 395
338(deffoo nnml-request-move-article 396(deffoo nnml-request-move-article
339 (article group server accept-form &optional last) 397 (article group server accept-form &optional last move-is-internal)
340 (let ((buf (get-buffer-create " *nnml move*")) 398 (let ((buf (get-buffer-create " *nnml move*"))
399 (file-name-coding-system nnmail-pathname-coding-system)
341 result) 400 result)
342 (nnml-possibly-change-directory group server) 401 (nnml-possibly-change-directory group server)
343 (nnml-update-file-alist) 402 (nnml-update-file-alist)
@@ -370,7 +429,7 @@ marks file will be regenerated properly by Gnus.")
370 (nnmail-check-syntax) 429 (nnmail-check-syntax)
371 (let (result) 430 (let (result)
372 (when nnmail-cache-accepted-message-ids 431 (when nnmail-cache-accepted-message-ids
373 (nnmail-cache-insert (nnmail-fetch-field "message-id") 432 (nnmail-cache-insert (nnmail-fetch-field "message-id")
374 group 433 group
375 (nnmail-fetch-field "subject") 434 (nnmail-fetch-field "subject")
376 (nnmail-fetch-field "from"))) 435 (nnmail-fetch-field "from")))
@@ -378,16 +437,20 @@ marks file will be regenerated properly by Gnus.")
378 (and 437 (and
379 (nnmail-activate 'nnml) 438 (nnmail-activate 'nnml)
380 (setq result (car (nnml-save-mail 439 (setq result (car (nnml-save-mail
381 (list (cons group (nnml-active-number group)))))) 440 (list (cons group (nnml-active-number group
441 server)))
442 server)))
382 (progn 443 (progn
383 (nnmail-save-active nnml-group-alist nnml-active-file) 444 (nnmail-save-active nnml-group-alist nnml-active-file)
384 (and last (nnml-save-nov)))) 445 (and last (nnml-save-nov))))
385 (and 446 (and
386 (nnmail-activate 'nnml) 447 (nnmail-activate 'nnml)
387 (if (and (not (setq result (nnmail-article-group 'nnml-active-number))) 448 (if (and (not (setq result (nnmail-article-group
449 `(lambda (group)
450 (nnml-active-number group ,server)))))
388 (yes-or-no-p "Moved to `junk' group; delete article? ")) 451 (yes-or-no-p "Moved to `junk' group; delete article? "))
389 (setq result 'junk) 452 (setq result 'junk)
390 (setq result (car (nnml-save-mail result)))) 453 (setq result (car (nnml-save-mail result server))))
391 (when last 454 (when last
392 (nnmail-save-active nnml-group-alist nnml-active-file) 455 (nnmail-save-active nnml-group-alist nnml-active-file)
393 (when nnmail-cache-accepted-message-ids 456 (when nnmail-cache-accepted-message-ids
@@ -439,47 +502,54 @@ marks file will be regenerated properly by Gnus.")
439 502
440(deffoo nnml-request-delete-group (group &optional force server) 503(deffoo nnml-request-delete-group (group &optional force server)
441 (nnml-possibly-change-directory group server) 504 (nnml-possibly-change-directory group server)
442 (when force 505 (let ((file (directory-file-name nnml-current-directory))
443 ;; Delete all articles in GROUP. 506 (file-name-coding-system nnmail-pathname-coding-system))
444 (let ((articles 507 (if (file-exists-p file)
445 (directory-files 508 (if (file-directory-p file)
446 nnml-current-directory t 509 (progn
447 (concat nnheader-numerical-short-files 510 (when force
448 "\\|" (regexp-quote nnml-nov-file-name) "$" 511 ;; Delete all articles in GROUP.
449 "\\|" (regexp-quote nnml-marks-file-name) "$"))) 512 (let ((articles
450 article) 513 (directory-files
451 (while articles 514 nnml-current-directory t
452 (setq article (pop articles)) 515 (concat
453 (when (file-writable-p article) 516 nnheader-numerical-short-files
454 (nnheader-message 5 "Deleting article %s in %s..." article group) 517 "\\|" (regexp-quote nnml-nov-file-name) "$"
455 (funcall nnmail-delete-file-function article)))) 518 "\\|" (regexp-quote nnml-marks-file-name) "$")))
456 ;; Try to delete the directory itself. 519 (decoded (nnml-decoded-group-name group server)))
457 (ignore-errors (delete-directory nnml-current-directory))) 520 (dolist (article articles)
458 ;; Remove the group from all structures. 521 (when (file-writable-p article)
459 (setq nnml-group-alist 522 (nnheader-message 5 "Deleting article %s in %s..."
460 (delq (assoc group nnml-group-alist) nnml-group-alist) 523 (file-name-nondirectory article)
461 nnml-current-group nil 524 decoded)
462 nnml-current-directory nil) 525 (funcall nnmail-delete-file-function article))))
463 ;; Save the active file. 526 ;; Try to delete the directory itself.
464 (nnmail-save-active nnml-group-alist nnml-active-file) 527 (ignore-errors (delete-directory nnml-current-directory))))
528 (nnheader-report 'nnml "%s is not a directory" file))
529 (nnheader-report 'nnml "No such directory: %s/" file))
530 ;; Remove the group from all structures.
531 (setq nnml-group-alist
532 (delq (assoc group nnml-group-alist) nnml-group-alist)
533 nnml-current-group nil
534 nnml-current-directory nil)
535 ;; Save the active file.
536 (nnmail-save-active nnml-group-alist nnml-active-file))
465 t) 537 t)
466 538
467(deffoo nnml-request-rename-group (group new-name &optional server) 539(deffoo nnml-request-rename-group (group new-name &optional server)
468 (nnml-possibly-change-directory group server) 540 (nnml-possibly-change-directory group server)
469 (let ((new-dir (nnmail-group-pathname new-name nnml-directory)) 541 (let ((new-dir (nnml-group-pathname new-name nil server))
470 (old-dir (nnmail-group-pathname group nnml-directory))) 542 (old-dir (nnml-group-pathname group nil server)))
471 (when (ignore-errors 543 (when (ignore-errors
472 (make-directory new-dir t) 544 (make-directory new-dir t)
473 t) 545 t)
474 ;; We move the articles file by file instead of renaming 546 ;; We move the articles file by file instead of renaming
475 ;; the directory -- there may be subgroups in this group. 547 ;; the directory -- there may be subgroups in this group.
476 ;; One might be more clever, I guess. 548 ;; One might be more clever, I guess.
477 (let ((files (nnheader-article-to-file-alist old-dir))) 549 (dolist (file (nnheader-article-to-file-alist old-dir))
478 (while files 550 (rename-file
479 (rename-file 551 (concat old-dir (cdr file))
480 (concat old-dir (cdar files)) 552 (concat new-dir (cdr file))))
481 (concat new-dir (cdar files)))
482 (pop files)))
483 ;; Move .overview file. 553 ;; Move .overview file.
484 (let ((overview (concat old-dir nnml-nov-file-name))) 554 (let ((overview (concat old-dir nnml-nov-file-name)))
485 (when (file-exists-p overview) 555 (when (file-exists-p overview)
@@ -534,7 +604,8 @@ marks file will be regenerated properly by Gnus.")
534 604
535(defun nnml-deletable-article-p (group article) 605(defun nnml-deletable-article-p (group article)
536 "Say whether ARTICLE in GROUP can be deleted." 606 "Say whether ARTICLE in GROUP can be deleted."
537 (let (path) 607 (let ((file-name-coding-system nnmail-pathname-coding-system)
608 path)
538 (when (setq path (nnml-article-to-file article)) 609 (when (setq path (nnml-article-to-file article))
539 (when (file-writable-p path) 610 (when (file-writable-p path)
540 (or (not nnmail-keep-last-article) 611 (or (not nnmail-keep-last-article)
@@ -542,7 +613,7 @@ marks file will be regenerated properly by Gnus.")
542 article))))))) 613 article)))))))
543 614
544;; Find an article number in the current group given the Message-ID. 615;; Find an article number in the current group given the Message-ID.
545(defun nnml-find-group-number (id) 616(defun nnml-find-group-number (id server)
546 (save-excursion 617 (save-excursion
547 (set-buffer (get-buffer-create " *nnml id*")) 618 (set-buffer (get-buffer-create " *nnml id*"))
548 (let ((alist nnml-group-alist) 619 (let ((alist nnml-group-alist)
@@ -550,22 +621,21 @@ marks file will be regenerated properly by Gnus.")
550 ;; We want to look through all .overview files, but we want to 621 ;; We want to look through all .overview files, but we want to
551 ;; start with the one in the current directory. It seems most 622 ;; start with the one in the current directory. It seems most
552 ;; likely that the article we are looking for is in that group. 623 ;; likely that the article we are looking for is in that group.
553 (if (setq number (nnml-find-id nnml-current-group id)) 624 (if (setq number (nnml-find-id nnml-current-group id server))
554 (cons nnml-current-group number) 625 (cons nnml-current-group number)
555 ;; It wasn't there, so we look through the other groups as well. 626 ;; It wasn't there, so we look through the other groups as well.
556 (while (and (not number) 627 (while (and (not number)
557 alist) 628 alist)
558 (or (string= (caar alist) nnml-current-group) 629 (or (string= (caar alist) nnml-current-group)
559 (setq number (nnml-find-id (caar alist) id))) 630 (setq number (nnml-find-id (caar alist) id server)))
560 (or number 631 (or number
561 (setq alist (cdr alist)))) 632 (setq alist (cdr alist))))
562 (and number 633 (and number
563 (cons (caar alist) number)))))) 634 (cons (caar alist) number))))))
564 635
565(defun nnml-find-id (group id) 636(defun nnml-find-id (group id server)
566 (erase-buffer) 637 (erase-buffer)
567 (let ((nov (expand-file-name nnml-nov-file-name 638 (let ((nov (nnml-group-pathname group nnml-nov-file-name server))
568 (nnmail-group-pathname group nnml-directory)))
569 number found) 639 number found)
570 (when (file-exists-p nov) 640 (when (file-exists-p nov)
571 (nnheader-insert-file-contents nov) 641 (nnheader-insert-file-contents nov)
@@ -573,7 +643,7 @@ marks file will be regenerated properly by Gnus.")
573 (search-forward id nil t)) ; We find the ID. 643 (search-forward id nil t)) ; We find the ID.
574 ;; And the id is in the fourth field. 644 ;; And the id is in the fourth field.
575 (if (not (and (search-backward "\t" nil t 4) 645 (if (not (and (search-backward "\t" nil t 4)
576 (not (search-backward"\t" (gnus-point-at-bol) t)))) 646 (not (search-backward "\t" (point-at-bol) t))))
577 (forward-line 1) 647 (forward-line 1)
578 (beginning-of-line) 648 (beginning-of-line)
579 (setq found t) 649 (setq found t)
@@ -606,7 +676,7 @@ marks file will be regenerated properly by Gnus.")
606 (nnml-open-server server)) 676 (nnml-open-server server))
607 (if (not group) 677 (if (not group)
608 t 678 t
609 (let ((pathname (nnmail-group-pathname group nnml-directory)) 679 (let ((pathname (nnml-group-pathname group nil server))
610 (file-name-coding-system nnmail-pathname-coding-system)) 680 (file-name-coding-system nnmail-pathname-coding-system))
611 (when (not (equal pathname nnml-current-directory)) 681 (when (not (equal pathname nnml-current-directory))
612 (setq nnml-current-directory pathname 682 (setq nnml-current-directory pathname
@@ -614,20 +684,32 @@ marks file will be regenerated properly by Gnus.")
614 nnml-article-file-alist nil)) 684 nnml-article-file-alist nil))
615 (file-exists-p nnml-current-directory)))) 685 (file-exists-p nnml-current-directory))))
616 686
617(defun nnml-possibly-create-directory (group) 687(defun nnml-possibly-create-directory (group &optional server)
618 (let ((dir (nnmail-group-pathname group nnml-directory))) 688 (let ((dir (nnml-group-pathname group nil server))
689 (file-name-coding-system nnmail-pathname-coding-system))
619 (unless (file-exists-p dir) 690 (unless (file-exists-p dir)
620 (make-directory (directory-file-name dir) t) 691 (make-directory (directory-file-name dir) t)
621 (nnheader-message 5 "Creating mail directory %s" dir)))) 692 (nnheader-message 5 "Creating mail directory %s" dir))))
622 693
623(defun nnml-save-mail (group-art) 694(defun nnml-save-mail (group-art &optional server)
624 "Called narrowed to an article." 695 "Save a mail into the groups GROUP-ART in the nnml server SERVER.
625 (let (chars headers extension) 696GROUP-ART is a list that each element is a cons of a group name and an
626 (setq chars (nnmail-insert-lines)) 697article number. This function is called narrowed to an article."
627 (setq extension 698 (let* ((chars (nnmail-insert-lines))
628 (and nnml-use-compressed-files 699 (extension (and nnml-use-compressed-files
629 (> chars 1000) 700 (> chars nnml-compressed-files-size-threshold)
630 ".gz")) 701 (if (stringp nnml-use-compressed-files)
702 nnml-use-compressed-files
703 ".gz")))
704 decoded dec file first headers)
705 (when nnmail-group-names-not-encoded-p
706 (dolist (ga (prog1 group-art (setq group-art nil)))
707 (setq group-art (nconc group-art
708 (list (cons (nnml-encoded-group-name (car ga)
709 server)
710 (cdr ga))))
711 decoded (nconc decoded (list (car ga)))))
712 (setq dec decoded))
631 (nnmail-insert-xref group-art) 713 (nnmail-insert-xref group-art)
632 (run-hooks 'nnmail-prepare-save-mail-hook) 714 (run-hooks 'nnmail-prepare-save-mail-hook)
633 (run-hooks 'nnml-prepare-save-mail-hook) 715 (run-hooks 'nnml-prepare-save-mail-hook)
@@ -636,43 +718,50 @@ marks file will be regenerated properly by Gnus.")
636 (replace-match "X-From-Line: ") 718 (replace-match "X-From-Line: ")
637 (forward-line 1)) 719 (forward-line 1))
638 ;; We save the article in all the groups it belongs in. 720 ;; We save the article in all the groups it belongs in.
639 (let ((ga group-art) 721 (dolist (ga group-art)
640 first) 722 (if nnmail-group-names-not-encoded-p
641 (while ga 723 (progn
642 (nnml-possibly-create-directory (caar ga)) 724 (nnml-possibly-create-directory (car decoded) server)
643 (let ((file (concat (nnmail-group-pathname 725 (setq file (nnmail-group-pathname
644 (caar ga) nnml-directory) 726 (pop decoded) nnml-directory
645 (int-to-string (cdar ga)) 727 (concat (number-to-string (cdr ga)) extension))))
646 extension))) 728 (nnml-possibly-create-directory (car ga) server)
647 (if first 729 (setq file (nnml-group-pathname
648 ;; It was already saved, so we just make a hard link. 730 (car ga) (concat (number-to-string (cdr ga)) extension)
649 (funcall nnmail-crosspost-link-function first file t) 731 server)))
650 ;; Save the article. 732 (if first
651 (nnmail-write-region (point-min) (point-max) file nil 733 ;; It was already saved, so we just make a hard link.
652 (if (nnheader-be-verbose 5) nil 'nomesg)) 734 (let ((file-name-coding-system nnmail-pathname-coding-system))
653 (setq first file))) 735 (funcall nnmail-crosspost-link-function first file t))
654 (setq ga (cdr ga)))) 736 ;; Save the article.
737 (nnmail-write-region (point-min) (point-max) file nil
738 (if (nnheader-be-verbose 5) nil 'nomesg))
739 (setq first file)))
655 ;; Generate a nov line for this article. We generate the nov 740 ;; Generate a nov line for this article. We generate the nov
656 ;; line after saving, because nov generation destroys the 741 ;; line after saving, because nov generation destroys the
657 ;; header. 742 ;; header.
658 (setq headers (nnml-parse-head chars)) 743 (setq headers (nnml-parse-head chars))
659 ;; Output the nov line to all nov databases that should have it. 744 ;; Output the nov line to all nov databases that should have it.
660 (let ((ga group-art)) 745 (if nnmail-group-names-not-encoded-p
661 (while ga 746 (dolist (ga group-art)
662 (nnml-add-nov (caar ga) (cdar ga) headers) 747 (nnml-add-nov (pop dec) (cdr ga) headers))
663 (setq ga (cdr ga)))) 748 (dolist (ga group-art)
664 group-art)) 749 (nnml-add-nov (car ga) (cdr ga) headers))))
665 750 group-art)
666(defun nnml-active-number (group) 751
667 "Compute the next article number in GROUP." 752(defun nnml-active-number (group &optional server)
668 (let ((active (cadr (assoc group nnml-group-alist)))) 753 "Compute the next article number in GROUP on SERVER."
754 (let ((active (cadr (assoc (if nnmail-group-names-not-encoded-p
755 (nnml-encoded-group-name group server)
756 group)
757 nnml-group-alist))))
669 ;; The group wasn't known to nnml, so we just create an active 758 ;; The group wasn't known to nnml, so we just create an active
670 ;; entry for it. 759 ;; entry for it.
671 (unless active 760 (unless active
672 ;; Perhaps the active file was corrupt? See whether 761 ;; Perhaps the active file was corrupt? See whether
673 ;; there are any articles in this group. 762 ;; there are any articles in this group.
674 (nnml-possibly-create-directory group) 763 (nnml-possibly-create-directory group server)
675 (nnml-possibly-change-directory group) 764 (nnml-possibly-change-directory group server)
676 (unless nnml-article-file-alist 765 (unless nnml-article-file-alist
677 (setq nnml-article-file-alist 766 (setq nnml-article-file-alist
678 (sort 767 (sort
@@ -686,8 +775,7 @@ marks file will be regenerated properly by Gnus.")
686 (push (list group active) nnml-group-alist)) 775 (push (list group active) nnml-group-alist))
687 (setcdr active (1+ (cdr active))) 776 (setcdr active (1+ (cdr active)))
688 (while (file-exists-p 777 (while (file-exists-p
689 (expand-file-name (int-to-string (cdr active)) 778 (nnml-group-pathname group (int-to-string (cdr active)) server))
690 (nnmail-group-pathname group nnml-directory)))
691 (setcdr active (1+ (cdr active)))) 779 (setcdr active (1+ (cdr active))))
692 (cdr active))) 780 (cdr active)))
693 781
@@ -700,7 +788,7 @@ marks file will be regenerated properly by Gnus.")
700 (nnheader-insert-nov headers))) 788 (nnheader-insert-nov headers)))
701 789
702(defsubst nnml-header-value () 790(defsubst nnml-header-value ()
703 (buffer-substring (match-end 0) (gnus-point-at-eol))) 791 (buffer-substring (match-end 0) (point-at-eol)))
704 792
705(defun nnml-parse-head (chars &optional number) 793(defun nnml-parse-head (chars &optional number)
706 "Parse the head of the current buffer." 794 "Parse the head of the current buffer."
@@ -718,13 +806,13 @@ marks file will be regenerated properly by Gnus.")
718 headers)))) 806 headers))))
719 807
720(defun nnml-get-nov-buffer (group) 808(defun nnml-get-nov-buffer (group)
721 (let ((buffer (get-buffer-create (format " *nnml overview %s*" group)))) 809 (let* ((decoded (nnml-decoded-group-name group))
810 (buffer (get-buffer-create (format " *nnml overview %s*" decoded)))
811 (file-name-coding-system nnmail-pathname-coding-system))
722 (save-excursion 812 (save-excursion
723 (set-buffer buffer) 813 (set-buffer buffer)
724 (set (make-local-variable 'nnml-nov-buffer-file-name) 814 (set (make-local-variable 'nnml-nov-buffer-file-name)
725 (expand-file-name 815 (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
726 nnml-nov-file-name
727 (nnmail-group-pathname group nnml-directory)))
728 (erase-buffer) 816 (erase-buffer)
729 (when (file-exists-p nnml-nov-buffer-file-name) 817 (when (file-exists-p nnml-nov-buffer-file-name)
730 (nnheader-insert-file-contents nnml-nov-buffer-file-name))) 818 (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
@@ -759,53 +847,57 @@ marks file will be regenerated properly by Gnus.")
759 (nnml-open-server server)) 847 (nnml-open-server server))
760 (setq nnml-directory (expand-file-name nnml-directory)) 848 (setq nnml-directory (expand-file-name nnml-directory))
761 ;; Recurse down the directories. 849 ;; Recurse down the directories.
762 (nnml-generate-nov-databases-1 nnml-directory nil t) 850 (nnml-generate-nov-databases-directory nnml-directory nil t)
763 ;; Save the active file. 851 ;; Save the active file.
764 (nnmail-save-active nnml-group-alist nnml-active-file)) 852 (nnmail-save-active nnml-group-alist nnml-active-file))
765 853
766(defun nnml-generate-nov-databases-1 (dir &optional seen no-active) 854(defun nnml-generate-nov-databases-directory (dir &optional seen no-active)
767 "Regenerate the NOV database in DIR." 855 "Regenerate the NOV database in DIR.
768 (interactive "DRegenerate NOV in: ") 856
857Unless no-active is non-nil, update the active file too."
858 (interactive (list (let ((file-name-coding-system
859 nnmail-pathname-coding-system))
860 (read-directory-name "Regenerate NOV in: "
861 nnml-directory nil t))))
769 (setq dir (file-name-as-directory dir)) 862 (setq dir (file-name-as-directory dir))
770 ;; Only scan this sub-tree if we haven't been here yet. 863 (let ((file-name-coding-system nnmail-pathname-coding-system))
771 (unless (member (file-truename dir) seen) 864 ;; Only scan this sub-tree if we haven't been here yet.
772 (push (file-truename dir) seen) 865 (unless (member (file-truename dir) seen)
773 ;; We descend recursively 866 (push (file-truename dir) seen)
774 (let ((dirs (directory-files dir t nil t)) 867 ;; We descend recursively
775 dir) 868 (dolist (dir (directory-files dir t nil t))
776 (while (setq dir (pop dirs))
777 (when (and (not (string-match "^\\." (file-name-nondirectory dir))) 869 (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
778 (file-directory-p dir)) 870 (file-directory-p dir))
779 (nnml-generate-nov-databases-1 dir seen)))) 871 (nnml-generate-nov-databases-directory dir seen)))
780 ;; Do this directory. 872 ;; Do this directory.
781 (let ((files (sort (nnheader-article-to-file-alist dir) 873 (let ((files (sort (nnheader-article-to-file-alist dir)
782 'car-less-than-car))) 874 'car-less-than-car)))
783 (if (not files) 875 (if (not files)
784 (let* ((group (nnheader-file-to-group 876 (let* ((group (nnheader-file-to-group
785 (directory-file-name dir) nnml-directory)) 877 (directory-file-name dir) nnml-directory))
786 (info (cadr (assoc group nnml-group-alist)))) 878 (info (cadr (assoc group nnml-group-alist))))
787 (when info 879 (when info
788 (setcar info (1+ (cdr info))))) 880 (setcar info (1+ (cdr info)))))
789 (funcall nnml-generate-active-function dir) 881 (funcall nnml-generate-active-function dir)
790 ;; Generate the nov file. 882 ;; Generate the nov file.
791 (nnml-generate-nov-file dir files) 883 (nnml-generate-nov-file dir files)
792 (unless no-active 884 (unless no-active
793 (nnmail-save-active nnml-group-alist nnml-active-file)))))) 885 (nnmail-save-active nnml-group-alist nnml-active-file)))))))
794 886
795(eval-when-compile (defvar files)) 887(eval-when-compile (defvar files))
796(defun nnml-generate-active-info (dir) 888(defun nnml-generate-active-info (dir)
797 ;; Update the active info for this group. 889 ;; Update the active info for this group.
798 (let* ((group (nnheader-file-to-group 890 (let ((group (directory-file-name dir))
799 (directory-file-name dir) nnml-directory)) 891 entry last)
800 (entry (assoc group nnml-group-alist)) 892 (setq group (nnheader-file-to-group (nnml-encoded-group-name group)
801 (last (or (caadr entry) 0))) 893 nnml-directory)
802 (setq nnml-group-alist (delq entry nnml-group-alist)) 894 entry (assoc group nnml-group-alist)
895 last (or (caadr entry) 0)
896 nnml-group-alist (delq entry nnml-group-alist))
803 (push (list group 897 (push (list group
804 (cons (or (caar files) (1+ last)) 898 (cons (or (caar files) (1+ last))
805 (max last 899 (max last
806 (or (let ((f files)) 900 (or (caar (last files))
807 (while (cdr f) (setq f (cdr f)))
808 (caar f))
809 0)))) 901 0))))
810 nnml-group-alist))) 902 nnml-group-alist)))
811 903
@@ -938,20 +1030,20 @@ Use the nov database for the current group if available."
938 1030
939(deffoo nnml-request-update-info (group info &optional server) 1031(deffoo nnml-request-update-info (group info &optional server)
940 (nnml-possibly-change-directory group server) 1032 (nnml-possibly-change-directory group server)
941 (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group)) 1033 (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
942 (nnheader-message 8 "Updating marks for %s..." group) 1034 (nnheader-message 8 "Updating marks for %s..." group)
943 (nnml-open-marks group server) 1035 (nnml-open-marks group server)
944 ;; Update info using `nnml-marks'. 1036 ;; Update info using `nnml-marks'.
945 (mapcar (lambda (pred) 1037 (mapc (lambda (pred)
946 (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) 1038 (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
947 (gnus-info-set-marks 1039 (gnus-info-set-marks
948 info 1040 info
949 (gnus-update-alist-soft 1041 (gnus-update-alist-soft
950 (cdr pred) 1042 (cdr pred)
951 (cdr (assq (cdr pred) nnml-marks)) 1043 (cdr (assq (cdr pred) nnml-marks))
952 (gnus-info-marks info)) 1044 (gnus-info-marks info))
953 t))) 1045 t)))
954 gnus-article-mark-lists) 1046 gnus-article-mark-lists)
955 (let ((seen (cdr (assq 'read nnml-marks)))) 1047 (let ((seen (cdr (assq 'read nnml-marks))))
956 (gnus-info-set-read info 1048 (gnus-info-set-read info
957 (if (and (integerp (car seen)) 1049 (if (and (integerp (car seen))
@@ -961,9 +1053,8 @@ Use the nov database for the current group if available."
961 (nnheader-message 8 "Updating marks for %s...done" group)) 1053 (nnheader-message 8 "Updating marks for %s...done" group))
962 info) 1054 info)
963 1055
964(defun nnml-marks-changed-p (group) 1056(defun nnml-marks-changed-p (group server)
965 (let ((file (expand-file-name nnml-marks-file-name 1057 (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
966 (nnmail-group-pathname group nnml-directory))))
967 (if (null (gnus-gethash file nnml-marks-modtime)) 1058 (if (null (gnus-gethash file nnml-marks-modtime))
968 t ;; never looked at marks file, assume it has changed 1059 t ;; never looked at marks file, assume it has changed
969 (not (equal (gnus-gethash file nnml-marks-modtime) 1060 (not (equal (gnus-gethash file nnml-marks-modtime)
@@ -971,11 +1062,10 @@ Use the nov database for the current group if available."
971 1062
972(defun nnml-save-marks (group server) 1063(defun nnml-save-marks (group server)
973 (let ((file-name-coding-system nnmail-pathname-coding-system) 1064 (let ((file-name-coding-system nnmail-pathname-coding-system)
974 (file (expand-file-name nnml-marks-file-name 1065 (file (nnml-group-pathname group nnml-marks-file-name server)))
975 (nnmail-group-pathname group nnml-directory))))
976 (condition-case err 1066 (condition-case err
977 (progn 1067 (progn
978 (nnml-possibly-create-directory group) 1068 (nnml-possibly-create-directory group server)
979 (with-temp-file file 1069 (with-temp-file file
980 (erase-buffer) 1070 (erase-buffer)
981 (gnus-prin1 nnml-marks) 1071 (gnus-prin1 nnml-marks)
@@ -988,9 +1078,10 @@ Use the nov database for the current group if available."
988 (error "Cannot write to %s (%s)" file err)))))) 1078 (error "Cannot write to %s (%s)" file err))))))
989 1079
990(defun nnml-open-marks (group server) 1080(defun nnml-open-marks (group server)
991 (let ((file (expand-file-name 1081 (let* ((decoded (nnml-decoded-group-name group server))
992 nnml-marks-file-name 1082 (file (nnmail-group-pathname decoded nnml-directory
993 (nnmail-group-pathname group nnml-directory)))) 1083 nnml-marks-file-name))
1084 (file-name-coding-system nnmail-pathname-coding-system))
994 (if (file-exists-p file) 1085 (if (file-exists-p file)
995 (condition-case err 1086 (condition-case err
996 (with-temp-buffer 1087 (with-temp-buffer
@@ -1008,14 +1099,211 @@ Use the nov database for the current group if available."
1008 (let ((info (gnus-get-info 1099 (let ((info (gnus-get-info
1009 (gnus-group-prefixed-name 1100 (gnus-group-prefixed-name
1010 group 1101 group
1011 (gnus-server-to-method (format "nnml:%s" server)))))) 1102 (gnus-server-to-method
1012 (nnheader-message 7 "Bootstrapping marks for %s..." group) 1103 (format "nnml:%s" (or server "")))))))
1104 (setq decoded (if (member server '(nil ""))
1105 (concat "nnml:" decoded)
1106 (format "nnml+%s:%s" server decoded)))
1107 (nnheader-message 7 "Bootstrapping marks for %s..." decoded)
1013 (setq nnml-marks (gnus-info-marks info)) 1108 (setq nnml-marks (gnus-info-marks info))
1014 (push (cons 'read (gnus-info-read info)) nnml-marks) 1109 (push (cons 'read (gnus-info-read info)) nnml-marks)
1015 (dolist (el gnus-article-unpropagated-mark-lists) 1110 (dolist (el gnus-article-unpropagated-mark-lists)
1016 (setq nnml-marks (gnus-remassoc el nnml-marks))) 1111 (setq nnml-marks (gnus-remassoc el nnml-marks)))
1017 (nnml-save-marks group server) 1112 (nnml-save-marks group server)
1018 (nnheader-message 7 "Bootstrapping marks for %s...done" group))))) 1113 (nnheader-message 7 "Bootstrapping marks for %s...done" decoded)))))
1114
1115
1116;;;
1117;;; Group and server compaction. -- dvl
1118;;;
1119
1120;; #### FIXME: this function handles self Xref: entry correctly, but I don't
1121;; #### know how to handle external cross-references. I actually don't know if
1122;; #### this is handled correctly elsewhere. For instance, what happens if you
1123;; #### move all articles to a new group (that's what people do for manual
1124;; #### compaction) ?
1125
1126;; #### NOTE: the function below handles the article backlog. This is
1127;; #### conceptually the wrong place to do it because the backend is at a
1128;; #### lower level. However, this is the only place where we have the needed
1129;; #### information to do the job. Ideally, this function should not handle
1130;; #### the backlog by itself, but return a list of moved groups / articles to
1131;; #### the caller. This will become important to avoid code duplication when
1132;; #### other backends get a compaction feature. Also, note that invalidating
1133;; #### the "original article buffer" is already done at an upper level.
1134
1135;; Shouldn't `nnml-request-compact-group' be interactive? --rsteib
1136
1137(defun nnml-request-compact-group (group &optional server save)
1138 (nnml-possibly-change-directory group server)
1139 (unless nnml-article-file-alist
1140 (setq nnml-article-file-alist
1141 (sort (nnml-current-group-article-to-file-alist)
1142 'car-less-than-car)))
1143 (if (not nnml-article-file-alist)
1144 ;; The group is empty: do nothing but return t
1145 t
1146 ;; The group is not empty:
1147 (let* ((group-full-name
1148 (gnus-group-prefixed-name
1149 group
1150 (gnus-server-to-method (format "nnml:%s" server))))
1151 (info (gnus-get-info group-full-name))
1152 (new-number 1)
1153 compacted)
1154 (let ((articles nnml-article-file-alist)
1155 article)
1156 (while (setq article (pop articles))
1157 (let ((old-number (car article)))
1158 (when (> old-number new-number)
1159 ;; There is a gap here:
1160 (let ((old-number-string (int-to-string old-number))
1161 (new-number-string (int-to-string new-number)))
1162 (setq compacted t)
1163 ;; #### NOTE: `nnml-article-to-file' calls
1164 ;; #### `nnml-update-file-alist' (which in turn calls
1165 ;; #### `nnml-current-group-article-to-file-alist', which
1166 ;; #### might use the NOV database). This might turn out to be
1167 ;; #### inefficient. In that case, we will do the work
1168 ;; #### manually.
1169 ;; 1/ Move the article to a new file:
1170 (let* ((oldfile (nnml-article-to-file old-number))
1171 (newfile
1172 (gnus-replace-in-string
1173 oldfile
1174 ;; nnml-use-compressed-files might be any string, but
1175 ;; probably it's sufficient to take into account only
1176 ;; "\\.[a-z0-9]+". Note that we can't only use the
1177 ;; value of nnml-use-compressed-files because old
1178 ;; articles might have been saved with a different
1179 ;; value.
1180 (concat
1181 "\\(" old-number-string "\\)\\(\\(\\.[a-z0-9]+\\)?\\)$")
1182 (concat new-number-string "\\2"))))
1183 (with-current-buffer nntp-server-buffer
1184 (nnmail-find-file oldfile)
1185 ;; Update the Xref header in the article itself:
1186 (when (and (re-search-forward "^Xref: [^ ]+ " nil t)
1187 (re-search-forward
1188 (concat "\\<"
1189 (regexp-quote
1190 (concat group ":" old-number-string))
1191 "\\>")
1192 (point-at-eol) t))
1193 (replace-match
1194 (concat group ":" new-number-string)))
1195 ;; Save to the new file:
1196 (nnmail-write-region (point-min) (point-max) newfile))
1197 (funcall nnmail-delete-file-function oldfile))
1198 ;; 2/ Update all marks for this article:
1199 ;; #### NOTE: it is possible that the new article number
1200 ;; #### already belongs to a range, whereas the corresponding
1201 ;; #### article doesn't exist (for example, if you delete an
1202 ;; #### article). For that reason, it is important to update
1203 ;; #### the ranges (meaning remove inexistant articles) before
1204 ;; #### doing anything on them.
1205 ;; 2 a/ read articles:
1206 (let ((read (gnus-info-read info)))
1207 (setq read (gnus-remove-from-range read (list new-number)))
1208 (when (gnus-member-of-range old-number read)
1209 (setq read (gnus-remove-from-range read (list old-number)))
1210 (setq read (gnus-add-to-range read (list new-number))))
1211 (gnus-info-set-read info read))
1212 ;; 2 b/ marked articles:
1213 (let ((oldmarks (gnus-info-marks info))
1214 mark newmarks)
1215 (while (setq mark (pop oldmarks))
1216 (setcdr mark (gnus-remove-from-range (cdr mark)
1217 (list new-number)))
1218 (when (gnus-member-of-range old-number (cdr mark))
1219 (setcdr mark (gnus-remove-from-range (cdr mark)
1220 (list old-number)))
1221 (setcdr mark (gnus-add-to-range (cdr mark)
1222 (list new-number))))
1223 (push mark newmarks))
1224 (gnus-info-set-marks info newmarks))
1225 ;; 3/ Update the NOV entry for this article:
1226 (unless nnml-nov-is-evil
1227 (save-excursion
1228 (set-buffer (nnml-open-nov group))
1229 (when (nnheader-find-nov-line old-number)
1230 ;; Replace the article number:
1231 (looking-at old-number-string)
1232 (replace-match new-number-string nil t)
1233 ;; Update the Xref header:
1234 (when (re-search-forward
1235 (concat "\\(Xref:[^\t\n]* \\)\\<"
1236 (regexp-quote
1237 (concat group ":" old-number-string))
1238 "\\>")
1239 (point-at-eol) t)
1240 (replace-match
1241 (concat "\\1" group ":" new-number-string))))))
1242 ;; 4/ Possibly remove the article from the backlog:
1243 (when gnus-keep-backlog
1244 ;; #### NOTE: instead of removing the article, we could
1245 ;; #### modify the backlog to reflect the numbering change,
1246 ;; #### but I don't think it's worth it.
1247 (gnus-backlog-remove-article group-full-name old-number)
1248 (gnus-backlog-remove-article group-full-name new-number))))
1249 (setq new-number (1+ new-number)))))
1250 (if (not compacted)
1251 ;; No compaction had to be done:
1252 t
1253 ;; Some articles have actually been renamed:
1254 ;; 1/ Rebuild active information:
1255 (let ((entry (assoc group nnml-group-alist))
1256 (active (cons 1 (1- new-number))))
1257 (setq nnml-group-alist (delq entry nnml-group-alist))
1258 (push (list group active) nnml-group-alist)
1259 ;; Update the active hashtable to let the *Group* buffer display
1260 ;; up-to-date lines. I don't think that either gnus-newsrc-hashtb or
1261 ;; gnus-newwrc-alist are out of date, since all we did is to modify
1262 ;; the info of the group internally.
1263 (gnus-set-active group-full-name active))
1264 ;; 1 bis/
1265 ;; #### NOTE: normally, we should save the overview (NOV) file
1266 ;; #### here, just like we save the marks file. However, there is no
1267 ;; #### such function as nnml-save-nov for a single group. Only for
1268 ;; #### all groups. Gnus inconsistency is getting worse every day...
1269 ;; 2/ Rebuild marks file:
1270 (unless nnml-marks-is-evil
1271 ;; #### NOTE: this constant use of global variables everywhere is
1272 ;; #### truly disgusting. Gnus really needs a *major* cleanup.
1273 (setq nnml-marks (gnus-info-marks info))
1274 (push (cons 'read (gnus-info-read info)) nnml-marks)
1275 (dolist (el gnus-article-unpropagated-mark-lists)
1276 (setq nnml-marks (gnus-remassoc el nnml-marks)))
1277 (nnml-save-marks group server))
1278 ;; 3/ Save everything if this was not part of a bigger operation:
1279 (if (not save)
1280 ;; Nothing to save (yet):
1281 t
1282 ;; Something to save:
1283 ;; a/ Save the NOV databases:
1284 ;; #### NOTE: this should be done directory per directory in 1bis
1285 ;; #### above. See comment there.
1286 (nnml-save-nov)
1287 ;; b/ Save the active file:
1288 (nnmail-save-active nnml-group-alist nnml-active-file)
1289 t)))))
1290
1291(defun nnml-request-compact (&optional server)
1292 "Request compaction of all SERVER nnml groups."
1293 (interactive (list (or (nnoo-current-server 'nnml) "")))
1294 (nnmail-activate 'nnml)
1295 (unless (nnml-server-opened server)
1296 (nnml-open-server server))
1297 (setq nnml-directory (expand-file-name nnml-directory))
1298 (let* ((groups (gnus-groups-from-server
1299 (gnus-server-to-method (format "nnml:%s" server))))
1300 (first (pop groups))
1301 group)
1302 (when first
1303 (while (setq group (pop groups))
1304 (nnml-request-compact-group (gnus-group-real-name group) server))
1305 (nnml-request-compact-group (gnus-group-real-name first) server t))))
1306
1019 1307
1020(provide 'nnml) 1308(provide 'nnml)
1021 1309
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
index 3508a7dd94f..926553365d3 100644
--- a/lisp/gnus/nnnil.el
+++ b/lisp/gnus/nnnil.el
@@ -32,8 +32,7 @@
32(defvar nnnil-status-string "") 32(defvar nnnil-status-string "")
33 33
34(defun nnnil-retrieve-headers (articles &optional group server fetch-old) 34(defun nnnil-retrieve-headers (articles &optional group server fetch-old)
35 (save-excursion 35 (with-current-buffer nntp-server-buffer
36 (set-buffer nntp-server-buffer)
37 (erase-buffer)) 36 (erase-buffer))
38 'nov) 37 'nov)
39 38
@@ -69,8 +68,7 @@
69 t) 68 t)
70 69
71(defun nnnil-request-list (&optional server) 70(defun nnnil-request-list (&optional server)
72 (save-excursion 71 (with-current-buffer nntp-server-buffer
73 (set-buffer nntp-server-buffer)
74 (erase-buffer)) 72 (erase-buffer))
75 t) 73 t)
76 74
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index af2a3e2ea62..5241f9d80e6 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -50,6 +50,15 @@
50(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/") 50(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
51 "Where nnrss will save its files.") 51 "Where nnrss will save its files.")
52 52
53(defvoo nnrss-ignore-article-fields '(slash:comments)
54 "*List of fields that should be ignored when comparing RSS articles.
55Some RSS feeds update article fields during their lives, e.g. to
56indicate the number of comments or the number of times the
57articles have been seen. However, if there is a difference
58between the local article and the distant one, the latter is
59considered to be new. To avoid this and discard some fields, set
60this variable to the list of fields to be ignored.")
61
53;; (group max rss-url) 62;; (group max rss-url)
54(defvoo nnrss-server-data nil) 63(defvoo nnrss-server-data nil)
55 64
@@ -58,7 +67,7 @@
58(defvoo nnrss-group-max 0) 67(defvoo nnrss-group-max 0)
59(defvoo nnrss-group-min 1) 68(defvoo nnrss-group-min 1)
60(defvoo nnrss-group nil) 69(defvoo nnrss-group nil)
61(defvoo nnrss-group-hashtb nil) 70(defvoo nnrss-group-hashtb (make-hash-table :test 'equal))
62(defvoo nnrss-status-string "") 71(defvoo nnrss-status-string "")
63 72
64(defconst nnrss-version "nnrss 1.0") 73(defconst nnrss-version "nnrss 1.0")
@@ -83,7 +92,13 @@ ENTRY is the record of the current headline. GROUP is the group name.
83ARTICLE is the article number of the current headline.") 92ARTICLE is the article number of the current headline.")
84 93
85(defvar nnrss-file-coding-system mm-universal-coding-system 94(defvar nnrss-file-coding-system mm-universal-coding-system
86 "Coding system used when reading and writing files.") 95 "*Coding system used when reading and writing files.
96If you run Gnus with various versions of Emacsen, the value of this
97variable should be the coding system that all those Emacsen support.
98Note that you have to regenerate all the nnrss groups if you change
99the value. Moreover, you should be patient even if you are made to
100read the same articles twice, that arises for the difference of the
101versions of xml.el.")
87 102
88(defvar nnrss-compatible-encoding-alist 103(defvar nnrss-compatible-encoding-alist
89 (delq nil (mapcar (lambda (elem) 104 (delq nil (mapcar (lambda (elem)
@@ -365,7 +380,8 @@ used to render text. If it is nil, text will simply be folded.")
365 (delq (assoc group nnrss-server-data) nnrss-server-data)) 380 (delq (assoc group nnrss-server-data) nnrss-server-data))
366 (nnrss-save-server-data server) 381 (nnrss-save-server-data server)
367 (ignore-errors 382 (ignore-errors
368 (delete-file (nnrss-make-filename group server))) 383 (let ((file-name-coding-system nnmail-pathname-coding-system))
384 (delete-file (nnrss-make-filename group server))))
369 t) 385 t)
370 386
371(deffoo nnrss-request-list-newsgroups (&optional server) 387(deffoo nnrss-request-list-newsgroups (&optional server)
@@ -391,10 +407,10 @@ return `utf-8' which is the default encoding for xml if it is available,
391otherwise return nil." 407otherwise return nil."
392 (goto-char (point-min)) 408 (goto-char (point-min))
393 (if (re-search-forward 409 (if (re-search-forward
394 "<\\?[^>]*encoding=\\(\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" 410 "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
395 nil t) 411 nil t)
396 (let ((encoding (intern (downcase (or (match-string 2) 412 (let ((encoding (intern (downcase (or (match-string 1)
397 (match-string 3)))))) 413 (match-string 2))))))
398 (or 414 (or
399 (mm-coding-system-p (cdr (assq encoding 415 (mm-coding-system-p (cdr (assq encoding
400 nnrss-compatible-encoding-alist))) 416 nnrss-compatible-encoding-alist)))
@@ -462,8 +478,7 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
462 478
463(defun nnrss-generate-active () 479(defun nnrss-generate-active ()
464 (when (y-or-n-p "Fetch extra categories? ") 480 (when (y-or-n-p "Fetch extra categories? ")
465 (dolist (func nnrss-extra-categories) 481 (mapc 'funcall nnrss-extra-categories))
466 (funcall func)))
467 (save-excursion 482 (save-excursion
468 (set-buffer nntp-server-buffer) 483 (set-buffer nntp-server-buffer)
469 (erase-buffer) 484 (erase-buffer)
@@ -500,37 +515,37 @@ which RSS 2.0 allows."
500 (concat 515 (concat
501 ;; 1. year 516 ;; 1. year
502 "\\(199[0-9]\\|20[0-9][0-9]\\)" 517 "\\(199[0-9]\\|20[0-9][0-9]\\)"
503 "\\(-" 518 "\\(?:-"
504 ;; 3. month 519 ;; 2. month
505 "\\([01][0-9]\\)" 520 "\\([01][0-9]\\)"
506 "\\(-" 521 "\\(?:-"
507 ;; 5. day 522 ;; 3. day
508 "\\([0-3][0-9]\\)" 523 "\\([0-3][0-9]\\)"
509 "\\)?\\)?\\(T" 524 "\\)?\\)?\\(?:T"
510 ;; 7. hh:mm 525 ;; 4. hh:mm
511 "\\([012][0-9]:[0-5][0-9]\\)" 526 "\\([012][0-9]:[0-5][0-9]\\)"
512 "\\(" 527 "\\(?:"
513 ;; 9. :ss 528 ;; 5. :ss
514 "\\(:[0-5][0-9]\\)" 529 "\\(:[0-5][0-9]\\)"
515 "\\(\\.[0-9]+\\)?\\)?\\)?" 530 "\\(?:\\.[0-9]+\\)?\\)?\\)?"
516 ;; 13+14,15,16. zone 531 ;; 6+7,8,9. zone
517 "\\(\\(\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)" 532 "\\(?:\\(?:\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)"
518 "\\|\\([+-][012][0-9][0-5][0-9]\\)" 533 "\\|\\([+-][012][0-9][0-5][0-9]\\)"
519 "\\|\\(Z\\)\\)?")) 534 "\\|\\(Z\\)\\)?"))
520 date) 535 date)
521 (setq year (string-to-number (match-string 1 date)) 536 (setq year (string-to-number (match-string 1 date))
522 month (string-to-number (or (match-string 3 date) "1")) 537 month (string-to-number (or (match-string 2 date) "1"))
523 day (string-to-number (or (match-string 5 date) "1")) 538 day (string-to-number (or (match-string 3 date) "1"))
524 time (if (match-beginning 9) 539 time (if (match-beginning 5)
525 (substring date (match-beginning 7) (match-end 9)) 540 (substring date (match-beginning 4) (match-end 5))
526 (concat (or (match-string 7 date) "00:00") ":00")) 541 (concat (or (match-string 4 date) "00:00") ":00"))
527 zone (cond ((match-beginning 13) 542 zone (cond ((match-beginning 6)
528 (concat (match-string 13 date) 543 (concat (match-string 6 date)
529 (match-string 14 date))) 544 (match-string 7 date)))
530 ((match-beginning 16) ;; Z 545 ((match-beginning 9) ;; Z
531 "+0000") 546 "+0000")
532 (t ;; nil if zone is not provided. 547 (t ;; nil if zone is not provided.
533 (match-string 15 date)))))) 548 (match-string 8 date))))))
534 (if month 549 (if month
535 (progn 550 (progn
536 (setq cts (current-time-string (encode-time 0 0 0 day month year))) 551 (setq cts (current-time-string (encode-time 0 0 0 day month year)))
@@ -545,13 +560,13 @@ which RSS 2.0 allows."
545 560
546(defun nnrss-read-server-data (server) 561(defun nnrss-read-server-data (server)
547 (setq nnrss-server-data nil) 562 (setq nnrss-server-data nil)
548 (let ((file (nnrss-make-filename "nnrss" server))) 563 (let ((file (nnrss-make-filename "nnrss" server))
564 (file-name-coding-system nnmail-pathname-coding-system))
549 (when (file-exists-p file) 565 (when (file-exists-p file)
550 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII 566 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
551 ;; file names. So, we use `insert-file-contents' instead. 567 ;; file names. So, we use `insert-file-contents' instead.
552 (mm-with-multibyte-buffer 568 (mm-with-multibyte-buffer
553 (let ((coding-system-for-read nnrss-file-coding-system) 569 (let ((coding-system-for-read nnrss-file-coding-system))
554 (file-name-coding-system nnmail-pathname-coding-system))
555 (insert-file-contents file) 570 (insert-file-contents file)
556 (eval-region (point-min) (point-max))))))) 571 (eval-region (point-min) (point-max)))))))
557 572
@@ -568,21 +583,23 @@ which RSS 2.0 allows."
568 583
569(defun nnrss-read-group-data (group server) 584(defun nnrss-read-group-data (group server)
570 (setq nnrss-group-data nil) 585 (setq nnrss-group-data nil)
571 (setq nnrss-group-hashtb (gnus-make-hashtable)) 586 (if (hash-table-p nnrss-group-hashtb)
587 (clrhash nnrss-group-hashtb)
588 (setq nnrss-group-hashtb (make-hash-table :test 'equal)))
572 (let ((pair (assoc group nnrss-server-data))) 589 (let ((pair (assoc group nnrss-server-data)))
573 (setq nnrss-group-max (or (cadr pair) 0)) 590 (setq nnrss-group-max (or (cadr pair) 0))
574 (setq nnrss-group-min (+ nnrss-group-max 1))) 591 (setq nnrss-group-min (+ nnrss-group-max 1)))
575 (let ((file (nnrss-make-filename group server))) 592 (let ((file (nnrss-make-filename group server))
593 (file-name-coding-system nnmail-pathname-coding-system))
576 (when (file-exists-p file) 594 (when (file-exists-p file)
577 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII 595 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
578 ;; file names. So, we use `insert-file-contents' instead. 596 ;; file names. So, we use `insert-file-contents' instead.
579 (mm-with-multibyte-buffer 597 (mm-with-multibyte-buffer
580 (let ((coding-system-for-read nnrss-file-coding-system) 598 (let ((coding-system-for-read nnrss-file-coding-system))
581 (file-name-coding-system nnmail-pathname-coding-system))
582 (insert-file-contents file) 599 (insert-file-contents file)
583 (eval-region (point-min) (point-max)))) 600 (eval-region (point-min) (point-max))))
584 (dolist (e nnrss-group-data) 601 (dolist (e nnrss-group-data)
585 (gnus-sethash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb) 602 (puthash (nth 9 e) t nnrss-group-hashtb)
586 (when (and (car e) (> nnrss-group-min (car e))) 603 (when (and (car e) (> nnrss-group-min (car e)))
587 (setq nnrss-group-min (car e))) 604 (setq nnrss-group-min (car e)))
588 (when (and (car e) (< nnrss-group-max (car e))) 605 (when (and (car e) (< nnrss-group-max (car e)))
@@ -662,9 +679,20 @@ which RSS 2.0 allows."
662 679
663;;; Snarf functions 680;;; Snarf functions
664 681
682(defun nnrss-make-hash-index (item)
683 (setq item (gnus-remove-if
684 (lambda (field)
685 (when (listp field)
686 (memq (car field) nnrss-ignore-article-fields)))
687 item))
688 (md5 (gnus-prin1-to-string item)
689 nil nil
690 nnrss-file-coding-system))
691
665(defun nnrss-check-group (group server) 692(defun nnrss-check-group (group server)
666 (let (file xml subject url extra changed author date feed-subject 693 (let (file xml subject url extra changed author date feed-subject
667 enclosure comments rss-ns rdf-ns content-ns dc-ns) 694 enclosure comments rss-ns rdf-ns content-ns dc-ns
695 hash-index)
668 (if (and nnrss-use-local 696 (if (and nnrss-use-local
669 (file-exists-p (setq file (expand-file-name 697 (file-exists-p (setq file (expand-file-name
670 (nnrss-translate-file-chars 698 (nnrss-translate-file-chars
@@ -696,15 +724,12 @@ which RSS 2.0 allows."
696 (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) 724 (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
697 (when (and (listp item) 725 (when (and (listp item)
698 (string= (concat rss-ns "item") (car item)) 726 (string= (concat rss-ns "item") (car item))
699 (if (setq url (nnrss-decode-entities-string 727 (progn (setq hash-index (nnrss-make-hash-index item))
700 (nnrss-node-text rss-ns 'link (cddr item)))) 728 (not (gethash hash-index nnrss-group-hashtb))))
701 (not (gnus-gethash url nnrss-group-hashtb))
702 (setq extra (or (nnrss-node-text content-ns 'encoded item)
703 (nnrss-node-text rss-ns 'description item)))
704 (not (gnus-gethash extra nnrss-group-hashtb))))
705 (setq subject (nnrss-node-text rss-ns 'title item)) 729 (setq subject (nnrss-node-text rss-ns 'title item))
706 (setq extra (or extra 730 (setq url (nnrss-decode-entities-string
707 (nnrss-node-text content-ns 'encoded item) 731 (nnrss-node-text rss-ns 'link (cddr item))))
732 (setq extra (or (nnrss-node-text content-ns 'encoded item)
708 (nnrss-node-text rss-ns 'description item))) 733 (nnrss-node-text rss-ns 'description item)))
709 (if (setq feed-subject (nnrss-node-text dc-ns 'subject item)) 734 (if (setq feed-subject (nnrss-node-text dc-ns 'subject item))
710 (setq extra (concat feed-subject "<br /><br />" extra))) 735 (setq extra (concat feed-subject "<br /><br />" extra)))
@@ -746,9 +771,10 @@ which RSS 2.0 allows."
746 date 771 date
747 (and extra (nnrss-decode-entities-string extra)) 772 (and extra (nnrss-decode-entities-string extra))
748 enclosure 773 enclosure
749 comments) 774 comments
775 hash-index)
750 nnrss-group-data) 776 nnrss-group-data)
751 (gnus-sethash (or url extra) t nnrss-group-hashtb) 777 (puthash hash-index t nnrss-group-hashtb)
752 (setq changed t)) 778 (setq changed t))
753 (setq extra nil)) 779 (setq extra nil))
754 (when changed 780 (when changed
@@ -947,7 +973,7 @@ whether they are `offsite' or `onsite'."
947 (let (rss-onsite-end rdf-onsite-end xml-onsite-end 973 (let (rss-onsite-end rdf-onsite-end xml-onsite-end
948 rss-onsite-in rdf-onsite-in xml-onsite-in 974 rss-onsite-in rdf-onsite-in xml-onsite-in
949 rss-offsite-end rdf-offsite-end xml-offsite-end 975 rss-offsite-end rdf-offsite-end xml-offsite-end
950 rss-offsite-in rdf-offsite-in xml-offsite-in) 976 rss-offsite-in rdf-offsite-in xml-offsite-in)
951 (dolist (href hrefs) 977 (dolist (href hrefs)
952 (cond ((null href)) 978 (cond ((null href))
953 ((string-match "\\.rss$" href) 979 ((string-match "\\.rss$" href)
diff --git a/lisp/gnus/nnslashdot.el b/lisp/gnus/nnslashdot.el
index ee97f7085c8..04e998c76ba 100644
--- a/lisp/gnus/nnslashdot.el
+++ b/lisp/gnus/nnslashdot.el
@@ -459,11 +459,9 @@
459 (insert-file-contents file) 459 (insert-file-contents file)
460 (goto-char (point-min)) 460 (goto-char (point-min))
461 (setq nnslashdot-groups (read (current-buffer)))) 461 (setq nnslashdot-groups (read (current-buffer))))
462 (if (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) 462 (when (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5))
463 (let ((groups nnslashdot-groups)) 463 (dolist (group nnslashdot-groups)
464 (while groups 464 (nnslashdot-make-tuple group 5))))))
465 (nnslashdot-make-tuple (car groups) 5)
466 (setq groups (cdr groups))))))))
467 465
468(defun nnslashdot-write-groups () 466(defun nnslashdot-write-groups ()
469 (with-temp-file (expand-file-name "groups" nnslashdot-directory) 467 (with-temp-file (expand-file-name "groups" nnslashdot-directory)
diff --git a/lisp/gnus/nnsoup.el b/lisp/gnus/nnsoup.el
index 8167ba2bf4e..1053ecc413c 100644
--- a/lisp/gnus/nnsoup.el
+++ b/lisp/gnus/nnsoup.el
@@ -371,9 +371,7 @@ backend for the messages.")
371 entry e min max) 371 entry e min max)
372 (while (setq e (cdr (setq entry (pop alist)))) 372 (while (setq e (cdr (setq entry (pop alist))))
373 (setq min (caaar e)) 373 (setq min (caaar e))
374 (while (cdr e) 374 (setq max (cdar (car (last e))))
375 (setq e (cdr e)))
376 (setq max (cdar (car e)))
377 (setcdr entry (cons (cons min max) (cdr entry))))) 375 (setcdr entry (cons (cons min max) (cdr entry)))))
378 (setq nnsoup-group-alist-touched t)) 376 (setq nnsoup-group-alist-touched t))
379 nnsoup-group-alist)) 377 nnsoup-group-alist))
@@ -558,9 +556,8 @@ backend for the messages.")
558(defun nnsoup-unpack-packets () 556(defun nnsoup-unpack-packets ()
559 "Unpack all packets in `nnsoup-packet-directory'." 557 "Unpack all packets in `nnsoup-packet-directory'."
560 (let ((packets (directory-files 558 (let ((packets (directory-files
561 nnsoup-packet-directory t nnsoup-packet-regexp)) 559 nnsoup-packet-directory t nnsoup-packet-regexp)))
562 packet) 560 (dolist (packet packets)
563 (while (setq packet (pop packets))
564 (nnheader-message 5 "nnsoup: unpacking %s..." packet) 561 (nnheader-message 5 "nnsoup: unpacking %s..." packet)
565 (if (not (gnus-soup-unpack-packet 562 (if (not (gnus-soup-unpack-packet
566 nnsoup-tmp-directory nnsoup-unpacker packet)) 563 nnsoup-tmp-directory nnsoup-unpacker packet))
@@ -759,20 +756,18 @@ backend for the messages.")
759 (string-to-number (match-string 1 f2))))))) 756 (string-to-number (match-string 1 f2)))))))
760 active group lines ident elem min) 757 active group lines ident elem min)
761 (set-buffer (get-buffer-create " *nnsoup work*")) 758 (set-buffer (get-buffer-create " *nnsoup work*"))
762 (while files 759 (dolist (file files)
763 (nnheader-message 5 "Doing %s..." (car files)) 760 (nnheader-message 5 "Doing %s..." file)
764 (erase-buffer) 761 (erase-buffer)
765 (nnheader-insert-file-contents (car files)) 762 (nnheader-insert-file-contents file)
766 (goto-char (point-min)) 763 (goto-char (point-min))
767 (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) 764 (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
768 (setq group "unknown") 765 (setq group "unknown")
769 (setq group (match-string 2))) 766 (setq group (match-string 2)))
770 (setq lines (count-lines (point-min) (point-max))) 767 (setq lines (count-lines (point-min) (point-max)))
771 (setq ident (progn (string-match 768 (setq ident (progn (string-match
772 "/\\([0-9]+\\)\\." (car files)) 769 "/\\([0-9]+\\)\\." file)
773 (substring 770 (match-string 1 file)))
774 (car files) (match-beginning 1)
775 (match-end 1))))
776 (if (not (setq elem (assoc group active))) 771 (if (not (setq elem (assoc group active)))
777 (push (list group (cons 1 lines) 772 (push (list group (cons 1 lines)
778 (list (cons 1 lines) 773 (list (cons 1 lines)
@@ -783,8 +778,7 @@ backend for the messages.")
783 (list (cons (1+ (setq min (cdadr elem))) 778 (list (cons (1+ (setq min (cdadr elem)))
784 (+ min lines)) 779 (+ min lines))
785 (vector ident group "ucm" "" lines)))) 780 (vector ident group "ucm" "" lines))))
786 (setcdr (cadr elem) (+ min lines))) 781 (setcdr (cadr elem) (+ min lines))))
787 (setq files (cdr files)))
788 (nnheader-message 5 "") 782 (nnheader-message 5 "")
789 (setq nnsoup-group-alist active) 783 (setq nnsoup-group-alist active)
790 (nnsoup-write-active-file t))) 784 (nnsoup-write-active-file t)))
@@ -801,9 +795,9 @@ backend for the messages.")
801 nnsoup-group-alist))) 795 nnsoup-group-alist)))
802 (regexp "\\.MSG$\\|\\.IDX$") 796 (regexp "\\.MSG$\\|\\.IDX$")
803 (files (directory-files nnsoup-directory nil regexp)) 797 (files (directory-files nnsoup-directory nil regexp))
804 non-files file) 798 non-files)
805 ;; Find all files that aren't known by nnsoup. 799 ;; Find all files that aren't known by nnsoup.
806 (while (setq file (pop files)) 800 (dolist (file files)
807 (string-match regexp file) 801 (string-match regexp file)
808 (unless (member (substring file 0 (match-beginning 0)) known) 802 (unless (member (substring file 0 (match-beginning 0)) known)
809 (push file non-files))) 803 (push file non-files)))
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 39fa1874d3b..0861f5c85a3 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -246,13 +246,11 @@ there.")
246 ;; Yes, completely empty spool directories *are* possible. 246 ;; Yes, completely empty spool directories *are* possible.
247 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> 247 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
248 (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) 248 (when (setq dir (directory-files pathname nil "^[0-9]+$" t))
249 (setq dir 249 (setq dir (sort (mapcar 'string-to-number dir) '<)))
250 (sort (mapcar (lambda (name) (string-to-number name)) dir) '<)))
251 (if dir 250 (if dir
252 (nnheader-insert 251 (nnheader-insert
253 "211 %d %d %d %s\n" (length dir) (car dir) 252 "211 %d %d %d %s\n" (length dir) (car dir)
254 (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) 253 (car (last dir)) group)
255 group)
256 (nnheader-report 'nnspool "Empty group %s" group) 254 (nnheader-report 'nnspool "Empty group %s" group)
257 (nnheader-insert "211 0 0 0 %s\n" group)))))) 255 (nnheader-insert "211 0 0 0 %s\n" group))))))
258 256
@@ -311,9 +309,8 @@ there.")
311 groups) 309 groups)
312 (zerop (forward-line -1)))) 310 (zerop (forward-line -1))))
313 (erase-buffer) 311 (erase-buffer)
314 (while groups 312 (dolist (group groups)
315 (insert (car groups) " 0 0 y\n") 313 (insert group " 0 0 y\n")))
316 (setq groups (cdr groups))))
317 t) 314 t)
318 nil)) 315 nil))
319 316
@@ -400,8 +397,7 @@ there.")
400 (<= last (car arts))) 397 (<= last (car arts)))
401 (pop arts)) 398 (pop arts))
402 ;; The articles in `arts' are missing from the buffer. 399 ;; The articles in `arts' are missing from the buffer.
403 (while arts 400 (mapc 'nnspool-insert-nov-head arts)
404 (nnspool-insert-nov-head (pop arts)))
405 t)))))))))) 401 t))))))))))
406 402
407(defun nnspool-insert-nov-head (article) 403(defun nnspool-insert-nov-head (article)
@@ -421,8 +417,7 @@ there.")
421 417
422(defun nnspool-sift-nov-with-sed (articles file) 418(defun nnspool-sift-nov-with-sed (articles file)
423 (let ((first (car articles)) 419 (let ((first (car articles))
424 (last (progn (while (cdr articles) (setq articles (cdr articles))) 420 (last (car (last articles))))
425 (car articles))))
426 (call-process "awk" nil t nil 421 (call-process "awk" nil t nil
427 (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" 422 (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
428 (1- first) (1+ last)) 423 (1- first) (1+ last))
@@ -431,16 +426,12 @@ there.")
431;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). 426;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle).
432;; Find out what group an article identified by a Message-ID is in. 427;; Find out what group an article identified by a Message-ID is in.
433(defun nnspool-find-id (id) 428(defun nnspool-find-id (id)
434 (save-excursion 429 (with-temp-buffer
435 (set-buffer (get-buffer-create " *nnspool work*"))
436 (erase-buffer)
437 (ignore-errors 430 (ignore-errors
438 (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) 431 (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
439 (goto-char (point-min)) 432 (goto-char (point-min))
440 (prog1 433 (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]")
441 (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") 434 (cons (match-string 1) (string-to-number (match-string 2))))))
442 (cons (match-string 1) (string-to-number (match-string 2))))
443 (kill-buffer (current-buffer)))))
444 435
445(defun nnspool-find-file (file) 436(defun nnspool-find-file (file)
446 "Insert FILE in server buffer safely." 437 "Insert FILE in server buffer safely."
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 2623df58e4d..c8c14da4df7 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -31,6 +31,8 @@
31(require 'nnheader) 31(require 'nnheader)
32(require 'nnoo) 32(require 'nnoo)
33(require 'gnus-util) 33(require 'gnus-util)
34(require 'gnus)
35(require 'gnus-group) ;; gnus-group-name-charset
34 36
35(nnoo-declare nntp) 37(nnoo-declare nntp)
36 38
@@ -86,6 +88,7 @@ Direct connections:
86 88
87Indirect connections: 89Indirect connections:
88- `nntp-open-via-rlogin-and-telnet', 90- `nntp-open-via-rlogin-and-telnet',
91- `nntp-open-via-rlogin-and-netcat',
89- `nntp-open-via-telnet-and-telnet'.") 92- `nntp-open-via-telnet-and-telnet'.")
90 93
91(defvoo nntp-never-echoes-commands nil 94(defvoo nntp-never-echoes-commands nil
@@ -109,20 +112,22 @@ This is where you would put \"runsocks\" or stuff like that.")
109 112
110(defvoo nntp-telnet-command "telnet" 113(defvoo nntp-telnet-command "telnet"
111 "*Telnet command used to connect to the nntp server. 114 "*Telnet command used to connect to the nntp server.
112This command is used by the various nntp-open-via-* methods.") 115This command is used by the methods `nntp-open-telnet-stream',
116`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.")
113 117
114(defvoo nntp-telnet-switches '("-8") 118(defvoo nntp-telnet-switches '("-8")
115 "*Switches given to the telnet command `nntp-telnet-command'.") 119 "*Switches given to the telnet command `nntp-telnet-command'.")
116 120
117(defvoo nntp-end-of-line "\r\n" 121(defvoo nntp-end-of-line "\r\n"
118 "*String to use on the end of lines when talking to the NNTP server. 122 "*String to use on the end of lines when talking to the NNTP server.
119This is \"\\r\\n\" by default, but should be \"\\n\" when 123This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect
120using an indirect connection method (nntp-open-via-*).") 124connection method (nntp-open-via-*).")
121 125
122(defvoo nntp-via-rlogin-command "rsh" 126(defvoo nntp-via-rlogin-command "rsh"
123 "*Rlogin command used to connect to an intermediate host. 127 "*Rlogin command used to connect to an intermediate host.
124This command is used by the `nntp-open-via-rlogin-and-telnet' method. 128This command is used by the methods `nntp-open-via-rlogin-and-telnet'
125The default is \"rsh\", but \"ssh\" is a popular alternative.") 129and `nntp-open-via-rlogin-and-netcat'. The default is \"rsh\", but \"ssh\"
130is a popular alternative.")
126 131
127(defvoo nntp-via-rlogin-command-switches nil 132(defvoo nntp-via-rlogin-command-switches nil
128 "*Switches given to the rlogin command `nntp-via-rlogin-command'. 133 "*Switches given to the rlogin command `nntp-via-rlogin-command'.
@@ -138,9 +143,16 @@ This command is used by the `nntp-open-via-telnet-and-telnet' method.")
138(defvoo nntp-via-telnet-switches '("-8") 143(defvoo nntp-via-telnet-switches '("-8")
139 "*Switches given to the telnet command `nntp-via-telnet-command'.") 144 "*Switches given to the telnet command `nntp-via-telnet-command'.")
140 145
146(defvoo nntp-via-netcat-command "nc"
147 "*Netcat command used to connect to the nntp server.
148This command is used by the `nntp-open-via-rlogin-and-netcat' method.")
149
150(defvoo nntp-via-netcat-switches nil
151 "*Switches given to the netcat command `nntp-via-netcat-command'.")
152
141(defvoo nntp-via-user-name nil 153(defvoo nntp-via-user-name nil
142 "*User name to log in on an intermediate host with. 154 "*User name to log in on an intermediate host with.
143This variable is used by the `nntp-open-via-telnet-and-telnet' method.") 155This variable is used by the various nntp-open-via-* methods.")
144 156
145(defvoo nntp-via-user-password nil 157(defvoo nntp-via-user-password nil
146 "*Password to use to log in on an intermediate host with. 158 "*Password to use to log in on an intermediate host with.
@@ -148,8 +160,7 @@ This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
148 160
149(defvoo nntp-via-address nil 161(defvoo nntp-via-address nil
150 "*Address of an intermediate host to connect to. 162 "*Address of an intermediate host to connect to.
151This variable is used by the `nntp-open-via-rlogin-and-telnet' and 163This variable is used by the various nntp-open-via-* methods.")
152`nntp-open-via-telnet-and-telnet' methods.")
153 164
154(defvoo nntp-via-envuser nil 165(defvoo nntp-via-envuser nil
155 "*Whether both telnet client and server support the ENVIRON option. 166 "*Whether both telnet client and server support the ENVIRON option.
@@ -206,6 +217,21 @@ server there that you can connect to. See also
206(defvoo nntp-coding-system-for-write 'binary 217(defvoo nntp-coding-system-for-write 'binary
207 "*Coding system to write to NNTP.") 218 "*Coding system to write to NNTP.")
208 219
220;; Marks
221(defvoo nntp-marks-is-evil nil
222 "*If non-nil, Gnus will never generate and use marks file for nntp groups.
223See `nnml-marks-is-evil' for more information.")
224
225(defvoo nntp-marks-file-name ".marks")
226(defvoo nntp-marks nil)
227(defvar nntp-marks-modtime (gnus-make-hashtable))
228
229(defcustom nntp-marks-directory
230 (nnheader-concat gnus-directory "marks/")
231 "*The directory where marks for nntp groups will be stored."
232 :group 'nntp
233 :type 'directory)
234
209(defcustom nntp-authinfo-file "~/.authinfo" 235(defcustom nntp-authinfo-file "~/.authinfo"
210 ".netrc-like file that holds nntp authinfo passwords." 236 ".netrc-like file that holds nntp authinfo passwords."
211 :group 'nntp 237 :group 'nntp
@@ -252,6 +278,7 @@ to insert Cancel-Lock headers.")
252(defvoo nntp-last-command nil) 278(defvoo nntp-last-command nil)
253(defvoo nntp-authinfo-password nil) 279(defvoo nntp-authinfo-password nil)
254(defvoo nntp-authinfo-user nil) 280(defvoo nntp-authinfo-user nil)
281(defvoo nntp-authinfo-force nil)
255 282
256(defvar nntp-connection-list nil) 283(defvar nntp-connection-list nil)
257 284
@@ -339,14 +366,16 @@ be restored and the command retried."
339 366
340(defsubst nntp-wait-for (process wait-for buffer &optional decode discard) 367(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
341 "Wait for WAIT-FOR to arrive from PROCESS." 368 "Wait for WAIT-FOR to arrive from PROCESS."
369
342 (save-excursion 370 (save-excursion
343 (set-buffer (process-buffer process)) 371 (set-buffer (process-buffer process))
344 (goto-char (point-min)) 372 (goto-char (point-min))
373
345 (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) 374 (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
346 (looking-at "48[02]")) 375 (looking-at "48[02]"))
347 (memq (process-status process) '(open run))) 376 (memq (process-status process) '(open run)))
348 (cond ((looking-at "480") 377 (cond ((looking-at "480")
349 (nntp-handle-authinfo process)) 378 (nntp-handle-authinfo process))
350 ((looking-at "482") 379 ((looking-at "482")
351 (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message)) 380 (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message))
352 (signal 'nntp-authinfo-rejected nil)) 381 (signal 'nntp-authinfo-rejected nil))
@@ -394,6 +423,11 @@ be restored and the command retried."
394 (kill-buffer buffer) 423 (kill-buffer buffer)
395 (nnheader-init-server-buffer))) 424 (nnheader-init-server-buffer)))
396 425
426(defun nntp-erase-buffer (buffer)
427 "Erase contents of BUFFER."
428 (with-current-buffer buffer
429 (erase-buffer)))
430
397(defsubst nntp-find-connection (buffer) 431(defsubst nntp-find-connection (buffer)
398 "Find the connection delivering to BUFFER." 432 "Find the connection delivering to BUFFER."
399 (let ((alist nntp-connection-alist) 433 (let ((alist nntp-connection-alist)
@@ -428,9 +462,7 @@ be restored and the command retried."
428 (if process 462 (if process
429 (progn 463 (progn
430 (unless (or nntp-inhibit-erase nnheader-callback-function) 464 (unless (or nntp-inhibit-erase nnheader-callback-function)
431 (save-excursion 465 (nntp-erase-buffer (process-buffer process)))
432 (set-buffer (process-buffer process))
433 (erase-buffer)))
434 (condition-case err 466 (condition-case err
435 (progn 467 (progn
436 (when command 468 (when command
@@ -459,9 +491,7 @@ be restored and the command retried."
459 "Send STRINGS to server and wait until WAIT-FOR returns." 491 "Send STRINGS to server and wait until WAIT-FOR returns."
460 (when (and (not nnheader-callback-function) 492 (when (and (not nnheader-callback-function)
461 (not nntp-inhibit-output)) 493 (not nntp-inhibit-output))
462 (save-excursion 494 (nntp-erase-buffer nntp-server-buffer))
463 (set-buffer nntp-server-buffer)
464 (erase-buffer)))
465 (let* ((command (mapconcat 'identity strings " ")) 495 (let* ((command (mapconcat 'identity strings " "))
466 (process (nntp-find-connection nntp-server-buffer)) 496 (process (nntp-find-connection nntp-server-buffer))
467 (buffer (and process (process-buffer process))) 497 (buffer (and process (process-buffer process)))
@@ -488,8 +518,7 @@ be restored and the command retried."
488 (goto-char pos) 518 (goto-char pos)
489 (if (looking-at (regexp-quote command)) 519 (if (looking-at (regexp-quote command))
490 (delete-region pos (progn (forward-line 1) 520 (delete-region pos (progn (forward-line 1)
491 (gnus-point-at-bol)))) 521 (point-at-bol)))))))
492 )))
493 (nnheader-report 'nntp "Couldn't open connection to %s." 522 (nnheader-report 'nntp "Couldn't open connection to %s."
494 nntp-address)))) 523 nntp-address))))
495 524
@@ -513,7 +542,7 @@ be restored and the command retried."
513 (goto-char pos) 542 (goto-char pos)
514 (if (looking-at (regexp-quote command)) 543 (if (looking-at (regexp-quote command))
515 (delete-region pos (progn (forward-line 1) 544 (delete-region pos (progn (forward-line 1)
516 (gnus-point-at-bol))))))) 545 (point-at-bol)))))))
517 (nnheader-report 'nntp "Couldn't open connection to %s." 546 (nnheader-report 'nntp "Couldn't open connection to %s."
518 nntp-address)))) 547 nntp-address))))
519 548
@@ -521,9 +550,7 @@ be restored and the command retried."
521 "Send STRINGS to server and wait until WAIT-FOR returns." 550 "Send STRINGS to server and wait until WAIT-FOR returns."
522 (when (and (not nnheader-callback-function) 551 (when (and (not nnheader-callback-function)
523 (not nntp-inhibit-output)) 552 (not nntp-inhibit-output))
524 (save-excursion 553 (nntp-erase-buffer nntp-server-buffer))
525 (set-buffer nntp-server-buffer)
526 (erase-buffer)))
527 (let* ((command (mapconcat 'identity strings " ")) 554 (let* ((command (mapconcat 'identity strings " "))
528 (process (nntp-find-connection nntp-server-buffer)) 555 (process (nntp-find-connection nntp-server-buffer))
529 (buffer (and process (process-buffer process))) 556 (buffer (and process (process-buffer process)))
@@ -538,11 +565,11 @@ be restored and the command retried."
538 (unless wait-for 565 (unless wait-for
539 (nntp-accept-response) 566 (nntp-accept-response)
540 (save-excursion 567 (save-excursion
541 (set-buffer buffer) 568 (set-buffer buffer)
542 (goto-char pos) 569 (goto-char pos)
543 (if (looking-at (regexp-quote command)) 570 (if (looking-at (regexp-quote command))
544 (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) 571 (delete-region pos (progn (forward-line 1) (point-at-bol))))
545 ))) 572 )))
546 (nnheader-report 'nntp "Couldn't open connection to %s." 573 (nnheader-report 'nntp "Couldn't open connection to %s."
547 nntp-address)))) 574 nntp-address))))
548 575
@@ -551,9 +578,8 @@ be restored and the command retried."
551 "Send the current buffer to server and wait until WAIT-FOR returns." 578 "Send the current buffer to server and wait until WAIT-FOR returns."
552 (when (and (not nnheader-callback-function) 579 (when (and (not nnheader-callback-function)
553 (not nntp-inhibit-output)) 580 (not nntp-inhibit-output))
554 (save-excursion 581 (nntp-erase-buffer
555 (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) 582 (nntp-find-connection-buffer nntp-server-buffer)))
556 (erase-buffer)))
557 (nntp-encode-text) 583 (nntp-encode-text)
558 (mm-with-unibyte-current-buffer 584 (mm-with-unibyte-current-buffer
559 ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. 585 ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
@@ -575,7 +601,12 @@ be restored and the command retried."
575 ;; a line with only a "." on it. 601 ;; a line with only a "." on it.
576 ((eq (char-after) ?2) 602 ((eq (char-after) ?2)
577 (if (re-search-forward "\n\\.\r?\n" nil t) 603 (if (re-search-forward "\n\\.\r?\n" nil t)
578 t 604 (progn
605 ;; Some broken news servers add another dot at the end.
606 ;; Protect against inflooping there.
607 (while (looking-at "^\\.\r?\n")
608 (forward-line 1))
609 t)
579 nil)) 610 nil))
580 ;; A result that starts with a 3xx or 4xx code is terminated 611 ;; A result that starts with a 3xx or 4xx code is terminated
581 ;; by a newline. 612 ;; by a newline.
@@ -615,7 +646,7 @@ command whose response triggered the error."
615 646
616 (let ((timer 647 (let ((timer
617 (and nntp-connection-timeout 648 (and nntp-connection-timeout
618 (nnheader-run-at-time 649 (run-at-time
619 nntp-connection-timeout nil 650 nntp-connection-timeout nil
620 '(lambda () 651 '(lambda ()
621 (let ((process (nntp-find-connection 652 (let ((process (nntp-find-connection
@@ -637,7 +668,8 @@ command whose response triggered the error."
637 (condition-case nil 668 (condition-case nil
638 (progn ,@forms) 669 (progn ,@forms)
639 (quit 670 (quit
640 (nntp-close-server) 671 (unless debug-on-quit
672 (nntp-close-server))
641 (signal 'quit nil)))) 673 (signal 'quit nil))))
642 (when timer 674 (when timer
643 (nnheader-cancel-timer timer))) 675 (nnheader-cancel-timer timer)))
@@ -717,8 +749,7 @@ command whose response triggered the error."
717 (catch 'done 749 (catch 'done
718 (save-excursion 750 (save-excursion
719 ;; Erase nntp-server-buffer before nntp-inhibit-erase. 751 ;; Erase nntp-server-buffer before nntp-inhibit-erase.
720 (set-buffer nntp-server-buffer) 752 (nntp-erase-buffer nntp-server-buffer)
721 (erase-buffer)
722 (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) 753 (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
723 ;; The first time this is run, this variable is `try'. So we 754 ;; The first time this is run, this variable is `try'. So we
724 ;; try. 755 ;; try.
@@ -1046,6 +1077,54 @@ command whose response triggered the error."
1046(deffoo nntp-asynchronous-p () 1077(deffoo nntp-asynchronous-p ()
1047 t) 1078 t)
1048 1079
1080(deffoo nntp-request-set-mark (group actions &optional server)
1081 (unless nntp-marks-is-evil
1082 (nntp-possibly-create-directory group server)
1083 (nntp-open-marks group server)
1084 (dolist (action actions)
1085 (let ((range (nth 0 action))
1086 (what (nth 1 action))
1087 (marks (nth 2 action)))
1088 (assert (or (eq what 'add) (eq what 'del)) nil
1089 "Unknown request-set-mark action: %s" what)
1090 (dolist (mark marks)
1091 (setq nntp-marks (gnus-update-alist-soft
1092 mark
1093 (funcall (if (eq what 'add) 'gnus-range-add
1094 'gnus-remove-from-range)
1095 (cdr (assoc mark nntp-marks)) range)
1096 nntp-marks)))))
1097 (nntp-save-marks group server))
1098 nil)
1099
1100(deffoo nntp-request-update-info (group info &optional server)
1101 (unless nntp-marks-is-evil
1102 (nntp-possibly-create-directory group server)
1103 (when (nntp-marks-changed-p group server)
1104 (nnheader-message 8 "Updating marks for %s..." group)
1105 (nntp-open-marks group server)
1106 ;; Update info using `nntp-marks'.
1107 (mapc (lambda (pred)
1108 (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
1109 (gnus-info-set-marks
1110 info
1111 (gnus-update-alist-soft
1112 (cdr pred)
1113 (cdr (assq (cdr pred) nntp-marks))
1114 (gnus-info-marks info))
1115 t)))
1116 gnus-article-mark-lists)
1117 (let ((seen (cdr (assq 'read nntp-marks))))
1118 (gnus-info-set-read info
1119 (if (and (integerp (car seen))
1120 (null (cdr seen)))
1121 (list (cons (car seen) (car seen)))
1122 seen)))
1123 (nnheader-message 8 "Updating marks for %s...done" group)))
1124 nil)
1125
1126
1127
1049;;; Hooky functions. 1128;;; Hooky functions.
1050 1129
1051(defun nntp-send-mode-reader () 1130(defun nntp-send-mode-reader ()
@@ -1063,11 +1142,11 @@ and a password.
1063 1142
1064If SEND-IF-FORCE, only send authinfo to the server if the 1143If SEND-IF-FORCE, only send authinfo to the server if the
1065.authinfo file has the FORCE token." 1144.authinfo file has the FORCE token."
1066 (let* ((list (gnus-parse-netrc nntp-authinfo-file)) 1145 (let* ((list (netrc-parse nntp-authinfo-file))
1067 (alist (gnus-netrc-machine list nntp-address "nntp")) 1146 (alist (netrc-machine list nntp-address "nntp"))
1068 (force (gnus-netrc-get alist "force")) 1147 (force (or (netrc-get alist "force") nntp-authinfo-force))
1069 (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) 1148 (user (or (netrc-get alist "login") nntp-authinfo-user))
1070 (passwd (gnus-netrc-get alist "password"))) 1149 (passwd (netrc-get alist "password")))
1071 (when (or (not send-if-force) 1150 (when (or (not send-if-force)
1072 force) 1151 force)
1073 (unless user 1152 (unless user
@@ -1106,7 +1185,7 @@ password contained in '~/.nntp-authinfo'."
1106 (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) 1185 (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
1107 (nntp-send-command 1186 (nntp-send-command
1108 "^2.*\r?\n" "AUTHINFO PASS" 1187 "^2.*\r?\n" "AUTHINFO PASS"
1109 (buffer-substring (point) (gnus-point-at-eol)))))) 1188 (buffer-substring (point) (point-at-eol))))))
1110 1189
1111;;; Internal functions. 1190;;; Internal functions.
1112 1191
@@ -1116,9 +1195,7 @@ password contained in '~/.nntp-authinfo'."
1116 (funcall nntp-authinfo-function) 1195 (funcall nntp-authinfo-function)
1117 ;; We have to re-send the function that was interrupted by 1196 ;; We have to re-send the function that was interrupted by
1118 ;; the authinfo request. 1197 ;; the authinfo request.
1119 (save-excursion 1198 (nntp-erase-buffer nntp-server-buffer)
1120 (set-buffer nntp-server-buffer)
1121 (erase-buffer))
1122 (nntp-send-string process last))) 1199 (nntp-send-string process last)))
1123 1200
1124(defun nntp-make-process-buffer (buffer) 1201(defun nntp-make-process-buffer (buffer)
@@ -1144,7 +1221,7 @@ password contained in '~/.nntp-authinfo'."
1144 (let* ((pbuffer (nntp-make-process-buffer buffer)) 1221 (let* ((pbuffer (nntp-make-process-buffer buffer))
1145 (timer 1222 (timer
1146 (and nntp-connection-timeout 1223 (and nntp-connection-timeout
1147 (nnheader-run-at-time 1224 (run-at-time
1148 nntp-connection-timeout nil 1225 nntp-connection-timeout nil
1149 `(lambda () 1226 `(lambda ()
1150 (nntp-kill-buffer ,pbuffer))))) 1227 (nntp-kill-buffer ,pbuffer)))))
@@ -1155,7 +1232,7 @@ password contained in '~/.nntp-authinfo'."
1155 (funcall nntp-open-connection-function pbuffer)) 1232 (funcall nntp-open-connection-function pbuffer))
1156 (error nil) 1233 (error nil)
1157 (quit 1234 (quit
1158 (message "Quit opening connection") 1235 (message "Quit opening connection to %s" nntp-address)
1159 (nntp-kill-buffer pbuffer) 1236 (nntp-kill-buffer pbuffer)
1160 (signal 'quit nil) 1237 (signal 'quit nil)
1161 nil)))) 1238 nil))))
@@ -1223,12 +1300,9 @@ password contained in '~/.nntp-authinfo'."
1223 "Find out what the name of the server we have connected to is." 1300 "Find out what the name of the server we have connected to is."
1224 ;; Wait for the status string to arrive. 1301 ;; Wait for the status string to arrive.
1225 (setq nntp-server-type (buffer-string)) 1302 (setq nntp-server-type (buffer-string))
1226 (let ((alist nntp-server-action-alist) 1303 (let ((case-fold-search t))
1227 (case-fold-search t)
1228 entry)
1229 ;; Run server-specific commands. 1304 ;; Run server-specific commands.
1230 (while alist 1305 (dolist (entry nntp-server-action-alist)
1231 (setq entry (pop alist))
1232 (when (string-match (car entry) nntp-server-type) 1306 (when (string-match (car entry) nntp-server-type)
1233 (if (and (listp (cadr entry)) 1307 (if (and (listp (cadr entry))
1234 (not (eq 'lambda (caadr entry)))) 1308 (not (eq 'lambda (caadr entry))))
@@ -1254,7 +1328,7 @@ password contained in '~/.nntp-authinfo'."
1254 ;; doesn't trigger after-change-functions. 1328 ;; doesn't trigger after-change-functions.
1255 (unless nntp-async-timer 1329 (unless nntp-async-timer
1256 (setq nntp-async-timer 1330 (setq nntp-async-timer
1257 (nnheader-run-at-time 1 1 'nntp-async-timer-handler))) 1331 (run-at-time 1 1 'nntp-async-timer-handler)))
1258 (add-to-list 'nntp-async-process-list process)) 1332 (add-to-list 'nntp-async-process-list process))
1259 1333
1260(defun nntp-async-timer-handler () 1334(defun nntp-async-timer-handler ()
@@ -1340,22 +1414,22 @@ password contained in '~/.nntp-authinfo'."
1340 1414
1341(defun nntp-accept-process-output (process) 1415(defun nntp-accept-process-output (process)
1342 "Wait for output from PROCESS and message some dots." 1416 "Wait for output from PROCESS and message some dots."
1343 (save-excursion 1417 (with-current-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
1344 (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) 1418 nntp-server-buffer)
1345 nntp-server-buffer))
1346 (let ((len (/ (buffer-size) 1024)) 1419 (let ((len (/ (buffer-size) 1024))
1347 message-log-max) 1420 message-log-max)
1348 (unless (< len 10) 1421 (unless (< len 10)
1349 (setq nntp-have-messaged t) 1422 (setq nntp-have-messaged t)
1350 (nnheader-message 7 "nntp read: %dk" len))) 1423 (nnheader-message 7 "nntp read: %dk" len)))
1351 (nnheader-accept-process-output process) 1424 (prog1
1352 ;; accept-process-output may update status of process to indicate 1425 (nnheader-accept-process-output process)
1353 ;; that the server has closed the connection. This MUST be 1426 ;; accept-process-output may update status of process to indicate
1354 ;; handled here as the buffer restored by the save-excursion may 1427 ;; that the server has closed the connection. This MUST be
1355 ;; be the process's former output buffer (i.e. now killed) 1428 ;; handled here as the buffer restored by the save-excursion may
1356 (or (and process 1429 ;; be the process's former output buffer (i.e. now killed)
1357 (memq (process-status process) '(open run))) 1430 (or (and process
1358 (nntp-report "Server closed connection")))) 1431 (memq (process-status process) '(open run)))
1432 (nntp-report "Server closed connection")))))
1359 1433
1360(defun nntp-accept-response () 1434(defun nntp-accept-response ()
1361 "Wait for output from the process that outputs to BUFFER." 1435 "Wait for output from the process that outputs to BUFFER."
@@ -1382,9 +1456,7 @@ password contained in '~/.nntp-authinfo'."
1382 (nntp-send-command "^[245].*\n" "GROUP" group) 1456 (nntp-send-command "^[245].*\n" "GROUP" group)
1383 (setcar (cddr entry) group) 1457 (setcar (cddr entry) group)
1384 (erase-buffer) 1458 (erase-buffer)
1385 (save-excursion 1459 (nntp-erase-buffer nntp-server-buffer)))))))
1386 (set-buffer nntp-server-buffer)
1387 (erase-buffer))))))))
1388 1460
1389(defun nntp-decode-text (&optional cr-only) 1461(defun nntp-decode-text (&optional cr-only)
1390 "Decode the text in the current buffer." 1462 "Decode the text in the current buffer."
@@ -1594,10 +1666,8 @@ password contained in '~/.nntp-authinfo'."
1594 (setq commands (cdr commands))) 1666 (setq commands (cdr commands)))
1595 ;; If none of the commands worked, we disable XOVER. 1667 ;; If none of the commands worked, we disable XOVER.
1596 (when (eq nntp-server-xover 'try) 1668 (when (eq nntp-server-xover 'try)
1597 (save-excursion 1669 (nntp-erase-buffer nntp-server-buffer)
1598 (set-buffer nntp-server-buffer) 1670 (setq nntp-server-xover nil))
1599 (erase-buffer)
1600 (setq nntp-server-xover nil)))
1601 nntp-server-xover)))) 1671 nntp-server-xover))))
1602 1672
1603(defun nntp-find-group-and-number (&optional group) 1673(defun nntp-find-group-and-number (&optional group)
@@ -1847,6 +1917,36 @@ Please refer to the following variables to customize the connection:
1847 (delete-region (point) (point-max))) 1917 (delete-region (point) (point-max)))
1848 proc)) 1918 proc))
1849 1919
1920(defun nntp-open-via-rlogin-and-netcat (buffer)
1921 "Open a connection to an nntp server through an intermediate host.
1922First rlogin to the remote host, and then connect to the real news
1923server from there using the netcat command.
1924
1925Please refer to the following variables to customize the connection:
1926- `nntp-pre-command',
1927- `nntp-via-rlogin-command',
1928- `nntp-via-rlogin-command-switches',
1929- `nntp-via-user-name',
1930- `nntp-via-address',
1931- `nntp-via-netcat-command',
1932- `nntp-via-netcat-switches',
1933- `nntp-address',
1934- `nntp-port-number',
1935- `nntp-end-of-line'."
1936 (let ((command `(,@(when nntp-pre-command
1937 (list nntp-pre-command))
1938 ,nntp-via-rlogin-command
1939 ,@(when nntp-via-rlogin-command-switches
1940 nntp-via-rlogin-command-switches)
1941 ,@(when nntp-via-user-name
1942 (list "-l" nntp-via-user-name))
1943 ,nntp-via-address
1944 ,nntp-via-netcat-command
1945 ,@nntp-via-netcat-switches
1946 ,nntp-address
1947 ,nntp-port-number)))
1948 (apply 'start-process "nntpd" buffer command)))
1949
1850(defun nntp-open-via-telnet-and-telnet (buffer) 1950(defun nntp-open-via-telnet-and-telnet (buffer)
1851 "Open a connection to an nntp server through an intermediate host. 1951 "Open a connection to an nntp server through an intermediate host.
1852First telnet the remote host, and then telnet the real news server 1952First telnet the remote host, and then telnet the real news server
@@ -1922,6 +2022,96 @@ Please refer to the following variables to customize the connection:
1922 (delete-region (point) (point-max))) 2022 (delete-region (point) (point-max)))
1923 proc))) 2023 proc)))
1924 2024
2025;; Marks handling
2026
2027(defun nntp-marks-directory (server)
2028 (expand-file-name server nntp-marks-directory))
2029
2030(defvar nntp-server-to-method-cache nil
2031 "Alist of servers and select methods.")
2032
2033(defun nntp-group-pathname (server group &optional file)
2034 "Return an absolute file name of FILE for GROUP on SERVER."
2035 (let ((method (cdr (assoc server nntp-server-to-method-cache))))
2036 (unless method
2037 (push (cons server (setq method (or (gnus-server-to-method server)
2038 (gnus-find-method-for-group group))))
2039 nntp-server-to-method-cache))
2040 (nnmail-group-pathname
2041 (mm-decode-coding-string group
2042 (inline (gnus-group-name-charset method group)))
2043 (nntp-marks-directory server)
2044 file)))
2045
2046(defun nntp-possibly-create-directory (group server)
2047 (let ((dir (nntp-group-pathname server group))
2048 (file-name-coding-system nnmail-pathname-coding-system))
2049 (unless (file-exists-p dir)
2050 (make-directory (directory-file-name dir) t)
2051 (nnheader-message 5 "Creating nntp marks directory %s" dir))))
2052
2053(eval-and-compile
2054 (autoload 'time-less-p "time-date"))
2055
2056(defun nntp-marks-changed-p (group server)
2057 (let ((file (nntp-group-pathname server group nntp-marks-file-name))
2058 (file-name-coding-system nnmail-pathname-coding-system))
2059 (if (null (gnus-gethash file nntp-marks-modtime))
2060 t ;; never looked at marks file, assume it has changed
2061 (time-less-p (gnus-gethash file nntp-marks-modtime)
2062 (nth 5 (file-attributes file))))))
2063
2064(defun nntp-save-marks (group server)
2065 (let ((file-name-coding-system nnmail-pathname-coding-system)
2066 (file (nntp-group-pathname server group nntp-marks-file-name)))
2067 (condition-case err
2068 (progn
2069 (nntp-possibly-create-directory group server)
2070 (with-temp-file file
2071 (erase-buffer)
2072 (gnus-prin1 nntp-marks)
2073 (insert "\n"))
2074 (gnus-sethash file
2075 (nth 5 (file-attributes file))
2076 nntp-marks-modtime))
2077 (error (or (gnus-yes-or-no-p
2078 (format "Could not write to %s (%s). Continue? " file err))
2079 (error "Cannot write to %s (%s)" file err))))))
2080
2081(defun nntp-open-marks (group server)
2082 (let ((file (nntp-group-pathname server group nntp-marks-file-name))
2083 (file-name-coding-system nnmail-pathname-coding-system))
2084 (if (file-exists-p file)
2085 (condition-case err
2086 (with-temp-buffer
2087 (gnus-sethash file (nth 5 (file-attributes file))
2088 nntp-marks-modtime)
2089 (nnheader-insert-file-contents file)
2090 (setq nntp-marks (read (current-buffer)))
2091 (dolist (el gnus-article-unpropagated-mark-lists)
2092 (setq nntp-marks (gnus-remassoc el nntp-marks))))
2093 (error (or (gnus-yes-or-no-p
2094 (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
2095 (error "Cannot read nntp marks file %s (%s)" file err))))
2096 ;; User didn't have a .marks file. Probably first time
2097 ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
2098 (let ((info (gnus-get-info
2099 (gnus-group-prefixed-name
2100 group
2101 (gnus-server-to-method (format "nntp:%s" server)))))
2102 (decoded-name (mm-decode-coding-string
2103 group
2104 (gnus-group-name-charset
2105 (gnus-server-to-method server) group))))
2106 (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
2107 (setq nntp-marks (gnus-info-marks info))
2108 (push (cons 'read (gnus-info-read info)) nntp-marks)
2109 (dolist (el gnus-article-unpropagated-mark-lists)
2110 (setq nntp-marks (gnus-remassoc el nntp-marks)))
2111 (nntp-save-marks group server)
2112 (nnheader-message 7 "Bootstrapping marks for %s...done"
2113 decoded-name)))))
2114
1925(provide 'nntp) 2115(provide 'nntp)
1926 2116
1927;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 2117;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index fc2500df2f5..4905e7631b3 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -339,9 +339,9 @@ component group will show up when you enter the virtual group.")
339 (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) 339 (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
340 (gnus-expert-user t)) 340 (gnus-expert-user t))
341 ;; Make sure all groups are activated. 341 ;; Make sure all groups are activated.
342 (mapcar 342 (mapc
343 (lambda (g) 343 (lambda (g)
344 (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb)))) 344 (when (not (numberp (gnus-group-unread g)))
345 (gnus-activate-group g))) 345 (gnus-activate-group g)))
346 nnvirtual-component-groups) 346 nnvirtual-component-groups)
347 (save-excursion 347 (save-excursion
@@ -384,14 +384,11 @@ component group will show up when you enter the virtual group.")
384 384
385(defun nnvirtual-convert-headers () 385(defun nnvirtual-convert-headers ()
386 "Convert HEAD headers into NOV headers." 386 "Convert HEAD headers into NOV headers."
387 (save-excursion 387 (with-current-buffer nntp-server-buffer
388 (set-buffer nntp-server-buffer)
389 (let* ((dependencies (make-vector 100 0)) 388 (let* ((dependencies (make-vector 100 0))
390 (headers (gnus-get-newsgroup-headers dependencies)) 389 (headers (gnus-get-newsgroup-headers dependencies)))
391 header)
392 (erase-buffer) 390 (erase-buffer)
393 (while (setq header (pop headers)) 391 (mapc 'nnheader-insert-nov headers))))
394 (nnheader-insert-nov header)))))
395 392
396 393
397(defun nnvirtual-update-xref-header (group article prefix system-name) 394(defun nnvirtual-update-xref-header (group article prefix system-name)
@@ -401,7 +398,7 @@ component group will show up when you enter the virtual group.")
401 (looking-at 398 (looking-at
402 "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") 399 "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
403 (goto-char (match-end 0)) 400 (goto-char (match-end 0))
404 (unless (search-forward "\t" (gnus-point-at-eol) 'move) 401 (unless (search-forward "\t" (point-at-eol) 'move)
405 (insert "\t")) 402 (insert "\t"))
406 403
407 ;; Remove any spaces at the beginning of the Xref field. 404 ;; Remove any spaces at the beginning of the Xref field.
@@ -417,8 +414,8 @@ component group will show up when you enter the virtual group.")
417 ;; component server prefix. 414 ;; component server prefix.
418 (save-restriction 415 (save-restriction
419 (narrow-to-region (point) 416 (narrow-to-region (point)
420 (or (search-forward "\t" (gnus-point-at-eol) t) 417 (or (search-forward "\t" (point-at-eol) t)
421 (gnus-point-at-eol))) 418 (point-at-eol)))
422 (goto-char (point-min)) 419 (goto-char (point-min))
423 (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) 420 (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
424 (replace-match "" t t)) 421 (replace-match "" t t))
@@ -465,7 +462,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components."
465 (nnvirtual-partition-sequence (cdr ml))))) 462 (nnvirtual-partition-sequence (cdr ml)))))
466 (gnus-info-marks (gnus-get-info 463 (gnus-info-marks (gnus-get-info
467 (nnvirtual-current-group)))))) 464 (nnvirtual-current-group))))))
468 mark type groups carticles info entry) 465 type groups info)
469 466
470 ;; Ok, atomically move all of the (un)read info, clear any old 467 ;; Ok, atomically move all of the (un)read info, clear any old
471 ;; marks, and move all of the current marks. This way if someone 468 ;; marks, and move all of the current marks. This way if someone
@@ -474,13 +471,12 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components."
474 ;; move (un)read 471 ;; move (un)read
475 ;; bind for workaround guns-update-read-articles 472 ;; bind for workaround guns-update-read-articles
476 (let ((gnus-newsgroup-active nil)) 473 (let ((gnus-newsgroup-active nil))
477 (while (setq entry (pop unreads)) 474 (dolist (entry unreads)
478 (gnus-update-read-articles (car entry) (cdr entry)))) 475 (gnus-update-read-articles (car entry) (cdr entry))))
479 476
480 ;; clear all existing marks on the component groups 477 ;; clear all existing marks on the component groups
481 (setq groups nnvirtual-component-groups) 478 (dolist (group nnvirtual-component-groups)
482 (while groups 479 (when (and (setq info (gnus-get-info group))
483 (when (and (setq info (gnus-get-info (pop groups)))
484 (gnus-info-marks info)) 480 (gnus-info-marks info))
485 (gnus-info-set-marks 481 (gnus-info-set-marks
486 info 482 info
@@ -491,18 +487,17 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components."
491 ;; Ok, currently type-marks is an assq list with keys of a mark type, 487 ;; Ok, currently type-marks is an assq list with keys of a mark type,
492 ;; with data of an assq list with keys of component group names 488 ;; with data of an assq list with keys of component group names
493 ;; and the articles which correspond to that key/group pair. 489 ;; and the articles which correspond to that key/group pair.
494 (while (setq mark (pop type-marks)) 490 (dolist (mark type-marks)
495 (setq type (car mark)) 491 (setq type (car mark))
496 (setq groups (cdr mark)) 492 (setq groups (cdr mark))
497 (while (setq carticles (pop groups)) 493 (dolist (carticles groups)
498 (gnus-add-marked-articles (car carticles) type (cdr carticles) 494 (gnus-add-marked-articles (car carticles) type (cdr carticles)
499 nil t)))) 495 nil t))))
500 496
501 ;; possibly update the display, it is really slow 497 ;; possibly update the display, it is really slow
502 (when update-p 498 (when update-p
503 (setq groups nnvirtual-component-groups) 499 (dolist (group nnvirtual-component-groups)
504 (while groups 500 (gnus-group-update-group group t))))))
505 (gnus-group-update-group (pop groups) t))))))
506 501
507 502
508(defun nnvirtual-current-group () 503(defun nnvirtual-current-group ()
@@ -664,8 +659,7 @@ numbers has no corresponding component article, then it is left out of
664the result." 659the result."
665 (when (numberp (cdr-safe articles)) 660 (when (numberp (cdr-safe articles))
666 (setq articles (list articles))) 661 (setq articles (list articles)))
667 (let ((carticles (mapcar (lambda (g) (list g)) 662 (let ((carticles (mapcar 'list nnvirtual-component-groups))
668 nnvirtual-component-groups))
669 a i j article entry) 663 a i j article entry)
670 (while (setq a (pop articles)) 664 (while (setq a (pop articles))
671 (if (atom a) 665 (if (atom a)
@@ -678,8 +672,8 @@ the result."
678 (setq entry (assoc (car article) carticles)) 672 (setq entry (assoc (car article) carticles))
679 (setcdr entry (cons (cdr article) (cdr entry)))) 673 (setcdr entry (cons (cdr article) (cdr entry))))
680 (setq i (1+ i)))) 674 (setq i (1+ i))))
681 (mapcar (lambda (x) (setcdr x (nreverse (cdr x)))) 675 (mapc (lambda (x) (setcdr x (nreverse (cdr x))))
682 carticles) 676 carticles)
683 carticles)) 677 carticles))
684 678
685 679
@@ -701,29 +695,29 @@ based on the marks on the component groups."
701 ;; Into all-unreads we put (g unreads). 695 ;; Into all-unreads we put (g unreads).
702 ;; Into all-marks we put (g marks). 696 ;; Into all-marks we put (g marks).
703 ;; We also increment cnt and tot here, and compute M (max of sizes). 697 ;; We also increment cnt and tot here, and compute M (max of sizes).
704 (mapcar (lambda (g) 698 (mapc (lambda (g)
705 (setq active (gnus-activate-group g) 699 (setq active (gnus-activate-group g)
706 min (car active) 700 min (car active)
707 max (cdr active)) 701 max (cdr active))
708 (when (and active (>= max min) (not (zerop max))) 702 (when (and active (>= max min) (not (zerop max)))
709 ;; store active information 703 ;; store active information
710 (push (list g (- max min -1) max) actives) 704 (push (list g (- max min -1) max) actives)
711 ;; collect unread/mark info for later 705 ;; collect unread/mark info for later
712 (setq unreads (gnus-list-of-unread-articles g)) 706 (setq unreads (gnus-list-of-unread-articles g))
713 (setq marks (gnus-info-marks (gnus-get-info g))) 707 (setq marks (gnus-info-marks (gnus-get-info g)))
714 (when gnus-use-cache 708 (when gnus-use-cache
715 (push (cons 'cache 709 (push (cons 'cache
716 (gnus-cache-articles-in-group g)) 710 (gnus-cache-articles-in-group g))
717 marks)) 711 marks))
718 (push (cons g unreads) all-unreads) 712 (push (cons g unreads) all-unreads)
719 (push (cons g marks) all-marks) 713 (push (cons g marks) all-marks)
720 ;; count groups, total #articles, and max size 714 ;; count groups, total #articles, and max size
721 (setq size (- max min -1)) 715 (setq size (- max min -1))
722 (setq cnt (1+ cnt) 716 (setq cnt (1+ cnt)
723 tot (+ tot size) 717 tot (+ tot size)
724 M (max M size)))) 718 M (max M size))))
725 nnvirtual-component-groups) 719 nnvirtual-component-groups)
726 720
727 ;; Number of articles in the virtual group. 721 ;; Number of articles in the virtual group.
728 (setq nnvirtual-mapping-len tot) 722 (setq nnvirtual-mapping-len tot)
729 723
@@ -785,10 +779,9 @@ based on the marks on the component groups."
785 779
786 ;; Remove any empty marks lists, and store. 780 ;; Remove any empty marks lists, and store.
787 (setq nnvirtual-mapping-marks nil) 781 (setq nnvirtual-mapping-marks nil)
788 (while marks 782 (dolist (mark marks)
789 (if (cdr (car marks)) 783 (when (cdr mark)
790 (push (car marks) nnvirtual-mapping-marks)) 784 (push mark nnvirtual-mapping-marks)))
791 (setq marks (cdr marks)))
792 785
793 ;; We need to convert the unreads to reads. We compress the 786 ;; We need to convert the unreads to reads. We compress the
794 ;; sequence as we go, otherwise it could be huge. 787 ;; sequence as we go, otherwise it could be huge.
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index 0d1fb193082..4729e7216be 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -523,7 +523,9 @@ Valid types include `google', `dejanews', and `gmane'.")
523 "?" 523 "?"
524 (mm-url-encode-www-form-urlencoded 524 (mm-url-encode-www-form-urlencoded
525 `(("query" . ,search) 525 `(("query" . ,search)
526 ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits)))))) 526 ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))
527 ;;("TOPDOC" . "1000")
528 ))))
527 (setq buffer-file-name nil) 529 (setq buffer-file-name nil)
528 (set-buffer-multibyte t) 530 (set-buffer-multibyte t)
529 (mm-decode-coding-region (point-min) (point-max) 'utf-8) 531 (mm-decode-coding-region (point-min) (point-max) 'utf-8)
@@ -554,7 +556,7 @@ Valid types include `google', `dejanews', and `gmane'.")
554 (nth 1 parse) 556 (nth 1 parse)
555 " ")) 557 " "))
556 (insert ">\n") 558 (insert ">\n")
557 (mapcar 'nnweb-insert-html (nth 2 parse)) 559 (mapc 'nnweb-insert-html (nth 2 parse))
558 (insert "</" (symbol-name (car parse)) ">\n"))) 560 (insert "</" (symbol-name (car parse)) ">\n")))
559 561
560(defun nnweb-parse-find (type parse &optional maxdepth) 562(defun nnweb-parse-find (type parse &optional maxdepth)
diff --git a/lisp/gnus/ntlm.el b/lisp/gnus/ntlm.el
new file mode 100644
index 00000000000..edea2c3048a
--- /dev/null
+++ b/lisp/gnus/ntlm.el
@@ -0,0 +1,537 @@
1;;; ntlm.el --- NTLM (NT LanManager) authentication support
2
3;; Copyright (C) 2001 Taro Kawagishi
4;; Author: Taro Kawagishi <tarok@transpulse.org>
5;; Keywords: NTLM, SASL
6;; Version: 1.00
7;; Created: February 2001
8
9;; This program is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version.
13;;
14;; This program is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
23
24;;; Commentary:
25
26;; This library is a direct translation of the Samba release 2.2.0
27;; implementation of Windows NT and LanManager compatible password
28;; encryption.
29;;
30;; Interface functions:
31;;
32;; ntlm-build-auth-request
33;; This will return a binary string, which should be used in the
34;; base64 encoded form and it is the caller's responsibility to encode
35;; the returned string with base64.
36;;
37;; ntlm-build-auth-response
38;; It is the caller's responsibility to pass a base64 decoded string
39;; (which will be a binary string) as the first argument and to
40;; encode the returned string with base64. The second argument user
41;; should be given in user@domain format.
42;;
43;; ntlm-get-password-hashes
44;;
45;;
46;; NTLM authentication procedure example:
47;;
48;; 1. Open a network connection to the Exchange server at the IMAP port (143)
49;; 2. Receive an opening message such as:
50;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready"
51;; 3. Ask for IMAP server capability by sending "NNN capability"
52;; 4. Receive a capability message such as:
53;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM"
54;; 5. Ask for NTLM authentication by sending a string
55;; "NNN authenticate ntlm"
56;; 6. Receive continuation acknowledgment "+"
57;; 7. Send NTLM authentication request generated by 'ntlm-build-auth-request
58;; 8. Receive NTLM challenge string following acknowledgment "+"
59;; 9. Generate response to challenge by 'ntlm-build-auth-response
60;; (here two hash function values of the user password are encrypted)
61;; 10. Receive authentication completion message such as
62;; "NNN OK AUTHENTICATE NTLM completed."
63
64;;; Code:
65
66(require 'md4)
67
68;;;
69;;; NTLM authentication interface functions
70
71(defun ntlm-build-auth-request (user &optional domain)
72 "Return the NTLM authentication request string for USER and DOMAIN.
73USER is a string representing a user name to be authenticated and
74DOMAIN is a NT domain. USER can include a NT domain part as in
75user@domain where the string after @ is used as the domain if DOMAIN
76is not given."
77 (interactive)
78 (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
79 (request-msgType (concat (make-string 1 1) (make-string 3 0)))
80 ;0x01 0x00 0x00 0x00
81 (request-flags (concat (make-string 1 7) (make-string 1 178)
82 (make-string 2 0)))
83 ;0x07 0xb2 0x00 0x00
84 lu ld off-d off-u)
85 (when (string-match "@" user)
86 (unless domain
87 (setq domain (substring user (1+ (match-beginning 0)))))
88 (setq user (substring user 0 (match-beginning 0))))
89 ;; set fields offsets within the request struct
90 (setq lu (length user))
91 (setq ld (length domain))
92 (setq off-u 32) ;offset to the string 'user
93 (setq off-d (+ 32 lu)) ;offset to the string 'domain
94 ;; pack the request struct in a string
95 (concat request-ident ;8 bytes
96 request-msgType ;4 bytes
97 request-flags ;4 bytes
98 (md4-pack-int16 lu) ;user field, count field
99 (md4-pack-int16 lu) ;user field, max count field
100 (md4-pack-int32 (cons 0 off-u)) ;user field, offset field
101 (md4-pack-int16 ld) ;domain field, count field
102 (md4-pack-int16 ld) ;domain field, max count field
103 (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field
104 user ;bufer field
105 domain ;bufer field
106 )))
107
108(eval-when-compile
109 (defmacro ntlm-string-as-unibyte (string)
110 (if (fboundp 'string-as-unibyte)
111 `(string-as-unibyte ,string)
112 string)))
113
114(defun ntlm-build-auth-response (challenge user password-hashes)
115 "Return the response string to a challenge string CHALLENGE given by
116the NTLM based server for the user USER and the password hash list
117PASSWORD-HASHES. NTLM uses two hash values which are represented
118by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
119 (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
120 (let* ((rchallenge (ntlm-string-as-unibyte challenge))
121 ;; get fields within challenge struct
122 ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes
123 ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
124 (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
125 (flags (substring rchallenge 20 24)) ;flags, 4 bytes
126 (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
127 uDomain-len uDomain-offs
128 ;; response struct and its fields
129 lmRespData ;lmRespData, 24 bytes
130 ntRespData ;ntRespData, 24 bytes
131 domain ;ascii domain string
132 lu ld off-lm off-nt off-d off-u off-w off-s)
133 ;; extract domain string from challenge string
134 (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
135 (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
136 (setq domain
137 (ntlm-unicode2ascii (substring challenge
138 (cdr uDomain-offs)
139 (+ (cdr uDomain-offs) uDomain-len))
140 (/ uDomain-len 2)))
141 ;; overwrite domain in case user is given in <user>@<domain> format
142 (when (string-match "@" user)
143 (setq domain (substring user (1+ (match-beginning 0))))
144 (setq user (substring user 0 (match-beginning 0))))
145
146 ;; generate response data
147 (setq lmRespData
148 (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
149 (setq ntRespData
150 (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))
151
152 ;; get offsets to fields to pack the response struct in a string
153 (setq lu (length user))
154 (setq ld (length domain))
155 (setq off-lm 64) ;offset to string 'lmResponse
156 (setq off-nt (+ 64 24)) ;offset to string 'ntResponse
157 (setq off-d (+ 64 48)) ;offset to string 'uDomain
158 (setq off-u (+ 64 48 (* 2 ld))) ;offset to string 'uUser
159 (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
160 (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
161 ;; pack the response struct in a string
162 (concat "NTLMSSP\0" ;response ident field, 8 bytes
163 (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
164
165 ;; lmResponse field, 8 bytes
166 ;;AddBytes(response,lmResponse,lmRespData,24);
167 (md4-pack-int16 24) ;len field
168 (md4-pack-int16 24) ;maxlen field
169 (md4-pack-int32 (cons 0 off-lm)) ;field offset
170
171 ;; ntResponse field, 8 bytes
172 ;;AddBytes(response,ntResponse,ntRespData,24);
173 (md4-pack-int16 24) ;len field
174 (md4-pack-int16 24) ;maxlen field
175 (md4-pack-int32 (cons 0 off-nt)) ;field offset
176
177 ;; uDomain field, 8 bytes
178 ;;AddUnicodeString(response,uDomain,domain);
179 ;;AddBytes(response, uDomain, udomain, 2*ld);
180 (md4-pack-int16 (* 2 ld)) ;len field
181 (md4-pack-int16 (* 2 ld)) ;maxlen field
182 (md4-pack-int32 (cons 0 off-d)) ;field offset
183
184 ;; uUser field, 8 bytes
185 ;;AddUnicodeString(response,uUser,u);
186 ;;AddBytes(response, uUser, uuser, 2*lu);
187 (md4-pack-int16 (* 2 lu)) ;len field
188 (md4-pack-int16 (* 2 lu)) ;maxlen field
189 (md4-pack-int32 (cons 0 off-u)) ;field offset
190
191 ;; uWks field, 8 bytes
192 ;;AddUnicodeString(response,uWks,u);
193 (md4-pack-int16 (* 2 lu)) ;len field
194 (md4-pack-int16 (* 2 lu)) ;maxlen field
195 (md4-pack-int32 (cons 0 off-w)) ;field offset
196
197 ;; sessionKey field, 8 bytes
198 ;;AddString(response,sessionKey,NULL);
199 (md4-pack-int16 0) ;len field
200 (md4-pack-int16 0) ;maxlen field
201 (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
202
203 ;; flags field, 4 bytes
204 flags ;
205
206 ;; buffer field
207 lmRespData ;lmResponse, 24 bytes
208 ntRespData ;ntResponse, 24 bytes
209 (ntlm-ascii2unicode domain ;unicode domain string, 2*ld bytes
210 (length domain)) ;
211 (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes
212 (length user)) ;
213 (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes
214 (length user)) ;
215 )))
216
217(defun ntlm-get-password-hashes (password)
218 "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD"
219 (list (ntlm-smb-passwd-hash password)
220 (ntlm-md4hash password)))
221
222(defun ntlm-ascii2unicode (str len)
223 "Convert an ASCII string into a NT Unicode string, which is
224little-endian utf16."
225 (let ((utf (make-string (* 2 len) 0)) (i 0) val)
226 (while (and (< i len)
227 (not (zerop (setq val (aref str i)))))
228 (aset utf (* 2 i) val)
229 (aset utf (1+ (* 2 i)) 0)
230 (setq i (1+ i)))
231 utf))
232
233(defun ntlm-unicode2ascii (str len)
234 "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
235 (let ((buf (make-string len 0)) (i 0) (j 0))
236 (while (< i len)
237 (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
238 (setq i (1+ i)
239 j (+ 2 j)))
240 buf))
241
242(defun ntlm-smb-passwd-hash (passwd)
243 "Return the SMB password hash string of 16 bytes long for the given password
244string PASSWD. PASSWD is truncated to 14 bytes if longer."
245 (let ((len (min (length passwd) 14)))
246 (ntlm-smb-des-e-p16
247 (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
248 (make-string (- 15 len) 0)))))
249
250(defun ntlm-smb-owf-encrypt (passwd c8)
251 "Return the response string of 24 bytes long for the given password
252string PASSWD based on the DES encryption. PASSWD is of at most 14
253bytes long and the challenge string C8 of 8 bytes long."
254 (let ((len (min (length passwd) 16)) p22)
255 (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
256 (make-string (- 22 len) 0)))
257 (ntlm-smb-des-e-p24 p22 c8)))
258
259(defun ntlm-smb-des-e-p24 (p22 c8)
260 "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes
261string C8."
262 (concat (ntlm-smb-hash c8 p22 t) ;hash first 8 bytes of p22
263 (ntlm-smb-hash c8 (substring p22 7) t)
264 (ntlm-smb-hash c8 (substring p22 14) t)))
265
266(defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37])
267
268(defun ntlm-smb-des-e-p16 (p15)
269 "Return a 16 bytes hashed string for a 15 bytes string P15."
270 (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t) ;hash of first 8 bytes of p15
271 (ntlm-smb-hash ntlm-smb-sp8 ;hash of last 8 bytes of p15
272 (substring p15 7) t)))
273
274(defun ntlm-smb-hash (in key forw)
275 "Return the hash string of length 8 for a string IN of length 8 and
276a string KEY of length 8. FORW is t or nil."
277 (let ((out (make-string 8 0))
278 outb ;string of length 64
279 (inb (make-string 64 0))
280 (keyb (make-string 64 0))
281 (key2 (ntlm-smb-str-to-key key))
282 (i 0) aa)
283 (while (< i 64)
284 (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
285 (aset inb i 1))
286 (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
287 (aset keyb i 1))
288 (setq i (1+ i)))
289 (setq outb (ntlm-smb-dohash inb keyb forw))
290 (setq i 0)
291 (while (< i 64)
292 (unless (zerop (aref outb i))
293 (setq aa (aref out (/ i 8)))
294 (aset out (/ i 8)
295 (logior aa (lsh 1 (- 7 (% i 8))))))
296 (setq i (1+ i)))
297 out))
298
299(defun ntlm-smb-str-to-key (str)
300 "Return a string of length 8 for the given string STR of length 7."
301 (let ((key (make-string 8 0))
302 (i 7))
303 (aset key 0 (lsh (aref str 0) -1))
304 (aset key 1 (logior
305 (lsh (logand (aref str 0) 1) 6)
306 (lsh (aref str 1) -2)))
307 (aset key 2 (logior
308 (lsh (logand (aref str 1) 3) 5)
309 (lsh (aref str 2) -3)))
310 (aset key 3 (logior
311 (lsh (logand (aref str 2) 7) 4)
312 (lsh (aref str 3) -4)))
313 (aset key 4 (logior
314 (lsh (logand (aref str 3) 15) 3)
315 (lsh (aref str 4) -5)))
316 (aset key 5 (logior
317 (lsh (logand (aref str 4) 31) 2)
318 (lsh (aref str 5) -6)))
319 (aset key 6 (logior
320 (lsh (logand (aref str 5) 63) 1)
321 (lsh (aref str 6) -7)))
322 (aset key 7 (logand (aref str 6) 127))
323 (while (>= i 0)
324 (aset key i (lsh (aref key i) 1))
325 (setq i (1- i)))
326 key))
327
328(defconst ntlm-smb-perm1 [57 49 41 33 25 17 9
329 1 58 50 42 34 26 18
330 10 2 59 51 43 35 27
331 19 11 3 60 52 44 36
332 63 55 47 39 31 23 15
333 7 62 54 46 38 30 22
334 14 6 61 53 45 37 29
335 21 13 5 28 20 12 4])
336
337(defconst ntlm-smb-perm2 [14 17 11 24 1 5
338 3 28 15 6 21 10
339 23 19 12 4 26 8
340 16 7 27 20 13 2
341 41 52 31 37 47 55
342 30 40 51 45 33 48
343 44 49 39 56 34 53
344 46 42 50 36 29 32])
345
346(defconst ntlm-smb-perm3 [58 50 42 34 26 18 10 2
347 60 52 44 36 28 20 12 4
348 62 54 46 38 30 22 14 6
349 64 56 48 40 32 24 16 8
350 57 49 41 33 25 17 9 1
351 59 51 43 35 27 19 11 3
352 61 53 45 37 29 21 13 5
353 63 55 47 39 31 23 15 7])
354
355(defconst ntlm-smb-perm4 [32 1 2 3 4 5
356 4 5 6 7 8 9
357 8 9 10 11 12 13
358 12 13 14 15 16 17
359 16 17 18 19 20 21
360 20 21 22 23 24 25
361 24 25 26 27 28 29
362 28 29 30 31 32 1])
363
364(defconst ntlm-smb-perm5 [16 7 20 21
365 29 12 28 17
366 1 15 23 26
367 5 18 31 10
368 2 8 24 14
369 32 27 3 9
370 19 13 30 6
371 22 11 4 25])
372
373(defconst ntlm-smb-perm6 [40 8 48 16 56 24 64 32
374 39 7 47 15 55 23 63 31
375 38 6 46 14 54 22 62 30
376 37 5 45 13 53 21 61 29
377 36 4 44 12 52 20 60 28
378 35 3 43 11 51 19 59 27
379 34 2 42 10 50 18 58 26
380 33 1 41 9 49 17 57 25])
381
382(defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
383
384(defconst ntlm-smb-sbox [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7]
385 [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8]
386 [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0]
387 [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]]
388 [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10]
389 [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5]
390 [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15]
391 [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]]
392 [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8]
393 [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1]
394 [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7]
395 [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]]
396 [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15]
397 [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9]
398 [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4]
399 [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]]
400 [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9]
401 [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6]
402 [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14]
403 [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]]
404 [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11]
405 [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8]
406 [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6]
407 [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]]
408 [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1]
409 [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6]
410 [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2]
411 [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]]
412 [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7]
413 [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2]
414 [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8]
415 [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]])
416
417(defsubst ntlm-string-permute (in perm n)
418 "Return a string of length N for a string IN and a permutation vector
419PERM of size N. The length of IN should be height of PERM."
420 (let ((i 0) (out (make-string n 0)))
421 (while (< i n)
422 (aset out i (aref in (- (aref perm i) 1)))
423 (setq i (1+ i)))
424 out))
425
426(defsubst ntlm-string-lshift (str count len)
427 "Return a string by circularly shifting a string STR by COUNT to the left.
428length of STR is LEN."
429 (let ((c (% count len)))
430 (concat (substring str c len) (substring str 0 c))))
431
432(defsubst ntlm-string-xor (in1 in2 n)
433 "Return exclusive-or of sequences in1 and in2"
434 (let ((w (make-string n 0)) (i 0))
435 (while (< i n)
436 (aset w i (logxor (aref in1 i) (aref in2 i)))
437 (setq i (1+ i)))
438 w))
439
440(defun ntlm-smb-dohash (in key forw)
441 "Return the hash value for a string IN and a string KEY.
442Length of IN and KEY are 64. FORW non nill means forward, nil means
443backward."
444 (let (pk1 ;string of length 56
445 c ;string of length 28
446 d ;string of length 28
447 cd ;string of length 56
448 (ki (make-vector 16 0)) ;vector of string of length 48
449 pd1 ;string of length 64
450 l ;string of length 32
451 r ;string of length 32
452 rl ;string of length 64
453 (i 0) (j 0) (k 0))
454 (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
455 (setq c (substring pk1 0 28))
456 (setq d (substring pk1 28 56))
457
458 (setq i 0)
459 (while (< i 16)
460 (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
461 (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
462 (setq cd (concat (substring c 0 28) (substring d 0 28)))
463 (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
464 (setq i (1+ i)))
465
466 (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
467
468 (setq l (substring pd1 0 32))
469 (setq r (substring pd1 32 64))
470
471 (setq i 0)
472 (let (er ;string of length 48
473 erk ;string of length 48
474 (b (make-vector 8 0)) ;vector of strings of length 6
475 cb ;string of length 32
476 pcb ;string of length 32
477 r2 ;string of length 32
478 jj m n bj sbox-jmn)
479 (while (< i 16)
480 (setq er (ntlm-string-permute r ntlm-smb-perm4 48))
481 (setq erk (ntlm-string-xor er
482 (aref ki (if forw i (- 15 i)))
483 48))
484 (setq j 0)
485 (while (< j 8)
486 (setq jj (* 6 j))
487 (aset b j (substring erk jj (+ jj 6)))
488 (setq j (1+ j)))
489 (setq j 0)
490 (while (< j 8)
491 (setq bj (aref b j))
492 (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
493 (setq n (logior (lsh (aref bj 1) 3)
494 (lsh (aref bj 2) 2)
495 (lsh (aref bj 3) 1)
496 (aref bj 4)))
497 (setq k 0)
498 (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
499 (while (< k 4)
500 (aset bj k
501 (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
502 0 1))
503 (setq k (1+ k)))
504 (setq j (1+ j)))
505
506 (setq j 0)
507 (setq cb nil)
508 (while (< j 8)
509 (setq cb (concat cb (substring (aref b j) 0 4)))
510 (setq j (1+ j)))
511
512 (setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32))
513 (setq r2 (ntlm-string-xor l pcb 32))
514 (setq l r)
515 (setq r r2)
516 (setq i (1+ i))))
517 (setq rl (concat r l))
518 (ntlm-string-permute rl ntlm-smb-perm6 64)))
519
520(defun ntlm-md4hash (passwd)
521 "Return the 16 bytes MD4 hash of a string PASSWD after converting it
522into a Unicode string. PASSWD is truncated to 128 bytes if longer."
523 (let (len wpwd)
524 ;; Password cannot be longer than 128 characters
525 (setq len (length passwd))
526 (if (> len 128)
527 (setq len 128))
528 ;; Password must be converted to NT unicode
529 (setq wpwd (ntlm-ascii2unicode passwd len))
530 ;; Calculate length in bytes
531 (setq len (* len 2))
532 (md4 wpwd len)))
533
534(provide 'ntlm)
535
536;;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296
537;;; ntlm.el ends here
diff --git a/lisp/gnus/password.el b/lisp/gnus/password.el
new file mode 100644
index 00000000000..32ab76052d9
--- /dev/null
+++ b/lisp/gnus/password.el
@@ -0,0 +1,140 @@
1;;; password.el --- Read passwords from user, possibly using a password cache.
2
3;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
4
5;; Author: Simon Josefsson <simon@josefsson.org>
6;; Created: 2003-12-21
7;; Keywords: password cache passphrase key
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; Greatly influenced by pgg.el written by Daiki Ueno, with timer
29;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just
30;; a rip-off.
31;;
32;; (password-read "Password? " "test")
33;; ;; Minibuffer prompt for password.
34;; => "foo"
35;;
36;; (password-cache-add "test" "foo")
37;; => nil
38
39;; Note the previous two can be replaced with:
40;; (password-read-and-add "Password? " "test")
41;; ;; Minibuffer prompt for password.
42;; => "foo"
43;; ;; "foo" is now cached with key "test"
44
45
46;; (password-read "Password? " "test")
47;; ;; No minibuffer prompt
48;; => "foo"
49;;
50;; (password-read "Password? " "test")
51;; ;; No minibuffer prompt
52;; => "foo"
53;;
54;; ;; Wait `password-cache-expiry' seconds.
55;;
56;; (password-read "Password? " "test")
57;; ;; Minibuffer prompt for password is back.
58;; => "foo"
59
60;;; Code:
61
62(eval-when-compile
63 (require 'cl))
64
65(defcustom password-cache t
66 "Whether to cache passwords."
67 :group 'password
68 :type 'boolean)
69
70(defcustom password-cache-expiry 16
71 "How many seconds passwords are cached, or nil to disable expiring.
72Whether passwords are cached at all is controlled by `password-cache'."
73 :group 'password
74 :type '(choice (const :tag "Never" nil)
75 (integer :tag "Seconds")))
76
77(defvar password-data (make-vector 7 0))
78
79(defun password-read-from-cache (key)
80 "Obtain passphrase for KEY from time-limited passphrase cache.
81Custom variables `password-cache' and `password-cache-expiry'
82regulate cache behavior."
83 (and password-cache
84 key
85 (symbol-value (intern-soft key password-data))))
86
87(defun password-read (prompt &optional key)
88 "Read password, for use with KEY, from user, or from cache if wanted.
89KEY indicate the purpose of the password, so the cache can
90separate passwords. The cache is not used if KEY is nil. It is
91typically a string.
92The variable `password-cache' control whether the cache is used."
93 (or (password-read-from-cache key)
94 (read-passwd prompt)))
95
96(defun password-read-and-add (prompt &optional key)
97 "Read password, for use with KEY, from user, or from cache if wanted.
98Then store the password in the cache. Uses `password-read' and
99`password-cache-add'.
100Custom variables `password-cache' and `password-cache-expiry'
101regulate cache behavior."
102 (let ((password (password-read prompt key)))
103 (when (and password key)
104 (password-cache-add key password))
105 password))
106
107(defun password-cache-remove (key)
108 "Remove password indexed by KEY from password cache.
109This is typically run be a timer setup from `password-cache-add',
110but can be invoked at any time to forcefully remove passwords
111from the cache. This may be useful when it has been detected
112that a password is invalid, so that `password-read' query the
113user again."
114 (let ((password (symbol-value (intern-soft key password-data))))
115 (when password
116 (if (fboundp 'clear-string)
117 (clear-string password)
118 (fillarray password ?_))
119 (unintern key password-data))))
120
121(defun password-cache-add (key password)
122 "Add password to cache.
123The password is removed by a timer after `password-cache-expiry'
124seconds."
125 (when (and password-cache-expiry (null (intern-soft key password-data)))
126 (run-at-time password-cache-expiry nil
127 #'password-cache-remove
128 key))
129 (set (intern key password-data) password)
130 nil)
131
132(defun password-reset ()
133 "Clear the password cache."
134 (interactive)
135 (fillarray password-data 0))
136
137(provide 'password)
138
139;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
140;;; password.el ends here
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 97d6af02cde..c8e309d8c14 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -201,6 +201,23 @@ to %s might not give the result you'd expect." pop3-leave-mail-on-server)
201 (pop3-quit process) 201 (pop3-quit process)
202 message-count)) 202 message-count))
203 203
204(autoload 'open-tls-stream "tls")
205(autoload 'starttls-open-stream "starttls")
206(autoload 'starttls-negotiate "starttls") ; avoid warning
207
208(defcustom pop3-stream-type nil
209 "*Transport security type for POP3 connexions.
210This may be either nil (plain connexion), `ssl' (use an
211SSL/TSL-secured stream) or `starttls' (use the starttls mechanism
212to turn on TLS security after opening the stream). However, if
213this is nil, `ssl' is assumed for connexions to port
214995 (pop3s)."
215 :version "23.0" ;; No Gnus
216 :group 'pop3
217 :type '(choice (const :tag "Plain" nil)
218 (const :tag "SSL/TLS" ssl)
219 (const starttls)))
220
204(defun pop3-open-server (mailhost port) 221(defun pop3-open-server (mailhost port)
205 "Open TCP connection to MAILHOST on PORT. 222 "Open TCP connection to MAILHOST on PORT.
206Returns the process associated with the connection." 223Returns the process associated with the connection."
@@ -212,7 +229,44 @@ Returns the process associated with the connection."
212 mailhost))) 229 mailhost)))
213 (erase-buffer) 230 (erase-buffer)
214 (setq pop3-read-point (point-min)) 231 (setq pop3-read-point (point-min))
215 (setq process (open-network-stream "POP" (current-buffer) mailhost port)) 232 (setq process
233 (cond
234 ((or (eq pop3-stream-type 'ssl)
235 (and (not pop3-stream-type) (member port '(995 "pop3s"))))
236 ;; gnutls-cli, openssl don't accept service names
237 (if (or (equal port "pop3s")
238 (null port))
239 (setq port 995))
240 (let ((process (open-tls-stream "POP" (current-buffer)
241 mailhost port)))
242 (when process
243 ;; There's a load of info printed that needs deleting.
244 (while (when (memq (process-status process) '(open run))
245 (pop3-accept-process-output process)
246 (goto-char (point-max))
247 (forward-line -1)
248 (if (looking-at "\\+OK")
249 (progn
250 (delete-region (point-min) (point))
251 nil)
252 (pop3-quit process)
253 (error "POP SSL connexion failed"))))
254 process)))
255 ((eq pop3-stream-type 'starttls)
256 ;; gnutls-cli, openssl don't accept service names
257 (if (equal port "pop3")
258 (setq port 110))
259 (let ((process (starttls-open-stream "POP" (current-buffer)
260 mailhost (or port 110))))
261 (pop3-send-command process "STLS")
262 (let ((response (pop3-read-response process t)))
263 (if (and response (string-match "+OK" response))
264 (starttls-negotiate process)
265 (pop3-quit process)
266 (error "POP server doesn't support starttls")))
267 process))
268 (t
269 (open-network-stream "POP" (current-buffer) mailhost port))))
216 (let ((response (pop3-read-response process t))) 270 (let ((response (pop3-read-response process t)))
217 (setq pop3-timestamp 271 (setq pop3-timestamp
218 (substring response (or (string-match "<" response) 0) 272 (substring response (or (string-match "<" response) 0)
@@ -357,37 +411,6 @@ If NOW, use that time instead."
357 411
358;; AUTHORIZATION STATE 412;; AUTHORIZATION STATE
359 413
360(eval-when-compile
361 (if (not (fboundp 'md5)) ;; Emacs 20
362 (defalias 'md5 'ignore)))
363
364(eval-and-compile
365 (if (and (fboundp 'md5)
366 ;; There might be an incompatible implementation.
367 (condition-case nil
368 (md5 "Check whether the 4th argument is allowed"
369 nil nil 'binary)
370 (error nil)))
371 (defun pop3-md5 (string)
372 (md5 string nil nil 'binary))
373 (defvar pop3-md5-program "md5"
374 "*Program to encode its input in MD5.
375\"openssl\" is a popular alternative; set `pop3-md5-program-args' to
376'(\"md5\") if you use it.")
377 (defvar pop3-md5-program-args nil
378 "*List of arguments passed to `pop3-md5-program'.")
379 (defun pop3-md5 (string)
380 (let ((default-enable-multibyte-characters t)
381 (coding-system-for-write 'binary))
382 (with-temp-buffer
383 (insert string)
384 (apply 'call-process-region (point-min) (point-max)
385 pop3-md5-program t (current-buffer) nil
386 pop3-md5-program-args)
387 ;; The meaningful output is the first 32 characters.
388 ;; Don't return the newline that follows them!
389 (buffer-substring (point-min) (+ 32 (point-min))))))))
390
391(defun pop3-user (process user) 414(defun pop3-user (process user)
392 "Send USER information to POP3 server." 415 "Send USER information to POP3 server."
393 (pop3-send-command process (format "USER %s" user)) 416 (pop3-send-command process (format "USER %s" user))
@@ -409,7 +432,7 @@ If NOW, use that time instead."
409 (setq pass 432 (setq pass
410 (read-passwd (format "Password for %s: " pop3-maildrop)))) 433 (read-passwd (format "Password for %s: " pop3-maildrop))))
411 (if pass 434 (if pass
412 (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) 435 (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary)))
413 (pop3-send-command process (format "APOP %s %s" user hash)) 436 (pop3-send-command process (format "APOP %s %s" user hash))
414 (let ((response (pop3-read-response process t))) 437 (let ((response (pop3-read-response process t)))
415 (if (not (and response (string-match "+OK" response))) 438 (if (not (and response (string-match "+OK" response)))
@@ -520,6 +543,13 @@ and close the connection."
520;; -ERR [invalid password] 543;; -ERR [invalid password]
521;; -ERR [unable to lock maildrop] 544;; -ERR [unable to lock maildrop]
522 545
546;; STLS (RFC 2595)
547;; Arguments: none
548;; Restrictions: Only permitted in AUTHORIZATION state.
549;; Possible responses:
550;; +OK
551;; -ERR
552
523;;; TRANSACTION STATE 553;;; TRANSACTION STATE
524 554
525;; STAT 555;; STAT
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index 17cc7ef2cf6..d601222160d 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -70,8 +70,8 @@ them into characters should be done separately."
70 (delete-char 2)) 70 (delete-char 2))
71 ((looking-at "=[0-9A-F][0-9A-F]") 71 ((looking-at "=[0-9A-F][0-9A-F]")
72 (let ((byte (string-to-number (buffer-substring (1+ (point)) 72 (let ((byte (string-to-number (buffer-substring (1+ (point))
73 (+ 3 (point))) 73 (+ 3 (point)))
74 16))) 74 16)))
75 (mm-insert-byte byte 1) 75 (mm-insert-byte byte 1)
76 (delete-char 3))) 76 (delete-char 3)))
77 (t 77 (t
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index 2ad57323d47..4f63cae9eec 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -31,24 +31,7 @@
31 31
32(eval-when-compile 32(eval-when-compile
33 (require 'cl) 33 (require 'cl)
34 (defvar message-posting-charset) 34 (defvar message-posting-charset))
35 (unless (fboundp 'with-syntax-table) ; not in Emacs 20
36 (defmacro with-syntax-table (table &rest body)
37 "Evaluate BODY with syntax table of current buffer set to TABLE.
38The syntax table of the current buffer is saved, BODY is evaluated, and the
39saved table is restored, even in case of an abnormal exit.
40Value is what BODY returns."
41 (let ((old-table (make-symbol "table"))
42 (old-buffer (make-symbol "buffer")))
43 `(let ((,old-table (syntax-table))
44 (,old-buffer (current-buffer)))
45 (unwind-protect
46 (progn
47 (set-syntax-table ,table)
48 ,@body)
49 (save-current-buffer
50 (set-buffer ,old-buffer)
51 (set-syntax-table ,old-table))))))))
52 35
53(require 'qp) 36(require 'qp)
54(require 'mm-util) 37(require 'mm-util)
@@ -58,18 +41,6 @@ Value is what BODY returns."
58(require 'rfc2045) ;; rfc2045-encode-string 41(require 'rfc2045) ;; rfc2045-encode-string
59(autoload 'mm-body-7-or-8 "mm-bodies") 42(autoload 'mm-body-7-or-8 "mm-bodies")
60 43
61(eval-and-compile
62 ;; Avoid gnus-util for mm- code.
63 (defalias 'rfc2047-point-at-bol
64 (if (fboundp 'point-at-bol)
65 'point-at-bol
66 'line-beginning-position))
67
68 (defalias 'rfc2047-point-at-eol
69 (if (fboundp 'point-at-eol)
70 'point-at-eol
71 'line-end-position)))
72
73(defvar rfc2047-header-encoding-alist 44(defvar rfc2047-header-encoding-alist
74 '(("Newsgroups" . nil) 45 '(("Newsgroups" . nil)
75 ("Followup-To" . nil) 46 ("Followup-To" . nil)
@@ -159,7 +130,7 @@ This is either `base64' or `quoted-printable'."
159 (progn 130 (progn
160 (forward-line 1) 131 (forward-line 1)
161 (if (re-search-forward "^[^ \n\t]" nil t) 132 (if (re-search-forward "^[^ \n\t]" nil t)
162 (rfc2047-point-at-bol) 133 (point-at-bol)
163 (point-max)))) 134 (point-max))))
164 (goto-char (point-min))) 135 (goto-char (point-min)))
165 136
@@ -175,37 +146,50 @@ This is either `base64' or `quoted-printable'."
175 encodable-regexp) 146 encodable-regexp)
176 "Quote special characters with `\\'s in quoted strings. 147 "Quote special characters with `\\'s in quoted strings.
177Quoting will not be done in a quoted string if it contains characters 148Quoting will not be done in a quoted string if it contains characters
178matching ENCODABLE-REGEXP." 149matching ENCODABLE-REGEXP or it is within parentheses."
179 (goto-char (point-min)) 150 (goto-char (point-min))
180 (let ((tspecials (concat "[" ietf-drums-tspecials "]")) 151 (let ((tspecials (concat "[" ietf-drums-tspecials "]"))
152 (start (point))
181 beg end) 153 beg end)
182 (with-syntax-table (standard-syntax-table) 154 (with-syntax-table (standard-syntax-table)
183 (while (search-forward "\"" nil t) 155 (while (not (eobp))
184 (setq beg (match-beginning 0)) 156 (if (ignore-errors
185 (unless (eq (char-before beg) ?\\) 157 (forward-list 1)
186 (goto-char beg) 158 (eq (char-before) ?\)))
187 (setq beg (1+ beg)) 159 (forward-list -1)
188 (condition-case nil 160 (goto-char (point-max)))
189 (progn 161 (save-restriction
190 (forward-sexp) 162 (narrow-to-region start (point))
191 (setq end (1- (point))) 163 (goto-char start)
192 (goto-char beg) 164 (while (search-forward "\"" nil t)
193 (if (and encodable-regexp 165 (setq beg (match-beginning 0))
194 (re-search-forward encodable-regexp end t)) 166 (unless (eq (char-before beg) ?\\)
195 (goto-char (1+ end)) 167 (goto-char beg)
196 (save-restriction 168 (setq beg (1+ beg))
197 (narrow-to-region beg end) 169 (condition-case nil
198 (while (re-search-forward tspecials nil 'move) 170 (progn
199 (if (eq (char-before) ?\\) 171 (forward-sexp)
200 (if (looking-at tspecials) ;; Already quoted. 172 (setq end (1- (point)))
201 (forward-char) 173 (goto-char beg)
202 (insert "\\")) 174 (if (and encodable-regexp
203 (goto-char (match-beginning 0)) 175 (re-search-forward encodable-regexp end t))
204 (insert "\\") 176 (goto-char (1+ end))
205 (forward-char)))) 177 (save-restriction
206 (forward-char))) 178 (narrow-to-region beg end)
207 (error 179 (while (re-search-forward tspecials nil 'move)
208 (goto-char beg)))))))) 180 (if (eq (char-before) ?\\)
181 (if (looking-at tspecials) ;; Already quoted.
182 (forward-char)
183 (insert "\\"))
184 (goto-char (match-beginning 0))
185 (insert "\\")
186 (forward-char))))
187 (forward-char)))
188 (error
189 (goto-char beg)))))
190 (goto-char (point-max)))
191 (forward-list 1)
192 (setq start (point))))))
209 193
210(defvar rfc2047-encoding-type 'address-mime 194(defvar rfc2047-encoding-type 'address-mime
211 "The type of encoding done by `rfc2047-encode-region'. 195 "The type of encoding done by `rfc2047-encode-region'.
@@ -290,9 +274,10 @@ Should be called narrowed to the head of the message."
290;;; (rfc2047-encode-region (point-min) (point-max)) 274;;; (rfc2047-encode-region (point-min) (point-max))
291;;; (error "Cannot send unencoded text"))) 275;;; (error "Cannot send unencoded text")))
292 ((mm-coding-system-p method) 276 ((mm-coding-system-p method)
293 (if (and (featurep 'mule) 277 (if (or (and (featurep 'mule)
294 (if (boundp 'default-enable-multibyte-characters) 278 (if (boundp 'default-enable-multibyte-characters)
295 default-enable-multibyte-characters)) 279 default-enable-multibyte-characters))
280 (featurep 'file-coding))
296 (mm-encode-coding-region (point) (point-max) method))) 281 (mm-encode-coding-region (point) (point-max) method)))
297 ;; Hm. 282 ;; Hm.
298 (t))) 283 (t)))
@@ -656,14 +641,14 @@ Point moves to the end of the region."
656 (goto-char b) 641 (goto-char b)
657 (setq b (point-marker) 642 (setq b (point-marker)
658 e (set-marker (make-marker) e)) 643 e (set-marker (make-marker) e))
659 (rfc2047-fold-region (rfc2047-point-at-bol) b) 644 (rfc2047-fold-region (point-at-bol) b)
660 (goto-char b) 645 (goto-char b)
661 (skip-chars-backward "^ \t\n") 646 (skip-chars-backward "^ \t\n")
662 (unless (= 0 (skip-chars-backward " \t")) 647 (unless (= 0 (skip-chars-backward " \t"))
663 ;; `crest' may contain whitespace and an open parenthesis. 648 ;; `crest' may contain whitespace and an open parenthesis.
664 (setq crest (buffer-substring-no-properties (point) b))) 649 (setq crest (buffer-substring-no-properties (point) b)))
665 (setq eword (rfc2047-encode-1 650 (setq eword (rfc2047-encode-1
666 (- b (rfc2047-point-at-bol)) 651 (- b (point-at-bol))
667 (mm-replace-in-string 652 (mm-replace-in-string
668 (buffer-substring-no-properties b e) 653 (buffer-substring-no-properties b e)
669 "\n\\([ \t]?\\)" "\\1") 654 "\n\\([ \t]?\\)" "\\1")
@@ -710,7 +695,7 @@ Point moves to the end of the region."
710 (first t) 695 (first t)
711 (bol (save-restriction 696 (bol (save-restriction
712 (widen) 697 (widen)
713 (rfc2047-point-at-bol)))) 698 (point-at-bol))))
714 (while (not (eobp)) 699 (while (not (eobp))
715 (when (and (or break qword-break) 700 (when (and (or break qword-break)
716 (> (- (point) bol) 76)) 701 (> (- (point) bol) 76))
@@ -782,18 +767,18 @@ Point moves to the end of the region."
782 (goto-char (point-min)) 767 (goto-char (point-min))
783 (let ((bol (save-restriction 768 (let ((bol (save-restriction
784 (widen) 769 (widen)
785 (rfc2047-point-at-bol))) 770 (point-at-bol)))
786 (eol (rfc2047-point-at-eol))) 771 (eol (point-at-eol)))
787 (forward-line 1) 772 (forward-line 1)
788 (while (not (eobp)) 773 (while (not (eobp))
789 (if (and (looking-at "[ \t]") 774 (if (and (looking-at "[ \t]")
790 (< (- (rfc2047-point-at-eol) bol) 76)) 775 (< (- (point-at-eol) bol) 76))
791 (delete-region eol (progn 776 (delete-region eol (progn
792 (goto-char eol) 777 (goto-char eol)
793 (skip-chars-forward "\r\n") 778 (skip-chars-forward "\r\n")
794 (point))) 779 (point)))
795 (setq bol (rfc2047-point-at-bol))) 780 (setq bol (point-at-bol)))
796 (setq eol (rfc2047-point-at-eol)) 781 (setq eol (point-at-eol))
797 (forward-line 1))))) 782 (forward-line 1)))))
798 783
799(defun rfc2047-b-encode-string (string) 784(defun rfc2047-b-encode-string (string)
@@ -842,7 +827,7 @@ it, put the following line in your ~/.gnus.el file:
842 827
843(eval-and-compile 828(eval-and-compile
844 (defconst rfc2047-encoded-word-regexp 829 (defconst rfc2047-encoded-word-regexp
845 "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(\\*[^?]+\\)?\ 830 "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\
846\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?=")) 831\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?="))
847 832
848(defvar rfc2047-quote-decoded-words-containing-tspecials nil 833(defvar rfc2047-quote-decoded-words-containing-tspecials nil
@@ -981,8 +966,8 @@ other than `\"' and `\\' in quoted strings."
981 words nil) 966 words nil)
982 (while match 967 (while match
983 (push (list (match-string 2) ;; charset 968 (push (list (match-string 2) ;; charset
984 (char-after (match-beginning 4)) ;; encoding 969 (char-after (match-beginning 3)) ;; encoding
985 (match-string 5) ;; encoded-text 970 (match-string 4) ;; encoded-text
986 (match-string 1)) ;; encoded-word 971 (match-string 1)) ;; encoded-word
987 words) 972 words)
988 ;; Look for the subsequent encoded-words. 973 ;; Look for the subsequent encoded-words.
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index 51d7523a648..6e9963c5321 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -53,8 +53,7 @@ must never cause a Lisp error."
53 (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token)) 53 (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
54 (stoken (ietf-drums-token-to-list ietf-drums-tspecials)) 54 (stoken (ietf-drums-token-to-list ietf-drums-tspecials))
55 (ntoken (ietf-drums-token-to-list "0-9")) 55 (ntoken (ietf-drums-token-to-list "0-9"))
56 c type attribute encoded number prev-attribute vals 56 c type attribute encoded number parameters value)
57 prev-encoded parameters value)
58 (ietf-drums-init 57 (ietf-drums-init
59 (condition-case nil 58 (condition-case nil
60 (mail-header-remove-whitespace 59 (mail-header-remove-whitespace
@@ -81,8 +80,8 @@ must never cause a Lisp error."
81 ;; Finally, attempt to extract only type. 80 ;; Finally, attempt to extract only type.
82 (if (string-match 81 (if (string-match
83 (concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+" 82 (concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+"
84 "\\(/[^" ietf-drums-tspecials 83 "\\(?:/[^" ietf-drums-tspecials
85 "\t\n ]+\\)?\\)\\([\t\n ;]\\|\\'\\)") 84 "\t\n ]+\\)?\\)\\(?:[\t\n ;]\\|\\'\\)")
86 string) 85 string)
87 (match-string 1 string) 86 (match-string 1 string)
88 "")))))) 87 ""))))))
@@ -142,19 +141,6 @@ must never cause a Lisp error."
142 (setq c (char-after))))) 141 (setq c (char-after)))))
143 (setq number nil 142 (setq number nil
144 encoded nil)) 143 encoded nil))
145 ;; See if we have any previous continuations.
146 (when (and prev-attribute
147 (not (eq prev-attribute attribute)))
148 (setq vals
149 (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
150 (push (cons prev-attribute
151 (if prev-encoded
152 (rfc2231-decode-encoded-string vals)
153 vals))
154 parameters)
155 (setq prev-attribute nil
156 vals nil
157 prev-encoded nil))
158 (unless (eq c ?=) 144 (unless (eq c ?=)
159 (error "Invalid header: %s" string)) 145 (error "Invalid header: %s" string))
160 (forward-char 1) 146 (forward-char 1)
@@ -187,33 +173,33 @@ must never cause a Lisp error."
187 (point))))) 173 (point)))))
188 (t 174 (t
189 (error "Invalid header: %s" string))) 175 (error "Invalid header: %s" string)))
190 (if number 176 (push (list attribute value number encoded)
191 (progn 177 parameters))))
192 (push (cons number value) vals)
193 (setq prev-attribute attribute
194 prev-encoded encoded))
195 (push (cons attribute
196 (if encoded
197 (rfc2231-decode-encoded-string value)
198 value))
199 parameters))))
200
201 ;; Take care of any final continuations.
202 (when prev-attribute
203 (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
204 (push (cons prev-attribute
205 (if prev-encoded
206 (rfc2231-decode-encoded-string vals)
207 vals))
208 parameters)))
209 (error 178 (error
210 (setq parameters nil) 179 (setq parameters nil)
211 (if signal-error 180 (when signal-error
212 (signal (car err) (cdr err)) 181 (signal (car err) (cdr err)))))
213 ;;(message "%s" (error-message-string err))
214 )))
215 182
216 (cons type (nreverse parameters)))))) 183 ;; Now collect and concatenate continuation parameters.
184 (let ((cparams nil)
185 elem)
186 (loop for (attribute value part encoded)
187 in (sort parameters (lambda (e1 e2)
188 (< (or (caddr e1) 0)
189 (or (caddr e2) 0))))
190 do (if (or (not (setq elem (assq attribute cparams)))
191 (and (numberp part)
192 (zerop part)))
193 (push (list attribute value encoded) cparams)
194 (setcar (cdr elem) (concat (cadr elem) value))))
195 ;; Finally decode encoded values.
196 (cons type (mapcar
197 (lambda (elem)
198 (cons (car elem)
199 (if (nth 2 elem)
200 (rfc2231-decode-encoded-string (nth 1 elem))
201 (nth 1 elem))))
202 (nreverse cparams))))))))
217 203
218(defun rfc2231-decode-encoded-string (string) 204(defun rfc2231-decode-encoded-string (string)
219 "Decode an RFC2231-encoded string. 205 "Decode an RFC2231-encoded string.
@@ -223,10 +209,10 @@ These look like:
223 \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", 209 \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
224 \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or 210 \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
225 \"This is ***fun***\"." 211 \"This is ***fun***\"."
226 (string-match "\\`\\(\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) 212 (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string)
227 (let ((coding-system (mm-charset-to-coding-system (match-string 2 string))) 213 (let ((coding-system (mm-charset-to-coding-system (match-string 1 string)))
228 ;;(language (match-string 3 string)) 214 ;;(language (match-string 2 string))
229 (value (match-string 4 string))) 215 (value (match-string 3 string)))
230 (mm-with-unibyte-buffer 216 (mm-with-unibyte-buffer
231 (insert value) 217 (insert value)
232 (goto-char (point-min)) 218 (goto-char (point-min))
diff --git a/lisp/gnus/sasl-cram.el b/lisp/gnus/sasl-cram.el
new file mode 100644
index 00000000000..b8b1ced82ac
--- /dev/null
+++ b/lisp/gnus/sasl-cram.el
@@ -0,0 +1,52 @@
1;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
2
3;; Copyright (C) 2000 Free Software Foundation, Inc.
4
5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Kenichi OKADA <okada@opaopa.org>
7;; Keywords: SASL, CRAM-MD5
8
9;; This file is part of FLIM (Faithful Library about Internet Message).
10
11;; This program is free software; you can redistribute it and/or
12;; modify it under the terms of the GNU General Public License as
13;; published by the Free Software Foundation; either version 3, or (at
14;; your option) any later version.
15
16;; This program is distributed in the hope that it will be useful, but
17;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19;; General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with this program; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28(require 'sasl)
29(require 'hmac-md5)
30
31(defconst sasl-cram-md5-steps
32 '(ignore ;no initial response
33 sasl-cram-md5-response))
34
35(defun sasl-cram-md5-response (client step)
36 (let ((passphrase
37 (sasl-read-passphrase
38 (format "CRAM-MD5 passphrase for %s: "
39 (sasl-client-name client)))))
40 (unwind-protect
41 (concat (sasl-client-name client) " "
42 (encode-hex-string
43 (hmac-md5 (sasl-step-data step) passphrase)))
44 (fillarray passphrase 0))))
45
46(put 'sasl-cram 'sasl-mechanism
47 (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps))
48
49(provide 'sasl-cram)
50
51;;; arch-tag: 46cb281b-975a-4fe0-a39f-3018691b1b05
52;;; sasl-cram.el ends here
diff --git a/lisp/gnus/sasl-digest.el b/lisp/gnus/sasl-digest.el
new file mode 100644
index 00000000000..c290c7524c8
--- /dev/null
+++ b/lisp/gnus/sasl-digest.el
@@ -0,0 +1,157 @@
1;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
2
3;; Copyright (C) 2000 Free Software Foundation, Inc.
4
5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Kenichi OKADA <okada@opaopa.org>
7;; Keywords: SASL, DIGEST-MD5
8
9;; This file is part of FLIM (Faithful Library about Internet Message).
10
11;; This program is free software; you can redistribute it and/or
12;; modify it under the terms of the GNU General Public License as
13;; published by the Free Software Foundation; either version 3, or (at
14;; your option) any later version.
15
16;; This program is distributed in the hope that it will be useful, but
17;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19;; General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with this program; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;; This program is implemented from draft-leach-digest-sasl-05.txt.
27;;
28;; It is caller's responsibility to base64-decode challenges and
29;; base64-encode responses in IMAP4 AUTHENTICATE command.
30;;
31;; Passphrase should be longer than 16 bytes. (See RFC 2195)
32
33;;; Commentary:
34
35(require 'sasl)
36(require 'hmac-md5)
37
38(defvar sasl-digest-md5-nonce-count 1)
39(defvar sasl-digest-md5-unique-id-function
40 sasl-unique-id-function)
41
42(defvar sasl-digest-md5-syntax-table
43 (let ((table (make-syntax-table)))
44 (modify-syntax-entry ?= "." table)
45 (modify-syntax-entry ?, "." table)
46 table)
47 "A syntax table for parsing digest-challenge attributes.")
48
49(defconst sasl-digest-md5-steps
50 '(ignore ;no initial response
51 sasl-digest-md5-response
52 ignore)) ;""
53
54(defun sasl-digest-md5-parse-string (string)
55 "Parse STRING and return a property list.
56The value is a cons cell of the form \(realm nonce qop-options stale maxbuf
57charset algorithm cipher-opts auth-param)."
58 (with-temp-buffer
59 (set-syntax-table sasl-digest-md5-syntax-table)
60 (save-excursion
61 (insert string)
62 (goto-char (point-min))
63 (insert "(")
64 (while (progn (forward-sexp) (not (eobp)))
65 (delete-char 1)
66 (insert " "))
67 (insert ")")
68 (read (point-min-marker)))))
69
70(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name)
71 (concat serv-type "/" host
72 (if (and serv-name
73 (not (string= host serv-name)))
74 (concat "/" serv-name))))
75
76(defun sasl-digest-md5-cnonce ()
77 (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function))
78 (sasl-unique-id)))
79
80(defun sasl-digest-md5-response-value (username
81 realm
82 nonce
83 cnonce
84 nonce-count
85 qop
86 digest-uri
87 authzid)
88 (let ((passphrase
89 (sasl-read-passphrase
90 (format "DIGEST-MD5 passphrase for %s: "
91 username))))
92 (unwind-protect
93 (encode-hex-string
94 (md5-binary
95 (concat
96 (encode-hex-string
97 (md5-binary (concat (md5-binary
98 (concat username ":" realm ":" passphrase))
99 ":" nonce ":" cnonce
100 (if authzid
101 (concat ":" authzid)))))
102 ":" nonce
103 ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
104 (encode-hex-string
105 (md5-binary
106 (concat "AUTHENTICATE:" digest-uri
107 (if (member qop '("auth-int" "auth-conf"))
108 ":00000000000000000000000000000000")))))))
109 (fillarray passphrase 0))))
110
111(defun sasl-digest-md5-response (client step)
112 (let* ((plist
113 (sasl-digest-md5-parse-string (sasl-step-data step)))
114 (realm
115 (or (sasl-client-property client 'realm)
116 (plist-get plist 'realm))) ;need to check
117 (nonce-count
118 (or (sasl-client-property client 'nonce-count)
119 sasl-digest-md5-nonce-count))
120 (qop
121 (or (sasl-client-property client 'qop)
122 "auth"))
123 (digest-uri
124 (sasl-digest-md5-digest-uri
125 (sasl-client-service client)(sasl-client-server client)))
126 (cnonce
127 (or (sasl-client-property client 'cnonce)
128 (sasl-digest-md5-cnonce))))
129 (sasl-client-set-property client 'nonce-count (1+ nonce-count))
130 (unless (string= qop "auth")
131 (sasl-error (format "Unsupported \"qop-value\": %s" qop)))
132 (concat
133 "username=\"" (sasl-client-name client) "\","
134 "realm=\"" realm "\","
135 "nonce=\"" (plist-get plist 'nonce) "\","
136 "cnonce=\"" cnonce "\","
137 (format "nc=%08x," nonce-count)
138 "digest-uri=\"" digest-uri "\","
139 "qop=" qop ","
140 "response="
141 (sasl-digest-md5-response-value
142 (sasl-client-name client)
143 realm
144 (plist-get plist 'nonce)
145 cnonce
146 nonce-count
147 qop
148 digest-uri
149 (plist-get plist 'authzid)))))
150
151(put 'sasl-digest 'sasl-mechanism
152 (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
153
154(provide 'sasl-digest)
155
156;;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d
157;;; sasl-digest.el ends here
diff --git a/lisp/gnus/sasl-ntlm.el b/lisp/gnus/sasl-ntlm.el
new file mode 100644
index 00000000000..784b373c056
--- /dev/null
+++ b/lisp/gnus/sasl-ntlm.el
@@ -0,0 +1,66 @@
1;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
2
3;; Copyright (C) 2000 Free Software Foundation, Inc.
4
5;; Author: Taro Kawagishi <tarok@transpulse.org>
6;; Keywords: SASL, NTLM
7;; Version: 1.00
8;; Created: February 2001
9
10;; This program is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 3, or (at your option)
13;; any later version.
14;;
15;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19;;
20;; You should have received a copy of the GNU General Public License
21;; along with this program; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This is a SASL interface layer for NTLM authentication message
28;; generation by ntlm.el
29
30;;; Code:
31
32(require 'sasl)
33(require 'ntlm)
34
35(defconst sasl-ntlm-steps
36 '(ignore ;nothing to do before making
37 sasl-ntlm-request ;authentication request
38 sasl-ntlm-response) ;response to challenge
39 "A list of functions to be called in sequnece for the NTLM
40authentication steps. Ther are called by 'sasl-next-step.")
41
42(defun sasl-ntlm-request (client step)
43 "SASL step function to generate a NTLM authentication request to the server.
44Called from 'sasl-next-step.
45CLIENT is a vector [mechanism user service server sasl-client-properties]
46STEP is a vector [<previous step function> <result of previous step function>]"
47 (let ((user (sasl-client-name client)))
48 (ntlm-build-auth-request user)))
49
50(defun sasl-ntlm-response (client step)
51 "SASL step function to generate a NTLM response against the server
52challenge stored in the 2nd element of STEP. Called from 'sasl-next-step."
53 (let* ((user (sasl-client-name client))
54 (passphrase
55 (sasl-read-passphrase (format "NTLM passphrase for %s: " user)))
56 (challenge (sasl-step-data step)))
57 (ntlm-build-auth-response challenge user
58 (ntlm-get-password-hashes passphrase))))
59
60(put 'sasl-ntlm 'sasl-mechanism
61 (sasl-make-mechanism "NTLM" sasl-ntlm-steps))
62
63(provide 'sasl-ntlm)
64
65;;; arch-tag: 1d9164c1-1df0-418f-b7ab-360157fd05dc
66;;; sasl-ntlm.el ends here
diff --git a/lisp/gnus/sasl.el b/lisp/gnus/sasl.el
new file mode 100644
index 00000000000..d730dddcb20
--- /dev/null
+++ b/lisp/gnus/sasl.el
@@ -0,0 +1,273 @@
1;;; sasl.el --- SASL client framework
2
3;; Copyright (C) 2000 Free Software Foundation, Inc.
4
5;; Author: Daiki Ueno <ueno@unixuser.org>
6;; Keywords: SASL
7
8;; This file is part of FLIM (Faithful Library about Internet Message).
9
10;; This program is free software; you can redistribute it and/or
11;; modify it under the terms of the GNU General Public License as
12;; published by the Free Software Foundation; either version 3, or (at
13;; your option) any later version.
14
15;; This program is distributed in the hope that it will be useful, but
16;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18;; General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with this program; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This module provides common interface functions to share several
28;; SASL mechanism drivers. The toplevel is designed to be mostly
29;; compatible with [Java-SASL].
30;;
31;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)",
32;; RFC 2222, October 1997.
33;;
34;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program
35;; Interface", draft-weltman-java-sasl-03.txt, March 2000.
36
37;;; Code:
38
39(defvar sasl-mechanisms
40 '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
41 "NTLM" "SCRAM-MD5"))
42
43(defvar sasl-mechanism-alist
44 '(("CRAM-MD5" sasl-cram)
45 ("DIGEST-MD5" sasl-digest)
46 ("PLAIN" sasl-plain)
47 ("LOGIN" sasl-login)
48 ("ANONYMOUS" sasl-anonymous)
49 ("NTLM" sasl-ntlm)
50 ("SCRAM-MD5" sasl-scram)))
51
52(defvar sasl-unique-id-function #'sasl-unique-id-function)
53
54(put 'sasl-error 'error-message "SASL error")
55(put 'sasl-error 'error-conditions '(sasl-error error))
56
57(defun sasl-error (datum)
58 (signal 'sasl-error (list datum)))
59
60;;; @ SASL client
61;;;
62
63(defun sasl-make-client (mechanism name service server)
64 "Return a newly allocated SASL client.
65NAME is name of the authorization. SERVICE is name of the service desired.
66SERVER is the fully qualified host name of the server to authenticate to."
67 (vector mechanism name service server (make-symbol "sasl-client-properties")))
68
69(defun sasl-client-mechanism (client)
70 "Return the authentication mechanism driver of CLIENT."
71 (aref client 0))
72
73(defun sasl-client-name (client)
74 "Return the authorization name of CLIENT, a string."
75 (aref client 1))
76
77(defun sasl-client-service (client)
78 "Return the service name of CLIENT, a string."
79 (aref client 2))
80
81(defun sasl-client-server (client)
82 "Return the server name of CLIENT, a string."
83 (aref client 3))
84
85(defun sasl-client-set-properties (client plist)
86 "Destructively set the properties of CLIENT.
87The second argument PLIST is the new property list."
88 (setplist (aref client 4) plist))
89
90(defun sasl-client-set-property (client property value)
91 "Add the given property/value to CLIENT."
92 (put (aref client 4) property value))
93
94(defun sasl-client-property (client property)
95 "Return the value of the PROPERTY of CLIENT."
96 (get (aref client 4) property))
97
98(defun sasl-client-properties (client)
99 "Return the properties of CLIENT."
100 (symbol-plist (aref client 4)))
101
102;;; @ SASL mechanism
103;;;
104
105(defun sasl-make-mechanism (name steps)
106 "Make an authentication mechanism.
107NAME is a IANA registered SASL mechanism name.
108STEPS is list of continuation function."
109 (vector name
110 (mapcar
111 (lambda (step)
112 (let ((symbol (make-symbol (symbol-name step))))
113 (fset symbol (symbol-function step))
114 symbol))
115 steps)))
116
117(defun sasl-mechanism-name (mechanism)
118 "Return name of MECHANISM, a string."
119 (aref mechanism 0))
120
121(defun sasl-mechanism-steps (mechanism)
122 "Return the authentication steps of MECHANISM, a list of functions."
123 (aref mechanism 1))
124
125(defun sasl-find-mechanism (mechanisms)
126 "Retrieve an apropriate mechanism object from MECHANISMS hints."
127 (let* ((sasl-mechanisms sasl-mechanisms)
128 (mechanism
129 (catch 'done
130 (while sasl-mechanisms
131 (if (member (car sasl-mechanisms) mechanisms)
132 (throw 'done (nth 1 (assoc (car sasl-mechanisms)
133 sasl-mechanism-alist))))
134 (setq sasl-mechanisms (cdr sasl-mechanisms))))))
135 (if mechanism
136 (require mechanism))
137 (get mechanism 'sasl-mechanism)))
138
139;;; @ SASL authentication step
140;;;
141
142(defun sasl-step-data (step)
143 "Return the data which STEP holds, a string."
144 (aref step 1))
145
146(defun sasl-step-set-data (step data)
147 "Store DATA string to STEP."
148 (aset step 1 data))
149
150(defun sasl-next-step (client step)
151 "Evaluate the challenge and prepare an appropriate next response.
152The data type of the value and optional 2nd argument STEP is nil or
153opaque authentication step which holds the reference to the next action
154and the current challenge. At the first time STEP should be set to nil."
155 (let* ((steps
156 (sasl-mechanism-steps
157 (sasl-client-mechanism client)))
158 (function
159 (if (vectorp step)
160 (nth 1 (memq (aref step 0) steps))
161 (car steps))))
162 (if function
163 (vector function (funcall function client step)))))
164
165(defvar sasl-read-passphrase nil)
166(defun sasl-read-passphrase (prompt)
167 (if (not sasl-read-passphrase)
168 (if (functionp 'read-passwd)
169 (setq sasl-read-passphrase 'read-passwd)
170 (if (load "passwd" t)
171 (setq sasl-read-passphrase 'read-passwd)
172 (autoload 'ange-ftp-read-passwd "ange-ftp")
173 (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
174 (funcall sasl-read-passphrase prompt))
175
176(defun sasl-unique-id ()
177 "Compute a data string which must be different each time.
178It contain at least 64 bits of entropy."
179 (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
180
181(defvar sasl-unique-id-char nil)
182
183;; stolen (and renamed) from message.el
184(defun sasl-unique-id-function ()
185 ;; Don't use microseconds from (current-time), they may be unsupported.
186 ;; Instead we use this randomly inited counter.
187 (setq sasl-unique-id-char
188 (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20)))))
189 ;; (current-time) returns 16-bit ints,
190 ;; and 2^16*25 just fits into 4 digits i base 36.
191 (* 25 25)))
192 (let ((tm (current-time)))
193 (concat
194 (sasl-unique-id-number-base36
195 (+ (car tm)
196 (lsh (% sasl-unique-id-char 25) 16)) 4)
197 (sasl-unique-id-number-base36
198 (+ (nth 1 tm)
199 (lsh (/ sasl-unique-id-char 25) 16)) 4))))
200
201(defun sasl-unique-id-number-base36 (num len)
202 (if (if (< len 0)
203 (<= num 0)
204 (= len 0))
205 ""
206 (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
207 (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
208 (% num 36))))))
209
210;;; PLAIN (RFC2595 Section 6)
211(defconst sasl-plain-steps
212 '(sasl-plain-response))
213
214(defun sasl-plain-response (client step)
215 (let ((passphrase
216 (sasl-read-passphrase
217 (format "PLAIN passphrase for %s: " (sasl-client-name client))))
218 (authenticator-name
219 (sasl-client-property
220 client 'authenticator-name))
221 (name (sasl-client-name client)))
222 (unwind-protect
223 (if (and authenticator-name
224 (not (string= authenticator-name name)))
225 (concat authenticator-name "\0" name "\0" passphrase)
226 (concat "\0" name "\0" passphrase))
227 (fillarray passphrase 0))))
228
229(put 'sasl-plain 'sasl-mechanism
230 (sasl-make-mechanism "PLAIN" sasl-plain-steps))
231
232(provide 'sasl-plain)
233
234;;; LOGIN (No specification exists)
235(defconst sasl-login-steps
236 '(ignore ;no initial response
237 sasl-login-response-1
238 sasl-login-response-2))
239
240(defun sasl-login-response-1 (client step)
241;;; (unless (string-match "^Username:" (sasl-step-data step))
242;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
243 (sasl-client-name client))
244
245(defun sasl-login-response-2 (client step)
246;;; (unless (string-match "^Password:" (sasl-step-data step))
247;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
248 (sasl-read-passphrase
249 (format "LOGIN passphrase for %s: " (sasl-client-name client))))
250
251(put 'sasl-login 'sasl-mechanism
252 (sasl-make-mechanism "LOGIN" sasl-login-steps))
253
254(provide 'sasl-login)
255
256;;; ANONYMOUS (RFC2245)
257(defconst sasl-anonymous-steps
258 '(ignore ;no initial response
259 sasl-anonymous-response))
260
261(defun sasl-anonymous-response (client step)
262 (or (sasl-client-property client 'trace)
263 (sasl-client-name client)))
264
265(put 'sasl-anonymous 'sasl-mechanism
266 (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps))
267
268(provide 'sasl-anonymous)
269
270(provide 'sasl)
271
272;;; arch-tag: 8b3326fa-4978-4fda-93e2-cb2c6255f887
273;;; sasl.el ends here
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index 33cdfe55944..c71ef32f22c 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -31,6 +31,9 @@
31(require 'mm-util) ; for mm-universal-coding-system 31(require 'mm-util) ; for mm-universal-coding-system
32(require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks 32(require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks
33 33
34(defvar gnus-score-edit-done-hook nil
35 "*Hook run at the end of closing the score buffer.")
36
34(defvar gnus-score-mode-hook nil 37(defvar gnus-score-mode-hook nil
35 "*Hook run in score mode buffers.") 38 "*Hook run in score mode buffers.")
36 39
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index 2f0e54a234b..d8bd965718d 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -27,7 +27,10 @@
27;; This library provides an elisp API for the managesieve network 27;; This library provides an elisp API for the managesieve network
28;; protocol. 28;; protocol.
29;; 29;;
30;; Currently only the CRAM-MD5 authentication mechanism is supported. 30;; It uses the SASL library for authentication, which means it
31;; supports DIGEST-MD5, CRAM-MD5, SCRAM-MD5, NTLM, PLAIN and LOGIN
32;; methods. STARTTLS is not well tested, but should be easy to get to
33;; work if someone wants.
31;; 34;;
32;; The API should be fairly obvious for anyone familiar with the 35;; The API should be fairly obvious for anyone familiar with the
33;; managesieve protocol, interface functions include: 36;; managesieve protocol, interface functions include:
@@ -69,15 +72,17 @@
69;; 72;;
70;; 2001-10-31 Committed to Oort Gnus. 73;; 2001-10-31 Committed to Oort Gnus.
71;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. 74;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd.
75;; 2002-08-03 Use SASL library.
72 76
73;;; Code: 77;;; Code:
74 78
75(require 'rfc2104) 79(require 'password)
76(or (fboundp 'md5) 80(eval-when-compile
77 (require 'md5)) 81 (require 'sasl)
82 (require 'starttls))
78(eval-and-compile 83(eval-and-compile
79 (autoload 'starttls-open-stream "starttls") 84 (autoload 'sasl-find-mechanism "sasl")
80 (autoload 'starttls-negotiate "starttls")) 85 (autoload 'starttls-open-stream "starttls"))
81 86
82;; User customizable variables: 87;; User customizable variables:
83 88
@@ -123,13 +128,22 @@ server support the stream and OPEN is a function for opening the
123stream." 128stream."
124 :group 'sieve-manage) 129 :group 'sieve-manage)
125 130
126(defcustom sieve-manage-authenticators '(cram-md5 plain) 131(defcustom sieve-manage-authenticators '(digest-md5
132 cram-md5
133 scram-md5
134 ntlm
135 plain
136 login)
127 "Priority of authenticators to consider when authenticating to server." 137 "Priority of authenticators to consider when authenticating to server."
128 :group 'sieve-manage) 138 :group 'sieve-manage)
129 139
130(defcustom sieve-manage-authenticator-alist 140(defcustom sieve-manage-authenticator-alist
131 '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth) 141 '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth)
132 (plain sieve-manage-plain-p sieve-manage-plain-auth)) 142 (digest-md5 sieve-manage-digest-md5-p sieve-manage-digest-md5-auth)
143 (scram-md5 sieve-manage-scram-md5-p sieve-manage-scram-md5-auth)
144 (ntlm sieve-manage-ntlm-p sieve-manage-ntlm-auth)
145 (plain sieve-manage-plain-p sieve-manage-plain-auth)
146 (login sieve-manage-login-p sieve-manage-login-auth))
133 "Definition of authenticators. 147 "Definition of authenticators.
134 148
135\(NAME CHECK AUTHENTICATE) 149\(NAME CHECK AUTHENTICATE)
@@ -188,38 +202,45 @@ Returns t if login was successful, nil otherwise."
188 (with-current-buffer buffer 202 (with-current-buffer buffer
189 (make-local-variable 'sieve-manage-username) 203 (make-local-variable 'sieve-manage-username)
190 (make-local-variable 'sieve-manage-password) 204 (make-local-variable 'sieve-manage-password)
191 (let (user passwd ret reason) 205 (let (user passwd ret reason passwd-key)
192 ;; (condition-case () 206 (condition-case ()
193 (while (or (not user) (not passwd)) 207 (while (or (not user) (not passwd))
194 (setq user (or sieve-manage-username 208 (setq user (or sieve-manage-username
195 (read-from-minibuffer 209 (read-from-minibuffer
196 (concat "Managesieve username for " 210 (concat "Managesieve username for "
197 sieve-manage-server ": ") 211 sieve-manage-server ": ")
198 (or user sieve-manage-default-user)))) 212 (or user sieve-manage-default-user)))
199 (setq passwd (or sieve-manage-password 213 passwd-key (concat "managesieve:" user "@" sieve-manage-server
200 (read-passwd 214 ":" sieve-manage-port)
201 (concat "Managesieve password for " user "@" 215 passwd (or sieve-manage-password
202 sieve-manage-server ": ")))) 216 (password-read (concat "Managesieve password for "
203 (when (and user passwd) 217 user "@" sieve-manage-server
204 (if (funcall loginfunc user passwd) 218 ": ")
205 (progn 219 passwd-key)))
206 (setq ret t 220 (when (y-or-n-p "Store password for this session? ")
207 sieve-manage-username user) 221 (password-cache-add passwd-key (copy-sequence passwd)))
208 (if (and (not sieve-manage-password) 222 (when (and user passwd)
209 (y-or-n-p "Store password for this session? ")) 223 (if (funcall loginfunc user passwd)
210 (setq sieve-manage-password passwd))) 224 (setq ret t
211 (if reason 225 sieve-manage-username user)
212 (message "Login failed (reason given: %s)..." reason) 226 (if reason
213 (message "Login failed...")) 227 (message "Login failed (reason given: %s)..." reason)
214 (setq reason nil) 228 (message "Login failed..."))
215 (setq passwd nil) 229 (password-cache-remove passwd-key)
216 (sit-for 1)))) 230 (setq sieve-manage-password nil)
217 ;; (quit (with-current-buffer buffer 231 (setq passwd nil)
218 ;; (setq user nil 232 (setq reason nil)
219 ;; passwd nil))) 233 (sit-for 1))))
220 ;; (error (with-current-buffer buffer 234 (quit (with-current-buffer buffer
221 ;; (setq user nil 235 (password-cache-remove passwd-key)
222 ;; passwd nil)))) 236 (setq user nil
237 passwd nil
238 sieve-manage-password nil)))
239 (error (with-current-buffer buffer
240 (password-cache-remove passwd-key)
241 (setq user nil
242 passwd nil
243 sieve-manage-password nil))))
223 ret))) 244 ret)))
224 245
225(defun sieve-manage-erase (&optional p buffer) 246(defun sieve-manage-erase (&optional p buffer)
@@ -304,60 +325,111 @@ Returns t if login was successful, nil otherwise."
304 325
305;; Authenticators 326;; Authenticators
306 327
328(defun sieve-sasl-auth (buffer mech)
329 "Login to server using the SASL MECH method."
330 (message "sieve: Authenticating using %s..." mech)
331 (if (sieve-manage-interactive-login
332 buffer
333 (lambda (user passwd)
334 (let (client step tag data rsp)
335 (setq client (sasl-make-client (sasl-find-mechanism (list mech))
336 user "sieve" sieve-manage-server))
337 (setq sasl-read-passphrase (function (lambda (prompt) passwd)))
338 (setq step (sasl-next-step client nil))
339 (setq tag
340 (sieve-manage-send
341 (concat
342 "AUTHENTICATE \""
343 mech
344 "\""
345 (and (sasl-step-data step)
346 (concat
347 " \""
348 (base64-encode-string
349 (sasl-step-data step)
350 'no-line-break)
351 "\"")))))
352 (catch 'done
353 (while t
354 (setq rsp nil)
355 (goto-char (point-min))
356 (while (null (or (progn
357 (setq rsp (sieve-manage-is-string))
358 (if (not (and rsp (looking-at
359 sieve-manage-server-eol)))
360 (setq rsp nil)
361 (goto-char (match-end 0))
362 rsp))
363 (setq rsp (sieve-manage-is-okno))))
364 (accept-process-output sieve-manage-process 1)
365 (goto-char (point-min)))
366 (sieve-manage-erase)
367 (when (sieve-manage-ok-p rsp)
368 (when (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp))
369 (sasl-step-set-data
370 step (base64-decode-string (match-string 1 (cadr rsp)))))
371 (if (and (setq step (sasl-next-step client step))
372 (setq data (sasl-step-data step)))
373 ;; We got data for server but it's finished
374 (error "Server not ready for SASL data: %s" data)
375 ;; The authentication process is finished.
376 (throw 'done t)))
377 (unless (stringp rsp)
378 (apply 'error "Server aborted SASL authentication: %s %s %s"
379 rsp))
380 (sasl-step-set-data step (base64-decode-string rsp))
381 (setq step (sasl-next-step client step))
382 (sieve-manage-send
383 (if (sasl-step-data step)
384 (concat "\""
385 (base64-encode-string (sasl-step-data step)
386 'no-line-break)
387 "\"")
388 "")))))))
389 (message "sieve: Authenticating using %s...done" mech)
390 (message "sieve: Authenticating using %s...failed" mech)))
391
392(defun sieve-manage-cram-md5-p (buffer)
393 (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
394
395(defun sieve-manage-cram-md5-auth (buffer)
396 "Login to managesieve server using the CRAM-MD5 SASL method."
397 (sieve-sasl-auth buffer "CRAM-MD5"))
398
399(defun sieve-manage-digest-md5-p (buffer)
400 (sieve-manage-capability "SASL" "DIGEST-MD5" buffer))
401
402(defun sieve-manage-digest-md5-auth (buffer)
403 "Login to managesieve server using the DIGEST-MD5 SASL method."
404 (sieve-sasl-auth buffer "DIGEST-MD5"))
405
406(defun sieve-manage-scram-md5-p (buffer)
407 (sieve-manage-capability "SASL" "SCRAM-MD5" buffer))
408
409(defun sieve-manage-scram-md5-auth (buffer)
410 "Login to managesieve server using the SCRAM-MD5 SASL method."
411 (sieve-sasl-auth buffer "SCRAM-MD5"))
412
413(defun sieve-manage-ntlm-p (buffer)
414 (sieve-manage-capability "SASL" "NTLM" buffer))
415
416(defun sieve-manage-ntlm-auth (buffer)
417 "Login to managesieve server using the NTLM SASL method."
418 (sieve-sasl-auth buffer "NTLM"))
419
307(defun sieve-manage-plain-p (buffer) 420(defun sieve-manage-plain-p (buffer)
308 (sieve-manage-capability "SASL" "PLAIN" buffer)) 421 (sieve-manage-capability "SASL" "PLAIN" buffer))
309 422
310(defun sieve-manage-plain-auth (buffer) 423(defun sieve-manage-plain-auth (buffer)
311 "Login to managesieve server using the PLAIN SASL method." 424 "Login to managesieve server using the PLAIN SASL method."
312 (let* ((done (sieve-manage-interactive-login 425 (sieve-sasl-auth buffer "PLAIN"))
313 buffer
314 (lambda (user passwd)
315 (sieve-manage-send (concat "AUTHENTICATE \"PLAIN\" \""
316 (base64-encode-string
317 (concat (char-to-string 0)
318 user
319 (char-to-string 0)
320 passwd))
321 "\""))
322 (let ((rsp (sieve-manage-parse-okno)))
323 (if (sieve-manage-ok-p rsp)
324 t
325 (setq reason (cdr-safe rsp))
326 nil))))))
327 (if done
328 (message "sieve: Authenticating using PLAIN...done")
329 (message "sieve: Authenticating using PLAIN...failed"))))
330 426
331(defun sieve-manage-cram-md5-p (buffer) 427(defun sieve-manage-login-p (buffer)
332 (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) 428 (sieve-manage-capability "SASL" "LOGIN" buffer))
333 429
334(defun sieve-manage-cram-md5-auth (buffer) 430(defun sieve-manage-login-auth (buffer)
335 "Login to managesieve server using the CRAM-MD5 SASL method." 431 "Login to managesieve server using the LOGIN SASL method."
336 (message "sieve: Authenticating using CRAM-MD5...") 432 (sieve-sasl-auth buffer "LOGIN"))
337 (let* ((done (sieve-manage-interactive-login
338 buffer
339 (lambda (user passwd)
340 (sieve-manage-send "AUTHENTICATE \"CRAM-MD5\"")
341 (sieve-manage-send
342 (concat
343 "\""
344 (base64-encode-string
345 (concat
346 user " "
347 (rfc2104-hash 'md5 64 16 passwd
348 (base64-decode-string
349 (prog1
350 (sieve-manage-parse-string)
351 (sieve-manage-erase))))))
352 "\""))
353 (let ((rsp (sieve-manage-parse-okno)))
354 (if (sieve-manage-ok-p rsp)
355 t
356 (setq reason (cdr-safe rsp))
357 nil))))))
358 (if done
359 (message "sieve: Authenticating using CRAM-MD5...done")
360 (message "sieve: Authenticating using CRAM-MD5...failed"))))
361 433
362;; Managesieve API 434;; Managesieve API
363 435
diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el
index 694cad6e77c..d12045627fb 100644
--- a/lisp/gnus/sieve-mode.el
+++ b/lisp/gnus/sieve-mode.el
@@ -51,7 +51,6 @@
51 51
52(autoload 'sieve-manage "sieve") 52(autoload 'sieve-manage "sieve")
53(autoload 'sieve-upload "sieve") 53(autoload 'sieve-upload "sieve")
54(autoload 'c-mode "cc-mode")
55(require 'easymenu) 54(require 'easymenu)
56(eval-when-compile 55(eval-when-compile
57 (require 'font-lock)) 56 (require 'font-lock))
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index 3605da590de..2d4dfba4ee6 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -145,7 +145,7 @@ require \"fileinto\";
145 (setq mode-name "SIEVE") 145 (setq mode-name "SIEVE")
146 (buffer-disable-undo (current-buffer)) 146 (buffer-disable-undo (current-buffer))
147 (setq truncate-lines t) 147 (setq truncate-lines t)
148 (easy-menu-add-item nil nil sieve-manage-mode-menu)) 148 (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map))
149 149
150(put 'sieve-manage-mode 'mode-class 'special) 150(put 'sieve-manage-mode 'mode-class 'special)
151 151
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 2b13ecd7388..b0f194893b5 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -58,24 +58,65 @@
58 "Turn :-)'s into real images." 58 "Turn :-)'s into real images."
59 :group 'gnus-visual) 59 :group 'gnus-visual)
60 60
61;; Maybe this should go. 61(defvar smiley-data-directory)
62(defcustom smiley-data-directory 62
63 (nnheader-find-etc-directory "images/smilies") 63(defcustom smiley-style
64 "Location of the smiley faces files." 64 (if (or (and (fboundp 'face-attribute)
65 (>= (face-attribute 'default :height) 160))
66 (and (fboundp 'face-height)
67 (>= (face-height 'default) 14)))
68 'medium
69 'low-color)
70 "Smiley style."
71 :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14
72 (const :tag "medium, ~10 colors" medium) ;; 16x16
73 (const :tag "dull, grayscale" grayscale));; 14x14
74 :set (lambda (symbol value)
75 (set-default symbol value)
76 (setq smiley-data-directory (smiley-directory))
77 (smiley-update-cache))
78 :initialize 'custom-initialize-default
79 :version "23.0" ;; No Gnus
80 :group 'smiley)
81
82;; For compatibility, honor the variable `smiley-data-directory' if the user
83;; has set it.
84
85(defun smiley-directory (&optional style)
86 "Return a the location of the smiley faces files.
87STYLE specifies which style to use, see `smiley-style'. If STYLE
88is nil, use `smiley-style'."
89 (unless style (setq style smiley-style))
90 (nnheader-find-etc-directory
91 (concat "images/smilies"
92 (cond ((eq smiley-style 'low-color) "")
93 ((eq smiley-style 'medium) "/medium")
94 ((eq smiley-style 'grayscale) "/grayscale")))))
95
96(defcustom smiley-data-directory (smiley-directory)
97 "*Location of the smiley faces files."
98 :set (lambda (symbol value)
99 (set-default symbol value)
100 (smiley-update-cache))
101 :initialize 'custom-initialize-default
65 :type 'directory 102 :type 'directory
66 :group 'smiley) 103 :group 'smiley)
67 104
68;; The XEmacs version has a baroque, if not rococo, set of these. 105;; The XEmacs version has a baroque, if not rococo, set of these.
69(defcustom smiley-regexp-alist 106(defcustom smiley-regexp-alist
70 '(("\\(:-?)\\)\\W" 1 "smile") 107 '(("\\(;-?)\\)\\W" 1 "blink")
71 ("\\(;-?)\\)\\W" 1 "blink")
72 ("\\(:-]\\)\\W" 1 "forced") 108 ("\\(:-]\\)\\W" 1 "forced")
73 ("\\(8-)\\)\\W" 1 "braindamaged") 109 ("\\(8-)\\)\\W" 1 "braindamaged")
74 ("\\(:-|\\)\\W" 1 "indifferent") 110 ("\\(:-|\\)\\W" 1 "indifferent")
75 ("\\(:-[/\\]\\)\\W" 1 "wry") 111 ("\\(:-[/\\]\\)\\W" 1 "wry")
76 ("\\(:-(\\)\\W" 1 "sad") 112 ("\\(:-(\\)\\W" 1 "sad")
77 ("\\(X-)\\)\\W" 1 "dead") 113 ("\\(X-)\\)\\W" 1 "dead")
78 ("\\(:-{\\)\\W" 1 "frown")) 114 ("\\(:-{\\)\\W" 1 "frown")
115 ("\\(>:-)\\)\\W" 1 "evil")
116 ("\\(;-(\\)\\W" 1 "cry")
117 ("\\(:-D\\)\\W" 1 "grin")
118 ;; "smile" must be come after "evil"
119 ("\\(\\^?:-?)\\)\\W" 1 "smile"))
79 "*A list of regexps to map smilies to images. 120 "*A list of regexps to map smilies to images.
80The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in 121The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in
81regexp to replace with IMAGE. IMAGE is the name of an image file in 122regexp to replace with IMAGE. IMAGE is the name of an image file in
diff --git a/lisp/gnus/smime-ldap.el b/lisp/gnus/smime-ldap.el
new file mode 100644
index 00000000000..882f9f80c6f
--- /dev/null
+++ b/lisp/gnus/smime-ldap.el
@@ -0,0 +1,206 @@
1;;; smime-ldap.el --- client interface to LDAP for Emacs
2
3;; Copyright (C) 1998, 1999, 2000, 2005 Free Software Foundation, Inc.
4
5;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
6;; Maintainer: Arne J,Ax(Brgensen <arne@arnested.dk>
7;; Created: February 2005
8;; Keywords: comm
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 3, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Commentary:
28
29;; This file has a slightly changed implementation of Emacs 21.3's
30;; ldap-search and ldap-search-internal from ldap.el. The changes are
31;; made to achieve compatibility with OpenLDAP v2 and to make it
32;; possible to retrieve LDAP attributes that are tagged ie ";binary".
33
34;; The file also adds a compatibility layer for Emacs and XEmacs.
35
36;;; Code:
37
38(require 'ldap)
39
40(defun smime-ldap-search (filter &optional host attributes attrsonly withdn)
41 "Perform an LDAP search.
42FILTER is the search filter in RFC1558 syntax.
43HOST is the LDAP host on which to perform the search.
44ATTRIBUTES are the specific attributes to retrieve, nil means
45retrieve all.
46ATTRSONLY, if non-nil, retrieves the attributes only, without
47the associated values.
48If WITHDN is non-nil, each entry in the result will be prepended with
49its distinguished name WITHDN.
50Additional search parameters can be specified through
51`ldap-host-parameters-alist', which see."
52 (interactive "sFilter:")
53 ;; for XEmacs
54 (if (fboundp 'ldap-search-entries)
55 (ldap-search-entries filter host attributes attrsonly)
56 ;; for Emacs 22
57 (if (>= emacs-major-version 22)
58 (cdr (ldap-search filter host attributes attrsonly))
59 ;; for Emacs 21.x
60 (or host
61 (setq host ldap-default-host)
62 (error "No LDAP host specified"))
63 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
64 result)
65 (setq result (smime-ldap-search-internal
66 (append host-plist
67 (list 'host host
68 'filter filter
69 'attributes attributes
70 'attrsonly attrsonly
71 'withdn withdn))))
72 (cdr (if ldap-ignore-attribute-codings
73 result
74 (mapcar (function
75 (lambda (record)
76 (mapcar 'ldap-decode-attribute record)))
77 result)))))))
78
79(defun smime-ldap-search-internal (search-plist)
80 "Perform a search on a LDAP server.
81SEARCH-PLIST is a property list describing the search request.
82Valid keys in that list are:
83`host' is a string naming one or more (blank-separated) LDAP servers to
84to try to connect to. Each host name may optionally be of the form HOST:PORT.
85`filter' is a filter string for the search as described in RFC 1558.
86`attributes' is a list of strings indicating which attributes to retrieve
87for each matching entry. If nil, return all available attributes.
88`attrsonly', if non-nil, indicates that only attributes are retrieved,
89not their associated values.
90`base' is the base for the search as described in RFC 1779.
91`scope' is one of the three symbols `sub', `base' or `one'.
92`binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
93`passwd' is the password to use for simple authentication.
94`deref' is one of the symbols `never', `always', `search' or `find'.
95`timelimit' is the timeout limit for the connection in seconds.
96`sizelimit' is the maximum number of matches to return.
97`withdn' if non-nil each entry in the result will be prepended with
98its distinguished name DN.
99The function returns a list of matching entries. Each entry is itself
100an alist of attribute/value pairs."
101 (let ((buf (get-buffer-create " *ldap-search*"))
102 (bufval (get-buffer-create " *ldap-value*"))
103 (host (or (plist-get search-plist 'host)
104 ldap-default-host))
105 (filter (plist-get search-plist 'filter))
106 (attributes (plist-get search-plist 'attributes))
107 (attrsonly (plist-get search-plist 'attrsonly))
108 (base (or (plist-get search-plist 'base)
109 ldap-default-base))
110 (scope (plist-get search-plist 'scope))
111 (binddn (plist-get search-plist 'binddn))
112 (passwd (plist-get search-plist 'passwd))
113 (deref (plist-get search-plist 'deref))
114 (timelimit (plist-get search-plist 'timelimit))
115 (sizelimit (plist-get search-plist 'sizelimit))
116 (withdn (plist-get search-plist 'withdn))
117 (numres 0)
118 arglist dn name value record result)
119 (if (or (null filter)
120 (equal "" filter))
121 (error "No search filter"))
122 (setq filter (cons filter attributes))
123 (save-excursion
124 (set-buffer buf)
125 (erase-buffer)
126 (if (and host
127 (not (equal "" host)))
128 (setq arglist (nconc arglist (list (format "-h%s" host)))))
129 (if (and attrsonly
130 (not (equal "" attrsonly)))
131 (setq arglist (nconc arglist (list "-A"))))
132 (if (and base
133 (not (equal "" base)))
134 (setq arglist (nconc arglist (list (format "-b%s" base)))))
135 (if (and scope
136 (not (equal "" scope)))
137 (setq arglist (nconc arglist (list (format "-s%s" scope)))))
138 (if (and binddn
139 (not (equal "" binddn)))
140 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
141 (if (and passwd
142 (not (equal "" passwd)))
143 (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
144 (if (and deref
145 (not (equal "" deref)))
146 (setq arglist (nconc arglist (list (format "-a%s" deref)))))
147 (if (and timelimit
148 (not (equal "" timelimit)))
149 (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
150 (if (and sizelimit
151 (not (equal "" sizelimit)))
152 (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
153 (eval `(call-process ldap-ldapsearch-prog
154 nil
155 buf
156 nil
157 ,@arglist
158 "-tt" ; Write values to temp files
159 "-x"
160 "-LL"
161 ; ,@ldap-ldapsearch-args
162 ,@filter))
163 (insert "\n")
164 (goto-char (point-min))
165
166 (while (re-search-forward "[\t\n\f]+ " nil t)
167 (replace-match "" nil nil))
168 (goto-char (point-min))
169
170 (if (looking-at "usage")
171 (error "Incorrect ldapsearch invocation")
172 (message "Parsing results... ")
173 (while (progn
174 (skip-chars-forward " \t\n")
175 (not (eobp)))
176 (setq dn (buffer-substring (point) (save-excursion
177 (end-of-line)
178 (point))))
179 (forward-line 1)
180 (while (looking-at (concat "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+"
181 "\\(<[\t ]*file://\\)?\\(.*\\)$"))
182 (setq name (match-string 1)
183 value (match-string 4))
184 (save-excursion
185 (set-buffer bufval)
186 (erase-buffer)
187 (insert-file-contents-literally value)
188 (delete-file value)
189 (setq value (buffer-substring (point-min) (point-max))))
190 (setq record (cons (list name value)
191 record))
192 (forward-line 1))
193 (setq result (cons (if withdn
194 (cons dn (nreverse record))
195 (nreverse record)) result))
196 (setq record nil)
197 (skip-chars-forward " \t\n")
198 (message "Parsing results... %d" numres)
199 (1+ numres))
200 (message "Parsing results... done")
201 (nreverse result)))))
202
203(provide 'smime-ldap)
204
205;; arch-tag: 87e6bc44-21fc-4e9b-a89b-f55f031f78f8
206;;; smime-ldap.el ends here
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 62d1f27b4b5..ee62fd8124b 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -28,7 +28,7 @@
28;; This library perform S/MIME operations from within Emacs. 28;; This library perform S/MIME operations from within Emacs.
29;; 29;;
30;; Functions for fetching certificates from public repositories are 30;; Functions for fetching certificates from public repositories are
31;; provided, currently only from DNS. LDAP support (via EUDC) is planned. 31;; provided, currently from DNS and LDAP.
32;; 32;;
33;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing, 33;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
34;; encryption and decryption. 34;; encryption and decryption.
@@ -117,12 +117,28 @@
117;; 2000-06-05 initial version, committed to Gnus CVS contrib/ 117;; 2000-06-05 initial version, committed to Gnus CVS contrib/
118;; 2000-10-28 retrieve certificates via DNS CERT RRs 118;; 2000-10-28 retrieve certificates via DNS CERT RRs
119;; 2001-10-14 posted to gnu.emacs.sources 119;; 2001-10-14 posted to gnu.emacs.sources
120;; 2005-02-13 retrieve certificates via LDAP
120 121
121;;; Code: 122;;; Code:
122 123
123(require 'dig) 124(require 'dig)
125(require 'smime-ldap)
126(require 'password)
124(eval-when-compile (require 'cl)) 127(eval-when-compile (require 'cl))
125 128
129(eval-and-compile
130 (cond
131 ((fboundp 'replace-in-string)
132 (defalias 'smime-replace-in-string 'replace-in-string))
133 ((fboundp 'replace-regexp-in-string)
134 (defun smime-replace-in-string (string regexp newtext &optional literal)
135 "Replace all matches for REGEXP with NEWTEXT in STRING.
136If LITERAL is non-nil, insert NEWTEXT literally. Return a new
137string containing the replacements.
138
139This is a compatibility function for different Emacsen."
140 (replace-regexp-in-string regexp newtext string nil literal)))))
141
126(defgroup smime nil 142(defgroup smime nil
127 "S/MIME configuration." 143 "S/MIME configuration."
128 :group 'mime) 144 :group 'mime)
@@ -218,6 +234,14 @@ If nil, use system defaults."
218 string) 234 string)
219 :group 'smime) 235 :group 'smime)
220 236
237(defcustom smime-ldap-host-list nil
238 "A list of LDAP hosts with S/MIME user certificates.
239If needed search base, binddn, passwd, etc. for the LDAP host
240must be set in `ldap-host-parameters-alist'."
241 :type '(repeat (string :tag "Host name"))
242 :version "23.0" ;; No Gnus
243 :group 'smime)
244
221(defvar smime-details-buffer "*OpenSSL output*") 245(defvar smime-details-buffer "*OpenSSL output*")
222 246
223;; Use mm-util? 247;; Use mm-util?
@@ -234,11 +258,13 @@ If nil, use system defaults."
234 258
235;; Password dialog function 259;; Password dialog function
236 260
237(defun smime-ask-passphrase () 261(defun smime-ask-passphrase (&optional cache-key)
238 "Asks the passphrase to unlock the secret key." 262 "Asks the passphrase to unlock the secret key.
263If `cache-key' and `password-cache' is non-nil then cache the
264password under `cache-key'."
239 (let ((passphrase 265 (let ((passphrase
240 (read-passwd 266 (password-read-and-add
241 "Passphrase for secret key (RET for no passphrase): "))) 267 "Passphrase for secret key (RET for no passphrase): " cache-key)))
242 (if (string= passphrase "") 268 (if (string= passphrase "")
243 nil 269 nil
244 passphrase))) 270 passphrase)))
@@ -270,11 +296,11 @@ certificates to include in its caar. If no additional certificates is
270included, KEYFILE may be the file containing the PEM encoded private 296included, KEYFILE may be the file containing the PEM encoded private
271key and certificate itself." 297key and certificate itself."
272 (smime-new-details-buffer) 298 (smime-new-details-buffer)
273 (let ((keyfile (or (car-safe keyfile) keyfile)) 299 (let* ((certfiles (and (cdr-safe keyfile) (cadr keyfile)))
274 (certfiles (and (cdr-safe keyfile) (cadr keyfile))) 300 (keyfile (or (car-safe keyfile) keyfile))
275 (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) 301 (buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
276 (passphrase (smime-ask-passphrase)) 302 (passphrase (smime-ask-passphrase (expand-file-name keyfile)))
277 (tmpfile (smime-make-temp-file "smime"))) 303 (tmpfile (smime-make-temp-file "smime")))
278 (if passphrase 304 (if passphrase
279 (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) 305 (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
280 (prog1 306 (prog1
@@ -408,7 +434,7 @@ Any details (stderr on success, stdout and stderr on error) are left
408in the buffer specified by `smime-details-buffer'." 434in the buffer specified by `smime-details-buffer'."
409 (smime-new-details-buffer) 435 (smime-new-details-buffer)
410 (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) 436 (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
411 CAs (passphrase (smime-ask-passphrase)) 437 CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile)))
412 (tmpfile (smime-make-temp-file "smime"))) 438 (tmpfile (smime-make-temp-file "smime")))
413 (if passphrase 439 (if passphrase
414 (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) 440 (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
@@ -521,20 +547,13 @@ A string or a list of strings is returned."
521 (caddr curkey) 547 (caddr curkey)
522 (smime-get-certfiles keyfile otherkeys))))) 548 (smime-get-certfiles keyfile otherkeys)))))
523 549
524;; Use mm-util?
525(eval-and-compile
526 (defalias 'smime-point-at-eol
527 (if (fboundp 'point-at-eol)
528 'point-at-eol
529 'line-end-position)))
530
531(defun smime-buffer-as-string-region (b e) 550(defun smime-buffer-as-string-region (b e)
532 "Return each line in region between B and E as a list of strings." 551 "Return each line in region between B and E as a list of strings."
533 (save-excursion 552 (save-excursion
534 (goto-char b) 553 (goto-char b)
535 (let (res) 554 (let (res)
536 (while (< (point) e) 555 (while (< (point) e)
537 (let ((str (buffer-substring (point) (smime-point-at-eol)))) 556 (let ((str (buffer-substring (point) (point-at-eol))))
538 (unless (string= "" str) 557 (unless (string= "" str)
539 (push str res))) 558 (push str res)))
540 (forward-line)) 559 (forward-line))
@@ -548,6 +567,7 @@ A string or a list of strings is returned."
548 mailaddr)) 567 mailaddr))
549 568
550(defun smime-cert-by-dns (mail) 569(defun smime-cert-by-dns (mail)
570 "Find certificate via DNS for address MAIL."
551 (let* ((dig-dns-server smime-dns-server) 571 (let* ((dig-dns-server smime-dns-server)
552 (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc")) 572 (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
553 (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) 573 (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
@@ -568,6 +588,50 @@ A string or a list of strings is returned."
568 (kill-buffer digbuf) 588 (kill-buffer digbuf)
569 retbuf)) 589 retbuf))
570 590
591(defun smime-cert-by-ldap-1 (mail host)
592 "Get cetificate for MAIL from the ldap server at HOST."
593 (let ((ldapresult (smime-ldap-search (concat "mail=" mail)
594 host '("userCertificate") nil))
595 (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
596 cert)
597 (if (and (>= (length ldapresult) 1)
598 (> (length (cadaar ldapresult)) 0))
599 (with-current-buffer retbuf
600 ;; Certificates on LDAP servers _should_ be in DER format,
601 ;; but there are some servers out there that distributes the
602 ;; certificates in PEM format (with or without
603 ;; header/footer) so we try to handle them anyway.
604 (if (or (string= (substring (cadaar ldapresult) 0 27)
605 "-----BEGIN CERTIFICATE-----")
606 (string= (substring (cadaar ldapresult) 0 3)
607 "MII"))
608 (setq cert
609 (smime-replace-in-string
610 (cadaar ldapresult)
611 (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|"
612 "-----END CERTIFICATE-----\\)")
613 "" t))
614 (setq cert (base64-encode-string (cadaar ldapresult) t)))
615 (insert "-----BEGIN CERTIFICATE-----\n")
616 (let ((i 0) (len (length cert)))
617 (while (> (- len 64) i)
618 (insert (substring cert i (+ i 64)) "\n")
619 (setq i (+ i 64)))
620 (insert (substring cert i len) "\n"))
621 (insert "-----END CERTIFICATE-----\n"))
622 (kill-buffer retbuf)
623 (setq retbuf nil))
624 retbuf))
625
626(defun smime-cert-by-ldap (mail)
627 "Find certificate via LDAP for address MAIL."
628 (if smime-ldap-host-list
629 (catch 'certbuf
630 (dolist (host smime-ldap-host-list)
631 (let ((retbuf (smime-cert-by-ldap-1 mail host)))
632 (when retbuf
633 (throw 'certbuf retbuf)))))))
634
571;; User interface. 635;; User interface.
572 636
573(defvar smime-buffer "*SMIME*") 637(defvar smime-buffer "*SMIME*")
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index ce891a11d49..51ad9b8649e 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -2,8 +2,8 @@
2 2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4 4
5;; Author: Teodor Zlatanov <tzz@lifelogs.com> 5;; Author: Ted Zlatanov <tzz@lifelogs.com>
6;; Keywords: network 6;; Keywords: network, spam, mail, gmane, report
7 7
8;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
9 9
@@ -80,26 +80,92 @@ The function must accept the arguments `host' and `report'."
80 :type 'file 80 :type 'file
81 :group 'spam-report) 81 :group 'spam-report)
82 82
83(defcustom spam-report-resend-to nil
84 "Email address that spam articles are resent to when reporting.
85If not set, the user will be prompted to enter a value which will be
86saved for future use."
87 :type 'string
88 :group 'spam-report)
89
83(defvar spam-report-url-ping-temp-agent-function nil 90(defvar spam-report-url-ping-temp-agent-function nil
84 "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. 91 "Internal variable for `spam-report-agentize' and `spam-report-deagentize'.
85This variable will store the value of `spam-report-url-ping-function' from 92This variable will store the value of `spam-report-url-ping-function' from
86before `spam-report-agentize' was run, so that `spam-report-deagentize' can 93before `spam-report-agentize' was run, so that `spam-report-deagentize' can
87undo that change.") 94undo that change.")
88 95
89(defun spam-report-gmane (&rest articles) 96(defun spam-report-resend (articles &optional ham)
90 "Report an article as spam through Gmane" 97 "Report an article as spam by resending via email.
98Reports is as ham when HAM is set."
99 (dolist (article articles)
100 (gnus-message 6
101 "Reporting %s article %d to <%s>..."
102 (if ham "ham" "spam")
103 article spam-report-resend-to)
104 (unless spam-report-resend-to
105 (customize-set-variable
106 spam-report-resend-to
107 (read-from-minibuffer "email address to resend SPAM/HAM to? ")))
108 ;; This is ganked from the `gnus-summary-resend-message' function.
109 ;; It involves rendering the SPAM, which is undesirable, but there does
110 ;; not seem to be a nicer way to achieve this.
111 ;; select this particular article
112 (gnus-summary-select-article nil nil nil article)
113 ;; resend it to the destination address
114 (save-excursion
115 (set-buffer gnus-original-article-buffer)
116 (message-resend spam-report-resend-to))))
117
118(defun spam-report-resend-ham (articles)
119 "Report an article as ham by resending via email."
120 (spam-report-resend articles t))
121
122(defun spam-report-gmane-ham (&rest articles)
123 "Report ARTICLES as ham (unregister) through Gmane."
124 (interactive (gnus-summary-work-articles current-prefix-arg))
125 (dolist (article articles)
126 (spam-report-gmane-internal t article)))
127
128(defun spam-report-gmane-spam (&rest articles)
129 "Report ARTICLES as spam through Gmane."
130 (interactive (gnus-summary-work-articles current-prefix-arg))
91 (dolist (article articles) 131 (dolist (article articles)
92 (when (and gnus-newsgroup-name 132 (spam-report-gmane-internal nil article)))
93 (or (null spam-report-gmane-regex) 133
94 (string-match spam-report-gmane-regex gnus-newsgroup-name))) 134;; `spam-report-gmane' was an interactive entry point, so we should provide an
95 (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article) 135;; alias.
96 (if spam-report-gmane-use-article-number 136(defalias 'spam-report-gmane 'spam-report-gmane-spam)
97 (spam-report-url-ping 137
98 "spam.gmane.org" 138(defun spam-report-gmane-internal (unspam article)
99 (format "/%s:%d" 139 "Report ARTICLE as spam or not-spam through Gmane, depending on UNSPAM."
100 (gnus-group-real-name gnus-newsgroup-name) 140 (when (and gnus-newsgroup-name
101 article)) 141 (or (null spam-report-gmane-regex)
142 (string-match spam-report-gmane-regex gnus-newsgroup-name)))
143 (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org")))
144 (gnus-message 6 "Reporting article %d to %s..." article rpt-host)
145 (cond
146 ;; Special-case nnweb groups -- these have the URL to use in
147 ;; the Xref headers.
148 ((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb)
149 (spam-report-url-ping
150 rpt-host
151 (concat
152 "/"
153 (gnus-replace-in-string
154 (gnus-replace-in-string
155 (gnus-replace-in-string
156 (mail-header-xref (gnus-summary-article-header article))
157 "/raw" ":silent")
158 "^.*article.gmane.org/" "")
159 "/" ":"))))
160 (spam-report-gmane-use-article-number
161 (spam-report-url-ping
162 rpt-host
163 (format "/%s:%d"
164 (gnus-group-real-name gnus-newsgroup-name)
165 article)))
166 (t
102 (with-current-buffer nntp-server-buffer 167 (with-current-buffer nntp-server-buffer
168 (erase-buffer)
103 (gnus-request-head article gnus-newsgroup-name) 169 (gnus-request-head article gnus-newsgroup-name)
104 (let ((case-fold-search t) 170 (let ((case-fold-search t)
105 field host report url) 171 field host report url)
@@ -111,25 +177,33 @@ undo that change.")
111 ;; There might be more than one Archived-At header so we need to 177 ;; There might be more than one Archived-At header so we need to
112 ;; find (and transform) the one related to Gmane. 178 ;; find (and transform) the one related to Gmane.
113 (setq field (or (gnus-fetch-field "X-Report-Spam") 179 (setq field (or (gnus-fetch-field "X-Report-Spam")
180 (gnus-fetch-field "X-Report-Unspam")
114 (gnus-fetch-field "Archived-At"))) 181 (gnus-fetch-field "Archived-At")))
115 (setq host (progn 182 (if (not (stringp field))
116 (string-match 183 (if (and (setq field (gnus-fetch-field "Xref"))
117 (concat "http://\\([a-z]+\\.gmane\\.org\\)" 184 (string-match "[^ ]+ +\\([^ ]+\\)" field))
118 "\\(/[^:/]+[:/][0-9]+\\)") 185 (setq report (concat "/" (match-string 1 field))
119 field) 186 host rpt-host))
120 (match-string 1 field))) 187 (setq host
121 (setq report (match-string 2 field)) 188 (progn
122 (when (string-equal "permalink.gmane.org" host) 189 (string-match
123 (setq host "spam.gmane.org") 190 (concat "http://\\([a-z]+\\.gmane\\.org\\)"
124 (setq report (gnus-replace-in-string 191 "\\(/[^:/]+[:/][0-9]+\\)")
125 report "/\\([0-9]+\\)$" ":\\1"))) 192 field)
126 (setq url (format "http://%s%s" host report)) 193 (match-string 1 field)))
194 (setq report (match-string 2 field)))
195 (when host
196 (when (string-equal "permalink.gmane.org" host)
197 (setq host rpt-host)
198 (setq report (gnus-replace-in-string
199 report "/\\([0-9]+\\)$" ":\\1")))
200 (setq url (format "http://%s%s" host report)))
127 (if (not (and host report url)) 201 (if (not (and host report url))
128 (gnus-message 202 (gnus-message
129 3 "Could not find a spam report header in article %d..." 203 3 "Could not find a spam report header in article %d..."
130 article) 204 article)
131 (gnus-message 7 "Reporting spam through URL %s..." url) 205 (gnus-message 7 "Reporting article through URL %s..." url)
132 (spam-report-url-ping host report)))))))) 206 (spam-report-url-ping host report)))))))))
133 207
134(defun spam-report-url-ping (host report) 208(defun spam-report-url-ping (host report)
135 "Ping a host through HTTP, addressing a specific GET resource using 209 "Ping a host through HTTP, addressing a specific GET resource using
@@ -139,6 +213,24 @@ the function specified by `spam-report-url-ping-function'."
139 ;; report: "/gmane.some.group:123456" 213 ;; report: "/gmane.some.group:123456"
140 (funcall spam-report-url-ping-function host report)) 214 (funcall spam-report-url-ping-function host report))
141 215
216(defcustom spam-report-user-mail-address
217 (and (stringp user-mail-address)
218 (gnus-replace-in-string user-mail-address "@" "<at>"))
219 "Mail address of this user used for spam reports to Gmane.
220This is initialized based on `user-mail-address'."
221 :type '(choice string
222 (const :tag "Don't expose address" nil))
223 :version "23.0" ;; No Gnus
224 :group 'spam-report)
225
226(defvar spam-report-user-agent
227 (if spam-report-user-mail-address
228 (format "%s (%s) %s" "spam-report.el"
229 spam-report-user-mail-address
230 (gnus-extended-version))
231 (format "%s %s" "spam-report.el"
232 (gnus-extended-version))))
233
142(defun spam-report-url-ping-plain (host report) 234(defun spam-report-url-ping-plain (host report)
143 "Ping a host through HTTP, addressing a specific GET resource." 235 "Ping a host through HTTP, addressing a specific GET resource."
144 (let ((tcp-connection)) 236 (let ((tcp-connection))
@@ -153,8 +245,12 @@ the function specified by `spam-report-url-ping-function'."
153 (set-marker (process-mark tcp-connection) (point-min)) 245 (set-marker (process-mark tcp-connection) (point-min))
154 (process-send-string 246 (process-send-string
155 tcp-connection 247 tcp-connection
156 (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n" 248 (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n"
157 report (gnus-extended-version) host))))) 249 report spam-report-user-agent host))
250 ;; Wait until we get something so we don't DOS the host.
251 (while (and (memq (process-status tcp-connection) '(open run))
252 (zerop (buffer-size)))
253 (accept-process-output tcp-connection)))))
158 254
159;;;###autoload 255;;;###autoload
160(defun spam-report-process-queue (&optional file keep) 256(defun spam-report-process-queue (&optional file keep)
@@ -183,7 +279,7 @@ symbol `ask', query before flushing the queue file."
183 (goto-char (point-min)) 279 (goto-char (point-min))
184 (while (and (not (eobp)) 280 (while (and (not (eobp))
185 (re-search-forward 281 (re-search-forward
186 "http://\\([^/]+\\)\\(/.*\\) *$" (gnus-point-at-eol) t)) 282 "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t))
187 (funcall spam-report-url-ping-function (match-string 1) (match-string 2)) 283 (funcall spam-report-url-ping-function (match-string 1) (match-string 2))
188 (forward-line 1)) 284 (forward-line 1))
189 (if (or (eq keep nil) 285 (if (or (eq keep nil)
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 4a13548fcab..5b57f376cf8 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -122,6 +122,7 @@
122 122
123 123
124;;; Code: 124;;; Code:
125(require 'mail-parse)
125 126
126(defvar gnus-original-article-buffer) 127(defvar gnus-original-article-buffer)
127 128
@@ -163,17 +164,53 @@ This variable says how many characters this will be."
163 :group 'spam-stat) 164 :group 'spam-stat)
164 165
165(defcustom spam-stat-split-fancy-spam-group "mail.spam" 166(defcustom spam-stat-split-fancy-spam-group "mail.spam"
166 "Name of the group where spam should be stored, if 167 "Name of the group where spam should be stored.
167`spam-stat-split-fancy' is used in fancy splitting rules. Has no 168If `spam-stat-split-fancy' is used in fancy splitting rules. Has
168effect when spam-stat is invoked through spam.el." 169no effect when spam-stat is invoked through spam.el."
169 :type 'string 170 :type 'string
170 :group 'spam-stat) 171 :group 'spam-stat)
171 172
172(defcustom spam-stat-split-fancy-spam-threshhold 0.9 173(defcustom spam-stat-split-fancy-spam-threshold 0.9
173 "Spam score threshhold in spam-stat-split-fancy." 174 "Spam score threshold in spam-stat-split-fancy."
174 :type 'number 175 :type 'number
175 :group 'spam-stat) 176 :group 'spam-stat)
176 177
178(defcustom spam-stat-washing-hook nil
179 "Hook applied to each message before analysis."
180 :type 'hook
181 :group 'spam-stat)
182
183(defcustom spam-stat-score-buffer-user-functions nil
184 "List of additional scoring functions.
185Called one by one on the buffer.
186
187If all of these functions return non-nil answers, these numerical
188answers are added to the computed spam stat score on the buffer. If
189you defun such functions, make sure they don't return the buffer in a
190narrowed state or such: use, for example, `save-excursion'. Each of
191your functions is also passed the initial spam-stat score which might
192aid in your scoring.
193
194Also be careful when defining such functions. If they take a long
195time, they will slow down your mail splitting. Thus, if the buffer is
196large, don't forget to use smaller regions, by wrapping your work in,
197say, `with-spam-stat-max-buffer-size'."
198 :type '(repeat sexp)
199 :group 'spam-stat)
200
201(defcustom spam-stat-process-directory-age 90
202 "Max. age of files to be processed in directory, in days.
203When using `spam-stat-process-spam-directory' or
204`spam-stat-process-non-spam-directory', only files that have
205been touched in this many days will be considered. Without
206this filter, re-training spam-stat with several thousand messages
207will start to take a very long time."
208 :type 'number
209 :group 'spam-stat)
210
211(defvar spam-stat-last-saved-at nil
212 "Time stamp of last change of spam-stat-file on this run")
213
177(defvar spam-stat-syntax-table 214(defvar spam-stat-syntax-table
178 (let ((table (copy-syntax-table text-mode-syntax-table))) 215 (let ((table (copy-syntax-table text-mode-syntax-table)))
179 (modify-syntax-entry ?- "w" table) 216 (modify-syntax-entry ?- "w" table)
@@ -196,52 +233,24 @@ This is set by hooking into Gnus.")
196(defvar spam-stat-buffer-name " *spam stat buffer*" 233(defvar spam-stat-buffer-name " *spam stat buffer*"
197 "Name of the `spam-stat-buffer'.") 234 "Name of the `spam-stat-buffer'.")
198 235
199;; Functions missing in Emacs 20 236(defvar spam-stat-coding-system
200 237 (if (mm-coding-system-p 'emacs-mule) 'emacs-mule 'raw-text)
201(when (memq nil (mapcar 'fboundp 238 "Coding system used for `spam-stat-file'.")
202 '(gethash hash-table-count make-hash-table
203 mapc puthash)))
204 (require 'cl)
205 (unless (fboundp 'puthash)
206 ;; alias puthash is missing from Emacs 20 cl-extra.el
207 (defalias 'puthash 'cl-puthash)))
208
209(eval-when-compile
210 (unless (fboundp 'with-syntax-table)
211 ;; Imported from Emacs 21.2
212 (defmacro with-syntax-table (table &rest body) "\
213Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
214The syntax table of the current buffer is saved, BODY is evaluated, and the
215saved table is restored, even in case of an abnormal exit.
216Value is what BODY returns."
217 (let ((old-table (make-symbol "table"))
218 (old-buffer (make-symbol "buffer")))
219 `(let ((,old-table (syntax-table))
220 (,old-buffer (current-buffer)))
221 (unwind-protect
222 (progn
223 (set-syntax-table (copy-syntax-table ,table))
224 ,@body)
225 (save-current-buffer
226 (set-buffer ,old-buffer)
227 (set-syntax-table ,old-table))))))))
228 239
229;; Hooking into Gnus 240;; Hooking into Gnus
230 241
231(defun spam-stat-store-current-buffer () 242(defun spam-stat-store-current-buffer ()
232 "Store a copy of the current buffer in `spam-stat-buffer'." 243 "Store a copy of the current buffer in `spam-stat-buffer'."
233 (save-excursion 244 (let ((buf (current-buffer)))
234 (let ((str (buffer-string))) 245 (with-current-buffer (get-buffer-create spam-stat-buffer-name)
235 (set-buffer (get-buffer-create spam-stat-buffer-name))
236 (erase-buffer) 246 (erase-buffer)
237 (insert str) 247 (insert-buffer-substring buf)
238 (setq spam-stat-buffer (current-buffer))))) 248 (setq spam-stat-buffer (current-buffer)))))
239 249
240(defun spam-stat-store-gnus-article-buffer () 250(defun spam-stat-store-gnus-article-buffer ()
241 "Store a copy of the current article in `spam-stat-buffer'. 251 "Store a copy of the current article in `spam-stat-buffer'.
242This uses `gnus-article-buffer'." 252This uses `gnus-article-buffer'."
243 (save-excursion 253 (with-current-buffer gnus-original-article-buffer
244 (set-buffer gnus-original-article-buffer)
245 (spam-stat-store-current-buffer))) 254 (spam-stat-store-current-buffer)))
246 255
247;; Data -- not using defstruct in order to save space and time 256;; Data -- not using defstruct in order to save space and time
@@ -259,6 +268,9 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
259(defvar spam-stat-nbad 0 268(defvar spam-stat-nbad 0
260 "The number of bad mails in the dictionary.") 269 "The number of bad mails in the dictionary.")
261 270
271(defvar spam-stat-error-holder nil
272 "A holder for condition-case errors while scoring buffers.")
273
262(defsubst spam-stat-good (entry) 274(defsubst spam-stat-good (entry)
263 "Return the number of times this word belongs to good mails." 275 "Return the number of times this word belongs to good mails."
264 (aref entry 0)) 276 (aref entry 0))
@@ -313,7 +325,7 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
313;; Parsing 325;; Parsing
314 326
315(defmacro with-spam-stat-max-buffer-size (&rest body) 327(defmacro with-spam-stat-max-buffer-size (&rest body)
316 "Narrows the buffer down to the first 4k characters, then evaluates BODY." 328 "Narrow the buffer down to the first 4k characters, then evaluate BODY."
317 `(save-restriction 329 `(save-restriction
318 (when (> (- (point-max) 330 (when (> (- (point-max)
319 (point-min)) 331 (point-min))
@@ -324,6 +336,7 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
324 336
325(defun spam-stat-buffer-words () 337(defun spam-stat-buffer-words ()
326 "Return a hash table of words and number of occurrences in the buffer." 338 "Return a hash table of words and number of occurrences in the buffer."
339 (run-hooks 'spam-stat-washing-hook)
327 (with-spam-stat-max-buffer-size 340 (with-spam-stat-max-buffer-size
328 (with-syntax-table spam-stat-syntax-table 341 (with-syntax-table spam-stat-syntax-table
329 (goto-char (point-min)) 342 (goto-char (point-min))
@@ -372,7 +385,7 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
372 (lambda (word count) 385 (lambda (word count)
373 (let ((entry (gethash word spam-stat))) 386 (let ((entry (gethash word spam-stat)))
374 (if (not entry) 387 (if (not entry)
375 (error "This buffer has unknown words in it") 388 (gnus-message 8 "This buffer has unknown words in it")
376 (spam-stat-set-good entry (- (spam-stat-good entry) count)) 389 (spam-stat-set-good entry (- (spam-stat-good entry) count))
377 (spam-stat-set-bad entry (+ (spam-stat-bad entry) count)) 390 (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
378 (spam-stat-set-score entry (spam-stat-compute-score entry)) 391 (spam-stat-set-score entry (spam-stat-compute-score entry))
@@ -388,7 +401,7 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
388 (lambda (word count) 401 (lambda (word count)
389 (let ((entry (gethash word spam-stat))) 402 (let ((entry (gethash word spam-stat)))
390 (if (not entry) 403 (if (not entry)
391 (error "This buffer has unknown words in it") 404 (gnus-message 8 "This buffer has unknown words in it")
392 (spam-stat-set-good entry (+ (spam-stat-good entry) count)) 405 (spam-stat-set-good entry (+ (spam-stat-good entry) count))
393 (spam-stat-set-bad entry (- (spam-stat-bad entry) count)) 406 (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
394 (spam-stat-set-score entry (spam-stat-compute-score entry)) 407 (spam-stat-set-score entry (spam-stat-compute-score entry))
@@ -403,28 +416,38 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
403With a prefix argument save unconditionally." 416With a prefix argument save unconditionally."
404 (interactive "P") 417 (interactive "P")
405 (when (or force spam-stat-dirty) 418 (when (or force spam-stat-dirty)
406 (with-temp-buffer 419 (let ((coding-system-for-write spam-stat-coding-system))
407 (let ((standard-output (current-buffer)) 420 (with-temp-file spam-stat-file
408 (font-lock-maximum-size 0)) 421 (let ((standard-output (current-buffer))
409 (insert "(setq spam-stat-ngood " 422 (font-lock-maximum-size 0))
410 (number-to-string spam-stat-ngood) 423 (insert (format ";-*- coding: %s; -*-\n" spam-stat-coding-system))
411 " spam-stat-nbad " 424 (insert (format "(setq spam-stat-ngood %d spam-stat-nbad %d
412 (number-to-string spam-stat-nbad) 425spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood spam-stat-nbad))
413 " spam-stat (spam-stat-to-hash-table '(") 426 (maphash (lambda (word entry)
414 (maphash (lambda (word entry) 427 (prin1 (list word
415 (prin1 (list word 428 (spam-stat-good entry)
416 (spam-stat-good entry) 429 (spam-stat-bad entry))))
417 (spam-stat-bad entry)))) 430 spam-stat)
418 spam-stat) 431 (insert ")))"))))
419 (insert ")))") 432 (message "Saved %s." spam-stat-file)
420 (write-file spam-stat-file))) 433 (setq spam-stat-dirty nil
421 (setq spam-stat-dirty nil))) 434 spam-stat-last-saved-at (nth 5 (file-attributes spam-stat-file)))))
422 435
423(defun spam-stat-load () 436(defun spam-stat-load ()
424 "Read the `spam-stat' hash table from disk." 437 "Read the `spam-stat' hash table from disk."
425 ;; TODO: maybe we should warn the user if spam-stat-dirty is t? 438 ;; TODO: maybe we should warn the user if spam-stat-dirty is t?
426 (load-file spam-stat-file) 439 (let ((coding-system-for-read spam-stat-coding-system))
427 (setq spam-stat-dirty nil)) 440 (cond (spam-stat-dirty (message "Spam stat not loaded: spam-stat-dirty t"))
441 ((or (not (boundp 'spam-stat-last-saved-at))
442 (null spam-stat-last-saved-at)
443 (not (equal spam-stat-last-saved-at
444 (nth 5 (file-attributes spam-stat-file)))))
445 (progn
446 (load-file spam-stat-file)
447 (setq spam-stat-dirty nil
448 spam-stat-last-saved-at
449 (nth 5 (file-attributes spam-stat-file)))))
450 (t (message "Spam stat file not loaded: no change in disk..")))))
428 451
429(defun spam-stat-to-hash-table (entries) 452(defun spam-stat-to-hash-table (entries)
430 "Turn list ENTRIES into a hash table and store as `spam-stat'. 453 "Turn list ENTRIES into a hash table and store as `spam-stat'.
@@ -433,7 +456,8 @@ the word string, NGOOD is the number of good mails it has appeared in,
433NBAD is the number of bad mails it has appeared in, GOOD is the number 456NBAD is the number of bad mails it has appeared in, GOOD is the number
434of times it appeared in good mails, and BAD is the number of times it 457of times it appeared in good mails, and BAD is the number of times it
435has appeared in bad mails." 458has appeared in bad mails."
436 (let ((table (make-hash-table :test 'equal))) 459 (let ((table (make-hash-table :size (length entries)
460 :test 'equal)))
437 (mapc (lambda (l) 461 (mapc (lambda (l)
438 (puthash (car l) 462 (puthash (car l)
439 (spam-stat-make-entry (nth 1 l) (nth 2 l)) 463 (spam-stat-make-entry (nth 1 l) (nth 2 l))
@@ -466,46 +490,73 @@ The default score for unknown words is stored in
466These are the words whose spam-stat differs the most from 0.5. 490These are the words whose spam-stat differs the most from 0.5.
467The list returned contains elements of the form \(WORD SCORE DIFF), 491The list returned contains elements of the form \(WORD SCORE DIFF),
468where DIFF is the difference between SCORE and 0.5." 492where DIFF is the difference between SCORE and 0.5."
469 (with-spam-stat-max-buffer-size 493 (let (result word score)
470 (with-syntax-table spam-stat-syntax-table 494 (maphash (lambda (word ignore)
471 (let (result word score) 495 (setq score (spam-stat-score-word word)
472 (maphash (lambda (word ignore) 496 result (cons (list word score (abs (- score 0.5)))
473 (setq score (spam-stat-score-word word) 497 result)))
474 result (cons (list word score (abs (- score 0.5))) 498 (spam-stat-buffer-words))
475 result))) 499 (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a)))))
476 (spam-stat-buffer-words)) 500 (setcdr (nthcdr 14 result) nil)
477 (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a))))) 501 result))
478 (setcdr (nthcdr 14 result) nil)
479 result))))
480 502
481(defun spam-stat-score-buffer () 503(defun spam-stat-score-buffer ()
482 "Return a score describing the spam-probability for this buffer." 504 "Return a score describing the spam-probability for this buffer.
505Add user supplied modifications if supplied."
506 (interactive) ; helps in debugging.
483 (setq spam-stat-score-data (spam-stat-buffer-words-with-scores)) 507 (setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
484 (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data)) 508 (let* ((probs (mapcar 'cadr spam-stat-score-data))
485 (prod (apply #'* probs))) 509 (prod (apply #'* probs))
486 (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x)) 510 (score0
487 probs)))))) 511 (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
512 probs)))))
513 (score1s
514 (condition-case
515 spam-stat-error-holder
516 (spam-stat-score-buffer-user score0)
517 (error nil)))
518 (ans
519 (if score1s (+ score0 score1s) score0)))
520 (when (interactive-p)
521 (message "%S" ans))
522 ans))
523
524(defun spam-stat-score-buffer-user (&rest args)
525 (let* ((scores
526 (mapcar
527 (lambda (fn)
528 (apply fn args))
529 spam-stat-score-buffer-user-functions)))
530 (if (memq nil scores) nil
531 (apply #'+ scores))))
488 532
489(defun spam-stat-split-fancy () 533(defun spam-stat-split-fancy ()
490 "Return the name of the spam group if the current mail is spam. 534 "Return the name of the spam group if the current mail is spam.
491Use this function on `nnmail-split-fancy'. If you are interested in 535Use this function on `nnmail-split-fancy'. If you are interested in
492the raw data used for the last run of `spam-stat-score-buffer', 536the raw data used for the last run of `spam-stat-score-buffer',
493check the variable `spam-stat-score-data'." 537check the variable `spam-stat-score-data'."
494 (condition-case var 538 (condition-case spam-stat-error-holder
495 (progn 539 (progn
496 (set-buffer spam-stat-buffer) 540 (set-buffer spam-stat-buffer)
497 (goto-char (point-min)) 541 (goto-char (point-min))
498 (when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshhold) 542 (when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshold)
499 (when (boundp 'nnmail-split-trace) 543 (when (boundp 'nnmail-split-trace)
500 (mapc (lambda (entry) 544 (mapc (lambda (entry)
501 (push entry nnmail-split-trace)) 545 (push entry nnmail-split-trace))
502 spam-stat-score-data)) 546 spam-stat-score-data))
503 spam-stat-split-fancy-spam-group)) 547 spam-stat-split-fancy-spam-group))
504 (error (message "Error in spam-stat-split-fancy: %S" var) 548 (error (message "Error in spam-stat-split-fancy: %S" spam-stat-error-holder)
505 nil))) 549 nil)))
506 550
507;; Testing 551;; Testing
508 552
553(defun spam-stat-strip-xref ()
554 "Strip the the Xref header."
555 (save-restriction
556 (mail-narrow-to-head)
557 (when (re-search-forward "^Xref:.*\n" nil t)
558 (delete-region (match-beginning 0) (match-end 0)))))
559
509(defun spam-stat-process-directory (dir func) 560(defun spam-stat-process-directory (dir func)
510 "Process all the regular files in directory DIR using function FUNC." 561 "Process all the regular files in directory DIR using function FUNC."
511 (let* ((files (directory-files dir t "^[^.]")) 562 (let* ((files (directory-files dir t "^[^.]"))
@@ -515,10 +566,13 @@ check the variable `spam-stat-score-data'."
515 (dolist (f files) 566 (dolist (f files)
516 (when (and (file-readable-p f) 567 (when (and (file-readable-p f)
517 (file-regular-p f) 568 (file-regular-p f)
518 (> (nth 7 (file-attributes f)) 0)) 569 (> (nth 7 (file-attributes f)) 0)
570 (< (time-to-number-of-days (time-since (nth 5 (file-attributes f))))
571 spam-stat-process-directory-age))
519 (setq count (1+ count)) 572 (setq count (1+ count))
520 (message "Reading %s: %.2f%%" dir (/ count max)) 573 (message "Reading %s: %.2f%%" dir (/ count max))
521 (insert-file-contents f) 574 (insert-file-contents-literally f)
575 (spam-stat-strip-xref)
522 (funcall func) 576 (funcall func)
523 (erase-buffer)))))) 577 (erase-buffer))))))
524 578
@@ -537,13 +591,19 @@ check the variable `spam-stat-score-data'."
537 (interactive) 591 (interactive)
538 (hash-table-count spam-stat)) 592 (hash-table-count spam-stat))
539 593
540(defun spam-stat-test-directory (dir) 594(defun spam-stat-test-directory (dir &optional verbose)
541 "Test all the regular files in directory DIR for spam. 595 "Test all the regular files in directory DIR for spam.
542If the result is 1.0, then all files are considered spam. 596If the result is 1.0, then all files are considered spam.
543If the result is 0.0, non of the files is considered spam. 597If the result is 0.0, non of the files is considered spam.
544You can use this to determine error rates." 598You can use this to determine error rates.
545 (interactive "D") 599
600If VERBOSE is non-nil display names of files detected as spam or
601non-spam in a temporary buffer. If it is the symbol `ham',
602display non-spam files; otherwise display spam files."
603 (interactive "DDirectory: ")
546 (let* ((files (directory-files dir t "^[^.]")) 604 (let* ((files (directory-files dir t "^[^.]"))
605 display-files
606 buffer-score
547 (total (length files)) 607 (total (length files))
548 (score 0.0); float 608 (score 0.0); float
549 (max (/ total 100.0)); float 609 (max (/ total 100.0)); float
@@ -554,12 +614,22 @@ You can use this to determine error rates."
554 (file-regular-p f) 614 (file-regular-p f)
555 (> (nth 7 (file-attributes f)) 0)) 615 (> (nth 7 (file-attributes f)) 0))
556 (setq count (1+ count)) 616 (setq count (1+ count))
557 (message "Reading %.2f%%, score %.2f%%" 617 (message "Reading %.2f%%, score %.2f"
558 (/ count max) (/ score count)) 618 (/ count max) (/ score count))
559 (insert-file-contents f) 619 (insert-file-contents-literally f)
560 (when (> (spam-stat-score-buffer) 0.9) 620 (setq buffer-score (spam-stat-score-buffer))
621 (when (> buffer-score 0.9)
561 (setq score (1+ score))) 622 (setq score (1+ score)))
623 (when verbose
624 (if (> buffer-score 0.9)
625 (unless (eq verbose 'ham) (push f display-files))
626 (when (eq verbose 'ham) (push f display-files))))
562 (erase-buffer)))) 627 (erase-buffer))))
628 (when display-files
629 (with-output-to-temp-buffer "*spam-stat results*"
630 (dolist (file display-files)
631 (princ file)
632 (terpri))))
563 (message "Final score: %d / %d = %f" score total (/ score total)))) 633 (message "Final score: %d / %d = %f" score total (/ score total))))
564 634
565;; Shrinking the dictionary 635;; Shrinking the dictionary
@@ -579,7 +649,7 @@ COUNT defaults to 5"
579 (setq spam-stat-dirty t)) 649 (setq spam-stat-dirty t))
580 650
581(defun spam-stat-install-hooks-function () 651(defun spam-stat-install-hooks-function ()
582 "Install the spam-stat function hooks" 652 "Install the spam-stat function hooks."
583 (interactive) 653 (interactive)
584 (add-hook 'nnmail-prepare-incoming-message-hook 654 (add-hook 'nnmail-prepare-incoming-message-hook
585 'spam-stat-store-current-buffer) 655 'spam-stat-store-current-buffer)
@@ -590,7 +660,7 @@ COUNT defaults to 5"
590 (spam-stat-install-hooks-function)) 660 (spam-stat-install-hooks-function))
591 661
592(defun spam-stat-unload-hook () 662(defun spam-stat-unload-hook ()
593 "Uninstall the spam-stat function hooks" 663 "Uninstall the spam-stat function hooks."
594 (interactive) 664 (interactive)
595 (remove-hook 'nnmail-prepare-incoming-message-hook 665 (remove-hook 'nnmail-prepare-incoming-message-hook
596 'spam-stat-store-current-buffer) 666 'spam-stat-store-current-buffer)
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
new file mode 100644
index 00000000000..d1be1816a4f
--- /dev/null
+++ b/lisp/gnus/spam-wash.el
@@ -0,0 +1,75 @@
1;;; spam-wash.el --- wash spam before analysis
2
3;; Copyright (C) 2004 Free Software Foundation, Inc.
4
5;; Author: Andrew Cohen <cohen@andy.bu.edu>
6;; Keywords: mail
7
8;; This file is part of GNU Emacs.
9
10;; This is free software; you can redistribute it and/or modify it
11;; under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 3, or (at your option)
13;; any later version.
14
15;; This is distributed in the hope that it will be useful, but WITHOUT
16;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
17;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
18;; License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This library decodes MIME encodings such as base64 and
28;; quoted-printable to allow for better spam analysis.
29;;
30;; `spam-wash' should be called in a buffer containing the message.
31
32;;; Code:
33
34(require 'gnus-art)
35
36(defun spam-wash ()
37 "Treat the current buffer prior to spam analysis."
38 (interactive)
39 (run-hooks 'gnus-article-decode-hook)
40 (save-excursion
41 (save-restriction
42 (let* ((buffer-read-only nil)
43 (gnus-inhibit-treatment t)
44 (gnus-article-buffer (current-buffer))
45 (handles (or (mm-dissect-buffer nil gnus-article-loose-mime)
46 (and gnus-article-emulate-mime
47 (mm-uu-dissect))))
48 handle)
49 (when gnus-article-mime-handles
50 (mm-destroy-parts gnus-article-mime-handles)
51 (setq gnus-article-mime-handle-alist nil))
52 (setq gnus-article-mime-handles handles)
53 (when (and handles
54 (or (not (stringp (car handles)))
55 (cdr handles)))
56 (article-goto-body)
57 (delete-region (point) (point-max))
58 (spam-treat-parts handles))))))
59
60(defun spam-treat-parts (handle)
61 (if (stringp (car handle))
62 (mapcar 'spam-treat-parts (cdr handle))
63 (if (bufferp (car handle))
64 (save-restriction
65 (narrow-to-region (point) (point))
66 (when (let ((case-fold-search t))
67 (string-match "text" (car (mm-handle-type handle))))
68 (mm-insert-part handle))
69 (goto-char (point-max)))
70 (mapcar 'spam-treat-parts handle))))
71
72(provide 'spam-wash)
73
74;;; arch-tag: 3c7f94a7-c96d-4c77-bb59-950df12bc85f
75;;; spam-wash.el ends here
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index b19ce8cd285..4164d3f718b 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -3,7 +3,8 @@
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4 4
5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6;; Keywords: network 6;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
7;; Keywords: network, spam, mail, bogofilter, BBDB, dspam, dig, whitelist, blacklist, gmane, hashcash, spamassassin, bsfilter, ifile, stat, crm114, spamoracle
7 8
8;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
9 10
@@ -33,12 +34,15 @@
33 34
34;;; Several TODO items are marked as such 35;;; Several TODO items are marked as such
35 36
36;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting, 37;; TODO: cross-server splitting, remote processing, training through files
37;; remote processing, training through files
38 38
39;;; Code: 39;;; Code:
40 40
41;;{{{ compilation directives and autoloads/requires
42
41(eval-when-compile (require 'cl)) 43(eval-when-compile (require 'cl))
44(eval-when-compile (require 'spam-report))
45(eval-when-compile (require 'hashcash))
42 46
43(require 'gnus-sum) 47(require 'gnus-sum)
44 48
@@ -50,18 +54,16 @@
50;; for nnimap-split-download-body-default 54;; for nnimap-split-download-body-default
51(eval-when-compile (require 'nnimap)) 55(eval-when-compile (require 'nnimap))
52 56
53;; autoload executable-find
54(eval-and-compile
55 ;; executable-find is not autoloaded in Emacs 20
56 (autoload 'executable-find "executable"))
57
58;; autoload query-dig 57;; autoload query-dig
59(eval-and-compile 58(eval-and-compile
60 (autoload 'query-dig "dig")) 59 (autoload 'query-dig "dig"))
61 60
62;; autoload spam-report 61;; autoload spam-report
63(eval-and-compile 62(eval-and-compile
64 (autoload 'spam-report-gmane "spam-report")) 63 (autoload 'spam-report-gmane "spam-report")
64 (autoload 'spam-report-gmane-spam "spam-report")
65 (autoload 'spam-report-gmane-ham "spam-report")
66 (autoload 'spam-report-resend "spam-report"))
65 67
66;; autoload gnus-registry 68;; autoload gnus-registry
67(eval-and-compile 69(eval-and-compile
@@ -74,7 +76,12 @@
74(eval-and-compile 76(eval-and-compile
75 (autoload 'query-dns "dns")) 77 (autoload 'query-dns "dns"))
76 78
77;;; Main parameters. 79;;}}}
80
81;;{{{ Main parameters.
82(defvar spam-backends nil
83 "List of spam.el backends with all the pertinent data.
84Populated by spam-install-backend-super.")
78 85
79(defgroup spam nil 86(defgroup spam nil
80 "Spam configuration." 87 "Spam configuration."
@@ -82,24 +89,23 @@
82 :group 'mail 89 :group 'mail
83 :group 'news) 90 :group 'news)
84 91
92(defcustom spam-summary-exit-behavior 'default
93 "Exit behavior at the time of summary exit.
94Note that setting the spam-use-move or spam-use-copy backends on
95a group through group/topic parameters overrides this mechanism."
96 :type '(choice (const 'default :tag
97 "Move spam out of all groups. Move ham out of spam groups.")
98 (const 'move-all :tag
99 "Move spam out of all groups. Move ham out of all groups.")
100 (const 'move-none :tag
101 "Never move spam or ham out of any groups."))
102 :group 'spam)
103
85(defcustom spam-directory (nnheader-concat gnus-directory "spam/") 104(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
86 "Directory for spam whitelists and blacklists." 105 "Directory for spam whitelists and blacklists."
87 :type 'directory 106 :type 'directory
88 :group 'spam) 107 :group 'spam)
89 108
90(defcustom spam-move-spam-nonspam-groups-only t
91 "Whether spam should be moved in non-spam groups only.
92When t, only ham and unclassified groups will have their spam moved
93to the spam-process-destination. When nil, spam will also be moved from
94spam groups."
95 :type 'boolean
96 :group 'spam)
97
98(defcustom spam-process-ham-in-nonham-groups nil
99 "Whether ham should be processed in non-ham groups."
100 :type 'boolean
101 :group 'spam)
102
103(defcustom spam-mark-new-messages-in-spam-group-as-spam t 109(defcustom spam-mark-new-messages-in-spam-group-as-spam t
104 "Whether new messages in a spam group should get the spam-mark." 110 "Whether new messages in a spam group should get the spam-mark."
105 :type 'boolean 111 :type 'boolean
@@ -123,11 +129,6 @@ Do not set this if you use `spam-split' in a fancy split
123 :type 'boolean 129 :type 'boolean
124 :group 'spam) 130 :group 'spam)
125 131
126(defcustom spam-process-ham-in-spam-groups nil
127 "Whether ham should be processed in spam groups."
128 :type 'boolean
129 :group 'spam)
130
131(defcustom spam-mark-only-unseen-as-spam t 132(defcustom spam-mark-only-unseen-as-spam t
132 "Whether only unseen articles should be marked as spam in spam groups. 133 "Whether only unseen articles should be marked as spam in spam groups.
133When nil, all unread articles in a spam group are marked as 134When nil, all unread articles in a spam group are marked as
@@ -145,9 +146,9 @@ Competition."
145 :group 'spam) 146 :group 'spam)
146 147
147(defcustom spam-disable-spam-split-during-ham-respool nil 148(defcustom spam-disable-spam-split-during-ham-respool nil
148 "Whether `spam-split' should be ignored while resplitting ham in a process 149 "Whether `spam-split' should be ignored while resplitting ham.
149destination. This is useful to prevent ham from ending up in the same spam 150This is useful to prevent ham from ending up in the same spam
150group after the resplit. Don't set this to t if you have spam-split as the 151group after the resplit. Don't set this to t if you have `spam-split' as the
151last rule in your split configuration." 152last rule in your split configuration."
152 :type 'boolean 153 :type 'boolean
153 :group 'spam) 154 :group 'spam)
@@ -177,6 +178,11 @@ The regular expression is matched against the address."
177 :type 'boolean 178 :type 'boolean
178 :group 'spam) 179 :group 'spam)
179 180
181(defcustom spam-use-gmane-xref nil
182 "Whether the Gmane spam xref should be used by `spam-split'."
183 :type 'boolean
184 :group 'spam)
185
180(defcustom spam-use-blacklist nil 186(defcustom spam-use-blacklist nil
181 "Whether the blacklist should be used by `spam-split'." 187 "Whether the blacklist should be used by `spam-split'."
182 :type 'boolean 188 :type 'boolean
@@ -233,6 +239,18 @@ Enable this if you want Gnus to invoke Bogofilter on new messages."
233 :type 'boolean 239 :type 'boolean
234 :group 'spam) 240 :group 'spam)
235 241
242(defcustom spam-use-bsfilter-headers nil
243 "Whether bsfilter headers should be used by `spam-split'.
244Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
245 :type 'boolean
246 :group 'spam)
247
248(defcustom spam-use-bsfilter nil
249 "Whether bsfilter should be invoked by `spam-split'.
250Enable this if you want Gnus to invoke Bsfilter on new messages."
251 :type 'boolean
252 :group 'spam)
253
236(defcustom spam-use-BBDB nil 254(defcustom spam-use-BBDB nil
237 "Whether BBDB should be used by `spam-split'." 255 "Whether BBDB should be used by `spam-split'."
238 :type 'boolean 256 :type 'boolean
@@ -260,8 +278,27 @@ considered spam."
260 :type 'boolean 278 :type 'boolean
261 :group 'spam) 279 :group 'spam)
262 280
281(defcustom spam-use-spamassassin nil
282 "Whether spamassassin should be invoked by `spam-split'.
283Enable this if you want Gnus to invoke SpamAssassin on new messages."
284 :type 'boolean
285 :group 'spam)
286
287(defcustom spam-use-spamassassin-headers nil
288 "Whether spamassassin headers should be checked by `spam-split'.
289Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
290them."
291 :type 'boolean
292 :group 'spam)
293
294(defcustom spam-use-crm114 nil
295 "Whether the CRM114 Mailfilter should be used by `spam-split'."
296 :type 'boolean
297 :group 'spam)
298
263(defcustom spam-install-hooks (or 299(defcustom spam-install-hooks (or
264 spam-use-dig 300 spam-use-dig
301 spam-use-gmane-xref
265 spam-use-blacklist 302 spam-use-blacklist
266 spam-use-whitelist 303 spam-use-whitelist
267 spam-use-whitelist-exclusive 304 spam-use-whitelist-exclusive
@@ -269,13 +306,18 @@ considered spam."
269 spam-use-hashcash 306 spam-use-hashcash
270 spam-use-regex-headers 307 spam-use-regex-headers
271 spam-use-regex-body 308 spam-use-regex-body
272 spam-use-bogofilter-headers
273 spam-use-bogofilter 309 spam-use-bogofilter
310 spam-use-bogofilter-headers
311 spam-use-spamassassin
312 spam-use-spamassassin-headers
313 spam-use-bsfilter
314 spam-use-bsfilter-headers
274 spam-use-BBDB 315 spam-use-BBDB
275 spam-use-BBDB-exclusive 316 spam-use-BBDB-exclusive
276 spam-use-ifile 317 spam-use-ifile
277 spam-use-stat 318 spam-use-stat
278 spam-use-spamoracle) 319 spam-use-spamoracle
320 spam-use-crm114)
279 "Whether the spam hooks should be installed. 321 "Whether the spam hooks should be installed.
280Default to t if one of the spam-use-* variables is set." 322Default to t if one of the spam-use-* variables is set."
281 :group 'spam 323 :group 'spam
@@ -296,14 +338,23 @@ All unmarked article in such group receive the spam mark on group entry."
296 :type '(repeat (string :tag "Group")) 338 :type '(repeat (string :tag "Group"))
297 :group 'spam) 339 :group 'spam)
298 340
341
342(defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
343 "The group where spam xrefs can be found on Gmane.
344Only meaningful if you enable `spam-use-gmane-xref'."
345 :type 'string
346 :group 'spam)
347
299(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" 348(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
300 "dev.null.dk" "relays.visi.com") 349 "dev.null.dk" "relays.visi.com")
301 "List of blackhole servers." 350 "List of blackhole servers.
351Only meaningful if you enable `spam-use-blackholes'."
302 :type '(repeat (string :tag "Server")) 352 :type '(repeat (string :tag "Server"))
303 :group 'spam) 353 :group 'spam)
304 354
305(defcustom spam-blackhole-good-server-regex nil 355(defcustom spam-blackhole-good-server-regex nil
306 "String matching IP addresses that should not be checked in the blackholes." 356 "String matching IP addresses that should not be checked in the blackholes.
357Only meaningful if you enable `spam-use-blackholes'."
307 :type '(radio (const nil) regexp) 358 :type '(radio (const nil) regexp)
308 :group 'spam) 359 :group 'spam)
309 360
@@ -328,25 +379,37 @@ All unmarked article in such group receive the spam mark on group entry."
328 :group 'spam) 379 :group 'spam)
329 380
330(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") 381(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
331 "Regular expression for positive header spam matches." 382 "Regular expression for positive header spam matches.
383Only meaningful if you enable `spam-use-regex-headers'."
332 :type '(repeat (regexp :tag "Regular expression to match spam header")) 384 :type '(repeat (regexp :tag "Regular expression to match spam header"))
333 :group 'spam) 385 :group 'spam)
334 386
335(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") 387(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
336 "Regular expression for positive header ham matches." 388 "Regular expression for positive header ham matches.
389Only meaningful if you enable `spam-use-regex-headers'."
337 :type '(repeat (regexp :tag "Regular expression to match ham header")) 390 :type '(repeat (regexp :tag "Regular expression to match ham header"))
338 :group 'spam) 391 :group 'spam)
339 392
340(defcustom spam-regex-body-spam '() 393(defcustom spam-regex-body-spam '()
341 "Regular expression for positive body spam matches." 394 "Regular expression for positive body spam matches.
395Only meaningful if you enable `spam-use-regex-body'."
342 :type '(repeat (regexp :tag "Regular expression to match spam body")) 396 :type '(repeat (regexp :tag "Regular expression to match spam body"))
343 :group 'spam) 397 :group 'spam)
344 398
345(defcustom spam-regex-body-ham '() 399(defcustom spam-regex-body-ham '()
346 "Regular expression for positive body ham matches." 400 "Regular expression for positive body ham matches.
401Only meaningful if you enable `spam-use-regex-body'."
347 :type '(repeat (regexp :tag "Regular expression to match ham body")) 402 :type '(repeat (regexp :tag "Regular expression to match ham body"))
348 :group 'spam) 403 :group 'spam)
349 404
405(defcustom spam-summary-score-preferred-header nil
406 "Preferred header to use for spam-summary-score."
407 :type '(choice :tag "Header name"
408 (symbol :tag "SpamAssassin etc" X-Spam-Status)
409 (symbol :tag "Bogofilter" X-Bogosity)
410 (const :tag "No preference, take best guess." nil))
411 :group 'spam)
412
350(defgroup spam-ifile nil 413(defgroup spam-ifile nil
351 "Spam ifile configuration." 414 "Spam ifile configuration."
352 :group 'spam) 415 :group 'spam)
@@ -398,6 +461,8 @@ your main source of newsgroup names."
398 (const :tag "Bogofilter is not installed")) 461 (const :tag "Bogofilter is not installed"))
399 :group 'spam-bogofilter) 462 :group 'spam-bogofilter)
400 463
464(defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?")
465
401(defcustom spam-bogofilter-header "X-Bogosity" 466(defcustom spam-bogofilter-header "X-Bogosity"
402 "The header that Bogofilter inserts in messages." 467 "The header that Bogofilter inserts in messages."
403 :type 'string 468 :type 'string
@@ -436,6 +501,55 @@ When nil, use the default location."
436 (const :tag "Use the default")) 501 (const :tag "Use the default"))
437 :group 'spam-bogofilter) 502 :group 'spam-bogofilter)
438 503
504(defgroup spam-bsfilter nil
505 "Spam bsfilter configuration."
506 :group 'spam)
507
508(make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program)
509;; "22.1" ;; Gnus 5.10.9
510(defcustom spam-bsfilter-program (executable-find "bsfilter")
511 "Name of the Bsfilter program."
512 :type '(choice (file :tag "Location of bsfilter")
513 (const :tag "Bsfilter is not installed"))
514 :group 'spam-bsfilter)
515
516(defcustom spam-bsfilter-header "X-Spam-Flag"
517 "The header inserted by Bsfilter to flag spam."
518 :type 'string
519 :group 'spam-bsfilter)
520
521(defcustom spam-bsfilter-probability-header "X-Spam-Probability"
522 "The header that Bsfilter inserts in messages."
523 :type 'string
524 :group 'spam-bsfilter)
525
526(defcustom spam-bsfilter-spam-switch "--add-spam"
527 "The switch that Bsfilter uses to register spam messages."
528 :type 'string
529 :group 'spam-bsfilter)
530
531(defcustom spam-bsfilter-ham-switch "--add-clean"
532 "The switch that Bsfilter uses to register ham messages."
533 :type 'string
534 :group 'spam-bsfilter)
535
536(defcustom spam-bsfilter-spam-strong-switch "--sub-spam"
537 "The switch that Bsfilter uses to unregister ham messages."
538 :type 'string
539 :group 'spam-bsfilter)
540
541(defcustom spam-bsfilter-ham-strong-switch "--sub-clean"
542 "The switch that Bsfilter uses to unregister spam messages."
543 :type 'string
544 :group 'spam-bsfilter)
545
546(defcustom spam-bsfilter-database-directory nil
547 "Directory path of the Bsfilter databases."
548 :type '(choice (directory
549 :tag "Location of the Bsfilter database directory")
550 (const :tag "Use the default"))
551 :group 'spam-bsfilter)
552
439(defgroup spam-spamoracle nil 553(defgroup spam-spamoracle nil
440 "Spam spamoracle configuration." 554 "Spam spamoracle configuration."
441 :group 'spam) 555 :group 'spam)
@@ -453,34 +567,184 @@ When nil, use the default spamoracle database."
453 (const :tag "Use the default")) 567 (const :tag "Use the default"))
454 :group 'spam-spamoracle) 568 :group 'spam-spamoracle)
455 569
570(defgroup spam-spamassassin nil
571 "Spam SpamAssassin configuration."
572 :group 'spam)
573
574(make-obsolete-variable 'spam-spamassassin-path
575 'spam-spamassassin-program) ;; "22.1" ;; Gnus 5.10.9
576(defcustom spam-assassin-program (executable-find "spamassassin")
577 "Name of the spamassassin program.
578Hint: set this to \"spamc\" if you have spamd running. See the spamc and
579spamd man pages for more information on these programs."
580 :type '(choice (file :tag "Location of spamc")
581 (const :tag "spamassassin is not installed"))
582 :group 'spam-spamassassin)
583
584(defcustom spam-spamassassin-arguments ()
585 "Arguments to pass to the spamassassin executable.
586This must be a list. For example, `(\"-C\" \"configfile\")'."
587 :type '(restricted-sexp :match-alternatives (listp))
588 :group 'spam-spamassassin)
589
590(defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag"
591 "The header inserted by SpamAssassin to flag spam."
592 :type 'string
593 :group 'spam-spamassassin)
594
595(defcustom spam-spamassassin-positive-spam-flag-header "YES"
596 "The regex on `spam-spamassassin-spam-flag-header' for positive spam
597identification"
598 :type 'string
599 :group 'spam-spamassassin)
600
601(defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
602 "The header inserted by SpamAssassin, giving extended scoring information"
603 :type 'string
604 :group 'spam-spamassassin)
605
606(make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program)
607;; "22.1" ;; Gnus 5.10.9
608(defcustom spam-sa-learn-program (executable-find "sa-learn")
609 "Name of the sa-learn program."
610 :type '(choice (file :tag "Location of spamassassin")
611 (const :tag "spamassassin is not installed"))
612 :group 'spam-spamassassin)
613
614(defcustom spam-sa-learn-rebuild t
615 "Whether sa-learn should rebuild the database every time it is called
616Enable this if you want sa-learn to rebuild the database automatically. Doing
617this will slightly increase the running time of the spam registration process.
618If you choose not to do this, you will have to run \"sa-learn --rebuild\" in
619order for SpamAssassin to recognize the new registered spam."
620 :type 'boolean
621 :group 'spam-spamassassin)
622
623(defcustom spam-sa-learn-spam-switch "--spam"
624 "The switch that sa-learn uses to register spam messages"
625 :type 'string
626 :group 'spam-spamassassin)
627
628(defcustom spam-sa-learn-ham-switch "--ham"
629 "The switch that sa-learn uses to register ham messages"
630 :type 'string
631 :group 'spam-spamassassin)
632
633(defcustom spam-sa-learn-unregister-switch "--forget"
634 "The switch that sa-learn uses to unregister messages messages"
635 :type 'string
636 :group 'spam-spamassassin)
637
638(defgroup spam-crm114 nil
639 "Spam CRM114 Mailfilter configuration."
640 :group 'spam)
641
642(defcustom spam-crm114-program (executable-find "mailfilter.crm")
643 "File path of the CRM114 Mailfilter executable program."
644 :type '(choice (file :tag "Location of CRM114 Mailfilter")
645 (const :tag "CRM114 Mailfilter is not installed"))
646 :group 'spam-crm114)
647
648(defcustom spam-crm114-header "X-CRM114-Status"
649 "The header that CRM114 Mailfilter inserts in messages."
650 :type 'string
651 :group 'spam-crm114)
652
653(defcustom spam-crm114-spam-switch "--learnspam"
654 "The switch that CRM114 Mailfilter uses to register spam messages."
655 :type 'string
656 :group 'spam-crm114)
657
658(defcustom spam-crm114-ham-switch "--learnnonspam"
659 "The switch that CRM114 Mailfilter uses to register ham messages."
660 :type 'string
661 :group 'spam-crm114)
662
663(defcustom spam-crm114-spam-strong-switch "--UNKNOWN"
664 "The switch that CRM114 Mailfilter uses to unregister ham messages."
665 :type 'string
666 :group 'spam-crm114)
667
668(defcustom spam-crm114-ham-strong-switch "--UNKNOWN"
669 "The switch that CRM114 Mailfilter uses to unregister spam messages."
670 :type 'string
671 :group 'spam-crm114)
672
673(defcustom spam-crm114-positive-spam-header "^SPAM"
674 "The regex on `spam-crm114-header' for positive spam identification."
675 :type 'regexp
676 :group 'spam-crm114)
677
678(defcustom spam-crm114-database-directory nil
679 "Directory path of the CRM114 Mailfilter databases."
680 :type '(choice (directory
681 :tag "Location of the CRM114 Mailfilter database directory")
682 (const :tag "Use the default"))
683 :group 'spam-crm114)
684
456;;; Key bindings for spam control. 685;;; Key bindings for spam control.
457 686
458(gnus-define-keys gnus-summary-mode-map 687(gnus-define-keys gnus-summary-mode-map
459 "St" spam-bogofilter-score 688 "St" spam-generic-score
460 "Sx" gnus-summary-mark-as-spam 689 "Sx" gnus-summary-mark-as-spam
461 "Mst" spam-bogofilter-score 690 "Mst" spam-generic-score
462 "Msx" gnus-summary-mark-as-spam 691 "Msx" gnus-summary-mark-as-spam
463 "\M-d" gnus-summary-mark-as-spam) 692 "\M-d" gnus-summary-mark-as-spam)
464 693
465(defvar spam-old-ham-articles nil 694(defvar spam-cache-lookups t
466 "List of old ham articles, generated when a group is entered.") 695 "Whether spam.el will try to cache lookups using `spam-caches'.")
467 696
468(defvar spam-old-spam-articles nil 697(defvar spam-caches (make-hash-table
469 "List of old spam articles, generated when a group is entered.") 698 :size 10
699 :test 'equal)
700 "Cache of spam detection entries.")
701
702(defvar spam-old-articles nil
703 "List of old ham and spam articles, generated when a group is entered.")
470 704
471(defvar spam-split-disabled nil 705(defvar spam-split-disabled nil
472 "If non-nil, `spam-split' is disabled, and always returns nil.") 706 "If non-nil, `spam-split' is disabled, and always returns nil.")
473 707
474(defvar spam-split-last-successful-check nil 708(defvar spam-split-last-successful-check nil
475 "`spam-split' will set this to nil or a spam-use-XYZ check if it 709 "Internal variable.
476 finds ham or spam.") 710`spam-split' will set this to nil or a spam-use-XYZ check if it
711finds ham or spam.")
712
713;; internal variables for backends
714;; TODO: find a way to create these on the fly in spam-install-backend-super
715(defvar spam-use-copy nil)
716(defvar spam-use-move nil)
717(defvar spam-use-gmane nil)
718(defvar spam-use-resend nil)
719
720;;}}}
721
722;;{{{ convenience functions
723
724(defun spam-clear-cache (symbol)
725 "Clear the spam-caches entry for a check."
726 (remhash symbol spam-caches))
477 727
478;; convenience functions
479(defun spam-xor (a b) 728(defun spam-xor (a b)
480 "Logical exclusive `or'." 729 "Logical A xor B."
481 (and (or a b) (not (and a b)))) 730 (and (or a b) (not (and a b))))
482 731
732(defun spam-set-difference (list1 list2)
733 "Return a set difference of LIST1 and LIST2.
734When either list is nil, the other is returned."
735 (if (and list1 list2)
736 ;; we have two non-nil lists
737 (progn
738 (dolist (item (append list1 list2))
739 (when (and (memq item list1) (memq item list2))
740 (setq list1 (delq item list1))
741 (setq list2 (delq item list2))))
742 (append list1 list2))
743 ;; if either of the lists was nil, return the other one
744 (if list1 list1 list2)))
745
483(defun spam-group-ham-mark-p (group mark &optional spam) 746(defun spam-group-ham-mark-p (group mark &optional spam)
747 "Checks if MARK is considered a ham mark in GROUP."
484 (when (stringp group) 748 (when (stringp group)
485 (let* ((marks (spam-group-ham-marks group spam)) 749 (let* ((marks (spam-group-ham-marks group spam))
486 (marks (if (symbolp mark) 750 (marks (if (symbolp mark)
@@ -489,9 +753,11 @@ When nil, use the default spamoracle database."
489 (memq mark marks)))) 753 (memq mark marks))))
490 754
491(defun spam-group-spam-mark-p (group mark) 755(defun spam-group-spam-mark-p (group mark)
756 "Checks if MARK is considered a spam mark in GROUP."
492 (spam-group-ham-mark-p group mark t)) 757 (spam-group-ham-mark-p group mark t))
493 758
494(defun spam-group-ham-marks (group &optional spam) 759(defun spam-group-ham-marks (group &optional spam)
760 "In GROUP, get all the ham marks."
495 (when (stringp group) 761 (when (stringp group)
496 (let* ((marks (if spam 762 (let* ((marks (if spam
497 (gnus-parameter-spam-marks group) 763 (gnus-parameter-spam-marks group)
@@ -501,107 +767,594 @@ When nil, use the default spamoracle database."
501 marks))) 767 marks)))
502 768
503(defun spam-group-spam-marks (group) 769(defun spam-group-spam-marks (group)
770 "In GROUP, get all the spam marks."
504 (spam-group-ham-marks group t)) 771 (spam-group-ham-marks group t))
505 772
506(defun spam-group-spam-contents-p (group) 773(defun spam-group-spam-contents-p (group)
507 (if (stringp group) 774 "Is GROUP a spam group?"
775 (if (and (stringp group) (< 0 (length group)))
508 (or (member group spam-junk-mailgroups) 776 (or (member group spam-junk-mailgroups)
509 (memq 'gnus-group-spam-classification-spam 777 (memq 'gnus-group-spam-classification-spam
510 (gnus-parameter-spam-contents group))) 778 (gnus-parameter-spam-contents group)))
511 nil)) 779 nil))
512 780
513(defun spam-group-ham-contents-p (group) 781(defun spam-group-ham-contents-p (group)
782 "Is GROUP a ham group?"
514 (if (stringp group) 783 (if (stringp group)
515 (memq 'gnus-group-spam-classification-ham 784 (memq 'gnus-group-spam-classification-ham
516 (gnus-parameter-spam-contents group)) 785 (gnus-parameter-spam-contents group))
517 nil)) 786 nil))
518 787
788(defun spam-classifications ()
789 "Return list of valid classifications"
790 '(spam ham))
791
792(defun spam-classification-valid-p (classification)
793 "Is CLASSIFICATION a valid spam/ham classification?"
794 (memq classification (spam-classifications)))
795
796(defun spam-backend-properties ()
797 "Return list of valid classifications."
798 '(statistical mover check hrf srf huf suf))
799
800(defun spam-backend-property-valid-p (property)
801 "Is PROPERTY a valid backend property?"
802 (memq property (spam-backend-properties)))
803
804(defun spam-backend-function-type-valid-p (type)
805 (or (eq type 'registration)
806 (eq type 'unregistration)))
807
808(defun spam-process-type-valid-p (process-type)
809 (or (eq process-type 'incoming)
810 (eq process-type 'process)))
811
812(defun spam-list-articles (articles classification)
813 (let ((mark-check (if (eq classification 'spam)
814 'spam-group-spam-mark-p
815 'spam-group-ham-mark-p))
816 alist mark-cache-yes mark-cache-no)
817 (dolist (article articles)
818 (let ((mark (gnus-summary-article-mark article)))
819 (unless (or (memq mark mark-cache-yes)
820 (memq mark mark-cache-no))
821 (if (funcall mark-check
822 gnus-newsgroup-name
823 mark)
824 (push mark mark-cache-yes)
825 (push mark mark-cache-no)))
826 (when (memq mark mark-cache-yes)
827 (push article alist))))
828 alist))
829
830;;}}}
831
832;;{{{ backend installation functions and procedures
833
834(defun spam-install-backend-super (backend &rest properties)
835 "Install BACKEND for spam.el.
836Accepts incoming CHECK, ham registration function HRF, spam
837registration function SRF, ham unregistration function HUF, spam
838unregistration function SUF, and an indication whether the
839backend is STATISTICAL."
840
841 (setq spam-backends (add-to-list 'spam-backends backend))
842 (while properties
843 (let ((property (pop properties))
844 (value (pop properties)))
845 (if (spam-backend-property-valid-p property)
846 (put backend property value)
847 (gnus-error
848 5
849 "spam-install-backend-super got an invalid property %s"
850 property)))))
851
852(defun spam-backend-list (&optional type)
853 "Return a list of all the backend symbols, constrained by TYPE.
854When TYPE is 'non-mover, only non-mover backends are returned.
855When TYPE is 'mover, only mover backends are returned."
856 (let (list)
857 (dolist (backend spam-backends)
858 (when (or
859 (null type) ;either no type was requested
860 ;; or the type is 'mover and the backend is a mover
861 (and
862 (eq type 'mover)
863 (spam-backend-mover-p backend))
864 ;; or the type is 'non-mover and the backend is not a mover
865 (and
866 (eq type 'non-mover)
867 (not (spam-backend-mover-p backend))))
868 (push backend list)))
869 list))
870
871(defun spam-backend-check (backend)
872 "Get the check function for BACKEND.
873Each individual check may return nil, t, or a mailgroup name.
874The value nil means that the check does not yield a decision, and
875so, that further checks are needed. The value t means that the
876message is definitely not spam, and that further spam checks
877should be inhibited. Otherwise, a mailgroup name or the symbol
878'spam (depending on spam-split-symbolic-return) is returned where
879the mail should go, and further checks are also inhibited. The
880usual mailgroup name is the value of `spam-split-group', meaning
881that the message is definitely a spam."
882 (get backend 'check))
883
884(defun spam-backend-valid-p (backend)
885 "Is BACKEND valid?"
886 (member backend (spam-backend-list)))
887
888(defun spam-backend-info (backend)
889 "Return information about BACKEND."
890 (if (spam-backend-valid-p backend)
891 (let (info)
892 (setq info (format "Backend %s has the following properties:\n"
893 backend))
894 (dolist (property (spam-backend-properties))
895 (setq info (format "%s%s=%s\n"
896 info
897 property
898 (get backend property))))
899 info)
900 (gnus-error 5 "spam-backend-info was asked about an invalid backend %s"
901 backend)))
902
903(defun spam-backend-function (backend classification type)
904 "Get the BACKEND function for CLASSIFICATION and TYPE.
905TYPE is 'registration or 'unregistration.
906CLASSIFICATION is 'ham or 'spam."
907 (if (and
908 (spam-classification-valid-p classification)
909 (spam-backend-function-type-valid-p type))
910 (let ((retrieval
911 (intern
912 (format "spam-backend-%s-%s-function"
913 classification
914 type))))
915 (funcall retrieval backend))
916 (gnus-error
917 5
918 "%s was passed invalid backend %s, classification %s, or type %s"
919 "spam-backend-function"
920 backend
921 classification
922 type)))
923
924(defun spam-backend-article-list-property (classification
925 &optional unregister)
926 "Property name of article list with CLASSIFICATION and UNREGISTER."
927 (let* ((r (if unregister "unregister" "register"))
928 (prop (format "%s-%s" classification r)))
929 prop))
930
931(defun spam-backend-get-article-todo-list (backend
932 classification
933 &optional unregister)
934 "Get the articles to be processed for BACKEND and CLASSIFICATION.
935With UNREGISTER, get articles to be unregistered.
936This is a temporary storage function - nothing here persists."
937 (get
938 backend
939 (intern (spam-backend-article-list-property classification unregister))))
940
941(defun spam-backend-put-article-todo-list (backend classification list &optional unregister)
942 "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION.
943With UNREGISTER, set articles to be unregistered.
944This is a temporary storage function - nothing here persists."
945 (put
946 backend
947 (intern (spam-backend-article-list-property classification unregister))
948 list))
949
950(defun spam-backend-ham-registration-function (backend)
951 "Get the ham registration function for BACKEND."
952 (get backend 'hrf))
953
954(defun spam-backend-spam-registration-function (backend)
955 "Get the spam registration function for BACKEND."
956 (get backend 'srf))
957
958(defun spam-backend-ham-unregistration-function (backend)
959 "Get the ham unregistration function for BACKEND."
960 (get backend 'huf))
961
962(defun spam-backend-spam-unregistration-function (backend)
963 "Get the spam unregistration function for BACKEND."
964 (get backend 'suf))
965
966(defun spam-backend-statistical-p (backend)
967 "Is BACKEND statistical?"
968 (get backend 'statistical))
969
970(defun spam-backend-mover-p (backend)
971 "Is BACKEND a mover?"
972 (get backend 'mover))
973
974(defun spam-install-backend-alias (backend alias)
975 "Add ALIAS to an existing BACKEND.
976The previous backend settings for ALIAS are erased."
977
978 ;; install alias with no properties at first
979 (spam-install-backend-super alias)
980
981 (dolist (property (spam-backend-properties))
982 (put alias property (get backend property))))
983
984(defun spam-install-checkonly-backend (backend check)
985 "Install a BACKEND than can only CHECK for spam."
986 (spam-install-backend-super backend 'check check))
987
988(defun spam-install-mover-backend (backend hrf srf huf suf)
989 "Install a BACKEND than can move articles at summary exit.
990Accepts ham registration function HRF, spam registration function
991SRF, ham unregistration function HUF, spam unregistration
992function SUF. The backend has no incoming check and can't be
993statistical."
994 (spam-install-backend-super
995 backend
996 'hrf hrf 'srf srf 'huf huf 'suf suf 'mover t))
997
998(defun spam-install-nocheck-backend (backend hrf srf huf suf)
999 "Install a BACKEND than has no check.
1000Accepts ham registration function HRF, spam registration function
1001SRF, ham unregistration function HUF, spam unregistration
1002function SUF. The backend has no incoming check and can't be
1003statistical (it could be, but in practice that doesn't happen)."
1004 (spam-install-backend-super
1005 backend
1006 'hrf hrf 'srf srf 'huf huf 'suf suf))
1007
1008(defun spam-install-backend (backend check hrf srf huf suf)
1009 "Install a BACKEND.
1010Accepts incoming CHECK, ham registration function HRF, spam
1011registration function SRF, ham unregistration function HUF, spam
1012unregistration function SUF. The backend won't be
1013statistical (use spam-install-statistical-backend for that)."
1014 (spam-install-backend-super
1015 backend
1016 'check check 'hrf hrf 'srf srf 'huf huf 'suf suf))
1017
1018(defun spam-install-statistical-backend (backend check hrf srf huf suf)
1019 "Install a BACKEND.
1020Accepts incoming CHECK, ham registration function HRF, spam
1021registration function SRF, ham unregistration function HUF, spam
1022unregistration function SUF. The backend will be
1023statistical (use spam-install-backend for non-statistical
1024backends)."
1025 (spam-install-backend-super
1026 backend
1027 'check check 'statistical t 'hrf hrf 'srf srf 'huf huf 'suf suf))
1028
1029(defun spam-install-statistical-checkonly-backend (backend check)
1030 "Install a statistical BACKEND than can only CHECK for spam."
1031 (spam-install-backend-super
1032 backend
1033 'check check 'statistical t))
1034
1035;;}}}
1036
1037;;{{{ backend installations
1038(spam-install-checkonly-backend 'spam-use-blackholes
1039 'spam-check-blackholes)
1040
1041(spam-install-checkonly-backend 'spam-use-hashcash
1042 'spam-check-hashcash)
1043
1044(spam-install-checkonly-backend 'spam-use-spamassassin-headers
1045 'spam-check-spamassassin-headers)
1046
1047(spam-install-checkonly-backend 'spam-use-bogofilter-headers
1048 'spam-check-bogofilter-headers)
1049
1050(spam-install-checkonly-backend 'spam-use-bsfilter-headers
1051 'spam-check-bsfilter-headers)
1052
1053(spam-install-checkonly-backend 'spam-use-gmane-xref
1054 'spam-check-gmane-xref)
1055
1056(spam-install-checkonly-backend 'spam-use-regex-headers
1057 'spam-check-regex-headers)
1058
1059(spam-install-statistical-checkonly-backend 'spam-use-regex-body
1060 'spam-check-regex-body)
1061
1062;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) instead
1063(spam-install-mover-backend 'spam-use-move
1064 'spam-move-ham-routine
1065 'spam-move-spam-routine
1066 nil
1067 nil)
1068
1069(spam-install-nocheck-backend 'spam-use-copy
1070 'spam-copy-ham-routine
1071 'spam-copy-spam-routine
1072 nil
1073 nil)
1074
1075(spam-install-nocheck-backend 'spam-use-gmane
1076 'spam-report-gmane-unregister-routine
1077 'spam-report-gmane-register-routine
1078 'spam-report-gmane-register-routine
1079 'spam-report-gmane-unregister-routine)
1080
1081(spam-install-nocheck-backend 'spam-use-resend
1082 'spam-report-resend-register-ham-routine
1083 'spam-report-resend-register-routine
1084 nil
1085 nil)
1086
1087(spam-install-backend 'spam-use-BBDB
1088 'spam-check-BBDB
1089 'spam-BBDB-register-routine
1090 nil
1091 'spam-BBDB-unregister-routine
1092 nil)
1093
1094(spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive)
1095
1096(spam-install-backend 'spam-use-blacklist
1097 'spam-check-blacklist
1098 nil
1099 'spam-blacklist-register-routine
1100 nil
1101 'spam-blacklist-unregister-routine)
1102
1103(spam-install-backend 'spam-use-whitelist
1104 'spam-check-whitelist
1105 'spam-whitelist-register-routine
1106 nil
1107 'spam-whitelist-unregister-routine
1108 nil)
1109
1110(spam-install-statistical-backend 'spam-use-ifile
1111 'spam-check-ifile
1112 'spam-ifile-register-ham-routine
1113 'spam-ifile-register-spam-routine
1114 'spam-ifile-unregister-ham-routine
1115 'spam-ifile-unregister-spam-routine)
1116
1117(spam-install-statistical-backend 'spam-use-spamoracle
1118 'spam-check-spamoracle
1119 'spam-spamoracle-learn-ham
1120 'spam-spamoracle-learn-spam
1121 'spam-spamoracle-unlearn-ham
1122 'spam-spamoracle-unlearn-spam)
1123
1124(spam-install-statistical-backend 'spam-use-stat
1125 'spam-check-stat
1126 'spam-stat-register-ham-routine
1127 'spam-stat-register-spam-routine
1128 'spam-stat-unregister-ham-routine
1129 'spam-stat-unregister-spam-routine)
1130
1131(spam-install-statistical-backend 'spam-use-spamassassin
1132 'spam-check-spamassassin
1133 'spam-spamassassin-register-ham-routine
1134 'spam-spamassassin-register-spam-routine
1135 'spam-spamassassin-unregister-ham-routine
1136 'spam-spamassassin-unregister-spam-routine)
1137
1138(spam-install-statistical-backend 'spam-use-bogofilter
1139 'spam-check-bogofilter
1140 'spam-bogofilter-register-ham-routine
1141 'spam-bogofilter-register-spam-routine
1142 'spam-bogofilter-unregister-ham-routine
1143 'spam-bogofilter-unregister-spam-routine)
1144
1145(spam-install-statistical-backend 'spam-use-bsfilter
1146 'spam-check-bsfilter
1147 'spam-bsfilter-register-ham-routine
1148 'spam-bsfilter-register-spam-routine
1149 'spam-bsfilter-unregister-ham-routine
1150 'spam-bsfilter-unregister-spam-routine)
1151
1152(spam-install-statistical-backend 'spam-use-crm114
1153 'spam-check-crm114
1154 'spam-crm114-register-ham-routine
1155 'spam-crm114-register-spam-routine
1156 ;; does CRM114 Mailfilter support unregistration?
1157 nil
1158 nil)
1159
1160;;}}}
1161
1162;;{{{ scoring and summary formatting
1163(defun spam-necessary-extra-headers ()
1164 "Return the extra headers spam.el thinks are necessary."
1165 (let (list)
1166 (when (or spam-use-spamassassin
1167 spam-use-spamassassin-headers
1168 spam-use-regex-headers)
1169 (push 'X-Spam-Status list))
1170 (when (or spam-use-bogofilter
1171 spam-use-regex-headers)
1172 (push 'X-Bogosity list))
1173 (when (or spam-use-crm114
1174 spam-use-regex-headers)
1175 (push 'X-CRM114-Status list))
1176 list))
1177
1178(defun spam-user-format-function-S (headers)
1179 (when headers
1180 (format "%3.2f"
1181 (spam-summary-score headers spam-summary-score-preferred-header))))
1182
1183(defun spam-article-sort-by-spam-status (h1 h2)
1184 "Sort articles by score."
1185 (let (result)
1186 (dolist (header (spam-necessary-extra-headers))
1187 (let ((s1 (spam-summary-score h1 header))
1188 (s2 (spam-summary-score h2 header)))
1189 (unless (= s1 s2)
1190 (setq result (< s1 s2))
1191 (return))))
1192 result))
1193
1194(defvar spam-spamassassin-score-regexp
1195 ".*\\b\\(?:score\\|hits\\)=\\(-?[0-9.]+\\)"
1196 "Regexp matching SpamAssassin score header.
1197The first group must match the number.")
1198
1199(defun spam-extra-header-to-number (header headers)
1200 "Transform an extra HEADER to a number, using list of HEADERS.
1201Note this has to be fast."
1202 (let ((header-content (gnus-extra-header header headers)))
1203 (if header-content
1204 (cond
1205 ((eq header 'X-Spam-Status)
1206 (string-to-number (gnus-replace-in-string
1207 header-content
1208 spam-spamassassin-score-regexp
1209 "\\1")))
1210 ;; for CRM checking, it's probably faster to just do the string match
1211 ((string-match "( pR: \\([0-9.-]+\\)" header-content)
1212 (- (string-to-number (match-string 1 header-content))))
1213 ((eq header 'X-Bogosity)
1214 (string-to-number (gnus-replace-in-string
1215 (gnus-replace-in-string
1216 header-content
1217 ".*spamicity=" "")
1218 ",.*" "")))
1219 (t nil))
1220 nil)))
1221
1222(defun spam-summary-score (headers &optional specific-header)
1223 "Score an article for the summary buffer, as fast as possible.
1224With SPECIFIC-HEADER, returns only that header's score.
1225Will not return a nil score."
1226 (let (score)
1227 (dolist (header
1228 (if specific-header
1229 (list specific-header)
1230 (spam-necessary-extra-headers)))
1231 (setq score
1232 (spam-extra-header-to-number header headers))
1233 (when score
1234 (return)))
1235 (or score 0)))
1236
1237(defun spam-generic-score (&optional recheck)
1238 "Invoke whatever scoring method we can."
1239 (interactive "P")
1240 (cond
1241 ((or spam-use-spamassassin spam-use-spamassassin-headers)
1242 (spam-spamassassin-score recheck))
1243 ((or spam-use-bsfilter spam-use-bsfilter-headers)
1244 (spam-bsfilter-score recheck))
1245 (spam-use-crm114
1246 (spam-crm114-score))
1247 (t (spam-bogofilter-score recheck))))
1248;;}}}
1249
1250;;{{{ set up widening, processor checks
1251
1252;;; set up IMAP widening if it's necessary
1253(defun spam-setup-widening ()
1254 (when (spam-widening-needed-p)
1255 (setq nnimap-split-download-body-default t)))
1256
1257(defun spam-widening-needed-p (&optional force-symbols)
1258 (let (found)
1259 (dolist (backend (spam-backend-list))
1260 (when (and (spam-backend-statistical-p backend)
1261 (or (symbol-value backend)
1262 (memq backend force-symbols)))
1263 (setq found backend)))
1264 found))
1265
519(defvar spam-list-of-processors 1266(defvar spam-list-of-processors
520 '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) 1267 ;; note the nil processors are not defined in gnus.el
521 (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) 1268 '((gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
1269 (gnus-group-spam-exit-processor-bsfilter spam spam-use-bsfilter)
522 (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) 1270 (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist)
523 (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) 1271 (gnus-group-spam-exit-processor-ifile spam spam-use-ifile)
524 (gnus-group-spam-exit-processor-stat spam spam-use-stat) 1272 (gnus-group-spam-exit-processor-stat spam spam-use-stat)
525 (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) 1273 (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle)
1274 (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
1275 (gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) ;; Buggy?
526 (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) 1276 (gnus-group-ham-exit-processor-ifile ham spam-use-ifile)
527 (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) 1277 (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter)
1278 (gnus-group-ham-exit-processor-bsfilter ham spam-use-bsfilter)
528 (gnus-group-ham-exit-processor-stat ham spam-use-stat) 1279 (gnus-group-ham-exit-processor-stat ham spam-use-stat)
529 (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) 1280 (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist)
530 (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) 1281 (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB)
531 (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) 1282 (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy)
1283 (gnus-group-ham-exit-processor-spamassassin ham spam-use-spamassassin)
532 (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) 1284 (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle))
533 "The spam-list-of-processors list contains pairs associating a 1285 "The OBSOLETE `spam-list-of-processors' list.
534ham/spam exit processor variable with a classification and a 1286This list contains pairs associating the obsolete ham/spam exit
535spam-use-* variable.") 1287processor variables with a classification and a spam-use-*
536 1288variable. When the processor variable is nil, just the
537(defun spam-group-processor-p (group processor) 1289classification and spam-use-* check variable are used. This is
1290superceded by the new spam backend code, so it's only consulted
1291for backwards compatibility.")
1292
1293(defun spam-group-processor-p (group backend &optional classification)
1294 "Checks if GROUP has a BACKEND with CLASSIFICATION registered.
1295Also accepts the obsolete processors, which can be found in
1296gnus.el and in spam-list-of-processors. In the case of mover
1297backends, checks the setting of spam-summary-exit-behavior in
1298addition to the set values for the group."
538 (if (and (stringp group) 1299 (if (and (stringp group)
539 (symbolp processor)) 1300 (symbolp backend))
540 (or (member processor (nth 0 (gnus-parameter-spam-process group))) 1301 (let ((old-style (assq backend spam-list-of-processors))
541 (spam-group-processor-multiple-p 1302 (parameters (nth 0 (gnus-parameter-spam-process group)))
542 group 1303 found)
543 (cdr-safe (assoc processor spam-list-of-processors)))) 1304 (if old-style ; old-style processor
1305 (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style))
1306 ;; now search for the parameter
1307 (dolist (parameter parameters)
1308 (when (and (null found)
1309 (listp parameter)
1310 (eq classification (nth 0 parameter))
1311 (eq backend (nth 1 parameter)))
1312 (setq found t)))
1313
1314 ;; now, if the parameter was not found, do the
1315 ;; spam-summary-exit-behavior-logic for mover backends
1316 (unless found
1317 (when (spam-backend-mover-p backend)
1318 (setq
1319 found
1320 (cond
1321 ((eq spam-summary-exit-behavior 'move-all) t)
1322 ((eq spam-summary-exit-behavior 'move-none) nil)
1323 ((eq spam-summary-exit-behavior 'default)
1324 (or (eq classification 'spam) ;move spam out of all groups
1325 ;; move ham out of spam groups
1326 (and (eq classification 'ham)
1327 (spam-group-spam-contents-p group))))
1328 (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s"
1329 spam-summary-exit-behavior))))))
1330
1331 found))
544 nil)) 1332 nil))
545 1333
546(defun spam-group-processor-multiple-p (group processor-info) 1334;;}}}
547 (let* ((classification (nth 0 processor-info))
548 (check (nth 1 processor-info))
549 (parameters (nth 0 (gnus-parameter-spam-process group)))
550 found)
551 (dolist (parameter parameters)
552 (when (and (null found)
553 (listp parameter)
554 (eq classification (nth 0 parameter))
555 (eq check (nth 1 parameter)))
556 (setq found t)))
557 found))
558
559(defun spam-group-spam-processor-report-gmane-p (group)
560 (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
561
562(defun spam-group-spam-processor-bogofilter-p (group)
563 (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
564
565(defun spam-group-spam-processor-blacklist-p (group)
566 (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
567
568(defun spam-group-spam-processor-ifile-p (group)
569 (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
570
571(defun spam-group-ham-processor-ifile-p (group)
572 (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
573 1335
574(defun spam-group-spam-processor-spamoracle-p (group) 1336;;{{{ Summary entry and exit processing.
575 (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
576 1337
577(defun spam-group-ham-processor-bogofilter-p (group) 1338(defun spam-mark-junk-as-spam-routine ()
578 (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter)) 1339 ;; check the global list of group names spam-junk-mailgroups and the
579 1340 ;; group parameters
580(defun spam-group-spam-processor-stat-p (group) 1341 (when (spam-group-spam-contents-p gnus-newsgroup-name)
581 (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat)) 1342 (gnus-message 6 "Marking %s articles as spam"
582 1343 (if spam-mark-only-unseen-as-spam
583(defun spam-group-ham-processor-stat-p (group) 1344 "unseen"
584 (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat)) 1345 "unread"))
585 1346 (let ((articles (if spam-mark-only-unseen-as-spam
586(defun spam-group-ham-processor-whitelist-p (group) 1347 gnus-newsgroup-unseen
587 (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist)) 1348 gnus-newsgroup-unreads)))
588 1349 (if spam-mark-new-messages-in-spam-group-as-spam
589(defun spam-group-ham-processor-BBDB-p (group) 1350 (dolist (article articles)
590 (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB)) 1351 (gnus-summary-mark-article article gnus-spam-mark))
591 1352 (gnus-message 9 "Did not mark new messages as spam.")))))
592(defun spam-group-ham-processor-copy-p (group)
593 (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
594
595(defun spam-group-ham-processor-spamoracle-p (group)
596 (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
597
598;;; Summary entry and exit processing.
599 1353
600(defun spam-summary-prepare () 1354(defun spam-summary-prepare ()
601 (setq spam-old-ham-articles 1355 (setq spam-old-articles
602 (spam-list-articles gnus-newsgroup-articles 'ham)) 1356 (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham))
603 (setq spam-old-spam-articles 1357 (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam))))
604 (spam-list-articles gnus-newsgroup-articles 'spam))
605 (spam-mark-junk-as-spam-routine)) 1358 (spam-mark-junk-as-spam-routine))
606 1359
607;; The spam processors are invoked for any group, spam or ham or neither 1360;; The spam processors are invoked for any group, spam or ham or neither
@@ -609,141 +1362,74 @@ spam-use-* variable.")
609 (unless gnus-group-is-exiting-without-update-p 1362 (unless gnus-group-is-exiting-without-update-p
610 (gnus-message 6 "Exiting summary buffer and applying spam rules") 1363 (gnus-message 6 "Exiting summary buffer and applying spam rules")
611 1364
1365 ;; before we begin, remove any article limits
1366; (ignore-errors
1367; (gnus-summary-pop-limit t))
1368
612 ;; first of all, unregister any articles that are no longer ham or spam 1369 ;; first of all, unregister any articles that are no longer ham or spam
613 ;; we have to iterate over the processors, or else we'll be too slow 1370 ;; we have to iterate over the processors, or else we'll be too slow
614 (dolist (classification '(spam ham)) 1371 (dolist (classification (spam-classifications))
615 (let* ((old-articles (if (eq classification 'spam) 1372 (let* ((old-articles (cdr-safe (assq classification spam-old-articles)))
616 spam-old-spam-articles
617 spam-old-ham-articles))
618 (new-articles (spam-list-articles 1373 (new-articles (spam-list-articles
619 gnus-newsgroup-articles 1374 gnus-newsgroup-articles
620 classification)) 1375 classification))
621 (changed-articles (gnus-set-difference old-articles new-articles))) 1376 (changed-articles (spam-set-difference new-articles old-articles)))
622 ;; now that we have the changed articles, we go through the processors 1377 ;; now that we have the changed articles, we go through the processors
623 (dolist (processor-param spam-list-of-processors) 1378 (dolist (backend (spam-backend-list))
624 (let ((processor (nth 0 processor-param)) 1379 (let (unregister-list)
625 (processor-classification (nth 1 processor-param))
626 (check (nth 2 processor-param))
627 unregister-list)
628 (dolist (article changed-articles) 1380 (dolist (article changed-articles)
629 (let ((id (spam-fetch-field-message-id-fast article))) 1381 (let ((id (spam-fetch-field-message-id-fast article)))
630 (when (spam-log-unregistration-needed-p 1382 (when (spam-log-unregistration-needed-p
631 id 'process classification check) 1383 id 'process classification backend)
632 (push article unregister-list)))) 1384 (push article unregister-list))))
633 ;; call spam-register-routine with specific articles to unregister, 1385 ;; call spam-register-routine with specific articles to unregister,
634 ;; when there are articles to unregister and the check is enabled 1386 ;; when there are articles to unregister and the check is enabled
635 (when (and unregister-list (symbol-value check)) 1387 (when (and unregister-list (symbol-value backend))
636 (spam-register-routine classification check t unregister-list)))))) 1388 (spam-backend-put-article-todo-list backend
637 1389 classification
638 ;; find all the spam processors applicable to this group 1390 unregister-list
639 (dolist (processor-param spam-list-of-processors) 1391 t))))))
640 (let ((processor (nth 0 processor-param))
641 (classification (nth 1 processor-param))
642 (check (nth 2 processor-param)))
643 (when (and (eq 'spam classification)
644 (spam-group-processor-p gnus-newsgroup-name processor))
645 (spam-register-routine classification check))))
646
647 (if spam-move-spam-nonspam-groups-only
648 (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
649 (spam-mark-spam-as-expired-and-move-routine
650 (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
651 (gnus-message 5 "Marking spam as expired and moving it to %s"
652 gnus-newsgroup-name)
653 (spam-mark-spam-as-expired-and-move-routine
654 (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
655
656 ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
657 ;; expire spam, in case the above did not expire them
658 (gnus-message 5 "Marking spam as expired without moving it")
659 (spam-mark-spam-as-expired-and-move-routine nil)
660
661 (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
662 (and (spam-group-spam-contents-p gnus-newsgroup-name)
663 spam-process-ham-in-spam-groups)
664 spam-process-ham-in-nonham-groups)
665 ;; find all the ham processors applicable to this group
666 (dolist (processor-param spam-list-of-processors)
667 (let ((processor (nth 0 processor-param))
668 (classification (nth 1 processor-param))
669 (check (nth 2 processor-param)))
670 (when (and (eq 'ham classification)
671 (spam-group-processor-p gnus-newsgroup-name processor))
672 (spam-register-routine classification check)))))
673
674 (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
675 (gnus-message 5 "Copying ham")
676 (spam-ham-copy-routine
677 (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
678
679 ;; now move all ham articles out of spam groups
680 (when (spam-group-spam-contents-p gnus-newsgroup-name)
681 (gnus-message 5 "Moving ham messages from spam group")
682 (spam-ham-move-routine
683 (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
684
685 (setq spam-old-ham-articles nil)
686 (setq spam-old-spam-articles nil))
687 1392
688(defun spam-mark-junk-as-spam-routine () 1393 ;; do the non-moving backends first, then the moving ones
689 ;; check the global list of group names spam-junk-mailgroups and the 1394 (dolist (backend-type '(non-mover mover))
690 ;; group parameters 1395 (dolist (classification (spam-classifications))
691 (when (spam-group-spam-contents-p gnus-newsgroup-name) 1396 (dolist (backend (spam-backend-list backend-type))
692 (gnus-message 6 "Marking %s articles as spam" 1397 (when (spam-group-processor-p
693 (if spam-mark-only-unseen-as-spam 1398 gnus-newsgroup-name
694 "unseen" 1399 backend
695 "unread")) 1400 classification)
696 (let ((articles (if spam-mark-only-unseen-as-spam 1401 (spam-backend-put-article-todo-list backend
697 gnus-newsgroup-unseen 1402 classification
698 gnus-newsgroup-unreads))) 1403 (spam-list-articles
699 (if spam-mark-new-messages-in-spam-group-as-spam 1404 gnus-newsgroup-articles
700 (dolist (article articles) 1405 classification))))))
701 (gnus-summary-mark-article article gnus-spam-mark))
702 (gnus-message 9 "Did not mark new messages as spam.")))))
703 1406
704(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) 1407 (spam-resolve-registrations-routine) ; do the registrations now
705 (if (and (car-safe groups) (listp (car-safe groups))) 1408
706 (apply 'spam-mark-spam-as-expired-and-move-routine (car groups)) 1409 ;; we mark all the leftover spam articles as expired at the end
707 (gnus-summary-kill-process-mark) 1410 (dolist (article (spam-list-articles
708 (let ((articles gnus-newsgroup-articles) 1411 gnus-newsgroup-articles
709 (backend-supports-deletions 1412 'spam))
710 (gnus-check-backend-function 1413 (gnus-summary-mark-article article gnus-expirable-mark)))
711 'request-move-article gnus-newsgroup-name)) 1414
712 article tomove deletep) 1415 (setq spam-old-articles nil))
713 (dolist (article articles) 1416
714 (when (eq (gnus-summary-article-mark article) gnus-spam-mark) 1417;;}}}
715 (gnus-summary-mark-article article gnus-expirable-mark)
716 (push article tomove)))
717
718 ;; now do the actual copies
719 (dolist (group groups)
720 (when (and tomove
721 (stringp group))
722 (dolist (article tomove)
723 (gnus-summary-set-process-mark article))
724 (when tomove
725 (if (or (not backend-supports-deletions)
726 (> (length groups) 1))
727 (progn
728 (gnus-summary-copy-article nil group)
729 (setq deletep t))
730 (gnus-summary-move-article nil group)))))
731 1418
732 ;; now delete the articles, if there was a copy done, and the 1419;;{{{ spam-use-move and spam-use-copy backend support functions
733 ;; backend allows it
734 (when (and deletep backend-supports-deletions)
735 (dolist (article tomove)
736 (gnus-summary-set-process-mark article))
737 (when tomove
738 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
739 (gnus-summary-delete-article nil))))
740 1420
741 (gnus-summary-yank-process-mark)))) 1421(defun spam-copy-or-move-routine (copy groups articles classification)
742 1422
743(defun spam-ham-copy-or-move-routine (copy groups) 1423 (when (and (car-safe groups) (listp (car-safe groups)))
1424 (setq groups (pop groups)))
1425
1426 (unless (listp groups)
1427 (setq groups (list groups)))
1428
1429 ;; remove the current process mark
744 (gnus-summary-kill-process-mark) 1430 (gnus-summary-kill-process-mark)
745 (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham)) 1431
746 (backend-supports-deletions 1432 (let ((backend-supports-deletions
747 (gnus-check-backend-function 1433 (gnus-check-backend-function
748 'request-move-article gnus-newsgroup-name)) 1434 'request-move-article gnus-newsgroup-name))
749 (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) 1435 (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
@@ -755,69 +1441,95 @@ spam-use-* variable.")
755 1441
756 ;; now do the actual move 1442 ;; now do the actual move
757 (dolist (group groups) 1443 (dolist (group groups)
758 (when (and todo (stringp group)) 1444 (when (and articles (stringp group))
759 (dolist (article todo)
760 (when spam-mark-ham-unread-before-move-from-spam-group
761 (gnus-summary-mark-article article gnus-unread-mark))
762 (gnus-summary-set-process-mark article))
763
764 (if respool ; respooling is with a "fake" group
765 (let ((spam-split-disabled
766 (or spam-split-disabled
767 spam-disable-spam-split-during-ham-respool)))
768 (gnus-summary-respool-article nil respool-method))
769 (if (or (not backend-supports-deletions) ; else, we are not respooling
770 (> (length groups) 1))
771 (progn ; if copying, copy and set deletep
772 (gnus-summary-copy-article nil group)
773 (setq deletep t))
774 (gnus-summary-move-article nil group))))) ; else move articles
775
776 ;; now delete the articles, unless a) copy is t, and there was a copy done
777 ;; b) a move was done to a single group
778 ;; c) backend-supports-deletions is nil
779 (unless copy
780 (when (and deletep backend-supports-deletions)
781 (dolist (article todo)
782 (gnus-summary-set-process-mark article))
783 (when todo
784 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
785 (gnus-summary-delete-article nil))))))
786
787 (gnus-summary-yank-process-mark))
788
789(defun spam-ham-copy-routine (&rest groups)
790 (if (and (car-safe groups) (listp (car-safe groups)))
791 (apply 'spam-ham-copy-routine (car groups))
792 (spam-ham-copy-or-move-routine t groups)))
793
794(defun spam-ham-move-routine (&rest groups)
795 (if (and (car-safe groups) (listp (car-safe groups)))
796 (apply 'spam-ham-move-routine (car groups))
797 (spam-ham-copy-or-move-routine nil groups)))
798
799(eval-and-compile
800 (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
801 'point-at-eol
802 'line-end-position)))
803 1445
1446 ;; first, mark the article with the process mark and, if needed,
1447 ;; the unread or expired mark (for ham and spam respectively)
1448 (dolist (article articles)
1449 (when (and (eq classification 'ham)
1450 spam-mark-ham-unread-before-move-from-spam-group)
1451 (gnus-message 9 "Marking ham article %d unread before move"
1452 article)
1453 (gnus-summary-mark-article article gnus-unread-mark))
1454 (when (and (eq classification 'spam)
1455 (not copy))
1456 (gnus-message 9 "Marking spam article %d expirable before move"
1457 article)
1458 (gnus-summary-mark-article article gnus-expirable-mark))
1459 (gnus-summary-set-process-mark article)
1460
1461 (if respool ; respooling is with a "fake" group
1462 (let ((spam-split-disabled
1463 (or spam-split-disabled
1464 (and (eq classification 'ham)
1465 spam-disable-spam-split-during-ham-respool))))
1466 (gnus-message 9 "Respooling article %d with method %s"
1467 article respool-method)
1468 (gnus-summary-respool-article nil respool-method))
1469 (if (or (not backend-supports-deletions) ; else, we are not respooling
1470 (> (length groups) 1))
1471 (progn ; if copying, copy and set deletep
1472 (gnus-message 9 "Copying article %d to group %s"
1473 article group)
1474 (gnus-summary-copy-article nil group)
1475 (setq deletep t))
1476 (gnus-message 9 "Moving article %d to group %s"
1477 article group)
1478 (gnus-summary-move-article nil group))))) ; else move articles
1479
1480 ;; now delete the articles, unless a) copy is t, and there was a copy done
1481 ;; b) a move was done to a single group
1482 ;; c) backend-supports-deletions is nil
1483 (unless copy
1484 (when (and deletep backend-supports-deletions)
1485 (dolist (article articles)
1486 (gnus-summary-set-process-mark article)
1487 (gnus-message 9 "Deleting article %d" article))
1488 (when articles
1489 (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1490 (gnus-summary-delete-article nil)))))
1491
1492 (gnus-summary-yank-process-mark)
1493 (length articles))))
1494
1495(defun spam-copy-spam-routine (articles)
1496 (spam-copy-or-move-routine
1497 t
1498 (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1499 articles
1500 'spam))
1501
1502(defun spam-move-spam-routine (articles)
1503 (spam-copy-or-move-routine
1504 nil
1505 (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1506 articles
1507 'spam))
1508
1509(defun spam-copy-ham-routine (articles)
1510 (spam-copy-or-move-routine
1511 t
1512 (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1513 articles
1514 'ham))
1515
1516(defun spam-move-ham-routine (articles)
1517 (spam-copy-or-move-routine
1518 nil
1519 (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1520 articles
1521 'ham))
1522
1523;;}}}
1524
1525;;{{{ article and field retrieval code
804(defun spam-get-article-as-string (article) 1526(defun spam-get-article-as-string (article)
805 (let ((article-buffer (spam-get-article-as-buffer article)) 1527 (when (numberp article)
806 article-string) 1528 (with-temp-buffer
807 (when article-buffer 1529 (gnus-request-article-this-buffer
808 (save-window-excursion 1530 article
809 (set-buffer article-buffer) 1531 gnus-newsgroup-name)
810 (setq article-string (buffer-string)))) 1532 (buffer-string))))
811 article-string))
812
813(defun spam-get-article-as-buffer (article)
814 (let ((article-buffer))
815 (when (numberp article)
816 (save-window-excursion
817 (gnus-summary-goto-subject article)
818 (gnus-summary-show-article t)
819 (setq article-buffer (get-buffer gnus-article-buffer))))
820 article-buffer))
821 1533
822;; disabled for now 1534;; disabled for now
823;; (defun spam-get-article-as-filename (article) 1535;; (defun spam-get-article-as-filename (article)
@@ -831,72 +1543,79 @@ spam-use-* variable.")
831;; article-filename 1543;; article-filename
832;; nil))) 1544;; nil)))
833 1545
834(defun spam-fetch-field-from-fast (article) 1546(defun spam-fetch-field-fast (article field &optional prepared-data-header)
835 "Fetch the `from' field quickly, using the internal gnus-data-list function" 1547 "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function.
836 (if (and (numberp article) 1548When PREPARED-DATA-HEADER is given, don't look in the Gnus data.
837 (assoc article (gnus-data-list nil))) 1549When FIELD is 'number, ARTICLE can be any number (since we want
838 (mail-header-from 1550to find it out)."
839 (gnus-data-header (assoc article (gnus-data-list nil)))) 1551 (when (numberp article)
840 nil)) 1552 (let* ((data-header (or prepared-data-header
841 1553 (spam-fetch-article-header article))))
842(defun spam-fetch-field-subject-fast (article) 1554 (if (arrayp data-header)
843 "Fetch the `subject' field quickly, using the internal 1555 (cond
844 gnus-data-list function" 1556 ((equal field 'number)
845 (if (and (numberp article) 1557 (mail-header-number data-header))
846 (assoc article (gnus-data-list nil))) 1558 ((equal field 'from)
847 (mail-header-subject 1559 (mail-header-from data-header))
848 (gnus-data-header (assoc article (gnus-data-list nil)))) 1560 ((equal field 'message-id)
849 nil)) 1561 (mail-header-message-id data-header))
850 1562 ((equal field 'subject)
851(defun spam-fetch-field-message-id-fast (article) 1563 (mail-header-subject data-header))
852 "Fetch the `Message-ID' field quickly, using the internal 1564 ((equal field 'references)
853 gnus-data-list function" 1565 (mail-header-references data-header))
854 (if (and (numberp article) 1566 ((equal field 'date)
855 (assoc article (gnus-data-list nil))) 1567 (mail-header-date data-header))
856 (mail-header-message-id 1568 ((equal field 'xref)
857 (gnus-data-header (assoc article (gnus-data-list nil)))) 1569 (mail-header-xref data-header))
858 nil)) 1570 ((equal field 'extra)
1571 (mail-header-extra data-header))
1572 (t
1573 (gnus-error
1574 5
1575 "spam-fetch-field-fast: unknown field %s requested"
1576 field)
1577 nil))
1578 (gnus-message 6 "Article %d has a nil data header" article)))))
1579
1580(defun spam-fetch-field-from-fast (article &optional prepared-data-header)
1581 (spam-fetch-field-fast article 'from prepared-data-header))
1582
1583(defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
1584 (spam-fetch-field-fast article 'subject prepared-data-header))
1585
1586(defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
1587 (spam-fetch-field-fast article 'message-id prepared-data-header))
1588
1589(defun spam-generate-fake-headers (article)
1590 (let ((dh (spam-fetch-article-header article)))
1591 (if dh
1592 (concat
1593 (format
1594 ;; 80-character limit makes for strange constructs
1595 (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
1596 "Date: %s\nReferences: %s\nXref: %s\n")
1597 (spam-fetch-field-fast article 'from dh)
1598 (spam-fetch-field-fast article 'subject dh)
1599 (spam-fetch-field-fast article 'message-id dh)
1600 (spam-fetch-field-fast article 'date dh)
1601 (spam-fetch-field-fast article 'references dh)
1602 (spam-fetch-field-fast article 'xref dh))
1603 (when (spam-fetch-field-fast article 'extra dh)
1604 (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
1605 (gnus-message
1606 5
1607 "spam-generate-fake-headers: article %d didn't have a valid header"
1608 article))))
1609
1610(defun spam-fetch-article-header (article)
1611 (save-excursion
1612 (set-buffer gnus-summary-buffer)
1613 (gnus-read-header article)
1614 (nth 3 (assq article gnus-newsgroup-data))))
1615;;}}}
1616
1617;;{{{ Spam determination.
859 1618
860
861;;;; Spam determination.
862
863(defvar spam-list-of-checks
864 '((spam-use-blacklist . spam-check-blacklist)
865 (spam-use-regex-headers . spam-check-regex-headers)
866 (spam-use-regex-body . spam-check-regex-body)
867 (spam-use-whitelist . spam-check-whitelist)
868 (spam-use-BBDB . spam-check-BBDB)
869 (spam-use-ifile . spam-check-ifile)
870 (spam-use-spamoracle . spam-check-spamoracle)
871 (spam-use-stat . spam-check-stat)
872 (spam-use-blackholes . spam-check-blackholes)
873 (spam-use-hashcash . spam-check-hashcash)
874 (spam-use-bogofilter-headers . spam-check-bogofilter-headers)
875 (spam-use-bogofilter . spam-check-bogofilter))
876 "The spam-list-of-checks list contains pairs associating a
877parameter variable with a spam checking function. If the
878parameter variable is true, then the checking function is called,
879and its value decides what happens. Each individual check may
880return nil, t, or a mailgroup name. The value nil means that the
881check does not yield a decision, and so, that further checks are
882needed. The value t means that the message is definitely not
883spam, and that further spam checks should be inhibited.
884Otherwise, a mailgroup name or the symbol 'spam (depending on
885spam-split-symbolic-return) is returned where the mail should go,
886and further checks are also inhibited. The usual mailgroup name
887is the value of `spam-split-group', meaning that the message is
888definitely a spam.")
889
890(defvar spam-list-of-statistical-checks
891 '(spam-use-ifile
892 spam-use-regex-body
893 spam-use-stat
894 spam-use-bogofilter
895 spam-use-spamoracle)
896 "The spam-list-of-statistical-checks list contains all the mail
897splitters that need to have the full message body available.")
898
899;;;TODO: modify to invoke self with each check if invoked without specifics
900(defun spam-split (&rest specific-checks) 1619(defun spam-split (&rest specific-checks)
901 "Split this message into the `spam' group if it is spam. 1620 "Split this message into the `spam' group if it is spam.
902This function can be used as an entry in the variable `nnmail-split-fancy', 1621This function can be used as an entry in the variable `nnmail-split-fancy',
@@ -914,38 +1633,41 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
914 (setq spam-split-group-choice check) 1633 (setq spam-split-group-choice check)
915 (setq specific-checks (delq check specific-checks)))) 1634 (setq specific-checks (delq check specific-checks))))
916 1635
917 (let ((spam-split-group spam-split-group-choice)) 1636 (let ((spam-split-group spam-split-group-choice)
1637 (widening-needed-check (spam-widening-needed-p specific-checks)))
918 (save-excursion 1638 (save-excursion
919 (save-restriction 1639 (save-restriction
920 (dolist (check spam-list-of-statistical-checks) 1640 (when widening-needed-check
921 (when (and (symbolp check) (symbol-value check)) 1641 (widen)
922 (widen) 1642 (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
923 (gnus-message 8 "spam-split: widening the buffer (%s requires it)" 1643 widening-needed-check))
924 (symbol-name check)) 1644 (let ((backends (spam-backend-list))
925 (return)))
926 ;; (progn (widen) (debug (buffer-string)))
927 (let ((list-of-checks spam-list-of-checks)
928 decision) 1645 decision)
929 (while (and list-of-checks (not decision)) 1646 (while (and backends (not decision))
930 (let ((pair (pop list-of-checks))) 1647 (let* ((backend (pop backends))
931 (when (and (symbol-value (car pair)) 1648 (check-function (spam-backend-check backend))
932 (or (null specific-checks) 1649 (spam-split-group (if spam-split-symbolic-return
933 (memq (car pair) specific-checks))) 1650 'spam
934 (gnus-message 5 "spam-split: calling the %s function" 1651 spam-split-group)))
935 (symbol-name (cdr pair))) 1652 (when (or
936 (setq decision (funcall (cdr pair))) 1653 ;; either, given specific checks, this is one of them
1654 (memq backend specific-checks)
1655 ;; or, given no specific checks, spam-use-CHECK is set
1656 (and (null specific-checks) (symbol-value backend)))
1657 (gnus-message 6 "spam-split: calling the %s function"
1658 check-function)
1659 (setq decision (funcall check-function))
937 ;; if we got a decision at all, save the current check 1660 ;; if we got a decision at all, save the current check
938 (when decision 1661 (when decision
939 (setq spam-split-last-successful-check (car pair))) 1662 (setq spam-split-last-successful-check backend))
940 1663
941 (when (eq decision 'spam) 1664 (when (eq decision 'spam)
942 (if spam-split-symbolic-return 1665 (unless spam-split-symbolic-return
943 (setq decision spam-split-group)
944 (gnus-error 1666 (gnus-error
945 5 1667 5
946 (format "spam-split got %s but %s is nil" 1668 (format "spam-split got %s but %s is nil"
947 (symbol-name decision) 1669 decision
948 (symbol-name spam-split-symbolic-return)))))))) 1670 spam-split-symbolic-return)))))))
949 (if (eq decision t) 1671 (if (eq decision t)
950 (if spam-split-symbolic-return-positive 'ham nil) 1672 (if spam-split-symbolic-return-positive 'ham nil)
951 decision)))))))) 1673 decision))))))))
@@ -957,143 +1679,149 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
957 (let* ((group gnus-newsgroup-name) 1679 (let* ((group gnus-newsgroup-name)
958 (autodetect (gnus-parameter-spam-autodetect group)) 1680 (autodetect (gnus-parameter-spam-autodetect group))
959 (methods (gnus-parameter-spam-autodetect-methods group)) 1681 (methods (gnus-parameter-spam-autodetect-methods group))
960 (first-method (nth 0 methods))) 1682 (first-method (nth 0 methods))
961 (when (and autodetect 1683 (articles (if spam-autodetect-recheck-messages
962 (not (equal first-method 'none))) 1684 gnus-newsgroup-articles
963 (mapcar 1685 gnus-newsgroup-unseen))
964 (lambda (article) 1686 article-cannot-be-faked)
965 (let ((id (spam-fetch-field-message-id-fast article)) 1687
966 (subject (spam-fetch-field-subject-fast article)) 1688
967 (sender (spam-fetch-field-from-fast article))) 1689 (dolist (backend methods)
968 (unless (and spam-log-to-registry 1690 (when (spam-backend-statistical-p backend)
969 (spam-log-registered-p id 'incoming)) 1691 (setq article-cannot-be-faked t)
1692 (return)))
1693
1694 (when (memq 'default methods)
1695 (setq article-cannot-be-faked t))
1696
1697 (when (and autodetect
1698 (not (equal first-method 'none)))
1699 (mapcar
1700 (lambda (article)
1701 (let ((id (spam-fetch-field-message-id-fast article))
1702 (subject (spam-fetch-field-subject-fast article))
1703 (sender (spam-fetch-field-from-fast article))
1704 registry-lookup)
1705
1706 (unless id
1707 (gnus-message 6 "Article %d has no message ID!" article))
1708
1709 (when (and id spam-log-to-registry)
1710 (setq registry-lookup (spam-log-registration-type id 'incoming))
1711 (when registry-lookup
1712 (gnus-message
1713 9
1714 "spam-find-spam: message %s was already registered incoming"
1715 id)))
1716
970 (let* ((spam-split-symbolic-return t) 1717 (let* ((spam-split-symbolic-return t)
971 (spam-split-symbolic-return-positive t) 1718 (spam-split-symbolic-return-positive t)
1719 (fake-headers (spam-generate-fake-headers article))
972 (split-return 1720 (split-return
973 (with-temp-buffer 1721 (or registry-lookup
974 (gnus-request-article-this-buffer 1722 (with-temp-buffer
975 article 1723 (if article-cannot-be-faked
976 group) 1724 (gnus-request-article-this-buffer
977 (if (or (null first-method) 1725 article
978 (equal first-method 'default)) 1726 group)
979 (spam-split) 1727 ;; else, we fake the article
980 (apply 'spam-split methods))))) 1728 (when fake-headers (insert fake-headers)))
1729 (if (or (null first-method)
1730 (equal first-method 'default))
1731 (spam-split)
1732 (apply 'spam-split methods))))))
981 (if (equal split-return 'spam) 1733 (if (equal split-return 'spam)
982 (gnus-summary-mark-article article gnus-spam-mark)) 1734 (gnus-summary-mark-article article gnus-spam-mark))
983 1735
984 (when (and split-return spam-log-to-registry) 1736 (when (and id split-return spam-log-to-registry)
985 (when (zerop (gnus-registry-group-count id)) 1737 (when (zerop (gnus-registry-group-count id))
986 (gnus-registry-add-group 1738 (gnus-registry-add-group
987 id group subject sender)) 1739 id group subject sender))
1740
1741 (unless registry-lookup
1742 (spam-log-processing-to-registry
1743 id
1744 'incoming
1745 split-return
1746 spam-split-last-successful-check
1747 group))))))
1748 articles))))
1749
1750;;}}}
1751
1752;;{{{ registration/unregistration functions
1753
1754(defun spam-resolve-registrations-routine ()
1755 "Go through the backends and register or unregister articles as needed."
1756 (dolist (backend-type '(non-mover mover))
1757 (dolist (classification (spam-classifications))
1758 (dolist (backend (spam-backend-list backend-type))
1759 (let ((rlist (spam-backend-get-article-todo-list
1760 backend classification))
1761 (ulist (spam-backend-get-article-todo-list
1762 backend classification t))
1763 (delcount 0))
1764
1765 ;; clear the old lists right away
1766 (spam-backend-put-article-todo-list backend
1767 classification
1768 nil
1769 nil)
1770 (spam-backend-put-article-todo-list backend
1771 classification
1772 nil
1773 t)
1774
1775 ;; eliminate duplicates
1776 (dolist (article (copy-sequence ulist))
1777 (when (memq article rlist)
1778 (incf delcount)
1779 (setq rlist (delq article rlist))
1780 (setq ulist (delq article ulist))))
1781
1782 (unless (zerop delcount)
1783 (gnus-message
1784 9
1785 "%d messages were saved the trouble of unregistering and then registering"
1786 delcount))
1787
1788 ;; unregister articles
1789 (unless (zerop (length ulist))
1790 (let ((num (spam-unregister-routine classification backend ulist)))
1791 (when (> num 0)
1792 (gnus-message
1793 6
1794 "%d %s messages were unregistered by backend %s."
1795 num
1796 classification
1797 backend))))
1798
1799 ;; register articles
1800 (unless (zerop (length rlist))
1801 (let ((num (spam-register-routine classification backend rlist)))
1802 (when (> num 0)
1803 (gnus-message
1804 6
1805 "%d %s messages were registered by backend %s."
1806 num
1807 classification
1808 backend)))))))))
988 1809
989 (spam-log-processing-to-registry 1810(defun spam-unregister-routine (classification
990 id 1811 backend
991 'incoming 1812 specific-articles)
992 split-return 1813 (spam-register-routine classification backend specific-articles t))
993 spam-split-last-successful-check
994 group))))))
995 (if spam-autodetect-recheck-messages
996 gnus-newsgroup-articles
997 gnus-newsgroup-unseen)))))
998
999(defvar spam-registration-functions
1000 ;; first the ham register, second the spam register function
1001 ;; third the ham unregister, fourth the spam unregister function
1002 '((spam-use-blacklist nil
1003 spam-blacklist-register-routine
1004 nil
1005 spam-blacklist-unregister-routine)
1006 (spam-use-whitelist spam-whitelist-register-routine
1007 nil
1008 spam-whitelist-unregister-routine
1009 nil)
1010 (spam-use-BBDB spam-BBDB-register-routine
1011 nil
1012 spam-BBDB-unregister-routine
1013 nil)
1014 (spam-use-ifile spam-ifile-register-ham-routine
1015 spam-ifile-register-spam-routine
1016 spam-ifile-unregister-ham-routine
1017 spam-ifile-unregister-spam-routine)
1018 (spam-use-spamoracle spam-spamoracle-learn-ham
1019 spam-spamoracle-learn-spam
1020 spam-spamoracle-unlearn-ham
1021 spam-spamoracle-unlearn-spam)
1022 (spam-use-stat spam-stat-register-ham-routine
1023 spam-stat-register-spam-routine
1024 spam-stat-unregister-ham-routine
1025 spam-stat-unregister-spam-routine)
1026 ;; note that spam-use-gmane is not a legitimate check
1027 (spam-use-gmane nil
1028 spam-report-gmane-register-routine
1029 ;; does Gmane support unregistration?
1030 nil
1031 nil)
1032 (spam-use-bogofilter spam-bogofilter-register-ham-routine
1033 spam-bogofilter-register-spam-routine
1034 spam-bogofilter-unregister-ham-routine
1035 spam-bogofilter-unregister-spam-routine))
1036 "The spam-registration-functions list contains pairs
1037associating a parameter variable with the ham and spam
1038registration functions, and the ham and spam unregistration
1039functions")
1040
1041(defun spam-classification-valid-p (classification)
1042 (or (eq classification 'spam)
1043 (eq classification 'ham)))
1044
1045(defun spam-process-type-valid-p (process-type)
1046 (or (eq process-type 'incoming)
1047 (eq process-type 'process)))
1048
1049(defun spam-registration-check-valid-p (check)
1050 (assoc check spam-registration-functions))
1051
1052(defun spam-unregistration-check-valid-p (check)
1053 (assoc check spam-registration-functions))
1054
1055(defun spam-registration-function (classification check)
1056 (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1057 (if (eq classification 'spam)
1058 (nth 1 flist)
1059 (nth 0 flist))))
1060
1061(defun spam-unregistration-function (classification check)
1062 (let ((flist (cdr-safe (assoc check spam-registration-functions))))
1063 (if (eq classification 'spam)
1064 (nth 3 flist)
1065 (nth 2 flist))))
1066
1067(defun spam-list-articles (articles classification)
1068 (let ((mark-check (if (eq classification 'spam)
1069 'spam-group-spam-mark-p
1070 'spam-group-ham-mark-p))
1071 list mark-cache-yes mark-cache-no)
1072 (dolist (article articles)
1073 (let ((mark (gnus-summary-article-mark article)))
1074 (unless (memq mark mark-cache-no)
1075 (if (memq mark mark-cache-yes)
1076 (push article list)
1077 ;; else, we have to actually check the mark
1078 (if (funcall mark-check
1079 gnus-newsgroup-name
1080 mark)
1081 (progn
1082 (push article list)
1083 (push mark mark-cache-yes))
1084 (push mark mark-cache-no))))))
1085 list))
1086 1814
1087(defun spam-register-routine (classification 1815(defun spam-register-routine (classification
1088 check 1816 backend
1089 &optional unregister 1817 specific-articles
1090 specific-articles) 1818 &optional unregister)
1091 (when (and (spam-classification-valid-p classification) 1819 (when (and (spam-classification-valid-p classification)
1092 (spam-registration-check-valid-p check)) 1820 (spam-backend-valid-p backend))
1093 (let* ((register-function 1821 (let* ((register-function
1094 (spam-registration-function classification check)) 1822 (spam-backend-function backend classification 'registration))
1095 (unregister-function 1823 (unregister-function
1096 (spam-unregistration-function classification check)) 1824 (spam-backend-function backend classification 'unregistration))
1097 (run-function (if unregister 1825 (run-function (if unregister
1098 unregister-function 1826 unregister-function
1099 register-function)) 1827 register-function))
@@ -1109,40 +1837,46 @@ functions")
1109 gnus-newsgroup-articles 1837 gnus-newsgroup-articles
1110 classification))) 1838 classification)))
1111 ;; process them 1839 ;; process them
1112 (gnus-message 5 "%s %d %s articles with classification %s, check %s" 1840 (when (> (length articles) 0)
1113 (if unregister "Unregistering" "Registering") 1841 (gnus-message 5 "%s %d %s articles as %s using backend %s"
1114 (length articles) 1842 (if unregister "Unregistering" "Registering")
1115 (if specific-articles "specific" "") 1843 (length articles)
1116 (symbol-name classification) 1844 (if specific-articles "specific" "")
1117 (symbol-name check)) 1845 classification
1118 (funcall run-function articles) 1846 backend)
1119 ;; now log all the registrations (or undo them, depending on unregister) 1847 (funcall run-function articles)
1120 (dolist (article articles) 1848 ;; now log all the registrations (or undo them, depending on
1121 (funcall log-function 1849 ;; unregister)
1122 (spam-fetch-field-message-id-fast article) 1850 (dolist (article articles)
1123 'process 1851 (funcall log-function
1124 classification 1852 (spam-fetch-field-message-id-fast article)
1125 check 1853 'process
1126 gnus-newsgroup-name)))))) 1854 classification
1855 backend
1856 gnus-newsgroup-name))))
1857 ;; return the number of articles processed
1858 (length articles))))
1127 1859
1128;;; log a ham- or spam-processor invocation to the registry 1860;;; log a ham- or spam-processor invocation to the registry
1129(defun spam-log-processing-to-registry (id type classification check group) 1861(defun spam-log-processing-to-registry (id type classification backend group)
1130 (when spam-log-to-registry 1862 (when spam-log-to-registry
1131 (if (and (stringp id) 1863 (if (and (stringp id)
1132 (stringp group) 1864 (stringp group)
1133 (spam-process-type-valid-p type) 1865 (spam-process-type-valid-p type)
1134 (spam-classification-valid-p classification) 1866 (spam-classification-valid-p classification)
1135 (spam-registration-check-valid-p check)) 1867 (spam-backend-valid-p backend))
1136 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) 1868 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1137 (cell (list classification check group))) 1869 (cell (list classification backend group)))
1138 (push cell cell-list) 1870 (push cell cell-list)
1139 (gnus-registry-store-extra-entry 1871 (gnus-registry-store-extra-entry
1140 id 1872 id
1141 type 1873 type
1142 cell-list)) 1874 cell-list))
1143 1875
1144 (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group" 1876 (gnus-error
1145 "spam-log-processing-to-registry"))))) 1877 7
1878 (format "%s call with bad ID, type, classification, spam-backend, or group"
1879 "spam-log-processing-to-registry")))))
1146 1880
1147;;; check if a ham- or spam-processor registration has been done 1881;;; check if a ham- or spam-processor registration has been done
1148(defun spam-log-registered-p (id type) 1882(defun spam-log-registered-p (id type)
@@ -1151,76 +1885,104 @@ functions")
1151 (spam-process-type-valid-p type)) 1885 (spam-process-type-valid-p type))
1152 (cdr-safe (gnus-registry-fetch-extra id type)) 1886 (cdr-safe (gnus-registry-fetch-extra id type))
1153 (progn 1887 (progn
1154 (gnus-message 5 (format "%s called with bad ID, type, classification, or check" 1888 (gnus-error
1155 "spam-log-registered-p")) 1889 7
1890 (format "%s called with bad ID, type, classification, or spam-backend"
1891 "spam-log-registered-p"))
1156 nil)))) 1892 nil))))
1157 1893
1894;;; check what a ham- or spam-processor registration says
1895;;; returns nil if conflicting registrations are found
1896(defun spam-log-registration-type (id type)
1897 (let ((count 0)
1898 decision)
1899 (dolist (reg (spam-log-registered-p id type))
1900 (let ((classification (nth 0 reg)))
1901 (when (spam-classification-valid-p classification)
1902 (when (and decision
1903 (not (eq classification decision)))
1904 (setq count (+ 1 count)))
1905 (setq decision classification))))
1906 (if (< 0 count)
1907 nil
1908 decision)))
1909
1910
1158;;; check if a ham- or spam-processor registration needs to be undone 1911;;; check if a ham- or spam-processor registration needs to be undone
1159(defun spam-log-unregistration-needed-p (id type classification check) 1912(defun spam-log-unregistration-needed-p (id type classification backend)
1160 (when spam-log-to-registry 1913 (when spam-log-to-registry
1161 (if (and (stringp id) 1914 (if (and (stringp id)
1162 (spam-process-type-valid-p type) 1915 (spam-process-type-valid-p type)
1163 (spam-classification-valid-p classification) 1916 (spam-classification-valid-p classification)
1164 (spam-registration-check-valid-p check)) 1917 (spam-backend-valid-p backend))
1165 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) 1918 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1166 found) 1919 found)
1167 (dolist (cell cell-list) 1920 (dolist (cell cell-list)
1168 (unless found 1921 (unless found
1169 (when (and (eq classification (nth 0 cell)) 1922 (when (and (eq classification (nth 0 cell))
1170 (eq check (nth 1 cell))) 1923 (eq backend (nth 1 cell)))
1171 (setq found t)))) 1924 (setq found t))))
1172 found) 1925 found)
1173 (progn 1926 (progn
1174 (gnus-message 5 (format "%s called with bad ID, type, classification, or check" 1927 (gnus-error
1175 "spam-log-unregistration-needed-p")) 1928 7
1929 (format "%s called with bad ID, type, classification, or spam-backend"
1930 "spam-log-unregistration-needed-p"))
1176 nil)))) 1931 nil))))
1177 1932
1178 1933
1179;;; undo a ham- or spam-processor registration (the group is not used) 1934;;; undo a ham- or spam-processor registration (the group is not used)
1180(defun spam-log-undo-registration (id type classification check &optional group) 1935(defun spam-log-undo-registration (id type classification backend &optional group)
1181 (when (and spam-log-to-registry 1936 (when (and spam-log-to-registry
1182 (spam-log-unregistration-needed-p id type classification check)) 1937 (spam-log-unregistration-needed-p id type classification backend))
1183 (if (and (stringp id) 1938 (if (and (stringp id)
1184 (spam-process-type-valid-p type) 1939 (spam-process-type-valid-p type)
1185 (spam-classification-valid-p classification) 1940 (spam-classification-valid-p classification)
1186 (spam-registration-check-valid-p check)) 1941 (spam-backend-valid-p backend))
1187 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) 1942 (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1188 new-cell-list found) 1943 new-cell-list found)
1189 (dolist (cell cell-list) 1944 (dolist (cell cell-list)
1190 (unless (and (eq classification (nth 0 cell)) 1945 (unless (and (eq classification (nth 0 cell))
1191 (eq check (nth 1 cell))) 1946 (eq backend (nth 1 cell)))
1192 (push cell new-cell-list))) 1947 (push cell new-cell-list)))
1193 (gnus-registry-store-extra-entry 1948 (gnus-registry-store-extra-entry
1194 id 1949 id
1195 type 1950 type
1196 new-cell-list)) 1951 new-cell-list))
1197 (progn 1952 (progn
1198 (gnus-message 5 (format "%s called with bad ID, type, check, or group" 1953 (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group"
1199 "spam-log-undo-registration")) 1954 "spam-log-undo-registration"))
1200 nil)))) 1955 nil))))
1201 1956
1202;;; set up IMAP widening if it's necessary 1957;;}}}
1203(defun spam-setup-widening () 1958
1204 (dolist (check spam-list-of-statistical-checks) 1959;;{{{ backend functions
1205 (when (symbol-value check)
1206 (setq nnimap-split-download-body-default t))))
1207 1960
1208 1961;;{{{ Gmane xrefs
1209;;;; Regex body 1962(defun spam-check-gmane-xref ()
1963 (let ((header (or
1964 (message-fetch-field "Xref")
1965 (message-fetch-field "Newsgroups"))))
1966 (when header ; return nil when no header
1967 (when (string-match spam-gmane-xref-spam-group
1968 header)
1969 spam-split-group))))
1970
1971;;}}}
1972
1973;;{{{ Regex body
1210 1974
1211(defun spam-check-regex-body () 1975(defun spam-check-regex-body ()
1212 (let ((spam-regex-headers-ham spam-regex-body-ham) 1976 (let ((spam-regex-headers-ham spam-regex-body-ham)
1213 (spam-regex-headers-spam spam-regex-body-spam)) 1977 (spam-regex-headers-spam spam-regex-body-spam))
1214 (spam-check-regex-headers t))) 1978 (spam-check-regex-headers t)))
1215 1979
1216 1980;;}}}
1217;;;; Regex headers 1981
1982;;{{{ Regex headers
1218 1983
1219(defun spam-check-regex-headers (&optional body) 1984(defun spam-check-regex-headers (&optional body)
1220 (let ((type (if body "body" "header")) 1985 (let ((type (if body "body" "header"))
1221 (spam-split-group (if spam-split-symbolic-return
1222 'spam
1223 spam-split-group))
1224 ret found) 1986 ret found)
1225 (dolist (h-regex spam-regex-headers-ham) 1987 (dolist (h-regex spam-regex-headers-ham)
1226 (unless found 1988 (unless found
@@ -1237,8 +1999,9 @@ functions")
1237 (setq ret spam-split-group)))) 1999 (setq ret spam-split-group))))
1238 ret)) 2000 ret))
1239 2001
1240 2002;;}}}
1241;;;; Blackholes. 2003
2004;;{{{ Blackholes.
1242 2005
1243(defun spam-reverse-ip-string (ip) 2006(defun spam-reverse-ip-string (ip)
1244 (when (stringp ip) 2007 (when (stringp ip)
@@ -1248,16 +2011,13 @@ functions")
1248 2011
1249(defun spam-check-blackholes () 2012(defun spam-check-blackholes ()
1250 "Check the Received headers for blackholed relays." 2013 "Check the Received headers for blackholed relays."
1251 (let ((headers (nnmail-fetch-field "received")) 2014 (let ((headers (message-fetch-field "received"))
1252 (spam-split-group (if spam-split-symbolic-return
1253 'spam
1254 spam-split-group))
1255 ips matches) 2015 ips matches)
1256 (when headers 2016 (when headers
1257 (with-temp-buffer 2017 (with-temp-buffer
1258 (insert headers) 2018 (insert headers)
1259 (goto-char (point-min)) 2019 (goto-char (point-min))
1260 (gnus-message 5 "Checking headers for relay addresses") 2020 (gnus-message 6 "Checking headers for relay addresses")
1261 (while (re-search-forward 2021 (while (re-search-forward
1262 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) 2022 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1263 (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) 2023 (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
@@ -1275,34 +2035,28 @@ functions")
1275 (if spam-use-dig 2035 (if spam-use-dig
1276 (let ((query-result (query-dig query-string))) 2036 (let ((query-result (query-dig query-string)))
1277 (when query-result 2037 (when query-result
1278 (gnus-message 5 "(DIG): positive blackhole check '%s'" 2038 (gnus-message 6 "(DIG): positive blackhole check '%s'"
1279 query-result) 2039 query-result)
1280 (push (list ip server query-result) 2040 (push (list ip server query-result)
1281 matches))) 2041 matches)))
1282 ;; else, if not using dig.el 2042 ;; else, if not using dig.el
1283 (when (query-dns query-string) 2043 (when (query-dns query-string)
1284 (gnus-message 5 "positive blackhole check") 2044 (gnus-message 6 "positive blackhole check")
1285 (push (list ip server (query-dns query-string 'TXT)) 2045 (push (list ip server (query-dns query-string 'TXT))
1286 matches))))))))) 2046 matches)))))))))
1287 (when matches 2047 (when matches
1288 spam-split-group))) 2048 spam-split-group)))
1289 2049;;}}}
1290;;;; Hashcash.
1291 2050
1292(eval-when-compile 2051;;{{{ Hashcash.
1293 (autoload 'mail-check-payment "hashcash"))
1294 2052
1295(condition-case nil 2053(defun spam-check-hashcash ()
1296 (progn 2054 "Check the headers for hashcash payments."
1297 (require 'hashcash) 2055 (ignore-errors (mail-check-payment))) ;mail-check-payment returns a boolean
1298 2056
1299 (defun spam-check-hashcash () 2057;;}}}
1300 "Check the headers for hashcash payments."
1301 (mail-check-payment))) ;mail-check-payment returns a boolean
1302 2058
1303 (file-error)) 2059;;{{{ BBDB
1304
1305;;;; BBDB
1306 2060
1307;;; original idea for spam-check-BBDB from Alexander Kotelnikov 2061;;; original idea for spam-check-BBDB from Alexander Kotelnikov
1308;;; <sacha@giotto.sj.ru> 2062;;; <sacha@giotto.sj.ru>
@@ -1320,10 +2074,19 @@ functions")
1320 (require 'bbdb) 2074 (require 'bbdb)
1321 (require 'bbdb-com)) 2075 (require 'bbdb-com))
1322 (file-error 2076 (file-error
2077 ;; `bbdb-records' should not be bound as an autoload function
2078 ;; before loading bbdb because of `bbdb-hashtable-size'.
2079 (defalias 'bbdb-records 'ignore)
1323 (defalias 'spam-BBDB-register-routine 'ignore) 2080 (defalias 'spam-BBDB-register-routine 'ignore)
1324 (defalias 'spam-enter-ham-BBDB 'ignore) 2081 (defalias 'spam-enter-ham-BBDB 'ignore)
1325 nil)) 2082 nil))
1326 2083
2084 ;; when the BBDB changes, we want to clear out our cache
2085 (defun spam-clear-cache-BBDB (&rest immaterial)
2086 (spam-clear-cache 'spam-use-BBDB))
2087
2088 (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2089
1327 (defun spam-enter-ham-BBDB (addresses &optional remove) 2090 (defun spam-enter-ham-BBDB (addresses &optional remove)
1328 "Enter an address into the BBDB; implies ham (non-spam) sender" 2091 "Enter an address into the BBDB; implies ham (non-spam) sender"
1329 (dolist (from addresses) 2092 (dolist (from addresses)
@@ -1337,7 +2100,7 @@ functions")
1337 (record (and net-address 2100 (record (and net-address
1338 (bbdb-search-simple nil net-address)))) 2101 (bbdb-search-simple nil net-address))))
1339 (when net-address 2102 (when net-address
1340 (gnus-message 5 "%s address %s %s BBDB" 2103 (gnus-message 6 "%s address %s %s BBDB"
1341 (if remove "Deleting" "Adding") 2104 (if remove "Deleting" "Adding")
1342 from 2105 from
1343 (if remove "from" "to")) 2106 (if remove "from" "to"))
@@ -1359,20 +2122,37 @@ functions")
1359 2122
1360 (defun spam-check-BBDB () 2123 (defun spam-check-BBDB ()
1361 "Mail from people in the BBDB is classified as ham or non-spam" 2124 "Mail from people in the BBDB is classified as ham or non-spam"
1362 (let ((who (nnmail-fetch-field "from")) 2125 (let ((who (message-fetch-field "from"))
1363 (spam-split-group (if spam-split-symbolic-return 2126 bbdb-cache bbdb-hashtable)
1364 'spam 2127 (when spam-cache-lookups
1365 spam-split-group))) 2128 (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2129 (unless bbdb-cache
2130 (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value
2131 ;; this is based on the expanded (bbdb-hashtable) macro
2132 ;; without the debugging support
2133 (with-current-buffer (bbdb-buffer)
2134 (save-excursion
2135 (save-window-excursion
2136 (bbdb-records nil t)
2137 (mapatoms
2138 (lambda (symbol)
2139 (intern (downcase (symbol-name symbol)) bbdb-cache))
2140 bbdb-hashtable))))
2141 (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
1366 (when who 2142 (when who
1367 (setq who (nth 1 (gnus-extract-address-components who))) 2143 (setq who (nth 1 (gnus-extract-address-components who)))
1368 (if (bbdb-search-simple nil who) 2144 (if
2145 (if spam-cache-lookups
2146 (intern-soft (downcase who) bbdb-cache)
2147 (bbdb-search-simple nil who))
1369 t 2148 t
1370 (if spam-use-BBDB-exclusive 2149 (if spam-use-BBDB-exclusive
1371 spam-split-group 2150 spam-split-group
1372 nil))))))) 2151 nil)))))))
1373 2152
1374 2153;;}}}
1375;;;; ifile 2154
2155;;{{{ ifile
1376 2156
1377;;; check the ifile backend; return nil if the mail was NOT classified 2157;;; check the ifile backend; return nil if the mail was NOT classified
1378;;; as spam 2158;;; as spam
@@ -1388,9 +2168,6 @@ See `spam-ifile-database'."
1388(defun spam-check-ifile () 2168(defun spam-check-ifile ()
1389 "Check the ifile backend for the classification of this message." 2169 "Check the ifile backend for the classification of this message."
1390 (let ((article-buffer-name (buffer-name)) 2170 (let ((article-buffer-name (buffer-name))
1391 (spam-split-group (if spam-split-symbolic-return
1392 'spam
1393 spam-split-group))
1394 category return) 2171 category return)
1395 (with-temp-buffer 2172 (with-temp-buffer
1396 (let ((temp-buffer-name (buffer-name)) 2173 (let ((temp-buffer-name (buffer-name))
@@ -1404,7 +2181,7 @@ See `spam-ifile-database'."
1404 ;; check the return now (we're back in the temp buffer) 2181 ;; check the return now (we're back in the temp buffer)
1405 (goto-char (point-min)) 2182 (goto-char (point-min))
1406 (if (not (eobp)) 2183 (if (not (eobp))
1407 (setq category (buffer-substring (point) (spam-point-at-eol)))) 2184 (setq category (buffer-substring (point) (point-at-eol))))
1408 (when (not (zerop (length category))) ; we need a category here 2185 (when (not (zerop (length category))) ; we need a category here
1409 (if spam-ifile-all-categories 2186 (if spam-ifile-all-categories
1410 (setq return category) 2187 (setq return category)
@@ -1443,8 +2220,9 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1443(defun spam-ifile-unregister-ham-routine (articles) 2220(defun spam-ifile-unregister-ham-routine (articles)
1444 (spam-ifile-register-ham-routine articles t)) 2221 (spam-ifile-register-ham-routine articles t))
1445 2222
1446 2223;;}}}
1447;;;; spam-stat 2224
2225;;{{{ spam-stat
1448 2226
1449(eval-when-compile 2227(eval-when-compile
1450 (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat") 2228 (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
@@ -1466,10 +2244,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1466 2244
1467 (defun spam-check-stat () 2245 (defun spam-check-stat ()
1468 "Check the spam-stat backend for the classification of this message" 2246 "Check the spam-stat backend for the classification of this message"
1469 (let ((spam-split-group (if spam-split-symbolic-return 2247 (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
1470 'spam
1471 spam-split-group))
1472 (spam-stat-split-fancy-spam-group spam-split-group) ; override
1473 (spam-stat-buffer (buffer-name)) ; stat the current buffer 2248 (spam-stat-buffer (buffer-name)) ; stat the current buffer
1474 category return) 2249 category return)
1475 (spam-stat-split-fancy))) 2250 (spam-stat-split-fancy)))
@@ -1504,9 +2279,9 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1504 (defun spam-maybe-spam-stat-save () 2279 (defun spam-maybe-spam-stat-save ()
1505 (when spam-use-stat (spam-stat-save))))) 2280 (when spam-use-stat (spam-stat-save)))))
1506 2281
1507 2282;;}}}
1508 2283
1509;;;; Blacklists and whitelists. 2284;;{{{ Blacklists and whitelists.
1510 2285
1511(defvar spam-whitelist-cache nil) 2286(defvar spam-whitelist-cache nil)
1512(defvar spam-blacklist-cache nil) 2287(defvar spam-blacklist-cache nil)
@@ -1522,7 +2297,8 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
1522With a non-nil REMOVE, remove them." 2297With a non-nil REMOVE, remove them."
1523 (interactive "sAddress: ") 2298 (interactive "sAddress: ")
1524 (spam-enter-list address spam-whitelist remove) 2299 (spam-enter-list address spam-whitelist remove)
1525 (setq spam-whitelist-cache nil)) 2300 (setq spam-whitelist-cache nil)
2301 (spam-clear-cache 'spam-use-whitelist))
1526 2302
1527;;; address can be a list, too 2303;;; address can be a list, too
1528(defun spam-enter-blacklist (address &optional remove) 2304(defun spam-enter-blacklist (address &optional remove)
@@ -1530,7 +2306,8 @@ With a non-nil REMOVE, remove them."
1530With a non-nil REMOVE, remove them." 2306With a non-nil REMOVE, remove them."
1531 (interactive "sAddress: ") 2307 (interactive "sAddress: ")
1532 (spam-enter-list address spam-blacklist remove) 2308 (spam-enter-list address spam-blacklist remove)
1533 (setq spam-blacklist-cache nil)) 2309 (setq spam-blacklist-cache nil)
2310 (spam-clear-cache 'spam-use-whitelist))
1534 2311
1535(defun spam-enter-list (addresses file &optional remove) 2312(defun spam-enter-list (addresses file &optional remove)
1536 "Enter ADDRESSES into the given FILE. 2313 "Enter ADDRESSES into the given FILE.
@@ -1559,29 +2336,50 @@ REMOVE not nil, remove the ADDRESSES."
1559 (insert a "\n"))))) 2336 (insert a "\n")))))
1560 (save-buffer)))) 2337 (save-buffer))))
1561 2338
2339(defun spam-filelist-build-cache (type)
2340 (let ((cache (if (eq type 'spam-use-blacklist)
2341 spam-blacklist-cache
2342 spam-whitelist-cache))
2343 parsed-cache)
2344 (unless (gethash type spam-caches)
2345 (while cache
2346 (let ((address (pop cache)))
2347 (unless (zerop (length address)) ; 0 for a nil address too
2348 (setq address (regexp-quote address))
2349 ;; fix regexp-quote's treatment of user-intended regexes
2350 (while (string-match "\\\\\\*" address)
2351 (setq address (replace-match ".*" t t address))))
2352 (push address parsed-cache)))
2353 (puthash type parsed-cache spam-caches))))
2354
2355(defun spam-filelist-check-cache (type from)
2356 (when (stringp from)
2357 (spam-filelist-build-cache type)
2358 (let (found)
2359 (dolist (address (gethash type spam-caches))
2360 (when (and address (string-match address from))
2361 (setq found t)
2362 (return)))
2363 found)))
2364
1562;;; returns t if the sender is in the whitelist, nil or 2365;;; returns t if the sender is in the whitelist, nil or
1563;;; spam-split-group otherwise 2366;;; spam-split-group otherwise
1564(defun spam-check-whitelist () 2367(defun spam-check-whitelist ()
1565 ;; FIXME! Should it detect when file timestamps change? 2368 ;; FIXME! Should it detect when file timestamps change?
1566 (let ((spam-split-group (if spam-split-symbolic-return 2369 (unless spam-whitelist-cache
1567 'spam 2370 (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
1568 spam-split-group))) 2371 (if (spam-from-listed-p 'spam-use-whitelist)
1569 (unless spam-whitelist-cache 2372 t
1570 (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) 2373 (if spam-use-whitelist-exclusive
1571 (if (spam-from-listed-p spam-whitelist-cache) 2374 spam-split-group
1572 t 2375 nil)))
1573 (if spam-use-whitelist-exclusive
1574 spam-split-group
1575 nil))))
1576 2376
1577(defun spam-check-blacklist () 2377(defun spam-check-blacklist ()
1578 ;; FIXME! Should it detect when file timestamps change? 2378 ;; FIXME! Should it detect when file timestamps change?
1579 (let ((spam-split-group (if spam-split-symbolic-return 2379 (unless spam-blacklist-cache
1580 'spam 2380 (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
1581 spam-split-group))) 2381 (and (spam-from-listed-p 'spam-use-blacklist)
1582 (unless spam-blacklist-cache 2382 spam-split-group))
1583 (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
1584 (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)))
1585 2383
1586(defun spam-parse-list (file) 2384(defun spam-parse-list (file)
1587 (when (file-readable-p file) 2385 (when (file-readable-p file)
@@ -1589,7 +2387,7 @@ REMOVE not nil, remove the ADDRESSES."
1589 (with-temp-buffer 2387 (with-temp-buffer
1590 (insert-file-contents file) 2388 (insert-file-contents file)
1591 (while (not (eobp)) 2389 (while (not (eobp))
1592 (setq address (buffer-substring (point) (spam-point-at-eol))) 2390 (setq address (buffer-substring (point) (point-at-eol)))
1593 (forward-line 1) 2391 (forward-line 1)
1594 ;; insert the e-mail address if detected, otherwise the raw data 2392 ;; insert the e-mail address if detected, otherwise the raw data
1595 (unless (zerop (length address)) 2393 (unless (zerop (length address))
@@ -1597,20 +2395,10 @@ REMOVE not nil, remove the ADDRESSES."
1597 (push (or pure-address address) contents))))) 2395 (push (or pure-address address) contents)))))
1598 (nreverse contents)))) 2396 (nreverse contents))))
1599 2397
1600(defun spam-from-listed-p (cache) 2398(defun spam-from-listed-p (type)
1601 (let ((from (nnmail-fetch-field "from")) 2399 (let ((from (message-fetch-field "from"))
1602 found) 2400 found)
1603 (while cache 2401 (spam-filelist-check-cache type from)))
1604 (let ((address (pop cache)))
1605 (unless (zerop (length address)) ; 0 for a nil address too
1606 (setq address (regexp-quote address))
1607 ;; fix regexp-quote's treatment of user-intended regexes
1608 (while (string-match "\\\\\\*" address)
1609 (setq address (replace-match ".*" t t address))))
1610 (when (and address (string-match address from))
1611 (setq found t
1612 cache nil))))
1613 found))
1614 2402
1615(defun spam-filelist-register-routine (articles blacklist &optional unregister) 2403(defun spam-filelist-register-routine (articles blacklist &optional unregister)
1616 (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) 2404 (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
@@ -1619,7 +2407,7 @@ REMOVE not nil, remove the ADDRESSES."
1619 (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) 2407 (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
1620 (remove-function 2408 (remove-function
1621 (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) 2409 (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
1622 from addresses unregister-list) 2410 from addresses unregister-list article-unregister-list)
1623 (dolist (article articles) 2411 (dolist (article articles)
1624 (let ((from (spam-fetch-field-from-fast article)) 2412 (let ((from (spam-fetch-field-from-fast article))
1625 (id (spam-fetch-field-message-id-fast article)) 2413 (id (spam-fetch-field-message-id-fast article))
@@ -1635,6 +2423,7 @@ REMOVE not nil, remove the ADDRESSES."
1635 (null unregister) 2423 (null unregister)
1636 (spam-log-unregistration-needed-p 2424 (spam-log-unregistration-needed-p
1637 id 'process declassification de-symbol)) 2425 id 'process declassification de-symbol))
2426 (push article article-unregister-list)
1638 (push from unregister-list)) 2427 (push from unregister-list))
1639 (unless sender-ignored 2428 (unless sender-ignored
1640 (push from addresses))))) 2429 (push from addresses)))))
@@ -1643,7 +2432,7 @@ REMOVE not nil, remove the ADDRESSES."
1643 (funcall enter-function addresses t) ; unregister all these addresses 2432 (funcall enter-function addresses t) ; unregister all these addresses
1644 ;; else, register normally and unregister what we need to 2433 ;; else, register normally and unregister what we need to
1645 (funcall remove-function unregister-list t) 2434 (funcall remove-function unregister-list t)
1646 (dolist (article unregister-list) 2435 (dolist (article article-unregister-list)
1647 (spam-log-undo-registration 2436 (spam-log-undo-registration
1648 (spam-fetch-field-message-id-fast article) 2437 (spam-fetch-field-message-id-fast article)
1649 'process 2438 'process
@@ -1663,19 +2452,34 @@ REMOVE not nil, remove the ADDRESSES."
1663(defun spam-whitelist-register-routine (articles &optional unregister) 2452(defun spam-whitelist-register-routine (articles &optional unregister)
1664 (spam-filelist-register-routine articles nil unregister)) 2453 (spam-filelist-register-routine articles nil unregister))
1665 2454
1666 2455;;}}}
1667;;;; Spam-report glue 2456
2457;;{{{ Spam-report glue (gmane and resend reporting)
1668(defun spam-report-gmane-register-routine (articles) 2458(defun spam-report-gmane-register-routine (articles)
1669 (when articles 2459 (when articles
1670 (apply 'spam-report-gmane articles))) 2460 (apply 'spam-report-gmane-spam articles)))
2461
2462(defun spam-report-gmane-unregister-routine (articles)
2463 (when articles
2464 (apply 'spam-report-gmane-ham articles)))
2465
2466(defun spam-report-resend-register-ham-routine (articles)
2467 (spam-report-resend-register-routine articles t))
2468
2469(defun spam-report-resend-register-routine (articles &optional ham)
2470 (let* ((resend-to-gp
2471 (if ham
2472 (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2473 (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2474 (spam-report-resend-to (or (car-safe resend-to-gp)
2475 spam-report-resend-to)))
2476 (spam-report-resend articles ham)))
1671 2477
1672 2478;;}}}
1673;;;; Bogofilter 2479
2480;;{{{ Bogofilter
1674(defun spam-check-bogofilter-headers (&optional score) 2481(defun spam-check-bogofilter-headers (&optional score)
1675 (let ((header (nnmail-fetch-field spam-bogofilter-header)) 2482 (let ((header (message-fetch-field spam-bogofilter-header)))
1676 (spam-split-group (if spam-split-symbolic-return
1677 'spam
1678 spam-split-group)))
1679 (when header ; return nil when no header 2483 (when header ; return nil when no header
1680 (if score ; scoring mode 2484 (if score ; scoring mode
1681 (if (string-match "spamicity=\\([0-9.]+\\)" header) 2485 (if (string-match "spamicity=\\([0-9.]+\\)" header)
@@ -1687,58 +2491,72 @@ REMOVE not nil, remove the ADDRESSES."
1687 spam-split-group))))) 2491 spam-split-group)))))
1688 2492
1689;; return something sensible if the score can't be determined 2493;; return something sensible if the score can't be determined
1690(defun spam-bogofilter-score () 2494(defun spam-bogofilter-score (&optional recheck)
1691 "Get the Bogofilter spamicity score" 2495 "Get the Bogofilter spamicity score"
1692 (interactive) 2496 (interactive "P")
1693 (save-window-excursion 2497 (save-window-excursion
1694 (gnus-summary-show-article t) 2498 (gnus-summary-show-article t)
1695 (set-buffer gnus-article-buffer) 2499 (set-buffer gnus-article-buffer)
1696 (let ((score (or (spam-check-bogofilter-headers t) 2500 (let ((score (or (unless recheck
2501 (spam-check-bogofilter-headers t))
1697 (spam-check-bogofilter t)))) 2502 (spam-check-bogofilter t))))
2503 (gnus-summary-show-article)
1698 (message "Spamicity score %s" score) 2504 (message "Spamicity score %s" score)
1699 (or score "0")) 2505 (or score "0"))))
1700 (gnus-summary-show-article))) 2506
1701 2507(defun spam-verify-bogofilter ()
2508 "Verify the Bogofilter version is sufficient."
2509 (when (eq spam-bogofilter-valid 'unknown)
2510 (setq spam-bogofilter-valid
2511 (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2512 (shell-command-to-string
2513 (format "%s -V" spam-bogofilter-program))))))
2514 spam-bogofilter-valid)
2515
1702(defun spam-check-bogofilter (&optional score) 2516(defun spam-check-bogofilter (&optional score)
1703 "Check the Bogofilter backend for the classification of this message" 2517 "Check the Bogofilter backend for the classification of this message."
1704 (let ((article-buffer-name (buffer-name)) 2518 (if (spam-verify-bogofilter)
1705 (db spam-bogofilter-database-directory) 2519 (let ((article-buffer-name (buffer-name))
2520 (db spam-bogofilter-database-directory)
2521 return)
2522 (with-temp-buffer
2523 (let ((temp-buffer-name (buffer-name)))
2524 (save-excursion
2525 (set-buffer article-buffer-name)
2526 (apply 'call-process-region
2527 (point-min) (point-max)
2528 spam-bogofilter-program
2529 nil temp-buffer-name nil
2530 (if db `("-d" ,db "-v") `("-v"))))
2531 (setq return (spam-check-bogofilter-headers score))))
1706 return) 2532 return)
1707 (with-temp-buffer 2533 (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions")))
1708 (let ((temp-buffer-name (buffer-name)))
1709 (save-excursion
1710 (set-buffer article-buffer-name)
1711 (apply 'call-process-region
1712 (point-min) (point-max)
1713 spam-bogofilter-program
1714 nil temp-buffer-name nil
1715 (if db `("-d" ,db "-v") `("-v"))))
1716 (setq return (spam-check-bogofilter-headers score))))
1717 return))
1718 2534
1719(defun spam-bogofilter-register-with-bogofilter (articles 2535(defun spam-bogofilter-register-with-bogofilter (articles
1720 spam 2536 spam
1721 &optional unregister) 2537 &optional unregister)
1722 "Register an article, given as a string, as spam or non-spam." 2538 "Register an article, given as a string, as spam or non-spam."
1723 (dolist (article articles) 2539 (if (spam-verify-bogofilter)
1724 (let ((article-string (spam-get-article-as-string article)) 2540 (dolist (article articles)
1725 (db spam-bogofilter-database-directory) 2541 (let ((article-string (spam-get-article-as-string article))
1726 (switch (if unregister 2542 (db spam-bogofilter-database-directory)
1727 (if spam 2543 (switch (if unregister
1728 spam-bogofilter-spam-strong-switch 2544 (if spam
1729 spam-bogofilter-ham-strong-switch) 2545 spam-bogofilter-spam-strong-switch
1730 (if spam 2546 spam-bogofilter-ham-strong-switch)
1731 spam-bogofilter-spam-switch 2547 (if spam
1732 spam-bogofilter-ham-switch)))) 2548 spam-bogofilter-spam-switch
1733 (when (stringp article-string) 2549 spam-bogofilter-ham-switch))))
1734 (with-temp-buffer 2550 (when (stringp article-string)
1735 (insert article-string) 2551 (with-temp-buffer
1736 2552 (insert article-string)
1737 (apply 'call-process-region 2553
1738 (point-min) (point-max) 2554 (apply 'call-process-region
1739 spam-bogofilter-program 2555 (point-min) (point-max)
1740 nil nil nil switch 2556 spam-bogofilter-program
1741 (if db `("-d" ,db "-v") `("-v")))))))) 2557 nil nil nil switch
2558 (if db `("-d" ,db "-v") `("-v")))))))
2559 (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions")))
1742 2560
1743(defun spam-bogofilter-register-spam-routine (articles &optional unregister) 2561(defun spam-bogofilter-register-spam-routine (articles &optional unregister)
1744 (spam-bogofilter-register-with-bogofilter articles t unregister)) 2562 (spam-bogofilter-register-with-bogofilter articles t unregister))
@@ -1753,14 +2571,12 @@ REMOVE not nil, remove the ADDRESSES."
1753 (spam-bogofilter-register-ham-routine articles t)) 2571 (spam-bogofilter-register-ham-routine articles t))
1754 2572
1755 2573
1756 2574;;}}}
1757;;;; spamoracle 2575
2576;;{{{ spamoracle
1758(defun spam-check-spamoracle () 2577(defun spam-check-spamoracle ()
1759 "Run spamoracle on an article to determine whether it's spam." 2578 "Run spamoracle on an article to determine whether it's spam."
1760 (let ((article-buffer-name (buffer-name)) 2579 (let ((article-buffer-name (buffer-name)))
1761 (spam-split-group (if spam-split-symbolic-return
1762 'spam
1763 spam-split-group)))
1764 (with-temp-buffer 2580 (with-temp-buffer
1765 (let ((temp-buffer-name (buffer-name))) 2581 (let ((temp-buffer-name (buffer-name)))
1766 (save-excursion 2582 (save-excursion
@@ -1816,13 +2632,283 @@ REMOVE not nil, remove the ADDRESSES."
1816(defun spam-spamoracle-unlearn-spam (articles &optional unregister) 2632(defun spam-spamoracle-unlearn-spam (articles &optional unregister)
1817 (spam-spamoracle-learn-spam articles t)) 2633 (spam-spamoracle-learn-spam articles t))
1818 2634
1819 2635;;}}}
1820;;;; Hooks 2636
2637;;{{{ SpamAssassin
2638;;; based mostly on the bogofilter code
2639(defun spam-check-spamassassin-headers (&optional score)
2640 "Check the SpamAssassin headers for the classification of this message."
2641 (if score ; scoring mode
2642 (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2643 (when header
2644 (if (string-match spam-spamassassin-score-regexp header)
2645 (match-string 1 header)
2646 "0")))
2647 ;; spam detection mode
2648 (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2649 (when header ; return nil when no header
2650 (when (string-match spam-spamassassin-positive-spam-flag-header
2651 header)
2652 spam-split-group)))))
2653
2654(defun spam-check-spamassassin (&optional score)
2655 "Check the SpamAssassin backend for the classification of this message."
2656 (let ((article-buffer-name (buffer-name)))
2657 (with-temp-buffer
2658 (let ((temp-buffer-name (buffer-name)))
2659 (save-excursion
2660 (set-buffer article-buffer-name)
2661 (apply 'call-process-region
2662 (point-min) (point-max) spam-assassin-program
2663 nil temp-buffer-name nil spam-spamassassin-arguments))
2664 ;; check the return now (we're back in the temp buffer)
2665 (goto-char (point-min))
2666 (spam-check-spamassassin-headers score)))))
2667
2668;; return something sensible if the score can't be determined
2669(defun spam-spamassassin-score (&optional recheck)
2670 "Get the SpamAssassin score"
2671 (interactive "P")
2672 (save-window-excursion
2673 (gnus-summary-show-article t)
2674 (set-buffer gnus-article-buffer)
2675 (let ((score (or (unless recheck
2676 (spam-check-spamassassin-headers t))
2677 (spam-check-spamassassin t))))
2678 (gnus-summary-show-article)
2679 (message "SpamAssassin score %s" score)
2680 (or score "0"))))
2681
2682(defun spam-spamassassin-register-with-sa-learn (articles spam
2683 &optional unregister)
2684 "Register articles with spamassassin's sa-learn as spam or non-spam."
2685 (if articles
2686 (let ((action (if unregister spam-sa-learn-unregister-switch
2687 (if spam spam-sa-learn-spam-switch
2688 spam-sa-learn-ham-switch)))
2689 (summary-buffer-name (buffer-name)))
2690 (with-temp-buffer
2691 ;; group the articles into mbox format
2692 (dolist (article articles)
2693 (let (article-string)
2694 (save-excursion
2695 (set-buffer summary-buffer-name)
2696 (setq article-string (spam-get-article-as-string article)))
2697 (when (stringp article-string)
2698 (insert "From \n") ; mbox separator (sa-learn only checks the
2699 ; first five chars, so we can get away with
2700 ; a bogus line))
2701 (insert article-string)
2702 (insert "\n"))))
2703 ;; call sa-learn on all messages at the same time
2704 (apply 'call-process-region
2705 (point-min) (point-max)
2706 spam-sa-learn-program
2707 nil nil nil "--mbox"
2708 (if spam-sa-learn-rebuild
2709 (list action)
2710 `("--no-rebuild" ,action)))))))
2711
2712(defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2713 (spam-spamassassin-register-with-sa-learn articles t unregister))
2714
2715(defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2716 (spam-spamassassin-register-with-sa-learn articles nil unregister))
2717
2718(defun spam-spamassassin-unregister-spam-routine (articles)
2719 (spam-spamassassin-register-with-sa-learn articles t t))
2720
2721(defun spam-spamassassin-unregister-ham-routine (articles)
2722 (spam-spamassassin-register-with-sa-learn articles nil t))
2723
2724;;}}}
2725
2726;;{{{ Bsfilter
2727;;; based mostly on the bogofilter code
2728(defun spam-check-bsfilter-headers (&optional score)
2729 (if score
2730 (or (nnmail-fetch-field spam-bsfilter-probability-header)
2731 "0")
2732 (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2733 (when header ; return nil when no header
2734 (when (string-match "YES" header)
2735 spam-split-group)))))
2736
2737;; return something sensible if the score can't be determined
2738(defun spam-bsfilter-score (&optional recheck)
2739 "Get the Bsfilter spamicity score"
2740 (interactive "P")
2741 (save-window-excursion
2742 (gnus-summary-show-article t)
2743 (set-buffer gnus-article-buffer)
2744 (let ((score (or (unless recheck
2745 (spam-check-bsfilter-headers t))
2746 (spam-check-bsfilter t))))
2747 (gnus-summary-show-article)
2748 (message "Spamicity score %s" score)
2749 (or score "0"))))
2750
2751(defun spam-check-bsfilter (&optional score)
2752 "Check the Bsfilter backend for the classification of this message"
2753 (let ((article-buffer-name (buffer-name))
2754 (dir spam-bsfilter-database-directory)
2755 return)
2756 (with-temp-buffer
2757 (let ((temp-buffer-name (buffer-name)))
2758 (save-excursion
2759 (set-buffer article-buffer-name)
2760 (apply 'call-process-region
2761 (point-min) (point-max)
2762 spam-bsfilter-program
2763 nil temp-buffer-name nil
2764 "--pipe"
2765 "--insert-flag"
2766 "--insert-probability"
2767 (when dir
2768 (list "--homedir" dir))))
2769 (setq return (spam-check-bsfilter-headers score))))
2770 return))
2771
2772(defun spam-bsfilter-register-with-bsfilter (articles
2773 spam
2774 &optional unregister)
2775 "Register an article, given as a string, as spam or non-spam."
2776 (dolist (article articles)
2777 (let ((article-string (spam-get-article-as-string article))
2778 (switch (if unregister
2779 (if spam
2780 spam-bsfilter-spam-strong-switch
2781 spam-bsfilter-ham-strong-switch)
2782 (if spam
2783 spam-bsfilter-spam-switch
2784 spam-bsfilter-ham-switch))))
2785 (when (stringp article-string)
2786 (with-temp-buffer
2787 (insert article-string)
2788 (apply 'call-process-region
2789 (point-min) (point-max)
2790 spam-bsfilter-program
2791 nil nil nil switch
2792 "--update"
2793 (when spam-bsfilter-database-directory
2794 (list "--homedir"
2795 spam-bsfilter-database-directory))))))))
2796
2797(defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2798 (spam-bsfilter-register-with-bsfilter articles t unregister))
2799
2800(defun spam-bsfilter-unregister-spam-routine (articles)
2801 (spam-bsfilter-register-spam-routine articles t))
2802
2803(defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2804 (spam-bsfilter-register-with-bsfilter articles nil unregister))
2805
2806(defun spam-bsfilter-unregister-ham-routine (articles)
2807 (spam-bsfilter-register-ham-routine articles t))
2808
2809;;}}}
2810
2811;;{{{ CRM114 Mailfilter
2812(defun spam-check-crm114-headers (&optional score)
2813 (let ((header (message-fetch-field spam-crm114-header)))
2814 (when header ; return nil when no header
2815 (if score ; scoring mode
2816 (if (string-match "( pR: \\([0-9.-]+\\)" header)
2817 (match-string 1 header)
2818 "0")
2819 ;; spam detection mode
2820 (when (string-match spam-crm114-positive-spam-header
2821 header)
2822 spam-split-group)))))
2823
2824;; return something sensible if the score can't be determined
2825(defun spam-crm114-score ()
2826 "Get the CRM114 Mailfilter pR"
2827 (interactive)
2828 (save-window-excursion
2829 (gnus-summary-show-article t)
2830 (set-buffer gnus-article-buffer)
2831 (let ((score (or (spam-check-crm114-headers t)
2832 (spam-check-crm114 t))))
2833 (gnus-summary-show-article)
2834 (message "pR: %s" score)
2835 (or score "0"))))
2836
2837(defun spam-check-crm114 (&optional score)
2838 "Check the CRM114 Mailfilter backend for the classification of this message"
2839 (let ((article-buffer-name (buffer-name))
2840 (db spam-crm114-database-directory)
2841 return)
2842 (with-temp-buffer
2843 (let ((temp-buffer-name (buffer-name)))
2844 (save-excursion
2845 (set-buffer article-buffer-name)
2846 (apply 'call-process-region
2847 (point-min) (point-max)
2848 spam-crm114-program
2849 nil temp-buffer-name nil
2850 (when db (list (concat "--fileprefix=" db)))))
2851 (setq return (spam-check-crm114-headers score))))
2852 return))
2853
2854(defun spam-crm114-register-with-crm114 (articles
2855 spam
2856 &optional unregister)
2857 "Register an article, given as a string, as spam or non-spam."
2858 (dolist (article articles)
2859 (let ((article-string (spam-get-article-as-string article))
2860 (db spam-crm114-database-directory)
2861 (switch (if unregister
2862 (if spam
2863 spam-crm114-spam-strong-switch
2864 spam-crm114-ham-strong-switch)
2865 (if spam
2866 spam-crm114-spam-switch
2867 spam-crm114-ham-switch))))
2868 (when (stringp article-string)
2869 (with-temp-buffer
2870 (insert article-string)
2871
2872 (apply 'call-process-region
2873 (point-min) (point-max)
2874 spam-crm114-program
2875 nil nil nil
2876 (when db (list switch (concat "--fileprefix=" db)))))))))
2877
2878(defun spam-crm114-register-spam-routine (articles &optional unregister)
2879 (spam-crm114-register-with-crm114 articles t unregister))
2880
2881(defun spam-crm114-unregister-spam-routine (articles)
2882 (spam-crm114-register-spam-routine articles t))
2883
2884(defun spam-crm114-register-ham-routine (articles &optional unregister)
2885 (spam-crm114-register-with-crm114 articles nil unregister))
2886
2887(defun spam-crm114-unregister-ham-routine (articles)
2888 (spam-crm114-register-ham-routine articles t))
2889
2890;;}}}
2891
2892;;}}}
2893
2894;;{{{ Hooks
1821 2895
1822;;;###autoload 2896;;;###autoload
1823(defun spam-initialize () 2897(defun spam-initialize (&rest symbols)
1824 "Install the spam.el hooks and do other initialization" 2898 "Install the spam.el hooks and do other initialization.
2899When SYMBOLS is given, set those variables to t. This is so you
2900can call spam-initialize before you set spam-use-* variables on
2901explicitly, and matters only if you need the extra headers
2902installed through spam-necessary-extra-headers."
1825 (interactive) 2903 (interactive)
2904
2905 (dolist (var symbols)
2906 (set var t))
2907
2908 (dolist (header (spam-necessary-extra-headers))
2909 (add-to-list 'nnmail-extra-headers header)
2910 (add-to-list 'gnus-extra-headers header))
2911
1826 (setq spam-install-hooks t) 2912 (setq spam-install-hooks t)
1827 ;; TODO: How do we redo this every time the `spam' face is customized? 2913 ;; TODO: How do we redo this every time the `spam' face is customized?
1828 (push '((eq mark gnus-spam-mark) . spam) 2914 (push '((eq mark gnus-spam-mark) . spam)
@@ -1834,7 +2920,7 @@ REMOVE not nil, remove the ADDRESSES."
1834 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) 2920 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
1835 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) 2921 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
1836 (add-hook 'gnus-get-new-news-hook 'spam-setup-widening) 2922 (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
1837 (add-hook 'gnus-summary-prepare-hook 'spam-find-spam)) 2923 (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
1838 2924
1839(defun spam-unload-hook () 2925(defun spam-unload-hook ()
1840 "Uninstall the spam.el hooks" 2926 "Uninstall the spam.el hooks"
@@ -1851,6 +2937,7 @@ REMOVE not nil, remove the ADDRESSES."
1851 2937
1852(when spam-install-hooks 2938(when spam-install-hooks
1853 (spam-initialize)) 2939 (spam-initialize))
2940;;}}}
1854 2941
1855(provide 'spam) 2942(provide 'spam)
1856 2943
diff --git a/lisp/gnus/uudecode.el b/lisp/gnus/uudecode.el
index 1d1860d9a7e..74abeff6621 100644
--- a/lisp/gnus/uudecode.el
+++ b/lisp/gnus/uudecode.el
@@ -27,8 +27,6 @@
27 27
28;;; Code: 28;;; Code:
29 29
30(autoload 'executable-find "executable")
31
32(eval-when-compile (require 'cl)) 30(eval-when-compile (require 'cl))
33 31
34(eval-and-compile 32(eval-and-compile
diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
index c238134749a..52b2ed82a79 100644
--- a/lisp/gnus/webmail.el
+++ b/lisp/gnus/webmail.el
@@ -196,10 +196,9 @@
196(defun webmail-debug (str) 196(defun webmail-debug (str)
197 (with-temp-buffer 197 (with-temp-buffer
198 (insert "\n---------------- A bug at " str " ------------------\n") 198 (insert "\n---------------- A bug at " str " ------------------\n")
199 (mapcar #'(lambda (sym) 199 (dolist (sym '(webmail-type user))
200 (if (boundp sym) 200 (if (boundp sym)
201 (gnus-pp `(setq ,sym ',(eval sym))))) 201 (gnus-pp `(setq ,sym ',(eval sym)))))
202 '(webmail-type user))
203 (insert "---------------- webmail buffer ------------------\n\n") 202 (insert "---------------- webmail buffer ------------------\n\n")
204 (insert-buffer-substring webmail-buffer) 203 (insert-buffer-substring webmail-buffer)
205 (insert "\n---------------- end of buffer ------------------\n\n") 204 (insert "\n---------------- end of buffer ------------------\n\n")
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 1b52090abf6..8c4b0a08f51 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -32,27 +32,45 @@
32;;; Code: 32;;; Code:
33 33
34;;; 34;;;
35;;; .netrc and .authinforc parsing 35;;; .netrc and .authinfo rc parsing
36;;; 36;;;
37 37
38(defalias 'netrc-point-at-eol 38(defalias 'netrc-point-at-eol
39 (if (fboundp 'point-at-eol) 39 (if (fboundp 'point-at-eol)
40 'point-at-eol 40 'point-at-eol
41 'line-end-position)) 41 'line-end-position))
42;; autoload encrypt
43
44(eval-and-compile
45 (autoload 'encrypt-find-model "encrypt")
46 (autoload 'encrypt-insert-file-contents "encrypt"))
47
48(defgroup netrc nil
49 "Netrc configuration."
50 :group 'comm)
51
52(defvar netrc-services-file "/etc/services"
53 "The name of the services file.")
42 54
43(defun netrc-parse (file) 55(defun netrc-parse (file)
44 "Parse FILE and return a list of all entries in the file." 56 (interactive "fFile to Parse: ")
57 "Parse FILE and return an list of all entries in the file."
45 (when (file-exists-p file) 58 (when (file-exists-p file)
46 (with-temp-buffer 59 (with-temp-buffer
47 (let ((tokens '("machine" "default" "login" 60 (let ((tokens '("machine" "default" "login"
48 "password" "account" "macdef" "force" 61 "password" "account" "macdef" "force"
49 "port")) 62 "port"))
63 (encryption-model (encrypt-find-model file))
50 alist elem result pair) 64 alist elem result pair)
51 (insert-file-contents file) 65
66 (if encryption-model
67 (encrypt-insert-file-contents file encryption-model)
68 (insert-file-contents file))
69
52 (goto-char (point-min)) 70 (goto-char (point-min))
53 ;; Go through the file, line by line. 71 ;; Go through the file, line by line.
54 (while (not (eobp)) 72 (while (not (eobp))
55 (narrow-to-region (point) (netrc-point-at-eol)) 73 (narrow-to-region (point) (point-at-eol))
56 ;; For each line, get the tokens and values. 74 ;; For each line, get the tokens and values.
57 (while (not (eobp)) 75 (while (not (eobp))
58 (skip-chars-forward "\t ") 76 (skip-chars-forward "\t ")
@@ -113,16 +131,79 @@ Entries without port tokens default to DEFAULTPORT."
113 (when result 131 (when result
114 (setq result (nreverse result)) 132 (setq result (nreverse result))
115 (while (and result 133 (while (and result
116 (not (equal (or port defaultport "nntp") 134 (not (netrc-port-equal
117 (or (netrc-get (car result) "port") 135 (or port defaultport "nntp")
118 defaultport "nntp")))) 136 (or (netrc-get (car result) "port")
137 defaultport "nntp"))))
119 (pop result)) 138 (pop result))
120 (car result)))) 139 (car result))))
121 140
141(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults)
142 "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST.
143Matches a machine from MACHINES and a port from PORTS, giving
144default ports DEFAULTS to `netrc-machine'.
145
146MODE can be \"login\" or \"password\", suitable for passing to
147`netrc-get'."
148 (let ((authinfo-list (if (stringp authinfo-file-or-list)
149 (netrc-parse authinfo-file-or-list)
150 authinfo-file-or-list))
151 (ports (or ports '(nil)))
152 (defaults (or defaults '(nil)))
153 info)
154 (dolist (machine machines)
155 (dolist (default defaults)
156 (dolist (port ports)
157 (let ((alist (netrc-machine authinfo-list machine port default)))
158 (setq info (or (netrc-get alist mode) info))))))
159 info))
160
122(defun netrc-get (alist type) 161(defun netrc-get (alist type)
123 "Return the value of token TYPE from ALIST." 162 "Return the value of token TYPE from ALIST."
124 (cdr (assoc type alist))) 163 (cdr (assoc type alist)))
125 164
165(defun netrc-port-equal (port1 port2)
166 (when (numberp port1)
167 (setq port1 (or (netrc-find-service-name port1) port1)))
168 (when (numberp port2)
169 (setq port2 (or (netrc-find-service-name port2) port2)))
170 (equal port1 port2))
171
172(defun netrc-parse-services ()
173 (when (file-exists-p netrc-services-file)
174 (let ((services nil))
175 (with-temp-buffer
176 (insert-file-contents netrc-services-file)
177 (while (search-forward "#" nil t)
178 (delete-region (1- (point)) (point-at-eol)))
179 (goto-char (point-min))
180 (while (re-search-forward
181 "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t)
182 (push (list (match-string 1) (string-to-number (match-string 2))
183 (intern (downcase (match-string 3))))
184 services))
185 (nreverse services)))))
186
187(defun netrc-find-service-name (number &optional type)
188 (let ((services (netrc-parse-services))
189 service)
190 (setq type (or type 'tcp))
191 (while (and (setq service (pop services))
192 (not (and (= number (cadr service))
193 (eq type (caddr service)))))
194 )
195 (car service)))
196
197(defun netrc-find-service-number (name &optional type)
198 (let ((services (netrc-parse-services))
199 service)
200 (setq type (or type 'tcp))
201 (while (and (setq service (pop services))
202 (not (and (string= name (car service))
203 (eq type (caddr service)))))
204 )
205 (cadr service)))
206
126(provide 'netrc) 207(provide 'netrc)
127 208
128;;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55 209;;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55