diff options
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 @@ | |||
| 1 | 2007-10-28 Miles Bader <miles@gnu.org> | ||
| 2 | |||
| 3 | * gnus-news.texi, gnus-coding.texi, sasl.texi: New files. | ||
| 4 | |||
| 5 | 2007-10-28 Emanuele Giaquinta <e.giaquinta@glauco.it> (tiny change) | ||
| 6 | |||
| 7 | * gnus-faq.texi ([5.12]): Remove reference to discontinued service. | ||
| 8 | |||
| 9 | 2007-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 | |||
| 14 | 2007-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 | |||
| 20 | 2007-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 | |||
| 25 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 26 | |||
| 27 | * gnus.texi (IMAP): Mention nnimap-logout-timeout. | ||
| 28 | |||
| 29 | 2007-10-28 Tassilo Horn <tassilo@member.fsf.org> | ||
| 30 | |||
| 31 | * gnus.texi (Sticky Articles): Documentation for sticky article | ||
| 32 | buffers. | ||
| 33 | |||
| 34 | 2007-10-28 Micha,Ak(Bl Cadilhac <michael@cadilhac.name> | ||
| 35 | |||
| 36 | * gnus.texi (RSS): Document nnrss-ignore-article-fields. | ||
| 37 | |||
| 38 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 39 | |||
| 40 | * gnus.texi (Various Various): Mention gnus-add-timestamp-to-message. | ||
| 41 | |||
| 42 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 43 | |||
| 44 | * gnus.texi (Archived Messages): Document | ||
| 45 | gnus-update-message-archive-method. | ||
| 46 | |||
| 47 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 48 | |||
| 49 | * gnus.texi (Limiting): Document gnus-summary-limit-to-address. | ||
| 50 | |||
| 51 | 2007-10-28 Micha,Ak(Bl Cadilhac <michael@cadilhac.name> | ||
| 52 | |||
| 53 | * gnus.texi (Group Maneuvering): Document | ||
| 54 | `gnus-summary-next-group-on-exit'. | ||
| 55 | |||
| 56 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 57 | |||
| 58 | * gnus.texi (Really Various Summary Commands): Mention | ||
| 59 | gnus-auto-select-on-ephemeral-exit. | ||
| 60 | |||
| 61 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 62 | |||
| 63 | * gnus.texi, message.texi: Bump version number. | ||
| 64 | |||
| 65 | 2007-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 | |||
| 70 | 2007-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 | |||
| 76 | 2007-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 | |||
| 82 | 2007-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 | |||
| 88 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 89 | |||
| 90 | * gnus.texi: Untabify. | ||
| 91 | |||
| 92 | 2007-10-28 Didier Verna <didier@xemacs.org> | ||
| 93 | |||
| 94 | * gnus.texi (Group Parameters): Document the posting-style merging | ||
| 95 | process in topic-mode. | ||
| 96 | |||
| 97 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 98 | |||
| 99 | * gnus.texi (Scoring On Other Headers): Add gnus-inhibit-slow-scoring. | ||
| 100 | |||
| 101 | 2007-10-28 Romain Francoise <romain@orebokech.com> | ||
| 102 | |||
| 103 | * gnus.texi (Mail Spool): Fix typo. | ||
| 104 | Update copyright. | ||
| 105 | |||
| 106 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 107 | |||
| 108 | * gnus.texi (Limiting): Add gnus-summary-limit-to-singletons. | ||
| 109 | |||
| 110 | 2007-10-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | ||
| 111 | |||
| 112 | * gnus.texi (Summary Generation Commands): | ||
| 113 | Add gnus-summary-insert-ticked-articles. | ||
| 114 | |||
| 115 | 2007-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 | |||
| 121 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 122 | |||
| 123 | * gnus.texi (Mail and Post): Add gnus-message-highlight-citation. | ||
| 124 | |||
| 125 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 126 | |||
| 127 | * gnus.texi (Limiting): Add gnus-summary-limit-to-headers. | ||
| 128 | |||
| 129 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 130 | |||
| 131 | * message.texi (Mail Headers): Document `opportunistic'. | ||
| 132 | |||
| 133 | 2007-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 | |||
| 138 | 2007-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 | |||
| 143 | 2007-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 | |||
| 148 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 149 | |||
| 150 | * gnus.texi (Spam Package Introduction): Fix spam menu and links. | ||
| 151 | |||
| 152 | 2007-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 | |||
| 158 | 2007-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 | |||
| 163 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 164 | |||
| 165 | * gnus.texi (Thread Commands): T M-^. | ||
| 166 | |||
| 167 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 168 | |||
| 169 | * message.texi (Mail Aliases): Document ecomplete. | ||
| 170 | (Mail Aliases): Fix typo. | ||
| 171 | |||
| 172 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 173 | |||
| 174 | * gnus.texi (Face): Restore xref to gnus-face-properties-alist; | ||
| 175 | fix typo. | ||
| 176 | |||
| 177 | 2007-10-28 Romain Francoise <romain@orebokech.com> | ||
| 178 | |||
| 179 | * gnus.texi (Mail Spool): Grammar fix. | ||
| 180 | |||
| 181 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 182 | |||
| 183 | * gnus.texi (Mail Spool): nnml-use-compressed-files can be a | ||
| 184 | string. | ||
| 185 | |||
| 186 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 187 | |||
| 188 | * gnus.texi (Group Parameters): Fix description. | ||
| 189 | |||
| 190 | 2007-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 | |||
| 196 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 197 | |||
| 198 | * emacs-mime.texi (Non-MIME): x-gnus-verbatim -> x-verbatim. | ||
| 199 | |||
| 200 | 2007-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 | |||
| 207 | 2007-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 | |||
| 218 | 2007-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 | |||
| 223 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 224 | |||
| 225 | * gnus.texi (Conformity): Fix typo. | ||
| 226 | (Customizing Articles): Document `first'. | ||
| 227 | |||
| 228 | 2007-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 | |||
| 234 | 2007-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 | |||
| 239 | 2007-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 | |||
| 244 | 2007-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 | |||
| 253 | 2007-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 | |||
| 259 | 2007-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 | |||
| 265 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 266 | |||
| 267 | * gnus.texi (Sorting the Summary Buffer): Added | ||
| 268 | gnus-thread-sort-by-recipient. | ||
| 269 | |||
| 270 | 2007-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 | |||
| 276 | 2007-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 | |||
| 281 | 2007-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 | |||
| 286 | 2007-10-28 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 287 | |||
| 288 | * gnus.texi (Spam ELisp Package Configuration Examples): | ||
| 289 | "training.ham" should be "training.spam" | ||
| 290 | |||
| 291 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 292 | |||
| 293 | * message.texi (Mail Variables): Fix the default value for | ||
| 294 | message-send-mail-function. | ||
| 295 | |||
| 296 | 2007-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 | |||
| 301 | 2007-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 | |||
| 306 | 2007-10-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 307 | |||
| 308 | * gnus.texi (Topic Commands): Fix next/previous. | ||
| 309 | |||
| 310 | 2007-10-28 Simon Josefsson <jas@extundo.com> | ||
| 311 | |||
| 312 | * gnus.texi (Article Washing): Mention `W i'. | ||
| 313 | |||
| 314 | 2007-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 | |||
| 319 | 2007-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 | |||
| 325 | 2007-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 | |||
| 331 | 2007-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 | |||
| 336 | 2007-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 | |||
| 341 | 2007-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 | |||
| 348 | 2007-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 | |||
| 365 | 2007-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 | |||
| 371 | 2007-10-28 Magnus Henoch <mange@freemail.hu> | ||
| 372 | |||
| 373 | * gnus.texi (Hashcash): New default value of | ||
| 374 | hashcash-default-payment. | ||
| 375 | |||
| 376 | 2007-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 | |||
| 381 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 382 | |||
| 383 | * gnus.texi (Adaptive Scoring): Added gnus-adaptive-pretty-print. | ||
| 384 | |||
| 385 | 2007-10-28 Simon Josefsson <jas@extundo.com> | ||
| 386 | |||
| 387 | * gnus.texi (documentencoding): Add, to avoid warnings. | ||
| 388 | |||
| 389 | 2007-10-28 Simon Josefsson <jas@extundo.com> | ||
| 390 | |||
| 391 | * message.texi (Mail Headers): Add. | ||
| 392 | |||
| 393 | * gnus.texi (Hashcash): Fix. | ||
| 394 | |||
| 395 | 2007-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 | |||
| 401 | 2007-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 402 | |||
| 403 | * gnus.texi | ||
| 404 | (Article Display): Add `gnus-picon-style'. | ||
| 405 | |||
| 406 | 2007-10-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 407 | |||
| 408 | * gnus.texi (SpamAssassin backend): Add it to the detailmenu. | ||
| 409 | |||
| 410 | 2007-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 | |||
| 416 | 2007-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 | |||
| 421 | 2007-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 | |||
| 430 | 2007-10-28 Jesper Harder <harder@ifa.au.dk> | ||
| 431 | |||
| 432 | * gnus.texi (GroupLens): Remove. | ||
| 433 | |||
| 434 | 2007-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 | |||
| 440 | 2007-10-28 Jesper Harder <harder@ifa.au.dk> | ||
| 441 | |||
| 442 | * gnus.texi (Limiting): Add gnus-summary-limit-to-replied. | ||
| 443 | |||
| 444 | 2007-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 | |||
| 450 | 2007-10-28 Simon Josefsson <jas@extundo.com> | ||
| 451 | |||
| 452 | * gnus.texi (Top): Add SASL. | ||
| 453 | |||
| 1 | 2007-10-27 Jay Belanger <jay.p.belanger@gmail.com> | 454 | 2007-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 | |||
| 180 | are automatically sent to. It only works in groups matching | 180 | are 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 | ||
| 185 | Slrn-style verbatim marks. | ||
| 186 | |||
| 187 | @item LaTeX | ||
| 188 | @cindex LaTeX | ||
| 189 | LaTeX 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 | ||
| 197 | Some inlined non-@acronym{MIME} attachments are displayed using the face | ||
| 198 | @code{mm-uu-extract}. By default, no @acronym{MIME} button for these | ||
| 199 | parts is displayed. You can force displaying a button using @kbd{K b} | ||
| 200 | (@code{gnus-summary-display-buttonized}) or add @code{text/x-verbatim} | ||
| 201 | to @code{gnus-buttonized-mime-types}, @xref{MIME Commands, ,MIME | ||
| 202 | Commands, 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 |
| 850 | basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). | 869 | basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). |
| 851 | 870 | ||
| 871 | As different hierarchies prefer different charsets, you may want to set | ||
| 872 | @code{mm-coding-system-priorities} according to the hierarchy in Gnus. | ||
| 873 | Here'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 |
| 854 | Mapping from @acronym{MIME} types to encoding to use. This variable is usually | 903 | Mapping 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 |
| 1157 | Encode the non-@acronym{ASCII} words in the region. For instance, | 1206 | Encode 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 | ||
| 10 | Copyright (c) 2004, 2005, 2007 Free Software Foundation, Inc. | ||
| 11 | |||
| 12 | @quotation | ||
| 13 | Permission is granted to copy, distribute and/or modify this document | ||
| 14 | under the terms of the GNU Free Documentation License, Version 1.1 or | ||
| 15 | any later version published by the Free Software Foundation; with no | ||
| 16 | Invariant Sections, with the Front-Cover texts being ``A GNU | ||
| 17 | Manual'', and with the Back-Cover Texts as in (a) below. A copy of the | ||
| 18 | license is included in the section entitled ``GNU Free Documentation | ||
| 19 | License'' in the Emacs manual. | ||
| 20 | |||
| 21 | (a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify | ||
| 22 | this GNU Manual, like GNU software. Copies published by the Free | ||
| 23 | Software Foundation raise funds for GNU development.'' | ||
| 24 | |||
| 25 | This document is part of a collection distributed under the GNU Free | ||
| 26 | Documentation License. If you want to distribute this document | ||
| 27 | separately from the collection, you can do so by adding a copy of the | ||
| 28 | license 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 | ||
| 47 | This 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 | |||
| 59 | The Gnus distribution contains a lot of libraries that have been written | ||
| 60 | for Gnus and used intensively for Gnus. But many of those libraries are | ||
| 61 | useful on their own. E.g. other Emacs Lisp packages might use the | ||
| 62 | @acronym{MIME} library @xref{Top, ,Top, emacs-mime, The Emacs MIME | ||
| 63 | Manual}. | ||
| 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... | ||
| 72 | There are no Gnus dependencies in this file. | ||
| 73 | |||
| 74 | @item format-spec.el | ||
| 75 | Functions for formatting arbitrary formatting strings. | ||
| 76 | @c As of 2005-10-21... | ||
| 77 | There are no Gnus dependencies in this file. | ||
| 78 | |||
| 79 | @item hex-util.el | ||
| 80 | Functions to encode/decode hexadecimal string. | ||
| 81 | @c As of 2007-08-25... | ||
| 82 | There are no Gnus dependencies in these files. | ||
| 83 | @end table | ||
| 84 | |||
| 85 | @subsection Encryption and security | ||
| 86 | |||
| 87 | @table @file | ||
| 88 | @item encrypt.el | ||
| 89 | File encryption routines | ||
| 90 | @c As of 2005-10-25... | ||
| 91 | There are no Gnus dependencies in this file. | ||
| 92 | |||
| 93 | @item password.el | ||
| 94 | Read passwords from user, possibly using a password cache. | ||
| 95 | @c As of 2005-10-21... | ||
| 96 | There are no Gnus dependencies in this file. | ||
| 97 | |||
| 98 | @item tls.el | ||
| 99 | TLS/SSL support via wrapper around GnuTLS | ||
| 100 | @c As of 2005-10-21... | ||
| 101 | There are no Gnus dependencies in this file. | ||
| 102 | |||
| 103 | @item pgg*.el | ||
| 104 | Glue for the various PGP implementations. | ||
| 105 | @c As of 2005-10-21... | ||
| 106 | There are no Gnus dependencies in these files. | ||
| 107 | |||
| 108 | @item sha1.el | ||
| 109 | SHA1 Secure Hash Algorithm. | ||
| 110 | @c As of 2007-08-25... | ||
| 111 | There are no Gnus dependencies in these files. | ||
| 112 | @end table | ||
| 113 | |||
| 114 | @subsection Networking | ||
| 115 | |||
| 116 | @table @file | ||
| 117 | @item dig.el | ||
| 118 | Domain Name System dig interface. | ||
| 119 | @c As of 2005-10-21... | ||
| 120 | There 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 | ||
| 124 | Domain Name Service lookups. | ||
| 125 | @c As of 2005-10-21... | ||
| 126 | There 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 | ||
| 133 | Post Office Protocol (RFC 1460) interface. | ||
| 134 | @c As of 2005-10-21... | ||
| 135 | There are no Gnus dependencies in this file. | ||
| 136 | |||
| 137 | @item imap.el | ||
| 138 | @acronym{IMAP} library. | ||
| 139 | @c As of 2005-10-21... | ||
| 140 | There are no Gnus dependencies in this file. | ||
| 141 | |||
| 142 | @item ietf-drums.el | ||
| 143 | Functions for parsing RFC822bis headers. | ||
| 144 | @c As of 2005-10-21... | ||
| 145 | There are no Gnus dependencies in this file. | ||
| 146 | |||
| 147 | @item rfc1843.el | ||
| 148 | HZ (rfc1843) decoding. HZ is a data format for exchanging files of | ||
| 149 | arbitrarily 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 | ||
| 152 | function should be relocated to remove dependencies on Gnus. Other | ||
| 153 | minor dependencies: @code{gnus-newsgroup-name} could be eliminated by | ||
| 154 | using an optional argument to @code{rfc1843-decode-article-body}. | ||
| 155 | |||
| 156 | @item rfc2045.el | ||
| 157 | Functions for decoding rfc2045 headers | ||
| 158 | @c As of 2007-08-25... | ||
| 159 | There are no Gnus dependencies in these files. | ||
| 160 | |||
| 161 | @item rfc2047.el | ||
| 162 | Functions for encoding and decoding rfc2047 messages | ||
| 163 | @c As of 2007-08-25... | ||
| 164 | There are no Gnus dependencies in these files. | ||
| 165 | @c | ||
| 166 | Only a couple of tests for gnusy symbols. | ||
| 167 | |||
| 168 | @item rfc2104.el | ||
| 169 | RFC2104 Hashed Message Authentication Codes | ||
| 170 | @c As of 2007-08-25... | ||
| 171 | There are no Gnus dependencies in these files. | ||
| 172 | |||
| 173 | @item rfc2231.el | ||
| 174 | Functions for decoding rfc2231 headers | ||
| 175 | @c As of 2007-08-25... | ||
| 176 | There are no Gnus dependencies in these files. | ||
| 177 | |||
| 178 | @item flow-fill.el | ||
| 179 | Interpret RFC2646 "flowed" text. | ||
| 180 | @c As of 2005-10-27... | ||
| 181 | There are no Gnus dependencies in this file. | ||
| 182 | |||
| 183 | @item uudecode.el | ||
| 184 | Elisp native uudecode. | ||
| 185 | @c As of 2005-12-06... | ||
| 186 | There are no Gnus dependencies in this file. | ||
| 187 | @c ... but the custom group is gnus-extract. | ||
| 188 | |||
| 189 | @item canlock.el | ||
| 190 | Functions 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... | ||
| 195 | There are no Gnus dependencies in these files. | ||
| 196 | |||
| 197 | @end table | ||
| 198 | |||
| 199 | @subsection message | ||
| 200 | |||
| 201 | All message composition from Gnus (both mail and news) takes place in | ||
| 202 | Message mode buffers. Message mode is intended to be a replacement for | ||
| 203 | Emacs mail mode. There should be no Gnus dependencies in | ||
| 204 | @file{message.el}. Alas it is not anymore. Patches and suggestions to | ||
| 205 | remove the dependencies are welcome. | ||
| 206 | |||
| 207 | @c message.el requires nnheader which requires gnus-util. | ||
| 208 | |||
| 209 | @subsection Emacs @acronym{MIME} | ||
| 210 | |||
| 211 | The files @file{mml*.el} and @file{mm-*.el} provide @acronym{MIME} | ||
| 212 | functionality for Emacs. | ||
| 213 | |||
| 214 | @acronym{MML} (@acronym{MIME} Meta Language) is supposed to be | ||
| 215 | independent from Gnus. Alas it is not anymore. Patches and suggestions | ||
| 216 | to remove the dependencies are welcome. | ||
| 217 | |||
| 218 | @subsection Gnus backends | ||
| 219 | |||
| 220 | The files @file{nn*.el} provide functionality for accessing NNTP | ||
| 221 | (@file{nntp.el}), IMAP (@file{nnimap.el}) and several other Mail back | ||
| 222 | ends (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 | |||
| 231 | No Gnus and Gnus 5.10.10 and up should work on: | ||
| 232 | @itemize @bullet | ||
| 233 | @item | ||
| 234 | Emacs 21.1 and up. | ||
| 235 | @item | ||
| 236 | XEmacs 21.4 and up. | ||
| 237 | @end itemize | ||
| 238 | |||
| 239 | Gnus 5.10.8 and below should work on: | ||
| 240 | @itemize @bullet | ||
| 241 | @item | ||
| 242 | Emacs 20.7 and up. | ||
| 243 | @item | ||
| 244 | XEmacs 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 | |||
| 252 | The development of Gnus normally is done on the CVS trunk, i.e. there | ||
| 253 | are no separate branches to develop and test new features. Most of the | ||
| 254 | time, the trunk is developed quite actively with more or less daily | ||
| 255 | changes. Only after a new major release, e.g. 5.10.1, there's usually a | ||
| 256 | feature period of several months. After the release of Gnus 5.10.6 the | ||
| 257 | development of new features started again on the trunk while the 5.10 | ||
| 258 | series is continued on the stable branch (v5-10) from which more stable | ||
| 259 | releases will be done when needed (5.10.7, @dots{}). | ||
| 260 | @ref{Gnus Development, ,Gnus Development, gnus, The Gnus Newsreader} | ||
| 261 | |||
| 262 | Stable releases of Gnus finally become part of Emacs. E.g. Gnus 5.8 | ||
| 263 | became a part of Emacs 21 (relabeled to Gnus 5.9). The 5.10 series | ||
| 264 | became 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 | |||
| 276 | In the past, the inclusion of Gnus into Emacs was quite cumbersome. For | ||
| 277 | each change made to Gnus in Emacs repository, it had to be checked that | ||
| 278 | it was applied to the new Gnus version, too. Else, bug fixes done in | ||
| 279 | Emacs repository might have been lost. | ||
| 280 | |||
| 281 | With the inclusion of Gnus 5.10, Miles Bader has set up an Emacs-Gnus | ||
| 282 | gateway to ensure the bug fixes from Emacs CVS are propagated to Gnus | ||
| 283 | CVS semi-automatically. These bug fixes are installed on the stable | ||
| 284 | branch and on the trunk. Basically the idea is that the gateway will | ||
| 285 | cause all common files in Emacs and Gnus v5-10 to be identical except | ||
| 286 | when there's a very good reason (e.g., the Gnus version string in Emacs | ||
| 287 | says @samp{5.11}, but the v5-10 version string remains @samp{5.10.x}). | ||
| 288 | Furthermore, all changes in these files in either Emacs or the v5-10 | ||
| 289 | branch will be installed into the Gnus CVS trunk, again except where | ||
| 290 | there'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). | ||
| 293 | Because of this, when the next major version of Gnus will be included in | ||
| 294 | Emacs, it should be very easy -- just plonk in the files from the Gnus | ||
| 295 | trunk without worrying about lost changes from the Emacs tree. | ||
| 296 | |||
| 297 | The effect of this is that as hacker, you should generally only have to | ||
| 298 | make changes in one place: | ||
| 299 | |||
| 300 | @itemize | ||
| 301 | @item | ||
| 302 | If it's a file which is thought of as being outside of Gnus (e.g., the | ||
| 303 | new @file{encrypt.el}), you should probably make the change in the Emacs | ||
| 304 | tree, and it will show up in the Gnus tree a few days later. | ||
| 305 | |||
| 306 | If you don't have Emacs CVS access (or it's inconvenient), you can | ||
| 307 | change such a file in the v5-10 branch, and it should propagate to Emacs | ||
| 308 | CVS -- however, it will get some extra scrutiny (by Miles) to see if the | ||
| 309 | changes are possibly controversial and need discussion on the mailing | ||
| 310 | list. Many changes are obvious bug-fixes however, so often there won't | ||
| 311 | be any problem. | ||
| 312 | |||
| 313 | @item | ||
| 314 | If it's to a Gnus file, and it's important enough that it should be part | ||
| 315 | of Emacs and the v5-10 branch, then you can make the change on the v5-10 | ||
| 316 | branch, and it will go into Emacs CVS and the Gnus CVS trunk (a few days | ||
| 317 | later). The most prominent examples for such changes are bug-fixed | ||
| 318 | including improvements on the documentation. | ||
| 319 | |||
| 320 | If you know that there will be conflicts (perhaps because the affected | ||
| 321 | source code is different in v5-10 and the Gnus CVS trunk), then you can | ||
| 322 | install your change in both places, and when I try to sync them, there | ||
| 323 | will be a conflict -- however, since in most such cases there would be a | ||
| 324 | conflict @emph{anyway}, it's often easier for me to resolve it simply if | ||
| 325 | I see two @samp{identical} changes, and can just choose the proper one, | ||
| 326 | rather than having to actually fix the code. | ||
| 327 | |||
| 328 | @item | ||
| 329 | For general Gnus development changes, of course you just make the | ||
| 330 | change on the Gnus CVS trunk and it goes into Emacs a few years | ||
| 331 | later... :-) | ||
| 332 | @end itemize | ||
| 333 | |||
| 334 | Of course in any case, if you just can't wait for me to sync your | ||
| 335 | change, you can commit it in more than one place and probably there will | ||
| 336 | be no problem; usually the changes are textually identical anyway, so | ||
| 337 | can be easily resolved automatically (sometimes I notice silly things in | ||
| 338 | such 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 | |||
| 356 | Starting 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 | |||
| 364 | For new customizable variables introduced in Oort Gnus (including the | ||
| 365 | v5-10 branch) use @code{:version "22.1" ;; Oort Gnus} (including the | ||
| 366 | comment) or e.g. @code{:version "22.2" ;; Gnus 5.10.10} if the feature | ||
| 367 | was added for Emacs 22.2 and Gnus 5.10.10. | ||
| 368 | @c | ||
| 369 | If the variable is new in No Gnus use @code{:version "23.0" ;; No Gnus}. | ||
| 370 | |||
| 371 | The same applies for customizable variables when its default value was | ||
| 372 | changed. | ||
| 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 | ||
| 1289 | Say | 1289 | Starting from No Gnus, automatic word-wrap is already enabled by |
| 1290 | default, see the variable message-fill-column. | ||
| 1291 | |||
| 1292 | For 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 | ||
| 1299 | in ~/.gnus.el. You can reformat a paragraph by hitting | 1303 | in ~/.gnus.el. |
| 1300 | @samp{M-q} (as usual) | 1304 | |
| 1305 | You 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 | |||
| 1676 | yourUserName.userfqdn.provider.net, or you can use | 1681 | yourUserName.userfqdn.provider.net, or you can use |
| 1677 | somethingUnique.yourdomain.tld if you own the domain | 1682 | somethingUnique.yourdomain.tld if you own the domain |
| 1678 | yourdomain.tld, or you can register at a service which | 1683 | yourdomain.tld, or you can register at a service which |
| 1679 | gives private users a FQDN for free, e.g. | 1684 | gives 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 | ||
| 1682 | English one offering the same, drop me a note). | ||
| 1683 | 1685 | ||
| 1684 | Finally you can tell Gnus not to generate a Message-ID | 1686 | Finally you can tell Gnus not to generate a Message-ID |
| 1685 | for News at all (and letting the server do the job) by saying | 1687 | for 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 | |||
| 31 | Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, | ||
| 32 | 2006, 2007 Free Software Foundation, Inc. | ||
| 33 | See the end of the file for license conditions. | ||
| 34 | |||
| 35 | Please send Gnus bug reports to bugs@gnus.org. | ||
| 36 | For 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 | |||
| 44 | This file is part of GNU Emacs. | ||
| 45 | |||
| 46 | GNU Emacs is free software; you can redistribute it and/or modify | ||
| 47 | it under the terms of the GNU General Public License as published by | ||
| 48 | the Free Software Foundation; either version 3, or (at your option) | ||
| 49 | any later version. | ||
| 50 | |||
| 51 | GNU Emacs is distributed in the hope that it will be useful, | ||
| 52 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 53 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 54 | GNU General Public License for more details. | ||
| 55 | |||
| 56 | You should have received a copy of the GNU General Public License | ||
| 57 | along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 58 | Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 59 | Boston, MA 02110-1301, USA. | ||
| 60 | |||
| 61 | \nLocal variables:\nmode: outline | ||
| 62 | paragraph-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 | |||
| 26 | If you have tried No Gnus (the unstable Gnus branch leading to this | ||
| 27 | release) but went back to a stable version, be careful when upgrading | ||
| 28 | to this version. In particular, you will probably want to remove the | ||
| 29 | @file{~/News/marks} directory (perhaps selectively), so that flags are | ||
| 30 | read from your @file{~/.newsrc.eld} instead of from the stale marks | ||
| 31 | file, where this release will store flags for nntp. See a later entry | ||
| 32 | for more information about nntp marks. Note that downgrading isn't | ||
| 33 | safe in general. | ||
| 34 | |||
| 35 | @item Lisp files are now installed in @file{.../site-lisp/gnus/} by default. | ||
| 36 | It defaulted to @file{.../site-lisp/} formerly. In addition to this, | ||
| 37 | the new installer issues a warning if other Gnus installations which | ||
| 38 | will shadow the latest one are detected. You can then remove those | ||
| 39 | shadows manually or remove them using @code{make | ||
| 40 | remove-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 | |||
| 49 | This provides a clean @acronym{API} to @acronym{SASL} mechanisms from | ||
| 50 | within Emacs. The user visible aspects of this, compared to the earlier | ||
| 51 | situation, 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 | |||
| 56 | The 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 | |||
| 61 | It is enabled by default (see @code{password-cache}), with a short | ||
| 62 | timeout of 16 seconds (see @code{password-cache-expiry}). If | ||
| 63 | @acronym{PGG} is used as the @acronym{PGP} back end, the @acronym{PGP} | ||
| 64 | passphrase is managed by this mechanism. Passwords for ManageSieve | ||
| 65 | connections are managed by this mechanism, after querying the user | ||
| 66 | about 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 | ||
| 74 | that are not reused when you select another article. @xref{Sticky | ||
| 75 | Articles}. | ||
| 76 | |||
| 77 | @item International host names (@acronym{IDNA}) can now be decoded | ||
| 78 | inside 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 | ||
| 84 | improved. The back ends that fully support non-@acronym{ASCII} group | ||
| 85 | names are now @code{nntp}, @code{nnml}, and @code{nnrss}. Also the | ||
| 86 | agent, 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 | ||
| 90 | using 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 | ||
| 98 | Generation 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 | ||
| 102 | Sorting}. | ||
| 103 | |||
| 104 | @item @acronym{S/MIME} now features @acronym{LDAP} user certificate searches. | ||
| 105 | You need to configure the server in @code{smime-ldap-host-list}. | ||
| 106 | |||
| 107 | @item URLs inside Open@acronym{PGP} headers are retrieved and imported | ||
| 108 | to your PGP key ring when you click on them. | ||
| 109 | |||
| 110 | @item | ||
| 111 | Picons 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 | ||
| 115 | using @kbd{W A}. | ||
| 116 | |||
| 117 | @acronym{ANSI} sequences are used in some Chinese hierarchies for | ||
| 118 | highlighting articles (@code{gnus-article-treat-ansi-sequences}). | ||
| 119 | |||
| 120 | @item Gnus now MIME decodes articles even when they lack "MIME-Version" header. | ||
| 121 | This changes the default of @code{gnus-article-loose-mime}. | ||
| 122 | |||
| 123 | @item @code{gnus-decay-scores} can be a regexp matching score files. | ||
| 124 | For example, set it to @samp{\\.ADAPT\\'} and only adaptive score files | ||
| 125 | will be decayed. @xref{Score Decays}. | ||
| 126 | |||
| 127 | @item Strings prefixing to the @code{To} and @code{Newsgroup} headers in | ||
| 128 | summary lines when using @code{gnus-ignored-from-addresses} can be | ||
| 129 | customized 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. | ||
| 133 | See @code{gnus-mime-replace-part} and @code{gnus-article-replace-part}. | ||
| 134 | @xref{MIME Commands}, @ref{Using MIME}. | ||
| 135 | |||
| 136 | @item | ||
| 137 | The option @code{mm-fill-flowed} can be used to disable treatment of | ||
| 138 | format=flowed messages. Also, flowed text is disabled when sending | ||
| 139 | inline @acronym{PGP} signed messages. @xref{Flowed text, ,Flowed text, | ||
| 140 | emacs-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. | ||
| 149 | Use @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. | ||
| 153 | See @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 | ||
| 157 | empty 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. | ||
| 161 | The @code{References} header is hidden by default. To make all | ||
| 162 | headers 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 | ||
| 166 | article buffer. See @code{gnus-message-highlight-citation}. | ||
| 167 | |||
| 168 | @item @code{auto-fill-mode} is enabled by default in Message mode. | ||
| 169 | See @code{message-fill-column}. @xref{Various Message Variables, , | ||
| 170 | Message Headers, message, Message Manual}. | ||
| 171 | |||
| 172 | @item You can now store signature files in a special directory | ||
| 173 | named @code{message-signature-directory}. | ||
| 174 | |||
| 175 | @item The option @code{message-citation-line-format} controls the format | ||
| 176 | of 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 | |||
| 186 | The 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 | ||
| 189 | is that you can copy @file{~/News/marks} (using rsync, scp or | ||
| 190 | whatever) to another Gnus installation, and it will realize what | ||
| 191 | articles you have read and marked. The data in @file{~/News/marks} | ||
| 192 | has priority over the same data in @file{~/.newsrc.eld}. | ||
| 193 | |||
| 194 | @item | ||
| 195 | You 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 | |||
| 200 | By default, Gnus does not send any information about itself, but you can | ||
| 201 | customize it using the variable @code{nnimap-id}. | ||
| 202 | |||
| 203 | @item The @code{nnrss} back end now supports multilingual text. | ||
| 204 | Non-@acronym{ASCII} group names for the @code{nnrss} groups are also | ||
| 205 | supported. @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} | ||
| 210 | for compressed message files. @xref{Mail Spool}. | ||
| 211 | |||
| 212 | @item The nnml back end supports group compaction. | ||
| 213 | |||
| 214 | This 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) | ||
| 217 | renumbers all articles in a group, starting from 1 and removing gaps. | ||
| 218 | As a consequence, you get a correct total article count (until | ||
| 219 | messages 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. | ||
| 228 | You can also customize the tool bar. There's no documentation in the | ||
| 229 | manual yet, but @kbd{M-x customize-apropos RET -tool-bar$} should get | ||
| 230 | you 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 | ||
| 234 | in the group buffer, see the variable @code{gnus-group-update-tool-bar}. | ||
| 235 | Its 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. | ||
| 239 | See @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 | ||
| 247 | server buffer is immediately reflected to the subscription of the groups | ||
| 248 | which 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 | ||
| 251 | intermediate host @samp{bar.example.com} from next time. | ||
| 252 | |||
| 253 | @item The @file{all.SCORE} file can be edited from the group buffer | ||
| 254 | using @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 |
| 10 | Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, | 12 | Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, |
| 11 | 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. | 13 | 2002, 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 | |||
| 360 | luck. | 362 | luck. |
| 361 | 363 | ||
| 362 | @c Adjust ../Makefile.in if you change the following line: | 364 | @c Adjust ../Makefile.in if you change the following line: |
| 363 | This manual corresponds to Gnus v5.11. | 365 | This 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 | ||
| 459 | Group Buffer Format | 463 | Group 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 | ||
| 650 | Getting Mail | 656 | Getting 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 | ||
| 791 | GroupLens | ||
| 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 | |||
| 798 | Advanced Scoring | 797 | Advanced 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 | ||
| 905 | Customization | 905 | Customization |
| 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 | ||
| 1070 | Note: the @acronym{NNTP} back end stores marks in marks files | ||
| 1071 | (@pxref{NNTP marks}). This feature makes it easy to share marks between | ||
| 1072 | several Gnus installations, but may slow down things a bit when fetching | ||
| 1073 | new 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 | |||
| 1819 | hysterical raisins, even the mail back ends, where the true number of | 1825 | hysterical raisins, even the mail back ends, where the true number of |
| 1820 | unread messages might be available efficiently, use the same limited | 1826 | unread messages might be available efficiently, use the same limited |
| 1821 | interface. To remove this restriction from Gnus means that the back | 1827 | interface. To remove this restriction from Gnus means that the back |
| 1822 | end interface has to be changed, which is not an easy job. If you | 1828 | end interface has to be changed, which is not an easy job. |
| 1823 | want to work on this, please contact the Gnus mailing list. | 1829 | |
| 1830 | The nnml backend (@pxref{Mail Spool}) has a feature called ``group | ||
| 1831 | compaction'' which circumvents this deficiency: the idea is to | ||
| 1832 | renumber all articles from 1, removing all gaps between numbers, hence | ||
| 1833 | getting a correct total count. Other backends may support this in the | ||
| 1834 | future. In order to keep your total article count relatively up to | ||
| 1835 | date, you might want to compact your groups (or even directly your | ||
| 1836 | server) from time to time. @xref{Misc Group Stuff}, @xref{Server Commands}. | ||
| 1824 | 1837 | ||
| 1825 | @item y | 1838 | @item y |
| 1826 | Number of unread, unticked, non-dormant articles. | 1839 | Number of unread, unticked, non-dormant articles. |
| @@ -1886,6 +1899,12 @@ the group lately. | |||
| 1886 | A string that says when you last read the group (@pxref{Group | 1899 | A string that says when you last read the group (@pxref{Group |
| 1887 | Timestamp}). | 1900 | Timestamp}). |
| 1888 | 1901 | ||
| 1902 | @item F | ||
| 1903 | The disk space used by the articles fetched by both the cache and | ||
| 1904 | agent. The value is automatically scaled to bytes(B), kilobytes(K), | ||
| 1905 | megabytes(M), or gigabytes(G) to minimize the column width. A format | ||
| 1906 | of %7F is sufficient for a fixed-width column. | ||
| 1907 | |||
| 1889 | @item u | 1908 | @item u |
| 1890 | User defined specifier. The next character in the format string should | 1909 | User defined specifier. The next character in the format string should |
| 1891 | be a letter. Gnus will call the function | 1910 | be a letter. Gnus will call the function |
| @@ -2071,6 +2090,11 @@ commands will move to the next group, not the next unread group. Even | |||
| 2071 | the commands that say they move to the next unread group. The default | 2090 | the commands that say they move to the next unread group. The default |
| 2072 | is @code{t}. | 2091 | is @code{t}. |
| 2073 | 2092 | ||
| 2093 | @vindex gnus-summary-next-group-on-exit | ||
| 2094 | If @code{gnus-summary-next-group-on-exit} is @code{t}, when a summary is | ||
| 2095 | exited, the point in the group buffer is moved to the next unread group. | ||
| 2096 | Otherwise, 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 | ||
| 3015 | If you're using topics to organize your group buffer | ||
| 3016 | (@pxref{Group Topics}), note that posting styles can also be set in | ||
| 3017 | the topics parameters. Posting styles in topic parameters apply to all | ||
| 3018 | groups in this topic. More precisely, the posting-style settings for a | ||
| 3019 | group result from the hierarchical merging of all posting-style | ||
| 3020 | entries in the parameters of this group and all the topics it belongs | ||
| 3021 | to. | ||
| 3022 | |||
| 3023 | |||
| 2991 | @item post-method | 3024 | @item post-method |
| 2992 | @cindex post-method | 3025 | @cindex post-method |
| 2993 | If it is set, the value is used as the method for posting message | 3026 | If 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 | |||
| 3014 | Commands}) the following Sieve code is generated: | 3047 | Commands}) the following Sieve code is generated: |
| 3015 | 3048 | ||
| 3016 | @example | 3049 | @example |
| 3017 | if address \"sender\" \"sieve-admin@@extundo.com\" @{ | 3050 | if address "sender" "sieve-admin@@extundo.com" @{ |
| 3018 | fileinto \"INBOX.list.sieve\"; | 3051 | fileinto "INBOX.list.sieve"; |
| 3052 | @} | ||
| 3053 | @end example | ||
| 3054 | |||
| 3055 | To generate tests for multiple email-addresses use a group parameter | ||
| 3056 | like @code{(sieve address "sender" ("name@@one.org" else@@two.org"))}. | ||
| 3057 | When generating a sieve script (@pxref{Sieve Commands}) Sieve code | ||
| 3058 | like the following is generated: | ||
| 3059 | |||
| 3060 | @example | ||
| 3061 | if address "sender" ["name@@one.org", "else@@two.org"] @{ | ||
| 3062 | fileinto "INBOX.list.sieve"; | ||
| 3019 | @} | 3063 | @} |
| 3020 | @end example | 3064 | @end example |
| 3021 | 3065 | ||
| 3066 | See @pxref{Sieve Commands} for commands and variables that might be of | ||
| 3067 | interest in relation to the sieve parameter. | ||
| 3068 | |||
| 3022 | The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve, | 3069 | The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve, |
| 3023 | Top, sieve, Emacs Sieve}. | 3070 | Top, 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 |
| 3133 | always in a case-insensitive manner. | 3180 | always in a case-insensitive manner. |
| 3134 | 3181 | ||
| 3182 | You can define different sorting to different groups via | ||
| 3183 | @code{gnus-parameters}. Here is an example to sort an @acronym{NNTP} | ||
| 3184 | group 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 | ||
| 3186 | Debian daily news group @code{gmane.linux.debian.user.news} from | ||
| 3187 | news.gmane.org. The @acronym{RSS} group corresponds to the Debian | ||
| 3188 | weekly 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 |
| 3850 | Go to the next topic (@code{gnus-topic-goto-previous-topic}). | 3924 | Go 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 | |||
| 4086 | happens. You just have to be careful if you do stuff like that. | 4160 | happens. 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 | |||
| 4167 | There are some news servers that provide groups of which the names are | ||
| 4168 | expressed with their native languages in the world. For instance, in a | ||
| 4169 | certain news server there are some newsgroups of which the names are | ||
| 4170 | spelled in Chinese, where people are talking in Chinese. You can, of | ||
| 4171 | course, subscribe to such news groups using Gnus. Currently Gnus | ||
| 4172 | supports non-@acronym{ASCII} group names not only with the @code{nntp} | ||
| 4173 | back end but also with the @code{nnml} back end and the @code{nnrss} | ||
| 4174 | back end. | ||
| 4175 | |||
| 4176 | Every such group name is encoded by a certain charset in the server | ||
| 4177 | side (in an @acronym{NNTP} server its administrator determines the | ||
| 4178 | charset, but for groups in the other back ends it is determined by you). | ||
| 4179 | Gnus has to display the decoded ones for you in the group buffer and the | ||
| 4180 | article buffer, and needs to use the encoded ones when communicating | ||
| 4181 | with servers. However, Gnus doesn't know what charset is used for each | ||
| 4182 | non-@acronym{ASCII} group name. The following two variables are just | ||
| 4183 | the 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 | ||
| 4188 | An alist of select methods and charsets. The default value is | ||
| 4189 | @code{nil}. The names of groups in the server specified by that select | ||
| 4190 | method 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 | |||
| 4197 | Charsets specified for groups with this variable are preferred to the | ||
| 4198 | ones specified for the same groups with the | ||
| 4199 | @code{gnus-group-name-charset-group-alist} variable (see below). | ||
| 4200 | |||
| 4201 | A 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 | |||
| 4215 | In that case, you can truncate it into @code{(nntp "gmane")} in this | ||
| 4216 | variable. That is, it is enough to contain only the back end name and | ||
| 4217 | the 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 | ||
| 4222 | An 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, | ||
| 4224 | otherwise 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 | |||
| 4232 | Note that this variable is ignored if the match is made with | ||
| 4233 | @code{gnus-group-name-charset-method-alist}. | ||
| 4234 | @end table | ||
| 4235 | |||
| 4236 | Those two variables are used also to determine the charset for encoding | ||
| 4237 | and decoding non-@acronym{ASCII} group names that are in the back ends | ||
| 4238 | other than @code{nntp}. It means that it is you who determine it. If | ||
| 4239 | you do nothing, the charset used for group names in those back ends will | ||
| 4240 | all be @code{utf-8} because of the last element of | ||
| 4241 | @code{gnus-group-name-charset-group-alist}. | ||
| 4242 | |||
| 4243 | There is one more important variable for non-@acronym{ASCII} group | ||
| 4244 | names. @emph{XEmacs users must set this}. Emacs users necessarily need | ||
| 4245 | not do: | ||
| 4246 | |||
| 4247 | @table @code | ||
| 4248 | @item nnmail-pathname-coding-system | ||
| 4249 | The 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 | ||
| 4251 | end, the @acronym{NNTP} marks feature (@pxref{NNTP marks}), the agent, | ||
| 4252 | and the cache use non-@acronym{ASCII} group names in those files and | ||
| 4253 | directories. This variable overrides the value of | ||
| 4254 | @code{file-name-coding-system} which specifies the coding system used | ||
| 4255 | when encoding and decoding those file names and directory names. | ||
| 4256 | |||
| 4257 | In XEmacs (with the @code{mule} feature), @code{file-name-coding-system} | ||
| 4258 | is the only means to specify the coding system used to encode and decode | ||
| 4259 | file names. Therefore, @emph{you, XEmacs users, have to set it} to the | ||
| 4260 | coding system that is suitable to encode and decode non-@acronym{ASCII} | ||
| 4261 | group names. On the other hand, Emacs uses the value of | ||
| 4262 | @code{default-file-name-coding-system} if @code{file-name-coding-system} | ||
| 4263 | is @code{nil}. Normally the value of | ||
| 4264 | @code{default-file-name-coding-system} is initialized according to the | ||
| 4265 | locale, so you will need to do nothing if the value is suitable to | ||
| 4266 | encode and decode non-@acronym{ASCII} group names. | ||
| 4267 | |||
| 4268 | The value of this variable (or @code{default-file-name-coding-system}) | ||
| 4269 | does 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 | |||
| 4273 | If 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 | ||
| 4276 | have to set @code{nnmail-pathname-coding-system} even if you are an | ||
| 4277 | Emacs user. The @code{utf-8} coding system is a good candidate for it. | ||
| 4278 | Otherwise, you may change the locale in your system so that | ||
| 4279 | @code{default-file-name-coding-system} may be initialized to an | ||
| 4280 | appropriate value, instead of specifying this variable. | ||
| 4281 | @end table | ||
| 4282 | |||
| 4283 | Note that when you copy or move articles from a non-@acronym{ASCII} | ||
| 4284 | group to another group, the charset used to encode and decode group | ||
| 4285 | names should be the same in both groups. Otherwise the Newsgroups | ||
| 4286 | header 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 | |||
| 4152 | in question. The corresponding back end must have a request-post method | 4352 | in question. The corresponding back end must have a request-post method |
| 4153 | for this to work though. | 4353 | for this to work though. |
| 4154 | 4354 | ||
| 4355 | @item G z | ||
| 4356 | @kindex G z (Group) | ||
| 4357 | @findex gnus-group-compact-group | ||
| 4358 | |||
| 4359 | Compact the group under point (@code{gnus-group-compact-group}). | ||
| 4360 | Currently implemented only in nnml (@pxref{Mail Spool}). This removes | ||
| 4361 | gaps between article numbers, hence getting a correct total article | ||
| 4362 | count. | ||
| 4363 | |||
| 4155 | @end table | 4364 | @end table |
| 4156 | 4365 | ||
| 4157 | Variables for the group buffer: | 4366 | Variables for the group buffer: |
| @@ -4179,31 +4388,6 @@ generated. It may be used to move point around, for instance. | |||
| 4179 | Groups matching this regexp will always be listed in the group buffer, | 4388 | Groups matching this regexp will always be listed in the group buffer, |
| 4180 | whether they are empty or not. | 4389 | whether they are empty or not. |
| 4181 | 4390 | ||
| 4182 | @item gnus-group-name-charset-method-alist | ||
| 4183 | @vindex gnus-group-name-charset-method-alist | ||
| 4184 | An alist of method and the charset for group names. It is used to show | ||
| 4185 | non-@acronym{ASCII} group names. | ||
| 4186 | |||
| 4187 | For 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 | ||
| 4196 | An alist of regexp of group name and the charset for group names. It | ||
| 4197 | is used to show non-@acronym{ASCII} group names. @code{((".*" | ||
| 4198 | utf-8))} is the default value if UTF-8 is supported, otherwise the | ||
| 4199 | default is @code{nil}. | ||
| 4200 | |||
| 4201 | For 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} |
| 4839 | headers are used instead. | 5024 | headers are used instead. |
| 4840 | 5025 | ||
| 5026 | To distinguish regular articles from those where the @code{From} field | ||
| 5027 | has 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 | ||
| 5030 | customize 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 |
| 6363 | matching articles. | 6555 | matching articles. |
| 6364 | 6556 | ||
| 6557 | @item / R | ||
| 6558 | @kindex / R (Summary) | ||
| 6559 | @findex gnus-summary-limit-to-recipient | ||
| 6560 | Limit the summary buffer to articles that match some recipient | ||
| 6561 | (@code{gnus-summary-limit-to-recipient}). If given a prefix, exclude | ||
| 6562 | matching articles. | ||
| 6563 | |||
| 6564 | @item / A | ||
| 6565 | @kindex / A (Summary) | ||
| 6566 | @findex gnus-summary-limit-to-address | ||
| 6567 | Limit the summary buffer to articles in which contents of From, To or Cc | ||
| 6568 | header match a given address (@code{gnus-summary-limit-to-address}). If | ||
| 6569 | given a prefix, exclude matching articles. | ||
| 6570 | |||
| 6571 | @item / S | ||
| 6572 | @kindex / S (Summary) | ||
| 6573 | @findex gnus-summary-limit-to-singletons | ||
| 6574 | Limit the summary buffer to articles that aren't part of any displayed | ||
| 6575 | threads (@code{gnus-summary-limit-to-singletons}). If given a prefix, | ||
| 6576 | limit 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 |
| 6428 | Parameters}, for more on this predicate. | 6641 | Parameters}, for more on this predicate. |
| 6429 | 6642 | ||
| 6643 | @item / r | ||
| 6644 | @kindex / r (Summary) | ||
| 6645 | @findex gnus-summary-limit-to-replied | ||
| 6646 | Limit the summary buffer to replied articles | ||
| 6647 | (@code{gnus-summary-limit-to-replied}). If given a prefix, exclude | ||
| 6648 | replied 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}. | |||
| 6488 | Insert all old articles in the summary buffer. If given a numbered | 6708 | Insert all old articles in the summary buffer. If given a numbered |
| 6489 | prefix, fetch this number of articles. | 6709 | prefix, fetch this number of articles. |
| 6490 | 6710 | ||
| 6711 | @item / b | ||
| 6712 | @kindex / b (Summary) | ||
| 6713 | @findex gnus-summary-limit-to-bodies | ||
| 6714 | Limit the summary buffer to articles that have bodies that match a | ||
| 6715 | certain regexp (@code{gnus-summary-limit-to-bodies}). If given a | ||
| 6716 | prefix, reverse the limit. This command is quite slow since it | ||
| 6717 | requires selecting each article to find the matches. | ||
| 6718 | |||
| 6719 | @item / h | ||
| 6720 | @kindex / h (Summary) | ||
| 6721 | @findex gnus-summary-limit-to-headers | ||
| 6722 | Like 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. | |||
| 6988 | Make the current article the child of the marked (or previous) article | 7222 | Make 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 | ||
| 7228 | Make the current article the parent of the marked articles | ||
| 7229 | (@code{gnus-summary-reparent-children}). | ||
| 7230 | |||
| 6991 | @end table | 7231 | @end table |
| 6992 | 7232 | ||
| 6993 | The following commands are thread movement commands. They all | 7233 | The 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 | ||
| 7065 | By default, sorting is done on article numbers. Ready-made sorting | 7306 | By default, sorting is done on article numbers. Ready-made sorting |
| 7066 | predicate functions include @code{gnus-thread-sort-by-number}, | 7307 | predicate 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 | ||
| 7386 | You 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 | |||
| 7613 | When you select an article the current article buffer will be reused | ||
| 7614 | according to the value of the variable | ||
| 7615 | @code{gnus-single-article-buffer}. If its value is non-@code{nil} (the | ||
| 7616 | default) all articles reuse the same article buffer. Else each group | ||
| 7617 | has its own article buffer. | ||
| 7618 | |||
| 7619 | This implies that it's not possible to have more than one article buffer | ||
| 7620 | in a group at a time. But sometimes you might want to display all the | ||
| 7621 | latest emails from your mother, your father, your aunt, your uncle and | ||
| 7622 | your 17 cousins to coordinate the next christmas party. | ||
| 7623 | |||
| 7624 | That's where sticky articles come in handy. A sticky article buffer | ||
| 7625 | basically is a normal article buffer, but it won't be reused when you | ||
| 7626 | select 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 | ||
| 7632 | Make the current article sticky. If a prefix arg is given, ask for a | ||
| 7633 | name for this sticky article buffer. | ||
| 7634 | @end table | ||
| 7635 | |||
| 7636 | To 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 | ||
| 7642 | Puts 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 | ||
| 7647 | Kills this sticky article buffer. | ||
| 7648 | @end table | ||
| 7649 | |||
| 7650 | To kill all sticky article buffers you can use: | ||
| 7651 | |||
| 7652 | @defun gnus-kill-sticky-article-buffers ARG | ||
| 7653 | Kill all sticky article buffers. | ||
| 7654 | If 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 |
| 8556 | Morse decode the article buffer (@code{gnus-summary-morse-message}). | 8847 | Morse 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 | ||
| 8852 | Decode IDNA encoded domain names in the current articles. IDNA | ||
| 8853 | encoded domain names looks like @samp{xn--bar}. If a string remain | ||
| 8854 | unencoded after running invoking this, it is likely an invalid IDNA | ||
| 8855 | string (@samp{xn--bar} is invalid). You must have GNU Libidn | ||
| 8856 | (@url{http://www.gnu.org/software/libidn/}) installed for this command | ||
| 8857 | to 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) | |||
| 8657 | Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). | 8958 | Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). |
| 8658 | Quoted-Printable is one common @acronym{MIME} encoding employed when | 8959 | Quoted-Printable is one common @acronym{MIME} encoding employed when |
| 8659 | sending non-@acronym{ASCII} (i.e., 8-bit) articles. It typically | 8960 | sending non-@acronym{ASCII} (i.e., 8-bit) articles. It typically |
| 8660 | makes strings like @samp{déjà vu} look like @samp{d=E9j=E0 vu}, which | 8961 | makes strings like @samp{d@'ej@`a vu} look like @samp{d=E9j=E0 vu}, |
| 8661 | doesn't look very readable to me. Note that this is usually done | 8962 | which doesn't look very readable to me. Note that this is usually |
| 8662 | automatically by Gnus if the message in question has a | 8963 | done 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 |
| 8664 | has been done. If a prefix is given, a charset will be asked for. | 8965 | has 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 | |||
| 8680 | common encoding employed when sending Chinese articles. It typically | 8981 | common encoding employed when sending Chinese articles. It typically |
| 8681 | makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}. | 8982 | makes 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 | ||
| 8988 | Translate @acronym{ANSI} SGR control sequences into overlays or | ||
| 8989 | extents (@code{gnus-article-treat-ansi-sequences}). @acronym{ANSI} | ||
| 8990 | sequences 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 | ||
| 9309 | The following commands all understand the numerical prefix. For | 9618 | The following commands all understand the numerical prefix. For |
| 9310 | instance, @kbd{3 b} means ``view the third @acronym{MIME} part''. | 9619 | instance, @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) |
| 9321 | Save the @acronym{MIME} part. | 9630 | Save the @acronym{MIME} part. |
| 9322 | 9631 | ||
| 9632 | @item K O | ||
| 9633 | @kindex K O (Summary) | ||
| 9634 | Prompt for a file name, then save the @acronym{MIME} part and strip it | ||
| 9635 | from the article. The stripped @acronym{MIME} object will be referred | ||
| 9636 | via the message/external-body @acronym{MIME} type. | ||
| 9637 | |||
| 9638 | @item K r | ||
| 9639 | @kindex K r (Summary) | ||
| 9640 | Replace the @acronym{MIME} part with an external body. | ||
| 9641 | |||
| 9642 | @item K d | ||
| 9643 | @kindex K d (Summary) | ||
| 9644 | Delete the @acronym{MIME} part and add some information about the | ||
| 9645 | removed part. | ||
| 9646 | |||
| 9323 | @item K c | 9647 | @item K c |
| 9324 | @kindex K c (Summary) | 9648 | @kindex K c (Summary) |
| 9325 | Copy the @acronym{MIME} part. | 9649 | Copy 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 |
| 9678 | Sort by author (@code{gnus-summary-sort-by-author}). | 10002 | Sort 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 | ||
| 10007 | Sort 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 | |||
| 10401 | Search through all previous (raw) articles for a regexp | 10730 | Search 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 | ||
| 10736 | Repeat 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 | ||
| 10742 | Repeat 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 | |||
| 10442 | Pull all dormant articles (for the current group) into the summary buffer | 10783 | Pull 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 | ||
| 10789 | Pull 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 | |||
| 10464 | some format, you @kbd{C-d} and read these messages in a more convenient | 10811 | some format, you @kbd{C-d} and read these messages in a more convenient |
| 10465 | fashion. | 10812 | fashion. |
| 10466 | 10813 | ||
| 10814 | @vindex gnus-auto-select-on-ephemeral-exit | ||
| 10815 | The variable @code{gnus-auto-select-on-ephemeral-exit} controls what | ||
| 10816 | article should be selected after exiting a digest group. Valid values | ||
| 10817 | include: | ||
| 10818 | |||
| 10819 | @table @code | ||
| 10820 | @item next | ||
| 10821 | Select the next article. | ||
| 10822 | |||
| 10823 | @item next-unread | ||
| 10824 | Select the next unread article. | ||
| 10825 | |||
| 10826 | @item next-noselect | ||
| 10827 | Move the cursor to the next article. This is the default. | ||
| 10828 | |||
| 10829 | @item next-unread-noselect | ||
| 10830 | Move the cursor to the next unread article. | ||
| 10831 | @end table | ||
| 10832 | |||
| 10833 | If it has any other value or there is no next (unread) article, the | ||
| 10834 | article 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 | |||
| 10562 | Mark all articles as read and go to the next group | 10931 | Mark 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 | ||
| 10937 | Mark 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 |
| 10895 | Browse the mailing list archive, if List-Archive field exists. | 11270 | Browse 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 | |||
| 11111 | message/external-body @acronym{MIME} type. | 11486 | message/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) | ||
| 11492 | Prompt for a file name, replace the @acronym{MIME} object with an | ||
| 11493 | external 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 | |||
| 11118 | information about the removed @acronym{MIME} object | 11500 | information 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) |
| 11124 | Copy the @acronym{MIME} object to a fresh buffer and display this buffer | 11508 | Copy 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 |
| 11510 | without decoding. If given a numerical prefix, you can do semi-manual | ||
| 11511 | charset 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,, |
| 11128 | Accessing Compressed Files, emacs, The Emacs Editor}). | 11515 | Accessing Compressed Files, emacs, The Emacs Editor}). |
| @@ -11142,7 +11529,10 @@ Insert the contents of the @acronym{MIME} object into the buffer | |||
| 11142 | the raw contents without decoding. If given a numerical prefix, you can | 11529 | the raw contents without decoding. If given a numerical prefix, you can |
| 11143 | do semi-manual charset stuff (see | 11530 | do 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 |
| 11145 | Article}). | 11532 | Article}). Compressed files like @file{.gz} and @file{.bz2} are |
| 11533 | automatically decompressed depending on @code{jka-compr} regardless of | ||
| 11534 | @code{auto-compression-mode} (@pxref{Compressed Files,, Accessing | ||
| 11535 | Compressed 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 |
| 11223 | An integer: Do this treatment on all body parts that have a length less | 11616 | An 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 |
| 11616 | This variable controls whether Gnus performs IDNA decoding of | 12010 | This variable controls whether Gnus performs IDNA decoding of |
| 11617 | internationalized domain names inside @samp{From}, @samp{To} and | 12011 | internationalized 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}, |
| 12013 | for 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 |
| 11620 | variable is only enabled if you have installed it. | 12015 | variable 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 | ||
| 11874 | Modify to suit your needs. | 12269 | Modify to suit your needs. |
| 11875 | 12270 | ||
| 12271 | @vindex gnus-message-highlight-citation | ||
| 12272 | If @code{gnus-message-highlight-citation} is t, different levels of | ||
| 12273 | citations are highlighted like in Gnus article buffers also in message | ||
| 12274 | mode 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 |
| 11894 | use to store sent messages. The default is: | 12293 | use to store sent messages. The default is @code{"archive"}, and when |
| 12294 | actually 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 | ||
| 12306 | Note: a server like this is saved in the @file{~/.newsrc.eld} file first | ||
| 12307 | so 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 | ||
| 12310 | since. If it once has been saved, it will never be updated by default | ||
| 12311 | even if you change the value of @code{gnus-message-archive-method} | ||
| 12312 | afterward. Therefore, the server @code{"archive"} doesn't necessarily | ||
| 12313 | mean the @code{nnfolder} server like this at all times. If you want the | ||
| 12314 | saved 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} | ||
| 12317 | value. The default value of this variable is @code{nil}. | ||
| 12318 | @end quotation | ||
| 12319 | |||
| 11904 | You can, however, use any mail select method (@code{nnml}, | 12320 | You 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 |
| 11906 | for doing this sort of thing, though. If you don't like the default | 12322 | for 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 | ||
| 12523 | Note that the @code{signature-file} attribute honors the variable | ||
| 12524 | @code{message-signature-directory}. | ||
| 12525 | |||
| 12107 | The attribute name can also be a string or a symbol. In that case, | 12526 | The attribute name can also be a string or a symbol. In that case, |
| 12108 | this will be used as a header name, and the value will be inserted in | 12527 | this will be used as a header name, and the value will be inserted in |
| 12109 | the headers of the article; if the value is @code{nil}, the header | 12528 | the 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 |
| 12536 | a mail back end that has gotten out of sync. | 12955 | a 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 | |||
| 12961 | Compact all groups in the server under point | ||
| 12962 | (@code{gnus-server-compact-server}). Currently implemented only in | ||
| 12963 | nnml (@pxref{Mail Spool}). This removes gaps between article numbers, | ||
| 12964 | hence 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 | ||
| 12619 | See also @code{nntp-via-rlogin-command-switches}. | 13047 | See also @code{nntp-via-rlogin-command-switches}. Here's an example for |
| 13048 | an 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 | ||
| 12621 | If you're behind a firewall, but have direct access to the outside world | 13061 | If you're behind a firewall, but have direct access to the outside world |
| 12622 | through a wrapper command like "runsocks", you could open a socksified | 13062 | through a wrapper command like "runsocks", you could open a socksified |
| @@ -13006,9 +13446,9 @@ that doesn't seem to work. | |||
| 13006 | It is possible to customize how the connection to the nntp server will | 13446 | It is possible to customize how the connection to the nntp server will |
| 13007 | be opened. If you specify an @code{nntp-open-connection-function} | 13447 | be opened. If you specify an @code{nntp-open-connection-function} |
| 13008 | parameter, Gnus will use that function to establish the connection. | 13448 | parameter, Gnus will use that function to establish the connection. |
| 13009 | Six pre-made functions are supplied. These functions can be grouped in | 13449 | Seven pre-made functions are supplied. These functions can be grouped |
| 13010 | two categories: direct connection functions (four pre-made), and | 13450 | in two categories: direct connection functions (four pre-made), and |
| 13011 | indirect ones (two pre-made). | 13451 | indirect 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 | |||
| 13158 | host. | 13599 | host. |
| 13159 | @end table | 13600 | @end table |
| 13160 | 13601 | ||
| 13602 | Note that you may want to change the value for @code{nntp-end-of-line} | ||
| 13603 | to @samp{\n} (@pxref{Common Variables}). | ||
| 13604 | |||
| 13605 | @item nntp-open-via-rlogin-and-netcat | ||
| 13606 | @findex nntp-open-via-rlogin-and-netcat | ||
| 13607 | Does essentially the same, but uses | ||
| 13608 | @uref{http://netcat.sourceforge.net/, netcat} instead of @samp{telnet} | ||
| 13609 | to 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 | ||
| 13616 | Command used to connect to the real @acronym{NNTP} server from the | ||
| 13617 | intermediate host. The default is @samp{nc}. You can also use other | ||
| 13618 | programs like @uref{http://www.imasy.or.jp/~gotoh/ssh/connect.html, | ||
| 13619 | connect} instead. | ||
| 13620 | |||
| 13621 | @item nntp-via-netcat-switches | ||
| 13622 | @vindex nntp-via-netcat-switches | ||
| 13623 | List 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 | ||
| 13628 | Command 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 | ||
| 13633 | List 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 |
| 13163 | Does essentially the same, but uses @samp{telnet} instead of | 13639 | Does 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 | ||
| 13672 | Note that you may want to change the value for @code{nntp-end-of-line} | ||
| 13673 | to @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 |
| 13248 | String to use as end-of-line marker when talking to the @acronym{NNTP} | 13726 | String to use as end-of-line marker when talking to the @acronym{NNTP} |
| 13249 | server. This is @samp{\r\n} by default, but should be @samp{\n} when | 13727 | server. This is @samp{\r\n} by default, but should be @samp{\n} when |
| 13250 | using a non native connection function. | 13728 | using 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 | |||
| 13748 | Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP} | ||
| 13749 | servers in marks files. A marks file records what marks you have set | ||
| 13750 | in a group and each file is specific to the corresponding server. | ||
| 13751 | Marks files are stored in @file{~/News/marks} | ||
| 13752 | (@code{nntp-marks-directory}) under a classic hierarchy resembling | ||
| 13753 | that of a news server, for example marks for the group | ||
| 13754 | @samp{gmane.discuss} on the news.gmane.org server will be stored in | ||
| 13755 | the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}. | ||
| 13756 | |||
| 13757 | Marks files are useful because you can copy the @file{~/News/marks} | ||
| 13758 | directory (using rsync, scp or whatever) to another Gnus installation, | ||
| 13759 | and it will realize what articles you have read and marked. The data | ||
| 13760 | in @file{~/News/marks} has priority over the same data in | ||
| 13761 | @file{~/.newsrc.eld}. | ||
| 13762 | |||
| 13763 | Note that marks files are very much server-specific: Gnus remembers | ||
| 13764 | the article numbers so if you don't use the same servers on both | ||
| 13765 | installations things are most likely to break (most @acronym{NNTP} | ||
| 13766 | servers do not use the same article numbers as any other server). | ||
| 13767 | However, if you use servers A, B, C on one installation and servers A, | ||
| 13768 | D, E on the other, you can sync the marks files for A and then you'll | ||
| 13769 | get synchronization for that server between the two installations. | ||
| 13770 | |||
| 13771 | Using @acronym{NNTP} marks can possibly incur a performance penalty so | ||
| 13772 | if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil} | ||
| 13773 | variable to @code{t}. Marks will then be stored in @file{~/.newsrc.eld}. | ||
| 13774 | |||
| 13775 | Related variables: | ||
| 13776 | |||
| 13777 | @table @code | ||
| 13778 | |||
| 13779 | @item nntp-marks-is-evil | ||
| 13780 | @vindex nntp-marks-is-evil | ||
| 13781 | If non-@code{nil}, this back end will ignore any marks files. The | ||
| 13782 | default is @code{nil}. | ||
| 13783 | |||
| 13784 | @item nntp-marks-directory | ||
| 13785 | @vindex nntp-marks-directory | ||
| 13786 | The 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 | |||
| 13926 | ssh %s imapd | 14450 | ssh %s imapd |
| 13927 | @end example | 14451 | @end example |
| 13928 | 14452 | ||
| 13929 | The valid format specifier characters are: | 14453 | Make sure nothing is interfering with the output of the program, e.g., |
| 14454 | don't forget to redirect the error output to the void. The valid format | ||
| 14455 | specifier characters are: | ||
| 13930 | 14456 | ||
| 13931 | @table @samp | 14457 | @table @samp |
| 13932 | @item s | 14458 | @item s |
| @@ -14342,7 +14868,7 @@ body of the messages: | |||
| 14342 | The buffer is narrowed to the message in question when @var{function} | 14868 | The buffer is narrowed to the message in question when @var{function} |
| 14343 | is run. That's why @code{(widen)} needs to be called after | 14869 | is 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 |
| 14345 | above. Also note that with the nnimap backend, message bodies will | 14871 | above. Also note that with the nnimap back end, message bodies will |
| 14346 | not be downloaded by default. You need to set | 14872 | not 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 |
| 14957 | Translate all @samp{TAB} characters into @samp{SPACE} characters. | 15483 | Translate 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 |
| 14962 | Eudora produces broken @code{References} headers, but OK | 15489 | @cindex Pegasus |
| 14963 | @code{In-Reply-To} headers. This function will get rid of the | 15490 | Some 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 |
| 15492 | function will get rid of the @code{References} header if the headers | ||
| 15493 | contain 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} | |||
| 15186 | servers have the property that you may backup them using @code{tar} or | 15716 | servers have the property that you may backup them using @code{tar} or |
| 15187 | similar, and later be able to restore them into Gnus (by adding the | 15717 | similar, and later be able to restore them into Gnus (by adding the |
| 15188 | proper @code{nnml} server) and have all your marks be preserved. Marks | 15718 | proper @code{nnml} server) and have all your marks be preserved. Marks |
| 15189 | for a group is usually stored in the @code{.marks} file (but see | 15719 | for 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. |
| 15191 | Individual @code{nnml} groups are also possible to backup, use @kbd{G m} | 15721 | Individual @code{nnml} groups are also possible to backup, use @kbd{G m} |
| 15192 | to restore the group (after restoring the backup into the nnml | 15722 | to 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 |
| 15247 | If non-@code{nil}, @code{nnml} will allow using compressed message | 15777 | If non-@code{nil}, @code{nnml} will allow using compressed message |
| 15248 | files. | 15778 | files. This requires @code{auto-compression-mode} to be enabled |
| 15779 | (@pxref{Compressed Files, ,Compressed Files, emacs, The Emacs Manual}). | ||
| 15780 | If the value of @code{nnml-use-compressed-files} is a string, it is used | ||
| 15781 | as the file extension specifying the compression program. You can set it | ||
| 15782 | to @samp{.bz2} if your Emacs supports it. A value of @code{t} is | ||
| 15783 | equivalent to @samp{.gz}. | ||
| 15784 | |||
| 15785 | @item nnml-compressed-files-size-threshold | ||
| 15786 | @vindex nnml-compressed-files-size-threshold | ||
| 15787 | Default size threshold for compressed message files. Message files with | ||
| 15788 | bodies larger than that many characters will be automatically compressed | ||
| 15789 | if @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 | ||
| 15959 | If the search engine changes its output substantially, @code{nnweb} | 16500 | If the search engine changes its output substantially, @code{nnweb} |
| 15960 | won't be able to parse it and will fail. One could hardly fault the Web | 16501 | won't be able to parse it and will fail. One could hardly fault the Web |
| 15961 | providers if they were to do this---their @emph{raison d'être} is to | 16502 | providers if they were to do this---their @emph{raison d'@^etre} is to |
| 15962 | make money off of advertisements, not to provide services to the | 16503 | make money off of advertisements, not to provide services to the |
| 15963 | community. Since @code{nnweb} washes the ads off all the articles, one | 16504 | community. Since @code{nnweb} washes the ads off all the articles, one |
| 15964 | might think that the providers might be somewhat miffed. We'll see. | 16505 | might 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} |
| 16239 | in Emacs or @code{escape-quoted} in XEmacs). | 16780 | in Emacs or @code{escape-quoted} in XEmacs). |
| 16240 | 16781 | ||
| 16782 | @item nnrss-ignore-article-fields | ||
| 16783 | @vindex nnrss-ignore-article-fields | ||
| 16784 | Some feeds update constantly article fields during their publications, | ||
| 16785 | e.g. to indicate the number of comments. However, if there is | ||
| 16786 | a difference between the local article and the distant one, the latter | ||
| 16787 | is considered to be new. To avoid this and discard some fields, set this | ||
| 16788 | variable 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 |
| 16532 | For @acronym{IMAP} connections using the @code{shell} stream, the variable | 17082 | For @acronym{IMAP} connections using the @code{shell} stream, the |
| 16533 | @code{imap-shell-program} specify what program to call. | 17083 | variable @code{imap-shell-program} specify what program to call. Make |
| 17084 | sure nothing is interfering with the output of the program, e.g., don't | ||
| 17085 | forget 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, | |||
| 16709 | if you get a lot of email within a week, setting this variable will | 17261 | if you get a lot of email within a week, setting this variable will |
| 16710 | cause a lot of network traffic between Gnus and the IMAP server. | 17262 | cause a lot of network traffic between Gnus and the IMAP server. |
| 16711 | 17263 | ||
| 17264 | @item nnimap-logout-timeout | ||
| 17265 | @vindex nnimap-logout-timeout | ||
| 17266 | |||
| 17267 | There is a case where a connection to a @acronym{IMAP} server is unable | ||
| 17268 | to close, when connecting to the server via a certain kind of network, | ||
| 17269 | e.g. @acronym{VPN}. In that case, it will be observed that a connection | ||
| 17270 | between Emacs and the local network looks alive even if the server has | ||
| 17271 | closed a connection for some reason (typically, a timeout). | ||
| 17272 | Consequently, Emacs continues waiting for a response from the server for | ||
| 17273 | the @code{LOGOUT} command that Emacs sent, or hangs in other words. If | ||
| 17274 | you are in such a network, setting this variable to a number of seconds | ||
| 17275 | will be helpful. If it is set, a hung connection will be closed | ||
| 17276 | forcibly, 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 | ||
| 17278 | value will be inconvenient too. Perhaps the value 1.0 will be a good | ||
| 17279 | candidate but it might be worth trying some other values. | ||
| 17280 | |||
| 17281 | Example 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 | |||
| 18350 | reading news on a machine. | 18926 | reading news on a machine. |
| 18351 | 18927 | ||
| 18352 | Setting up Gnus as an ``offline'' newsreader is quite simple. In | 18928 | Setting up Gnus as an ``offline'' newsreader is quite simple. In |
| 18353 | fact, you don't even have to configure anything. | 18929 | fact, you don't have to configure anything as the agent is now enabled |
| 18930 | by default (@pxref{Agent Variables, gnus-agent}). | ||
| 18354 | 18931 | ||
| 18355 | Of course, to use it as such, you have to learn a few new commands. | 18932 | Of 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 |
| 18530 | The name of the category. | ||
| 18531 | |||
| 18532 | @item gnus-agent-cat-groups | ||
| 18533 | The list of groups that are in this category. | 19108 | The list of groups that are in this category. |
| 18534 | 19109 | ||
| 18535 | @item gnus-agent-cat-predicate | 19110 | @item agent-predicate |
| 18536 | A predicate which (generally) gives a rough outline of which articles | 19111 | A predicate which (generally) gives a rough outline of which articles |
| 18537 | are eligible for downloading; and | 19112 | are eligible for downloading; and |
| 18538 | 19113 | ||
| 18539 | @item gnus-agent-cat-score-file | 19114 | @item agent-score |
| 18540 | a score rule which (generally) gives you a finer granularity when | 19115 | a score rule which (generally) gives you a finer granularity when |
| 18541 | deciding what articles to download. (Note that this @dfn{download | 19116 | deciding what articles to download. (Note that this @dfn{download |
| 18542 | score} is not necessarily related to normal scores.) | 19117 | score} is not necessarily related to normal scores.) |
| 18543 | 19118 | ||
| 18544 | @item gnus-agent-cat-enable-expiration | 19119 | @item agent-enable-expiration |
| 18545 | a boolean indicating whether the agent should expire old articles in | 19120 | a boolean indicating whether the agent should expire old articles in |
| 18546 | this group. Most groups should be expired to conserve disk space. In | 19121 | this group. Most groups should be expired to conserve disk space. In |
| 18547 | fact, its probably safe to say that the gnus.* hierarchy contains the | 19122 | fact, its probably safe to say that the gnus.* hierarchy contains the |
| 18548 | only groups that should not be expired. | 19123 | only groups that should not be expired. |
| 18549 | 19124 | ||
| 18550 | @item gnus-agent-cat-days-until-old | 19125 | @item agent-days-until-old |
| 18551 | an integer indicating the number of days that the agent should wait | 19126 | an integer indicating the number of days that the agent should wait |
| 18552 | before deciding that a read article is safe to expire. | 19127 | before deciding that a read article is safe to expire. |
| 18553 | 19128 | ||
| 18554 | @item gnus-agent-cat-low-score | 19129 | @item agent-low-score |
| 18555 | an integer that overrides the value of @code{gnus-agent-low-score}. | 19130 | an 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 |
| 18558 | an integer that overrides the value of @code{gnus-agent-high-score}. | 19133 | an 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 |
| 18561 | an integer that overrides the value of | 19136 | an 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 |
| 18565 | an integer that overrides the value of @code{gnus-agent-long-article}. | 19140 | an 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 | ||
| 18574 | a symbol indicating whether the summary buffer should display | 19143 | a symbol indicating whether the summary buffer should display |
| 18575 | undownloaded articles using the gnus-summary-*-undownloaded-face | 19144 | undownloaded articles using the @code{gnus-summary-*-undownloaded-face} |
| 18576 | faces. The symbol nil will disable the use of undownloaded faces while | 19145 | faces. Any symbol other than @code{nil} will enable the use of |
| 18577 | all other symbols enable them. | 19146 | undownloaded faces. |
| 18578 | @end table | 19147 | @end table |
| 18579 | 19148 | ||
| 18580 | The name of a category can not be changed once the category has been | 19149 | The 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 |
| 19083 | Download all processable articles in this group. | 19652 | Download 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 | |||
| 19157 | each time you visit it or to minimize your connection time), the | 19726 | each time you visit it or to minimize your connection time), the |
| 19158 | undownloaded face will probably seem like a good idea. The reason | 19727 | undownloaded face will probably seem like a good idea. The reason |
| 19159 | being that you do all of our work (marking, reading, deleting) with | 19728 | being that you do all of our work (marking, reading, deleting) with |
| 19160 | downloaded articles so the normal faces always appear. | 19729 | downloaded articles so the normal faces always appear. For those |
| 19161 | 19730 | users using the agent to improve online performance by caching the NOV | |
| 19162 | For occasional Agent users, the undownloaded faces may appear to be an | 19731 | database (most users since 5.10.2), the undownloaded faces may appear |
| 19163 | absolutely horrible idea. The issue being that, since most of their | 19732 | to be an absolutely horrible idea. The issue being that, since none |
| 19164 | articles have not been fetched into the Agent, most of the normal | 19733 | of their articles have been fetched into the Agent, all of the |
| 19165 | faces will be obscured by the undownloaded faces. If this is your | 19734 | normal faces will be obscured by the undownloaded faces. |
| 19166 | situation, you have two choices available. First, you can completely | 19735 | |
| 19167 | disable the undownload faces by customizing | 19736 | If you would like to use the undownloaded faces, you must enable the |
| 19168 | @code{gnus-summary-highlight} to delete the three cons-cells that | 19737 | undownloaded faces by setting the @code{agent-enable-undownloaded-faces} |
| 19169 | refer to the @code{gnus-summary-*-undownloaded-face} faces. Second, | 19738 | group parameter to @code{t}. This parameter, like all other agent |
| 19170 | if you prefer to take a more fine-grained approach, you may set the | 19739 | parameters, may be set on an Agent Category (@pxref{Agent Categories}), |
| 19171 | @code{agent-disable-undownloaded-faces} group parameter to @code{t}. | 19740 | a Group Topic (@pxref{Topic Parameters}), or an individual group |
| 19172 | This parameter, like all other agent parameters, may be set on an | 19741 | (@pxref{Group Parameters}). |
| 19173 | Agent Category (@pxref{Agent Categories}), a Group Topic (@pxref{Topic | 19742 | |
| 19174 | Parameters}), or an individual group (@pxref{Group Parameters}). | 19743 | The one problem common to all users using the agent is how quickly it |
| 19744 | can consume disk space. If you using the agent on many groups, it is | ||
| 19745 | even more difficult to effectively recover disk space. One solution | ||
| 19746 | is the @samp{%F} format available in @code{gnus-group-line-format}. | ||
| 19747 | This format will display the actual disk space used by articles | ||
| 19748 | fetched into both the agent and cache. By knowing which groups use | ||
| 19749 | the most space, users know where to focus their efforts when ``agent | ||
| 19750 | expiring'' 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 | |||
| 19267 | are stored locally. An optional argument will mark articles in the | 19843 | are stored locally. An optional argument will mark articles in the |
| 19268 | agent as unread. | 19844 | agent 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 | |||
| 19273 | The Agent works with any Gnus back end, including nnimap. However, | ||
| 19274 | since there are some conceptual differences between @acronym{NNTP} and | ||
| 19275 | @acronym{IMAP}, this section (should) provide you with some information to | ||
| 19276 | make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client. | ||
| 19277 | 19848 | ||
| 19278 | The first thing to keep in mind is that all flags (read, ticked, etc) | 19849 | The Agent works with any Gnus back end including those, such as |
| 19279 | are kept on the @acronym{IMAP} server, rather than in @file{.newsrc} as is the | 19850 | nnimap, that store flags (read, ticked, etc) on the server. Sadly, |
| 19280 | case for nntp. Thus Gnus need to remember flag changes when | 19851 | the Agent does not actually know which backends keep their flags in |
| 19281 | disconnected, and synchronize these flags when you plug back in. | 19852 | the backend server rather than in @file{.newsrc}. This means that the |
| 19853 | Agent, while unplugged or disconnected, will always record all changes | ||
| 19854 | to the flags in its own files. | ||
| 19282 | 19855 | ||
| 19283 | Gnus keeps track of flag changes when reading nnimap groups under the | 19856 | When you plug back in, Gnus will then check to see if you have any |
| 19284 | Agent. When you plug back in, Gnus will check if you have any changed | 19857 | changed any flags and ask if you wish to synchronize these with the |
| 19285 | any flags and ask if you wish to synchronize these with the server. | 19858 | server. This behavior is customizable by @code{gnus-agent-synchronize-flags}. |
| 19286 | The behavior is customizable by @code{gnus-agent-synchronize-flags}. | ||
| 19287 | 19859 | ||
| 19288 | @vindex gnus-agent-synchronize-flags | 19860 | @vindex gnus-agent-synchronize-flags |
| 19289 | If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will | 19861 | If @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} |
| 19298 | in the group buffer. | 19870 | in the group buffer. |
| 19299 | 19871 | ||
| 19872 | Technical note: the synchronization algorithm does not work by ``pushing'' | ||
| 19873 | all local flags to the server, but rather by incrementally updated the | ||
| 19874 | server view of flags by changing only those flags that were changed by | ||
| 19875 | the user. Thus, if you set one flag on an article, quit the group then | ||
| 19876 | re-select the group and remove the flag; the flag will be set and | ||
| 19877 | removed from the server when you ``synchronize''. The queued flag | ||
| 19878 | operations can be found in the per-server @code{flags} file in the Agent | ||
| 19879 | directory. It's emptied when you synchronize flags. | ||
| 19880 | |||
| 19881 | @node Agent and IMAP | ||
| 19882 | @subsection Agent and IMAP | ||
| 19883 | |||
| 19884 | The Agent works with any Gnus back end, including nnimap. However, | ||
| 19885 | since there are some conceptual differences between @acronym{NNTP} and | ||
| 19886 | @acronym{IMAP}, this section (should) provide you with some information to | ||
| 19887 | make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client. | ||
| 19888 | |||
| 19300 | Some things are currently not implemented in the Agent that you'd might | 19889 | Some things are currently not implemented in the Agent that you'd might |
| 19301 | expect from a disconnected @acronym{IMAP} client, including: | 19890 | expect 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 | ||
| 19313 | Technical note: the synchronization algorithm does not work by ``pushing'' | ||
| 19314 | all local flags to the server, but rather incrementally update the | ||
| 19315 | server view of flags by changing only those flags that were changed by | ||
| 19316 | the user. Thus, if you set one flag on an article, quit the group and | ||
| 19317 | re-select the group and remove the flag; the flag will be set and | ||
| 19318 | removed from the server when you ``synchronize''. The queued flag | ||
| 19319 | operations can be found in the per-server @code{flags} file in the Agent | ||
| 19320 | directory. 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 | ||
| 19326 | When Gnus is unplugged, all outgoing messages (both mail and news) are | 19905 | By default, when Gnus is unplugged, all outgoing messages (both mail |
| 19327 | stored in the draft group ``queue'' (@pxref{Drafts}). You can view | 19906 | and news) are stored in the draft group ``queue'' (@pxref{Drafts}). |
| 19328 | them there after posting, and edit them at will. | 19907 | You can view them there after posting, and edit them at will. |
| 19329 | 19908 | ||
| 19330 | When Gnus is plugged again, you can send the messages either from the | 19909 | You can control the circumstances under which outgoing mail is queued |
| 19331 | draft group with the special commands available there, or you can use | 19910 | (see @code{gnus-agent-queue-mail}, @pxref{Agent Variables}). Outgoing |
| 19332 | the @kbd{J S} command in the group buffer to send all the sendable | 19911 | news is always queued when Gnus is unplugged, and never otherwise. |
| 19333 | messages in the draft group. | ||
| 19334 | 19912 | ||
| 19913 | You can send the messages either from the draft group with the special | ||
| 19914 | commands available there, or you can use the @kbd{J S} command in the | ||
| 19915 | group buffer to send all the sendable messages in the draft group. | ||
| 19916 | Posting news will only work when Gnus is plugged, but you can send | ||
| 19917 | mail at any time. | ||
| 19335 | 19918 | ||
| 19919 | If sending mail while unplugged does not work for you and you worry | ||
| 19920 | about hitting @kbd{J S} by accident when unplugged, you can have Gnus | ||
| 19921 | ask 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 | ||
| 19930 | Is the agent enabled? The default is @code{t}. When first enabled, | ||
| 19931 | the agent will use @code{gnus-agent-auto-agentize-methods} to | ||
| 19932 | automatically mark some back ends as agentized. You may change which | ||
| 19933 | back ends are agentized using the agent commands in the server buffer. | ||
| 19934 | |||
| 19935 | To 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 |
| 19343 | Where the Gnus Agent will store its files. The default is | 19941 | Where 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 | |||
| 19384 | thing to do as the newly downloaded article has obviously not been | 19982 | thing to do as the newly downloaded article has obviously not been |
| 19385 | read. The default is @code{t}. | 19983 | read. The default is @code{t}. |
| 19386 | 19984 | ||
| 19985 | @item gnus-agent-synchronize-flags | ||
| 19986 | @vindex gnus-agent-synchronize-flags | ||
| 19987 | If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will | ||
| 19988 | never automatically synchronize flags. If it is @code{ask}, which is | ||
| 19989 | the default, the Agent will check if you made any changes and if so | ||
| 19990 | ask if you wish to synchronize these when you re-connect. If it has | ||
| 19991 | any 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 |
| 19389 | If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the | 19995 | If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the |
| @@ -19432,13 +20038,26 @@ have not been fetched), @code{always-undownloaded} (maneuvering always | |||
| 19432 | ignores articles that have not been fetched), @code{unfetched} | 20038 | ignores 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 | ||
| 20043 | When @code{gnus-agent-queue-mail} is @code{always}, Gnus will always | ||
| 20044 | queue mail rather than sending it straight away. When @code{t}, Gnus | ||
| 20045 | will queue mail when unplugged only. When @code{nil}, never queue | ||
| 20046 | mail. The default is @code{t}. | ||
| 20047 | |||
| 20048 | @item gnus-agent-prompt-send-queue | ||
| 20049 | @vindex gnus-agent-prompt-send-queue | ||
| 20050 | When @code{gnus-agent-prompt-send-queue} is non-@code{nil} Gnus will | ||
| 20051 | prompt 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 |
| 19437 | If you have never used the Agent before (or more technically, if | 20056 | If 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 |
| 19439 | automatically agentize a few servers for you. This variable control | 20058 | automatically agentize a few servers for you. This variable control |
| 19440 | which backends should be auto-agentized. It is typically only useful | 20059 | which back ends should be auto-agentized. It is typically only useful |
| 19441 | to agentize remote backends. The auto-agentizing has the same effect | 20060 | to agentize remote back ends. The auto-agentizing has the same effect |
| 19442 | as running @kbd{J a} on the servers (@pxref{Server Agent Commands}). | 20061 | as running @kbd{J a} on the servers (@pxref{Server Agent Commands}). |
| 19443 | If the file exist, you must manage the servers manually by adding or | 20062 | If the file exist, you must manage the servers manually by adding or |
| 19444 | removing them, this variable is only applicable the first time you | 20063 | removing 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 | ||
| 20473 | Edit the apply-to-all-groups all.SCORE file. You will be popped into | ||
| 20474 | a @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 | |||
| 20453 | group name with @code{gnus-adaptive-file-suffix} appended. The default | 21077 | group name with @code{gnus-adaptive-file-suffix} appended. The default |
| 20454 | is @file{ADAPT}. | 21078 | is @file{ADAPT}. |
| 20455 | 21079 | ||
| 21080 | @vindex gnus-adaptive-pretty-print | ||
| 21081 | Adaptive score files can get huge and are not meant to be edited by | ||
| 21082 | human hands. If @code{gnus-adaptive-pretty-print} is @code{nil} (the | ||
| 21083 | deafult) 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 |
| 20457 | When doing adaptive scoring, substring or fuzzy matching would probably | 21086 | When doing adaptive scoring, substring or fuzzy matching would probably |
| 20458 | give you the best results in most cases. However, if the header one | 21087 | give 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 | ||
| 20706 | See? Simple. | 21335 | See? Simple. |
| 20707 | 21336 | ||
| 21337 | @vindex gnus-inhibit-slow-scoring | ||
| 21338 | You can inhibit scoring the slow scoring on headers or body by setting | ||
| 21339 | the variable @code{gnus-inhibit-slow-scoring}. If | ||
| 21340 | @code{gnus-inhibit-slow-scoring} is regexp, slow scoring is inhibited if | ||
| 21341 | the group matches the regexp. If it is t, slow scoring on it is | ||
| 21342 | inhibited 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 | |||
| 20967 | before. | 21603 | before. |
| 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, | ||
| 20975 | so this section is mostly of historical interest. | ||
| 20976 | |||
| 20977 | @uref{http://www.cs.umn.edu/Research/GroupLens/, GroupLens} is a | ||
| 20978 | collaborative filtering system that helps you work together with other | ||
| 20979 | people to find the quality news articles out of the huge volume of | ||
| 20980 | news articles generated every day. | ||
| 20981 | |||
| 20982 | To accomplish this the GroupLens system combines your opinions about | ||
| 20983 | articles you have already read with the opinions of others who have done | ||
| 20984 | likewise and gives you a personalized prediction for each unread news | ||
| 20985 | article. Think of GroupLens as a matchmaker. GroupLens watches how you | ||
| 20986 | rate articles, and finds other people that rate articles the same way. | ||
| 20987 | Once it has found some people you agree with it tells you, in the form | ||
| 20988 | of a prediction, what they thought of the article. You can use this | ||
| 20989 | prediction to help you decide whether or not you want to read the | ||
| 20990 | article. | ||
| 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 | |||
| 21003 | To use GroupLens you must register a pseudonym with your local | ||
| 21004 | @uref{http://www.cs.umn.edu/Research/GroupLens/bbb.html, Better Bit | ||
| 21005 | Bureau (BBB)} is the only better bit in town at the moment. | ||
| 21006 | |||
| 21007 | Once 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 | ||
| 21013 | Setting this variable to a non-@code{nil} value will make Gnus hook into | ||
| 21014 | all the relevant GroupLens functions. | ||
| 21015 | |||
| 21016 | @item grouplens-pseudonym | ||
| 21017 | @vindex grouplens-pseudonym | ||
| 21018 | This variable should be set to the pseudonym you got when registering | ||
| 21019 | with the Better Bit Bureau. | ||
| 21020 | |||
| 21021 | @item grouplens-newsgroups | ||
| 21022 | @vindex grouplens-newsgroups | ||
| 21023 | A list of groups that you want to get GroupLens predictions for. | ||
| 21024 | |||
| 21025 | @end table | ||
| 21026 | |||
| 21027 | That's the minimum of what you need to get up and running with GroupLens. | ||
| 21028 | Once you've registered, GroupLens will start giving you scores for | ||
| 21029 | articles based on the average of what other people think. But, to get | ||
| 21030 | the real benefit of GroupLens you need to start rating articles | ||
| 21031 | yourself. Then the scores GroupLens gives you will be personalized for | ||
| 21032 | you, based on how the people you usually agree with have already rated. | ||
| 21033 | |||
| 21034 | |||
| 21035 | @node Rating Articles | ||
| 21036 | @subsection Rating Articles | ||
| 21037 | |||
| 21038 | In GroupLens, an article is rated on a scale from 1 to 5, inclusive. | ||
| 21039 | Where 1 means something like this article is a waste of bandwidth and 5 | ||
| 21040 | means that the article was really good. The basic question to ask | ||
| 21041 | yourself is, ``on a scale from 1 to 5 would I like to see more articles | ||
| 21042 | like this one?'' | ||
| 21043 | |||
| 21044 | There 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 | ||
| 21051 | This 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 | ||
| 21056 | This function will prompt you for a rating, and rate all the articles in | ||
| 21057 | the thread. This is really useful for some of those long running giant | ||
| 21058 | threads in rec.humor. | ||
| 21059 | |||
| 21060 | @end table | ||
| 21061 | |||
| 21062 | The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be | ||
| 21063 | the 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 | ||
| 21070 | Rate the article and go to the next unread article. | ||
| 21071 | |||
| 21072 | @item 1-5 , | ||
| 21073 | @kindex , (GroupLens) | ||
| 21074 | @findex grouplens-best-unread-article | ||
| 21075 | Rate the article and go to the next unread article with the highest score. | ||
| 21076 | |||
| 21077 | @end table | ||
| 21078 | |||
| 21079 | If you want to give the current article a score of 4 and then go to the | ||
| 21080 | next article, just type @kbd{4 n}. | ||
| 21081 | |||
| 21082 | |||
| 21083 | @node Displaying Predictions | ||
| 21084 | @subsection Displaying Predictions | ||
| 21085 | |||
| 21086 | GroupLens makes a prediction for you about how much you will like a | ||
| 21087 | news article. The predictions from GroupLens are on a scale from 1 to | ||
| 21088 | 5, where 1 is the worst and 5 is the best. You can use the predictions | ||
| 21089 | from GroupLens in one of three ways controlled by the variable | ||
| 21090 | @code{gnus-grouplens-override-scoring}. | ||
| 21091 | |||
| 21092 | @vindex gnus-grouplens-override-scoring | ||
| 21093 | There are three ways to display predictions in grouplens. You may | ||
| 21094 | choose to have the GroupLens scores contribute to, or override the | ||
| 21095 | regular Gnus scoring mechanism. override is the default; however, some | ||
| 21096 | people prefer to see the Gnus scores plus the grouplens scores. To get | ||
| 21097 | the separate scoring behavior you need to set | ||
| 21098 | @code{gnus-grouplens-override-scoring} to @code{'separate}. To have the | ||
| 21099 | GroupLens 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 | ||
| 21102 | the 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 | ||
| 21107 | In either case, GroupLens gives you a few choices for how you would like | ||
| 21108 | to see your predictions displayed. The display of predictions is | ||
| 21109 | controlled by the @code{grouplens-prediction-display} variable. | ||
| 21110 | |||
| 21111 | The following are valid values for that variable. | ||
| 21112 | |||
| 21113 | @table @code | ||
| 21114 | @item prediction-spot | ||
| 21115 | The higher the prediction, the further to the right an @samp{*} is | ||
| 21116 | displayed. | ||
| 21117 | |||
| 21118 | @item confidence-interval | ||
| 21119 | A numeric confidence interval. | ||
| 21120 | |||
| 21121 | @item prediction-bar | ||
| 21122 | The higher the prediction, the longer the bar. | ||
| 21123 | |||
| 21124 | @item confidence-bar | ||
| 21125 | Numerical confidence. | ||
| 21126 | |||
| 21127 | @item confidence-spot | ||
| 21128 | The spot gets bigger with more confidence. | ||
| 21129 | |||
| 21130 | @item prediction-num | ||
| 21131 | Plain-old numeric value. | ||
| 21132 | |||
| 21133 | @item confidence-plus-minus | ||
| 21134 | Prediction +/- 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 | ||
| 21145 | The summary line format used in GroupLens-enhanced summary buffers. It | ||
| 21146 | accepts the same specs as the normal summary line format (@pxref{Summary | ||
| 21147 | Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-23,23n%]%) | ||
| 21148 | %s\n}. | ||
| 21149 | |||
| 21150 | @item grouplens-bbb-host | ||
| 21151 | Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the | ||
| 21152 | default. | ||
| 21153 | |||
| 21154 | @item grouplens-bbb-port | ||
| 21155 | Port of the host running the bbbd server. The default is 9000. | ||
| 21156 | |||
| 21157 | @item grouplens-score-offset | ||
| 21158 | Offset the prediction by this value. In other words, subtract the | ||
| 21159 | prediction value by this number to arrive at the effective score. The | ||
| 21160 | default is 0. | ||
| 21161 | |||
| 21162 | @item grouplens-score-scale-factor | ||
| 21163 | This variable allows the user to magnify the effect of GroupLens scores. | ||
| 21164 | The 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. | |||
| 21366 | When score files are loaded and @code{gnus-decay-scores} is | 21803 | When score files are loaded and @code{gnus-decay-scores} is |
| 21367 | non-@code{nil}, Gnus will run the score files through the decaying | 21804 | non-@code{nil}, Gnus will run the score files through the decaying |
| 21368 | mechanism thereby lowering the scores of all non-permanent score rules. | 21805 | mechanism thereby lowering the scores of all non-permanent score rules. |
| 21369 | The decay itself if performed by the @code{gnus-decay-score-function} | 21806 | If @code{gnus-decay-scores} is a regexp, only score files matching this |
| 21370 | function, which is @code{gnus-decay-score} by default. Here's the | 21807 | regexp are treated. E.g. you may set it to @samp{\\.ADAPT\\'} if only |
| 21371 | definition of that function: | 21808 | @emph{adaptive} score files should be decayed. The decay itself if |
| 21809 | performed by the @code{gnus-decay-score-function} function, which is | ||
| 21810 | @code{gnus-decay-score} by default. Here's the definition of that | ||
| 21811 | function: | ||
| 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: | |||
| 22805 | Face to show X-Face. The colors from this face are used as the | 23247 | Face to show X-Face. The colors from this face are used as the |
| 22806 | foreground and background colors of the displayed X-Faces. The | 23248 | foreground and background colors of the displayed X-Faces. The |
| 22807 | default colors are black and white. | 23249 | default colors are black and white. |
| 23250 | |||
| 23251 | @item gnus-face-properties-alist | ||
| 23252 | @vindex gnus-face-properties-alist | ||
| 23253 | Alist of image types and properties applied to Face (@pxref{Face}) and | ||
| 23254 | X-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 | ||
| 23256 | XEmacs. 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 | ||
| 23271 | Reference Manual} for the valid properties for various image types. | ||
| 23272 | Currently, @code{pbm} is used for X-Face images and @code{png} is used | ||
| 23273 | for Face images in Emacs. Only the @code{:face} property is effective | ||
| 23274 | on 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 | ||
| 22810 | If you use posting styles, you can use an @code{x-face-file} entry in | 23278 | If 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. | |||
| 22871 | See @uref{http://quimby.gnus.org/circus/face/} for the precise | 23339 | See @uref{http://quimby.gnus.org/circus/face/} for the precise |
| 22872 | specifications. | 23340 | specifications. |
| 22873 | 23341 | ||
| 23342 | The @code{gnus-face-properties-alist} variable affects the appearance of | ||
| 23343 | displayed Face images. @xref{X-Face}. | ||
| 23344 | |||
| 22874 | Viewing an @code{Face} header requires an Emacs that is able to display | 23345 | Viewing an @code{Face} header requires an Emacs that is able to display |
| 22875 | PNG images. | 23346 | PNG 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 |
| 22995 | Picons databases. | 23466 | Picons databases. |
| 22996 | 23467 | ||
| 23468 | @vindex gnus-picon-style | ||
| 23469 | The variable @code{gnus-picon-style} controls how picons are displayed. | ||
| 23470 | If @code{inline}, the textual representation is replaced. If | ||
| 23471 | @code{right}, picons are added right to the textual representation. | ||
| 23472 | |||
| 22997 | The following variables offer control over where things are located. | 23473 | The 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 | ||
| 23363 | Note that with the nnimap backend, message bodies will not be | 23839 | Note that with the nnimap back end, message bodies will not be |
| 23364 | downloaded by default. You need to set | 23840 | downloaded 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 | ||
| 23385 | A novel technique to fight spam is to require senders to do something | 23861 | A novel technique to fight spam is to require senders to do something |
| 23386 | costly for each message they send. This has the obvious drawback that | 23862 | costly and demonstrably unique for each message they send. This has |
| 23387 | you cannot rely on everyone in the world using this technique, | 23863 | the obvious drawback that you cannot rely on everyone in the world |
| 23388 | since it is not part of the Internet standards, but it may be useful | 23864 | using this technique, since it is not part of the Internet standards, |
| 23389 | in smaller communities. | 23865 | but it may be useful in smaller communities. |
| 23390 | 23866 | ||
| 23391 | While the tools in the previous section work well in practice, they | 23867 | While the tools in the previous section work well in practice, they |
| 23392 | work only because the tools are constantly maintained and updated as | 23868 | work 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 |
| 23403 | The ``something costly'' is to burn CPU time, more specifically to | 23879 | The ``something costly'' is to burn CPU time, more specifically to |
| 23404 | compute a hash collision up to a certain number of bits. The | 23880 | compute a hash collision up to a certain number of bits. The |
| 23405 | resulting hashcash cookie is inserted in a @samp{X-Hashcash:} | 23881 | resulting hashcash cookie is inserted in a @samp{X-Hashcash:} header. |
| 23406 | header. For more details, and for the external application | 23882 | For more details, and for the external application @code{hashcash} you |
| 23407 | @code{hashcash} you need to install to use this feature, see | 23883 | need 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 |
| 23409 | information can be found at @uref{http://www.camram.org/}. | 23885 | at @uref{http://www.camram.org/}. |
| 23410 | 23886 | ||
| 23411 | If you wish to call hashcash for each message you send, say something | 23887 | If you wish to generate hashcash for each message you send, you can |
| 23412 | like: | 23888 | customize @code{message-generate-hashcash} (@pxref{Mail Headers, ,Mail |
| 23889 | Headers,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 | ||
| 23419 | The @file{hashcash.el} library can be found in the Gnus development | ||
| 23420 | contrib directory or at | ||
| 23421 | @uref{http://users.actrix.gen.nz/mycroft/hashcash.el}. | ||
| 23422 | |||
| 23423 | You will need to set up some additional variables as well: | 23895 | You 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 |
| 23429 | This variable indicates the default number of bits the hash collision | 23901 | This variable indicates the default number of bits the hash collision |
| 23430 | should consist of. By default this is 0, meaning nothing will be | 23902 | should consist of. By default this is 20. Suggested useful values |
| 23431 | done. Suggested useful values include 17 to 29. | 23903 | include 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 |
| 23445 | Where the @code{hashcash} binary is installed. | 23917 | Where the @code{hashcash} binary is installed. This variable should |
| 23918 | be automatically set by @code{executable-find}, but if it's @code{nil} | ||
| 23919 | (usually because the @code{hashcash} binary is not in your path) | ||
| 23920 | you'll get a warning when you check hashcash payments and an error | ||
| 23921 | when you generate hashcash payments. | ||
| 23446 | 23922 | ||
| 23447 | @end table | 23923 | @end table |
| 23448 | 23924 | ||
| 23449 | Currently there is no built in functionality in Gnus to verify | 23925 | Gnus can verify hashcash cookies, although this can also be done by |
| 23450 | hashcash cookies, it is expected that this is performed by your hand | 23926 | hand customized mail filtering scripts. To verify a hashcash cookie |
| 23451 | customized mail filtering scripts. Improvements in this area would be | 23927 | in a message, use the @code{mail-check-payment} function in the |
| 23452 | a useful contribution, however. | 23928 | @code{hashcash.el} library. You can also use the @code{spam.el} |
| 23929 | package with the @code{spam-use-hashcash} back end to validate hashcash | ||
| 23930 | cookies in incoming mail and filter mail accordingly (@pxref{Anti-spam | ||
| 23931 | Hashcash 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.) | |||
| 23481 | You must read this section to understand how the Spam package works. | 23960 | You must read this section to understand how the Spam package works. |
| 23482 | Do not skip, speed-read, or glance through this section. | 23961 | Do not skip, speed-read, or glance through this section. |
| 23483 | 23962 | ||
| 23963 | Make sure you read the section on the @code{spam.el} sequence of | ||
| 23964 | events. 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 |
| 23486 | To use the Spam package, you @strong{must} first run the function | 23968 | To 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 |
| 23837 | set, the ham articles are marked as unread before being moved. | 24319 | set, the ham articles are marked as unread before being moved. |
| 23838 | 24320 | ||
| 23839 | If ham can not be moved---because of a read-only backend such as | 24321 | If 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 | ||
| 23842 | Note that you can use multiples destinations per group or regular | 24324 | Note 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 | |||
| 23873 | that if you see @samp{nntp:servername} before the group name in the | 24355 | that if you see @samp{nntp:servername} before the group name in the |
| 23874 | group buffer then you need it here as well. | 24356 | group buffer then you need it here as well. |
| 23875 | 24357 | ||
| 23876 | If spam can not be moved---because of a read-only backend such as | 24358 | If 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 | ||
| 23879 | Note that you can use multiples destinations per group or regular | 24361 | Note 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 |
| 23996 | From Reiner Steib <reiner.steib@@gmx.de>. | 24478 | From Reiner Steib <reiner.steib@@gmx.de>. |
| 23997 | 24479 | ||
| 23998 | My provider has set up bogofilter (in combination with @acronym{DCC}) on | 24480 | My 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.) | |||
| 24046 | In my ham folders, I just hit @kbd{S x} | 24528 | In 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 |
| 24048 | mail (false negative). On group exit, those messages are moved to | 24530 | mail (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 | ||
| 24139 | Instead of the obsolete | 24622 | Instead 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 |
| 24141 | that you use @code{'(spam spam-use-blacklist)}. Everything will work | 24624 | that you use @code{(spam spam-use-blacklist)}. Everything will work |
| 24142 | the same way, we promise. | 24625 | the 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 |
| 24151 | added to a group's @code{spam-process} parameter, the senders of | 24634 | added to a group's @code{spam-process} parameter, the senders of |
| 24152 | ham-marked articles in @emph{ham} groups will be added to the | 24635 | ham-marked articles in @emph{ham} groups will be added to the |
| 24153 | whitelist. Note that this ham processor has no effect in @emph{spam} | 24636 | whitelist. |
| 24154 | or @emph{unclassified} groups. | ||
| 24155 | 24637 | ||
| 24156 | @emph{WARNING} | 24638 | @emph{WARNING} |
| 24157 | 24639 | ||
| 24158 | Instead of the obsolete | 24640 | Instead 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 |
| 24160 | that you use @code{'(ham spam-use-whitelist)}. Everything will work | 24642 | that you use @code{(ham spam-use-whitelist)}. Everything will work |
| 24161 | the same way, we promise. | 24643 | the 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 | |||
| 24207 | addresses in the BBDB will be allowed through; all others will be | 24689 | addresses in the BBDB will be allowed through; all others will be |
| 24208 | classified as spammers. | 24690 | classified as spammers. |
| 24209 | 24691 | ||
| 24692 | While @code{spam-use-BBDB-exclusive} @emph{can} be used as an alias | ||
| 24693 | for @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 | ||
| 24696 | will 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 |
| 24217 | added to a group's @code{spam-process} parameter, the senders of | 24705 | added to a group's @code{spam-process} parameter, the senders of |
| 24218 | ham-marked articles in @emph{ham} groups will be added to the | 24706 | ham-marked articles in @emph{ham} groups will be added to the |
| 24219 | BBDB. Note that this ham processor has no effect in @emph{spam} | 24707 | BBDB. |
| 24220 | or @emph{unclassified} groups. | ||
| 24221 | 24708 | ||
| 24222 | @emph{WARNING} | 24709 | @emph{WARNING} |
| 24223 | 24710 | ||
| 24224 | Instead of the obsolete | 24711 | Instead 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 |
| 24226 | that you use @code{'(ham spam-use-BBDB)}. Everything will work | 24713 | that you use @code{(ham spam-use-BBDB)}. Everything will work |
| 24227 | the same way, we promise. | 24714 | the 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 | ||
| 24251 | Instead of the obsolete | 24738 | Instead 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 |
| 24253 | that you use @code{'(spam spam-use-gmane)}. Everything will work the | 24740 | that you use @code{(spam spam-use-gmane)}. Everything will work the |
| 24254 | same way, we promise. | 24741 | same 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 | |||
| 24261 | running your own news server, for instance, and the local article | 24748 | running your own news server, for instance, and the local article |
| 24262 | numbers don't correspond to the Gmane article numbers. When | 24749 | numbers 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. |
| 24265 | Gmane provides. | 24752 | |
| 24753 | @end defvar | ||
| 24754 | |||
| 24755 | @defvar spam-report-user-mail-address | ||
| 24756 | |||
| 24757 | Mail address exposed in the User-Agent spam reports to Gmane. It allows | ||
| 24758 | the Gmane administrators to contact you in case of misreports. The | ||
| 24759 | default is @code{user-mail-address}. | ||
| 24266 | 24760 | ||
| 24267 | @end defvar | 24761 | @end defvar |
| 24268 | 24762 | ||
| @@ -24276,12 +24770,10 @@ Gmane provides. | |||
| 24276 | 24770 | ||
| 24277 | Similar to @code{spam-use-whitelist} (@pxref{Blacklists and | 24771 | Similar to @code{spam-use-whitelist} (@pxref{Blacklists and |
| 24278 | Whitelists}), but uses hashcash tokens for whitelisting messages | 24772 | Whitelists}), but uses hashcash tokens for whitelisting messages |
| 24279 | instead of the sender address. You must have the @code{hashcash.el} | 24773 | instead of the sender address. Messages without a hashcash payment |
| 24280 | package loaded for @code{spam-use-hashcash} to work properly. | 24774 | token will be sent to the next spam-split rule. This is an explicit |
| 24281 | Messages without a hashcash payment token will be sent to the next | 24775 | filter, meaning that unless a hashcash token is found, the messages |
| 24282 | spam-split rule. This is an explicit filter, meaning that unless a | 24776 | are not assumed to be spam or ham. |
| 24283 | hashcash token is found, the messages are not assumed to be spam or | ||
| 24284 | ham. | ||
| 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 | |||
| 24301 | contains outdated servers. | 24793 | contains outdated servers. |
| 24302 | 24794 | ||
| 24303 | The blackhole check uses the @code{dig.el} package, but you can tell | 24795 | The 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 |
| 24305 | you set @code{spam-use-dig} to @code{nil}. It is not recommended at | 24797 | you set @code{spam-use-dig} to @code{nil}. It is not recommended at |
| 24306 | this time to set @code{spam-use-dig} to @code{nil} despite the | 24798 | this time to set @code{spam-use-dig} to @code{nil} despite the |
| 24307 | possible performance improvements, because some users may be unable to | 24799 | possible performance improvements, because some users may be unable to |
| @@ -24428,7 +24920,7 @@ will be added to the Bogofilter spam database. | |||
| 24428 | 24920 | ||
| 24429 | Instead of the obsolete | 24921 | Instead 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 |
| 24431 | that you use @code{'(spam spam-use-bogofilter)}. Everything will work | 24923 | that you use @code{(spam spam-use-bogofilter)}. Everything will work |
| 24432 | the same way, we promise. | 24924 | the 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 |
| 24439 | added to a group's @code{spam-process} parameter, the ham-marked | 24931 | added to a group's @code{spam-process} parameter, the ham-marked |
| 24440 | articles in @emph{ham} groups will be added to the Bogofilter database | 24932 | articles in @emph{ham} groups will be added to the Bogofilter database |
| 24441 | of non-spam messages. Note that this ham processor has no effect in | 24933 | of non-spam messages. |
| 24442 | @emph{spam} or @emph{unclassified} groups. | ||
| 24443 | 24934 | ||
| 24444 | @emph{WARNING} | 24935 | @emph{WARNING} |
| 24445 | 24936 | ||
| 24446 | Instead of the obsolete | 24937 | Instead 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 |
| 24448 | that you use @code{'(ham spam-use-bogofilter)}. Everything will work | 24939 | that you use @code{(ham spam-use-bogofilter)}. Everything will work |
| 24449 | the same way, we promise. | 24940 | the 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 | |||
| 24464 | used, or has already been used on the article. The 0.9.2.1 version of | 24955 | used, or has already been used on the article. The 0.9.2.1 version of |
| 24465 | Bogofilter was used to test this functionality. | 24956 | Bogofilter 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 | |||
| 24966 | Set this variable if you want @code{spam-split} to use SpamAssassin. | ||
| 24967 | |||
| 24968 | SpamAssassin assigns a score to each article based on a set of rules | ||
| 24969 | and tests, including a Bayesian filter. The Bayesian filter can be | ||
| 24970 | trained by associating the @samp{$} mark for spam articles. The | ||
| 24971 | spam score can be viewed by using the command @kbd{S t} in summary | ||
| 24972 | mode. | ||
| 24973 | |||
| 24974 | If you set this variable, each article will be processed by | ||
| 24975 | SpamAssassin when @code{spam-split} is called. If your mail is | ||
| 24976 | preprocessed by SpamAssassin, and you want to just use the | ||
| 24977 | SpamAssassin headers, set @code{spam-use-spamassassin-headers} | ||
| 24978 | instead. | ||
| 24979 | |||
| 24980 | You 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 | |||
| 24987 | Set this variable if your mail is preprocessed by SpamAssassin and | ||
| 24988 | want @code{spam-split} to split based on the SpamAssassin headers. | ||
| 24989 | |||
| 24990 | You should not enable this if you use @code{spam-use-spamassassin}. | ||
| 24991 | |||
| 24992 | @end defvar | ||
| 24993 | |||
| 24994 | @defvar spam-spamassassin-program | ||
| 24995 | |||
| 24996 | This variable points to the SpamAssassin executable. If you have | ||
| 24997 | @code{spamd} running, you can set this variable to the @code{spamc} | ||
| 24998 | executable for faster processing. See the SpamAssassin documentation | ||
| 24999 | for more information on @code{spamd}/@code{spamc}. | ||
| 25000 | |||
| 25001 | @end defvar | ||
| 25002 | |||
| 25003 | SpamAssassin is a powerful and flexible spam filter that uses a wide | ||
| 25004 | variety of tests to identify spam. A ham and a spam processors are | ||
| 25005 | provided, plus the @code{spam-use-spamassassin} and | ||
| 25006 | @code{spam-use-spamassassin-headers} variables to indicate to | ||
| 25007 | spam-split that SpamAssassin should be either used, or has already | ||
| 25008 | been used on the article. The 2.63 version of SpamAssassin was used | ||
| 25009 | to 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 | ||
| 24534 | Instead of the obsolete | 25078 | Instead 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 |
| 24536 | that you use @code{'(spam spam-use-stat)}. Everything will work | 25080 | that you use @code{(spam spam-use-stat)}. Everything will work |
| 24537 | the same way, we promise. | 25081 | the 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 |
| 24544 | added to a group's @code{spam-process} parameter, the ham-marked | 25088 | added to a group's @code{spam-process} parameter, the ham-marked |
| 24545 | articles in @emph{ham} groups will be added to the spam-stat database | 25089 | articles in @emph{ham} groups will be added to the spam-stat database |
| 24546 | of non-spam messages. Note that this ham processor has no effect in | 25090 | of non-spam messages. |
| 24547 | @emph{spam} or @emph{unclassified} groups. | ||
| 24548 | 25091 | ||
| 24549 | @emph{WARNING} | 25092 | @emph{WARNING} |
| 24550 | 25093 | ||
| 24551 | Instead of the obsolete | 25094 | Instead 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 |
| 24553 | that you use @code{'(ham spam-use-stat)}. Everything will work | 25096 | that you use @code{(ham spam-use-stat)}. Everything will work |
| 24554 | the same way, we promise. | 25097 | the same way, we promise. |
| 24555 | @end defvar | 25098 | @end defvar |
| 24556 | 25099 | ||
| 24557 | This enables @file{spam.el} to cooperate with @file{spam-stat.el}. | 25100 | This 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, |
| 24559 | which unlike ifile or Bogofilter does not require external programs. | 25102 | which unlike ifile or Bogofilter does not require external programs. |
| 24560 | A spam and a ham processor, and the @code{spam-use-stat} variable for | 25103 | A 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}) | |||
| 24583 | call SpamOracle. | 25126 | call SpamOracle. |
| 24584 | 25127 | ||
| 24585 | @vindex spam-use-spamoracle | 25128 | @vindex spam-use-spamoracle |
| 24586 | To enable SpamOracle usage by @file{spam.el}, set the variable | 25129 | To 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 |
| 24589 | Package}. In this example the @samp{INBOX} of an nnimap server is | 25132 | Package}. In this example the @samp{INBOX} of an nnimap server is |
| @@ -24641,7 +25184,7 @@ sent to SpamOracle as spam samples. | |||
| 24641 | 25184 | ||
| 24642 | Instead of the obsolete | 25185 | Instead 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 |
| 24644 | that you use @code{'(spam spam-use-spamoracle)}. Everything will work | 25187 | that you use @code{(spam spam-use-spamoracle)}. Everything will work |
| 24645 | the same way, we promise. | 25188 | the 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 |
| 24652 | to a group's @code{spam-process} parameter, the ham-marked articles in | 25195 | to 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 |
| 24654 | messages. Note that this ham processor has no effect in @emph{spam} or | 25197 | messages. |
| 24655 | @emph{unclassified} groups. | ||
| 24656 | 25198 | ||
| 24657 | @emph{WARNING} | 25199 | @emph{WARNING} |
| 24658 | 25200 | ||
| 24659 | Instead of the obsolete | 25201 | Instead 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 |
| 24661 | that you use @code{'(ham spam-use-spamoracle)}. Everything will work | 25203 | that you use @code{(ham spam-use-spamoracle)}. Everything will work |
| 24662 | the same way, we promise. | 25204 | the 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 | ||
| 24699 | Add | 25241 | Write @code{spam-check-blackbox} if Blackbox can check incoming mail. |
| 24700 | @lisp | ||
| 24701 | (spam-use-blackbox . spam-check-blackbox) | ||
| 24702 | @end lisp | ||
| 24703 | to @code{spam-list-of-checks}. | ||
| 24704 | |||
| 24705 | Add | ||
| 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 | ||
| 24711 | to @code{spam-list-of-processors}. | 25243 | Write @code{spam-blackbox-register-routine} and |
| 24712 | 25244 | @code{spam-blackbox-unregister-routine} using the bogofilter | |
| 24713 | Add | 25245 | register/unregister routines as a start, or other restister/unregister |
| 24714 | @lisp | 25246 | routines more appropriate to Blackbox, if Blackbox can |
| 24715 | (spam-use-blackbox spam-blackbox-register-routine | 25247 | register/unregister spam and ham. |
| 24716 | nil | ||
| 24717 | spam-blackbox-unregister-routine | ||
| 24718 | nil) | ||
| 24719 | @end lisp | ||
| 24720 | |||
| 24721 | to @code{spam-registration-functions}. Write the register/unregister | ||
| 24722 | routines using the bogofilter register/unregister routines as a | ||
| 24723 | start, or other register/unregister routines more appropriate to | ||
| 24724 | Blackbox. | ||
| 24725 | 25248 | ||
| 24726 | @item | 25249 | @item |
| 24727 | Functionality | 25250 | Functionality |
| 24728 | 25251 | ||
| 24729 | Write the @code{spam-check-blackbox} function. It should return | 25252 | The @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 |
| 24731 | conventions. See the existing @code{spam-check-*} functions for | 25254 | existing @code{spam-check-*} functions for examples of what you can |
| 24732 | examples of what you can do, and stick to the template unless you | 25255 | do, and stick to the template unless you fully understand the reasons |
| 24733 | fully understand the reasons why you aren't. | 25256 | why you aren't. |
| 24734 | |||
| 24735 | Make sure to add @code{spam-use-blackbox} to | ||
| 24736 | @code{spam-list-of-statistical-checks} if Blackbox is a statistical | ||
| 24737 | mail 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 | |||
| 24749 | provide them if Blackbox supports spam or ham processing. | 25268 | provide them if Blackbox supports spam or ham processing. |
| 24750 | 25269 | ||
| 24751 | Also, ham and spam processors are being phased out as single | 25270 | Also, ham and spam processors are being phased out as single |
| 24752 | variables. Instead the form @code{'(spam spam-use-blackbox)} or | 25271 | variables. 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 |
| 24754 | processor variables are still around but they won't be for long. | 25273 | processor 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 |
| 24783 | to the @code{spam-autodetect-methods} group parameter in | 25302 | to 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 | |||
| 25305 | Finally, 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 | |||
| 25314 | This function will simply install an alias for a back end that does | ||
| 25315 | everything like the original back end. It is currently only used to | ||
| 25316 | make @code{spam-use-BBDB-exclusive} act like @code{spam-use-BBDB}. | ||
| 25317 | |||
| 25318 | @item | ||
| 25319 | @code{spam-install-nocheck-backend} | ||
| 25320 | |||
| 25321 | This function installs a back end that has no check function, but can | ||
| 25322 | register/unregister ham or spam. The @code{spam-use-gmane} back end is | ||
| 25323 | such a back end. | ||
| 25324 | |||
| 25325 | @item | ||
| 25326 | @code{spam-install-checkonly-backend} | ||
| 25327 | |||
| 25328 | This function will install a back end that can only check incoming mail | ||
| 25329 | for spam contents. It can't register or unregister messages. | ||
| 25330 | @code{spam-use-blackholes} and @code{spam-use-hashcash} are such | ||
| 25331 | back ends. | ||
| 25332 | |||
| 25333 | @item | ||
| 25334 | @code{spam-install-statistical-checkonly-backend} | ||
| 25335 | |||
| 25336 | This function installs a statistical back end (one which requires the | ||
| 25337 | full body of a message to check it) that can only check incoming mail | ||
| 25338 | for contents. @code{spam-use-regex-body} is such a filter. | ||
| 25339 | |||
| 25340 | @item | ||
| 25341 | @code{spam-install-statistical-backend} | ||
| 25342 | |||
| 25343 | This function install a statistical back end with incoming checks and | ||
| 25344 | registration/unregistration routines. @code{spam-use-bogofilter} is | ||
| 25345 | set up this way. | ||
| 25346 | |||
| 25347 | @item | ||
| 25348 | @code{spam-install-backend} | ||
| 25349 | |||
| 25350 | This is the most normal back end installation, where a back end that can | ||
| 25351 | check and register/unregister messages is set up without statistical | ||
| 25352 | abilities. The @code{spam-use-BBDB} is such a back end. | ||
| 25353 | |||
| 25354 | @item | ||
| 25355 | @code{spam-install-mover-backend} | ||
| 25356 | |||
| 25357 | Mover back ends are internal to @code{spam.el} and specifically move | ||
| 25358 | articles around when the summary is exited. You will very probably | ||
| 25359 | never 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. | |||
| 25140 | This variable works the same way as @code{gnus-verbose}, but it applies | 25716 | This variable works the same way as @code{gnus-verbose}, but it applies |
| 25141 | to the Gnus back ends instead of Gnus proper. | 25717 | to the Gnus back ends instead of Gnus proper. |
| 25142 | 25718 | ||
| 25719 | @item gnus-add-timestamp-to-message | ||
| 25720 | @vindex gnus-add-timestamp-to-message | ||
| 25721 | This variable controls whether to add timestamps to messages that are | ||
| 25722 | controlled by @code{gnus-verbose} and @code{gnus-verbose-backends} and | ||
| 25723 | are issued. The default value is @code{nil} which means never to add | ||
| 25724 | timestamp. If it is @code{log}, add timestamps to only the messages | ||
| 25725 | that 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 | ||
| 25728 | displayed 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 |
| 25145 | When the back ends read straight heads of articles, they all try to read | 25732 | When 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 | |||
| 25661 | Kim-Minh Kaplan---further work on the picon code. | 26248 | Kim-Minh Kaplan---further work on the picon code. |
| 25662 | 26249 | ||
| 25663 | @item | 26250 | @item |
| 25664 | Brad Miller---@file{gnus-gl.el} and the GroupLens manual section | 26251 | Brad Miller---@file{gnus-gl.el} and the GroupLens manual section. |
| 25665 | (@pxref{GroupLens}). | ||
| 25666 | 26252 | ||
| 25667 | @item | 26253 | @item |
| 25668 | Sudish Joseph---innumerable bug fixes. | 26254 | Sudish Joseph---innumerable bug fixes. |
| @@ -25703,7 +26289,7 @@ David Moore---rewrite of @file{nnvirtual.el} and many other things. | |||
| 25703 | Kevin Davidson---came up with the name @dfn{ding}, so blame him. | 26289 | Kevin Davidson---came up with the name @dfn{ding}, so blame him. |
| 25704 | 26290 | ||
| 25705 | @item | 26291 | @item |
| 25706 | François Pinard---many, many interesting and thorough bug reports, as | 26292 | Fran@,{c}ois Pinard---many, many interesting and thorough bug reports, as |
| 25707 | well as autoconf support. | 26293 | well as autoconf support. |
| 25708 | 26294 | ||
| 25709 | @end itemize | 26295 | @end itemize |
| @@ -25720,7 +26306,7 @@ Kevin Greiner, | |||
| 25720 | Jesper Harder, | 26306 | Jesper Harder, |
| 25721 | Paul Jarc, | 26307 | Paul Jarc, |
| 25722 | Simon Josefsson, | 26308 | Simon Josefsson, |
| 25723 | David Kågedal, | 26309 | David K@aa{}gedal, |
| 25724 | Richard Pieri, | 26310 | Richard Pieri, |
| 25725 | Fabrice Popineau, | 26311 | Fabrice Popineau, |
| 25726 | Daniel Quinlan, | 26312 | Daniel Quinlan, |
| @@ -25805,12 +26391,13 @@ Yoshiki Hayashi, @c Hayashi | |||
| 25805 | P. E. Jareth Hein, | 26391 | P. E. Jareth Hein, |
| 25806 | Hisashige Kenji, @c Hisashige | 26392 | Hisashige Kenji, @c Hisashige |
| 25807 | Scott Hofmann, | 26393 | Scott Hofmann, |
| 26394 | Tassilo Horn, | ||
| 25808 | Marc Horowitz, | 26395 | Marc Horowitz, |
| 25809 | Gunnar Horrigmo, | 26396 | Gunnar Horrigmo, |
| 25810 | Richard Hoskins, | 26397 | Richard Hoskins, |
| 25811 | Brad Howes, | 26398 | Brad Howes, |
| 25812 | Miguel de Icaza, | 26399 | Miguel de Icaza, |
| 25813 | François Felix Ingrand, | 26400 | Fran@,{c}ois Felix Ingrand, |
| 25814 | Tatsuya Ichikawa, @c Ichikawa | 26401 | Tatsuya Ichikawa, @c Ichikawa |
| 25815 | Ishikawa Ichiro, @c Ishikawa | 26402 | Ishikawa Ichiro, @c Ishikawa |
| 25816 | Lee Iverson, | 26403 | Lee 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 | ||
| 25955 | These lists are, of course, just @emph{short} overviews of the | 26543 | These lists are, of course, just @emph{short} overviews of the |
| @@ -26109,7 +26697,7 @@ Partial thread regeneration now happens when articles are | |||
| 26109 | referred. | 26697 | referred. |
| 26110 | 26698 | ||
| 26111 | @item | 26699 | @item |
| 26112 | Gnus can make use of GroupLens predictions (@pxref{GroupLens}). | 26700 | Gnus can make use of GroupLens predictions. |
| 26113 | 26701 | ||
| 26114 | @item | 26702 | @item |
| 26115 | Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}). | 26703 | Picons (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 | |||
| 26758 | using a wide variety of programs and filter rules. Among the supported | 27346 | using a wide variety of programs and filter rules. Among the supported |
| 26759 | methods are RBL blocklists, bogofilter and white/blacklists. Hooks | 27347 | methods are RBL blocklists, bogofilter and white/blacklists. Hooks |
| 26760 | for easy use of external packages such as SpamAssassin and Hashcash | 27348 | for easy use of external packages such as SpamAssassin and Hashcash |
| 26761 | are also new. @xref{Thwarting Email Spam}. | 27349 | are 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 | |||
| 27920 | New 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 | |||
| 28416 | alterations. This comes in handy if the back end really carries all | 29013 | alterations. This comes in handy if the back end really carries all |
| 28417 | the information (as is the case with virtual and imap groups). This | 29014 | the information (as is the case with virtual and imap groups). This |
| 28418 | function should destructively alter the info to suit its needs, and | 29015 | function should destructively alter the info to suit its needs, and |
| 28419 | should return a non-@code{nil} value. | 29016 | should return a non-@code{nil} value (exceptionally, |
| 29017 | @code{nntp-request-update-info} always returns @code{nil} not to waste | ||
| 29018 | the network resources). | ||
| 28420 | 29019 | ||
| 28421 | There should be no result data from this function. | 29020 | There 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: |
| 72 | Message is distributed with Gnus. The Gnus distribution | 72 | Message is distributed with Gnus. The Gnus distribution |
| 73 | @c | 73 | @c |
| 74 | corresponding to this manual is Gnus v5.11. | 74 | corresponding 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 | ||
| 80 | When a program (or a person) wants to respond to a message -- reply, | 80 | When a program (or a person) wants to respond to a message---reply, |
| 81 | follow up, forward, cancel -- the program (or person) should just put | 81 | follow up, forward, cancel---the program (or person) should just put |
| 82 | point in the buffer where the message is and call the required command. | 82 | point 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 |
| 84 | appropriate headers filled out, and the user can edit the message before | 84 | appropriate 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 |
| 181 | Addresses that match the @code{message-dont-reply-to-names} regular | 181 | Addresses that match the @code{message-dont-reply-to-names} regular |
| 182 | expression will be removed from the @code{Cc} header. | 182 | expression (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 |
| 185 | If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you | 186 | If @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:\\|@* |
| 258 | Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|@* | 259 | Return-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 |
| 800 | Mark some region in the current article with enclosing tags. | 801 | Mark some region in the current article with enclosing tags. See |
| 801 | See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. | 802 | @code{message-mark-insert-begin} and @code{message-mark-insert-end}. |
| 803 | When 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 |
| 806 | Insert a file in the current article with enclosing tags. | 809 | Insert a file in the current article with enclosing tags. |
| 807 | See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. | 810 | See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. |
| 811 | When 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 | ||
| 1170 | Kill 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 |
| 1249 | The @code{message-mail-alias-type} variable controls what type of mail | 1261 | The @code{message-mail-alias-type} variable controls what type of mail |
| 1250 | alias expansion to use. Currently only one form is supported---Message | 1262 | alias expansion to use. Currently two forms are supported: |
| 1251 | uses @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. | |||
| 1266 | No expansion will be performed upon sending of the message---all | 1278 | No expansion will be performed upon sending of the message---all |
| 1267 | expansions have to be done explicitly. | 1279 | expansions have to be done explicitly. |
| 1268 | 1280 | ||
| 1281 | If 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 | ||
| 1285 | there and ``electrically'' say what completions are possible. To | ||
| 1286 | choose one of these completions, use the @kbd{M-n} command to move | ||
| 1287 | down to the list. Use @kbd{M-n} and @kbd{M-p} to move down and up the | ||
| 1288 | list, 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 | ||
| 1336 | Message is quite aggressive on the message generation front. It has to | 1356 | Message is quite aggressive on the message generation front. It has to |
| 1337 | be -- it's a combined news and mail agent. To be able to send combined | 1357 | be---it's a combined news and mail agent. To be able to send combined |
| 1338 | messages, it has to generate all headers itself (instead of letting the | 1358 | messages, it has to generate all headers itself (instead of letting the |
| 1339 | mail/news system do it) to ensure that mail and news copies of messages | 1359 | mail/news system do it) to ensure that mail and news copies of messages |
| 1340 | look sufficiently similar. | 1360 | look sufficiently similar. |
| @@ -1373,7 +1393,7 @@ values: | |||
| 1373 | 1393 | ||
| 1374 | @table @code | 1394 | @table @code |
| 1375 | @item nil | 1395 | @item nil |
| 1376 | Just the address -- @samp{king@@grassland.com}. | 1396 | Just 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 | ||
| 1517 | Headers are hidden using narrowing, you can use @kbd{M-x widen} to | ||
| 1518 | expose 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 |
| 1499 | A list of lists of header synonyms. E.g., if this list contains a | 1522 | A 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@* | |||
| 1525 | This string is inserted at the end of the headers in all message | 1548 | This string is inserted at the end of the headers in all message |
| 1526 | buffers that are initialized as mail. | 1549 | buffers that are initialized as mail. |
| 1527 | 1550 | ||
| 1551 | @item message-generate-hashcash | ||
| 1552 | @vindex message-generate-hashcash | ||
| 1553 | Variable that indicates whether @samp{X-Hashcash} headers | ||
| 1554 | should be computed for the message. @xref{Hashcash, ,Hashcash,gnus, | ||
| 1555 | The Gnus Manual}. If @code{opportunistic}, only generate the headers | ||
| 1556 | when 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 |
| 1543 | Function used to send the current buffer as mail. The default is | 1573 | Function 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} |
| 1575 | according 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: | |||
| 1859 | Hallvard B Furuseth <h.b.furuseth@@usit.uio.no> writes: | 1889 | Hallvard 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 | |||
| 1862 | Point will be at the beginning of the body of the message when this | 1895 | Point will be at the beginning of the body of the message when this |
| 1863 | function is called. | 1896 | function 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 |
| 1875 | When you are replying to or following up an article, you normally want | 1908 | When you are replying to or following up an article, you normally want |
| 1876 | to quote the person you are answering. Inserting quoted text is done | 1909 | to quote the person you are answering. Inserting quoted text is done by |
| 1877 | by @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 |
| 1879 | empty lines which uses @code{message-yank-cited-prefix}). The default | 1912 | which use @code{message-yank-cited-prefix} and empty lines which use |
| 1880 | is @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 |
| 1887 | When yanking text from an article which contains no text or already | 1920 | When yanking text from an article which contains already cited text, |
| 1888 | cited text, each line will be prefixed with the contents of this | 1921 | each line will be prefixed with the contents of this variable. The |
| 1889 | variable. The default is @samp{>}. See also | 1922 | default 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 | ||
| 1928 | When yanking text from an article, each empty line will be prefixed with | ||
| 1929 | the contents of this variable. The default is @samp{>}. You can set | ||
| 1930 | this variable to an empty string to split the cited text into paragraphs | ||
| 1931 | automatically. 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 |
| 1934 | File containing the signature to be inserted at the end of the buffer. | 1975 | File containing the signature to be inserted at the end of the buffer. |
| 1976 | If a path is specified, the value of | ||
| 1977 | @code{message-signature-directory} is ignored, even if set. | ||
| 1935 | The default is @file{~/.signature}. | 1978 | The default is @file{~/.signature}. |
| 1936 | 1979 | ||
| 1980 | @item message-signature-directory | ||
| 1981 | @vindex message-signature-directory | ||
| 1982 | Name of directory containing signature files. Comes in handy if you | ||
| 1983 | have many such files, handled via Gnus posting styles for instance. | ||
| 1984 | If @code{nil} (the default), @code{message-signature-file} is expected | ||
| 1985 | to 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 |
| 1939 | If @code{t} (the default value) an empty line is inserted before the | 1990 | If @code{t} (the default value) an empty line is inserted before the |
| @@ -1968,6 +2019,13 @@ Emacsen.) @xref{Charset Translation, , Charset Translation, emacs-mime, | |||
| 1968 | Emacs MIME Manual}, for details on the @sc{mule}-to-@acronym{MIME} | 2019 | Emacs MIME Manual}, for details on the @sc{mule}-to-@acronym{MIME} |
| 1969 | translation process. | 2020 | translation process. |
| 1970 | 2021 | ||
| 2022 | @item message-fill-column | ||
| 2023 | @vindex message-fill-column | ||
| 2024 | @cindex auto-fill | ||
| 2025 | Local value for the column beyond which automatic line-wrapping should | ||
| 2026 | happen for message buffers. If non-nil (the default), also turn on | ||
| 2027 | auto-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 |
| 1973 | Regexp matching the signature separator. It is @samp{^-- *$} by | 2031 | Regexp 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 |
| 2058 | Syntax table used in message mode buffers. | 2116 | Syntax 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 | ||
| 2120 | If 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 | ||
| 2122 | undo 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 |
| 2062 | Emacs has a number of special text properties which can break message | 2126 | Emacs 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 |
| 2091 | A function to be called if @var{predicate} returns non-@code{nil}. | 2155 | A 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 | ||
| 2095 | The default is: | 2159 | The 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. | |||
| 345 | Since PGG was designed for accessing and developing PGP functionality, | 345 | Since PGG was designed for accessing and developing PGP functionality, |
| 346 | the architecture had to be designed not just for interoperability but | 346 | the architecture had to be designed not just for interoperability but |
| 347 | also for extensiblity. In this chapter we explore the architecture | 347 | also for extensiblity. In this chapter we explore the architecture |
| 348 | while finding out how to write the PGG backend. | 348 | while 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 | ||
| 375 | The name of the function must follow the | 375 | The name of the function must follow the |
| 376 | regulation---@code{pgg-make-scheme-} follows the backend name. | 376 | regulation---@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 | ||
| 381 | In each backend, these methods must be present. The output of these | 381 | In each back end, these methods must be present. The output of these |
| 382 | methods is stored in special buffers (@ref{Getting output}), so that | 382 | methods is stored in special buffers (@ref{Getting output}), so that |
| 383 | these methods must tell the status of the execution. | 383 | these 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 | ||
| 438 | The output of the backend methods (@ref{Backend methods}) is stored in | 438 | The output of the back end methods (@ref{Back end methods}) is stored in |
| 439 | special buffers, so that these methods must tell the status of the | 439 | special buffers, so that these methods must tell the status of the |
| 440 | execution. | 440 | execution. |
| 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 | ||
| 15 | This file describes the Emacs SASL library. | ||
| 16 | |||
| 17 | Copyright @copyright{} 2004, 2005, 2006 Free Software Foundation, Inc. | ||
| 18 | Copyright @copyright{} 2000 Daiki Ueno. | ||
| 19 | |||
| 20 | Permission is granted to copy, distribute and/or modify this document | ||
| 21 | under the terms of the GNU Free Documentation License, Version 1.2 or | ||
| 22 | any later version published by the Free Software Foundation; with no | ||
| 23 | Invariant Sections, with no Front-Cover Texts, and with no Back-Cover | ||
| 24 | Texts. A copy of the license is included in the section entitled "GNU | ||
| 25 | Free 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 | ||
| 37 | Copyright @copyright{} 2000 Daiki Ueno. | ||
| 38 | |||
| 39 | Permission is granted to copy, distribute and/or modify this document | ||
| 40 | under the terms of the GNU Free Documentation License, Version 1.2 or | ||
| 41 | any later version published by the Free Software Foundation; with no | ||
| 42 | Invariant Sections, with no Front-Cover Texts, and with no Back-Cover | ||
| 43 | Texts. A copy of the license is included in the section entitled "GNU | ||
| 44 | Free Documentation License". | ||
| 45 | @end titlepage | ||
| 46 | @page | ||
| 47 | |||
| 48 | @end tex | ||
| 49 | |||
| 50 | @node Top | ||
| 51 | @top Emacs SASL | ||
| 52 | This manual describes the Emacs SASL library. | ||
| 53 | |||
| 54 | A common interface to share several authentication mechanisms between | ||
| 55 | applications 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}. | ||
| 71 | This standard is documented in RFC2222. It provides a simple method for | ||
| 72 | adding authentication support to various application protocols. | ||
| 73 | |||
| 74 | The toplevel interface of this library is inspired by Java @sc{sasl} | ||
| 75 | Application Program Interface. It defines an abstraction over a series | ||
| 76 | of authentication mechanism drivers (@ref{Back end drivers}). | ||
| 77 | |||
| 78 | Back end drivers are designed to be close as possible to the | ||
| 79 | authentication mechanism. You can access the additional configuration | ||
| 80 | information anywhere from the implementation. | ||
| 81 | |||
| 82 | @node How to use | ||
| 83 | @chapter How to use | ||
| 84 | |||
| 85 | (Not yet written). | ||
| 86 | |||
| 87 | To use Emacs SASL library, please evaluate following expression at the | ||
| 88 | beginning of your application program. | ||
| 89 | |||
| 90 | @lisp | ||
| 91 | (require 'sasl) | ||
| 92 | @end lisp | ||
| 93 | |||
| 94 | If you want to check existence of sasl.el at runtime, instead you | ||
| 95 | can list autoload settings for functions you want. | ||
| 96 | |||
| 97 | @node Data types | ||
| 98 | @chapter Data types | ||
| 99 | |||
| 100 | There are three data types to be used for carrying a negotiated | ||
| 101 | security layer---a mechanism, a client parameter and an authentication | ||
| 102 | step. | ||
| 103 | |||
| 104 | @menu | ||
| 105 | * Mechanisms:: | ||
| 106 | * Clients:: | ||
| 107 | * Steps:: | ||
| 108 | @end menu | ||
| 109 | |||
| 110 | @node Mechanisms | ||
| 111 | @section Mechanisms | ||
| 112 | |||
| 113 | A mechanism (@code{sasl-mechanism} object) is a schema of the @sc{sasl} | ||
| 114 | authentication mechanism driver. | ||
| 115 | |||
| 116 | @defvar sasl-mechanisms | ||
| 117 | A list of mechanism names. | ||
| 118 | @end defvar | ||
| 119 | |||
| 120 | @defun sasl-find-mechanism mechanisms | ||
| 121 | |||
| 122 | Retrieve an apropriate mechanism. | ||
| 123 | This function compares @var{mechanisms} and @code{sasl-mechanisms} then | ||
| 124 | returns 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 | ||
| 134 | Return name of mechanism, a string. | ||
| 135 | @end defun | ||
| 136 | |||
| 137 | If you want to write an authentication mechanism driver (@ref{Back end | ||
| 138 | drivers}), 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 | ||
| 142 | Allocate a @code{sasl-mechanism} object. | ||
| 143 | This function takes two parameters---name of the mechanism, and a list | ||
| 144 | of 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 | |||
| 160 | A client (@code{sasl-client} object) initialized with four | ||
| 161 | parameters---a mechanism, a user name, name of the service and name of | ||
| 162 | the server. | ||
| 163 | |||
| 164 | @defun sasl-make-client mechanism name service server | ||
| 165 | Prepare a @code{sasl-client} object. | ||
| 166 | @end defun | ||
| 167 | |||
| 168 | @defun sasl-client-mechanism client | ||
| 169 | Return the mechanism (@code{sasl-mechanism} object) of client. | ||
| 170 | @end defun | ||
| 171 | |||
| 172 | @defun sasl-client-name client | ||
| 173 | Return the authorization name of client, a string. | ||
| 174 | @end defun | ||
| 175 | |||
| 176 | @defun sasl-client-service client | ||
| 177 | Return the service name of client, a string. | ||
| 178 | @end defun | ||
| 179 | |||
| 180 | @defun sasl-client-server client | ||
| 181 | Return the server name of client, a string. | ||
| 182 | @end defun | ||
| 183 | |||
| 184 | If 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 | ||
| 188 | Add the given property/value to client. | ||
| 189 | @end defun | ||
| 190 | |||
| 191 | @defun sasl-client-property client property | ||
| 192 | Return the value of the property of client. | ||
| 193 | @end defun | ||
| 194 | |||
| 195 | @defun sasl-client-set-properties client plist | ||
| 196 | Destructively set the properties of client. | ||
| 197 | The second argument is the new property list. | ||
| 198 | @end defun | ||
| 199 | |||
| 200 | @defun sasl-client-properties client | ||
| 201 | Return the whole property list of client configuration. | ||
| 202 | @end defun | ||
| 203 | |||
| 204 | @node Steps | ||
| 205 | @section Steps | ||
| 206 | |||
| 207 | A step (@code{sasl-step} object) is an abstraction of authentication | ||
| 208 | ``step'' which holds the response value and the next entry point for the | ||
| 209 | authentication process (the latter is not accessible). | ||
| 210 | |||
| 211 | @defun sasl-step-data step | ||
| 212 | Return the data which @var{step} holds, a string. | ||
| 213 | @end defun | ||
| 214 | |||
| 215 | @defun sasl-step-set-data step data | ||
| 216 | Store @var{data} string to @var{step}. | ||
| 217 | @end defun | ||
| 218 | |||
| 219 | To 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 | |||
| 226 | At this point we could send the command which starts a SASL | ||
| 227 | authentication 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 | |||
| 237 | To 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 | ||
| 241 | Perform the authentication step. | ||
| 242 | At 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 | ||
| 239 | A few mailing lists do not use the @samp{Sender:} header, but does | 239 | A few mailing lists do not use the @samp{Sender:} header, but has a |
| 240 | contain some unique identifier in some other header. The following is | 240 | unique identifier in some other header. The following is not a |
| 241 | not a complete script, it assumes that @code{fileinto} has already been | 241 | complete script, it assumes that @code{fileinto} has already been |
| 242 | required. | 242 | required. |
| 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 | ||
| 15 | If you have tried Oort (the unstable Gnus branch leading to this | 15 | If you have tried No Gnus (the unstable Gnus branch leading to this |
| 16 | release) but went back to a stable version, be careful when upgrading to | 16 | release) but went back to a stable version, be careful when upgrading to |
| 17 | this version. In particular, you will probably want to remove all | 17 | this 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 |
| 19 | your `.newsrc.eld' instead of from the `.marks'/`.mrk' file where this | 19 | from your `~/.newsrc.eld' instead of from the stale marks file, where |
| 20 | release store flags. See a later entry for more information about | 20 | this release will store flags for nntp. See a later entry for more |
| 21 | marks. Note that downgrading isn't save in general. | 21 | information about nntp marks. Note that downgrading isn't safe in |
| 22 | general. | ||
| 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 |
| 24 | defaulted to `.../site-lisp/' formerly. In addition to this, the new | 25 | defaulted 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 | |||
| 26 | the latest one are detected. You can then remove those shadows manually | 27 | the latest one are detected. You can then remove those shadows manually |
| 27 | or remove them using `make remove-installed-shadows'. | 28 | or remove them using `make remove-installed-shadows'. |
| 28 | 29 | ||
| 29 | ** New `make.bat' for compiling and installing Gnus under MS Windows | ||
| 30 | |||
| 31 | Use `make.bat' if you want to install Gnus under MS Windows, the first | ||
| 32 | argument to the batch-program should be the directory where `xemacs.exe' | ||
| 33 | respectively `emacs.exe' is located, if you want to install Gnus after | ||
| 34 | compiling it, give `make.bat' `/copy' as the second parameter. | ||
| 35 | |||
| 36 | `make.bat' has been rewritten from scratch, it now features automatic | ||
| 37 | recognition of XEmacs and GNU Emacs, generates `gnus-load.el', checks if | ||
| 38 | errors occur while compilation and generation of info files and reports | ||
| 39 | them at the end of the build process. It now uses `makeinfo' if it is | ||
| 40 | available and falls back to `infohack.el' otherwise. `make.bat' should | ||
| 41 | now install all files which are necessary to run Gnus and be generally a | ||
| 42 | complete replacement for the `configure; make; make install' cycle used | ||
| 43 | under Unix systems. | ||
| 44 | |||
| 45 | The new `make.bat' makes `make-x.bat' and `xemacs.mak' superfluous, so | ||
| 46 | they have been removed. | ||
| 47 | |||
| 48 | ** `~/News/overview/' not used. | ||
| 49 | |||
| 50 | As a result of the following change, the `~/News/overview/' directory is | ||
| 51 | not used any more. You can safely delete the entire hierarchy. | ||
| 52 | |||
| 53 | ** `(require 'gnus-load)' | ||
| 54 | |||
| 55 | If you use a stand-alone Gnus distribution, you'd better add `(require | ||
| 56 | 'gnus-load)' into your `~/.emacs' after adding the Gnus lisp directory | ||
| 57 | into load-path. | ||
| 58 | |||
| 59 | File `gnus-load.el' contains autoload commands, functions and variables, | ||
| 60 | some 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. |
| 67 | Questions::. | ||
| 68 | |||
| 69 | ** TLS wrapper shipped with Gnus | ||
| 70 | 34 | ||
| 71 | TLS/SSL is now supported in IMAP and NNTP via `tls.el' and GNUTLS. The | 35 | This provides a clean API to SASL mechanisms from within Emacs. The |
| 72 | old TLS/SSL support via (external third party) `ssl.el' and OpenSSL | 36 | user visible aspects of this, compared to the earlier situation, include |
| 73 | still works. | 37 | support 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 | ||
| 77 | Gnus is now able to take out spam from your mail and news streams using | 41 | The primary change this brings is support for DIGEST-MD5 and NTLM, when |
| 78 | a wide variety of programs and filter rules. Among the supported | 42 | the server supports it. |
| 79 | methods are RBL blocklists, bogofilter and white/blacklists. Hooks for | ||
| 80 | easy use of external packages such as SpamAssassin and Hashcash are also | ||
| 81 | new. *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 | |||
| 85 | Sieve rules can be added as Group Parameters for groups, and the | ||
| 86 | complete Sieve script is generated using `D g' from the Group buffer, | ||
| 87 | and then uploaded to the server using `C-c C-l' in the generated Sieve | ||
| 88 | buffer. *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 | ||
| 96 | M'. | ||
| 97 | |||
| 98 | ** Retrieval of charters and control messages | ||
| 99 | |||
| 100 | There are new commands for fetching newsgroup charters (`H c') and | ||
| 101 | control messages (`H C'). | ||
| 102 | |||
| 103 | ** The new variable `gnus-parameters' can be used to set group parameters. | ||
| 104 | |||
| 105 | Earlier this was done only via `G p' (or `G c'), which stored the | ||
| 106 | parameters in `~/.newsrc.eld', but via this variable you can enjoy the | ||
| 107 | powers of customize, and simplified backups since you set the variable | ||
| 108 | in `~/.gnus.el' instead of `~/.newsrc.eld'. The variable maps regular | ||
| 109 | expressions 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 | |||
| 119 | The estimated number of unread articles in the group buffer should now | ||
| 120 | be 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 | ||
| 124 | you 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 | ||
| 126 | with the estimate and want to save some (minimal) time when getting new | ||
| 127 | mail, remove the function. | ||
| 128 | |||
| 129 | ** Group names are treated as UTF-8 by default. | ||
| 130 | |||
| 131 | This 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 | |||
| 137 | The regexps in these variables are compared with full group names | ||
| 138 | instead of real group names in 5.8. Users who customize these variables | ||
| 139 | should change those regexps accordingly. For example: | ||
| 140 | ("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) | ||
| 141 | 45 | ||
| 46 | It is enabled by default (see `password-cache'), with a short timeout of | ||
| 47 | 16 seconds (see `password-cache-expiry'). If PGG is used as the PGP | ||
| 48 | back end, the PGP passphrase is managed by this mechanism. Passwords | ||
| 49 | for ManageSieve connections are managed by this mechanism, after | ||
| 50 | querying 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 | 56 | that are not reused when you select another article. *Note Sticky |
| 148 | the region is active. | 57 | Articles::. |
| 149 | |||
| 150 | ** In draft groups, `e' is now bound to `gnus-draft-edit-message'. Use `B | ||
| 151 | w' for `gnus-summary-edit-article' instead. | ||
| 152 | |||
| 153 | ** Article Buttons | ||
| 154 | |||
| 155 | More buttons for URLs, mail addresses, Message-IDs, Info links, man | ||
| 156 | pages and Emacs or Gnus related references. *Note Article Buttons::. | ||
| 157 | The variables `gnus-button-*-level' can be used to control the | ||
| 158 | appearance of all article buttons. *Note Article Button Levels::. | ||
| 159 | |||
| 160 | ** Single-part yenc encoded attachments can be decoded. | ||
| 161 | |||
| 162 | ** Picons | ||
| 163 | |||
| 164 | The picons code has been reimplemented to work in GNU Emacs--some of the | ||
| 165 | previous options have been removed or renamed. | ||
| 166 | |||
| 167 | Picons are small "personal icons" representing users, domain and | ||
| 168 | newsgroups, which can be displayed in the Article buffer. *Note | ||
| 169 | Picons::. | ||
| 170 | |||
| 171 | ** If the new option `gnus-treat-body-boundary' is non-`nil', a boundary | ||
| 172 | line 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 | ||
| 177 | article. Use `(setq gnus-summary-display-arrow nil)' to disable it. | ||
| 178 | |||
| 179 | ** Warn about email replies to news | ||
| 180 | |||
| 181 | Do you often find yourself replying to news by email by mistake? Then | ||
| 182 | the new option `gnus-confirm-mail-reply-to-news' is just the thing for | ||
| 183 | you. | ||
| 184 | |||
| 185 | ** If the new option `gnus-summary-display-while-building' is non-`nil', | ||
| 186 | the summary buffer is shown and updated as it's being built. | ||
| 187 | |||
| 188 | ** The new `recent' mark `.' indicates newly arrived messages (as opposed | ||
| 189 | to old but unread messages). | ||
| 190 | |||
| 191 | ** Gnus supports RFC 2369 mailing list headers, and adds a number of | ||
| 192 | related 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 | ||
| 195 | English. *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 | |||
| 202 | Gnus now tries to recognize the mangled header block that some Microsoft | ||
| 203 | mailers use to indicate that the rest of the message is a citation, even | ||
| 204 | though it is not quoted in any way. The variable | ||
| 205 | `gnus-cite-unsightly-citation-regexp' matches the start of these | ||
| 206 | citations. | ||
| 207 | |||
| 208 | The new command `W Y f' (`gnus-article-outlook-deuglify-article') allows | ||
| 209 | deuglifying broken Outlook (Express) articles. | ||
| 210 | |||
| 211 | ** `gnus-article-skip-boring' | ||
| 212 | |||
| 213 | If you set `gnus-article-skip-boring' to `t', then Gnus will not scroll | ||
| 214 | down to show you a page that contains only boring text, which by default | ||
| 215 | means cited text and signature. You can customize what is skippable | ||
| 216 | using `gnus-article-boring-faces'. | ||
| 217 | |||
| 218 | This feature is especially useful if you read many articles that consist | ||
| 219 | of a little new content at the top with a long, untrimmed message cited | ||
| 220 | below. | ||
| 221 | |||
| 222 | ** Smileys (`:-)', `;-)' etc) are now displayed graphically in Emacs too. | ||
| 223 | |||
| 224 | Put `(setq gnus-treat-display-smileys nil)' in `~/.gnus.el' to disable | ||
| 225 | it. | ||
| 226 | |||
| 227 | ** Face headers handling. *Note Face::. | ||
| 228 | |||
| 229 | ** In the summary buffer, the new command `/ N' inserts new messages and `/ | ||
| 230 | o' 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 |
| 60 | using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn | ||
| 61 | (`http://www.gnu.org/software/libidn/') has been installed. | ||
| 235 | 62 | ||
| 236 | The 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 |
| 237 | Moreover `gnus-extra-headers', `nnmail-extra-headers' and | 64 | ends that fully support non-ASCII group names are now `nntp', `nnml', |
| 238 | `gnus-ignored-from-addresses' changed their default so that the users | 65 | and `nnrss'. Also the agent, the cache, and the marks features work |
| 239 | name will be replaced by the recipient's name or the group name posting | 66 | with those back ends. *Note Non-ASCII Group Names::. |
| 240 | to 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 | ||
| 244 | The command `gnus-mime-save-part-and-strip' (bound to `C-o' on MIME | 70 | ** Gnus supports new limiting commands in the Summary buffer: `/ r' |
| 245 | buttons) 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::. |
| 247 | It 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 | ||
| 76 | Commands::. | ||
| 250 | 77 | ||
| 251 | The 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' |
| 252 | variable, 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 |
| 82 | configure the server in `smime-ldap-host-list'. | ||
| 256 | 83 | ||
| 257 | Gnus supports Muttprint natively with `O P' from the Summary and Article | 84 | ** URLs inside OpenPGP headers are retrieved and imported to your PGP key |
| 258 | buffers. Also, each individual MIME part can be printed using `p' on | 85 | ring when you click on them. |
| 259 | the 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 | ||
| 263 | Format 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 | ||
| 265 | specs are supported. The extended format specs look like `%u&foo;', | ||
| 266 | which invokes function `gnus-user-format-function-FOO'. Because `&' is | ||
| 267 | used as the escape character, old user defined format `%u&' is no longer | ||
| 268 | supported. | ||
| 269 | 91 | ||
| 270 | ** `/ *' (`gnus-summary-limit-include-cached') is rewritten. | 92 | ANSI sequences are used in some Chinese hierarchies for highlighting |
| 93 | articles (`gnus-article-treat-ansi-sequences'). | ||
| 271 | 94 | ||
| 272 | It was aliased to `Y c' (`gnus-summary-insert-cached-articles'). The | 95 | ** Gnus now MIME decodes articles even when they lack "MIME-Version" header. |
| 273 | new function filters out other articles. | 96 | This 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, |
| 99 | set it to `\\.ADAPT\\'' and only adaptive score files will be decayed. | ||
| 100 | *Note Score Decays::. | ||
| 276 | 101 | ||
| 277 | If `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 |
| 278 | a', and `/ x' (`gnus-summary-limit-to-{subject,author,extra}') | 103 | when using `gnus-ignored-from-addresses' can be customized with |
| 279 | respectively, the result will be to display all articles that do not | 104 | `gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. *Note To |
| 280 | match the expression. | 105 | From 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 | 109 | Commands::, *note Using MIME::. | |
| 285 | |||
| 286 | * Changes in Message mode and related Gnus features | ||
| 287 | |||
| 288 | ** Delayed articles | ||
| 289 | |||
| 290 | You can delay the sending of a message with `C-c C-j' in the Message | ||
| 291 | buffer. The messages are delivered at specified time. This is useful | ||
| 292 | for sending yourself reminders. *Note Delayed Articles::. | ||
| 293 | |||
| 294 | ** If the new option `nnml-use-compressed-files' is non-`nil', the nnml | ||
| 295 | back end allows compressed message files. | ||
| 296 | |||
| 297 | ** The new option `gnus-gcc-mark-as-read' automatically marks Gcc articles | ||
| 298 | as read. | ||
| 299 | |||
| 300 | ** Externalizing of attachments | ||
| 301 | |||
| 302 | If `gnus-gcc-externalize-attachments' or | ||
| 303 | `message-fcc-externalize-attachments' is non-`nil', attach local files | ||
| 304 | as 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 | |||
| 311 | Earlier it was generated when the user configurable email address was | ||
| 312 | different from the Gnus guessed default user address. As the guessing | ||
| 313 | algorithm is rarely correct these days, and (more controversially) the | ||
| 314 | only use of the Sender: header was to check if you are entitled to | ||
| 315 | cancel/supersede news (which is now solved by Cancel Locks instead, see | ||
| 316 | another entry), generation of the header has been disabled by default. | ||
| 317 | See 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 | |||
| 322 | Message now asks if you wish to remove `(was: <old subject>)' from | ||
| 323 | subject 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 | ||
| 325 | X-No-Archive: header. `C-c C-f x' inserts appropriate headers and a | ||
| 326 | note 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 | ||
| 330 | start 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 | |||
| 336 | To support groups that contains SPC and other weird characters, groups | ||
| 337 | are quoted before they are placed in the Gcc: header. This means | ||
| 338 | variables such as `gnus-message-archive-group' should no longer contain | ||
| 339 | quote characters to make groups containing SPC work. Also, if you are | ||
| 340 | using the string `nnml:foo, nnml:bar' (indicating Gcc into two groups) | ||
| 341 | you must change it to return the list `("nnml:foo" "nnml:bar")', | ||
| 342 | otherwise the Gcc: line will be quoted incorrectly. Note that returning | ||
| 343 | the string `nnml:foo, nnml:bar' was incorrect earlier, it just didn't | ||
| 344 | generate any problems since it was inserted directly. | ||
| 345 | |||
| 346 | ** `message-insinuate-rmail' | ||
| 347 | |||
| 348 | Adding `(message-insinuate-rmail)' and `(setq mail-user-agent | ||
| 349 | 'gnus-user-agent)' in `.emacs' convinces Rmail to compose, reply and | ||
| 350 | forward messages in message-mode, where you can enjoy the power of MML. | ||
| 351 | |||
| 352 | ** `message-minibuffer-local-map' | ||
| 353 | |||
| 354 | The 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 | |||
| 360 | Add a new format of match like | ||
| 361 | ((header "to" "larsi.*org") | ||
| 362 | (Organization "Somewhere, Inc.")) | ||
| 363 | The 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 | ||
| 370 | these two variables. If you customized those, perhaps you need add | ||
| 371 | those two headers too. | ||
| 372 | |||
| 373 | ** Gnus supports the "format=flowed" (RFC 2646) parameter. On composing | ||
| 374 | messages, it is enabled by `use-hard-newlines'. Decoding format=flowed | ||
| 375 | was 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 | 112 | format=flowed messages. Also, flowed text is disabled when sending |
| 379 | inline PGP signed messages. (New in Gnus 5.10.7) | 113 | inline 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 | ||
| 382 | requests. | ||
| 383 | 116 | ||
| 384 | This 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 | |||
| 388 | In the message buffer, `C-c C-f C-i' or `C-c C-u' cycles through the | ||
| 389 | valid values. | ||
| 390 | |||
| 391 | ** Gnus supports Cancel Locks in News. | ||
| 392 | |||
| 393 | This means a header `Cancel-Lock' is inserted in news posting. It is | ||
| 394 | used to determine if you wrote an article or not (for canceling and | ||
| 395 | superseding). Gnus generates a random password string the first time | ||
| 396 | you post a message, and saves it in your `~/.emacs' using the Custom | ||
| 397 | system. While the variable is called `canlock-password', it is not | ||
| 398 | security sensitive data. Publishing your canlock string on the web will | ||
| 399 | not allow anyone to be able to anything she could not already do. The | ||
| 400 | behavior 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 | ||
| 405 | It needs an external S/MIME and OpenPGP implementation, but no | 123 | ** You can now drag and drop attachments to the Message buffer. See |
| 406 | additional Lisp libraries. This add several menu items to the | 124 | `mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME: |
| 407 | Attachments menu, and `C-c RET' key bindings, when composing messages. | 125 | (message)MIME. |
| 408 | This 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 |
| 128 | prefixed in cited text. *Note Insertion Variables: (message)Insertion | ||
| 129 | Variables. | ||
| 411 | 130 | ||
| 412 | This 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, |
| 133 | use `(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 |
| 137 | buffer. See `gnus-message-highlight-citation'. | ||
| 416 | 138 | ||
| 417 | The 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 |
| 418 | when appropriate. MML will not be used when forwarding signed or | 140 | `message-fill-column'. *Note Message Headers: (message)Various Message |
| 419 | encrypted messages, as the conversion invalidate the digital signature. | 141 | Variables. |
| 420 | 142 | ||
| 421 | ** If `auto-compression-mode' is enabled, attachments are automatically | 143 | ** You can now store signature files in a special directory named |
| 422 | decompressed 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 | ||
| 426 | Message supports non-ASCII domain names in From:, To: and Cc: and will | 151 | |
| 427 | query you whether to perform encoding when you try to send a message. | 152 | * Changes in back ends |
| 428 | The variable `message-use-idna' controls this. Gnus will also decode | ||
| 429 | non-ASCII domain names in From:, To: and Cc: when you view a message. | ||
| 430 | The 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 | ||
| 156 | The directory can be changed using the (customizable) variable | ||
| 157 | `nntp-marks-directory', and marks can be disabled using the (back end) | ||
| 158 | variable `nntp-marks-is-evil'. The advantage of this is that you can | ||
| 159 | copy `~/News/marks' (using rsync, scp or whatever) to another Gnus | ||
| 160 | installation, and it will realize what articles you have read and | ||
| 161 | marked. 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 | 165 | RSS::. |
| 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. | 169 | By default, Gnus does not send any information about itself, but you can |
| 170 | customize 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 |
| 173 | names for the `nnrss' groups are also supported. *Note RSS::. | ||
| 445 | 174 | ||
| 446 | Gnus 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 |
| 178 | compressed message files. *Note Mail Spool::. | ||
| 449 | 179 | ||
| 450 | This makes it possible to take backup of nnml/nnfolder servers/groups | 180 | ** The nnml back end supports group compaction. |
| 451 | separately of `~/.newsrc.eld', while preserving marks. It also makes it | ||
| 452 | possible to share articles and marks between users (without sharing the | ||
| 453 | `~/.newsrc.eld' file) within e.g. a department. It works by storing the | ||
| 454 | marks stored in `~/.newsrc.eld' in a per-group file `.marks' (for nnml) | ||
| 455 | and `GROUPNAME.mrk' (for nnfolder, named GROUPNAME). If the | ||
| 456 | nnml/nnfolder is moved to another machine, Gnus will automatically use | ||
| 457 | the `.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 | ||
| 182 | This feature, accessible via the functions `gnus-group-compact-group' | ||
| 183 | (`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the | ||
| 184 | server buffer) renumbers all articles in a group, starting from 1 and | ||
| 185 | removing 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 |
| 466 | renamed to "Gnus". | 192 | customize 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 | 194 | for Emacs, not in XEmacs.) |
| 469 | "Attachments". Note that this menu also contains security related | ||
| 470 | stuff, like signing and encryption (*note Security: (message)Security.). | ||
| 471 | |||
| 472 | ** The tool bars have been updated to use GNOME icons in Group, Summary and | ||
| 473 | Message mode. You can also customize the tool bars. This is a new | ||
| 474 | feature 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, |
| 477 | see the variable `gnus-group-update-tool-bar'. Its default value | 197 | see the variable `gnus-group-update-tool-bar'. Its default value |
| 478 | depends on your Emacs version. This is a new feature in Gnus 5.10.9. | 198 | depends 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 | ||
| 485 | The Gnus Agent has seen a major updated and is now enabled by default, | ||
| 486 | and all nntp and nnimap servers from `gnus-select-method' and | ||
| 487 | `gnus-secondary-select-method' are agentized by default. Earlier only | ||
| 488 | the server in `gnus-select-method' was agentized by the default, and the | ||
| 489 | agent was disabled by default. When the agent is enabled, headers are | ||
| 490 | now also retrieved from the Agent cache instead of the back ends when | ||
| 491 | possible. Earlier this only happened in the unplugged state. You can | ||
| 492 | enroll or remove servers with `J a' and `J r' in the server buffer. | ||
| 493 | Gnus will not download articles into the Agent cache, unless you | ||
| 494 | instruct it to do so, though, by using `J u' or `J s' from the Group | ||
| 495 | buffer. You revert to the old behavior of having the Agent disabled | ||
| 496 | with `(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 | |
| 501 | If one reads an article while plugged, and the article already exists in | ||
| 502 | the Agent, it won't get downloaded once more. `(setq gnus-agent-cache | ||
| 503 | nil)' reverts to the old behavior. | ||
| 504 | |||
| 505 | ** Dired integration | ||
| 506 | |||
| 507 | `gnus-dired-minor-mode' (see *Note Other modes::) installs key bindings | ||
| 508 | in dired buffers to send a file as an attachment, open a file using the | ||
| 509 | appropriate 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 |
| 208 | buffer is immediately reflected to the subscription of the groups which | ||
| 209 | use the server in question. For instance, if you change | ||
| 210 | `nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus | ||
| 211 | will connect to the news host by way of the intermediate host | ||
| 212 | `bar.example.com' from next time. | ||
| 514 | 213 | ||
| 515 | A 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 | ||
| 11 | Welcome to Gnus. You need to tell us what you want to do with Gnus | ||
| 12 | before we go on to specific configurations. | ||
| 13 | |||
| 14 | Choose the tasks you want to set up: | ||
| 15 | @variable{backends} | ||
| 16 | |||
| 17 | Choose 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 | ||
| 29 | You are setting up local mail storage, using the nnml backend in Gnus terms. | ||
| 30 | |||
| 31 | Your 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 | ||
| 39 | TODO: this will be a real link. | ||
| 40 | Run 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 | ||
| 10 | Usenet news is usually read from your Internet service prodider's news | ||
| 11 | server. If you don't know the name of this server, contact your ISP. | ||
| 12 | |||
| 13 | As a guess, the name of the server might be news.yourisp.com. | ||
| 14 | |||
| 15 | Server name: @variable{server} | ||
| 16 | Port 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 | ||
| 33 | Some news servers require that you enter a user name and a password. | ||
| 34 | It doesn't look like your news server is one of them. | ||
| 35 | |||
| 36 | Do 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 | |||
| 51 | It looks like your news server requires you to enter a user name | ||
| 52 | and a password: | ||
| 53 | |||
| 54 | User name: @variable{user-name} | ||
| 55 | Password: @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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 */ | ||
| 2 | static 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 @@ | |||
| 1 | 2007-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 | |||
| 6 | 2007-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 | |||
| 11 | 2007-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 | |||
| 58 | 2007-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 | |||
| 1 | 2007-10-23 Richard Stallman <rms@gnu.org> | 96 | 2007-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 | |||
| 109 | 2007-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 | |||
| 10 | 2007-10-20 Reiner Steib <Reiner.Steib@gmx.de> | 116 | 2007-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 | ||
| 27 | 2007-10-15 Katsumi Yamaoka <yamaoka@jpl.org> | 133 | 2007-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 | ||
| 138 | 2007-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 | |||
| 143 | 2007-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 | |||
| 32 | 2007-10-04 Juanma Barranquero <lekktu@gmail.com> | 151 | 2007-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 @@ | |||
| 48 | 2007-10-08 Reiner Steib <Reiner.Steib@gmx.de> | 167 | 2007-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 | |||
| 172 | 2007-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 | |||
| 180 | 2007-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 | ||
| 52 | 2007-10-04 Reiner Steib <Reiner.Steib@gmx.de> | 186 | 2007-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 | ||
| 190 | 2007-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 | |||
| 203 | 2007-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 | |||
| 56 | 2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org> | 214 | 2007-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 | |||
| 248 | 2007-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 | |||
| 254 | 2007-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 | |||
| 261 | 2007-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 | |||
| 87 | 2007-09-05 Katsumi Yamaoka <yamaoka@jpl.org> | 267 | 2007-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 | ||
| 273 | 2007-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 | |||
| 287 | 2007-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 | |||
| 93 | 2007-08-23 Katsumi Yamaoka <yamaoka@jpl.org> | 303 | 2007-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 | ||
| 111 | 2007-08-17 Katsumi Yamaoka <yamaoka@jpl.org> | 328 | 2007-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 | ||
| 352 | 2007-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 | |||
| 362 | 2007-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 | |||
| 369 | 2007-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 | |||
| 127 | 2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org> | 380 | 2007-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 | ||
| 386 | 2007-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 | |||
| 133 | 2007-08-06 Katsumi Yamaoka <yamaoka@jpl.org> | 394 | 2007-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 | |||
| 137 | 2007-08-04 Reiner Steib <Reiner.Steib@gmx.de> | 402 | 2007-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 | ||
| 406 | 2007-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 | |||
| 411 | 2007-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 | |||
| 421 | 2007-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 | |||
| 441 | 2007-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 | |||
| 447 | 2007-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 | |||
| 141 | 2007-08-08 Glenn Morris <rgm@gnu.org> | 464 | 2007-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 | ||
| 151 | 2007-07-24 Katsumi Yamaoka <yamaoka@jpl.org> | 474 | 2007-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 | ||
| 160 | 2007-07-21 Reiner Steib <Reiner.Steib@gmx.de> | 479 | 2007-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 | ||
| 484 | 2007-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 | |||
| 493 | 2007-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 | |||
| 552 | 2007-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 | |||
| 564 | 2007-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 | |||
| 165 | 2007-07-16 Katsumi Yamaoka <yamaoka@jpl.org> | 593 | 2007-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 | ||
| 174 | 2007-07-13 Katsumi Yamaoka <yamaoka@jpl.org> | 602 | 2007-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 | |||
| 651 | 2007-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 | ||
| 673 | 2007-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 | |||
| 193 | 2007-07-04 Katsumi Yamaoka <yamaoka@jpl.org> | 685 | 2007-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 | ||
| 694 | 2007-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 | |||
| 202 | 2007-06-26 Katsumi Yamaoka <yamaoka@jpl.org> | 699 | 2007-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 | |||
| 707 | 2007-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 | |||
| 714 | 2007-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 | |||
| 723 | 2007-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 | ||
| 208 | 2007-06-14 Katsumi Yamaoka <yamaoka@jpl.org> | 728 | 2007-06-14 Katsumi Yamaoka <yamaoka@jpl.org> |
| 209 | 729 | ||
| @@ -218,14 +738,26 @@ | |||
| 218 | 738 | ||
| 219 | 2007-06-08 Katsumi Yamaoka <yamaoka@jpl.org> | 739 | 2007-06-08 Katsumi Yamaoka <yamaoka@jpl.org> |
| 220 | 740 | ||
| 741 | * gnus-ems.el (gnus-x-splash): Fix calculation; error in tty. | ||
| 742 | |||
| 743 | 2007-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 | 750 | 2007-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 | ||
| 230 | 2007-06-07 Juanma Barranquero <lekktu@gmail.com> | 762 | 2007-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 | |||
| 783 | 2007-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 | |||
| 791 | 2007-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 | ||
| 250 | 2007-05-28 Katsumi Yamaoka <yamaoka@jpl.org> | 797 | 2007-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 | ||
| 802 | 2007-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 | |||
| 807 | 2007-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 | |||
| 822 | 2007-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 | |||
| 255 | 2007-05-24 Katsumi Yamaoka <yamaoka@jpl.org> | 827 | 2007-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 | ||
| 832 | 2007-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 | |||
| 837 | 2007-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 | |||
| 843 | 2007-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 | |||
| 854 | 2007-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 | |||
| 260 | 2007-05-10 Reiner Steib <Reiner.Steib@gmx.de> | 860 | 2007-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 | ||
| 265 | 2007-05-09 Didier Verna <didier@xemacs.org> | 865 | 2007-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 | |||
| 880 | 2007-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 | |||
| 885 | 2007-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 | |||
| 891 | 2007-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 | |||
| 897 | 2007-05-02 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 898 | |||
| 899 | * gnus.el: Bump version number. | ||
| 900 | |||
| 901 | 2007-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". | 905 | 2007-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no> |
| 906 | |||
| 907 | * gnus.el: No Gnus v0.6 is released. | ||
| 908 | |||
| 909 | 2007-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 | |||
| 917 | 2007-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 | |||
| 922 | 2007-04-25 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 923 | |||
| 924 | * mm-util.el (mm-charset-synonym-alist): Defcustom. | ||
| 925 | |||
| 926 | 2007-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 | |||
| 930 | 2007-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 | |||
| 939 | 2007-04-24 Didier Verna <didier@xemacs.org> | ||
| 940 | |||
| 941 | * gnus-sum.el: | ||
| 942 | * gnus-utils.el: Fix some trailing whitespaces. | ||
| 943 | |||
| 944 | 2007-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 | |||
| 952 | 2007-04-20 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 953 | |||
| 954 | * gnus-msg.el (gnus-summary-supersede-article): Add Gcc header. | ||
| 270 | 955 | ||
| 271 | 2007-04-19 Katsumi Yamaoka <yamaoka@jpl.org> | 956 | 2007-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 | ||
| 967 | 2007-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 | |||
| 972 | 2007-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 | |||
| 977 | 2007-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 | |||
| 983 | 2007-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 | |||
| 283 | 2007-04-10 Katsumi Yamaoka <yamaoka@jpl.org> | 991 | 2007-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 | ||
| 303 | 2007-03-31 Reiner Steib <Reiner.Steib@gmx.de> | 1011 | 2007-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 | ||
| 313 | 2007-03-27 Thien-Thi Nguyen <ttn@gnu.org> | 1024 | 2007-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 | |||
| 1029 | 2007-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 | |||
| 1034 | 2007-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 | |||
| 1041 | 2007-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 | ||
| 318 | 2007-03-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1058 | 2007-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 | ||
| 324 | 2007-03-24 Reiner Steib <Reiner.Steib@gmx.de> | 1064 | 2007-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 | ||
| 329 | 2007-03-20 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1070 | 2007-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 | ||
| 1094 | 2007-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 | |||
| 1100 | 2007-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 | |||
| 1108 | 2007-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 | |||
| 1114 | 2007-02-24 John Paul Wallington <jpw@pobox.com> | ||
| 1115 | |||
| 1116 | * tls.el (tls-certtool-program): Fix custom type. | ||
| 1117 | |||
| 1118 | 2007-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 | |||
| 1125 | 2007-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 | |||
| 353 | 2007-02-28 Katsumi Yamaoka <yamaoka@jpl.org> | 1131 | 2007-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 | ||
| 1138 | 2007-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 | |||
| 360 | 2007-02-27 Katsumi Yamaoka <yamaoka@jpl.org> | 1146 | 2007-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 | ||
| 1152 | 2007-02-20 Daiki Ueno <ueno@unixuser.org> | ||
| 1153 | |||
| 1154 | * mml2015.el (mml2015-epg-verify): Simplified. | ||
| 1155 | |||
| 1156 | 2007-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 | |||
| 1163 | 2007-02-19 Daiki Ueno <ueno@unixuser.org> | ||
| 1164 | |||
| 1165 | * mml2015.el (mml2015-epg-verify): Convert LF to CRLF before signature | ||
| 1166 | verification. | ||
| 1167 | |||
| 366 | 2007-02-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1168 | 2007-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 | ||
| 1177 | 2007-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 | |||
| 1182 | 2007-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 | |||
| 1192 | 2007-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 | |||
| 1200 | 2007-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 | |||
| 1208 | 2007-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 | |||
| 375 | 2007-02-01 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1228 | 2007-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 | ||
| 1254 | 2007-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 | |||
| 401 | 2007-01-19 Reiner Steib <Reiner.Steib@gmx.de> | 1261 | 2007-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 | ||
| 1266 | 2007-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 | |||
| 1275 | 2007-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 | |||
| 406 | 2007-01-12 Kenichi Handa <handa@m17n.org> | 1280 | 2007-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 | ||
| 411 | 2007-01-14 Reiner Steib <Reiner.Steib@gmx.de> | 1285 | 2007-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 | ||
| 415 | 2007-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 | |||
| 1308 | 2007-01-13 Romain Francoise <romain@orebokech.com> | ||
| 1309 | |||
| 1310 | * nnml.el (nnml-use-compressed-files): Fix typo in docstring. | ||
| 1311 | Update copyright. | ||
| 418 | 1312 | ||
| 419 | 2007-01-05 Reiner Steib <Reiner.Steib@gmx.de> | 1313 | 2007-01-13 Patric Mueller <bhaak@bigfoot.com> (tiny change) |
| 1314 | |||
| 1315 | * gnus-sum.el (gnus-summary-reparent-children): Fix typo in doc string. | ||
| 1316 | |||
| 1317 | 2007-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 | |||
| 1322 | 2007-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 | |||
| 1327 | 2006-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 | |||
| 1334 | 2007-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 | ||
| 424 | 2007-01-03 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1339 | 2007-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 | ||
| 431 | 2006-01-03 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1346 | 2007-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 | ||
| 436 | 2006-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org> | 1350 | 2007-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 | ||
| 442 | 2007-01-02 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1357 | 2007-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 | ||
| 1365 | 2007-01-01 Romain Francoise <romain@orebokech.com> | ||
| 1366 | |||
| 1367 | * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo. | ||
| 1368 | |||
| 1369 | 2006-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 | |||
| 1382 | 2006-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 | |||
| 450 | 2006-12-30 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1391 | 2006-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 | |||
| 1400 | 2006-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 | ||
| 455 | 2006-12-29 Jouni K. Sepp,Ad(Bnen <jks@iki.fi> | 1408 | 2006-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 | |||
| 465 | 2006-12-28 Daiki Ueno <ueno@unixuser.org> | 1429 | 2006-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 | ||
| 470 | 2006-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) | 1437 | 2006-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 | |||
| 1459 | 2006-12-26 Oliver Scholz <epameinondas@gmx.de> | ||
| 1460 | |||
| 1461 | * gnus-cite.el: Enable highlighting of different citation levels in | ||
| 1462 | message-mode. | ||
| 475 | 1463 | ||
| 476 | 2006-12-26 Reiner Steib <Reiner.Steib@gmx.de> | 1464 | 2006-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 | ||
| 1493 | 2006-12-21 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | ||
| 1494 | |||
| 1495 | * message.el (message-generate-hashcash): Fix custom type. | ||
| 1496 | |||
| 1497 | 2006-12-20 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 1498 | |||
| 1499 | * gnus-sum.el (gnus-summary-recenter): Remove debug messages. | ||
| 1500 | |||
| 505 | 2006-12-20 Reiner Steib <Reiner.Steib@gmx.de> | 1501 | 2006-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 | ||
| 1506 | 2006-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 | |||
| 1511 | 2006-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 | |||
| 1517 | 2006-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 | |||
| 1524 | 2006-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 | |||
| 510 | 2006-12-13 Reiner Steib <Reiner.Steib@gmx.de> | 1529 | 2006-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 | ||
| 1537 | 2006-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 | |||
| 518 | 2006-12-08 Chong Yidong <cyd@stupidchicken.com> | 1546 | 2006-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 | ||
| 1565 | 2006-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 | |||
| 1574 | 2006-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 | |||
| 537 | 2006-11-30 Katsumi Yamaoka <yamaoka@jpl.org> | 1579 | 2006-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 | ||
| 542 | 2006-11-29 Katsumi Yamaoka <yamaoka@jpl.org> | 1587 | 2006-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 | |||
| 547 | 2006-11-24 Juanma Barranquero <lekktu@gmail.com> | 1594 | 2006-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 | ||
| 1610 | 2006-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 | |||
| 1616 | 2006-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 1617 | |||
| 1618 | * dns.el (query-dns): Protect against "Process dns deleted" strings. | ||
| 1619 | |||
| 563 | 2006-11-21 Katsumi Yamaoka <yamaoka@jpl.org> | 1620 | 2006-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 | ||
| 1624 | 2006-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 | |||
| 567 | 2006-11-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1630 | 2006-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 | ||
| 1653 | 2006-11-14 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 1654 | |||
| 1655 | * spam.el: Revert to 7.82 (removed changes since 2006-10-16). | ||
| 1656 | |||
| 1657 | 2006-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 | |||
| 590 | 2006-11-14 Katsumi Yamaoka <yamaoka@jpl.org> | 1662 | 2006-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 | ||
| 1670 | 2006-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 | |||
| 1675 | 2006-11-14 Daiki Ueno <ueno@p360> | ||
| 1676 | |||
| 1677 | * mml2015.el: Autoload epa-select-keys when compiling. | ||
| 1678 | |||
| 1679 | 2006-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 | |||
| 1685 | 2006-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 | |||
| 1693 | 2006-11-10 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 1694 | |||
| 1695 | * nntp.el (nntp-authinfo-force): New variable. | ||
| 1696 | (nntp-send-authinfo): Use it. | ||
| 1697 | |||
| 598 | 2006-11-09 Reiner Steib <Reiner.Steib@gmx.de> | 1698 | 2006-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 | ||
| 609 | 2006-11-08 Wolfgang Jenkner <wjenkner@inode.at> (tiny change) | 1704 | 2006-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 | ||
| 1710 | 2006-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 | |||
| 1716 | 2006-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 | |||
| 615 | 2006-11-03 Juanma Barranquero <lekktu@gmail.com> | 1723 | 2006-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 | ||
| 1758 | 2006-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 | |||
| 650 | 2006-10-26 Reiner Steib <Reiner.Steib@gmx.de> | 1764 | 2006-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 | ||
| 1772 | 2006-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 | |||
| 1782 | 2006-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 | |||
| 1788 | 2006-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 | |||
| 658 | 2006-10-20 Katsumi Yamaoka <yamaoka@jpl.org> | 1793 | 2006-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 | ||
| 665 | 2006-10-19 Katsumi Yamaoka <yamaoka@jpl.org> | 1800 | 2006-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 | |||
| 1813 | 2006-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 | |||
| 1819 | 2006-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 | ||
| 669 | 2006-10-19 Reiner Steib <Reiner.Steib@gmx.de> | 1825 | 2006-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 | ||
| 674 | 2006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1829 | 2006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> |
| 675 | 1830 | ||
| @@ -693,36 +1848,50 @@ | |||
| 693 | 1848 | ||
| 694 | 2006-10-04 Reiner Steib <Reiner.Steib@gmx.de> | 1849 | 2006-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 | ||
| 699 | 2006-10-04 Romain Francoise <romain@orebokech.com> | 1864 | 2006-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 | ||
| 707 | 2006-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. | 1870 | 2006-10-02 Teodor Zlatanov <tzz@lifelogs.com> |
| 710 | (pop3-movemail): Warn about pop3-leave-mail-on-server. | ||
| 711 | 1871 | ||
| 712 | 2006-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. | 1875 | 2006-09-29 Teodor Zlatanov <tzz@lifelogs.com> |
| 715 | 1876 | ||
| 716 | 2006-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 | 1880 | 2006-09-28 Teodor Zlatanov <tzz@lifelogs.com> |
| 719 | doc string. Improve doc string. | ||
| 720 | 1881 | ||
| 721 | 2006-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. | 1891 | 2006-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 | ||
| 727 | 2006-09-28 Reiner Steib <Reiner.Steib@gmx.de> | 1896 | 2006-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 | ||
| 1905 | 2006-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 | |||
| 1910 | 2006-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 | |||
| 736 | 2006-09-25 Chong Yidong <cyd@stupidchicken.com> | 1915 | 2006-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 | ||
| 1919 | 2006-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 | |||
| 1924 | 2006-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 | |||
| 1929 | 2006-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 | |||
| 740 | 2006-09-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 1934 | 2006-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 | ||
| 745 | 2006-09-16 Katsumi Yamaoka <yamaoka@jpl.org> | 1939 | 2006-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 | ||
| 1945 | 2006-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 | |||
| 752 | 2006-09-09 Reiner Steib <Reiner.Steib@gmx.de> | 1951 | 2006-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 | ||
| 757 | 2006-09-07 Katsumi Yamaoka <yamaoka@jpl.org> | 1957 | 2006-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 | ||
| 1962 | 2006-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 | |||
| 762 | 2006-09-06 Reiner Steib <Reiner.Steib@gmx.de> | 1969 | 2006-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 | |||
| 1975 | 2006-09-06 Simon Josefsson <jas@extundo.com> | ||
| 1976 | |||
| 1977 | * mml2015.el (mml2015-use): Doc fix, mention epg. | ||
| 1978 | |||
| 1979 | 2006-09-06 Daiki Ueno <ueno@unixuser.org> | ||
| 1980 | |||
| 1981 | * mml2015.el (mml2015-use): Default to epg, if available. | ||
| 1982 | |||
| 1983 | 2006-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 | ||
| 767 | 2006-09-04 Chong Yidong <cyd@stupidchicken.com> | 1992 | 2006-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 | ||
| 1997 | 2006-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 | |||
| 772 | 2006-09-04 Katsumi Yamaoka <yamaoka@jpl.org> | 2002 | 2006-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 | ||
| 813 | 2006-08-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 2043 | 2006-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. | 2052 | 2006-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 | ||
| 824 | 2006-08-13 Romain Francoise <romain@orebokech.com> | 2074 | 2006-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 | ||
| 2102 | 2006-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 | |||
| 852 | 2006-07-27 Katsumi Yamaoka <yamaoka@jpl.org> | 2128 | 2006-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 | ||
| 2133 | 2006-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 | |||
| 2154 | 2006-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 | |||
| 857 | 2006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 2162 | 2006-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 | ||
| 2169 | 2006-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 | |||
| 864 | 2006-07-18 Karl Fogel <kfogel@red-bean.com> | 2174 | 2006-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 | ||
| 870 | 2006-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 | |||
| 883 | 2006-07-17 Reiner Steib <Reiner.Steib@gmx.de> | 2180 | 2006-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 | ||
| 2193 | 2006-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 | |||
| 2199 | 2006-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 | |||
| 2210 | 2006-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 | |||
| 2216 | 2006-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 | |||
| 896 | 2006-06-26 Reiner Steib <Reiner.Steib@gmx.de> | 2221 | 2006-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 | ||
| 901 | 2006-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 | |||
| 2231 | 2006-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 | |||
| 2236 | 2006-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 | |||
| 2246 | 2006-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 | |||
| 2256 | 2006-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 | |||
| 2266 | 2006-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 | |||
| 2273 | 2006-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 | ||
| 906 | 2006-06-20 Katsumi Yamaoka <yamaoka@jpl.org> | 2278 | 2006-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 | ||
| 2282 | 2006-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 | |||
| 2289 | 2006-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 | |||
| 2306 | 2006-06-19 Bastien Guerry <bzg@altern.org> | ||
| 2307 | |||
| 2308 | * gnus-bookmark.el: New file. | ||
| 2309 | |||
| 910 | 2006-06-19 Katsumi Yamaoka <yamaoka@jpl.org> | 2310 | 2006-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 | ||
| 2314 | 2006-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 | |||
| 914 | 2006-06-16 Katsumi Yamaoka <yamaoka@jpl.org> | 2320 | 2006-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 | ||
| 2331 | 2006-06-11 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 2332 | |||
| 2333 | * gnus-art.el (gnus-article-toggle-truncate-lines): Fix code. | ||
| 2334 | |||
| 2335 | 2006-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 | |||
| 925 | 2006-06-06 Katsumi Yamaoka <yamaoka@jpl.org> | 2340 | 2006-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 | ||
| 930 | 2006-06-05 Dan Christensen <jdc@uwo.ca> | 2345 | 2006-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 | 2349 | 2006-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 | |||
| 2356 | 2006-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 | |||
| 2364 | 2006-05-30 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2365 | |||
| 2366 | * gnus-agent.el (directory-files-and-attributes): Move forward. | ||
| 937 | 2367 | ||
| 938 | 2006-05-29 Reiner Steib <Reiner.Steib@gmx.de> | 2368 | 2006-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 | ||
| 2379 | 2006-05-29 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 2380 | |||
| 2381 | * gnus-art.el (gnus-article-toggle-truncate-lines): Fix typo in | ||
| 2382 | comment. | ||
| 2383 | |||
| 949 | 2006-05-29 Kevin Greiner <kevin.greiner@compsol.cc> | 2384 | 2006-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 | ||
| 959 | 2006-05-29 Katsumi Yamaoka <yamaoka@jpl.org> | 2398 | 2006-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 | |||
| 2412 | 2006-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 | |||
| 2432 | 2006-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 | |||
| 2452 | 2006-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 | ||
| 990 | 2006-05-26 Reiner Steib <Reiner.Steib@gmx.de> | 2481 | 2006-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 | ||
| 994 | 2006-05-26 Katsumi Yamaoka <yamaoka@jpl.org> | 2485 | 2006-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 | ||
| 999 | 2006-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 | 2505 | 2006-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. | 2509 | 2006-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 | |||
| 2515 | 2006-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 | |||
| 2523 | 2006-05-23 Hynek Schlawack <hynek@ularx.de> | ||
| 2524 | |||
| 2525 | * gnus-sum.el (gnus-summary-mime-map): Add | ||
| 2526 | gnus-article-browse-html-article. | ||
| 2527 | 2006-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 | |||
| 2532 | 2006-05-22 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 2533 | |||
| 2534 | * mail-source.el (mail-sources): Fix custom type. | ||
| 1007 | 2535 | ||
| 1008 | 2006-05-18 Reiner Steib <Reiner.Steib@gmx.de> | 2536 | 2006-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 | ||
| 2546 | 2006-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 | |||
| 2559 | 2006-05-16 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2560 | |||
| 2561 | * gnus-art.el (easy-menu-define): Use :active instead of :enable. | ||
| 2562 | |||
| 2563 | 2006-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 | |||
| 2576 | 2006-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 | |||
| 1018 | 2006-05-04 Stefan Monnier <monnier@iro.umontreal.ca> | 2581 | 2006-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 | ||
| 2588 | 2006-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 | ||
| 1030 | 2006-05-04 Reiner Steib <Reiner.Steib@gmx.de> | 2595 | 2006-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 | |||
| 2607 | 2006-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2608 | |||
| 2609 | * gnus.el (gnus-version-number): Bump version. | ||
| 2610 | |||
| 2611 | 2006-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no> | ||
| 2612 | |||
| 2613 | * gnus.el: No Gnus v0.5 is released. | ||
| 2614 | |||
| 2615 | 2006-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 | |||
| 2620 | 2006-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 | |||
| 2641 | 2006-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 | ||
| 1037 | 2006-04-28 Katsumi Yamaoka <yamaoka@jpl.org> | 2646 | 2006-04-28 Katsumi Yamaoka <yamaoka@jpl.org> |
| 1038 | 2647 | ||
| @@ -1050,26 +2659,34 @@ | |||
| 1050 | 2659 | ||
| 1051 | 2006-04-26 Reiner Steib <Reiner.Steib@gmx.de> | 2660 | 2006-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 | ||
| 1074 | 2006-04-26 Katsumi Yamaoka <yamaoka@jpl.org> | 2691 | 2006-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 | ||
| 1086 | 2006-04-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | ||
| 1087 | |||
| 1088 | * nnweb.el (nnweb-google-wash-article): Sync up to new Google HTML. | ||
| 1089 | |||
| 1090 | 2006-04-25 Katsumi Yamaoka <yamaoka@jpl.org> | 2703 | 2006-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 | ||
| 2716 | 2006-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 | |||
| 2721 | 2006-04-23 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2722 | |||
| 2723 | * mail-source.el (mail-source-call-script): Message the error | ||
| 2724 | string. | ||
| 2725 | |||
| 2726 | 2006-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2727 | |||
| 2728 | * gnus-util.el (gnus-byte-compile): Use it. | ||
| 2729 | |||
| 2730 | 2006-04-22 xyblor <fake@invalid.email> (Tiny change.) | ||
| 2731 | |||
| 2732 | * gnus-util.el (kill-empty-logs): New function. | ||
| 2733 | |||
| 2734 | 2006-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 | |||
| 2747 | 2006-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 | |||
| 2752 | 2006-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 | |||
| 1101 | 2006-04-20 Reiner Steib <Reiner.Steib@gmx.de> | 2757 | 2006-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 | ||
| 1106 | 2006-04-20 Katsumi Yamaoka <yamaoka@jpl.org> | 2762 | 2006-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 | ||
| 2768 | 2006-04-19 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2769 | |||
| 2770 | * mm-view.el (mm-inline-text): Use equal instead of equalp. | ||
| 2771 | |||
| 2772 | 2006-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 | |||
| 2777 | 2006-04-18 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 2778 | |||
| 2779 | * message.el (message-generate-hashcash): Honor custom type. | ||
| 2780 | |||
| 2781 | 2006-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 | |||
| 2793 | 2006-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 | |||
| 2799 | 2006-04-18 Simon Josefsson <jas@extundo.com> | ||
| 2800 | |||
| 2801 | * message.el (message-generate-hashcash): Default to. | ||
| 2802 | |||
| 2803 | 2006-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 | |||
| 1116 | 2006-04-17 Reiner Steib <Reiner.Steib@gmx.de> | 2808 | 2006-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): | 2815 | 2006-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) | 2831 | 2006-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 | |||
| 2836 | 2006-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 | |||
| 2842 | 2006-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 | |||
| 2847 | 2006-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 | |||
| 2856 | 2006-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 | |||
| 2880 | 2006-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 | |||
| 2886 | 2006-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 | |||
| 2893 | 2006-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 | |||
| 2902 | 2006-04-15 NAKAJI Hiroyuki <nakaji@takamatsu-nct.ac.jp> (tiny change) | ||
| 2903 | |||
| 2904 | * smiley.el (smiley-style): Fix typo. | ||
| 2905 | |||
| 2906 | 2006-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 | |||
| 2911 | 2006-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 | |||
| 2918 | 2006-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 | |||
| 2941 | 2006-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 | |||
| 2968 | 2006-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 | |||
| 2978 | 2006-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 | |||
| 2986 | 2006-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 | |||
| 2998 | 2006-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 | |||
| 3007 | 2006-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 | ||
| 1155 | 2006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de> | 3032 | 2006-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 | ||
| 1160 | 2006-04-12 Reiner Steib <Reiner.Steib@gmx.de> | 3037 | 2006-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): | 3042 | 2006-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 | ||
| 1165 | 2006-04-12 Katsumi Yamaoka <yamaoka@jpl.org> | 3050 | 2006-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 | ||
| 1179 | 2006-04-11 Reiner Steib <Reiner.Steib@gmx.de> | 3070 | 2006-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 | ||
| 1183 | 2006-04-11 Arne J,Ax(Brgensen <arne@arnested.dk> | 3081 | 2006-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 | ||
| 3086 | 2006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 3087 | |||
| 3088 | * gnus.el (gnus-version-number): Bump version. | ||
| 3089 | |||
| 1188 | 2006-04-11 Reiner Steib <Reiner.Steib@gmx.de> | 3090 | 2006-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 | ||
| 1192 | 2006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | 3094 | 2006-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 | ||
| 1204 | 2006-04-06 Reiner Steib <Reiner.Steib@gmx.de> | 3108 | 2006-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 | ||
| 3112 | 2006-04-06 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 3113 | |||
| 3114 | * gnus-fun.el (gnus-face-properties-alist): Add :version. | ||
| 3115 | |||
| 3116 | 2006-04-05 Daiki Ueno <ueno@unixuser.org> | ||
| 3117 | |||
| 3118 | * pgg-gpg.el (pgg-gpg-process-filter): Fix. | ||
| 3119 | |||
| 3120 | 2006-04-05 Simon Josefsson <jas@extundo.com> | ||
| 3121 | |||
| 3122 | * password.el (password-reset): New function. | ||
| 3123 | |||
| 3124 | 2006-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 | |||
| 1208 | 2006-04-04 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 3129 | 2006-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 | ||
| 3135 | 2006-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 | |||
| 3143 | 2006-04-04 Daiki Ueno <ueno@unixuser.org> | ||
| 3144 | |||
| 3145 | * pgg-gpg.el: Clean up process buffers every time gpg processes | ||
| 3146 | complete. | ||
| 3147 | |||
| 3148 | 2006-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 | |||
| 3153 | 2006-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 | |||
| 1214 | 2006-03-31 Reiner Steib <Reiner.Steib@gmx.de> | 3161 | 2006-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 | ||
| 3165 | 2006-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 | |||
| 3174 | 2006-03-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 3175 | |||
| 3176 | * message.el (message-tool-bar-gnome): Move "spell". | ||
| 3177 | |||
| 3178 | 2006-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 | |||
| 3184 | 2006-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 | |||
| 3190 | 2006-03-26 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | ||
| 3191 | |||
| 3192 | * message.el (message-resend): Bind message-generate-hashcash to nil. | ||
| 3193 | |||
| 3194 | 2006-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 | |||
| 3199 | 2006-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 | |||
| 1218 | 2006-03-23 Katsumi Yamaoka <yamaoka@jpl.org> | 3207 | 2006-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 | ||
| 1226 | 2006-03-22 Katsumi Yamaoka <yamaoka@jpl.org> | 3215 | 2006-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 | ||
| 1231 | 2006-03-23 Kenichi Handa <handa@m17n.org> | 3221 | 2006-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 | ||
| 1236 | 2006-03-23 Kenichi Handa <handa@m17n.org> | 3227 | 2006-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 | ||
| 1243 | 2006-03-21 Daniel Pittman <daniel@rimspace.net> | 3232 | 2006-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 | ||
| 1248 | 2006-03-21 Reiner Steib <Reiner.Steib@gmx.de> | 3241 | 2006-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): | 3246 | 2006-03-21 Simon Josefsson <jas@extundo.com> |
| 1253 | Add comment on version. | ||
| 1254 | 3247 | ||
| 1255 | 2006-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. | 3258 | 2006-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 | ||
| 1261 | 2006-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 | ||
| 1265 | 2006-03-20 Reiner Steib <Reiner.Steib@gmx.de> | 3265 | 2006-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 | ||
| 3284 | 2006-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 | |||
| 3290 | 2006-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 | |||
| 1284 | 2006-03-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 3304 | 2006-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 | ||
| 3311 | 2006-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 | |||
| 1291 | 2006-03-14 Simon Josefsson <jas@extundo.com> | 3316 | 2006-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 | |||
| 1337 | 2006-03-08 Katsumi Yamaoka <yamaoka@jpl.org> | 3366 | 2006-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 | ||
| 3371 | 2006-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 | |||
| 3383 | 2006-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 | |||
| 1342 | 2006-03-06 Katsumi Yamaoka <yamaoka@jpl.org> | 3407 | 2006-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 | ||
| 3413 | 2006-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 | |||
| 3418 | 2006-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 | |||
| 1348 | 2006-03-03 Reiner Steib <Reiner.Steib@gmx.de> | 3426 | 2006-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 | ||
| 3441 | 2006-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 | |||
| 3453 | 2006-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 | |||
| 3460 | 2006-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 | |||
| 1363 | 2006-03-02 Katsumi Yamaoka <yamaoka@jpl.org> | 3474 | 2006-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 | ||
| 3479 | 2006-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 | |||
| 3506 | 2006-03-01 Michael Piotrowski <mxp@dynalabs.de> (tiny change) | ||
| 3507 | |||
| 3508 | * gnus-art.el (gnus-button): Add missing parentheses. | ||
| 3509 | |||
| 1368 | 2006-02-28 Katsumi Yamaoka <yamaoka@jpl.org> | 3510 | 2006-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 | ||
| 1372 | 2006-02-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | 3514 | 2006-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 | ||
| 1376 | 2006-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 | ||
| 1381 | 2006-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 | ||
| 1390 | 2006-02-28 Reiner Steib <Reiner.Steib@gmx.de> | 3539 | 2006-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 | ||
| 1398 | 2006-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | 3545 | 2006-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 | |||
| 3550 | 2006-02-24 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> | ||
| 3551 | |||
| 3552 | * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M. | ||
| 3553 | |||
| 3554 | 2006-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 | ||
| 1403 | 2006-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org> | 3558 | 2006-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 | ||
| 1408 | 2006-02-27 Reiner Steib <Reiner.Steib@gmx.de> | 3562 | 2006-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 | ||
| 1413 | 2006-02-24 Simon Josefsson <jas@extundo.com> | 3567 | 2006-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 | ||
| 1418 | 2006-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org> | 3576 | 2006-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 | ||
| 1425 | 2006-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 | ||
| 1442 | 2006-02-23 Ralf Angeli <angeli@iwi.uni-sb.de> | 3605 | 2006-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 | |||
| 3610 | 2006-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 | |||
| 3621 | 2006-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 | |||
| 3632 | 2006-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 | |||
| 3659 | 2006-02-21 Milan Zamazal <pdm@brailcom.org> | ||
| 3660 | |||
| 3661 | * mm-view.el (mm-view-pkcs7-verify): Implement using smime.el. | ||
| 1446 | 3662 | ||
| 1447 | 2006-02-21 Wolfram Fenske <wolfram.fenske@student.uni-magdeburg.de> (tiny change) | 3663 | 2006-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 | ||
| 3668 | 2006-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 | |||
| 1452 | 2006-02-20 Katsumi Yamaoka <yamaoka@jpl.org> | 3677 | 2006-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 | ||
| 3709 | 2006-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 | |||
| 1483 | 2006-02-15 Katsumi Yamaoka <yamaoka@jpl.org> | 3714 | 2006-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 | |||
| 3718 | 2006-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 | |||
| 3725 | 2006-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 | ||
| 3745 | 2006-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 | |||
| 3752 | 2006-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 | |||
| 1500 | 2006-02-13 Katsumi Yamaoka <yamaoka@jpl.org> | 3757 | 2006-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 | ||
| 1505 | 2006-02-10 Reiner Steib <Reiner.Steib@gmx.de> | 3762 | 2006-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 | ||
| 3776 | 2006-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 | |||
| 1509 | 2006-02-09 Daiki Ueno <ueno@unixuser.org> | 3782 | 2006-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 | ||
| 1584 | 2006-02-03 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 1585 | |||
| 1586 | * gnus-util.el (gnus-error): Describe `args'. | ||
| 1587 | |||
| 1588 | 2006-02-03 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de> | 3857 | 2006-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 | ||
| 1618 | 2006-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 | |||
| 1627 | 2006-01-31 Katsumi Yamaoka <yamaoka@jpl.org> | 3887 | 2006-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 | |||
| 1632 | 2006-01-31 Kevin Ryde <user42@zip.com.au> | 3894 | 2006-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 | ||
| 3901 | 2006-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 | |||
| 1639 | 2006-01-30 Reiner Steib <Reiner.Steib@gmx.de> | 3910 | 2006-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 | ||
| 3920 | 2006-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 | |||
| 1649 | 2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org> | 3938 | 2006-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 | ||
| 3943 | 2006-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 | |||
| 3948 | 2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 3949 | |||
| 3950 | * gmm-utils.el (gmm-verbose): Add :group. | ||
| 3951 | |||
| 3952 | 2006-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 | |||
| 1654 | 2006-01-25 Katsumi Yamaoka <yamaoka@jpl.org> | 3971 | 2006-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 | ||
| 3984 | 2006-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 | |||
| 1667 | 2006-01-24 Katsumi Yamaoka <yamaoka@jpl.org> | 3991 | 2006-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 | ||
| 1672 | 2006-01-24 Katsumi Yamaoka <yamaoka@jpl.org> | 4007 | 2006-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 | ||
| 4017 | 2006-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 | |||
| 4032 | 2006-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 | |||
| 1682 | 2006-01-23 Katsumi Yamaoka <yamaoka@jpl.org> | 4041 | 2006-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 | ||
| 1687 | 2006-01-20 Reiner Steib <Reiner.Steib@gmx.de> | 4046 | 2006-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 | |||
| 4064 | 2006-01-20 Per Abrahamsen <abraham@dina.kvl.dk> | ||
| 4065 | |||
| 4066 | * gmm-utils.el (gmm-widget-p): New function. | ||
| 4067 | |||
| 4068 | 2006-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 | ||
| 1692 | 2006-01-19 Reiner Steib <Reiner.Steib@gmx.de> | 4073 | 2006-01-20 Richard M. Stallman <rms@gnu.org> |
| 4074 | |||
| 4075 | * mm-url.el (mm-url-load-url): Require url-parse and url-vars. | ||
| 4076 | |||
| 4077 | 2006-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 | 4081 | 2006-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 | |||
| 4086 | 2005-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 | |||
| 4092 | 2005-01-20 Chong Yidong <cyd@stupidchicken.com> | ||
| 4093 | |||
| 4094 | * message.el (message-insert-citation-line): Use newlines. | ||
| 1698 | 4095 | ||
| 1699 | 2006-01-19 Katsumi Yamaoka <yamaoka@jpl.org> | 4096 | 2006-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 | ||
| 4102 | 2006-01-19 Mark D. Baushke <mdb@gnu.org> | ||
| 4103 | |||
| 4104 | * pgg-gpg.el (pgg-gpg-encrypt-region): Add --textmode to gpg args. | ||
| 4105 | |||
| 1705 | 2006-01-17 Katsumi Yamaoka <yamaoka@jpl.org> | 4106 | 2006-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 | ||
| 1734 | 2006-01-16 Katsumi Yamaoka <yamaoka@jpl.org> | 4132 | 2006-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 | ||
| 1748 | 2006-01-13 Katsumi Yamaoka <yamaoka@jpl.org> | 4138 | 2006-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 | ||
| 4150 | 2006-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 | |||
| 1760 | 2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org> | 4155 | 2006-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 | ||
| 4192 | 2005-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 | |||
| 1797 | 2005-12-21 Katsumi Yamaoka <yamaoka@jpl.org> | 4198 | 2005-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 | ||
| 1808 | 2005-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 | |||
| 1818 | 2005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change) | 4209 | 2005-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 | ||
| 1823 | 2005-12-18 Lars Magne Ingebrigtsen <larsi@gnus.org> | 4214 | 2005-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 | |||
| 4220 | 2005-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 | ||
| 1828 | 2006-01-08 Chong Yidong <cyd@stupidchicken.com> | 4225 | 2005-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 | ||
| 1835 | 2005-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 | ||
| 4244 | 2005-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 | |||
| 4250 | 2005-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 | |||
| 1846 | 2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> | 4260 | 2005-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 | ||
| 4269 | 2005-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 | |||
| 4274 | 2005-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 | |||
| 4279 | 2005-12-12 Simon Josefsson <jas@extundo.com> | ||
| 4280 | |||
| 4281 | * password.el (password-read-from-cache): Add. | ||
| 4282 | (password-read): Use it. | ||
| 4283 | |||
| 1855 | 2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org> | 4284 | 2005-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 | ||
| 1863 | 2005-12-09 Reiner Steib <Reiner.Steib@gmx.de> | 4292 | 2005-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 | |||
| 1868 | 2005-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 | ||
| 1880 | 2005-12-09 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) | 4298 | 2005-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 | ||
| 1884 | 2005-12-12 Richard M. Stallman <rms@gnu.org> | ||
| 1885 | |||
| 1886 | * mm-url.el (mm-url-load-url): Require url-parse and url-vars. | ||
| 1887 | |||
| 1888 | 2005-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 | |||
| 1893 | 2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org> | 4302 | 2005-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 | ||
| 1902 | 2005-12-06 Reiner Steib <Reiner.Steib@gmx.de> | 4311 | 2005-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 | ||
| 1907 | 2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change) | 4321 | 2005-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 | ||
| 1912 | 2005-11-29 Reiner Steib <Reiner.Steib@gmx.de> | 4326 | 2005-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 | |||
| 4339 | 2005-11-25 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 4340 | |||
| 4341 | * message.el (message-kill-to-signature): Fix interactive spec. | ||
| 4342 | |||
| 4343 | 2005-11-24 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 4344 | |||
| 4345 | * pop3.el (pop3-open-server): Recognize a string as a service name. | ||
| 1920 | 4346 | ||
| 1921 | 2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change) | 4347 | 2005-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 | ||
| 4351 | 2005-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 | |||
| 1925 | 2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org> | 4365 | 2005-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 | ||
| 4375 | 2005-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 | |||
| 4381 | 2005-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 | |||
| 4393 | 2005-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 4394 | |||
| 4395 | * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil. | ||
| 4396 | |||
| 1935 | 2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny change) | 4397 | 2005-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 | ||
| 1939 | 2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc> | 4401 | 2005-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 | ||
| 1977 | 2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org> | 4409 | 2005-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 | ||
| 4414 | 2005-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 | |||
| 1982 | 2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org> | 4421 | 2005-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 | ||
| 4425 | 2005-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 | |||
| 1986 | 2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org> | 4434 | 2005-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 | ||
| 1992 | 2005-11-04 Ken Manheimer <ken.manheimer@gmail.com> | 4440 | 2005-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) | 4452 | 2005-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 | 4457 | 2005-10-30 Chong Yidong <cyd@stupidchicken.com> |
| 2010 | function. | ||
| 2011 | 4458 | ||
| 2012 | 2005-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. | 4462 | 2005-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 | 4472 | 2005-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 | 4481 | 2005-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 | |||
| 2048 | 2005-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 | |||
| 2072 | 2005-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 | ||
| 2084 | 2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca> | 4486 | 2005-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 | ||
| 4532 | 2005-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 | |||
| 4540 | 2005-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 | |||
| 4546 | 2005-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 | |||
| 2130 | 2005-11-01 Katsumi Yamaoka <yamaoka@jpl.org> | 4553 | 2005-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 | ||
| 2141 | 2005-10-31 Katsumi Yamaoka <yamaoka@jpl.org> | 4564 | 2005-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 | |||
| 4570 | 2005-10-29 Romain Francoise <romain@orebokech.com> | ||
| 4571 | |||
| 4572 | * message.el (message-fix-before-sending): Fix comment. | ||
| 4573 | |||
| 4574 | 2005-10-29 Jari Aalto <jari.aalto@cante.net> | ||
| 4575 | |||
| 4576 | * gnus-sum.el (gnus-article-sort-by-date-reverse): New function. | ||
| 4577 | |||
| 4578 | 2005-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 | |||
| 4583 | 2005-10-28 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 4584 | |||
| 4585 | * mm-util.el (mm-codepage-setup): Remove bogus alias test. | ||
| 2144 | 4586 | ||
| 2145 | 2005-10-27 Reiner Steib <Reiner.Steib@gmx.de> | 4587 | 2005-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 | ||
| 4601 | 2005-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 | |||
| 4610 | 2005-10-26 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 4611 | |||
| 4612 | * mm-uu.el (mm-uu-hide-markers): Fix XEmacs case. | ||
| 4613 | |||
| 4614 | 2005-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 | |||
| 2159 | 2005-10-26 Katsumi Yamaoka <yamaoka@jpl.org> | 4619 | 2005-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 | ||
| 2189 | 2005-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 | ||
| 2194 | 2005-10-23 Simon Josefsson <jas@extundo.com> | 4665 | 2005-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 | ||
| 4671 | 2005-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 | |||
| 2200 | 2005-10-20 Hiroshi Fujishima <hiroshi.fujishima@gmail.com> (tiny change) | 4677 | 2005-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 | |||
| 2217 | 2005-10-19 Katsumi Yamaoka <yamaoka@jpl.org> | 4697 | 2005-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 | ||
| 2250 | 2005-10-09 Daniel Brockman <daniel@brockman.se> | 4730 | 2005-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 | ||
| 2254 | 2005-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 | ||
| 2258 | 2005-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 | ||
| 2263 | 2005-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 | |||
| 4759 | 2005-10-09 Daniel Brockman <daniel@brockman.se> | ||
| 2266 | 4760 | ||
| 2267 | 2005-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 | 4763 | 2005-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 | |||
| 4767 | 2005-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 | ||
| 2272 | 2005-10-04 David Hansen <david.hansen@gmx.net> | 4777 | 2005-10-04 David Hansen <david.hansen@gmx.net> |
| 2273 | 4778 | ||
| @@ -2276,6 +4781,13 @@ | |||
| 2276 | 4781 | ||
| 2277 | 2005-10-04 Reiner Steib <Reiner.Steib@gmx.de> | 4782 | 2005-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 | |||
| 4811 | 2005-10-04 Josh Huber <huber@alum.wpi.edu> | ||
| 4812 | |||
| 4813 | * message.el (message-make-expires-date): New function. | ||
| 4814 | |||
| 4815 | 2005-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 | |||
| 2293 | 2005-10-02 Katsumi Yamaoka <yamaoka@jpl.org> | 4821 | 2005-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 | ||
| 4833 | 2005-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 | |||
| 2305 | 2005-09-28 Reiner Steib <Reiner.Steib@gmx.de> | 4840 | 2005-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 | ||
| 2309 | 2005-09-28 Simon Josefsson <jas@extundo.com> | 4847 | 2005-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 | |||
| 2327 | 2005-09-27 Simon Josefsson <jas@extundo.com> | 4877 | 2005-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 | |||
| 4955 | 2005-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 | |||
| 4966 | 2005-09-19 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 4967 | |||
| 4968 | * mm-url.el (mm-url-decode-entities): Fix regexp. | ||
| 4969 | |||
| 2387 | 2005-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org> | 4970 | 2005-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 | ||
| 4977 | 2005-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 | |||
| 2394 | 2005-09-19 Reiner Steib <Reiner.Steib@gmx.de> | 4986 | 2005-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 | |||
| 4997 | 2005-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 | ||
| 2398 | 2005-09-18 Deepak Goel <deego@gnufans.org> | 5011 | 2005-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 | ||
| 5020 | 2005-09-15 Romain Francoise <romain@orebokech.com> | ||
| 5021 | |||
| 5022 | * message.el (message-fill-paragraph): Clarify docstring. | ||
| 5023 | |||
| 2407 | 2005-09-14 Katsumi Yamaoka <yamaoka@jpl.org> | 5024 | 2005-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 | ||
| 5034 | 2005-09-11 Jari Aalto <jari.aalto@cante.net> | ||
| 5035 | |||
| 5036 | * html2text.el: (html2text-replace-list): Add new entities. | ||
| 5037 | |||
| 5038 | 2005-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 | |||
| 5054 | 2005-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 | |||
| 2417 | 2005-09-10 Reiner Steib <Reiner.Steib@gmx.de> | 5059 | 2005-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 | ||
| 2438 | 2005-09-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org> | 5083 | 2005-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 | ||
| 2443 | 2005-09-06 Reiner Steib <Reiner.Steib@gmx.de> | 5088 | 2005-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 | ||
| 5108 | 2005-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 | |||
| 2463 | 2005-09-04 Reiner Steib <Reiner.Steib@gmx.de> | 5118 | 2005-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 | 5132 | 2005-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 | 5137 | 2005-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 | ||
| 2483 | 2005-09-02 Hrvoje Niksic <hniksic@xemacs.org> | 5144 | 2005-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 | ||
| 2492 | 2005-09-02 Katsumi Yamaoka <yamaoka@jpl.org> | 5153 | 2005-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 | 5158 | 2005-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 | |||
| 5165 | 2005-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 | |||
| 5170 | 2005-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 | ||
| 2499 | 2005-08-29 Romain Francoise <romain@orebokech.com> | 5182 | 2005-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 | ||
| 5188 | 2005-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 | |||
| 2505 | 2005-08-31 Juanma Barranquero <lekktu@gmail.com> | 5201 | 2005-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 | ||
| 5247 | 2005-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 | |||
| 5253 | 2005-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 | |||
| 2551 | 2005-08-08 Simon Josefsson <jas@extundo.com> | 5259 | 2005-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 | ||
| 5265 | 2005-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 | |||
| 5271 | 2005-08-06 Romain Francoise <romain@orebokech.com> | ||
| 5272 | |||
| 5273 | * message.el (message-user-fqdn): Fix typo in docstring. | ||
| 5274 | |||
| 2557 | 2005-08-05 Daiki Ueno <ueno@unixuser.org> | 5275 | 2005-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 | ||
| 2563 | 2005-08-06 Romain Francoise <romain@orebokech.com> | ||
| 2564 | |||
| 2565 | * message.el: Fix typo in docstring. | ||
| 2566 | |||
| 2567 | 2005-08-05 Katsumi Yamaoka <yamaoka@jpl.org> | 5281 | 2005-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 | ||
| 2575 | 2005-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 | |||
| 2581 | 2005-08-04 Reiner Steib <Reiner.Steib@gmx.de> | 5289 | 2005-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 | |||
| 2593 | 2005-08-02 Katsumi Yamaoka <yamaoka@jpl.org> | 5298 | 2005-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 | ||
| 2664 | 2005-07-21 Stefan Monnier <monnier@iro.umontreal.ca> | 5368 | 2005-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. | 5376 | 2005-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 | |||
| 5382 | 2005-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 | ||
| 2671 | 2005-07-16 Romain Francoise <romain@orebokech.com> | 5387 | 2005-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 | |||
| 5400 | 2005-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 | ||
| 2677 | 2005-07-16 Lars Magne Ingebrigtsen <larsi@gnus.org> | 5407 | 2005-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 | ||
| 5422 | 2005-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 | |||
| 5428 | 2005-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 | |||
| 2692 | 2005-07-13 Katsumi Yamaoka <yamaoka@jpl.org> | 5434 | 2005-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 @@ | |||
| 2730 | 2005-06-30 Katsumi Yamaoka <yamaoka@jpl.org> | 5472 | 2005-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 | ||
| 2735 | 2005-06-29 Didier Verna <didier@xemacs.org> | 5477 | 2005-06-29 Didier Verna <didier@xemacs.org> |
| 2736 | 5478 | ||
| @@ -2740,13 +5482,22 @@ | |||
| 2740 | 2005-06-29 Katsumi Yamaoka <yamaoka@jpl.org> | 5482 | 2005-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 | ||
| 5496 | 2005-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 | |||
| 2750 | 2005-06-24 Juanma Barranquero <lekktu@gmail.com> | 5501 | 2005-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 | ||
| 5524 | 2005-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 | |||
| 2773 | 2005-06-16 Miles Bader <miles@gnu.org> | 5529 | 2005-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 | ||
| 5670 | 2005-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 | |||
| 2909 | 2005-06-04 Luc Teirlinck <teirllm@auburn.edu> | 5675 | 2005-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 | ||
| 5688 | 2005-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 | |||
| 5695 | 2005-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 | |||
| 2922 | 2005-05-31 Katsumi Yamaoka <yamaoka@jpl.org> | 5700 | 2005-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 | ||
| 2957 | 2005-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, | 5739 | 2005-05-31 Ulf Stegemann <ulf@zeitform.de> (tiny change) |
| 2960 | instead of hard coding to nil. | ||
| 2961 | 5740 | ||
| 2962 | 2005-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 | 5744 | 2005-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 | ||
| 2967 | 2005-05-30 Reiner Steib <Reiner.Steib@gmx.de> | 5751 | 2005-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 | ||
| 5924 | 2005-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 | |||
| 3125 | 2005-05-26 Lute Kamstra <lute@gnu.org> | 5935 | 2005-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. | 5954 | 2005-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 | |||
| 5958 | 2005-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 5959 | |||
| 5960 | * gnus.el (gnus-version-number): Bump version. | ||
| 5961 | |||
| 5962 | 2005-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no> | ||
| 5963 | |||
| 5964 | * gnus.el: No Gnus v0.3 is released. | ||
| 3142 | 5965 | ||
| 3143 | 2005-04-28 Katsumi Yamaoka <yamaoka@jpl.org> | 5966 | 2005-04-28 Katsumi Yamaoka <yamaoka@jpl.org> |
| 3144 | 5967 | ||
| 5968 | * gnus-art.el (gnus-article-edit-part): Disable undo. | ||
| 5969 | |||
| 5970 | 2005-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 | |||
| 5978 | 2005-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 | ||
| 3150 | 2005-04-28 David Hansen <david.hansen@physik.fu-berlin.de> | 5985 | 2005-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 | ||
| 3155 | 2005-04-24 Teodor Zlatanov <tzz@lifelogs.com> | 5990 | 2005-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 | ||
| 3164 | 2005-04-24 Reiner Steib <Reiner.Steib@gmx.de> | 5995 | 2005-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' | 6000 | 2005-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. | 6004 | 2005-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 | ||
| 3176 | 2005-04-18 Katsumi Yamaoka <yamaoka@jpl.org> | 6009 | 2005-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 | ||
| 6013 | 2005-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 | |||
| 3180 | 2005-04-13 Katsumi Yamaoka <yamaoka@jpl.org> | 6019 | 2005-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 | ||
| 3185 | 2005-04-13 Miles Bader <miles@gnu.org> | ||
| 3186 | |||
| 3187 | * mm-util.el (mm-string-to-multibyte): Use Gnus trunk definition. | ||
| 3188 | |||
| 3189 | 2005-04-12 Katsumi Yamaoka <yamaoka@jpl.org> | 6024 | 2005-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 | ||
| 3194 | 2005-04-11 Lute Kamstra <lute@gnu.org> | 6029 | 2005-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 | ||
| 3200 | 2005-04-10 Stefan Monnier <monnier@iro.umontreal.ca> | 6034 | 2005-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 | ||
| 3205 | 2005-04-11 Katsumi Yamaoka <yamaoka@jpl.org> | 6038 | 2005-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 | ||
| 6042 | 2005-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 | |||
| 6054 | 2005-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 | |||
| 3209 | 2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> | 6068 | 2005-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 | |||
| 3224 | 2005-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 | |||
| 3229 | 2005-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 | ||
| 3234 | 2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org> | 6082 | 2005-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 | |||
| 3295 | 2005-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 | |||
| 3307 | 2005-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 | |||
| 3312 | 2005-04-06 Joakim Verona <joakim@verona.se> (tiny change) | ||
| 3313 | |||
| 3314 | * nnrss.el (nnrss-read-group-data): Fix off-by-one error. | ||
| 3315 | |||
| 3316 | 2005-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 | |||
| 3336 | 2005-04-06 Mark A. Hershberger <mah@everybody.org> | ||
| 3337 | |||
| 3338 | * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions. | ||
| 3339 | 6087 | ||
| 3340 | 2005-04-04 Reiner Steib <Reiner.Steib@gmx.de> | 6088 | 2005-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 | ||
| 3355 | 2005-04-03 Katsumi Yamaoka <yamaoka@jpl.org> | 6101 | 2005-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 | |||
| 3360 | 2005-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 | |||
| 3407 | 2005-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 | |||
| 3417 | 2005-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 | ||
| 3428 | 2005-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 | ||
| 3434 | 2005-03-21 Reiner Steib <Reiner.Steib@gmx.de> | 6109 | 2005-03-21 Reiner Steib <Reiner.Steib@gmx.de> |
| 3435 | 6110 | ||
| @@ -3475,22 +6150,13 @@ | |||
| 3475 | 6150 | ||
| 3476 | 2005-03-13 Andrey Slusar <anrays@gmail.com> (tiny change) | 6151 | 2005-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 | |||
| 3481 | 2005-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. | 6156 | 2005-03-13 Andrey Slusar <anrays@gmail.com> (tiny change) |
| 3490 | |||
| 3491 | 2005-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 | ||
| 3495 | 2005-03-10 Stefan Monnier <monnier@iro.umontreal.ca> | 6161 | 2005-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 | ||
| 6169 | 2005-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 | |||
| 6174 | 2005-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 | |||
| 3503 | 2005-03-08 Bjorn Solberg <bjorn_ding@hekneby.org> (tiny change) | 6180 | 2005-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 | ||
| 6186 | 2005-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 | |||
| 3509 | 2005-03-04 Reiner Steib <Reiner.Steib@gmx.de> | 6208 | 2005-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 | ||
| 6228 | 2005-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 | |||
| 3529 | 2005-03-01 Stefan Monnier <monnier@iro.umontreal.ca> | 6270 | 2005-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 | ||
| 3534 | 2005-02-27 Arne J,Ax(Brgensen <arne@arnested.dk> | 6275 | 2005-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 | |||
| 6280 | 2005-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 | ||
| 3543 | 2005-02-26 Stefan Monnier <monnier@iro.umontreal.ca> | 6289 | 2005-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 | ||
| 3548 | 2005-02-24 Reiner Steib <Reiner.Steib@gmx.de> | 6300 | 2005-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 | ||
| 6313 | 2005-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 | |||
| 3561 | 2005-02-22 Arne J,Ax(Brgensen <arne@arnested.dk> | 6321 | 2005-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 | |||
| 6341 | 2005-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 | |||
| 6346 | 2005-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 | ||
| 3568 | 2005-02-21 Reiner Steib <Reiner.Steib@gmx.de> | 6351 | 2005-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 | ||
| 3588 | 2005-02-16 Teodor Zlatanov <tzz@lifelogs.com> | 6371 | 2005-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 | ||
| 3594 | 2005-02-15 Simon Josefsson <jas@extundo.com> | 6377 | 2005-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 | ||
| 6383 | 2005-02-15 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 6384 | |||
| 6385 | * gnus-art.el: Avoid "Recursive load suspected" error in Emacs 21.1. | ||
| 6386 | |||
| 6387 | 2005-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 | |||
| 6392 | 2005-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 | |||
| 6405 | 2005-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 | |||
| 6416 | 2005-02-13 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 6417 | |||
| 6418 | * gnus-agent.el: Remove garbage made while merging the Emacs trunk. | ||
| 6419 | |||
| 3600 | 2005-02-14 Reiner Steib <Reiner.Steib@gmx.de> | 6420 | 2005-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 | ||
| 6438 | 2005-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 | |||
| 6448 | 2005-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 | |||
| 6453 | 2005-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 | |||
| 3618 | 2005-02-08 Simon Josefsson <jas@extundo.com> | 6474 | 2005-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 | ||
| 6478 | 2005-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 | |||
| 6496 | 2005-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 | |||
| 3622 | 2005-02-03 Katsumi Yamaoka <yamaoka@jpl.org> | 6501 | 2005-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 | ||
| 6506 | 2005-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 | |||
| 6511 | 2005-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 | |||
| 6516 | 2005-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 | |||
| 6523 | 2005-02-01 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 6524 | |||
| 6525 | * nntp.el (nntp-request-update-info): Always return nil. | ||
| 6526 | |||
| 3627 | 2005-01-30 Stefan Monnier <monnier@iro.umontreal.ca> | 6527 | 2005-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 | ||
| 6547 | 2005-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 | |||
| 6552 | 2005-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 | |||
| 3647 | 2005-01-24 Katsumi Yamaoka <yamaoka@jpl.org> | 6573 | 2005-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 | ||
| 6578 | 2005-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 | |||
| 6583 | 2005-01-21 Derek Atkins <warlord@MIT.EDU> (tiny change) | ||
| 6584 | |||
| 6585 | * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache. | ||
| 6586 | |||
| 3652 | 2005-01-20 Katsumi Yamaoka <yamaoka@jpl.org> | 6587 | 2005-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 | |||
| 6597 | 2005-01-17 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 6598 | |||
| 6599 | * gnus-sum.el (gnus-summary-idna-message): Silence byte compiler. | ||
| 6600 | |||
| 6601 | 2005-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 | |||
| 6614 | 2005-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 | |||
| 6624 | 2005-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 | |||
| 6629 | 2005-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 | |||
| 6635 | 2005-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 | |||
| 3659 | 2005-01-05 Reiner Steib <Reiner.Steib@gmx.de> | 6647 | 2005-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 | ||
| 6652 | 2005-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 | |||
| 6657 | 2005-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 | |||
| 6662 | 2004-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 | |||
| 6667 | 2004-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 | |||
| 6675 | 2004-12-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 6676 | |||
| 6677 | * nnrss.el (nnrss-get-encoding): Fix regexp. | ||
| 6678 | |||
| 3664 | 2004-12-27 Simon Josefsson <jas@extundo.com> | 6679 | 2004-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 | ||
| 6691 | 2004-12-26 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp> | ||
| 6692 | |||
| 6693 | * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name. | ||
| 6694 | |||
| 6695 | 2004-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 | |||
| 6725 | 2004-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 | |||
| 6735 | 2004-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 | |||
| 3676 | 2004-12-22 Katsumi Yamaoka <yamaoka@jpl.org> | 6740 | 2004-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 | ||
| 6745 | 2004-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 | |||
| 3681 | 2004-12-21 Katsumi Yamaoka <yamaoka@jpl.org> | 6751 | 2004-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 | |||
| 6759 | 2004-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 | |||
| 6764 | 2004-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 | |||
| 6775 | 2004-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 | |||
| 3687 | 2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org> | 6780 | 2004-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 | ||
| 6798 | 2004-12-16 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 6799 | |||
| 6800 | * gnus-group.el (gnus-group-make-rss-group): Unify non-ASCII group | ||
| 6801 | names. | ||
| 6802 | |||
| 6803 | 2004-12-16 Simon Josefsson <jas@extundo.com> | ||
| 6804 | |||
| 6805 | * hashcash.el (hashcash-payment-alist): Fix custom :type. | ||
| 6806 | |||
| 6807 | 2004-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 | |||
| 6814 | 2004-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 | |||
| 6819 | 2004-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 | |||
| 3705 | 2004-12-08 Stefan Monnier <monnier@iro.umontreal.ca> | 6826 | 2004-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 | ||
| 6839 | 2004-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 | |||
| 6844 | 2004-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 | |||
| 6849 | 2004-11-25 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 6850 | |||
| 6851 | * message.el (message-forbidden-properties): Fixed typo in doc | ||
| 6852 | string. | ||
| 6853 | |||
| 6854 | 2004-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 | |||
| 6861 | 2004-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 | |||
| 6866 | 2004-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 | |||
| 6872 | 2004-12-03 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 6873 | |||
| 6874 | * gnus-sum.el (gnus-summary-limit-to-recipient): Implement | ||
| 6875 | not-matching option. | ||
| 6876 | |||
| 6877 | 2004-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 | |||
| 3718 | 2004-12-02 Katsumi Yamaoka <yamaoka@jpl.org> | 6886 | 2004-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 | ||
| 6896 | 2004-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 | |||
| 6902 | 2004-11-29 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 6903 | |||
| 6904 | * spam.el (spam-summary-prepare-exit): Use gnus-summary-limit | ||
| 6905 | correctly. | ||
| 6906 | |||
| 6907 | 2004-11-28 Carl Henrik Lunde <chlunde+bugs+@ping.uio.no> (tiny change) | ||
| 6908 | |||
| 6909 | * format-spec.el (format-spec): Message the char. | ||
| 6910 | |||
| 6911 | 2004-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 | |||
| 3728 | 2004-11-26 Katsumi Yamaoka <yamaoka@jpl.org> | 6918 | 2004-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 | ||
| 3774 | 2004-11-25 Reiner Steib <Reiner.Steib@gmx.de> | 6962 | 2004-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 | ||
| 3778 | 2004-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): | 6970 | 2004-11-25 Katsumi Yamaoka <yamaoka@jpl.org> |
| 3781 | Bind buffer-read-only (etc) to nil. | ||
| 3782 | 6971 | ||
| 3783 | 2004-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. | 6976 | 2004-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 | |||
| 6982 | 2004-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 | |||
| 6992 | 2004-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 | ||
| 3790 | 2004-11-23 Katsumi Yamaoka <yamaoka@jpl.org> | 6997 | 2004-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 | ||
| 3799 | 2004-11-22 Stefan Monnier <monnier@iro.umontreal.ca> | 7006 | 2004-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 | |||
| 7012 | 2004-11-17 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 7013 | |||
| 7014 | * rfc2047.el (rfc2047-encode-region): Encode bogus delimiters. | ||
| 7015 | |||
| 7016 | 2004-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 | |||
| 7021 | 2004-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 | ||
| 3804 | 2004-11-14 Luc Teirlinck <teirllm@auburn.edu> | 7031 | 2004-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 | ||
| 3810 | 2004-11-14 Reiner Steib <Reiner.Steib@gmx.de> | 7038 | 2004-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 | ||
| 7043 | 2004-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 | |||
| 7048 | 2004-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 | |||
| 7071 | 2004-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 | |||
| 3815 | 2004-11-10 Katsumi Yamaoka <yamaoka@jpl.org> | 7077 | 2004-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 | ||
| 7085 | 2004-11-09 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7086 | |||
| 7087 | * dns.el (query-dns): Resolve reverse addresses. | ||
| 7088 | |||
| 7089 | 2004-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 | |||
| 3823 | 2004-11-07 Katsumi Yamaoka <yamaoka@jpl.org> | 7095 | 2004-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 | ||
| 7101 | 2004-11-07 Stefan Wiens <s.wi@gmx.net> (tiny change) | ||
| 7102 | |||
| 7103 | * gnus-sum.el (gnus-summary-clear-local-variables): Use symbolp. | ||
| 7104 | |||
| 3829 | 2004-11-04 Richard M. Stallman <rms@gnu.org> | 7105 | 2004-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 | ||
| 3841 | 2004-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 | |||
| 3846 | 2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> | 7117 | 2004-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 | |||
| 3870 | 2004-11-01 Reiner Steib <Reiner.Steib@gmx.de> | 7122 | 2004-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 | ||
| 7210 | 2004-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 | |||
| 3958 | 2004-10-29 Katsumi Yamaoka <yamaoka@jpl.org> | 7224 | 2004-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 | ||
| 7245 | 2004-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 | |||
| 7250 | 2004-10-26 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 7251 | |||
| 7252 | * nnimap.el (nnimap-open-connection): Fix prog1/prog2 bug. | ||
| 7253 | |||
| 3979 | 2004-10-26 Katsumi Yamaoka <yamaoka@jpl.org> | 7254 | 2004-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 | |
| 7262 | 2004-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 | |||
| 7267 | 2004-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 | ||
| 3988 | 2004-10-25 Reiner Steib <Reiner.Steib@gmx.de> | 7272 | 2004-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 | ||
| 3993 | 2004-10-24 Kevin Greiner <kevin.greiner@compsol.cc> | 7277 | 2004-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 | ||
| 3998 | 2004-10-21 Katsumi Yamaoka <yamaoka@jpl.org> | 7285 | 2004-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 | ||
| 4003 | 2004-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 | |||
| 4010 | 2004-10-19 Katsumi Yamaoka <yamaoka@jpl.org> | 7290 | 2004-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 | ||
| 4015 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | 7295 | 2004-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 | ||
| 4020 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | 7300 | 2004-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 | ||
| 4028 | 2004-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 | ||
| 4034 | 2004-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 | 7314 | 2004-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): | 7319 | 2004-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 | ||
| 4055 | 2004-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 | ||
| 4061 | 2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> | 7325 | 2004-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 | ||
| 4068 | 2004-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 | ||
| 4082 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | 7346 | 2004-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 | ||
| 4103 | 2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> | 7353 | 2004-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 | ||
| 4107 | 2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> | 7360 | 2004-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 | ||
| 4112 | 2004-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 | ||
| 4117 | 2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org> | 7372 | 2004-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 | ||
| 4122 | 2004-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 | ||
| 4134 | 2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> | 7385 | 2004-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 | ||
| 4138 | 2004-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. | 7395 | 2004-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): | 7400 | 2004-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 | 7406 | 2004-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 | ||
| 4175 | 2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> | 7411 | 2004-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 | ||
| 4180 | 2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org> | 7415 | 2004-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 | ||
| 4185 | 2004-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 | ||
| 4190 | 2004-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 | ||
| 4199 | 2004-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 | 7438 | 2004-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 | 7443 | 2004-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 | ||
| 4219 | 2004-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 | 7447 | 2004-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 | ||
| 4232 | 2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> | 7453 | 2004-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 | 7463 | 2004-10-06 Katsumi Yamaoka <yamaoka@jpl.org> |
| 4242 | the cache, but not the agent, now appear with their usual face. | ||
| 4243 | 7464 | ||
| 4244 | 2004-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 | 7471 | 2004-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 | ||
| 4250 | 2004-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 | 7479 | 2004-10-06 Katsumi Yamaoka <yamaoka@jpl.org> |
| 4253 | uncompressed list. | ||
| 4254 | 7480 | ||
| 4255 | 2004-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 | 7495 | 2004-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 | ||
| 4289 | 2004-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 | 7499 | 2004-10-05 Jesper Harder <harder@ifa.au.dk> |
| 4292 | excessively. | ||
| 4293 | 7500 | ||
| 4294 | 2004-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. | 7526 | 2004-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'. | 7530 | 2004-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 | ||
| 4326 | 2004-10-17 Richard M. Stallman <rms@gnu.org> | 7535 | 2004-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 | ||
| 4339 | 2004-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 | ||
| 4349 | 2004-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 | ||
| 4356 | 2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org> | 7563 | 2004-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 | ||
| 4361 | 2004-10-11 Reiner Steib <Reiner.Steib@gmx.de> | 7568 | 2004-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 | ||
| 4365 | 2004-10-10 Reiner Steib <Reiner.Steib@gmx.de> | 7573 | 2004-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. | 7578 | 2004-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 | 7583 | 2004-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 | ||
| 4388 | 2004-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): | 7594 | 2004-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 | ||
| 4398 | 2004-10-05 Juri Linkov <juri@jurta.org> | 7599 | 2004-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 | ||
| 4406 | 2004-10-01 Katsumi Yamaoka <yamaoka@jpl.org> | 7603 | 2004-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 | ||
| 4411 | 2004-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 | 7611 | 2004-09-28 Teodor Zlatanov <tzz@lifelogs.com> |
| 4414 | acroread. | ||
| 4415 | 7612 | ||
| 4416 | 2004-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. | 7618 | 2004-09-28 Simon Josefsson <jas@extundo.com> |
| 4419 | 7619 | ||
| 4420 | 2004-09-28 Jesper Harder <harder@ifa.au.dk> | 7620 | * hashcash.el (hashcash-generate-payment): Revert. |
| 4421 | 7621 | ||
| 4422 | * gnus-picon.el: Require cl. | 7622 | 2004-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. | 7637 | 2004-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 | ||
| 4441 | 2004-09-27 Reiner Steib <Reiner.Steib@gmx.de> | 7651 | 2004-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 | ||
| 4445 | 2004-09-27 Katsumi Yamaoka <yamaoka@jpl.org> | 7657 | 2004-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 | ||
| 4449 | 2004-09-26 Christian Neukirchen <chneukirchen@yahoo.de> (tiny change) | 7661 | 2004-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 | ||
| 4453 | 2004-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. | 7679 | 2004-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. | 7685 | 2004-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 & and '. | 7705 | 2004-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 | 7711 | 2004-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 | ||
| 4489 | 2004-09-23 Reiner Steib <Reiner.Steib@gmx.de> | 7722 | 2004-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 | |||
| 7730 | 2004-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 | |||
| 7741 | 2004-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 | |||
| 7747 | 2004-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 | |||
| 7752 | 2004-09-20 Simon Josefsson <jas@extundo.com> | ||
| 7753 | |||
| 7754 | * mm-util.el (mm-charset-synonym-alist): Map "unicode" to | ||
| 7755 | "utf-16-le". | ||
| 7756 | |||
| 4494 | 2004-09-20 Stefan Monnier <monnier@iro.umontreal.ca> | 7757 | 2004-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 | ||
| 4498 | 2004-09-20 Reiner Steib <Reiner.Steib@gmx.de> | 7761 | 2004-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 | ||
| 7913 | 2004-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 | |||
| 4650 | 2004-09-13 Simon Josefsson <jas@extundo.com> | 7918 | 2004-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 | |||
| 4654 | 2004-09-13 Reiner Steib <Reiner.Steib@gmx.de> | 7933 | 2004-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 | ||
| 4658 | 2004-09-10 Miles Bader <miles@gnu.ai.mit.edu> | 7937 | 2004-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 | ||
| 4662 | 2004-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 | ||
| 4670 | 2004-09-10 Simon Josefsson <jas@extundo.com> | 7949 | 2004-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 | ||
| 4674 | 2004-09-08 Reiner Steib <Reiner.Steib@gmx.de> | 7956 | 2004-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 | ||
| 4689 | 2004-09-06 Stefan Monnier <monnier@iro.umontreal.ca> | 7971 | 2004-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 | ||
| 7984 | 2004-09-10 Simon Josefsson <jas@extundo.com> | ||
| 7985 | |||
| 7986 | * nndb.el (require): Remove tcp and duplicate cl. | ||
| 7987 | |||
| 7988 | 2004-09-10 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 7989 | |||
| 7990 | * gnus-agent.el (directory-files-and-attributes): Move forward. | ||
| 7991 | |||
| 7992 | 2004-09-09 Kevin Greiner <kgreiner@compsol.cc> | ||
| 7993 | |||
| 7994 | * gnus-agent.el (directory-files-and-attributes): Optionally | ||
| 7995 | defined to support XEmacs. | ||
| 7996 | |||
| 7997 | 2004-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 | |||
| 4702 | 2004-09-03 Katsumi Yamaoka <yamaoka@jpl.org> | 8029 | 2004-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 | ||
| 4706 | 2004-09-03 Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp> (tiny change) | 8034 | 2004-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 | ||
| 4711 | 2004-09-01 Simon Josefsson <jas@extundo.com> | 8038 | 2004-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 | ||
| 8053 | 2004-08-30 Juanma Barranquero <lektu@terra.es> | ||
| 8054 | |||
| 8055 | * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant. | ||
| 8056 | |||
| 8057 | 2004-08-30 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 8058 | |||
| 8059 | * nnimap.el (nnimap-demule): Avoid string-as-multibyte. | ||
| 8060 | |||
| 8061 | 2004-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 | |||
| 8068 | 2004-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 | |||
| 8076 | 2004-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 | |||
| 8104 | 2004-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 | |||
| 8109 | 2004-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 | |||
| 8115 | 2004-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 | |||
| 8124 | 2004-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 | |||
| 8145 | 2004-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 | |||
| 8150 | 2004-08-22 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8151 | |||
| 8152 | * gnus-art.el (article-hide-list-identifiers): Bind | ||
| 8153 | inhibit-read-only as t. | ||
| 8154 | |||
| 8155 | 2004-08-22 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 8156 | |||
| 8157 | * gnus-mlspl.el (gnus-group-split-update): Fix docstring. | ||
| 8158 | |||
| 8159 | 2004-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 | |||
| 8174 | 2004-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 | |||
| 8179 | 2004-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 | |||
| 8195 | 2004-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 | |||
| 8200 | 2004-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 | |||
| 8205 | 2004-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 | |||
| 8212 | 2004-08-17 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 8213 | |||
| 8214 | * nnimap.el (nnimap-open-connection): Add 'imaps' synonym to | ||
| 8215 | 'imap' for netrc parsing. | ||
| 8216 | |||
| 8217 | 2004-08-16 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 8218 | |||
| 8219 | * mailcap.el (mailcap-mime-data): Mark as risky. | ||
| 8220 | |||
| 8221 | 2004-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 | |||
| 8228 | 2004-08-12 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8229 | |||
| 8230 | * rfc2047.el (rfc2047-encode-1, rfc2047-encode): Improve encoding | ||
| 8231 | of text within parentheses. | ||
| 8232 | |||
| 8233 | 2004-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 | |||
| 8240 | 2004-08-06 Simon Josefsson <jas@extundo.com> | ||
| 8241 | |||
| 8242 | * gnus-sum.el (gnus-article-loose-mime): Change default to t. Doc | ||
| 8243 | fix. | ||
| 8244 | |||
| 8245 | 2004-08-05 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8246 | |||
| 8247 | * rfc2047.el (rfc2047-fold-region): Use trailing whitespace as | ||
| 8248 | LWSP. | ||
| 8249 | |||
| 8250 | 2004-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 | |||
| 8265 | 2004-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 | |||
| 8273 | 2004-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 | |||
| 8278 | 2004-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 | |||
| 8283 | 2004-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 | |||
| 8288 | 2004-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 | |||
| 8294 | 2004-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 | |||
| 8299 | 2004-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 | |||
| 8310 | 2004-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 | |||
| 8319 | 2004-07-16 Jesper Harder <harder@ifa.au.dk> | ||
| 8320 | |||
| 8321 | * message.el (message-clone-locals): Clone sendmail and smtp | ||
| 8322 | variables. | ||
| 8323 | |||
| 8324 | 2004-07-12 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8325 | |||
| 8326 | * rfc2047.el (rfc2047-encode-region): Fix last change. | ||
| 8327 | |||
| 8328 | 2004-07-12 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8329 | |||
| 8330 | * rfc2047.el (rfc2047-encode-region): Treat backslash-quoted | ||
| 8331 | characters as non-special. | ||
| 8332 | |||
| 8333 | 2004-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 | |||
| 8340 | 2004-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 | |||
| 8350 | 2004-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 | |||
| 8357 | 2004-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 | |||
| 8365 | 2004-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 | |||
| 8370 | 2004-07-02 Joakim Verona <joakim@verona.se> (tiny change) | ||
| 8371 | |||
| 8372 | * nnrss.el (nnrss-read-group-data): Fix off-by-one error. | ||
| 8373 | |||
| 8374 | 2004-06-30 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 8375 | |||
| 8376 | * gnus-registry.el (gnus-registry-trim): Don't allow a negative | ||
| 8377 | trim value. | ||
| 8378 | |||
| 8379 | 2004-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 | |||
| 8385 | 2004-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 | |||
| 8390 | 2004-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 | |||
| 8395 | 2004-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 | |||
| 8400 | 2004-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 | |||
| 8411 | 2004-06-28 Jesper Harder <harder@ifa.au.dk> | ||
| 8412 | |||
| 8413 | * nnheader.el (nnheader-max-head-length): Increase to 8192. | ||
| 8414 | |||
| 8415 | 2004-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 | |||
| 8429 | 2004-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 | |||
| 8436 | 2004-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 | |||
| 8444 | 2004-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 | |||
| 8449 | 2004-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 | |||
| 8455 | 2004-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 | |||
| 8460 | 2004-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 | |||
| 8533 | 2004-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 | |||
| 8539 | 2004-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 | |||
| 8550 | 2004-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 | |||
| 8565 | 2004-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 | |||
| 8571 | 2004-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 | |||
| 8576 | 2004-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 | |||
| 8587 | 2004-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 | |||
| 8592 | 2004-06-12 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 8593 | |||
| 8594 | * message.el (message-ignored-supersedes-headers): Add Approved. | ||
| 8595 | |||
| 8596 | 2004-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 | |||
| 8602 | 2004-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 | |||
| 8608 | 2004-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 | |||
| 8616 | 2004-06-09 Jesper Harder <harder@ifa.au.dk> | ||
| 8617 | |||
| 8618 | * message.el (message-send-mail-with-sendmail): Use with-current-buffer. | ||
| 8619 | |||
| 8620 | 2004-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 | |||
| 8629 | 2004-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 | |||
| 8635 | 2004-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 | |||
| 8640 | 2004-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 | |||
| 8654 | 2004-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 | |||
| 8660 | 2004-06-04 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 8661 | |||
| 8662 | * message.el (message-cite-original): Respect X-No-Archive. | ||
| 8663 | |||
| 8664 | 2004-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 | |||
| 8670 | 2004-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 | |||
| 8679 | 2004-06-02 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 8680 | |||
| 8681 | * mail-source.el (mail-source-directory): Fix doc-string. | ||
| 8682 | |||
| 8683 | 2004-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 | |||
| 8689 | 2004-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 | |||
| 8698 | 2004-05-28 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8699 | |||
| 8700 | * mm-encode.el (mm-safer-encoding): Consider 7bit is safe. | ||
| 8701 | |||
| 8702 | 2004-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 | |||
| 8715 | 2004-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 | |||
| 8720 | 2004-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 | |||
| 8734 | 2004-05-27 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8735 | |||
| 8736 | * rfc2047.el (rfc2047-encode-region): Encode encoded words in | ||
| 8737 | structured fields. | ||
| 8738 | |||
| 8739 | 2004-05-26 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 8740 | |||
| 8741 | * message.el (message-resend): Bind rfc2047-encode-encoded-words. | ||
| 8742 | |||
| 8743 | 2004-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 | |||
| 8750 | 2004-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 | |||
| 8754 | 2004-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 | |||
| 8760 | 2004-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 | |||
| 8765 | 2004-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 | |||
| 8796 | 2004-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 | |||
| 8803 | 2004-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 | |||
| 8808 | 2004-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 | |||
| 8830 | 2004-05-23 Paul Stodghill <stodghil@cs.cornell.edu> | ||
| 8831 | |||
| 8832 | * gnus-util.el (gnus-set-file-modes): New function. (small | ||
| 8833 | patch). | ||
| 8834 | |||
| 8835 | 2004-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 | |||
| 8844 | 2004-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 | |||
| 8849 | 2004-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 | |||
| 8855 | 2004-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 | |||
| 8861 | 2004-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 | |||
| 8868 | 2004-05-20 Magnus Henoch <mange@freemail.hu> | ||
| 8869 | |||
| 8870 | * dns.el (dns-read-type): Add support for SVR. (small patch) | ||
| 8871 | |||
| 8872 | 2004-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 | |||
| 8907 | 2004-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 | |||
| 8916 | 2004-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 | |||
| 8938 | 2004-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 | |||
| 8944 | 2004-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 | |||
| 4726 | 2004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org> | 8949 | 2004-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 | |||
| 8961 | 2004-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 | |||
| 8981 | 2004-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 | |||
| 8986 | 2004-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 | |||
| 8991 | 2004-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 | |||
| 9004 | 2004-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 9005 | |||
| 9006 | * gnus-art.el (gnus-button-alist): Revert previous change. | ||
| 9007 | |||
| 9008 | 2004-05-18 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 9009 | |||
| 9010 | * message.el (message-idna-to-ascii-rhs-1): Fix typo. | ||
| 9011 | |||
| 9012 | 2004-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 | |||
| 9019 | 2004-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 | |||
| 9025 | 2004-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 | |||
| 9032 | 2004-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 | |||
| 9040 | 2004-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 | |||
| 9046 | 2004-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 | |||
| 9051 | 2004-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 | |||
| 9088 | 2004-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 | |||
| 9096 | 2004-05-16 Kim Minh Kaplan <kmkaplan-AwwS6Bc0PDVoiYX5Tdu9fQ@public.gmane.org> | ||
| 9097 | |||
| 9098 | * imap.el (imap-sasl-make-mechanisms): Use sasl. | ||
| 9099 | |||
| 9100 | 2004-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 | |||
| 9114 | 2004-05-15 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 9115 | |||
| 9116 | * spam.el (spam-summary-prepare-exit): Fixed (length). | ||
| 9117 | |||
| 9118 | 2004-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 | |||
| 9124 | 2004-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 | |||
| 9129 | 2004-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 | |||
| 9136 | 2004-05-14 Kai Grossjohann <kai@emptydomain.de> | ||
| 9137 | |||
| 9138 | * nntp.el (nntp-save-marks): Pass missing arg. | ||
| 9139 | |||
| 9140 | 2004-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 | |||
| 9150 | 2004-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 | |||
| 9160 | 2004-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 | |||
| 9166 | 2004-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 | |||
| 9172 | 2004-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 | |||
| 9178 | 2004-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 | |||
| 9183 | 2004-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 9184 | |||
| 9185 | * gnus.el (gnus-version-number): Bump. | ||
| 9186 | |||
| 9187 | 2004-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no> | ||
| 9188 | |||
| 9189 | * gnus.el: No Gnus v0.2 is released. | ||
| 9190 | |||
| 9191 | 2004-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 9192 | |||
| 9193 | * gnus-agent.el (gnus-agent-read-agentview): Inline | ||
| 9194 | gnus-uncompress-range. | ||
| 9195 | |||
| 9196 | 2004-05-01 TSUCHIYA Masatoshi <tsuchiya@namazu.org> | ||
| 9197 | |||
| 9198 | * spam.el (spam-bsfilter-path): Use `executable-find' instead of | ||
| 9199 | `exec-installed-p'. | ||
| 9200 | |||
| 9201 | 2004-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 | |||
| 9229 | 2004-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 | |||
| 9236 | 2004-04-28 Jesper Harder <harder@ifa.au.dk> | ||
| 9237 | |||
| 9238 | * html2text.el (html2text-replace-list): Add & and '. | ||
| 9239 | (html2text-get-attr): Rewrite. | ||
| 9240 | |||
| 9241 | * message.el (message-setup-1): Remove redundant put-text-property | ||
| 9242 | on mail-header-separator. | ||
| 9243 | |||
| 9244 | 2004-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 | |||
| 9257 | 2004-04-26 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 9258 | |||
| 9259 | * gnus-ems.el: Autoload appt-select-lowest-window (revert | ||
| 9260 | 2004-03-04 change). | ||
| 9261 | |||
| 9262 | 2004-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 | |||
| 9311 | 2004-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 | |||
| 9333 | 2004-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 | |||
| 9338 | 2004-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 | |||
| 9348 | 2004-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 | |||
| 9358 | 2004-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 | |||
| 9366 | 2004-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 | |||
| 9374 | 2004-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 | |||
| 9380 | 2004-04-15 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 9381 | |||
| 9382 | * nnmail.el (nnmail-cache-insert): Revert last change. | ||
| 9383 | |||
| 9384 | 2004-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 | ||
| 4730 | 2004-05-19 Michael Schierl <schierlm-usenet@gmx.de> (tiny change) | 9389 | 2004-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 | |||
| 9401 | 2004-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 | |||
| 9407 | 2004-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 | |||
| 9419 | 2004-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 | |||
| 9424 | 2004-04-08 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 9425 | |||
| 9426 | * gnus-start.el (gnus-get-unread-articles): Fix last commit. | ||
| 9427 | |||
| 9428 | 2004-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 | |||
| 9512 | 2004-04-07 Christian Neukirchen <chneukirchen@yahoo.de> (tiny change) | ||
| 9513 | |||
| 9514 | * mm-util.el (mm-image-load-path): Handle nil in load-path. | ||
| 9515 | |||
| 9516 | 2004-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 | |||
| 9521 | 2004-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 | |||
| 9526 | 2004-04-03 Jesper Harder <harder@ifa.au.dk> | ||
| 9527 | |||
| 9528 | * gnus.el (gnus-getenv-nntpserver): Strip whitespace. | ||
| 9529 | |||
| 9530 | 2004-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 | |||
| 9536 | 2004-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 | |||
| 9542 | 2004-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 | |||
| 9548 | 2004-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 | |||
| 9554 | 2004-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 | |||
| 9559 | 2004-03-24 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 9560 | |||
| 9561 | * nndoc.el (nndoc-forward-type-p): Recognize envelope From_. | ||
| 9562 | |||
| 9563 | 2004-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 | |||
| 9580 | 2004-03-18 Helmut Waitzmann <Helmut.Waitzmann@web.de> (tiny change) | ||
| 9581 | |||
| 9582 | * gnus-sum.el (gnus-newsgroup-variables): Doc fix. | ||
| 9583 | |||
| 9584 | 2004-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 | |||
| 9592 | 2004-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 | |||
| 9612 | 2004-03-19 Steve Youngs <sryoungs@bigpond.net.au> | ||
| 9613 | |||
| 9614 | * dns.el: Don't require gnus-xmas. | ||
| 9615 | |||
| 9616 | 2004-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 | |||
| 9622 | 2004-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 | |||
| 9627 | 2004-03-15 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 9628 | |||
| 9629 | * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to | ||
| 9630 | error. | ||
| 9631 | |||
| 9632 | 2004-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 | |||
| 9638 | 2004-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 | |||
| 9643 | 2004-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 | |||
| 9649 | 2004-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 | |||
| 9653 | 2004-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 | |||
| 9661 | 2004-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 | |||
| 9670 | 2004-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 | |||
| 9677 | 2004-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 | |||
| 9700 | 2004-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 | ||
| 4735 | 2004-03-05 Jesper Harder <harder@ifa.au.dk> | 9706 | 2004-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 | |||
| 9714 | 2004-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 | |||
| 9722 | 2004-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 | |||
| 9727 | 2004-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 | |||
| 9742 | 2004-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 | |||
| 4739 | 2004-03-04 Katsumi Yamaoka <yamaoka@jpl.org> | 9749 | 2004-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 | |||
| 9787 | 2004-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 | |||
| 9796 | 2004-03-04 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 9797 | |||
| 9798 | * rfc2047.el (rfc2047-encoded-word-regexp): Mismatched paren. | ||
| 9799 | |||
| 9800 | 2004-03-04 Jesper Harder <harder@ifa.au.dk> | ||
| 9801 | |||
| 9802 | * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231 | ||
| 9803 | language tags. | ||
| 9804 | |||
| 9805 | 2004-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 | |||
| 9815 | 2004-03-03 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 9816 | |||
| 9817 | * gnus-cus.el (gnus-agent-customize-category): Mismatched paren. | ||
| 9818 | |||
| 9819 | 2004-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 | |||
| 9835 | 2004-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 | |||
| 9842 | 2004-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 | |||
| 9849 | 2004-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 | |||
| 9864 | 2004-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 | |||
| 9875 | 2004-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 | |||
| 9884 | 2004-02-26 Jesper Harder <harder@ifa.au.dk> | ||
| 9885 | |||
| 9886 | * flow-fill.el: Typo. | ||
| 9887 | |||
| 9888 | 2004-02-26 Andrew Cohen <cohen@andy.bu.edu> | ||
| 9889 | |||
| 9890 | * spam-wash.el: New file. | ||
| 9891 | |||
| 9892 | 2004-02-26 Mark A. Hershberger <mah@everybody.org> | ||
| 9893 | |||
| 9894 | * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions. | ||
| 9895 | |||
| 9896 | 2004-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 | |||
| 9903 | 2004-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 | |||
| 9912 | 2004-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 | |||
| 9917 | 2004-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 | |||
| 9922 | 2004-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 | |||
| 9930 | 2004-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 | |||
| 9937 | 2004-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 | |||
| 9945 | 2004-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 | |||
| 9952 | 2004-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 | |||
| 9976 | 2004-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 | |||
| 9985 | 2004-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 | |||
| 9995 | 2004-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 | |||
| 10005 | 2004-02-10 Jesper Harder <harder@ifa.au.dk> | ||
| 10006 | |||
| 10007 | * nnrss.el (nnrss-read-group-data): Initialize nnrss-group-hashtb | ||
| 10008 | if necessary. | ||
| 10009 | |||
| 10010 | 2004-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 | |||
| 10021 | 2004-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 | |||
| 10037 | 2004-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 | |||
| 10047 | 2004-02-07 Jesper Harder <harder@ifa.au.dk> | ||
| 10048 | |||
| 10049 | * mml.el (mml-compute-boundary-1): Don't uncompress files. | ||
| 10050 | |||
| 10051 | 2004-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 | |||
| 10064 | 2004-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 | |||
| 10070 | 2004-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 | |||
| 10077 | 2004-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 | |||
| 10096 | 2004-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 | |||
| 10113 | 2004-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 | |||
| 10124 | 2004-02-03 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 10125 | |||
| 10126 | * spam.el (spam-list-of-processors): Fix spamassassin variable names. | ||
| 10127 | |||
| 10128 | 2004-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 | |||
| 10143 | 2004-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 | |||
| 10148 | 2004-01-31 Jesper Harder <harder@ifa.au.dk> | ||
| 10149 | |||
| 10150 | * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid | ||
| 10151 | padding. | ||
| 10152 | |||
| 10153 | 2004-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 | |||
| 10158 | 2004-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 | |||
| 10163 | 2004-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 | |||
| 10175 | 2004-01-27 Jerry James <james@xemacs.org> (tiny change) | ||
| 10176 | |||
| 10177 | * gnus-spec.el (gnus-parse-simple-format): Fix setq value | ||
| 10178 | omission. | ||
| 10179 | |||
| 10180 | 2004-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 | |||
| 10185 | 2004-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 | |||
| 10195 | 2004-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 | |||
| 10200 | 2004-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 | |||
| 10205 | 2004-01-23 Paul Jarc <prj@po.cwru.edu> | ||
| 10206 | |||
| 10207 | * nnmaildir.el (nnmaildir-request-set-mark): Handle the "too many | ||
| 10208 | links" error. | ||
| 10209 | |||
| 10210 | 2004-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 | |||
| 10225 | 2004-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 | |||
| 10231 | 2004-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 | |||
| 10241 | 2004-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com> | ||
| 10242 | |||
| 10243 | * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the | ||
| 10244 | uncompressed list. | ||
| 10245 | |||
| 10246 | 2004-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 | |||
| 10254 | 2004-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 | |||
| 10326 | 2004-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 | |||
| 10334 | 2004-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 | |||
| 10355 | 2004-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 | |||
| 10366 | 2004-01-20 Nevin Kapur <nkapur@cs.caltech.edu> | ||
| 10367 | |||
| 10368 | * gnus-registry.el (gnus-registry-split-fancy-with-parent): | ||
| 10369 | Suppress unnecessary messages. | ||
| 10370 | |||
| 10371 | 2004-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 | |||
| 4743 | 2004-01-19 Katsumi Yamaoka <yamaoka@jpl.org> | 10376 | 2004-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 | ||
| 10380 | 2004-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 | |||
| 10385 | 2004-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 | |||
| 10390 | 2004-01-16 Steve Youngs <sryoungs@bigpond.net.au> | ||
| 10391 | |||
| 10392 | * gnus.el: Autoload `message-y-or-n-p'. | ||
| 10393 | |||
| 10394 | 2004-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 | |||
| 10408 | 2004-01-15 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 10409 | |||
| 10410 | * gnus-sum.el (gnus-pick-line-number): Add autoload. | ||
| 10411 | |||
| 10412 | 2004-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 | |||
| 10421 | 2004-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 | |||
| 10426 | 2004-01-14 Kai Grossjohann <kai@emptydomain.de> | ||
| 10427 | |||
| 10428 | (message-kill-to-signature): Change docstring. | ||
| 10429 | |||
| 4747 | 2004-01-14 Katsumi Yamaoka <yamaoka@jpl.org> | 10430 | 2004-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 | |||
| 4752 | 2004-01-13 Katsumi Yamaoka <yamaoka@jpl.org> | 10437 | 2004-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 | ||
| 10441 | 2004-01-13 Jesper Harder <harder@ifa.au.dk> | ||
| 10442 | |||
| 10443 | * message.el (message-expand-name): Silence the byte compiler. | ||
| 10444 | |||
| 10445 | 2004-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 | |||
| 10454 | 2004-01-12 Jesper Harder <harder@ifa.au.dk> | ||
| 10455 | |||
| 10456 | * gnus-srvr.el (gnus-browse-foreign-server): Reduce consing. | ||
| 10457 | |||
| 10458 | 2004-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 | |||
| 10464 | 2004-01-12 Kai Grossjohann <kai.grossjohann@mci.com> | ||
| 10465 | |||
| 10466 | * message.el (message-expand-name): Use EUDC if the user uses | ||
| 10467 | that. | ||
| 10468 | |||
| 10469 | 2004-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 | |||
| 10482 | 2004-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 | |||
| 10492 | 2004-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 | |||
| 10540 | 2004-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 | |||
| 10555 | 2004-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 | |||
| 10565 | 2004-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 | |||
| 10574 | 2004-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 | |||
| 10583 | 2004-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 | |||
| 4756 | 2004-01-08 Katsumi Yamaoka <yamaoka@jpl.org> | 10593 | 2004-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 | |||
| 10608 | 2004-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 | |||
| 10618 | 2003-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 | |||
| 10625 | 2004-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 | |||
| 10631 | 2004-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 | |||
| 10651 | 2004-01-07 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 10652 | |||
| 10653 | * gnus-score.el (gnus-score-find-trace): Add `k' (kill-buffer). | ||
| 10654 | |||
| 10655 | 2004-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 | |||
| 10682 | 2004-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 | |||
| 4761 | 2004-01-07 Katsumi Yamaoka <yamaoka@jpl.org> | 10693 | 2004-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 | ||
| 4765 | 2004-01-07 Katsumi Yamaoka <yamaoka@jpl.org> | 10708 | 2004-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 | ||
| 4785 | 2003-11-15 Simon Josefsson <jas@extundo.com> | 10728 | 2004-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 | ||
| 4792 | 2004-07-28 Simon Josefsson <jas@extundo.com> | 10732 | 2004-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 | ||
| 4797 | 2004-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. | 10739 | 2004-01-07 Jesper Harder <harder@ifa.au.dk> |
| 4800 | 10740 | ||
| 4801 | 2004-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 | 10745 | 2004-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 | ||
| 4809 | 2004-08-31 Jesper Harder <harder@ifa.au.dk> | 10756 | 2004-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 | ||
| 4814 | 2004-08-31 Reiner Steib <Reiner.Steib@gmx.de> | 10760 | 2004-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 | ||
| 4818 | 2004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> | 10765 | 2004-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 | ||
| 4822 | 2004-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 | 10775 | 2004-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 4825 | message-idna-inside-rhs-p. | ||
| 4826 | 10776 | ||
| 4827 | 2004-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 | ||
| 4832 | 2004-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 | ||
| 4836 | 2004-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 | ||
| 4840 | 2004-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 | ||
| 4845 | 2004-08-26 Stefan Wiens <s.wi@gmx.net> (tiny change) | 10796 | 2004-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 | ||
| 4850 | 2004-08-26 David Hedbor <dhedbor@real.com> (tiny change) | 10801 | 2004-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. | 10811 | 2004-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. | 10826 | 2004-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. | 10831 | 2004-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. | 10837 | 2004-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): | 10854 | 2004-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, | 10860 | 2004-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): | 10869 | 2004-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 | ||
| 4954 | 2004-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 | ||
| 4958 | 2004-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 | ||
| 4964 | 2004-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 | ||
| 4968 | 2004-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 | ||
| 4975 | 2004-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 | ||
| 4982 | 2004-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 | ||
| 4987 | 2004-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 | ||
| 4991 | 2004-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 | ||
| 5005 | 2004-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 | ||
| 5010 | 2004-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 | ||
| 5014 | 2004-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. | 10942 | 2004-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 | ||
| 5025 | 2004-08-02 Reiner Steib <Reiner.Steib@gmx.de> | 10954 | 2004-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 | ||
| 5032 | 2004-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 | ||
| 5036 | 2004-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 | ||
| 5041 | 2004-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 | |||
| 10990 | 2003-02-19 Simon Josefsson <jas@extundo.com> | ||
| 10991 | |||
| 10992 | * sieve-manage.el (sieve-sasl-auth): Quote optional initial SASL | ||
| 10993 | token. | ||
| 10994 | |||
| 10995 | 2002-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 | |||
| 11008 | 2004-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 | |||
| 11013 | 2004-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 | |||
| 11019 | 2003-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 | |||
| 11029 | 2003-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 | |||
| 11034 | 2004-01-04 Simon Josefsson <jas@extundo.com> | ||
| 11035 | |||
| 11036 | * password.el: Add. | ||
| 11037 | |||
| 11038 | 2004-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 | |||
| 11046 | 2004-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 | |||
| 11052 | 2004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 11053 | |||
| 11054 | * gnus.el (gnus-version-number): Bump version. | ||
| 11055 | |||
| 11056 | 2004-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): | 11060 | 2004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no> |
| 5044 | Document yanking of region when active. | ||
| 5045 | 11061 | ||
| 5046 | 2004-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. | 11064 | 2004-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 | ||
| 5055 | See ChangeLog.2 for earlier changes. | 11069 | See 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 | |||
| 315 | indicating the minimum and maximum length of an unwrapped citation line. If | 315 | indicating the minimum and maximum length of an unwrapped citation line. If |
| 316 | NODISPLAY is non-nil, don't redisplay the article buffer." | 316 | NODISPLAY 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. |
| 313 | If FULLP, return the entire record returned." | 366 | If FULLP, return the entire record returned. |
| 367 | If 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. | ||
| 65 | Format 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. | ||
| 55 | The 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. |
| 120 | If this is `ask' the hook will query the user." | 120 | If 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 | ||
| 308 | buffer. 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 | ||
| 1797 | appears to have any local content. The actual content, the | ||
| 1798 | article files, may then be deleted using gnus-agent-expire-group. | ||
| 1799 | If flushing was a mistake, the gnus-agent-regenerate-group method | ||
| 1800 | provides an undo mechanism by reconstructing the index files from | ||
| 1801 | the 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 | ||
| 1824 | appears to have any local content. The actual content, the | ||
| 1825 | article files, is then deleted using gnus-agent-expire-group. The | ||
| 1826 | gnus-agent-regenerate-group method provides an undo mechanism by | ||
| 1827 | reconstructing 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. |
| 2977 | FORCE is equivalent to setting the expiration predicates to true." | 3101 | FORCE 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 \ | ||
| 3156 | occurred when reading expression at %s in %s. Skipping to next \ | 3275 | occurred when reading expression at %s in %s. Skipping to next \ |
| 3157 | line." (point) nov-file))) | 3276 | line." (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 \ | ||
| 3239 | download flag on %s:%d as the cached article file is missing." | 3383 | download 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 \ |
| 3243 | missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) | 3387 | missing 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 \ | ||
| 3307 | article alist" type) actions)) | 3457 | article 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 \ |
| 3316 | expiration tests failed." group article-number) | 3466 | expiration 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 | |||
| 3732 | the articles' current headers. | 3891 | the articles' current headers. |
| 3733 | If REREAD is not nil, downloaded articles are marked as unread." | 3892 | If 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 | ||
| 4153 | agent 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 | ||
| 4190 | modified." | ||
| 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. |
| 158 | This variable can also be a list of regexps of headers to be ignored. | 166 | This variable can also be a list of regexps of headers to be ignored. |
| 159 | If `gnus-visible-headers' is non-nil, this variable will be ignored." | 167 | If `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 | |||
| 238 | longer (in lines) than that number. If it is a function, the function | 246 | longer (in lines) than that number. If it is a function, the function |
| 239 | will be called without any parameters, and if it returns nil, there is | 247 | will be called without any parameters, and if it returns nil, there is |
| 240 | no signature in the buffer. If it is a string, it will be used as a | 248 | no signature in the buffer. If it is a string, it will be used as a |
| 241 | regexp. If it matches, the text in question is not a signature." | 249 | regexp. If it matches, the text in question is not a signature. |
| 250 | |||
| 251 | This 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. |
| 485 | See `format-time-string' for the possible values. | 495 | See `format-time-string' for the possible values. |
| 486 | 496 | ||
| 487 | The variable can also be function, which should return a complete Date | 497 | The variable can also be function, which should return a complete Date |
| 488 | header. The function is called with one argument, the time, which can | 498 | header. The function is called with one argument, the time, which can |
| 489 | be fed to `format-time-string'." | 499 | be 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 | ||
| 648 | This variable is an alist where the where the key is the match and the | 658 | This variable is an alist where the key is the match and the |
| 649 | value is a list of possible files to save in if the match is non-nil. | 659 | value is a list of possible files to save in if the match is |
| 660 | non-nil. | ||
| 650 | 661 | ||
| 651 | If the match is a string, it is used as a regexp match on the | 662 | If the match is a string, it is used as a regexp match on the |
| 652 | article. If the match is a symbol, that symbol will be funcalled | 663 | article. If the match is a symbol, that symbol will be funcalled |
| 653 | from the buffer of the article to be saved with the newsgroup as the | 664 | from the buffer of the article to be saved with the newsgroup as the |
| 654 | parameter. If it is a list, it will be evalled in the same buffer. | 665 | parameter. If it is a list, it will be evaled in the same buffer. |
| 655 | 666 | ||
| 656 | If this form or function returns a string, this string will be used as | 667 | If this form or function returns a string, this string will be used as a |
| 657 | a possible file name; and if it returns a non-nil list, that list will | 668 | possible file name; and if it returns a non-nil list, that list will be |
| 658 | be used as possible file names." | 669 | used 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. | ||
| 717 | Each 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 | ||
| 710 | An article button is a piece of text that you can activate by pressing | 733 | An 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. | ||
| 869 | Here 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 | |||
| 881 | See the manual for the valid properties for various image types. | ||
| 882 | Currently, `pbm' is used for X-Face images and `png' is used for Face | ||
| 883 | images in Emacs. Only the `:face' property is effective on the `xface' | ||
| 884 | image 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 | |||
| 1054 | When 0, point will be placed on the same part as before. When | ||
| 1055 | positive (negative), move point forward (backwards) this many | ||
| 1056 | parts. 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. |
| 1030 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1094 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1031 | See Info node `(gnus)Customizing Articles'." | 1095 | predicate. 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. |
| 1039 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1103 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1040 | See Info node `(gnus)Customizing Articles'." | 1104 | predicate. 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. |
| 1048 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1112 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1049 | See Info node `(gnus)Customizing Articles' for details." | 1113 | predicate. 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. |
| 1061 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1124 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1062 | See Info node `(gnus)Customizing Articles' for details." | 1125 | predicate. 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. |
| 1070 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1133 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1071 | See Info node `(gnus)Customizing Articles' for details." | 1134 | predicate. 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. |
| 1079 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1142 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1080 | See Info node `(gnus)Customizing Articles' for details." | 1143 | predicate. 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. |
| 1088 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1151 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1089 | See Info node `(gnus)Customizing Articles' for details." | 1152 | predicate. 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. |
| 1097 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1160 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1098 | See Info node `(gnus)Customizing Articles' for details." | 1161 | predicate. 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. |
| 1105 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1168 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1106 | See Info node `(gnus)Customizing Articles' for details." | 1169 | predicate. 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. |
| 1113 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1176 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1114 | See Info node `(gnus)Customizing Articles' for details." | 1177 | predicate. 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. |
| 1121 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1184 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1122 | See Info node `(gnus)Customizing Articles' for details." | 1185 | predicate. 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. |
| 1129 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1192 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1130 | See Info node `(gnus)Customizing Articles' for details." | 1193 | predicate. 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. |
| 1137 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1200 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1138 | See Info node `(gnus)Customizing Articles' for details." | 1201 | predicate. 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`. |
| 1145 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1208 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1146 | See Info node `(gnus)Customizing Articles' for details." | 1209 | predicate. 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. |
| 1157 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1220 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1158 | See Info node `(gnus)Customizing Articles' for details." | 1221 | predicate. 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. |
| 1165 | The banner to be stripped is specified in the `banner' group parameter. | 1228 | The banner to be stripped is specified in the `banner' group parameter. |
| 1166 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1229 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1167 | See Info node `(gnus)Customizing Articles' for details." | 1230 | predicate. 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. |
| 1174 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1237 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1175 | See Info node `(gnus)Customizing Articles' for details." | 1238 | predicate. 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. |
| 1183 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1246 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1184 | See Info node `(gnus)Customizing Articles' for details." | 1247 | predicate. 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). |
| 1192 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1255 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1193 | See Info node `(gnus)Customizing Articles' for details." | 1256 | predicate. 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. |
| 1200 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1263 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1201 | See Info node `(gnus)Customizing Articles' for details." | 1264 | predicate. 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. |
| 1208 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1271 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1209 | See Info node `(gnus)Customizing Articles' for details." | 1272 | predicate. 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. |
| 1217 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1280 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1218 | See Info node `(gnus)Customizing Articles' for details." | 1281 | predicate. 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. |
| 1225 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1288 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1226 | See Info node `(gnus)Customizing Articles' for details." | 1289 | predicate. 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. |
| 1233 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1296 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1234 | See Info node `(gnus)Customizing Articles' for details." | 1297 | predicate. 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. |
| 1242 | The format is defined by the `gnus-article-time-format' variable. | 1305 | The format is defined by the `gnus-article-time-format' variable. |
| 1243 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1306 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1244 | See Info node `(gnus)Customizing Articles' for details." | 1307 | predicate. 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. |
| 1251 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1314 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1252 | See Info node `(gnus)Customizing Articles' for details." | 1315 | predicate. 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. |
| 1260 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1323 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1261 | See Info node `(gnus)Customizing Articles' for details. | 1324 | predicate. See Info node `(gnus)Customizing Articles'. |
| 1262 | 1325 | ||
| 1263 | When set to t, it also strips trailing blanks in all MIME parts. | 1326 | When set to t, it also strips trailing blanks in all MIME parts. |
| 1264 | Consider to use `last' instead." | 1327 | Consider 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. |
| 1271 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1334 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1272 | See Info node `(gnus)Customizing Articles' for details. | 1335 | predicate. See Info node `(gnus)Customizing Articles'. |
| 1273 | 1336 | ||
| 1274 | When set to t, it also strips trailing blanks in all MIME parts." | 1337 | When 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. |
| 1281 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1344 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1282 | See Info node `(gnus)Customizing Articles' for details." | 1345 | predicate. 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. |
| 1289 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1352 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1290 | See Info node `(gnus)Customizing Articles' for details." | 1353 | predicate. 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. | ||
| 1361 | If it is a regexp, only long headers matching this regexp are unfolded. | ||
| 1362 | If it is t, all long headers are unfolded. | ||
| 1363 | |||
| 1364 | This 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. |
| 1298 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1373 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1299 | See Info node `(gnus)Customizing Articles' for details." | 1374 | predicate. 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. |
| 1307 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1382 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1308 | See Info node `(gnus)Customizing Articles' for details." | 1383 | predicate. 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. |
| 1316 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1391 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1317 | See Info node `(gnus)Customizing Articles' for details." | 1392 | predicate. 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. | ||
| 1400 | Valid values are nil, t, `head', `first', `last', an integer or a | ||
| 1401 | predicate. 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. |
| 1367 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1450 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1368 | See Info node `(gnus)Customizing Articles' and Info node | 1451 | predicate. See Info node `(gnus)Customizing Articles' and Info |
| 1369 | `(gnus)X-Face' for details." | 1452 | node `(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. |
| 1379 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1462 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1380 | See Info node `(gnus)Customizing Articles' and Info node | 1463 | predicate. See Info node `(gnus)Customizing Articles' and Info |
| 1381 | `(gnus)Smileys' for details." | 1464 | node `(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. |
| 1394 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1477 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1395 | See Info node `(gnus)Customizing Articles' and Info node | 1478 | predicate. See Info node `(gnus)Customizing Articles' and Info |
| 1396 | `(gnus)Picons' for details." | 1479 | node `(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. |
| 1410 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1493 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1411 | See Info node `(gnus)Customizing Articles' and Info node | 1494 | predicate. See Info node `(gnus)Customizing Articles' and Info |
| 1412 | `(gnus)Picons' for details." | 1495 | node `(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. |
| 1426 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1509 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1427 | See Info node `(gnus)Customizing Articles' and Info node | 1510 | predicate. See Info node `(gnus)Customizing Articles' and Info |
| 1428 | `(gnus)Picons' for details." | 1511 | node `(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. |
| 1443 | Valid values are nil and `head'. | 1527 | Valid 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. |
| 1452 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1536 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1453 | See Info node `(gnus)Customizing Articles' for details." | 1537 | predicate. 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. |
| 1461 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1545 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1462 | See Info node `(gnus)Customizing Articles' for details." | 1546 | predicate. 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. |
| 1470 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1554 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1471 | See Info node `(gnus)Customizing Articles' for details." | 1555 | predicate. 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. |
| 1478 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1562 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1479 | See Info node `(gnus)Customizing Articles' for details." | 1563 | predicate. 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. |
| 1487 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1571 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1488 | See Info node `(gnus)Customizing Articles' for details." | 1572 | predicate. 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. |
| 1496 | To automatically treat X-PGP-Sig, set it to head. | 1580 | To automatically treat X-PGP-Sig, set it to head. |
| 1497 | Valid values are nil, t, `head', `last', an integer or a predicate. | 1581 | Valid values are nil, t, `head', `first', `last', an integer or a |
| 1498 | See Info node `(gnus)Customizing Articles' for details." | 1582 | predicate. 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." | |||
| 2031 | MAP is an alist where the elements are on the form (\"from\" \"to\")." | 2113 | MAP 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. |
| 2069 | Only the headers that fit into the current window width will be | 2158 | Only 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. | ||
| 2229 | Valid values are nil, t, `head', `first', `last', an integer or a | ||
| 2230 | predicate. 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. | ||
| 2238 | If ARG is non-nil and not a number, toggle | ||
| 2239 | `gnus-article-truncate-lines' too. If ARG is a number, truncate | ||
| 2240 | long 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'. | ||
| 2750 | Internal variable.") | ||
| 2751 | |||
| 2752 | (defcustom gnus-article-browse-delete-temp 'ask | ||
| 2753 | "What to do with temporary files from `gnus-article-browse-html-parts'. | ||
| 2754 | If nil, don't delete temporary files. If it is t, delete them on | ||
| 2755 | exit from the summary buffer. If it is the symbol `file', query | ||
| 2756 | on each file, if it is `ask' ask once when exiting from the | ||
| 2757 | summary 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. | ||
| 2791 | Recurse 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 | |||
| 2825 | Warning: Spammers use links to images in HTML articles to verify | ||
| 2826 | whether you have read the message. As | ||
| 2827 | `gnus-article-browse-html-article' passes the unmodified HTML | ||
| 2828 | content to the browser without eliminating these \"web bugs\" you | ||
| 2829 | should 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. |
| 2633 | The `gnus-list-identifiers' variable specifies what to do." | 2848 | The `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 | 4147 | Internal 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. | ||
| 4374 | If 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. | ||
| 4417 | If 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. | ||
| 4428 | If 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. | ||
| 4564 | This function is exclusively used by `gnus-mime-save-part-and-strip' | ||
| 4565 | and `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. | ||
| 4627 | If 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 "\ |
| 4270 | The current article has a complicated MIME structure, giving up...")) | 4634 | The 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)) |
| 4272 | Deleting 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 "\ |
| 4341 | The current article has a complicated MIME structure, giving up...")) | 4675 | The current article has a complicated MIME structure, giving up...")) |
| 4342 | (when (gnus-yes-or-no-p "\ | 4676 | (when (or gnus-expert-user |
| 4343 | Deleting parts may malfunction or destroy the article; continue? ") | 4677 | (gnus-yes-or-no-p "\ |
| 4678 | Deleting 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. | ||
| 4497 | The 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. |
| 4521 | If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 | 4793 | If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 |
| 4522 | are decompressed." | 4794 | are 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. |
| 4879 | Compressed 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) | 5039 | Unless NO-HANDLE, call FUNCTION with N-th MIME handle as it's only argument. |
| 4716 | (when window | 5040 | If 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. |
| 4753 | N is the numerical prefix." | 5141 | N 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. | ||
| 5157 | N 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. | ||
| 5163 | N 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. | ||
| 5169 | N 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. | ||
| 5175 | N 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. |
| 5336 | Provided for backwards compatibility." | 5760 | Provided 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))) | 6907 | Both FUN and ARG are supposed to be strings. ARG will be passed |
| 6908 | as 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. |
| 6838 | It does this by highlighting everything after | 7307 | It 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 |
| 6864 | specified by `gnus-button-alist'." | 7331 | specified 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. | ||
| 7375 | Return non-nil if button is extended. BEG is a marker that points to | ||
| 7376 | the beginning position of a text containing url. START and END are | ||
| 7377 | the endpoints of a url button before it is extended. The concatenated | ||
| 7378 | url 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. | ||
| 87 | Otherwise they will be displayed in LIFO order (that is, | ||
| 88 | most 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. | ||
| 94 | List of details is defined in `gnus-bookmark-bookmark-inline-details'. | ||
| 95 | This may result in truncated bookmark names. To disable this, put the | ||
| 96 | following 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. | ||
| 104 | You 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'. | ||
| 115 | The 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'. | ||
| 128 | The 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. | ||
| 151 | You 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. | ||
| 158 | The format of the alist is | ||
| 159 | |||
| 160 | \(BMK1 BMK2 ...\) | ||
| 161 | |||
| 162 | where 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 | |||
| 172 | So 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. | ||
| 311 | The buffer must of course contain Gnus bookmark format information. | ||
| 312 | Does not care from where in the buffer it is called, and does not | ||
| 313 | affect 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. | ||
| 351 | If the gnus-bookmark-sort-flag is non-nil, then return a sorted | ||
| 352 | copy 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. | ||
| 362 | The list is displayed in a buffer named `*Gnus Bookmark List*'. | ||
| 363 | The leftmost column displays a D if the bookmark is flagged for | ||
| 364 | deletion, 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. | ||
| 410 | Don'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'. | ||
| 422 | If 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'. | ||
| 428 | That 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. | ||
| 475 | Each line describes one of the bookmarks in Gnus. | ||
| 476 | Letters do not insert themselves; instead, they are commands. | ||
| 477 | Gnus 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. | ||
| 510 | Optional 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. | ||
| 570 | If optional arg NEWLINE-TOO is non-nil, delete the newline too. | ||
| 571 | Does 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. | ||
| 624 | The actual value returned is gnus-bookmark-alist. Else | ||
| 625 | reposition 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. | ||
| 696 | Optional 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. | ||
| 722 | To 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. | ||
| 735 | To 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 `>'. | ||
| 746 | You can mark bookmarks with the | ||
| 747 | \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark] | ||
| 748 | command." | ||
| 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. | ||
| 809 | Removes only the first instance of a bookmark with that name. If | ||
| 810 | there are one or more other bookmarks with the same name, they will | ||
| 811 | not be deleted. Defaults to the \"current\" bookmark \(that is, the | ||
| 812 | one most recently used in this file, if any\). | ||
| 813 | Optional second arg BATCH means don't update the bookmark list buffer, | ||
| 814 | probably 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." | |||
| 325 | If not given a prefix, use the process marked articles instead. | 333 | If not given a prefix, use the process marked articles instead. |
| 326 | Returns the list of articles entered." | 334 | Returns 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. | |||
| 348 | Returns the list of articles removed." | 355 | Returns 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. | ||
| 432 | Decoding is done according to `gnus-group-name-charset-method-alist' | ||
| 433 | or `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. | ||
| 437 | A 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 | ||
| 440 | decoded again according to `nnmail-pathname-coding-system', | ||
| 441 | `file-name-coding-system', or `default-file-name-coding-system'. | ||
| 442 | |||
| 443 | It is used when asking for a original group name from a cache | ||
| 444 | directory name, in which non-ASCII characters might have been unified | ||
| 445 | into the ones of a certain charset particularly if the `utf-8' coding | ||
| 446 | system 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 | |||
| 736 | depends on the caller to determine whether group renaming is | 788 | depends on the caller to determine whether group renaming is |
| 737 | supported." | 789 | supported." |
| 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 | |||
| 762 | files would corrupt gnus when the cache was next enabled. | 817 | files would corrupt gnus when the cache was next enabled. |
| 763 | Depends upon the caller to determine whether group deletion is | 818 | Depends upon the caller to determine whether group deletion is |
| 764 | supported." | 819 | supported." |
| 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 | ||
| 300 | When there are citations from multiple articles in the same message, | 303 | When there are citations from multiple articles in the same message, |
| 301 | Gnus will try to give each citation from each article its own face. | 304 | Gnus will try to give each citation from each article its own face. |
| 302 | This should make it easier to see who wrote what." | 305 | This 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. |
| 372 | Each citation in the article will be highlighted with a different face. | 389 | Each citation in the article will be highlighted with a different face. |
| 373 | The faces are taken from `gnus-cite-face-list'. | 390 | The 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. | ||
| 1145 | Returns 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. | ||
| 1184 | This buffer local minor mode provides additional font-lock support for | ||
| 1185 | nested citations. | ||
| 1186 | With prefix ARG, turn `gnus-message-citation-mode' on if and only if ARG | ||
| 1187 | is positive. | ||
| 1188 | Automatically turn `font-lock-mode' on when `gnus-message-citation-mode' | ||
| 1189 | is 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. |
| 91 | Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning | 91 | Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning |
| 92 | of the buffer." | 92 | of the buffer. |
| 93 | The 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. |
| 52 | The command must take a image filename (use \"%s\") as input. | ||
| 53 | The output must be the Face header data on stdout in PNG format. | ||
| 54 | |||
| 51 | By default it takes a GIF filename and output the X-Face header data | 55 | By default it takes a GIF filename and output the X-Face header data |
| 52 | on stdout." | 56 | on 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. |
| 59 | By default it takes a JPEG filename and output the Face header data | 68 | |
| 60 | on stdout." | 69 | The command must take an image filename (first format argument |
| 70 | \"%s\") and the number of colors (second format argument: \"%d\") | ||
| 71 | as input. The output must be the Face header data on stdout in | ||
| 72 | PNG 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 | |
| 123 | Depending on `gnus-convert-image-to-x-face-command' it may accept | ||
| 124 | different 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 | |
| 135 | Depending on `gnus-convert-image-to-face-command' it may accept | ||
| 136 | different 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. | ||
| 139 | This 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. | ||
| 171 | Setting this variable to -2 would have the following effect on | ||
| 172 | GroupLens scores: | ||
| 173 | |||
| 174 | 1 --> -2 | ||
| 175 | 2 --> -1 | ||
| 176 | 3 --> 0 | ||
| 177 | 4 --> 1 | ||
| 178 | 5 --> 2 | ||
| 179 | |||
| 180 | The reason is that a user might want to do this is to combine | ||
| 181 | GroupLens 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. | ||
| 185 | The 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. | ||
| 189 | GroupLens 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. | ||
| 219 | If 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. | ||
| 345 | See the gnus variable `gnus-score-find-score-files-function'. | ||
| 346 | |||
| 347 | *Note:* If you want to use grouplens scores along with calculated scores, | ||
| 348 | you should see the offset and scale variables. At this point, I don't | ||
| 349 | recommend 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. | ||
| 674 | If 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. |
| 156 | It works along the same lines as a normal formatting string, | 160 | It works along the same lines as a normal formatting string, |
| 157 | with some simple extensions. | 161 | with 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 | |||
| 198 | groups. | 202 | groups. |
| 199 | 203 | ||
| 200 | If you use %o or %O, reading the active file will be slower and quite | 204 | If you use %o or %O, reading the active file will be slower and quite |
| 201 | a bit of extra memory will be used. %D will also worsen performance. | 205 | a bit of extra memory will be used. %D and %F will also worsen |
| 202 | Also note that if you change the format specification to include any | 206 | performance. Also note that if you change the format specification to |
| 203 | of these specs, you must probably re-start Gnus to see them go into | 207 | include any of these specs, you must probably re-start Gnus to see |
| 204 | effect. | 208 | them go into effect. |
| 205 | 209 | ||
| 206 | General format specifiers can also be used. | 210 | General format specifiers can also be used. |
| 207 | See Info node `(gnus)Formatting Variables'." | 211 | See 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'. |
| 443 | If non-nil, the value should be a string, e.g. \"nnml:\", | 447 | |
| 444 | in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" | 448 | If non-nil, the value should be a string or an alist. If it is a string, |
| 445 | in the minibuffer prompt." | 449 | e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group: |
| 450 | nnml:\" in the minibuffer prompt. | ||
| 451 | |||
| 452 | If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example: | ||
| 453 | \((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is | ||
| 454 | used 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 | ||
| 1054 | See `gmm-tool-bar-from-list' for the format of the list." | 1070 | See `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 | ||
| 1073 | See `gmm-tool-bar-from-list' for the format of the list." | 1089 | See `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 | ||
| 1084 | See `gmm-tool-bar-from-list' for the format of the list." | 1100 | See `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\". |
| 2056 | This means that no highlighting or scoring will be performed. | 2080 | This means that no highlighting or scoring will be performed. If |
| 2057 | If ALL (the prefix argument) is 0, don't even generate the summary | 2081 | ALL (the prefix argument) is 0, don't even generate the summary |
| 2058 | buffer. | 2082 | buffer. If GROUP is nil, use current group. |
| 2059 | 2083 | ||
| 2060 | This might be useful if you want to toggle threading | 2084 | This might be useful if you want to toggle threading |
| 2061 | before entering the group." | 2085 | before 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. | ||
| 2162 | The arguments are the same as `completing-read' except that COLLECTION | ||
| 2163 | and HIST default to `gnus-active-hashtb' and `gnus-group-history' | ||
| 2164 | respectively 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. |
| 2189 | If ARTICLES, display those articles. | ||
| 2096 | Returns whether the fetching was successful or not." | 2190 | Returns 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 | |||
| 2303 | If 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. | ||
| 2503 | The 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. |
| 2386 | The user will be prompted for a NAME, for a select METHOD, and an | 2511 | The user will be prompted for a NAME, for a select METHOD, and an |
| 2387 | ADDRESS." | 2512 | ADDRESS. NAME should be a human-readable string (i.e., not be encoded |
| 2513 | even 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." | |||
| 3304 | If ALL is non-nil, all articles are marked as read. | 3431 | If ALL is non-nil, all articles are marked as read. |
| 3305 | The return value is the number of articles that were marked as read, | 3432 | The return value is the number of articles that were marked as read, |
| 3306 | or nil if no action could be taken." | 3433 | or 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. |
| 3461 | Killed newsgroups are subscribed. If SILENT, don't try to update the | 3588 | Killed newsgroups are subscribed. If SILENT, don't try to update the |
| 3462 | group line." | 3589 | group 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." | |||
| 3851 | If given a prefix argument, prompt for a group." | 3975 | If 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." | |||
| 3879 | If given a prefix argument, prompt for a group." | 4003 | If 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. | ||
| 4590 | Compaction means removing gaps between article numbers. Hence, this | ||
| 4591 | operation is only meaningful for back ends using one file per article | ||
| 4592 | \(e.g. nnml). | ||
| 4593 | |||
| 4594 | Note: 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 "\ | ||
| 4602 | Compacting 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\"). |
| 498 | If optional 2nd argument ALL is non-nil, articles marked are also applied to. | 498 | If optional 2nd argument ALL is non-nil, articles marked are also applied to. |
| 499 | If FIELD is an empty string (or nil), entire article body is searched for. | 499 | If FIELD is an empty string (or nil), entire article body is searched for. |
| 500 | COMMAND must be a lisp expression or a string representing a key sequence." | 500 | COMMAND 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). |
| 629 | If FIELD is an empty string (or nil), entire article body is searched for. | 629 | If FIELD is an empty string (or nil), entire article body is searched for. |
| 630 | If optional 1st argument BACKWARD is non-nil, do backward instead. | 630 | If optional 1st argument BACKWARD is non-nil, do backward instead. |
| 631 | If optional 2nd argument UNREAD is non-nil, articles which are | 631 | If 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 |
| 38 | gnus-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. |
| 42 | Used by gnus-group-split and gnus-group-split-update as a fallback | 42 | Used by `gnus-group-split' and `gnus-group-split-update' as a fallback |
| 43 | split, in case none of the group-based splits matches.") | 43 | split, 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'. |
| 48 | Sets things up so that nnmail-split-fancy is used for mail | 48 | Sets things up so that nnmail-split-fancy is used for mail |
| 49 | splitting, and defines the variable nnmail-split-fancy according with | 49 | splitting, and defines the variable nnmail-split-fancy according with |
| 50 | group parameters. | 50 | group parameters. |
| 51 | 51 | ||
| 52 | If AUTO-UPDATE is non-nil (prefix argument accepted, if called | 52 | If AUTO-UPDATE is non-nil (prefix argument accepted, if called |
| 53 | interactively), it makes sure nnmail-split-fancy is re-computed before | 53 | interactively), it makes sure nnmail-split-fancy is re-computed before |
| 54 | getting new mail, by adding gnus-group-split-update to | 54 | getting new mail, by adding `gnus-group-split-update' to |
| 55 | nnmail-pre-get-new-mail-hook. | 55 | `nnmail-pre-get-new-mail-hook'. |
| 56 | 56 | ||
| 57 | A non-nil CATCH-ALL replaces the current value of | 57 | A non-nil CATCH-ALL replaces the current value of |
| 58 | gnus-group-split-default-catch-all-group. This variable is only used | 58 | `gnus-group-split-default-catch-all-group'. This variable is only used |
| 59 | by gnus-group-split-update, and only when its CATCH-ALL argument is | 59 | by gnus-group-split-update, and only when its CATCH-ALL argument is |
| 60 | nil. This argument may contain any fancy split, that will be added as | 60 | nil. This argument may contain any fancy split, that will be added as |
| 61 | the last split in a `|' split produced by gnus-group-split-fancy, | 61 | the last split in a `|' split produced by `gnus-group-split-fancy', |
| 62 | unless overridden by any group marked as a catch-all group. Typical | 62 | unless overridden by any group marked as a catch-all group. Typical |
| 63 | uses are as simple as the name of a default mail group, but more | 63 | uses are as simple as the name of a default mail group, but more |
| 64 | elaborate fancy splits may also be useful to split mail that doesn't | 64 | elaborate 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 | |||
| 78 | It does this by calling by calling (gnus-group-split-fancy nil | 78 | It does this by calling by calling (gnus-group-split-fancy nil |
| 79 | nil CATCH-ALL). | 79 | nil CATCH-ALL). |
| 80 | 80 | ||
| 81 | If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used | 81 | If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used |
| 82 | instead. This variable is set by gnus-group-split-setup." | 82 | instead. 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. |
| 93 | See `gnus-group-split-fancy' for more information. | 93 | See `gnus-group-split-fancy' for more information. |
| 94 | 94 | ||
| 95 | gnus-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. |
| 260 | This is done because new users often reply by mistake when reading | 261 | This is done because new users often reply by mistake when reading |
| 261 | news. | 262 | news. |
| @@ -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 | |||
| 784 | prefix `a', cancel using the standard posting method; if not | 802 | prefix `a', cancel using the standard posting method; if not |
| 785 | post using the current select method." | 803 | post 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. | ||
| 79 | If `inline', the textual representation is replaced. If `right', picons are | ||
| 80 | added 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. |
| 144 | GLYPH can be either a glyph or a string." | 153 | GLYPH can be either a glyph or a string. When NOSTRING, no textual |
| 154 | replacement 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. |
| 311 | If ALWAYS-LIST is non-nil, this function will always release a list of | 311 | If ALWAYS-LIST is non-nil, this function will always release a list of |
| 312 | ranges." | 312 | ranges." |
| 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. |
| 79 | The group names are matched, they don't have to be fully qualified." | 81 | The group names are matched, they don't have to be fully |
| 82 | qualified. This parameter tells the Registry 'never split a | ||
| 83 | message into a group that matches one of these, regardless of | ||
| 84 | references.'" | ||
| 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. |
| 90 | Registry entries are considered empty when they have no groups." | 95 | Registry entries are considered empty when they have no groups |
| 96 | and 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. |
| 314 | Also, 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 | |||
| 334 | in `nnmail-split-fancy' or `nnimap-split-fancy', for example like | 376 | in `nnmail-split-fancy' or `nnimap-split-fancy', for example like |
| 335 | this: (: gnus-registry-split-fancy-with-parent) | 377 | this: (: gnus-registry-split-fancy-with-parent) |
| 336 | 378 | ||
| 379 | This function tracks ALL backends, unlike | ||
| 380 | `nnmail-split-fancy-with-parent' which tracks only nnmail | ||
| 381 | messages. | ||
| 382 | |||
| 337 | For a message to be split, it looks for the parent message in the | 383 | For a message to be split, it looks for the parent message in the |
| 338 | References or In-Reply-To header and then looks in the registry to | 384 | References or In-Reply-To header and then looks in the registry |
| 339 | see which group that message was put in. This group is returned. | 385 | to see which group that message was put in. This group is |
| 386 | returned, unless it matches one of the entries in | ||
| 387 | gnus-registry-unfollowed-groups or | ||
| 388 | nnmail-split-fancy-with-parent-ignore-groups. | ||
| 340 | 389 | ||
| 341 | See the Info node `(gnus)Fancy Mail Splitting' for more details." | 390 | See 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. | ||
| 590 | Returns 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. | ||
| 599 | The `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. |
| 499 | Returns the first place where the trail finds a nonstring." | 616 | Returns 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. |
| 44 | Set this variable if you want to use people's score files. One entry | 42 | Set 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 | |||
| 152 | If 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 | |||
| 428 | If a regexp, scoring on headers or body is inhibited if the group | ||
| 429 | matches the regexp. If it is t, scoring on headers or body is | ||
| 430 | inhibited 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." | |||
| 2429 | Type `e' to edit score file corresponding to the score rule on current line, | 2475 | Type `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 | ||
| 2434 | The first sexp on each line is the score rule, followed by the file name of | 2480 | The first sexp on each line is the score rule, followed by the file name of |
| 2435 | the score file and its full name, including the directory.") | 2481 | the 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." | |||
| 306 | If NOT-ALL, don't pack ticked articles." | 306 | If 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 | ||
| 53 | The following specs are understood: | 53 | The 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 |
| 336 | gnus-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 | |||
| 1006 | Note: 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 "\ | ||
| 1017 | Requesting 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. | ||
| 67 | See `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. |
| 67 | If an unread article in the group refers to an older, already read (or | 75 | If an unread article in the group refers to an older, already |
| 68 | just marked as read) article, the old article will not normally be | 76 | read (or just marked as read) article, the old article will not |
| 69 | displayed in the Summary buffer. If this variable is t, Gnus | 77 | normally be displayed in the Summary buffer. If this variable is |
| 70 | will attempt to grab the headers to the old articles, and thereby | 78 | t, Gnus will attempt to grab the headers to the old articles, and |
| 71 | build complete threads. If it has the value `some', only enough | 79 | thereby build complete threads. If it has the value `some', all |
| 72 | headers to connect otherwise loose threads will be displayed. This | 80 | old headers will be fetched but only enough headers to connect |
| 73 | variable can also be a number. In that case, no more than that number | 81 | otherwise loose threads will be displayed. This variable can |
| 74 | of old headers will be fetched. If it has the value `invisible', all | 82 | also be a number. In that case, no more than that number of old |
| 83 | headers will be fetched. If it has the value `invisible', all | ||
| 75 | old headers will be fetched, but none will be displayed. | 84 | old headers will be fetched, but none will be displayed. |
| 76 | 85 | ||
| 77 | The server has to support NOV for any of this to work." | 86 | The server has to support NOV for any of this to work. |
| 87 | |||
| 88 | This feature can seriously impact performance it ignores all | ||
| 89 | locally 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]. |
| 88 | If t, fetch all the available old headers." | 100 | If 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. | ||
| 383 | Valid 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 | |||
| 394 | If it has any other value or there is no next (unread) article, the | ||
| 395 | article 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. |
| 396 | In particular, if `vertical' do only vertical recentering. If non-nil | 430 | In particular, if `vertical' do only vertical recentering. If non-nil |
| 397 | and non-`vertical', do both horizontal and vertical recentering." | 431 | and 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. | ||
| 477 | The function should take one argument, a group name, and return a | ||
| 478 | string 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. | ||
| 743 | VALUE 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. | ||
| 753 | VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom. | ||
| 754 | FOO 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. | ||
| 762 | VALUE 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 | |||
| 709 | very similar. (Sorting by date means sorting by the time the message | 784 | very similar. (Sorting by date means sorting by the time the message |
| 710 | was sent, sorting by number means sorting by arrival time.) | 785 | was sent, sorting by number means sorting by arrival time.) |
| 711 | 786 | ||
| 787 | Each item can also be a list `(not F)' where F is a function; | ||
| 788 | this reverses the sort order. | ||
| 789 | |||
| 712 | Ready-made functions include `gnus-article-sort-by-number', | 790 | Ready-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'. | |||
| 717 | When threading is turned on, the variable `gnus-thread-sort-functions' | 795 | When threading is turned on, the variable `gnus-thread-sort-functions' |
| 718 | controls how articles are sorted." | 796 | controls 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 | |||
| 738 | very similar. (Sorting by date means sorting by the time the message | 819 | very similar. (Sorting by date means sorting by the time the message |
| 739 | was sent, sorting by number means sorting by arrival time.) | 820 | was sent, sorting by number means sorting by arrival time.) |
| 740 | 821 | ||
| 822 | Each list item can also be a list `(not F)' where F is a | ||
| 823 | function; this specifies reversed sort order. | ||
| 824 | |||
| 741 | Ready-made functions include `gnus-thread-sort-by-number', | 825 | Ready-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 | 830 | and `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 | ||
| 749 | When threading is turned off, the variable | 833 | When 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. |
| 1110 | This 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 | ||
| 1121 | using `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 | ||
| 1128 | line 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. |
| 1132 | Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not | 1241 | Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not |
| 1133 | supply the MIME-Version header or deliberately strip it from the mail. | 1242 | supply the MIME-Version header or deliberately strip it from the mail. |
| 1134 | Set it to non-nil, Gnus will treat some articles as MIME even if | 1243 | If non-nil (the default), Gnus will treat some articles as MIME |
| 1135 | the MIME-Version header is missed." | 1244 | even 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 | ||
| 2654 | See `gmm-tool-bar-from-list' for the format of the list." | 2795 | See `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 | ||
| 2689 | See `gmm-tool-bar-from-list' for the format of the list." | 2830 | See `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 | ||
| 2700 | See `gmm-tool-bar-from-list' for the format of the list." | 2841 | See `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. |
| 4814 | If nil, use subject instead." | 4973 | If 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. |
| 4820 | If nil, use subject instead." | 4980 | If 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. |
| 5239 | If READ-ALL is non-nil, all articles in the group are selected. | 5400 | If READ-ALL is non-nil, all articles in the group are selected. |
| 5240 | If SELECT-ARTICLES, only select those articles from GROUP." | 5401 | If 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. |
| 6187 | This is meant to be called in `gnus-article-internal-prepare-hook'." | 6349 | This 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. |
| 6364 | If EXCLUDE-GROUP, do not go to this group." | 6525 | If 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 | |||
| 8005 | If NOT-MATCHING, exclude RECIPIENT. | ||
| 8006 | |||
| 8007 | To 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 | |||
| 8048 | If NOT-MATCHING, exclude ADDRESS. | ||
| 8049 | |||
| 8050 | To, Cc and From headers are checked. You need to include `To' and `Cc' | ||
| 8051 | in `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. | ||
| 8110 | PREDICATE will be called with the header structures of the | ||
| 8111 | articles." | ||
| 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. |
| 7849 | If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to | 8121 | If 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. | ||
| 8226 | If 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. | ||
| 8232 | If 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. | ||
| 8266 | If 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. | ||
| 8290 | If 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. |
| 8040 | Note that this command only works on a subset of the articles currently | 8394 | Note 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 | |||
| 8572 | documents as newsgroups. | 8924 | documents as newsgroups. |
| 8573 | Obeys the standard process/prefix convention." | 8925 | Obeys 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. |
| 8632 | If BACKWARD, search backward instead." | 8997 | If 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. |
| 9057 | The numerical prefix specifies how many places to rotate each letter | 9421 | With a non-numerical prefix, also rotate headers. A numerical |
| 9058 | forward." | 9422 | prefix 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) | 9440 | IDNA encoded domain names looks like `xn--bar'. If a string |
| 9441 | remain unencoded after running this function, it is likely an | ||
| 9442 | invalid IDNA string (`xn--bar' is invalid). | ||
| 9443 | |||
| 9444 | You must have GNU Libidn (`http://www.gnu.org/software/libidn/') | ||
| 9445 | installed 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. | ||
| 11056 | If given a prefix, mark all articles, unread as well as ticked, as | ||
| 11057 | read." | ||
| 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 | 11167 | When called interactively, PARENT is the current article and CHILDREN |
| 10736 | (gnus-summary-article-header parent-article)))) | 11168 | are 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. |
| 10952 | If the prefix argument is positive, remove any kinds of marks. | 11399 | If the prefix argument is positive, remove any kinds of marks. |
| 11400 | If the prefix argument is zero, mark thread as expired. | ||
| 10953 | If the prefix argument is negative, tick articles instead." | 11401 | If 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. | ||
| 11455 | If `case-fold-search' is non-nil, case of letters is ignored. | ||
| 11456 | Argument 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. |
| 11004 | If `case-fold-search' is non-nil, case of letters is ignored. | 11462 | If `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. |
| 11642 | UNREAD is a sorted list." | 12110 | UNREAD 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. |
| 381 | Possibly 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." | 397 | Possibly inherit parameters from topics above TOPIC. |
| 398 | (let ((topics (gnus-current-topics topic)) | 398 | If optional argument GROUP-PARAMS-LIST is non-nil, use it as the basis for |
| 399 | params-list param out params) | 399 | inheritance." |
| 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. |
| 72 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new | 71 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new |
| 73 | string containing the replacements. | 72 | string containing the replacements. |
| @@ -75,25 +74,7 @@ string containing the replacements. | |||
| 75 | This is a compatibility function for different Emacsen." | 74 | This 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. | ||
| 82 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new | ||
| 83 | string containing the replacements. | ||
| 84 | |||
| 85 | This 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. | ||
| 470 | If it is `log', add timestamps to only the messages that go into the | ||
| 471 | \"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer). | ||
| 472 | If it is neither nil nor `log', add timestamps not only to log messages | ||
| 473 | but 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'. | ||
| 537 | The `gnus-add-timestamp-to-message' variable controls how to add | ||
| 538 | timestamp 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: | |||
| 509 | that take a long time, 7 - not very important messages on stuff, 9 - messages | 546 | that take a long time, 7 - not very important messages on stuff, 9 - messages |
| 510 | inside loops." | 547 | inside 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. |
| 541 | If N, return the Nth ancestor instead." | 591 | If 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. |
| 714 | Bind `print-quoted' and `print-readably' to t, and `print-length' and | 764 | Bind `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. |
| 172 | See the Gnus manual for an explanation of the syntax used.") | 180 | See 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. |
| 1297 | This should be a mail method." | 1293 | This should be a mail method. |
| 1294 | |||
| 1295 | See 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 | |||
| 1304 | The archive method is initially set according to the value of | ||
| 1305 | `gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file | ||
| 1306 | so 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 | ||
| 1308 | updated if the value of this variable is nil, even if you change the | ||
| 1309 | value of `gnus-message-archive-method' afterward. If you want the | ||
| 1310 | saved \"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. |
| 1305 | This can either be a string; a list of strings; or an alist | 1319 | This 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. |
| 1576 | If it is a number N, then Gnus will only keep the last N articles | 1585 | If 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 | |||
| 2007 | spam. There is other behavior associated with ham and no | 2016 | spam. There is other behavior associated with ham and no |
| 2008 | classification when spam.el is loaded - see the manual.") | 2017 | classification 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. |
| 2393 | If `visual' is disabled, there will be no menus and few faces. Most of | 2465 | If `visual' is disabled, there will be no menus and few faces. Most of |
| 2394 | the visual customization options below will be ignored. Gnus will use | 2466 | the 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: | |||
| 2402 | Valid elements include `summary-highlight', `group-highlight', | 2474 | Valid 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'." |
| 2406 | and `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. | ||
| 58 | If this is zero, no payment header will be generated. | ||
| 59 | See `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. | ||
| 65 | Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where | ||
| 66 | ADDR is the email address of the intended recipient and AMOUNT is | ||
| 67 | the value of hashcash payment to be made to that user. STRING, if | ||
| 68 | present, 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. | ||
| 85 | Resources named here are to be accepted in incoming payments. If the | ||
| 86 | corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment' | ||
| 87 | is 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. | ||
| 96 | For 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. | ||
| 166 | Return 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 | ||
| 232 | Only 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. | ||
| 255 | BUFFER 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. | ||
| 266 | BUFFER 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 | ||
| 307 | for each recipient address. Prefix arg sets default payment temporarily. | ||
| 308 | Set 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 | ||
| 337 | for each recipient address. Prefix arg sets default payment temporarily. | ||
| 338 | Calculation 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. | ||
| 345 | Prefix 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 | |||
| 35 | HMAC function is H(KEY XOR opad, H(KEY XOR ipad, TEXT)): | ||
| 36 | |||
| 37 | H is a cryptographic hash function, such as SHA1 and MD5, which takes | ||
| 38 | a string and return a digest of it (in binary form). | ||
| 39 | B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.) | ||
| 40 | L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.) | ||
| 41 | If 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 | '((" " . " ") (">" . ">") ("<" . "<") (""" . "\"") | 46 | '(("´" . "`") |
| 47 | ("&" . "&") ("'" . "'")) | 47 | ("&" . "&") |
| 48 | ("'" . "'") | ||
| 49 | ("¦" . "|") | ||
| 50 | ("¢" . "c") | ||
| 51 | ("ˆ" . "^") | ||
| 52 | ("©" . "(C)") | ||
| 53 | ("¤" . "(#)") | ||
| 54 | ("°" . "degree") | ||
| 55 | ("÷" . "/") | ||
| 56 | ("€" . "e") | ||
| 57 | ("½" . "1/2") | ||
| 58 | (">" . ">") | ||
| 59 | ("¿" . "?") | ||
| 60 | ("«" . "<<") | ||
| 61 | ("&ldquo" . "\"") | ||
| 62 | ("‹" . "(") | ||
| 63 | ("‘" . "`") | ||
| 64 | ("<" . "<") | ||
| 65 | ("—" . "--") | ||
| 66 | (" " . " ") | ||
| 67 | ("–" . "-") | ||
| 68 | ("‰" . "%%") | ||
| 69 | ("±" . "+-") | ||
| 70 | ("£" . "£") | ||
| 71 | (""" . "\"") | ||
| 72 | ("»" . ">>") | ||
| 73 | ("&rdquo" . "\"") | ||
| 74 | ("®" . "(R)") | ||
| 75 | ("›" . ")") | ||
| 76 | ("’" . "'") | ||
| 77 | ("§" . "§") | ||
| 78 | ("¹" . "^1") | ||
| 79 | ("²" . "^2") | ||
| 80 | ("³" . "^3") | ||
| 81 | ("˜" . "~")) | ||
| 48 | "The map of entity to text. | 82 | "The map of entity to text. |
| 49 | 83 | ||
| 50 | This is an alist were each element is a dotted pair consisting of an | 84 | This 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. |
| 220 | If RAWP, don't actually parse the addresses, but instead return | ||
| 221 | a 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. | ||
| 330 | If it is nil, never close server until logout completes. Normally, | ||
| 331 | the value of this variable will be bound to a certain value to which | ||
| 332 | an application program that uses this module specifies on a per-server | ||
| 333 | basis.") | ||
| 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. | ||
| 413 | See 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. | ||
| 1223 | LIST-OF-VALUES is nil, or a plist with identifier and value | ||
| 1224 | strings to send to the server to identify the client. | ||
| 1225 | |||
| 1226 | Return a list of identifiers which server in BUFFER support, or | ||
| 1227 | nil if it doesn't support ID or returns no information. | ||
| 1228 | |||
| 1229 | If 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. |
| 1146 | If BUFFER is nil, the current buffer is assumed." | 1243 | If 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. |
| 274 | If t, delete immediately, if nil, never delete. If a positive number, delete | 282 | If t, delete immediately, if nil, never delete. If a positive number, delete |
| 275 | files older than number of days." | 283 | files 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." |
| 556 | Pass 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 | ||
| 37 | bytes 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 | ||
| 121 | 32 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 | ||
| 205 | integer 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. |
| 276 | It's best to delete old Path and Date headers before posting to avoid | 274 | It's best to delete old Path and Date headers before posting to avoid |
| 277 | any confusion." | 275 | any 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. | ||
| 472 | This 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. |
| 611 | The headers should be delimited by a line whose contents match the | 637 | The headers should be delimited by a line whose contents match the |
| 612 | variable `mail-header-separator'. | 638 | variable `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. | ||
| 691 | These 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. |
| 665 | If nil, always ignore the header. If it is t, use its value, but | 697 | If 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. | ||
| 781 | Folding `References' makes ancient versions of INN create incorrect | ||
| 782 | NOV 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. | ||
| 861 | Local value for message buffers. If non-nil, also turn on | ||
| 862 | auto-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 | ||
| 916 | Predefined functions include `message-insert-citation-line' and | ||
| 917 | `message-insert-formated-citation-line' (see the variable | ||
| 918 | `message-citation-line-format'). | ||
| 919 | |||
| 873 | Note that Gnus provides a feature where the reader can click on | 920 | Note 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, |
| 875 | people who read your message will have to change their Gnus | 922 | people who read your message will have to change their Gnus |
| 876 | configuration. See the variable `gnus-cite-attribution-suffix'." | 923 | configuration. 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 | |||
| 934 | The string is formatted using `format-spec'. The following | ||
| 935 | constructs 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 | |||
| 944 | All other format specifiers are passed to `format-time-string' | ||
| 945 | which is called using the date from the article your replying to. | ||
| 946 | Extracting the first (%F) and last name (%L) is done | ||
| 947 | heuristically, so you should always check it yourself. | ||
| 948 | |||
| 949 | Please 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. |
| 884 | Fix `message-cite-prefix-regexp' if it is set to an abnormal value. | 960 | Fix `message-cite-prefix-regexp' if it is set to an abnormal value. |
| 885 | See also `message-yank-cited-prefix'." | 961 | See 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. |
| 892 | Fix `message-cite-prefix-regexp' if it is set to an abnormal value. | 968 | Fix `message-cite-prefix-regexp' if it is set to an abnormal value. |
| 893 | See also `message-yank-prefix'." | 969 | See 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. | ||
| 977 | See 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. |
| 909 | Predefined functions include `message-cite-original' and | 992 | Predefined functions include `message-cite-original' and |
| 910 | `message-cite-original-without-signature'. | 993 | `message-cite-original-without-signature'. |
| 911 | Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." | 994 | Note 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. |
| 922 | This can also be a list of functions. Each function can find the | 1004 | This 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. |
| 932 | If t, the `message-signature-file' file will be inserted instead. | 1013 | If 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. |
| 942 | Ignored if the named file doesn't exist. | 1022 | Ignored if the named file doesn't exist. |
| 943 | If nil, don't insert a signature." | 1023 | If nil, don't insert a signature. |
| 1024 | If a path is specified, the value of `message-signature-directory' is ignored, | ||
| 1025 | even 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. | ||
| 1032 | Comes in handy if you have many such files, handled via posting styles for | ||
| 1033 | instance. | ||
| 1034 | If nil, `message-signature-file' is expected to specify the directory if | ||
| 1035 | needed." | ||
| 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. |
| 1078 | The default is `abbrev', which uses mailabbrev. nil switches | 1169 | The default is `abbrev', which uses mailabbrev. `ecomplete' uses |
| 1079 | mail aliases off." | 1170 | an electric completion mode. nil switches mail aliases off. |
| 1171 | This 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. | ||
| 1180 | When one of those commands is invoked to enter a character in To or Cc | ||
| 1181 | header, ecomplete will suggest the candidates of recipients (see also | ||
| 1182 | `message-mail-alias-type'). If you use some tool to enter non-ASCII | ||
| 1183 | text 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. |
| 1105 | A value of nil means exclude your own user name only." | 1208 | This can be a regexp or a list of regexps. Also, a value of nil means |
| 1209 | exclude 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. |
| 1130 | This can also be a list of regexps to match headers. Or a list | 1239 | This can also be a list of regexps to match headers. Or a list |
| 1131 | starting with `not' and followed by regexps." | 1240 | starting 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. |
| 1359 | The cdr of each entry is a function for applying the face to a region.") | 1481 | The 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. | ||
| 1620 | If `t', always generate hashcash headers. If `opportunistic', | ||
| 1621 | only generate hashcash headers if it can be done without the user | ||
| 1622 | waiting (i.e., only asynchronously). | ||
| 1623 | |||
| 1624 | You 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." | |||
| 1723 | The buffer is expected to be narrowed to just the header of the message; | 1869 | The buffer is expected to be narrowed to just the header of the message; |
| 1724 | see `message-narrow-to-headers-or-head'." | 1870 | see `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. |
| 1969 | See `message-mark-insert-begin' and `message-mark-insert-end'." | 2113 | See `message-mark-insert-begin' and `message-mark-insert-end'. |
| 1970 | (interactive "r") | 2114 | If 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. |
| 1980 | See `message-mark-insert-begin' and `message-mark-insert-end'." | 2125 | See `message-mark-insert-begin' and `message-mark-insert-end'. |
| 1981 | (interactive "fFile to insert: ") | 2126 | If 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. |
| 2560 | This function is intended to be called from `after-change-functions'. | 2725 | This function is intended to be called from `after-change-functions'. |
| 2561 | See also `message-forbidden-properties'." | 2726 | See 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 | |||
| 2845 | prefix FORCE is given." | 3016 | prefix 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) | 3137 | If a numberic argument or prefix arg is given, leave that number |
| 2967 | (let ((point (point))) | 3138 | of 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. |
| 2977 | Prefix arg means justify as well." | 3156 | Prefix 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. |
| 3244 | This function is used as the value of `fill-paragraph-function' in | ||
| 3245 | Message 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. |
| 3227 | Used to encode/decode possibly offensive messages (commonly in rec.humor). | 3414 | Used to encode/decode possibly offensive messages (commonly in rec.humor). |
| 3228 | With prefix arg, specifies the number of places to rotate each letter forward. | 3415 | With prefix arg, specifies the number of places to rotate each letter forward. |
| 3229 | Mail and USENET news headers are not rotated." | 3416 | Mail 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. |
| 3284 | The inserted text should be the region. | 3471 | The inserted text should be the region. |
| 3285 | When this function returns, the region is again around the modified text. | 3472 | When this function returns, the region is again around the modified text. |
| 3286 | 3473 | ||
| 3287 | Normally, indent each nonblank line `message-indentation-spaces' spaces. | 3474 | Normally, indent each nonblank line `message-indentation-spaces' spaces. |
| 3288 | However, if `message-yank-prefix' is non-nil, insert that prefix on each line." | 3475 | However, 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. | ||
| 3523 | If REMOVE is non-nil, remove newlines, too. | ||
| 3524 | |||
| 3525 | To 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 | |||
| 3545 | Note: Top posting is bad netiquette. Don't use it unless you | ||
| 3546 | really must. You probably want to set variable only for specific | ||
| 3547 | groups, e.g. using `gnus-posting-styles': | ||
| 3548 | |||
| 3549 | (eval (set (make-local-variable 'message-cite-reply-above) t)) | ||
| 3550 | |||
| 3551 | This 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. | |||
| 3338 | Just \\[universal-argument] as argument means don't indent, insert no | 3561 | Just \\[universal-argument] as argument means don't indent, insert no |
| 3339 | prefix, and don't delete any headers." | 3562 | prefix, 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 "\ | ||
| 3572 | Top posting is bad netiquette. Please don't top post unless you really must. | ||
| 3573 | Really 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." | 3625 | If STRIP-SIGNATURE is non-nil, strips off the signature from the |
| 3626 | original message. | ||
| 3627 | |||
| 3628 | This 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 | |||
| 3692 | See `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. | ||
| 3777 | This 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) | 3997 | START 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 | 3999 | not 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. |
| 4759 | If NOW, use that time instead." | 5111 | If 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 " | 5125 | In 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. |
| 5417 | If folding is disallowed, also check that the REFERENCES are less | 5794 | When sending via news, also check that the REFERENCES are less |
| 5418 | than 988 characters long, and if they are not, trim them until they are." | 5795 | than 988 characters long, and if they are not, trim them until |
| 5796 | they 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. | ||
| 6954 | If DONT-EMULATE-MIME is nil, this function does the MIME emulation on | ||
| 6955 | messages that don't conform to PGP/MIME described in RFC2015. HANDLES | ||
| 6956 | is 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. |
| 6777 | Works by overstriking characters. | 7216 | Works by overstriking characters. |
| 6778 | Called from program, takes two arguments START and END | 7217 | Called 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. |
| 6793 | Called from program, takes two arguments START and END | 7232 | Called from program, takes two arguments START and END |
| 6794 | which specify the range to operate on." | 7233 | which 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 | ||
| 6877 | See `gmm-tool-bar-from-list' for details on the format of the list." | 7316 | See `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 | ||
| 6897 | See `gmm-tool-bar-from-list' for details on the format of the list." | 7336 | See `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 | ||
| 6910 | See `gmm-tool-bar-from-list' for the format of the list." | 7349 | See `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'). | ||
| 7401 | Each 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. |
| 6961 | If nil, the function bound in `text-mode-map' or `global-map' is executed." | 7407 | If 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." | |||
| 7164 | address in `message-alternative-emails', looking at To, Cc and | 7616 | address in `message-alternative-emails', looking at To, Cc and |
| 7165 | From headers in the original article." | 7617 | From 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. |
| 370 | Each function takes a file name as input and returns a file name. | 370 | Each function takes a file name as input and returns a file name. |
| 371 | 371 | ||
| 372 | Ready-made functions include | 372 | Ready-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' | 374 | functions), `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 | |||
| 455 | When set to `always' or `known', you should add | ||
| 456 | \"multipart/signed\" to `gnus-buttonized-mime-types' to see | ||
| 457 | result 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. |
| 1137 | If NO-CACHE is non-nil, cached contents of a message/external-body part | 1149 | If NO-CACHE is non-nil, cached contents of a message/external-body part |
| 1138 | are ignored." | 1150 | are 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. |
| 1212 | PROMPT 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. | ||
| 130 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new | ||
| 131 | string containing the replacements. | ||
| 132 | |||
| 133 | This 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. | ||
| 138 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new | ||
| 139 | string containing the replacements. | ||
| 140 | |||
| 141 | This 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 | ||
| 384 | You may add pairs like (iso-8859-1 . windows-1252) here, | 387 | You 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 | |||
| 386 | superset of iso-8859-1." | 389 | superset 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. |
| 1237 | The returned file name (created by appending some random characters at the end | 1224 | The 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. | ||
| 1317 | To 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. | ||
| 1337 | Only when FORCE is t or `auto-compression-mode' is enabled and FILENAME | ||
| 1338 | agrees with `jka-compr-compression-info-list', decompression is done. | ||
| 1339 | Signal an error if FORCE is neither nil nor t and compressed data are | ||
| 1340 | not decompressed because `auto-compression-mode' is disabled. | ||
| 1341 | If INPLACE is nil, return decompressed data or nil without modifying | ||
| 1342 | the buffer. Otherwise, replace the buffer's contents with the | ||
| 1343 | decompressed 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. | ||
| 1410 | This function looks for the coding system magic cookie or examines the | ||
| 1411 | coding system specified by `file-coding-system-alist' being associated | ||
| 1412 | with FILENAME which defaults to `buffer-file-name'. Data compressed by | ||
| 1413 | gzip, 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. |
| 162 | Each element consist of the following entries: label, | 193 | Each element consist of the following entries: label, |
| 163 | start-regexp, end-regexp, extract-function, test-function. | 194 | start-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. | ||
| 244 | The 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. |
| 206 | Return that buffer." | 269 | Return that buffer. |
| 270 | |||
| 271 | If PROPERTIES is non-nil, PROPERTIES are applied to the buffer, | ||
| 272 | see `set-text-properties'. If PROPERTIES equals t, this means to | ||
| 273 | apply 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. | ||
| 117 | Whether 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. | ||
| 66 | Whether 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 "\ | ||
| 376 | Select keys for signing. | ||
| 377 | If 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 | ||
| 426 | Content-Transfer-Encoding: base64 | ||
| 427 | Content-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 "\ | ||
| 458 | Select recipients for encryption. | ||
| 459 | If 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 "\ | ||
| 494 | Content-Type: application/pkcs7-mime; | ||
| 495 | smime-type=enveloped-data; | ||
| 496 | name=smime.p7m | ||
| 497 | Content-Transfer-Encoding: base64 | ||
| 498 | Content-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. | ||
| 77 | Each element should be one of the following three forms: | ||
| 78 | |||
| 79 | (REGEXP . DISPOSITION) | ||
| 80 | (SUPERTYPE (SUBTYPE . DISPOSITION) (SUBTYPE . DISPOSITION)...) | ||
| 81 | (TYPE . DISPOSITION) | ||
| 82 | |||
| 83 | Where REGEXP is a string which matches the file name (if any) of an | ||
| 84 | attachment, SUPERTYPE, SUBTYPE and TYPE should be symbols which are a | ||
| 85 | MIME supertype (e.g., text), a MIME subtype (e.g., plain) and a MIME | ||
| 86 | type (e.g., text/plain) respectively, and DISPOSITION should be either | ||
| 87 | the string \"attachment\" or the string \"inline\". The value t for | ||
| 88 | SUPERTYPE, SUBTYPE or TYPE matches any of those types. The first | ||
| 89 | match 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. |
| 75 | It is necessary to work against a bug in certain clients." | 115 | It 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. | ||
| 1089 | If 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. |
| 1232 | If RAW, display a raw encoded MIME message." | 1320 | If RAW, display a raw encoded MIME message. |
| 1321 | |||
| 1322 | The 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), | ||
| 1325 | or 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. | ||
| 64 | Whether 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. | ||
| 366 | If 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. | ||
| 447 | If 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. | ||
| 464 | If 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. |
| 68 | Valid 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. | ||
| 124 | Whether 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 "\ | ||
| 1180 | Select keys for signing. | ||
| 1181 | If 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 "\ | ||
| 1261 | Select recipients for encryption. | ||
| 1262 | If 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 "\ | ||
| 1287 | Select keys for signing. | ||
| 1288 | If 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. |
| 246 | Evals ACCEPT-FORM in current buffer, where the article is. | 246 | Evals ACCEPT-FORM in current buffer, where the article is. |
| 247 | Optional LAST is ignored." | 247 | Optional 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. | ||
| 47 | The headers in this variable and the ones in `message-required-headers' | ||
| 48 | are 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. |
| 707 | It has been reported numerous times that `directory-files' fails with | 726 | It has been reported numerous times that `directory-files' fails with |
| 708 | an alarming frequency on NFS mounted file systems. If it is nil, | 727 | an 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. |
| 255 | Some servers seem to need this under some circumstances.") | 255 | Some 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. | ||
| 259 | If it is nil, never close server until logout completes. This variable | ||
| 260 | overrides `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.") | |||
| 417 | If this is 'imap-mailbox-lsub, then use a server-side subscription list to | 422 | If this is 'imap-mailbox-lsub, then use a server-side subscription list to |
| 418 | restrict visible folders.") | 423 | restrict visible folders.") |
| 419 | 424 | ||
| 425 | (defcustom nnimap-id nil | ||
| 426 | "Plist with client identity to send to server upon login. | ||
| 427 | Nil means no information is sent, symbol `no' to disable ID query | ||
| 428 | alltogheter, or plist with identifier-value pairs to send to | ||
| 429 | server. 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 | |||
| 455 | An 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. |
| 422 | Note that username, passwords and other privacy sensitive | 464 | Note 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. |
| 456 | If SERVER is nil, uses the current server." | 506 | If 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. |
| 806 | Return nil if the server couldn't be closed for some reason." | 868 | Return 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." | |||
| 820 | All buffers that have been created by that | 885 | All buffers that have been created by that |
| 821 | backend should be killed. (Not the nntp-server-buffer, though.) This | 886 | backend should be killed. (Not the nntp-server-buffer, though.) This |
| 822 | function is generally only called when Gnus is shutting down." | 887 | function 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 | ||
| 303 | If you have xwatch running, this will alert it that mail has been | 305 | If you have xwatch running, this will alert it that mail has been |
| 304 | read. | 306 | read. |
| @@ -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 | |||
| 476 | word according to the `nnmail-split-fancy-syntax-table' syntax table. | 478 | word according to the `nnmail-split-fancy-syntax-table' syntax table. |
| 477 | You can use \".*\" in the regexps to match partial field names or words. | 479 | You can use \".*\" in the regexps to match partial field names or words. |
| 478 | 480 | ||
| 479 | FIELD and VALUE can also be lisp symbols, in that case they are expanded | 481 | FIELD and VALUE can also be Lisp symbols, in that case they are expanded |
| 480 | as specified in `nnmail-split-abbrev-alist'. | 482 | as specified in `nnmail-split-abbrev-alist'. |
| 481 | 483 | ||
| 482 | GROUP can contain \\& and \\N which will substitute from matching | 484 | GROUP 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. | ||
| 1295 | See `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 | |||
| 1303 | Eudora 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. |
| 1329 | See the documentation for the variable `nnmail-split-fancy' for details." | 1346 | See 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 | |||
| 90 | If it is a string, use it as the file extension which specifies | ||
| 91 | the compression program. You can set it to \".bz2\" if your Emacs | ||
| 92 | supports auto-compression using the bzip2 program. A value of t | ||
| 93 | is equivalent to \".gz\".") | ||
| 94 | |||
| 95 | (defvoo nnml-compressed-files-size-threshold 1000 | ||
| 96 | "Default size threshold for compressed message files. | ||
| 97 | Message files with bodies larger than that many characters will | ||
| 98 | be automatically compressed if `nnml-use-compressed-files' is | ||
| 99 | non-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) | 696 | GROUP-ART is a list that each element is a cons of a group name and an |
| 626 | (setq chars (nnmail-insert-lines)) | 697 | article 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 | |
| 857 | Unless 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. | ||
| 55 | Some RSS feeds update article fields during their lives, e.g. to | ||
| 56 | indicate the number of comments or the number of times the | ||
| 57 | articles have been seen. However, if there is a difference | ||
| 58 | between the local article and the distant one, the latter is | ||
| 59 | considered to be new. To avoid this and discard some fields, set | ||
| 60 | this 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. | |||
| 83 | ARTICLE is the article number of the current headline.") | 92 | ARTICLE 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. |
| 96 | If you run Gnus with various versions of Emacsen, the value of this | ||
| 97 | variable should be the coding system that all those Emacsen support. | ||
| 98 | Note that you have to regenerate all the nnrss groups if you change | ||
| 99 | the value. Moreover, you should be patient even if you are made to | ||
| 100 | read the same articles twice, that arises for the difference of the | ||
| 101 | versions 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, | |||
| 391 | otherwise return nil." | 407 | otherwise 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 | ||
| 87 | Indirect connections: | 89 | Indirect 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. |
| 112 | This command is used by the various nntp-open-via-* methods.") | 115 | This 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. |
| 119 | This is \"\\r\\n\" by default, but should be \"\\n\" when | 123 | This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect |
| 120 | using an indirect connection method (nntp-open-via-*).") | 124 | connection 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. |
| 124 | This command is used by the `nntp-open-via-rlogin-and-telnet' method. | 128 | This command is used by the methods `nntp-open-via-rlogin-and-telnet' |
| 125 | The default is \"rsh\", but \"ssh\" is a popular alternative.") | 129 | and `nntp-open-via-rlogin-and-netcat'. The default is \"rsh\", but \"ssh\" |
| 130 | is 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. | ||
| 148 | This 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. |
| 143 | This variable is used by the `nntp-open-via-telnet-and-telnet' method.") | 155 | This 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. |
| 151 | This variable is used by the `nntp-open-via-rlogin-and-telnet' and | 163 | This 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. | ||
| 223 | See `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 | ||
| 1064 | If SEND-IF-FORCE, only send authinfo to the server if the | 1143 | If 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. | ||
| 1922 | First rlogin to the remote host, and then connect to the real news | ||
| 1923 | server from there using the netcat command. | ||
| 1924 | |||
| 1925 | Please 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. |
| 1852 | First telnet the remote host, and then telnet the real news server | 1952 | First 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 | |||
| 664 | the result." | 659 | the 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. | ||
| 73 | USER is a string representing a user name to be authenticated and | ||
| 74 | DOMAIN is a NT domain. USER can include a NT domain part as in | ||
| 75 | user@domain where the string after @ is used as the domain if DOMAIN | ||
| 76 | is 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 | ||
| 116 | the NTLM based server for the user USER and the password hash list | ||
| 117 | PASSWORD-HASHES. NTLM uses two hash values which are represented | ||
| 118 | by 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 | ||
| 224 | little-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 | ||
| 244 | string 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 | ||
| 252 | string PASSWD based on the DES encryption. PASSWD is of at most 14 | ||
| 253 | bytes 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 | ||
| 261 | string 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 | ||
| 276 | a 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 | ||
| 419 | PERM 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. | ||
| 428 | length 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. | ||
| 442 | Length of IN and KEY are 64. FORW non nill means forward, nil means | ||
| 443 | backward." | ||
| 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 | ||
| 522 | into 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. | ||
| 72 | Whether 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. | ||
| 81 | Custom variables `password-cache' and `password-cache-expiry' | ||
| 82 | regulate 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. | ||
| 89 | KEY indicate the purpose of the password, so the cache can | ||
| 90 | separate passwords. The cache is not used if KEY is nil. It is | ||
| 91 | typically a string. | ||
| 92 | The 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. | ||
| 98 | Then store the password in the cache. Uses `password-read' and | ||
| 99 | `password-cache-add'. | ||
| 100 | Custom variables `password-cache' and `password-cache-expiry' | ||
| 101 | regulate 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. | ||
| 109 | This is typically run be a timer setup from `password-cache-add', | ||
| 110 | but can be invoked at any time to forcefully remove passwords | ||
| 111 | from the cache. This may be useful when it has been detected | ||
| 112 | that a password is invalid, so that `password-read' query the | ||
| 113 | user 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. | ||
| 123 | The password is removed by a timer after `password-cache-expiry' | ||
| 124 | seconds." | ||
| 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. | ||
| 210 | This may be either nil (plain connexion), `ssl' (use an | ||
| 211 | SSL/TSL-secured stream) or `starttls' (use the starttls mechanism | ||
| 212 | to turn on TLS security after opening the stream). However, if | ||
| 213 | this is nil, `ssl' is assumed for connexions to port | ||
| 214 | 995 (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. |
| 206 | Returns the process associated with the connection." | 223 | Returns 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. | ||
| 38 | The syntax table of the current buffer is saved, BODY is evaluated, and the | ||
| 39 | saved table is restored, even in case of an abnormal exit. | ||
| 40 | Value 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. |
| 177 | Quoting will not be done in a quoted string if it contains characters | 148 | Quoting will not be done in a quoted string if it contains characters |
| 178 | matching ENCODABLE-REGEXP." | 149 | matching 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. | ||
| 56 | The value is a cons cell of the form \(realm nonce qop-options stale maxbuf | ||
| 57 | charset 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 | ||
| 40 | authentication 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. | ||
| 44 | Called from 'sasl-next-step. | ||
| 45 | CLIENT is a vector [mechanism user service server sasl-client-properties] | ||
| 46 | STEP 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 | ||
| 52 | challenge 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. | ||
| 65 | NAME is name of the authorization. SERVICE is name of the service desired. | ||
| 66 | SERVER 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. | ||
| 87 | The 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. | ||
| 107 | NAME is a IANA registered SASL mechanism name. | ||
| 108 | STEPS 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. | ||
| 152 | The data type of the value and optional 2nd argument STEP is nil or | ||
| 153 | opaque authentication step which holds the reference to the next action | ||
| 154 | and 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. | ||
| 178 | It 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 | |||
| 123 | stream." | 128 | stream." |
| 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. | ||
| 87 | STYLE specifies which style to use, see `smiley-style'. If STYLE | ||
| 88 | is 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. |
| 80 | The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in | 121 | The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in |
| 81 | regexp to replace with IMAGE. IMAGE is the name of an image file in | 122 | regexp 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. | ||
| 42 | FILTER is the search filter in RFC1558 syntax. | ||
| 43 | HOST is the LDAP host on which to perform the search. | ||
| 44 | ATTRIBUTES are the specific attributes to retrieve, nil means | ||
| 45 | retrieve all. | ||
| 46 | ATTRSONLY, if non-nil, retrieves the attributes only, without | ||
| 47 | the associated values. | ||
| 48 | If WITHDN is non-nil, each entry in the result will be prepended with | ||
| 49 | its distinguished name WITHDN. | ||
| 50 | Additional 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. | ||
| 81 | SEARCH-PLIST is a property list describing the search request. | ||
| 82 | Valid keys in that list are: | ||
| 83 | `host' is a string naming one or more (blank-separated) LDAP servers to | ||
| 84 | to 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 | ||
| 87 | for each matching entry. If nil, return all available attributes. | ||
| 88 | `attrsonly', if non-nil, indicates that only attributes are retrieved, | ||
| 89 | not 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 | ||
| 98 | its distinguished name DN. | ||
| 99 | The function returns a list of matching entries. Each entry is itself | ||
| 100 | an 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. | ||
| 136 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new | ||
| 137 | string containing the replacements. | ||
| 138 | |||
| 139 | This 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. | ||
| 239 | If needed search base, binddn, passwd, etc. for the LDAP host | ||
| 240 | must 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. |
| 263 | If `cache-key' and `password-cache' is non-nil then cache the | ||
| 264 | password 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 | |||
| 270 | included, KEYFILE may be the file containing the PEM encoded private | 296 | included, KEYFILE may be the file containing the PEM encoded private |
| 271 | key and certificate itself." | 297 | key 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 | |||
| 408 | in the buffer specified by `smime-details-buffer'." | 434 | in 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. | ||
| 85 | If not set, the user will be prompted to enter a value which will be | ||
| 86 | saved 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'. |
| 85 | This variable will store the value of `spam-report-url-ping-function' from | 92 | This variable will store the value of `spam-report-url-ping-function' from |
| 86 | before `spam-report-agentize' was run, so that `spam-report-deagentize' can | 93 | before `spam-report-agentize' was run, so that `spam-report-deagentize' can |
| 87 | undo that change.") | 94 | undo 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. |
| 98 | Reports 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. | ||
| 220 | This 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 | 168 | If `spam-stat-split-fancy' is used in fancy splitting rules. Has |
| 168 | effect when spam-stat is invoked through spam.el." | 169 | no 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. | ||
| 185 | Called one by one on the buffer. | ||
| 186 | |||
| 187 | If all of these functions return non-nil answers, these numerical | ||
| 188 | answers are added to the computed spam stat score on the buffer. If | ||
| 189 | you defun such functions, make sure they don't return the buffer in a | ||
| 190 | narrowed state or such: use, for example, `save-excursion'. Each of | ||
| 191 | your functions is also passed the initial spam-stat score which might | ||
| 192 | aid in your scoring. | ||
| 193 | |||
| 194 | Also be careful when defining such functions. If they take a long | ||
| 195 | time, they will slow down your mail splitting. Thus, if the buffer is | ||
| 196 | large, don't forget to use smaller regions, by wrapping your work in, | ||
| 197 | say, `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. | ||
| 203 | When using `spam-stat-process-spam-directory' or | ||
| 204 | `spam-stat-process-non-spam-directory', only files that have | ||
| 205 | been touched in this many days will be considered. Without | ||
| 206 | this filter, re-training spam-stat with several thousand messages | ||
| 207 | will 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) "\ | ||
| 213 | Evaluate BODY with syntax table of current buffer set to a copy of TABLE. | ||
| 214 | The syntax table of the current buffer is saved, BODY is evaluated, and the | ||
| 215 | saved table is restored, even in case of an abnormal exit. | ||
| 216 | Value 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'. |
| 242 | This uses `gnus-article-buffer'." | 252 | This 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', | |||
| 403 | With a prefix argument save unconditionally." | 416 | With 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) | 425 | spam-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, | |||
| 433 | NBAD is the number of bad mails it has appeared in, GOOD is the number | 456 | NBAD is the number of bad mails it has appeared in, GOOD is the number |
| 434 | of times it appeared in good mails, and BAD is the number of times it | 457 | of times it appeared in good mails, and BAD is the number of times it |
| 435 | has appeared in bad mails." | 458 | has 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 | |||
| 466 | These are the words whose spam-stat differs the most from 0.5. | 490 | These are the words whose spam-stat differs the most from 0.5. |
| 467 | The list returned contains elements of the form \(WORD SCORE DIFF), | 491 | The list returned contains elements of the form \(WORD SCORE DIFF), |
| 468 | where DIFF is the difference between SCORE and 0.5." | 492 | where 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. |
| 505 | Add 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. |
| 491 | Use this function on `nnmail-split-fancy'. If you are interested in | 535 | Use this function on `nnmail-split-fancy'. If you are interested in |
| 492 | the raw data used for the last run of `spam-stat-score-buffer', | 536 | the raw data used for the last run of `spam-stat-score-buffer', |
| 493 | check the variable `spam-stat-score-data'." | 537 | check 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. |
| 542 | If the result is 1.0, then all files are considered spam. | 596 | If the result is 1.0, then all files are considered spam. |
| 543 | If the result is 0.0, non of the files is considered spam. | 597 | If the result is 0.0, non of the files is considered spam. |
| 544 | You can use this to determine error rates." | 598 | You can use this to determine error rates. |
| 545 | (interactive "D") | 599 | |
| 600 | If VERBOSE is non-nil display names of files detected as spam or | ||
| 601 | non-spam in a temporary buffer. If it is the symbol `ham', | ||
| 602 | display 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. | ||
| 84 | Populated 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. | ||
| 94 | Note that setting the spam-use-move or spam-use-copy backends on | ||
| 95 | a 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. | ||
| 92 | When t, only ham and unclassified groups will have their spam moved | ||
| 93 | to the spam-process-destination. When nil, spam will also be moved from | ||
| 94 | spam 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. |
| 133 | When nil, all unread articles in a spam group are marked as | 134 | When 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. |
| 149 | destination. This is useful to prevent ham from ending up in the same spam | 150 | This is useful to prevent ham from ending up in the same spam |
| 150 | group after the resplit. Don't set this to t if you have spam-split as the | 151 | group after the resplit. Don't set this to t if you have `spam-split' as the |
| 151 | last rule in your split configuration." | 152 | last 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'. | ||
| 244 | Enable 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'. | ||
| 250 | Enable 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'. | ||
| 283 | Enable 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'. | ||
| 289 | Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees | ||
| 290 | them." | ||
| 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. |
| 280 | Default to t if one of the spam-use-* variables is set." | 322 | Default 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. | ||
| 344 | Only 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. |
| 351 | Only 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. |
| 357 | Only 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. |
| 383 | Only 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. |
| 389 | Only 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. |
| 395 | Only 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. |
| 401 | Only 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. | ||
| 578 | Hint: set this to \"spamc\" if you have spamd running. See the spamc and | ||
| 579 | spamd 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. | ||
| 586 | This 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 | ||
| 597 | identification" | ||
| 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 | ||
| 616 | Enable this if you want sa-learn to rebuild the database automatically. Doing | ||
| 617 | this will slightly increase the running time of the spam registration process. | ||
| 618 | If you choose not to do this, you will have to run \"sa-learn --rebuild\" in | ||
| 619 | order 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 |
| 711 | finds 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. | ||
| 734 | When 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. | ||
| 836 | Accepts incoming CHECK, ham registration function HRF, spam | ||
| 837 | registration function SRF, ham unregistration function HUF, spam | ||
| 838 | unregistration function SUF, and an indication whether the | ||
| 839 | backend 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. | ||
| 854 | When TYPE is 'non-mover, only non-mover backends are returned. | ||
| 855 | When 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. | ||
| 873 | Each individual check may return nil, t, or a mailgroup name. | ||
| 874 | The value nil means that the check does not yield a decision, and | ||
| 875 | so, that further checks are needed. The value t means that the | ||
| 876 | message is definitely not spam, and that further spam checks | ||
| 877 | should be inhibited. Otherwise, a mailgroup name or the symbol | ||
| 878 | 'spam (depending on spam-split-symbolic-return) is returned where | ||
| 879 | the mail should go, and further checks are also inhibited. The | ||
| 880 | usual mailgroup name is the value of `spam-split-group', meaning | ||
| 881 | that 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. | ||
| 905 | TYPE is 'registration or 'unregistration. | ||
| 906 | CLASSIFICATION 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. | ||
| 935 | With UNREGISTER, get articles to be unregistered. | ||
| 936 | This 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. | ||
| 943 | With UNREGISTER, set articles to be unregistered. | ||
| 944 | This 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. | ||
| 976 | The 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. | ||
| 990 | Accepts ham registration function HRF, spam registration function | ||
| 991 | SRF, ham unregistration function HUF, spam unregistration | ||
| 992 | function SUF. The backend has no incoming check and can't be | ||
| 993 | statistical." | ||
| 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. | ||
| 1000 | Accepts ham registration function HRF, spam registration function | ||
| 1001 | SRF, ham unregistration function HUF, spam unregistration | ||
| 1002 | function SUF. The backend has no incoming check and can't be | ||
| 1003 | statistical (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. | ||
| 1010 | Accepts incoming CHECK, ham registration function HRF, spam | ||
| 1011 | registration function SRF, ham unregistration function HUF, spam | ||
| 1012 | unregistration function SUF. The backend won't be | ||
| 1013 | statistical (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. | ||
| 1020 | Accepts incoming CHECK, ham registration function HRF, spam | ||
| 1021 | registration function SRF, ham unregistration function HUF, spam | ||
| 1022 | unregistration function SUF. The backend will be | ||
| 1023 | statistical (use spam-install-backend for non-statistical | ||
| 1024 | backends)." | ||
| 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. | ||
| 1197 | The 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. | ||
| 1201 | Note 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. | ||
| 1224 | With SPECIFIC-HEADER, returns only that header's score. | ||
| 1225 | Will 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. |
| 534 | ham/spam exit processor variable with a classification and a | 1286 | This list contains pairs associating the obsolete ham/spam exit |
| 535 | spam-use-* variable.") | 1287 | processor variables with a classification and a spam-use-* |
| 536 | 1288 | variable. When the processor variable is nil, just the | |
| 537 | (defun spam-group-processor-p (group processor) | 1289 | classification and spam-use-* check variable are used. This is |
| 1290 | superceded by the new spam backend code, so it's only consulted | ||
| 1291 | for backwards compatibility.") | ||
| 1292 | |||
| 1293 | (defun spam-group-processor-p (group backend &optional classification) | ||
| 1294 | "Checks if GROUP has a BACKEND with CLASSIFICATION registered. | ||
| 1295 | Also accepts the obsolete processors, which can be found in | ||
| 1296 | gnus.el and in spam-list-of-processors. In the case of mover | ||
| 1297 | backends, checks the setting of spam-summary-exit-behavior in | ||
| 1298 | addition 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) | 1548 | When PREPARED-DATA-HEADER is given, don't look in the Gnus data. |
| 837 | (assoc article (gnus-data-list nil))) | 1549 | When FIELD is 'number, ARTICLE can be any number (since we want |
| 838 | (mail-header-from | 1550 | to 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 | ||
| 877 | parameter variable with a spam checking function. If the | ||
| 878 | parameter variable is true, then the checking function is called, | ||
| 879 | and its value decides what happens. Each individual check may | ||
| 880 | return nil, t, or a mailgroup name. The value nil means that the | ||
| 881 | check does not yield a decision, and so, that further checks are | ||
| 882 | needed. The value t means that the message is definitely not | ||
| 883 | spam, and that further spam checks should be inhibited. | ||
| 884 | Otherwise, a mailgroup name or the symbol 'spam (depending on | ||
| 885 | spam-split-symbolic-return) is returned where the mail should go, | ||
| 886 | and further checks are also inhibited. The usual mailgroup name | ||
| 887 | is the value of `spam-split-group', meaning that the message is | ||
| 888 | definitely 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 | ||
| 897 | splitters 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. |
| 902 | This function can be used as an entry in the variable `nnmail-split-fancy', | 1621 | This 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 | ||
| 1037 | associating a parameter variable with the ham and spam | ||
| 1038 | registration functions, and the ham and spam unregistration | ||
| 1039 | functions") | ||
| 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)." | |||
| 1522 | With a non-nil REMOVE, remove them." | 2297 | With 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." | |||
| 1530 | With a non-nil REMOVE, remove them." | 2306 | With 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. |
| 2899 | When SYMBOLS is given, set those variables to t. This is so you | ||
| 2900 | can call spam-initialize before you set spam-use-* variables on | ||
| 2901 | explicitly, and matters only if you need the extra headers | ||
| 2902 | installed 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. | ||
| 143 | Matches a machine from MACHINES and a port from PORTS, giving | ||
| 144 | default ports DEFAULTS to `netrc-machine'. | ||
| 145 | |||
| 146 | MODE 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 |