summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/calendar/time-date.el9
-rw-r--r--lisp/gnus/ChangeLog11352
-rw-r--r--lisp/gnus/ChangeLog.218924
-rw-r--r--lisp/gnus/TODO193
-rw-r--r--lisp/gnus/bar.xbm7
-rw-r--r--lisp/gnus/bar.xpm54
-rw-r--r--lisp/gnus/binhex.el68
-rw-r--r--lisp/gnus/blink.pbmbin0 -> 37 bytes
-rw-r--r--lisp/gnus/blink.xpm20
-rw-r--r--lisp/gnus/braindamaged.xpm20
-rw-r--r--lisp/gnus/canlock.el251
-rw-r--r--lisp/gnus/catchup.xpm104
-rw-r--r--lisp/gnus/compface.el58
-rw-r--r--lisp/gnus/cry.xpm20
-rw-r--r--lisp/gnus/cu-exit.xpm93
-rw-r--r--lisp/gnus/dead.xpm20
-rw-r--r--lisp/gnus/describe-group.xpm102
-rw-r--r--lisp/gnus/deuglify.el472
-rw-r--r--lisp/gnus/dig.el189
-rw-r--r--lisp/gnus/dns.el359
-rw-r--r--lisp/gnus/earcon.el10
-rw-r--r--lisp/gnus/evil.xpm20
-rw-r--r--lisp/gnus/exit-gnus.xpm107
-rw-r--r--lisp/gnus/exit-summ.xpm73
-rw-r--r--lisp/gnus/flow-fill.el135
-rw-r--r--lisp/gnus/followup.xpm83
-rw-r--r--lisp/gnus/forced.xpm20
-rw-r--r--lisp/gnus/frown.xpm20
-rw-r--r--lisp/gnus/fuwo.xpm82
-rw-r--r--lisp/gnus/get-news.xpm97
-rw-r--r--lisp/gnus/gnntg.xpm93
-rw-r--r--lisp/gnus/gnus-agent.el3469
-rw-r--r--lisp/gnus/gnus-art.el4177
-rw-r--r--lisp/gnus/gnus-async.el22
-rw-r--r--lisp/gnus/gnus-audio.el14
-rw-r--r--lisp/gnus/gnus-bcklg.el53
-rw-r--r--lisp/gnus/gnus-cache.el156
-rw-r--r--lisp/gnus/gnus-cite.el258
-rw-r--r--lisp/gnus/gnus-cus.el474
-rw-r--r--lisp/gnus/gnus-delay.el196
-rw-r--r--lisp/gnus/gnus-demon.el56
-rw-r--r--lisp/gnus/gnus-diary.el461
-rw-r--r--lisp/gnus/gnus-dired.el207
-rw-r--r--lisp/gnus/gnus-draft.el107
-rw-r--r--lisp/gnus/gnus-dup.el10
-rw-r--r--lisp/gnus/gnus-eform.el8
-rw-r--r--lisp/gnus/gnus-ems.el172
-rw-r--r--lisp/gnus/gnus-fun.el252
-rw-r--r--lisp/gnus/gnus-gl.el28
-rw-r--r--lisp/gnus/gnus-group.el1536
-rw-r--r--lisp/gnus/gnus-int.el229
-rw-r--r--lisp/gnus/gnus-kill.el60
-rw-r--r--lisp/gnus/gnus-logic.el42
-rw-r--r--lisp/gnus/gnus-mh.el3
-rw-r--r--lisp/gnus/gnus-ml.el53
-rw-r--r--lisp/gnus/gnus-mlspl.el43
-rw-r--r--lisp/gnus/gnus-msg.el1258
-rw-r--r--lisp/gnus/gnus-mule.el75
-rw-r--r--lisp/gnus/gnus-nocem.el8
-rw-r--r--lisp/gnus/gnus-picon.el283
-rw-r--r--lisp/gnus/gnus-pointer.xbm6
-rw-r--r--lisp/gnus/gnus-pointer.xpm22
-rw-r--r--lisp/gnus/gnus-range.el214
-rw-r--r--lisp/gnus/gnus-registry.el703
-rw-r--r--lisp/gnus/gnus-salt.el197
-rw-r--r--lisp/gnus/gnus-score.el254
-rw-r--r--lisp/gnus/gnus-setup.el9
-rw-r--r--lisp/gnus/gnus-sieve.el240
-rw-r--r--lisp/gnus/gnus-soup.el51
-rw-r--r--lisp/gnus/gnus-spec.el357
-rw-r--r--lisp/gnus/gnus-srvr.el369
-rw-r--r--lisp/gnus/gnus-start.el756
-rw-r--r--lisp/gnus/gnus-sum.el5164
-rw-r--r--lisp/gnus/gnus-topic.el327
-rw-r--r--lisp/gnus/gnus-undo.el4
-rw-r--r--lisp/gnus/gnus-util.el918
-rw-r--r--lisp/gnus/gnus-uu.el257
-rw-r--r--lisp/gnus/gnus-vm.el2
-rw-r--r--lisp/gnus/gnus-win.el69
-rw-r--r--lisp/gnus/gnus.el1796
-rw-r--r--lisp/gnus/gnus.xbm622
-rw-r--r--lisp/gnus/gnus.xpm284
-rw-r--r--lisp/gnus/grin.xpm21
-rw-r--r--lisp/gnus/hex-util.el74
-rw-r--r--lisp/gnus/html2text.el550
-rw-r--r--lisp/gnus/ietf-drums.el77
-rw-r--r--lisp/gnus/imap.el732
-rw-r--r--lisp/gnus/important.xpm32
-rw-r--r--lisp/gnus/indifferent.xpm20
-rw-r--r--lisp/gnus/kill-group.xpm78
-rw-r--r--lisp/gnus/mail-parse.el13
-rw-r--r--lisp/gnus/mail-prsvr.el2
-rw-r--r--lisp/gnus/mail-reply.xpm81
-rw-r--r--lisp/gnus/mail-source.el293
-rw-r--r--lisp/gnus/mailcap.el145
-rw-r--r--lisp/gnus/message.el3714
-rw-r--r--lisp/gnus/messcompat.el4
-rw-r--r--lisp/gnus/mm-bodies.el166
-rw-r--r--lisp/gnus/mm-decode.el996
-rw-r--r--lisp/gnus/mm-encode.el99
-rw-r--r--lisp/gnus/mm-extern.el169
-rw-r--r--lisp/gnus/mm-partial.el28
-rw-r--r--lisp/gnus/mm-url.el450
-rw-r--r--lisp/gnus/mm-util.el276
-rw-r--r--lisp/gnus/mm-uu.el584
-rw-r--r--lisp/gnus/mm-view.el545
-rw-r--r--lisp/gnus/mml-sec.el293
-rw-r--r--lisp/gnus/mml-smime.el201
-rw-r--r--lisp/gnus/mml.el810
-rw-r--r--lisp/gnus/mml1991.el307
-rw-r--r--lisp/gnus/mml2015.el918
-rw-r--r--lisp/gnus/next-ur.xpm99
-rw-r--r--lisp/gnus/nnagent.el94
-rw-r--r--lisp/gnus/nnbabyl.el18
-rw-r--r--lisp/gnus/nndb.el331
-rw-r--r--lisp/gnus/nndiary.el1712
-rw-r--r--lisp/gnus/nndoc.el76
-rw-r--r--lisp/gnus/nndraft.el65
-rw-r--r--lisp/gnus/nneething.el109
-rw-r--r--lisp/gnus/nnfolder.el661
-rw-r--r--lisp/gnus/nngateway.el5
-rw-r--r--lisp/gnus/nnheader.el436
-rw-r--r--lisp/gnus/nnimap.el915
-rw-r--r--lisp/gnus/nnkiboze.el212
-rw-r--r--lisp/gnus/nnlistserv.el17
-rw-r--r--lisp/gnus/nnmail.el582
-rw-r--r--lisp/gnus/nnmaildir.el1627
-rw-r--r--lisp/gnus/nnmbox.el223
-rw-r--r--lisp/gnus/nnmh.el33
-rw-r--r--lisp/gnus/nnml.el373
-rw-r--r--lisp/gnus/nnnil.el83
-rw-r--r--lisp/gnus/nnoo.el24
-rw-r--r--lisp/gnus/nnrss.el771
-rw-r--r--lisp/gnus/nnslashdot.el99
-rw-r--r--lisp/gnus/nnsoup.el12
-rw-r--r--lisp/gnus/nnspool.el15
-rw-r--r--lisp/gnus/nntp.el1355
-rw-r--r--lisp/gnus/nnultimate.el61
-rw-r--r--lisp/gnus/nnvirtual.el32
-rw-r--r--lisp/gnus/nnwarchive.el82
-rw-r--r--lisp/gnus/nnweb.el635
-rw-r--r--lisp/gnus/nnwfm.el432
-rw-r--r--lisp/gnus/pgg-def.el91
-rw-r--r--lisp/gnus/pgg-gpg.el274
-rw-r--r--lisp/gnus/pgg-parse.el516
-rw-r--r--lisp/gnus/pgg-pgp.el242
-rw-r--r--lisp/gnus/pgg-pgp5.el249
-rw-r--r--lisp/gnus/pgg.el468
-rw-r--r--lisp/gnus/pop3.el33
-rw-r--r--lisp/gnus/post.xpm86
-rw-r--r--lisp/gnus/prev-ur.xpm98
-rw-r--r--lisp/gnus/preview.xbm10
-rw-r--r--lisp/gnus/preview.xpm33
-rw-r--r--lisp/gnus/qp.el21
-rw-r--r--lisp/gnus/receipt.xpm32
-rw-r--r--lisp/gnus/reply-wo.xpm94
-rw-r--r--lisp/gnus/reply.xpm93
-rw-r--r--lisp/gnus/reverse-smile.xpm20
-rw-r--r--lisp/gnus/rfc1843.el12
-rw-r--r--lisp/gnus/rfc2045.el2
-rw-r--r--lisp/gnus/rfc2047.el340
-rw-r--r--lisp/gnus/rfc2231.el40
-rw-r--r--lisp/gnus/rot13.xpm80
-rw-r--r--lisp/gnus/sad.pbmbin0 -> 37 bytes
-rw-r--r--lisp/gnus/sad.xpm20
-rw-r--r--lisp/gnus/save-aif.xpm86
-rw-r--r--lisp/gnus/save-art.xpm92
-rw-r--r--lisp/gnus/score-mode.el10
-rw-r--r--lisp/gnus/sha1.el441
-rw-r--r--lisp/gnus/sieve-manage.el616
-rw-r--r--lisp/gnus/sieve-mode.el205
-rw-r--r--lisp/gnus/sieve.el384
-rw-r--r--lisp/gnus/smile.xpm20
-rw-r--r--lisp/gnus/smiley.el (renamed from lisp/gnus/smiley-ems.el)141
-rw-r--r--lisp/gnus/smime.el644
-rw-r--r--lisp/gnus/spam-report.el127
-rw-r--r--lisp/gnus/spam-stat.el600
-rw-r--r--lisp/gnus/spam.el1827
-rw-r--r--lisp/gnus/subscribe.xpm79
-rw-r--r--lisp/gnus/unimportant.xpm32
-rw-r--r--lisp/gnus/unsubscribe.xpm78
-rw-r--r--lisp/gnus/utf7.el117
-rw-r--r--lisp/gnus/uu-decode.xpm82
-rw-r--r--lisp/gnus/uu-post.xpm90
-rw-r--r--lisp/gnus/uudecode.el194
-rw-r--r--lisp/gnus/webmail.el122
-rw-r--r--lisp/gnus/wry.xpm20
-rw-r--r--lisp/gnus/yenc.el121
-rw-r--r--lisp/net/tls.el2
190 files changed, 67575 insertions, 23672 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0ae0ccc7def..dd83a9524e2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -773,6 +773,16 @@
* ps-print.el (ps-begin-file): Improve the DSC compliance of the
generated PostScript.
+2004-08-17 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * net/tls.el (tls-process-connection-type): Fix docstring. (Sync
+ with Gnus v5_10 branch.)
+
+2004-08-16 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * calendar/time-date.el (time-to-number-of-days): New function.
+ Imported from from Gnus.
+
2004-07-22 Kim F. Storm <storm@cua.dk>
* progmodes/make-mode.el: Fix comments.
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 6439089273a..3a850717298 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,5 +1,5 @@
;;; time-date.el --- date and time handling functions
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2004 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
@@ -38,7 +38,7 @@
(parse-time-string
;; `parse-time-string' isn't sufficiently general or
;; robust. It fails to grok some of the formats that
- ;; timzeone does (e.g. dodgy post-2000 stuff from some
+ ;; timezone does (e.g. dodgy post-2000 stuff from some
;; Elms) and either fails or returns bogus values. Lars
;; reverted this change, but that loses non-trivially
;; often for me. -- fx
@@ -177,6 +177,11 @@ The Gregorian date Sunday, December 31, 1bce is imaginary."
(- (/ (1- year) 100)) ; - century years
(/ (1- year) 400)))) ; + Gregorian leap years
+(defun time-to-number-of-days (time)
+ "Return the number of days represented by TIME.
+The number of days will be returned as a floating point number."
+ (/ (+ (* 1.0 65536 (car time)) (cadr time)) (* 60 60 24)))
+
;;;###autoload
(defun safe-date-to-time (date)
"Parse a string that represents a date-time and return a time value.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 8169b014e16..83c74fe118d 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,11238 +1,370 @@
-2004-06-29 Kim F. Storm <storm@cua.dk>
+2004-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
- * nntp.el (nntp-authinfo-file): Add :group 'nntp.
-
- * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache):
- Add :group 'nnimap.
-
-2004-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mm-view.el (mm-insert-inline): Make it work in read-only buffer.
-
- * gnus-win.el (gnus-all-windows-visible-p): Don't consider
- non-visible windows.
-
-2004-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * rfc2047.el (rfc2047-encode-message-header): Don't encode non-address
- headers as address headers (which breaks if subject has a single ").
-
-2004-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * nnimap.el (nnimap-demule): Avoid string-as-multibyte.
-
-2004-04-21 Richard M. Stallman <rms@gnu.org>
-
- * mailcap.el (mailcap-mime-data): Mark as risky.
-
-2004-03-27 Juanma Barranquero <lektu@terra.es>
-
- * gnus-srvr.el (gnus-server-prepare): Remove spurious call to `cdr'.
-
-2004-03-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-art.el: Use inhibit-read-only instead of buffer-read-only.
- (gnus-narrow-to-page): Don't assume point-min == 1.
- (gnus-article-edit-mode): Derive from message-mode.
- (gnus-button-alist): Add buttons to (info "(emacs)Keymaps").
-
- * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume
- point-min == 1.
-
- * imap.el (imap-parse-address-list, imap-parse-body-ext):
- Disable incorrect use of `assert'.
-
-2004-03-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * message.el (message-mode): Fix last change.
-
-2004-03-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * message.el (message-mode): Set comment-start-skip.
-
-2004-02-08 Andreas Schwab <schwab@suse.de>
-
- * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting.
-
- * gnus-score.el (gnus-summary-increase-score): Fix format string.
-
-2003-06-25 Sam Steingold <sds@gnu.org>
-
- * gnus-group.el (gnus-group-suspend): Avoid some consing.
-
-2003-06-11 Sam Steingold <sds@gnu.org>
-
- * pop3.el (pop3-leave-mail-on-server): New user variable.
- (pop3-movemail): Delete mail only when it is nil.
-
-2003-05-10 Juanma Barranquero <lektu@terra.es>
-
- * message.el (message-buffer-naming-style): Fix typo.
-
-2003-05-07 Dave Love <fx@gnu.org>
-
- [Partial sync with Gnus.]
-
- * rfc2047.el (rfc2047-header-encoding-alist): Add Followup-To.
- (rfc2047-encode-message-header): Fold when encoding not necessary.
- (rfc2047-encode-region): Skip \n as whitespace.
- (rfc2047-fold-region): Fix whitespace regexps. Don't break just
- after the header name.
- (rfc2047-unfold-region): Fix regexp and whitespace-skipping.
-
-2003-05-06 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-cus.el (gnus-group-customize, gnus-score-parameters):
- Don't quote nil and t in docstrings.
-
- * gnus-score.el (gnus-score-lower-thread): Likewise.
-
- * gnus-art.el (gnus-article-mime-match-handle-function): Likewise.
-
-2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-accept-article): Don't use
- mail-header-unfold-field.
-
- * imap.el (imap-ssl-open): Don't depend on ssl.el.
- * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el.
-
-2003-02-18 Juanma Barranquero <lektu@terra.es>
-
- * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant.
-
-2003-02-14 Juanma Barranquero <lektu@terra.es>
-
- * mm-uu.el (mm-uu-dissect): Fix use of character constant.
-
-2003-02-11 Stefan Monnier <monnier@cs.yale.edu>
-
- * nntp.el (nntp-accept-process-output): Don't use point-max to get
- the buffer's size.
-
-2003-01-31 Joe Buehler <jhpb@draco.hekimian.com>
-
- * nnheader.el: Added cygwin to system-type comparisons.
-
-2003-01-27 Juanma Barranquero <lektu@terra.es>
-
- * imap.el (imap-mailbox-status): Fix typo.
-
-2003-01-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-alter-header-function): Add type and group.
-
-2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el: Don't use `path'.
-
- * nnsoup.el (nnsoup-file-name): Ditto.
-
- * nnmail.el (nnmail-pathname-coding-system): Ditto.
- (nnmail-group-pathname): Ditto.
-
- * nnimap.el (nnimap-group-overview-filename): Ditto.
-
- * nnheader.el (nnheader-pathname-coding-system): Ditto.
- (nnheader-group-pathname): Ditto.
-
- * nnfolder.el (nnfolder-group-pathname): Ditto.
-
- * gnus.el (gnus-home-directory): Ditto.
-
- * gnus-group.el (gnus-group-icon-list): Ditto.
-
-2003-01-04 Kim F. Storm <storm@cua.dk>
-
- * message.el (message-split-line): New function.
- (message-mode-map): Remap split-line to message-split-line.
-
-2002-11-29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smiley-ems.el (gnus-smiley-display): Typo.
-
- * nnvirtual.el: Typo.
-
- * nnsoup.el (nnsoup-retrieve-headers): Typo.
-
- * nnmail.el (nnmail-split, nnmail-process-unix-mail-format): Typos.
-
- * nnimap.el: Typo.
- (nnimap-split-rule, nnimap-find-minmax-uid): Typos.
-
- * mm-encode.el (mm-safer-encoding): Typo.
-
- * messcompat.el: Typo.
-
- * message.el (message-face-alist): Typo.
-
- * imap.el (imap-interactive-login, imap-anonymous-auth)
- (imap-open): Typos.
-
- * ietf-drums.el (ietf-drums-text-token, ietf-drums-qtext-token): Typos.
-
- * gnus.el: Typo.
-
- * gnus-win.el (gnus-configure-frame): Typo.
-
- * gnus-util.el (gnus-atomic-progn-assign): Typo.
-
- * gnus-topic.el (gnus-topic-sort-topics): Typo.
-
- * gnus-sum.el (gnus-summary-article-number)
- (gnus-summary-read-group-1, gnus-summary-mark-article)
- (gnus-summary-fetch-faq, gnus-refer-article-methods): Typos.
-
- * gnus-mule.el (gnus-mule-add-group): Typo.
-
- * gnus-mlspl.el (gnus-group-split-fancy): Typo.
-
- * gnus-group.el (gnus-group-fetch-faq): Typo.
-
- * gnus-art.el (gnus-decode-header-methods): Typo.
-
- * flow-fill.el: Typo.
-
-2002-11-19 Stefan Monnier <monnier@cs.yale.edu>
-
- * binhex.el (binhex-decode-region): Don't hardcode point-min == 1.
-
-2002-11-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-set-auto-save-file-name):
- Use make-directory, to avoid the dependence on gnus-util.
-
-2002-11-11 Markus Rost <rost@math.ohio-state.edu>
-
- * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open
- parens in column 0.
-
-2002-11-08 Markus Rost <rost@math.ohio-state.edu>
-
- * nnimap.el (nnimap-split-rule): Doc fix - escape open parens in
- column 0.
-
-2002-10-18 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-mime-mule-charset-alist): Require when compiling.
- (mm-auto-save-coding-system): Prefer utf-8-emacs coding system to
- emacs-mule.
- (mm-find-mime-charset-region): Fix :mime-charset part.
- (mm-mule-charset-to-mime-charset, mm-charset-to-coding-system)
- (mm-mime-charset, mm-find-mime-charset-region): Look for
- `:mime-charset' property of coding systems before `mime-charset'.
- (mm-mule4-p, mm-enable-multibyte-mule4, mm-disable-multibyte-mule4)
- (mm-with-unibyte-current-buffer-mule4): Deleted.
- (mm-point-at-bol, mm-point-at-eol, mm-insert-byte)
- (multibyte-char-to-unibyte): New.
-
- * rfc2047.el (message-posting-charset): defvar when compiling.
- (ietf-drums, gnus-util): Don't require.
- (rfc2047-header-encoding-alist): Add `address-mime' part. Doc fixes.
- (rfc2047-charset-encoding-alist): Use B for iso-8859-7,
- iso-8859-8.
- (rfc2047-q-encoding-alist): Augment header list.
- (rfc2047-encoding-type): New.
- (rfc2047-dissect-region): Deleted.
- (rfc2047-encode-region, rfc2047-encode): Rewritten to take
- account of rfc2047 rules with respect to rfc2822 tokens and to do
- encoding in place rather than by passing strings.
- (rfc2047-encode-message-header): Don't include header name field
- in encoding. Add `address-mime' case and bind
- rfc2047-encoding-type for `mime' case.
- (rfc2047-encode-string): Doc fix.
- (rfc2047-encode): Use longer chunks for base64.
- (rfc2047-fold-region): Insert single characters, not strings.
- (rfc2047-encoded-word-regexp): Wrap in eval-and-compile.
-
- * gnus-sum.el (gnus-summary-mode, gnus-summary-display-article)
- (gnus-summary-select-article, gnus-summary-edit-article):
- Use mm-{en,dis}able-multibyte, not mm-{en,dis}able-multibyte-mule4.
-
- * message.el (message-forward-make-body):
- Use mm-{en,dis}able-multibyte, not mm-{en,dis}able-multibyte-mule4.
-
- * qp.el (quoted-printable-encode-region): Use mm-insert-byte.
- Maybe use string-to-multibyte. Avoid find-charset-region.
- Cope with encoding Emacs 22 eight-bit chars.
-
- * mm-bodies.el (mm-body-7-or-8): Don't special-case Mule.
- (mm-encode-body): Just call mm-encode-coding-region in encoding case.
-
-2002-10-17 Juanma Barranquero <lektu@terra.es>
-
- * nnweb.el (nnweb-dejanews-create-mapping)
- (nnweb-reference-create-mapping, nnweb-altavista-create-mapping)
- (nnweb-google-create-mapping): Fix typos.
-
- * nnlistserv.el (nnlistserv-kk-create-mapping): Likewise.
-
- * gnus-nocem.el (gnus-nocem-liberal-fetch): Likewise.
-
- * gnus-cus.el (gnus-group-customize): Likewise.
-
- * gnus-util.el (gnus-parse-netrc): Likewise.
-
-2002-09-21 Rob Browning <rlb@defaultvalue.org>
-
- * gnus-art.el (gnus-article-x-face-command):
- Use gnus-article-compface-xbm if bound.
-
-2002-09-18 Rob Browning <rlb@defaultvalue.org>
-
- * gnus-art.el (gnus-article-x-face-command):
- Don't use gnus-article-compface-xbm.
-
-2002-09-06 Juanma Barranquero <lektu@terra.es>
-
- * gnus-int.el (gnus-status-message): Fix spacing.
-
-2002-08-30 Juanma Barranquero <lektu@terra.es>
-
- * imap.el (imap-authenticator-alist, imap-stream-alist)
- (imap-continuation): Fix typos.
-
-2002-08-23 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-expire-articles): expiry-target.
-
- * nnbabyl.el (nnbabyl-request-expire-articles): Ditto.
-
- * nnmbox.el (nnmbox-request-expire-articles): Ditto.
-
- * nnmh.el (nnmh-request-expire-articles):
- Implemented expiry-target for nnmh backend.
-
-2002-08-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-button-url-regexp): Use POSIX regexp if possible.
-
- * nnmh.el (nnmh-request-list-1): Use %.0f instead of %d to
- avoid arithmetic errors.
-
-2002-07-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent):
- Change cdaar to cdar and car.
-
- * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type)
- (nnsoup-read-active-file, nnsoup-article-to-area): Ditto.
-
-2002-07-03 Juanma Barranquero <lektu@terra.es>
-
- * gnus-sum.el (gnus-summary-highlight): Fix typo.
-
-2002-06-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-file-name-translation-alist): Set the
- default value for MS Windows systems.
-
- * gnus-ems.el (nnheader-file-name-translation-alist): Removed.
-
- * nndoc.el (nndoc-mime-digest-type-p): Set proper file-end.
- * nndoc.el: Add several new types.
-
-2002-05-16 Juanma Barranquero <lektu@terra.es>
-
- * gnus-art.el (gnus-mime-copy-part): Fix typo.
-
-2002-05-09 Miles Bader <miles@gnu.org>
-
- * gnus-cite.el (gnus-cite-blank-line-after-header): New variable.
- (gnus-article-hide-citation): Respect it.
-
-2002-04-12 Juanma Barranquero <lektu@terra.es>
-
- * pop3.el (pop3-open-server): Fix typo.
-
-2002-04-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-munge-message-separator): Work if no date.
- Trivial patch from Marius Vollmer <mvo@zagadka.ping.de>.
-
- * pop3.el (pop3-munge-message-separator): Only use valid date.
- Trivial patch from Michael Welsh Duggan <md5i@cs.cmu.edu>.
-
-2002-04-11 Stefan Monnier <monnier@cs.yale.edu>
-
- * gnus-sum.el (gnus-update-summary-mark-positions)
- (gnus-summary-toggle-header):
- * gnus-uu.el (gnus-uu-binhex-article, gnus-uu-reginize-string)
- (gnus-uu-expand-numbers, gnus-uu-post-make-mime)
- (gnus-uu-post-encoded):
- * nnfolder.el (nnfolder-possibly-change-group):
- * nnimap.el (nnimap-retrieve-headers):
- * nnmbox.el (nnmbox-create-mbox): Don't assume point-min == 1.
-
-2002-04-08 Stefan Monnier <monnier@cs.yale.edu>
-
- * nnml.el (nnml-save-nov, nnml-generate-nov-file):
- * pop3.el (pop3-md5): Don't hardcode point-min == 1.
-
-2002-04-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-delete-marked-with): Fix typo.
-
-2002-04-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-make-tool-bar): Load tool-bar first.
-
- * message.el (message-tool-bar-map): Ditto.
-
- * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
-
-2002-04-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-mail-archive-article): Fix typo.
-
-2002-03-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (make-source-make-complex-temp-name):
- Use make-temp-file.
-
- * mm-util.el (mm-make-temp-file): New function.
- * nneething.el (nneething-file-name): Use it.
- * mm-decode.el (mm-display-external, mm-create-image-xemacs): Ditto.
- * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view)
- (gnus-uu-digest-mail-forward, gnus-uu-initialize): Ditto.
- * gnus-start.el (gnus-slave-save-newsrc): Ditto.
-
- * message.el (message-mode): If buffer-file-name, don't set auto
- save file name.
- Trivial change from Geoff Greene <ggreene@wpi.edu>
-
-2002-03-05 Eli Zaretskii <eliz@is.elta.co.il>
-
- * qp.el (quoted-printable-decode-region): Doc addition.
-
-2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-edit-done): Widen the article buffer.
-
-2002-02-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Set
- default to base64. Add application/emacs-lisp.
-
- * mail-source.el (mail-source-fetch-directory): Run scripts.
-
-2002-02-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-post-method): Fix doc.
-
- * gnus-sum.el (gnus-rebuild-thread): Count hidden lines too.
-
-2002-02-13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-edit-mode): Use define-derived-mode.
- From: Stefan Monnier <monnier@cs.yale.edu>
-
-2002-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-wash-html): Bind url-gateway-unplugged.
- * mm-view.el (mm-w3-prepare-buffer): Ditto.
- (mm-inline-text): Ditto.
- Suggested by Dave Love <fx@gnu.org>.
-
- * mml.el (mml-preview): Disable local map.
-
- * mml.el (mml-preview): Bind `q'.
-
-2002-02-05 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * binhex.el (binhex-decoder-switches): Doc fix.
-
-2002-02-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward-rmail-make-body): Directly use
- rmail-msg-restore-non-pruned-header to avoid calling
- vertical-motion.
-
-2002-01-27 Richard M. Stallman <rms@gnu.org>
-
- * time-date.el: Add autoload cookies. Many doc fixes.
- (time-add): New function.
- (time-subtract): Renamed from subtract-time.
- (subtract-time): New alias for time-subtract.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-read-init-file): Cleaned up.
-
-2002-01-03 Dave Love <d.love@dl.ac.uk>
-
- * gnus-start.el (gnus-startup-file-coding-system): Removed.
- (gnus-read-init-file): Don't use it.
-
-2002-01-03 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-start.el (gnus-read-init-file): Don't force coding system
- for ~/.gnus. From Dave Love <fx@gnu.org>.
-
-2002-01-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-to-coding-system): Don't setq charset.
- * mm-util.el (mm-use-find-coding-systems-region): New variable.
- (mm-find-mime-charset-region): Use it.
- * nntp.el (nntp-send-buffer): Use mm-with-unibyte-current-buffer.
- * nnspool.el (nnspool-request-post): Ditto.
-
-2002-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el, gnus-art.el, gnus.el, gnus-cite.el:
- Adapt face definitions to use :weight and :slant.
-
-2001-12-12 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * gnus-mlspl.el (gnus-group-split-fancy): Doc fix (add reference
- to variable, follow doc-string conventions).
-
-2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): w3-coding-system-for-mime-charset
- may not defined. From: Raja R Harinath <harinath@cs.umn.edu>.
-
- * mm-view.el (mm-inline-message): Insert a newline unless bolp.
-
- * gnus-sum.el (gnus-summary-save-article): Nix
- gnus-display-mime-function and gnus-article-prepare-hook.
-
-2001-12-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mail): Add send-actions.
-
-2001-11-28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-limit-to-author): Fix the number of
- arguments.
-
-2001-11-25 Stefan Monnier <monnier@cs.yale.edu>
-
- * imap.el (imap-interactive-login, imap-open, imap-authenticate):
- Use make-local-variable rather than make-variable-buffer-local.
-
-2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward-rmail-make-body): Use
- save-window-excursion.
- (message-encode-message-body): Use noerror when search.
- (message-setup-1): Convert compose-mail send-actions to
- message-send-actions.
-
- * message.el (message-forward-subject-author-subject): Don't use
- message-news-p, which widens the buffer.
- (message-forward-make-body): New function.
- (message-forward): Use it.
- (message-insinuate-rmail): New function.
- (message-forward-rmail-make-body): New function.
-
- * gnus-util.el (gnus-directory-sep-char-regexp): New variable.
- * gnus-score.el (gnus-score-find-bnews): Use it.
- * mm-util.el (mm-iso-8859-x-to-15-region): Use
- insert-before-markers.
- From Jesper Harder <harder@ifa.au.dk>
- * mm-util.el (mm-coding-system-priorities): Add backslash in the doc.
- * mm-util.el (mm-coding-system-priorities): New variable.
- (mm-sort-coding-systems-predicate): New function.
- (mm-find-mime-charset-region): Resort coding systems if needed.
- Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
-
- * mm-util.el (mm-iso-8859-15-compatible): Fix doc.
- (mm-hack-charsets): Fix doc.
-
- * mm-util.el (mm-iso-8859-15-compatible): Add inconvertible chars.
- (mm-iso-8859-x-to-15-table): Ditto.
- (mm-iso-8859-x-to-15-region): Ditto.
- (mm-find-mime-charset-region): Ditto.
-
- * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version.
- (gnus-summary-limit-to-author): Ditto.
- (gnus-summary-limit-to-extra): Ditto.
- (gnus-summary-find-matching): Support not-matching argument.
-
- * message.el (message-wash-subject): Use `insert' rather than
- `insert-string', which is deprecated.
- From Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
-2001-11-14 Sam Steingold <sds@gnu.org>
-
- * gnus-score.el: Fixed some doc strings to properly quote symbols.
-
-2001-11-10 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * gnus.el (gnus-local-domain): Reformat the doc-string to refer to
- function `system-name' instead of both function and variable.
-
-2001-11-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Bind mail-header-separator.
-
-2001-11-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Use mm-with-unibyte-current-buffer.
- Suggested by Dave Love <fx@gnu.org>.
-
-2001-11-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-synonym-alist): Revert (some).
-
-2001-10-30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-iso-8859-x-to-15-region): New function.
- (mm-hack-charsets): New variable.
- (mm-iso-8859-15-compatible): New variable.
- (mm-iso-8859-x-to-15-table): New variable.
- (mm-find-mime-charset-region): Add parameter hack-charsets.
-
- * mm-util.el (mm-charset-to-coding-system): Return nil, if charset
- is nil.
-
- * nnultimate.el, nnweb.el, nnslashdot.el: Update, because the web
- pages are changed.
-
- * mm-util.el (mm-mime-mule-charset-alist): Move down and call
- mm-coding-system-p. Don't correct it only in XEmacs.
- (mm-charset-to-coding-system): Use mm-coding-system-p and
- mm-get-coding-system-list.
- (mm-emacs-mule, mm-mule4-p): New.
- (mm-enable-multibyte, mm-disable-multibyte,
- mm-enable-multibyte-mule4, mm-disable-multibyte-mule4,
- mm-with-unibyte-current-buffer,
- mm-with-unibyte-current-buffer-mule4): Use them.
- (mm-find-mime-charset-region): Treat iso-2022-jp.
-
- From Dave Love <fx@gnu.org>:
-
- * mm-util.el (mm-mime-mule-charset-alist): Make it correct by
- construction.
- (mm-charset-synonym-alist): Remove windows-125[02]. Make other
- entries conditional on not having a coding system defined for
- them.
- (mm-mule-charset-to-mime-charset): Use
- find-coding-systems-for-charsets if defined.
- (mm-charset-to-coding-system): Don't use
- mm-get-coding-system-list. Look in mm-charset-synonym-alist
- later. Add last resort search of coding systems.
- (mm-enable-multibyte-mule4, mm-disable-multibyte-mule4)
- (mm-with-unibyte-current-buffer-mule4): Just treat Mule 5 like
- Mule 4.
- (mm-find-mime-charset-region): Re-write.
- (mm-with-unibyte-current-buffer): Restore buffer as well as
- multibyteness.
-
-2001-10-30 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-date-days-ago): Defeat locale.
-
-2001-10-27 Stefan Monnier <monnier@cs.yale.edu>
-
- * gnus-msg.el (gnus-setup-message): Setup reaper for MML buffers.
-
-2001-10-05 Gerd Moellmann <gerd@gnu.org>
-
- * Branch for 21.1.
-
-2001-09-27 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-ems.el (gnus-article-display-xface): Skip over previously
- inserted images.
-
-2001-09-19 Sam Steingold <sds@gnu.org>
-
- * gnus-win.el (gnus-buffer-configuration):
- Respect `gnus-bug-create-help-buffer'.
-
-2001-09-18 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * mm-util.el (mm-charset-synonym-alist): Add windows-1250 so we
- can read e-mails from Microsoft Outlook users not using ISO
- 8859-2 character set.
-
-2001-09-18 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-sum.el (gnus-select-newsgroup):
- Make `gnus-current-select-method' buffer-local.
- From TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
- * gnus-art.el (gnus-request-article-this-buffer): Refer to
- `gnus-current-select-method' in the current summary buffer.
- From TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>.
-
-2001-09-18 Miles Bader <miles@gnu.org>
-
- * gnus-srvr.el (gnus-server-insert-server-line): Don't let an
- error querying a backend abort the whole process.
-
-2001-09-17 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-srvr.el (gnus-server-mode): Doc fix.
-
-2001-09-03 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-local-domain): Undo change of 2001-07-02.
-
-2001-08-31 Sam Steingold <sds@gnu.org>
-
- * imap.el (imap-mailbox-examine, imap-mailbox-examine-1): Fix a
- typo: `exmine' --> `examine'.
-
-2001-08-20 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * earcon.el (earcon-auto-play): Remove unused option.
-
-2001-08-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
-
- * gnus-util.el (gnus-output-to-rmail): Ditto.
- (gnus-output-to-mail): Ditto.
-
- * nnmail.el (nnmail-pathname-coding-system): Set default to nil.
-
-2001-08-07 Gerd Moellmann <gerd@gnu.org>
-
- * mm-uu.el (mm-uu-dissect, mm-uu-test): Fix autoload cookies.
-
-2001-08-01 Gerd Moellmann <gerd@gnu.org>
-
- * mm-view.el (autoload): Don't autoload `diff-mode' if it's
- already fboundp. Add INTERACTIVE arg to autoload form.
-
-2001-08-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-startup-file-coding-system): Revert to binary.
- (gnus-ding-file-coding-system): New variable.
- (gnus-read-newsrc-el-file, gnus-save-newsrc-file)
- (gnus-slave-save-newsrc): Use it.
-
-2001-07-31 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-start.el (gnus-startup-file-coding-system): Change to
- `emacs-mule'.
-
-2001-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS
- command.
-
- * gnus-start.el (gnus-find-new-newsgroups): Use
- `message-make-date' instead of `current-time-string'.
- (gnus-ask-server-for-new-groups): Ditto.
- (gnus-check-first-time-used): Ditto.
-
-2001-07-13 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * gnus-setup.el (gnus-use-installed-gnus): Fix a typo.
-
-2001-07-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-read-folder): Force to use a multibyte buffer.
-
-2001-07-12 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the
- Browse->Next entries to Browse->Prev.
- From: Bj,Av(Brn Torkelsson <torkel@hpc2n.umu.se>.
-
-2001-07-04 Gerd Moellmann <gerd@gnu.org>
-
- * nnheader.el (nnheader-init-server-buffer): Make sure the
- *nntpd* buffer is made multibyte instead of a random buffer.
-
-2001-07-02 Eli Zaretskii <eliz@is.elta.co.il>
-
- * gnus.el: Fix the header line, for finder.el. Suggested by
- Pavel Janik <Pavel@Janik.cz>
-
-2001-07-02 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-local-domain): Removed because unused.
-
-2001-06-18 Eli Zaretskii <eliz@is.elta.co.il>
-
- * qp.el (quoted-printable-decode-region): If called interactively,
- use coding-system-for-read.
-
-2001-03-30 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-interactive): Fix parenthesis errors.
-
-2001-03-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (rmail-output): It is in rmailout.el not rmail.el.
-
- * message.el (message-forward): local-variable-p takes an extra
- argument in XEmacs.
-
- * message.el (message-forward-decoded-p): New variable.
- (message-forward-subject-author-subject): Use it.
- (message-make-forward-subject): Use it.
- (message-forward): Use it.
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Use it.
-
-2001-03-05 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case.
- Move it after definition of mm-coding-system-p.
-
-2001-03-01 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-inhibit-file-name-handlers): Add
- image-file-handler.
-
-2001-02-11 Dave Love <fx@gnu.org>
-
- * message.el (message-signature-file): Fix doc, :type.
-
-2001-02-08 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-fold-region): Don't forward-char at EOB.
- (message-posting-charset): Defvar when compiling again.
- (rfc2047-encodable-p): Require message.
-
- * gnus-sum.el (gnus-alter-articles-to-read-function):
- * gnus-score.el (gnus-score-after-write-file-function): Fix :type.
-
-2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-make-forward-subject): Argument decoded.
- (message-forward): Use it when digest.
-
- * gnus-uu.el (gnus-uu-grab-articles): Shoot down original article
- buffer.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar
- in Emacs.
-
- * gnus-art.el (gnus-article-make-menu-bar): Make
- gnus-article-post-menu.
-
-2001-02-06 Dave Love <fx@gnu.org>
-
- * qp.el (quoted-printable-encode-region): Remove redundant code
- from last change.
-
-2001-02-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-summary-score-entry): match may be an integer.
-
- * gnus-art.el (gnus-summary-save-in-pipe): Prompt for saving
- command if there is not last-saver.
-
- * rfc2047.el (rfc2047-encode): MIME charset is not coding system.
- (rfc2047-charset-encoding-alist): Add big5.
-
- * mm-util.el (mm-mime-mule-charset-alist): Preferred MIME names
- GB2312 and Big5.
-
- * gnus-score.el (gnus-score-lower-thread): Fix a doc typo.
-
- * gnus-sum.el (gnus-summary-print-article): Remove process mark.
-
- * gnus-sum.el (gnus-summary-print-article): Take one prefix
- argument. Allow to print several articles in one file.
-
- * webmail.el (webmail-type-definition): netaddress changes.
-
-2001-01-31 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-mime-mule-charset-alist)
- (mm-find-mime-charset-region): Consider mule-utf-8.
-
-2001-01-31 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-article-x-face-command)
- (gnus-treat-display-xface, gnus-treat-display-smileys): Add
- :version.
-
-2001-01-26 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-multibyte-string-p): New.
-
- * qp.el: Remove un-logged bogus changes from 2000-12-20.
- (quoted-printable-encode-region): Doc fix. Don't call
- string-as-multibyte on class. Clarify line-folding.
- (quoted-printable-encode-string): Make temp buffer inherit
- string's multibyteness.
-
-2001-01-23 Gerd Moellmann <gerd@gnu.org>
-
- * nnheader.el (toplevel): Don't require `gnus-util' at
- compile-time; this creates a circular dependency, and prevents
- a bootstrap.
-
-2001-01-22 Andreas Schwab <schwab@suse.de>
-
- * nnheader.el (gnus-delete-line): Autoload it as a macro.
-
-2001-01-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward): Use mule4.
- * mm-util.el (mm-string-as-unibyte): New.
- * message.el (message-forward): Use it.
- * message.el (message-cite-original-without-signature): Don't peel
- off the blank line.
- (message-get-reply-headers): Add Cc if it is not in follow-to.
- * message.el (message-send-mail): Content-Type may not be there.
- By Alberto Lusiani.
- * gnus-art.el (article-display-x-face): Insert X-Face if there is
- not.
- * rfc2047.el (rfc2047-fold-region): Don't insert LWSP if there is
- one.
- * gnus-win.el (gnus-configure-windows): switch-to-buffer in XEmacs.
- (gnus-remove-some-windows): Ditto.
- * mm-decode.el (mm-interactively-view-part): Don't copy-sequence
- handle.
- * gnus-art.el (gnus-mime-view-part): Copy it.
- (gnus-mime-view-part-as-type): Add into gnus-article-mime-handles.
- * nnmail.el (nnmail-get-new-mail): Find group only if file is not
- orig-file. Use ',source.
- * nnslashdot.el (nnslashdot-request-list): Get the right year. By
- Lars Magne Ingebrigtsen.
- * pop3.el (pop3-get-message-count): Andrew Innes
- <andrewi@gnu.org>'s patch of 1999-12-01 was not fully committed.
-
-2001-01-08 Dave Love <fx@gnu.org>
-
- * mm-encode.el (mm-qp-or-base64): Don't base64 for the sake of a
- single character.
-
- * mm-util.el (mm-mime-mule-charset-alist): Add Latin-{8,9}.
-
- * message.el: Doc and message fixes.
- (message-send-rename-function)
- (message-make-forward-subject-function)
- (message-send-mail-function, message-reply-to-function)
- (message-wide-reply-to-function, message-followup-to-function)
- (message-distribution-function, message-auto-save-directory): Fix
- :type.
-
- * gnus/mml.el (mml-parse-1): Frob mml-confirmation-set when
- proceeding after warnings. Amend multipart warning message.
-
-2001-01-04 Dave Love <fx@gnu.org>
-
- * gnus-util.el (nnmail-pathname-coding-system): Defvar when
- compiling.
- (gnus-make-directory): Require nnmail.
-
- * mm-decode.el (mm-inline-media-tests): Add
- image/x-portable-bitmap.
- (mm-get-image): Grok pbm.
-
-2000-12-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mail): Support yank-action.
-
- * message.el (message-setup): Revoke the last change.
-
-2000-12-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-setup): Use cons. Suggested by Johan Vromans
- <jvromans@squirrel.nl>.
-
- * gnus-topic.el (gnus-topic-create-topic): Use list.
-
- * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art
- before binding gnus-default-article-saver.
-
- * gnus-sum.el (gnus-summary-save-article):
- (gnus-summary-pipe-output):
- (gnus-summary-save-article-mail):
- (gnus-summary-save-article-rmail):
- (gnus-summary-save-article-file):
- (gnus-summary-write-article-file):
- (gnus-summary-save-article-body-file): Ditto.
-
- * gnus-mh.el (gnus-summary-save-article-folder): Ditto.
-
-2000-12-22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-check-hidden-text): Return t.
-
- * gnus-util.el (gnus-remove-text-properties-when): Return t.
-
- * mm-decode.el (mm-dissect-multipart): Avoid errors owing to
- malformatted messages.
-
-2000-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-treat-dumbquotes): Quote \.
-
-2000-12-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-emphasize): Don't treat emphasis if
- Emacs 20 runs on a terminal.
-
-2000-12-21 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-art.el (article-treat-dumbquotes): More doc, provided by
- Paul Stevenson <p.stevenson@surrey.ac.uk>
-
-2000-12-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (gnus-add-minor-mode): Autoload.
-
- * message.el (message-forward): Save-restriction.
-
- * message.el (message-mail-user-agent): Add :version.
-
- * message.el (message-mail-user-agent): New variable.
- (message-setup): Renamed to message-setup-1. Support
- mail-user-agent.
- (message-mail-user-agent): New function.
- (message-mail): Use it.
- (message-reply): Use it.
- (message-resend): Use it.
- (message-mail-other-window): Use it.
- (message-mail-other-frame): Use it.
-
- * gnus-msg.el (gnus-bug): Support mail-user-agent.
-
-2000-12-21 Miles Bader <miles@gnu.org>
-
- * message.el (message-mode): Set `comment-start' to the yank prefix.
-
-2000-12-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-narrow-to-head-1): New function.
- (message-narrow-to-head): Use it.
- (message-reply): Ditto.
- (message-cancel-news): Ditto.
- (message-supersede): Ditto.
- (message-make-forward-subject): Ditto.
- (message-bounce): Ditto.
-
- * gnus-msg.el (gnus-summary-mail-forward): Use original buffer.
-
- * message.el (message-forward): Copy buffer in unibyte mode.
- (message-make-forward-subject): Don't widen. Decode.
- (message-forward): Don't decode subject.
-
- * mml.el (gnus-ems): Require it.
-
- * gnus-msg.el (gnus-summary-mail-forward):
-
- * message.el (message-forward): Move mime-to-mml here.
-
- * nnmbox.el (nnmbox-file-coding-system): Use binary.
- (nnmbox-active-file-coding-system): Ditto.
-
- * gnus-cus.el (gnus-group-parameters): Add posting-style.
-
- * mm-uu.el: Require binhex.
-
-2000-12-20 Christoph Conrad <C.Conrad@cli.de>
-
- * qp.el (quoted-printable-encode-region): Upcase QP.
-
-2000-12-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-add-text-properties-when): New function.
- (gnus-remove-text-properties-when): Ditto.
-
- * gnus-cite.el (gnus-article-hide-citation): Use them.
- (gnus-article-toggle-cited-text): Use them.
-
- * gnus-art.el (gnus-signature-toggle): Use them.
- (gnus-article-show-hidden-text): Ditto.
- (gnus-article-hide-text): Ditto.
-
- * gnus-art.el (gnus-article-describe-key): Use prompt.
- (gnus-article-describe-key-briefly): Ditto.
-
-2000-12-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-synonym-alist): Fix a typo.
-
-2000-12-18 Gerd Moellmann <gerd@gnu.org>
-
- * *.xpm, *.pbm: Convert icons icons to size 24x24.
-
-2000-12-18 Dave Love <fx@gnu.org>
-
- * gnus-msg.el (news-setup, news-reply-mode): Don't autoload
- (unused).
-
-2000-12-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-movemail): Use binary.
- (pop3-movemail-file-coding-system): Removed.
-
-2000-12-13 Miles Bader <miles@gnu.org>
-
- * smiley-ems.el (smiley-region): Bind `inhibit-point-motion-hooks'
- to t, so that we don't get stuck while trying to smilefy
- intangible text.
-
-2000-12-12 Gerd Moellmann <gerd@gnu.org>
-
- * smiley-ems.el (smiley-regexp-alist): Make regexps match
- at the end of the buffer.
- (smiley-region): In the loop, move to the end of the submatch
- matching the smiley instead of using the end of the match
- of the whole regexp.
-
-2000-12-12 Eli Zaretskii <eliz@is.elta.co.il>
-
- * message.el (message-mode): Doc fix.
-
-2000-12-12 Gerd Moellmann <gerd@gnu.org>
-
- * smiley-ems.el (smiley-region): Doc fix.
-
-2000-12-11 Miles Bader <miles@gnu.org>
-
- * gnus-sum.el (gnus-summary-recenter): When trying to keep the
- bottom line visible, check to see if it's partially obscured, and
- if so, either scroll one more line to make it fully visible, or
- revert to showing the second line from the top.
-
-2000-12-07 Dave Love <fx@gnu.org>
-
- * mailcap.el (mailcap-download-directory)
- * gnus-audio.el (gnus-audio-directory)
- * smiley-ems.el (smiley-data-directory): Fix :type.
-
-2000-12-05 Dave Love <fx@gnu.org>
-
- * starttls.el: New file.
-
-2000-12-04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if it
- succeeds.
- (gnus-setup-message): Remove a hack.
-
- * gnus-win.el (gnus-configure-windows): Make sure
- nntp-server-buffer is live.
- (gnus-remove-some-windows): switch-to-buffer -> set-buffer.
- (gnus-configure-frame): Save selected window.
-
-2000-12-04 Andreas Jaeger <aj@suse.de>
-
- * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description.
-
-2000-12-04 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow
- raw 8-bit in headers in dk.* newsgroups.
-
-2000-11-30 Dave Love <fx@gnu.org>
-
- * message.el (message-auto-save-directory): Use
- file-name-as-directory.
- (message-set-auto-save-file-name): Create
- message-auto-save-directory if necessary.
- (message-replace-chars-in-string): Removed -- unused.
- (message-mail-alias-type): Customize.
- (message-headers): Remove duplicate defgroup.
-
-2000-11-29 Dave Love <fx@gnu.org>
-
- * qp.el (quoted-printable-decode-region): Use error, not message
- to report malformed text (like base64). Amend message.
-
-2000-11-29 Miles Bader <miles@gnu.org>
-
- * message.el (message-header-lines): Fontify tag.
-
-2000-11-27 Dave Love <fx@gnu.org>
-
- * nnlistserv.el: Ignore errors when requiring nnweb and avoid a
- compiler warning.
-
-2000-11-26 Dave Love <fx@gnu.org>
-
- * mm-uu.el (mm-uu-configure-list): Fix typo in :type.
-
-2000-11-23 Dave Love <fx@gnu.org>
-
- * uu-post.pbm, uu-decode.pbm: new files from XPMs.
-
- * mm-uu.el (uudecode): Require.
- (uudecode-decode-region, uudecode-decode-region-external): Don't
- autoload.
- (mm-uu-copy-to-buffer): Doc fix.
- (mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom
- type fix.
-
- * mailcap.el: Doc fixes.
- (mailcap-mime-data): Various adjustments.
- (mailcap): New group.
- (mailcap-download-directory): Customize.
- (mailcap-generate-unique-filename, mailcap-binary-suffixes)
- (mailcap-temporary-directory): Deleted (unused).
- (mailcap-unescape-mime-test): Simplify slightly.
- (mailcap-viewer-passes-test): Use functionp.
- (mailcap-command-p): Aliased to executable-find.
-
- * rfc2047.el (rfc2047-encode-message-header): Don't encode if
- default-enable-multibyte-characters is nil.
-
-2000-11-22 Simon Josefsson <simon@josefsson.org>
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Search for "from:"
- instead of "from: " for rfc822 compliance. Insert SPC.
-
-2000-11-22 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-group.el (gnus-group-make-tool-bar): Fix a paren typo.
-
-2000-11-22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail): Use buffer-substring-no-properties.
- (message-send-news): Ditto.
-
-2000-11-21 Stefan Monnier <monnier@cs.yale.edu>
-
- * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer.
-
-2000-11-21 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-mime-button-map): Don't inherit from
- gnus-article-mode-map.
- (gnus-mime-button-menu): Use mouse-set-point.
- (gnus-insert-mime-button, gnus-mime-display-alternative)
- (gnus-mime-display-alternative): Don't use local-map property.
-
-2000-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-open-telnet): Wait for the telnet prompt before
- sending a command; allow the rtelnet prompt as well.
-
-2000-11-17 Simon Josefsson <simon@josefsson.org>
-
- * nntp.el (nntp-async-trigger): Fix authinfo in asynchronous
- prefetch.
-
-2000-11-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-decode-text): Delete bogus status lines.
- (nntp-open-connection): Kill process buffer when quit.
- (nntp-connection-timeout): Add a note. SIGALRM is ignored in both
- FSF Emacs 20 and XEmacs 21.
- (nntp-retrieve-data): Don't ignore quit.
-
-2000-11-17 Dave Love <fx@gnu.org>
-
- * uudecode.el (uudecode-insert-char): Fix bogus feature test.
- (uudecode-decode-region-external): Doc fix. Use with-temp-buffer
- and make-temp-file.
- (uudecode-decode-region): Doc fix.
-
-2000-11-14 Dave Love <fx@gnu.org>
-
- * cu-exit.pbm, exit-summ.pbm, followup.pbm, fuwo.pbm:
- * mail-reply.pbm, next-ur.pbm, post.pbm, prev-ur.pbm:
- * reply-wo.pbm, reply.pbm, rot13.pbm, save-aif.pbm, save-art.pbm:
- New files, derived from the XPMs.
-
-2000-11-12 Dave Love <fx@gnu.org>
-
- From Emerick Rogul <emerick@csa.bu.edu>.
- * message.el (message-setup-fill-variables): New variable.
- (message-mode): Use it.
-
-2000-11-10 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
-
- * gnus-mlspl.el: Documentation tweaks.
-
-2000-11-10 Dave Love <fx@gnu.org>
-
- * gnus-agent.el (gnus-agent-confirmation-function): Add :version.
- (gnus-agent-lib-file, gnus-agent-load-alist)
- (gnus-agent-save-alist, gnus-agent-article-name): Use
- expand-file-name.
-
- * gnus-group.el (gnus-group-name-charset-method-alist): Add
- :version.
- (nnkiboze-score-file): Defvar when compiling.
-
- * gnus-start.el (gnus-read-newsrc-file): Add :version.
-
- * gnus-art.el (gnus-article-banner-alist)
- (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types)
- (gnus-article-date-lapsed-new-header)
- (gnus-article-mime-match-handle-function, gnus-mime-action-alist)
- (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601)
- (gnus-treat-strip-headers-in-body)
- (gnus-treat-capitalize-sentences, gnus-treat-play-sounds)
- (gnus-treat-translate): Add :version.
- (gnus-article-mime-part-function): Fix defcustom.
-
- * nnmail.el (nnmail-expiry-target)
- (nnmail-scan-directory-mail-source-once, nnmail-extra-headers)
- (nnmail-split-header-length-limit): Add :version.
-
- * gnus-sum.el (gnus-auto-expirable-marks)
- (gnus-inhibit-user-auto-expire, gnus-list-identifiers)
- (gnus-extra-headers, gnus-ignored-from-addresses)
- (gnus-newsgroup-ignored-charsets)
- (gnus-group-highlight-words-alist)
- (gnus-summary-show-article-charset-alist): Add :version.
-
- * catchup.pbm, describe-group.pbm, exit-gnus.pbm, get-news.pbm:
- gnntg.pbm, kill-group.pbm, subscribe.pbm, unsubscribe.pbm: New
- files, converted from the XPMs.
-
- * gnus-cache.el (gnus-cache-active-file): Don't use
- file-name-as-directory on directory.
- (gnus-cache-file-name): Use expand-file-name, not concat. Don't
- use file-name-as-directory on directory.
-
- * time-date.el (timezone-make-date-arpa-standard): Autoload.
- (date-to-time): Use it.
-
- * message.el (message-mode) <adaptive-fill-regexp>:
- <adaptive-fill-first-line-regexp>: Use [:alnum:] in regexp range.
- (message-newline-and-reformat): Likewise.
- (message-forward-as-mime, message-forward-ignored-headers)
- (message-buffer-naming-style, message-default-charset)
- (message-dont-reply-to-names, message-send-mail-partially-limit):
- Add :version.
-
- * mm-util.el: Doc fixes.
- (mm-mime-charset): Don't use the raw result of
- mm-preferred-coding-system.
- (mm-with-unibyte-buffer, mm-with-unibyte-current-buffer)
- (mm-with-unibyte): Simplify.
-
- * gnus-int.el (gnus-start-news-server): Use expand-file-name, not
- concat.
-
- * pop3.el (pop3-version): Deleted.
- (pop3-make-date): New function, avoiding message-make-date.
- (pop3-munge-message-separator): Use it.
-
-2000-11-10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-munge-message-separator): A message may have an
- empty body.
-
-2000-11-09 Dave Love <fx@gnu.org>
-
- * gnus-group.el (gnus-group-make-directory-group)
- (gnus-group-fetch-faq): Use expand-file-name.
- (gnus-group-fetch-faq): Simplify completing-read form.
-
- * mm-bodies.el (mm-encode-body): Use mm-multibyte-p, don't just
- test for Mule.
-
- * message.el (tool-bar-map): Defvar when compiling.
-
- * gnus-setup.el (running-xemacs, gnus-use-installed-tm)
- (gnus-tm-lisp-directory): Deleted.
- (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use
- (featurep 'xemacs).
- (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory)
- (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove
- version numbers from file names.
-
-2000-11-08 John Wiegley <johnw@gnu.org>
-
- * gnus-topic.el (gnus-topic-mode): Use `setq' to clear
- `gnus-group-change-level-function', instead of `remove-hook',
- because it's not a hook!
-
-2000-11-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-decode-entities): Work for non-character
- entities.
-
- * gnus-start.el (gnus-read-active-file, gnus-activate-group):
- Issue message on quit.
-
-2000-11-08 Simon Josefsson <simon@josefsson.org>
-
- * rfc2104.el: Add SHA-1 example.
- (rfc2104-hexstring-to-bitstring): New function.
- (rfc2104-hash): Use it.
-
-2000-11-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el: Remove gnus-xemacs.
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Correctly mark body-begin.
-
- * gnus-score.el (gnus-score-body): Don't score body when
- agent-fetching.
- (gnus-score-followup): Don't score followup either.
- (gnus-score-use-all-scores): New variable.
- (gnus-all-score-files): Use it.
- (gnus-score-find-bnews): Use directory-sep-char.
-
- * nnweb.el (nnweb-url-retrieve-asynch): url-retrieve is
- asynchronous in Exp version.
-
-2000-11-08 Dave Love <fx@gnu.org>
-
- * mm-view.el: Use featurep for XEmacs test.
- (mm-inline-message): Test for `remove-specifier'; don't use
- condition-case.
-
- * mm-bodies.el (mm-encode-body): Use mm-multibyte-p.
-
- * gnus-score.el (gnus-score-load-file): Use expand-file-name.
- (gnus-score-find-bnews): Don't concat "".
-
- * cu-exit.xpm, prev-ur.xpm, next-ur.xpm, post.xpm, fuwo.xpm:
- * followup.xpm, uu-post.xpm, uu-decode.xpm, mail-reply.xpm:
- * reply.xpm, reply-wo.xpm, rot13.xpm, save-aif.xpm, save-art.xpm:
- * exit-summ.xpm: New files, renamed from icons by Luis Fernandes.
-
- * gnus-sum.el: Put some defvars in eval-when-compile.
- (gnus-summary-mode-hook): Add :options.
- (gnus-summary-make-menu-bar): Add some :help, used by tool bar.
- (gnus-summary-tool-bar-map): New variable.
- (gnus-summary-make-tool-bar): New function.
- (gnus-summary-mode): Put kill-all-local-variables first.
-
- * gnus-group.el (gnus-group-toolbar-map): New variable.
- (gnus-group-make-tool-bar): Rewritten.
- (gnus-group-mode): Put kill-all-local-variables first.
-
- * rfc2047.el: Require gnus-util.
-
- * nnml.el (gnus-sorted-intersection): Autoload.
-
- * nnheader.el: Wrap subst-char-in-string def in eval-and-compile.
- Put some defvars in eval-when-compile.
- (gnus-intersection, gnus-sorted-complement): Autoload.
-
- * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol.
-
- * mm-encode.el (mm-body-7-or-8): Autoload.
-
- * mm-decode.el (mm-insert-inline): Autoload.
-
- * mml.el:
- * message.el: Put some defvars in eval-when-compile.
-
- * gnus-msg.el: Put some defvars in eval-when-compile.
- (gnus-msg-mail): Move after gnus-setup-message.
-
- * smiley-ems.el (smiley-data-directory, smiley-regexp-alist): Doc fix.
-
-2000-11-07 Dave Love <fx@gnu.org>
-
- * gnus-util.el (nnheader): Don't require message (recursive
- autoload).
-
- * uudecode.el: Avoid compiler warnings.
-
- * rfc2047.el: (rfc2047-fold-region): Use gnus-point-at-bol.
- (rfc2047-charset-encoding-alist): Add iso-8859-1[45].
-
-2000-11-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el: Require cl when compiling.
- (rfc2047-q-encode-region): Don't break if a QP-word could be
- fitted in one line.
- (rfc2047-decode): Use mm-with-unibyte-current-buffer-mule4.
- (rfc2047-fold-region): "=?=" is not a break point.
- (rfc2047-encode-message-header): Move fold into encode-region.
- (rfc2047-dissect-region): Rewrite.
- (rfc2047-encode-region): Rewrite.
- (rfc2047-fold-region): Fold
- (rfc2047-unfold-region): New function.
- (rfc2047-decode-region): Use it.
- (rfc2047-q-encode-region): Don't break at bob.
- (rfc2047-decode): Use unibyte.
- (rfc2047-q-encode-region): Better calculation of break point.
- (rfc2047-fold-region): Don't break the first non-LWSP characters.
- (rfc2047-encode-region): Merge only if regions are adjacent.
-
-2000-11-06 Dave Love <fx@gnu.org>
-
- * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode.
-
- * uudecode.el: Use (featurep 'xemacs). Require cl when compiling.
- (uudecode-char-int): New alias, replacing char-int.
- (uudecode-decode-region): Don't call buffer-disable-undo.
-
- * mm-uu.el (mm-uu-configure): Unquote lambda.
- (mm-uu-configure-list): Doc fix.
-
- * earcon.el (running-xemacs): Don't define.
-
-2000-11-06 John Wiegley <johnw@gnu.org>
-
- * gnus-mlspl.el (gnus-group-split-update): Check the value of
- `nnmail-crosspost', and use it to set the `no-crosspost'
- argument when calling `gnus-group-split-fancy'. Otherwise, it
- assumes that cross-posting is always OK, no matter what
- `nmail-crosspost' is set to.
- (gnus-group-split-fancy): The argument order in the
- second-to-last `push' call was wrong, but since `no-crosspost'
- was always nil, it was never being triggered.
-
-2000-11-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- Don't postpone GCC if none of GCC methods is agent-covered. This
- fix presumes that the post-method must be agent-covered if any Gcc
- method is agent-covered.
-
- * gnus-msg.el (gnus-inews-group-method): New function.
- (gnus-inews-do-gcc): Use it.
- * gnus-agent.el (gnus-agent-any-covered-gcc): New function.
- (gnus-agent-possibly-save-gcc): Use it.
- (gnus-agent-possibly-do-gcc): Ditto.
-
- *gnus-msg.el: (gnus-inews-add-send-actions): Use
- `gnus-agent-possibly-do-gcc' if Agentized.
- (gnus-inews-add-send-actions): Add `gnus-agent-possibly-save-gcc'
- to `message-header-hook'.
-
- * gnus-mlspl.el: Require cl when compiling.
-
- * gnus-ml.el: Usage.
- (gnus-mailing-list-archive, gnus-mailing-list-owner,
- gnus-mailing-list-post, gnus-mailing-list-unsubscribe,
- gnus-mailing-list-subscribe, gnus-mailing-list-help): Bind list-*.
- (gnus-mailing-list-menu): Define it.
- (turn-on-gnus-mailing-list-mode, gnus-mailing-list-mode): Autoload.
-
- * gnus-logic.el (gnus-advanced-string): Use "" if nil.
-
-2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
-
- * message.el (message-font-lock-keywords): Match a final newline
- to help font-lock's multiline support.
-
-2000-11-03 Dave Love <fx@gnu.org>
-
- * gnus-nocem.el (gnus-nocem-check-article-limit): Default to 500.
-
- * mm-partial.el (mm-inline-partial): Space-prefix temp buffer
- name.
-
- * gnus-cus.el (gnus-group-parameters) <gcc-self>: Fix custom type.
- <banner>: Fix custom type, doc.
-
- * mm-decode.el (mm-display-external): Space-prefix temp buffer
- name. Don't disable undo explicitly.
-
-2000-11-02 Dave Love <fx@gnu.org>
-
- * message.el (message-font-lock-keywords): Use [:alpha:] for
- cite-prefix.
-
-2000-11-02 Miles Bader <miles@lsi.nec.co.jp>
-
- * mm-uu.el (mm-uu-configure-list): Move back to old location,
- because defcustom tries to call `mm-uu-configure'.
-
-2000-11-01 Dave Love <fx@gnu.org>
-
- * rfc2047.el (base64): Require unconditionally.
- (message-posting-charset): Defvar when compiling.
- (rfc2047-encode-message-header, rfc2047-encodable-p): Require
- message.
-
- * gnus-sum.el (nnoo): Require.
- (mm-uu-dissect): Autoload.
-
- * mml.el (mml-parse-1): Clarify message.
- (mml-minibuffer-read-type): Use mailcap-mime-types.
-
-2000-11-01 Stefan Monnier <monnier@cs.yale.edu>
-
- * mml.el: Fix a typo in the requiring of CL.
-
-2000-11-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2231.el: Require cl when compiling.
-
-2000-11-01 Dave Love <fx@gnu.org>
-
- * mm-uu.el (mm-uu-decode-function, mm-uu-binhex-decode-function):
- Fix custom type.
- (mm-uu-configure-list): Move and fix custom type.
-
- * utf7.el: Require cl when compiling.
-
- * binhex.el: Use (featurep 'xemacs).
- (binhex-char-int): New alias, replacing char-int. Change callers.
- (binhex-decode-region): Simplify work buffer code.
- (binhex-decode-region-external): Use expand-file-name, not concat.
-
-2000-10-30 Dave Love <fx@gnu.org>
-
- * gnus-art.el: Fix 2000-10-27 change properly.
-
-2000-10-28 Miles Bader <miles@gnu.org>
-
- * gnus-art.el (gnus-read-save-file-name): Remove extraneous paren.
-
-2000-10-27 Christoph Conrad <christoph.conrad@gmx.de>
-
- * gnus-draft.el (gnus-draft-send-message): Typo.
-
-2000-10-27 John Wiegley <johnw@gnu.org>
-
- * gnus-art.el (gnus-treat-hide-citation-maybe): Added this
- variable to correspond with `gnus-article-hide-citation-maybe'.
- (gnus-treatment-function-alist): Added entry for the above
- correlation.
-
-2000-10-27 Richard M. Alderson III <alderson@netcom2.netcom.com>
-
- * gnus-art.el (gnus-read-save-file-name): expand-file-name.
-
-2000-10-27 Dave Love <fx@gnu.org>
-
- * gnus.el: Don't require custom. Don't require message at top
- level.
- (gnus-message-archive-method): Require message here.
-
-2000-10-27 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-art.el (article-strip-banner): Use
- gnus-group-find-parameter rather than gnus-group-get-parameter, to
- allow inheritance on the banner.
- From elkin@tverd.astro.spbu.ru.
-
- * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L
- Cashin <ecashin@coe.uga.edu>).
-
-2000-10-27 Simon Josefsson <simon@josefsson.org>
-
- * gnus-agent.el (gnus-agent-possibly-do-gcc):
- (gnus-agent-restore-gcc):
- (gnus-agent-possibly-save-gcc): New functions.
-
- * nnimap.el (nnimap-group-overview-filename): Create directory for
- newfile (when use long filenames is nil). Copy+delete file if
- rename didn't work.
- (nnimap-group-overview-filename): `rename-file' and `copy-file'
- doesn't return anything useful, use ignore-errors instead.
- (nnimap-verify-uidvalidity): Delete overview file when
- uid validity changes.
- (nnimap-group-overview-filename): Store uidvalidity in filenames.
- Rename old files into new format.
- (nnimap-request-accept-article): Remove \n's from
- From_ lines.
- (nnimap-request-accept-article): Remove From[^:] lines.
- (imap-starttls-p): Check for starttls binary.
- (imap-starttls-open): More verbose.
- (imap-gssapi-auth): Ditto.
- (imap-kerberos4-auth): Ditto.
- (imap-cram-md5-auth): Ditto.
- (imap-login-auth): Ditto.
- (imap-anonymous-auth): Ditto.
- (imap-digest-md5-auth): Ditto.
- (imap-open): Ditto.
- (imap-digest-md5-p): Check capability first.
- (imap-parse-flag-list): Correctly parse empty lists.
- (imap-login-p): Support LOGINDISABLED.
- (imap-parse-body): Work around bug in Sun SIMS.
-
- * gnus-agent.el (gnus-agent-possibly-do-gcc):
- (gnus-agent-restore-gcc):
- (gnus-agent-possibly-save-gcc): New functions.
-
- Asks the user to synch flags with server when you plug in.
-
- * gnus-agent.el (gnus-agent-synchronize-flags): New variable.
- (gnus-agent-possibly-synchronize-flags-server): New function, use it.
- (gnus-agent-toggle-plugged): Call it.
- (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'.
- (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'.
- (gnus-agent-possibly-synchronize-flags): New function.
- (gnus-agent-possibly-synchronize-flags-server): New function.
-
- * nnheader.el (nnheader-parse-head): Try both "from:" and "from: ".
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Ditto.
-
- * gnus-group.el (gnus-group-nnimap-edit-acl): Check if server
- support ACL's.
-
-2000-10-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-send-message): Ditto.
- (gnus-group-send-drafts): Ditto.
-
- * gnus-art.el (gnus-request-article-this-buffer):
- gnus-refer-article-method might be a single method.
- (gnus-article-mime-total-parts): New function.
- (gnus-mm-display-part): Use it.
- (gnus-mime-display-single): Ditto.
- (gnus-mime-display-alternative): Ditto.
- (gnus-mime-inline-part): Check validity of charset.
- (gnus-treat-display-smileys): Default value in Emacs 21.
- * gnus-art.el: Define dynamic variables in eval-when-compile.
- (gnus-article-prepare): Configure it again.
- (gnus-insert-mime-button): Use gnus-overlay-buffer,
- gnus-overlay-start.
- (gnus-article-prepare): Configure windows before
- gnus-article-prepare-display is called. Otherwise, BBDB's popup
- window might be overrided.
- (gnus-mime-inline-part): Use prefix argument only
- when it is called interactively.
- (gnus-mime-action-alist): New variable.
- (gnus-mime-action-on-part): Use it.
- (gnus-mime-button-commands): Add command ".".
- (gnus-mime-inline-part): Support prefix argument.
- (gnus-article-banner-alist): New variable.
- (article-strip-banner): Use it.
-
- * mailcap.el (mailcap-parse-mailcaps): Don't use parse-colon-path,
- because they are files, not paths.
- (mailcap-parse-mimetypes): Ditto.
- (mailcap-mime-types): Use mailcap-mime-data.
-
- * gnus.el (gnus-xmas-define): Defalias gnus-overlay-buffer,
- gnus-overlay-start.
- * gnus.el (gnus-agent-fetching): New variable.
- * gnus-agent.el (gnus-agent-with-fetch): Bind it.
-
- * gnus-agent.el (gnus-agent-fetch-session): Catch quit.
- (gnus-agent-fetch-group-1): Score-param could be nil.
- (gnus-agent-any-covered-gcc): New function.
- (gnus-agent-possibly-save-gcc): Use it.
- (gnus-agent-possibly-do-gcc): Ditto.
- * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to
- the GNU assignment issue.
- (gnus-agent-fetch-group-1): Reimplement Mike McEwan's proposal.
- * gnus-agent.el: timer vs. itimer.
-
- * webmail.el (webmail-type-definition): Fix my-deja open url.
- (webmail-hotmail-list): Fix.
- (webmail-netscape-open, webmail-hotmail-article,
- webmail-hotmail-list): Update.
- (webmail-my-deja-*): Rewrite.
-
- * gnus-sum.el (gnus-refer-article-methods): The second could be
- a named method.
- (gnus-cache-write-active): Auto load.
- (gnus-summary-display-article): Enable multibyte.
- (gnus-summary-select-article): Don't enable multibyte here.
- (gnus-summary-goto-article): Ditto.
- (gnus-summary-enter-digest-group): Decode to-address.
-
- * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs).
- (mm-with-unibyte-current-buffer-mule4): New function.
- (mm-enable-multibyte-mule4): New.
- (mm-disable-multibyte-mule4): New.
-
- * mm-util.el (mm-enable-multibyte-mule4): New.
- (mm-disable-multibyte-mule4): New.
- * gnus-sum.el (gnus-summary-mode): Use it.
- (gnus-summary-select-article): Ditto.
- (gnus-summary-goto-article): Use enable multibyte.
-
- * nnkiboze.el (nnkiboze-generate-group): Use it. Inhibit list groups.
- (nnkiboze-enter-nov): Fix it when there is no xref.
- (nnkiboze-generate-groups): List groups.
- (nnkiboze-request-article): Use
- gnus-cache-request-article.
-
- * gnus-group.el (gnus-group-make-kiboze-group): Use
- nnkiboze-score-file.
- (gnus-group-make-kiboze-group): Fix prompt.
-
- * message.el (message-send-mail-partially): Replace the header
- delimiter with a blank line.
- (message-sending-message): New variable.
- (message-send): Use it.
- (message-default-charset): Default value for non-Mule Emacsen.
- (message-alternative-emails): New.
- (message-use-alternative-email-as-from): New.
- (message-setup): Use them.
- (message-default-charset): Set default value in non-MULE XEmacsen
- as iso-8859-1.
-
-2000-10-27 Bjorn Torkelsson <torkel@hpc2n.umu.se>
-
- * message.el: xemacs cleanup (use featurep ' xemacs)
-
- * nnheader.el: ditto
-
- * mm-util.el: ditto
-
-2000-10-27 Stanislav Shalunov <shalunov@internet2.edu>
-
- * message.el (message-make-in-reply-to): In-Reply-To is message-id
- (see DRUMS).
-
-2000-10-27 Simon Josefsson <simon@josefsson.org>
-
- * message.el (message-send): Make sure error is signalled if no
- send method is specified.
-
-2000-10-27 Dave Love <fx@gnu.org>
-
- * gnus-group.el (gnus-group-make-menu-bar): Add some :help
- strings.
- (gnus-group-make-tool-bar): New function.
- (gnus-group-mode): Use it.
-
- * message.el (message-mode-menu): Add some :help strings.
- (message-mode) [message-tool-bar-map]: Define tool-bar-map.
- (featurep): Use (featurep 'xemacs). Install tool bar for Emacs.
-
- * catchup.xpm, exit-gnus.xpm, gnntg.xpm, subscribe.xpm:
- * describe-group.xpm, get-news.xpm, kill-group.xpm:
- * unsubscribe.xpm: New files. Renamed icons from Luis Fernandes.
-
- * mm-decode.el (mm-valid-and-fit-image-p): Don't test
- display-graphic-p here.
-
-2000-10-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-viewer-completion-map): New.
- (mm-interactively-view-part): Use it.
-
-2000-10-27 Simon Josefsson <sj@extundo.com>
-
- * mail-source.el (mail-sources): IMAP predicate is a string.
- (mail-sources): Add default values for IMAP mailbox, predicate and
- fetchflag.
-
-2000-10-27 Miles Bader <miles@lsi.nec.co.jp>
-
- * gnus-ems.el (gnus-ems-redefine): Use (featurep 'xemacs) instead
- of the `gnus-xemacs' variable, as the latter has been removed.
- * gnus-start.el (gnus-1, gnus-read-descriptions-file): Likewise.
- * gnus-art.el (gnus-treat-display-xface)
- (gnus-treat-display-smileys, gnus-treat-display-picons)
- (gnus-article-read-summary-keys): Likewise.
-
-2000-10-26 Dave Love <fx@gnu.org>
-
- * flow-fill.el: Require cl when compiling.
-
-2000-10-26 Simon Josefsson <simon@josefsson.org>
-
- * flow-fill.el (fill-flowed): Don't flow "-- " lines.
- (fill-flowed): Make "quote-depth wins" rule work when first line
- is at level 0.
-
-2000-10-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el: Remove gnus-xemacs. Autoload smiley.
- (gnus-kill-all-overlays): Move here.
-
- * gnus-util.el (gnus-kill-all-overlays): Move out.
-
-2000-10-26 Dave Love <fx@gnu.org>
-
- * mail-source.el: Require imap when compiling and defvar
- display-time-mail-function. Require mm-util.
- (nnheader-cancel-timer): Autoload.
- (mail-source-imap-authenticators, mail-source-imap-streams): New
- variables.
- (mail-sources): Use them.
- (defvar): Use rmail-spool-directory unconditionally.
-
-2000-10-26 Dirk Meyer <dischi@tzi.de>
-
- * gnus-demon.el (gnus-demon-time-to-step): theHour was set to
- seconds instead of hour.
-
-2000-10-26 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mail-source.el (mail-sources): Better `:type'.
-
-2000-10-26 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * mail-source.el (mail-source-keyword-map): Use
- `rmail-spool-directory' as a default directory for the `file'
- source, if the variable is defined. Fall back to hardcoded
- "/usr/spool/mail/", as before. Suggestion by Steven E. Harris
- <seh@speakeasy.org>.
-
-2000-10-25 Jason Rumney <jasonr@gnus.org>
-
- * gnus-art.el (gnus-signature-face): Use italic on any frame that
- supports it.
-
-2000-10-18 Dave Love <fx@gnu.org>
-
- * mm-bodies.el (mm-uu-decode-function)
- (mm-uu-binhex-decode-function): Defvar when compiling.
-
- * gnus-nocem.el (gnus-nocem-issuers): Update.
- (gnus-nocem-check-from): New option.
- (gnus-nocem-scan-groups): Use it.
- (gnus-nocem-check-article): Bind gnus-newsgroup-name.
- (gnus-nocem-check-article-limit): Add :version.
-
-2000-10-16 Miles Bader <miles@lsi.nec.co.jp>
-
- * gnus-nocem.el (gnus-nocem-check-article-limit): New variable.
- (gnus-nocem-scan-groups): Obey `gnus-nocem-check-article-limit'.
-
-2000-10-16 Stefan Monnier <monnier@cs.yale.edu>
-
- * ietf-drums.el (mm-util): Require CL when compiling.
-
-2000-10-15 Dave Love <fx@gnu.org>
-
- * qp.el: Require mm-util.
-
-2000-10-13 Dave Love <fx@gnu.org>
-
- * qp.el (quoted-printable-decode-region): Avoid invalid
- coding-systems.
-
-2000-10-12 Gerd Moellmann <gerd@gnu.org>
-
- * mm-bodies.el: Don't require `mm-uu' at compile-time; it leads
- to a recursive load.
-
-2000-10-12 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-charset-synonym-alist): Add windows-1252.
-
- * gnus.el (gnus-group-startup-message): Check for PBM image.
-
-2000-10-09 Dave Love <fx@gnu.org>
-
- * mail-source.el (mail-source-fetch-imap): Bind
- default-enable-multibyte-characters rather than using
- mm-disable-multibyte.
-
-2000-10-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-maildir): Don't insert
- newlines.
-
-2000-10-06 Stefan Monnier <monnier@cs.yale.edu>
-
- * mm-encode.el: Require CL. At least, for `incf'.
-
-2000-10-06 Dave Love <fx@gnu.org>
-
- * gnus-audio.el: Don't require cl.
- (gnus-audio): New custom group.
- (gnus-audio-inline-sound): Change to work with Emacs.
- (gnus-audio-directory, gnus-audio-directory)
- (gnus-audio-au-player): Customize.
- (gnus-audio-play): Try external player if play-sound-file fails.
- Use file-name-extension, not string-match.
-
-2000-10-05 Dave Love <fx@gnu.org>
-
- * rfc1843.el: Require cl when compiling.
-
- * qp.el (mm-decode-coding-region, mm-encode-coding-region):
- Autoload.
- (quoted-printable-decode-region): Rename arg which confused
- charset with coding-system. Don't use nonascii-insert-offset.
- Coding-system encode the region initially. Don't recognize `=='
- as valid QP. Coding-system decode the region finally.
- (quoted-printable-decode-string): Rename arg which confused
- charset with coding-system.
-
- * mm-bodies.el: Require mm-uu, Don't require qp, uudecode.
- (mm-encode-body): Apply mm-charset-to-coding-system to arg of
- mm-encode-coding-region.
- (mm-decode-body, mm-decode-string): Rename variables which
- confused charset with coding-system.
- (binhex-decode-region): Don't autoload.
- (mm-body-encoding): Require message.
- (mm-decode-content-transfer-encoding): Require mm-uu in relevant
- cond branches.
-
- * gnus-art.el (article-de-quoted-unreadable)
- (article-de-base64-unreadable): Fold search case
- rather than downcasing string. Apply mm-charset-to-coding-system
- to arg of quoted-printable-decode-region.
-
-2000-10-05 Stefan Monnier <monnier@cs.yale.edu>
-
- * nnfolder.el (nnfolder-ignore-active-file): Typos.
-
- * gnus-mh.el (gnus-summary-save-in-folder): Obey mh-lib-progs.
-
- * gnus-kill.el (gnus-kill): Typo.
-
-2000-10-05 Kenichi Handa <handa@etl.go.jp>
-
- * gnus-mule.el: Revived.
-
-2000-10-04 Dave Love <fx@gnu.org>
-
- * gnus-ems.el: Don't turn off compiler warnings in local vars.
- Require ring when compiling.
- (gnus-x-splash): Bind width, height.
- (gnus-article-compface-xbm): New variable.
- (gnus-article-display-xface): Move graphic test. Use unibyte.
- Obey gnus-article-compface-xbm. Use pbm, not xbm.
-
-2000-10-04 Stefan Monnier <monnier@cs.yale.edu>
-
- * nnimap.el: require 'cl when compiling.
-
-2000-10-04 Dave Love <fx@gnu.org>
-
- * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use
- pbm images.
-
- * frown.pbm, smile.pbm, wry.pbm: New files.
-
- * frown.xbm, smile.xbm, wry.xbm: Deleted.
-
-2000-10-03 Dave Love <fx@gnu.org>
-
- * mail-source.el (mail-sources): Revert to nil.
-
- * nnmail.el (nnmail-spool-file): Revert to `((file))'.
-
- * qp.el: Don't require mm-util.
- (quoted-printable-decode-region): Rewritten.
- (quoted-printable-decode-string, quoted-printable-encode-region):
- Doc fix.
- (quoted-printable-encode-region): Barf on multibyte characters.
- Maybe make the class multibyte. Upcase chars, not formatted
- strings. Allow mm-use-ultra-safe-encoding to be unbound.
- (quoted-printable-encode-string): Don't use
- mm-with-unibyte-buffer.
-
-2000-10-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-report-new-mail): Use
- nnheader-cancel-timer.
-
-2000-10-03 Simon Josefsson <simon@josefsson.org>
-
- * mail-source.el (mail-source-imap-file-coding-system): New variable.
- (mail-source-fetch-imap): Use it.
-
-2000-09-29 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-mode-line-buffer-identification)[EMACS]: Fix
- last change.
-
- * gnus.el (gnus-mode-line-buffer-identification)[EMACS]: Use
- `:ascent center'.
-
- * smiley-ems.el (smiley-update-cache): Use `:ascent center'.
-
-2000-09-28 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-mode-line-buffer-identification) [Emacs]: Change
- image's :ascent to 80. That gives a mode-line which is approx.
- as tall as the normal one.
-
-2000-09-21 Dave Love <fx@gnu.org>
-
- * smiley-ems.el (smiley-region): Test if display-graphic-p bound
- (for Emacs 20). Tidy somewhat.
-
-2000-09-21 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-article-display-xface): Use unibyte for the
- image processing. Rationalize logic somewhat.
-
-2000-09-20 Dave Love <fx@gnu.org>
-
- * smiley-ems.el, frown.xbm, smile.xbm, wry.xbm: New files.
-
- * mail-source.el (mail-source-delete-incoming): Set to t, assuming
- we'll be careful merging development changes.
-
- * gnus-start.el (gnus-1) <gnus-simple-splash>: Don't test for X
- specifically.
-
- * gnus-ems.el (gnus-smiley-display): Autoload from smiley-ems.
- (mouse-set-point, set-face-foreground)
- (set-face-background, x-popup-menu) [not window-system]: Don't zap
- them.
-
- * mm-decode.el (mm-valid-and-fit-image-p): Use display-graphic-p.
-
- * gnus.el (gnus-version-number): Start 5.9 series. Avoid some
- redundant autoloads.
-
-2000-09-20 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-ems.el (gnus-article-display-xface): Don't convert PBM
- to XBM; we always have PBM support.
-
-2000-09-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-make-kiboze-group): Makedir.
- * nnheader.el (nnheader-parse-nov): Remove Xref in mail-header-xref.
- * gnus-sum.el (gnus-nov-parse-line): Ditto.
- * nnkiboze.el (nnkiboze-file-coding-system): New.
- (nnkiboze-retrieve-headers): Use it.
- (nnkiboze-request-group): Ditto.
- (nnkiboze-close-group): Ditto.
- (nnkiboze-generate-group): Ditto.
- (nnkiboze-enter-nov): Insert first Xref properly.
-
-2000-09-19 Dave Love <fx@gnu.org>
-
- * nnmail.el (nnmail-cache-accepted-message-ids): Default to nil.
- (nnmail-get-new-mail): Test `sources' in top-level conditional.
-
- * mail-source.el (mail-sources): Change default to '((file)).
- Add useful custom type.
-
-2000-09-18 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-util.el (gnus-time-iso8601): Correct doc string (four digit
- year).
- (gnus-date-iso8601): Ditto.
-
-2000-09-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-imap): Disable multibyte.
-
-2000-09-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-q-encoding-alist): Remove = and _ from the
- pattern. Avoid using 8 bit chars.
- * qp.el (quoted-printable-encode-region): Avoid using 8 bit chars.
-
-2000-09-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smiley.el (smiley-buffer-ems, smiley-create-glyph-ems,
- smiley-toggle-extent-ems, smiley-toggle-extents-ems,
- smiley-toggle-buffer-ems): New functions for Emacs 21. Toggle
- functions are not implemented yet.
-
- * dgnushack.el (dgnushack-compile): Remove smiley.el and
- x-overlay.el from the FSF Emacs black list.
-
-2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-inlined-types): Add application/emacs-lisp.
- (mm-inline-media-tests): Ditto.
- (mm-automatic-display): Ditto.
- * mm-view.el (mm-display-inline-fontify): Generalize from
- mm-display-patch-inline.
- (mm-display-patch-inline): Use it.
- (mm-display-elisp-inline): Ditto.
-
-2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-find-groups): Add recursive parameter.
- (gnus-topic-unmark-topic): Ditto.
- (gnus-topic-mark-topic): Ditto.
- (gnus-topic-get-new-news-this-topic): Use it.
-
-2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-display-xface): By default, Emacs 21
- display xface.
-
-2000-09-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-rename-group): Inhibit renaming of
- zombie or killed groups.
-
-2000-09-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Reinsert unibyte content.
- (mml-parse-1): Remove with-unibyte-current-buffer.
- (mml-generate-mime-1): Ditto.
- * gnus-msg.el (gnus-summary-mail-forward): Ditto.
- * message.el (message-forward): Ditto.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-de-quoted-unreadable): Guess charset from
- original article buffer.
- (article-de-base64-unreadable): Ditto.
- (article-wash-html): Ditto.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Disable multibyte
- unless forward-show-mml.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-save-parts-type-history): New.
- (gnus-summary-save-parts-last-directory): New.
- (gnus-summary-save-parts): Save history.
-
-2000-09-14 Ben Gertzfield <che@debian.org>
-
- * gnus-sum.el (gnus-summary-save-parts-default-mime): New
- variable.
- (gnus-summary-save-parts): Use it.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-setup-buffer): Clean handle-alist.
- * gnus-sum.el (gnus-summary-exit): Ditto.
- (gnus-summary-exit-no-update): Ditto.
- (gnus-summary-show-article): Ditto.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Remove
- Content-Disposition.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Hotmail updated. Add X-Gnus-Webmail.
-
-2000-09-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-setup-buffer): Set
- gnus-article-mime-handles to nil.
- * gnus-sum.el (gnus-summary-exit): Ditto.
- (gnus-summary-exit-no-update): Ditto.
- (gnus-summary-show-article): Ditto.
- (gnus-summary-save-parts): Use gnus-article-mime-handles if
- dissected.
- * mm-partial.el (mm-partial-find-parts): Remove redundancy.
-
-2000-09-14 Dave Love <fx@gnu.org>
-
- * gnus.el (gnus-charset):
- * mm-decode.el (mime-display):
- * imap.el (imap) <defgroup>: Add :version.
-
-2000-09-13 Gerd Moellmann <gerd@gnu.org>
-
- * parse-time.el: Fix author's mail address.
-
- * earcon.el, flow-fill.el, gnus-cite.el, gnus-gl.el, gnus-ml.el:
- * gnus-mlspl.el, gnus-nocem.el, gnus-range.el, gnus-salt.el:
- * gnus-setup.el, gnus-soup.el, gnus-undo.el, gnus-vm.el:
- * messcompat.el, nnbabyl.el, nndir.el, nneething.el:
- * nngateway.el, nnheaderxm.el, nnkiboze.el, nnlistserv.el:
- * nnmbox.el, nnmh.el, nnoo.el, nnsoup.el, nnspool.el, rfc2045.el:
- * rfc2231.el, uudecode.el: Fix copyright notice.
-
- * nnweb.el (toplevel): To make the file bootstrap in Emacs,
- require `w3' at load-time only if not running in batch mode.
-
-2000-09-13 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-ems-redefine): Don't alias
- gnus-summary-set-display-table.
-
- * message.el (message-user-agent): Don't wrap ignore-errors around
- it.
-
- * mm-encode.el (mm-insert-multipart-headers): Avoid redundant
- `format'.
- (mm-content-transfer-encoding): Don't use cadar.
-
- * uudecode.el (uudecode-decoder-program)
- (uudecode-decoder-switches): Customize.
-
- * gnus-score.el (gnus-home-score-file): Improve custom type.
-
- * gnus-cus.el (gnus-custom-mode): Conditionally set local
- variables for Emacs 21.
- (gnus-group-customize): Disable undo while laying out the buffer.
-
-2000-09-13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-write-active-file): Bind
- coding-system-for-write.
-
- * nnmail.el (nnmail-get-new-mail): Don't test nnmail-spool-file.
-
- * gnus-cache.el (gnus-jog-cache): Temporarily disable mail-sources.
- * gnus-kill.el (gnus-batch-score): Ditto.
- * gnus-move.el (gnus-change-server): Ditto.
- * nnkiboze.el (nnkiboze-generate-groups): Ditto.
-
-2000-09-12 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-update-read-articles): Undo
- `gnus-request-set-mark' operation.
-
-2000-09-11 Dave Love <fx@gnu.org>
-
- * ChangeLog: Use iso-2022 coding.
-
- * gnus-msg.el (gnus-msg-mail): New function.
- (gnus-user-agent): New mail agent.
-
-2000-09-10 Dave Love <fx@gnu.org>
-
- * message.el: Require mail-abbrevs for XEmacs for a problem with
- keybinding despite the autoloads for it.
-
-2000-09-08 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-kerberos4-open): Erase more (fixes race condition?).
-
- * nnimap.el (nnimap-request-update-info-internal): Remove tick
- marks from dormant articles. (See nnimap-request-set-mark.)
- (nnimap-retrieve-headers-progress): Demule.
- (nnimap-open-server): Call nnoo-change-server twice, once for
- getting the nnimap-server-buffer and once for letting n-c-s set
- the variables in that buffer.
-
-2000-09-08 David Edmondson <dme@dme.org>
-
- * gnus.el (gnus-short-group-name): Guess separator.
-
-2000-09-06 Francis Litterio <franl-removethis@world.omitthis.std.com>
-
- * gnus-group.el (gnus-group-insert-group-line): Fix.
-
-2000-09-04 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mime-display) <defgroup>: Add `multimedia' group.
- (mm-get-image): Avoid the losing `make-glyph' from W3.
-
-2000-09-03 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-summary-delete-article): Check server.
-
-2000-09-01 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-parse-flag-list): Rewrite.
-
- * nnimap.el (nnimap-retrieve-headers-from-file): Ignore errors.
-
- * imap.el (imap-parse-flag-list): Hack.
-
-2000-08-29 Dave Love <fx@gnu.org>
-
- * gnus-mlspl.el (gnus-group-split-fancy): Eschew mapcon.
-
- * gnus-agent.el (gnus-agent-union): new function.
- (gnus-agent-fetch-headers): Use it.
-
- * gnus.el (gnus-group-startup-message): Specify foreground and
- background for xpm image. Centre image vertically.
- From Katsumi Yamaoka <yamaoka@jpl.org> with mods.
-
-2000-08-25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail): Narrow-to-headers.
-
-2000-08-24 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-insert-mime-button): Fix help-echo for Emacs
- 21.
-
-2000-08-21 Dave Love <fx@gnu.org>
-
- * nnimap.el (nnimap-request-newgroups): Eschew member-if.
-
-2000-08-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-hide-topic): Use find-topology if
- permanent is used.
- (gnus-topic-show-topic): Read topic when to show permanent hidden
- topic.
- (gnus-topic-remove-topic): Revert to the old behavior, not using
- hide.
-
-2000-08-21 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-add-minor-mode): Add &rest arg.
- (gnus-xemacs): Use featurep.
-
- * mm-util.el (mm-read-charset): Maybe use builtin.
- (mm-replace-chars-in-string): Maybe use subst-char-in-string.
- (mm-multibyte-p, mm-with-unibyte-current-buffer)
- (mm-with-unibyte): Use featurep, not string-match.
- (mm-with-unibyte-buffer): Simplify.
- (mm-quote-arg): Maybe use shell-quote-argument.
-
- * mml.el (mml-make-string): Deleted (unused).
-
- * gnus.el (gnus-mode-line-buffer-identification): Supply
- definition for Emacs 21.
-
- * gnus-salt.el: Small doc fixes.
- (gnus-pick-mode, gnus-binary-mode): Supply a toggle-func arg to
- gnus-add-minor-mode.
-
- * gnus-topic.el (gnus-topic-mode): Supply a toggle-func arg to
- gnus-add-minor-mode.
-
-2000-08-20 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-before-find-minmax-bugworkaround): New
- function, thanks to Lloyd Zusman for debugging.
- (nnimap-request-group):
- (nnimap-request-list):
- (nnimap-retrieve-groups):
- (nnimap-request-newgroups): Use it.
-
- * nnimap.el (nnimap-request-article-part): Less verbose.
-
-2000-08-18 Dave Love <fx@gnu.org>
-
- * gnus-score.el (gnus-score-find-score-files-function): Fix doc,
- custom type.
-
- * nnheader.el (nnheader-replace-chars-in-string): Use
- subst-char-in-string if available.
-
- * gnus-art.el (gnus-read-save-file-name, gnus-plain-save-name)
- (gnus-request-article-this-buffer): Use expand-file-name.
- (gnus-mime-view-part-as-type): Simplify interactive spec.
- (gnus-mime-button-map): Define it all in defvar.
-
-2000-08-17 Dave Love <fx@gnu.org>
-
- * gnus-group.el (gnus-group-running-xemacs): Deleted.
-
- * gnus-demon.el (gnus-demon): Bind use-dialog-box and
- last-nonmenu-event.
-
- * uudecode.el (char-int): Use defalias, not fset.
-
- * score-mode.el: Don't require easymenu. Require mm-util.
- (score-mode-coding-system): Use mm-auto-save-coding-system.
-
- * nneething.el (nneething-create-mapping): Don't use cadar & al.
- (nneething-file-name): Use expand-file-name, not concat.
-
-2000-08-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers):
- Failure proof for email addresses.
- (nnslashdot-sane-retrieve-headers): Ditto.
-
-2000-08-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Only insert courtesy message
- when text/plain.
-
-2000-08-14 Jesper Harder <jesper_harder@hotmail.com>
-
- * message.el (message-cancel-news): Copy the From header from the
- original article.
-
-2000-08-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-async.el (gnus-asynchronous): Removed.
-
-2000-08-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-maildir): Use MMDF mail
- format.
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * nnmail.el (nnmail-expiry-target-group): Fixed.
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * nnmail.el (nnmail-expiry-target-group): Fix the call to
- gnus-request-accept-article so that body encoding is *not* done.
- Encoding is not done on incoming mail, so why should it be done on
- expired mail?
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * nnml.el (nnml-request-expire-articles): Fix the calls to
- nnml-request-article (the filename was being passed instead of the
- article number) and nnmail-expiry-target-group
- (nnml-current-directory is changed by nnml-request-accept-article,
- causing it to be incorrect for the next article to be expired).
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * gnus-sum.el (gnus-summary-expire-articles): Fix the handling of
- expiry-target group parameters.
-
-2000-08-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-select-group): Touch the dribble
- buffer.
- (gnus-topic-hide-topic): Take a PERMANENT parameter.
- (gnus-topic-show-topic): Ditto.
-
- * gnus-dup.el (gnus-dup-suppress-articles): Do auto-expiry.
-
-2000-08-12 John H. Palmieri <palmieri@math.washington.edu>
-
- * mail-source.el (mail-source-incoming-file-prefix): New
- variable.
-
-2000-08-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-check-first-time-used): Clean up a bit.
-
- * mailcap.el (mailcap-maybe-eval): Be even more warning.
-
-2000-08-11 Florian Weimer <fw@deneb.enyo.de>
-
- * message.el (message-syntax-checks): New check quotin-style:
- Text must be written below quoted text.
- (message-check-news-body-syntax): Check it.
-
-2000-08-11 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-authenticator-alist): Fix typo.
- (imap-gssapi-open): Copy krb4 fixes for modern imtest's, thanks to
- Jonas Oberg for debugging.
-
-2000-08-11 Simon Josefsson <simon@josefsson.org>
-
- * gnus-async.el (gnus-asynchronous): Disable by default.
-
-2000-08-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind fill-column.
-
- * nnvirtual.el (nnvirtual-request-expire-articles): Return the
- list of unexpired articles.
-
- * gnus-group.el (gnus-group-expire-articles-1): Return the list of
- un-expired articles.
-
- * gnus-sum.el (gnus-summary-reparent-thread): Narrow to the
- headers.
-
- * gnus-topic.el (gnus-topic-kill-group): Move up one line so that
- we update the right topic..
-
- * mm-decode.el (mm-display-external): Put point at start.
-
-2000-08-10 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-expiry-target): More explicit documentation.
-
- * gnus-cus.el (gnus-group-parameters): Add parameter `expiry-wait'.
-
-2000-08-09 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-parse-body):
- (imap-parse-string-list): Add bug workarounds for Stalker
- Communigate Pro 3.0 server.
- (imap-body-lines): Remove bogus comment.
-
- * imap.el (imap-range-to-message-set): Move from nnimap.el.
-
- * nnimap.el (nnimap-retrieve-which-headers):
- (nnimap-retrieve-headers-from-server):
- (nnimap-request-set-mark):
- (nnimap-request-expire-articles): Use `i-r-t-m-set' instead.
-
-2000-08-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-dont-reply-to-names):
- rmail-dont-reply-to-names may not be defined.
-
-2000-08-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-iterate): Uncompiled function should
- not use pop.
-
-2000-07-19 Dave Love <fx@gnu.org>
-
- * gnus-ems.el: Defalias some dummy funcs to `ignore'.
- (gnus-x-splash): Use expand-file-name. Remove redundant facep
- check.
- (gnus-article-display-xface): Special-case for dark backgrounds.
-
-2000-07-19 Kim-Minh Kaplan <kmkaplan@galaxy.fr>
-
- * imap.el (imap-calculate-literal-size-first): New variable.
- (imap-local-variables): Add it.
- (imap-kerberos4-open): Set it.
- (imap-send-command): Use it.
-
-2000-07-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-mimetypes-parsed-p): New variable.
- (mailcap-parse-mimetypes): Use it.
- (mailcap-extension-to-mime): Parse mimetype.
- (mailcap-mime-types): Ditto.
- * mml.el (mml-minibuffer-read-type): Ditto.
-
-2000-07-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Add outlook.
- (nndoc-outlook-type-p): New function.
- (nndoc-outlook-article-begin): Ditto.
-
-2000-07-16 Daiki Ueno <ueno@unixuser.org>
-
- * gnus-sum.el (gnus-restore-hidden-threads-configuration): Save
- excursion.
-
-2000-07-15 Simon Josefsson <simon@josefsson.org>
-
- * gnus-cus.el (gnus-group-parameters, banner): Type is regexp.
-
- * imap.el (imap):
- (imap-kerberos4-program):
- (imap-gssapi-program):
- (imap-ssl-program): Customization.
- (imap-shell-program):
- (imap-shell-host): New variables.
- (imap-streams):
- (imap-stream-alist): Add shell.
- (imap-shell-p):
- (imap-shell-open): New functions.
- (imap-open): Don't call authenticator if preauth.
- (imap-authenticate): Return t if already authenticated.
-
-2000-07-14 Simon Josefsson <simon@josefsson.org>
-
- * gnus.el (gnus-invalid-group-regexp): New variable.
- (gnus-read-group): Use it.
-
-2000-07-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): mark-below,
- expunge-below and orphan-score are "group variables".
-
-2000-07-13 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-srvr.el (gnus-browse-read-group): Don't pass fully
- qualified group names to `gnus-group-read-ephemeral-group'.
-
-2000-07-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el: `W t' is toggle-header in info.
-
-2000-07-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-de-base64-unreadable): Typo.
-
-2000-07-12 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (require): Require timer.
-
-2000-07-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-bounce): Call mime-to-mml.
-
-2000-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-close): New function.
-
-2000-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Get the
- right line number for the article.
-
-2000-07-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Save point.
- * webmail.el (webmail-fetch): Bind
- url-http-silence-on-insecure-redirection.
-
-2000-07-10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Use
- unibyte.
- (nnslashdot-sane-retrieve-headers): Ditto.
- (nnslashdot-request-article): Ditto.
-
-2000-07-10 William M. Perry <wmperry@aventail.com>
-
- * mailcap.el (mailcap-parse-mimetype-file):
-
-2000-07-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-insert): Stricter test.
- * webmail.el (webmail-refresh-redirect): Ditto.
-
-2000-07-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-multipart): Match the EOL of boundary.
-
-2000-07-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-insert-nov): Remove EOLs of all fields.
-
-2000-07-05 Dave Love <fx@gnu.org>
-
- * utf7.el: Doc and header fixes.
-
- * gnus-sum.el: Doc fixes.
-
- * gnus-util.el (gnus-point-at-eol, gnus-point-at-bol): Use
- defalias, not fset.
-
- * flow-fill.el (fill-flowed-point-at-eol)
- (fill-flowed-point-at-bol): Use defalias, not fset.
-
- * gnus-art.el: Don't alias article-mime-decode-quoted-printable.
- (gnus-Plain-save-name): Delete -- apparently bogus.
-
-2000-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnsoup.el: Use expand-file-name throughout.
-
-2000-07-03 Kjetil Torgrim Homme <kjetilho@ifi.uio.no>
-
- * nnmail.el (nnmail-read-incoming-hook): New example.
-
-2000-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Check whether the text has already
- been decoded.
-
-2000-07-04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-sid-strip): To strip or not to strip?
-
-2000-07-03 Stainless Steel Rat <ratinox@peorth.gweep.net>
-
- * gnus-sum.el (gnus-recenter): Fix horizontal recenter.
-
-2000-07-03 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-update-marks): Don't propagate download and
- unsend flags.
-
-2000-07-03 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-open-connection): Don't look up virtual server
- name in authinfo (.authinfo now support ports, no need for the
- hack).
- (nnimap-split-find-rule): Fix.
- (nnimap-open-connection): Look for nnimap-server-address in authinfo.
-
-2000-07-03 Paul Stodghill <stodghil@CS.Cornell.EDU>
-
- * message.el (message-unquote-tokens): Remove all quotes.
-
-2000-07-03 Julien Gilles <julien.gilles@bcv01y01.vz.cit.alcatel.fr>
-
- * gnus-ml.el: New file.
-
-2000-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-request-close): New function.
-
- * gnus-start.el (gnus-clear-system): Clear nnmail-split-history.
-
-2000-07-02 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
-
- * gnus.el: Gnus v5.8.7 is released.
-
-2000-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-insert-part): Characters doubly decoded.
-
-2000-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-do-fcc): Encode MIME.
-
-2000-06-28 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-split-rule): Update doc with extended syntax.
- (nnimap-assoc-match): New function.
- (nnimap-split-find-rule): Support extended syntax.
-
-2000-06-28 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-open-connection): Use port stuff.
-
- * gnus-util.el (gnus-netrc-machine): Add defaultport parameter,
- document port and defaultport.
-
-2000-06-27 Paul Stodghill <stodghil@CS.Cornell.EDU>
-
- * gnus-agent.el (gnus-agent-synchronize): Kill flags buffer.
-
-2000-06-26 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mm-image-fit-p): Use `image-size' in Emacs.
-
- * message.el: Remove unnecessary `require'ments. Defvar
- gnus-list-identifiers when compiling. Don't try to autoload
- variable `gnus-list-identifiers'. Autoload
- gnus-group-name-charset.
- (message-fetch-field): Don't assume `format' removes text
- properties.
- (message-strip-list-identifiers, message-reply, message-followup):
- Require gnus-sum.
- (message-mode): Tidy XEmacs conditionals.
- (message-replace-chars-in-string): Use subst-char-in-string when
- available.
-
- * gnus-art.el (gnus-article-edit-exit): Don't assume `format'
- removes text properties.
-
- * gnus-srvr.el (gnus-browse-group-name): Likewise.
-
- * gnus-msg.el (gnus-copy-article-buffer): Likewise.
-
- * gnus-score.el (gnus-summary-score-entry): Likewise.
-
-2000-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnimap.el (nnimap-request-post): Fix parenthesis.
-
-2000-06-26 Paul Stodghill <stodghil@CS.Cornell.EDU>
-
- * message.el (message-unquote-tokens): New function.
-
- * gnus-msg.el (gnus-inews-do-gcc): Unquote gcc tokens.
-
- * nnimap.el (nnimap-request-post): Ditto.
-
-2000-06-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-asynchronous): Removed (defined in gnus-async.el).
-
- * nnimap.el (nnimap-callback): Update for IMAP4rev1 servers (see
- patch commited 2000-04-02).
-
-2000-06-20 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-mailbox-examine-1): New function.
- (imap-message-copyuid-1):
- (imap-message-appenduid-1): Use it, instead of
- `imap-mailbox-examine' which would utf-7 encode mailbox name
- twice.
-
-2000-06-19 Dave Love <fx@gnu.org>
-
- * mm-uu.el Don't require message. Require cl when compiling.
-
-2000-06-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-local-variables): gnus-orphan-score is
- a local variable.
- * gnus-sum.el (gnus-orphan-score): Move here.
-
-2000-06-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward): Remove show-mml condition.
- (message-forward-ignored-headers): Remove X-Gnus headers.
-
-2000-06-08 Simon Josefsson <simon@josefsson.org>
-
- * gnus-cus.el (gnus-extra-group-parameters): Add uidvalidity.
-
-2000-06-08 Urban Engberg <ue@ccieurope.com>
-
- * gnus-demon.el (gnus-demon-scan-mail): Bind nnmail-fetched-sources.
-
-2000-06-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-syntax-checks): Add type.
-
-2000-06-07 Dave Love <fx@gnu.org>
-
- * mm-view.el (mm-inline-image-emacs): Don't specify string for
- put-image.
- (mm-inline-image): Defalias, not fset.
-
- * gnus.el (gnus-group-startup-message): Don't specify string for
- insert-image.
-
- * gnus-ems.el (gnus-add-minor-mode): Make it an alias if
- add-minor-mode is available.
- (gnus-article-display-xface): Don't specify string for
- insert-image.
-
-2000-06-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-remove-topic): Set hidden.
- (gnus-topic-insert-topic-line): Use shownp.
- (gnus-topic-hide-topic): Don't use hidden.
- (gnus-topic-show-topic): Don't use hidden.
-
-2000-06-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Bind coding
- system.
- * gnus-soup.el (gnus-soup-write-prefixes): Ditto.
- * gnus-start.el (gnus-slave-save-newsrc): Ditto.
- * gnus-util.el (gnus-output-to-rmail): Ditto.
- (gnus-output-to-mail): Ditto.
- (gnus-write-buffer): Ditto.
- * gnus-uu.el (gnus-uu-save-article): Ditto.
-
-2000-06-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-read-from-minibuffer): Typo.
-
-2000-06-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Override non-MIME forward
- charset.
-
-2000-06-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-quote-region): Correct the regexp.
- * gnus-msg.el (gnus-summary-reply): mml-quote it.
-
-2000-06-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward): Insert raw text.
- * mml.el (mml-parse-1): Get raw text in unibyte mode.
- (mml-generate-mime-1): Insert raw text in unibyte mode.
-
-2000-06-01 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-bodies.el (mm-body-encoding): Always encoded if
- `mm-use-ultra-safe-encoding' is set.
-
-2000-05-31 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (ange-ftp-name-format): Typo.
-
-2000-05-30 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): If
- `gnus-activate-group' and/or `gnus-check-server' return nil, don't
- try to do anything on that server.
-
-2000-05-25 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-group.el (gnus-group-nnimap-edit-acl): Help text updated
- from latest draft.
-
-2000-05-08 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-group.el (gnus-group-expire-articles-1): Make sure server
- is open.
-
-2000-05-24 Dave Love <fx@gnu.org>
-
- * mml.el (mml-parse-file-name): Fix ange-ftp part.
-
-2000-05-22 Didier Verna <didier@lrde.epita.fr>
-
- * gnus.el (gnus-redefine-select-method-widget): new function, call
- it once. Add an "other" entry for unknown but editable backend
- name symbols.
- * gnus-start.el (gnus-declare-backend): use it.
-
-2000-05-19 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-article-next-page): Revert last change.
-
-2000-05-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-open-history): Open history in binary mode.
-
-2000-05-19 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-mime-externalize-part): Bind mm-inlined-types,
- not mm-inline-large-images.
-
-2000-05-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Don't test multiple-charsets within mml tag.
-
-2000-05-18 Dave Love <fx@gnu.org>
-
- * gnus-art.el: Use defalias, not fset.
- (gnus-article-x-face-command): Don't test for xbm.
- (gnus-article-next-page): Redisplay before testing point in window.
-
-2000-05-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-mode-map): Add M-SPACE.
- * mml.el (mml-mode-map): Comment out mml-narrow-to-part.
-
-2000-05-17 Jim Davidson <jdavidson@acm.org>
-
- * gnus-sum.el (gnus-summary-save-article-rmail): Use
- gnus-summary-save-in-rmail.
- * message.el (message-output): Ditto.
-
-2000-05-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-emphasize-whitespace-regexp): Doc fix.
-
-2000-05-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode if the method
- is a charset.
- * message.el (message-send-news): Check group name charset.
- * gnus-msg.el (gnus-post-news): Decode group name.
- (gnus-inews-do-gcc): Encode group name.
-
-2000-05-17 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-art.el (gnus-emphasize-whitespace-regexp): New variable.
- * gnus-util.el (gnus-put-text-property-excluding-newlines): Use it.
-
-2000-05-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-mark-line-p): New function.
- (gnus-group-goto-group): New parameter.
- (gnus-group-remove-mark): Use it.
- * gnus-topic.el (gnus-topic-move-group): Ditto.
- (gnus-topic-remove-group): Ditto.
-
-2000-05-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-list-dormant): New function.
-
-2000-05-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-synchronize): Use
- nnheader-insert-file-contents.
- (gnus-agent-save-active-1): Ditto.
- (gnus-agent-write-active): Ditto.
- (gnus-agent-expire): Ditto.
- * gnus-cache.el (gnus-cache-read-active): Ditto.
- * gnus-start.el (gnus-master-read-slave-newsrc): Ditto.
- * gnus-sum.el (gnus-summary-import-article): Ditto.
-
- * gnus-agent.el (gnus-agent-write-servers): Bind coding-system.
- (gnus-agent-save-group-info): Ditto.
- (gnus-agent-save-alist): Ditto.
- * gnus-util.el (gnus-make-directory): Ditto.
-
- * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte.
-
-2000-05-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-preprocess-function): New variable.
- (mml-generate-mime-postprocess-function): New variable.
- (mml-generate-mime-1): Use them.
-
-2000-05-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-apropos): Group name charset.
- * gnus-sum.el (gnus-set-mode-line): Ditto.
- * gnus-group.el (gnus-group-decoded-name): New function.
- (gnus-group-edit-group): Use it.
- * gnus-cus.el (gnus-group-customize): Use it.
-
-2000-05-16 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve.
-
-2000-05-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-name-charset-method-alist): New variable.
- (gnus-group-name-charset-group-alist): Ditto.
- (gnus-group-name-charset): New function.
- (gnus-group-name-decode): New function.
- (gnus-group-insert-group-line): Use them.
- (gnus-group-prepare-flat-list-dead): Ditto.
- (gnus-group-list-active): Ditto.
- (gnus-group-describe-all-groups): Ditto.
- (gnus-group-prepare-flat-list-dead-predicate): Ditto.
- * gnus-srvr.el: (gnus-browse-foreign-server): Decode group name and
- add gnus-group property.
- (gnus-browse-group-name): Read gnus-group property.
-
-2000-05-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-possibly-change-group): Use
- file-name-coding-system instead of pathname-coding-system.
- * nnmail.el (nnmail-find-file): Ditto.
- (nnmail-write-region): Ditto.
- * nnmh.el (nnmh-retrieve-headers): Ditto.
- (nnmh-request-article): Ditto.
- (nnmh-request-group): Ditto.
- (nnmh-request-list): Ditto.
- (nnmh-possibly-change-directory): Ditto.
- (nnmh-active-number): Ditto.
- * nnml.el (nnml-possibly-change-directory): Ditto.
- (nnml-request-list): Ditto.
- (nnml-request-article): Ditto.
- (nnml-retrieve-headers): Ditto.
-
-2000-05-16 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-request-accept-article): Don't unselect
- mailbox if no mailbox is selected.
-
-2000-05-15 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-button-url-regexp): Revert earlier change.
- Recognize domain names starting with `www.' as starting an URL.
-
-2000-05-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-maildir): Insert "From ".
- (mail-source-keyword-map): Add "subdirs" for maildir.
-
-2000-05-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-scan-directory-mail-source-once): New variable.
- (nnmail-get-new-mail): Use it.
- * gnus-start.el (gnus-get-unread-articles): Ditto.
-
-2000-05-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-edit-article): Better support for
- nndraft:drafts.
- * nndraft.el (nndraft-request-replace-article): New function,
- bind nnmail-file-coding-system.
-
-2000-05-14 Dave Love <fx@gnu.org>
-
- * nnheader.el: Replace uses of `fset' with `defalias'.
- (jka-compr-compression-info-list): Only defvar when compiling.
-
-2000-05-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-netaddress-article): Refresh redirect.
-
-2000-05-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): w3 might not recognize utf-8.
-
-2000-05-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Translate &nbsp; to SP.
-
-2000-05-13 Robin S. Socha <robin@socha.net>
-
- * message.el (message-bounce): Doc typo.
-
-2000-05-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-encoding-type): u is USENET news format.
- (gnus-soup-store): Ditto.
- (gnus-soup-send-packet): Ditto.
- * nnsoup.el (nnsoup-replies-format-type): Ditto.
- (nnsoup-dissect-buffer): Ditto.
- (nnsoup-narrow-to-article): Ditto.
- (nnsoup-make-active): Ditto
-
-2000-05-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mode): Two parameters for local-variable-p.
-
-2000-05-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-strip-list-identifiers): New function.
- (message-reply): Use it and use message-strip-subject-re.
- (message-followup): Ditto.
- * gnus-art.el (article-hide-list-identifiers): Remove more.
- * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto.
-
-2000-05-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Bind
- mail-parset-charset and use non-numeric argument.
-
-2000-05-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-buffer-list): New variable.
- (mml-generate-new-buffer): New function.
- (mml-destroy-buffers): Ditto.
- (mml-insert-mime): Use them.
- * gnus-msg.el (gnus-setup-message): mml-buffer leaks.
- * gnus-sum.el (gnus-summary-edit-article): Ditto.
- * message.el (message-mode): Ditto.
- * gnus-uu.el (gnus-uu-digest-headers): Keep MIME headers.
- (gnus-uu-save-article): Support show-as-mml.
- * message.el (message-forward): Ditto.
-
-2000-05-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): mime-digest head-begin.
- (nndoc-mime-digest-type-p): Locate article head precisely.
- * mml.el (mml-generate-default-type): New variable.
- (mml-generate-mime-1): Use it.
- (mml-insert-mime-headers): Use it.
- * gnus-uu.el (gnus-uu-digest-buffer): New variable.
- (gnus-uu-digest-mail-forward): Use it and call message-forward
- with argument digest.
- (gnus-uu-save-article): Support message-forward-as-mime.
- * message.el (message-forward): Add parameter digest.
- * mm-decode.el (mm-dissect-default-type): New variable.
- (mm-dissect-buffer): Use it.
-
-2000-05-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Set space,
- newline and paragraph to nil when got a non-ascii character. Test
- paragraph before newline.
-
-2000-05-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Bind tab-width to 1. Set
- limit to 76.
-
-2000-05-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-sid-strip): New function.
- (nnslashdot-threaded-retrieve-headers): New format.
- (nnslashdot-sane-retrieve-headers): Ditto.
- (nnslashdot-request-article): Ditto.
- (nnslashdot-threaded-retrieve-headers): Thread properly.
- (nnslashdot-request-article): Be more lenient.
- (nnslashdot-threaded-retrieve-headers): Regexp search.
-
-2000-05-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-with-article): Define it before use it.
-
-2000-05-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-supersede): Use mime-to-mml.
- * mm-decode.el (mm-insert-part): Test the buffer if no encoding.
-
-2000-05-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-list-cached): Don't use
- `subst-char-in-string'.
-
-2000-05-08 Dave Love <fx@gnu.org>
-
- * pop3.el (pop3-open-server): Fix creating name of trace buffer.
-
-2000-05-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-interactively-view-part): Append %s if the
- method is a single word.
- * nnwarchive.el (nnwarchive-type-definition): Typo.
-
-2000-05-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-prepare-flat-list-dead-predicate): New
- function.
- (gnus-group-prepare-flat-predicate): Use it.
- (gnus-group-list-cached): List dead groups.
-
-2000-05-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Don't decode message with
- format.
-
-2000-05-07 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mailcap.el (mailcap-maybe-eval): Honor user request not to
- evaluate the Lisp code.
-
-2000-05-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-wash-html): New function.
- (gnus-article-wash-html): Bind.
- (gnus-article-make-menu-bar): Menu item.
- * gnus-sum.el (gnus-summary-wash-map): Bind 'h'.
- (gnus-summary-make-menu-bar): Menu item.
- * gnus.el: Autoload.
-
-2000-05-06 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * gnus-uu.el (gnus-uu-unshar-warning): New variable.
- (gnus-uu-unshar-article): Use it.
-
- * mailcap.el (mailcap-maybe-eval-warning): New variable.
- (mailcap-maybe-eval): Use it.
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Speling mistake
- in docstring.
-
- * mml.el (mml-generate-mime-1): Small comment.
-
-2000-05-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-de-base64-unreadable): New function.
- (gnus-article-de-base64-unreadable): Bind.
- (gnus-article-make-menu-bar): Menu item.
- * gnus-sum.el (gnus-summary-wash-map): Bind '6' and 'Z'.
- (gnus-summary-make-menu-bar): Menu item.
- * gnus.el: Autoload.
-
-2000-05-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Remove en/disable multibyte.
- (gnus-summary-select-article): Add en/disable multibyte.
-
-2000-05-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-edit-article): Enable multibyte.
- (gnus-summary-edit-article): New feature: editing raw articles.
-
-2000-05-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-region): Insert a space before encoding.
- Emacs MULE can not encode adjacent iso-2022-jp and cn-gb-2312.
- * gnus-msg.el (gnus-summary-mail-forward): Use unibyte buffer.
- Emacs MULE can not copy some 8bit characters in multibyte buffers.
- * mm-decode.el (mm-insert-part): Ditto.
-
-2000-05-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Extend forward regexp.
- (nndoc-forward-type-p): Ditto.
-
-2000-05-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-current-buffer): Set the default
- value of enable-multibyte-characters.
-
-2000-05-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): En/disable multibyte.
-
-2000-05-03 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-article-xface-ring-internal)
- (gnus-article-xface-ring-size): New variable.
- (gnus-article-display-xface): Use them to cache data. Don't try
- to use XPM. Set up binary coding for PBM's sake.
-
-2000-05-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-do-gcc): Set mail-parse-charset.
- * gnus-int.el (gnus-request-accept-article): Ditto.
- (gnus-request-replace-article): Ditto.
- * mm-util.el (mm-mime-mule-charset-alist): Add a fake mule-charset.
-
-2000-05-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): Test the validity of coding-system.
-
-2000-05-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode field by
- field.
- * mml.el (mml-to-mime): Use message-default-charset.
- (mml-preview): Narrow to headers.
- * message.el (message-send-mail): Use message-default-charset.
- (message-send-news): Narrow to headers;
- use message-default-charset.
-
-2000-05-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): A better junk
- detect.
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Save
- restriction.
- (mml-parse-1): Warning message.
- (mml-preview): Disable multibyte.
-
-2000-05-03 Dave Love <fx@gnu.org>
-
- * gnus.el (gnus-group-startup-message): Add newline before image.
-
-2000-05-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Check the coding-system.
- * message.el (message-send-mail): Use unibyte-buffer.
- (message-send-mail): Ditto.
-
-2000-05-01 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
-
- * gnus.el: Gnus v5.8.6 is released.
-
-2000-05-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Set no-markup-p and warn to nil.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially): Use forward-line.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-button-menu): Use call-interactively.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Ignore 0x1b.
- (mml-insert-mime): No markup only for text/plain.
- (mime-to-mml): Remove MIME headers.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Set gnus-newsgroup-charset.
- * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii
- as 8-bit.
-
-2000-04-28 Dave Love <fx@gnu.org>
-
- * gnus.el (gnus-group-startup-message): Maybe use image in Emacs
- 21.
-
- * mailcap.el (mailcap-parse-mailcaps): Revert last change to
- search order. Use parse-colon-path and remove some redundancy.
- Doc fix.
- (mailcap-parse-mimetypes): Code consistently with
- mailcap-parse-mailcaps. Doc fix.
-
- * gnus-start.el (gnus-unload): Iterate over `features', not
- `load-history'.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Don't create blank parts.
- (mml-read-part): Fix mml tag.
- (mml-insert-mime): Convert message/rfc822.
- (mml-insert-mml-markup): Add mmlp parameter.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially): Remove CTE.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-image): Fset it.
-
-2000-04-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Change forward regexp.
-
-2000-04-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially-limit): Change the
- default value.
-
-2000-04-27 Erik Toubro Nielsen <erik@ifad.dk>
-
- * gnus-util.el (gnus-extract-address-components): Name might be
- "".
-
-2000-04-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Use ARG.
- (gnus-summary-post-forward): Ditto.
- * message.el (message-forward-show-mml): New variable.
- (message-forward): Use it.
- * mml.el (mml-parse-1): Add tag mml.
- (mml-read-part): Ditto.
- (mml-generate-mime): Support reentance.
- (mml-generate-mime-1): Support mml tag.
-
-2000-04-27 Dave Love <fx@gnu.org>
-
- * gnus-art.el: Don't bother to require custom, browse-url.
- (gnus-article-x-face-command): Include gnus-article-display-xface.
-
- * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks.
- Use defalias, not fset.
- (gnus-article-display-xface): New function.
-
- * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images.
-
- * mm-decode.el: Small doc fixes. Require cl when compiling.
- (mm-xemacs-p): Deleted.
- (mm-get-image-emacs, mm-get-image-xemacs): Deleted.
- (mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs,
- use create-image and don't special-case xbm.
- (mm-valid-image-format-p): Use display-graphic-p.
-
-2000-04-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially-limit): New variable.
- (message-send-mail-partially): New function.
- (message-send-mail): Use it.
- * mm-bodies.el (mm-decode-content-transfer-encoding): Remove
- all blank lines inside of base64.
- * mm-partial.el (mm-inline-partial): Add an option. Remove tail
- blank lines.
-
-2000-04-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-tag): Match more special characters.
-
-2000-04-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-bug): Avoid attaching the external buffer.
-
-2000-04-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-inline-media-tests): Add message/partial.
- (mm-inlined-types): Ditto.
- * mm-partial.el: New file.
-
-2000-04-27 Dave Love <fx@gnu.org>
-
- * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might
- matter in Emacs 21.
-
-2000-04-26 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-bodies.el (mm-encode-body): Remove reference to
- mm-default-charset in comment.
-
-2000-04-24 Bj,Av(Brn Torkelsson <torkel@hpc2n.umu.se>
-
- * rfc2047.el (rfc2047-encode-message-header): Fixing typo.
-
-2000-04-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of
- let.
-
-2000-04-26 Pavel Jan,Am(Bk <Pavel@Janik.cz>
-
- * gnus-draft.el (gnus-draft-setup): Fix comments.
-
-2000-04-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system,
- if nnmbox-file-coding-system-for-write is nil.
-
-2000-04-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-configure-posting-styles): Just remove the
- header if nil.
-
-2000-04-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Insert directly if decoded.
- * mml.el (autoload): Typo.
-
-2000-04-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Set up posting-charset.
- * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r.
-
-2000-04-25 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Fix yahoo mail.
-
-2000-04-25 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of
- word if not necessary.
- (rfc2047-encode-region): Put space between encoded words.
-
-2000-04-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-netrc-machine): Another default to nntp.
-
-2000-04-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-setup): Restore mml only when
- required.
- (gnus-draft-edit-message): Require restoration.
-
-2000-04-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored
- back.
-
-2000-04-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-article): Make sure that the summary
- buffer is live.
-
-2000-04-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcaps): Reorder.
- (mailcap-parse-mailcap): Backwards parsing.
- (mailcap-possible-viewers): Remove nreverse.
- (mailcap-mime-info): Ditto.
- (mailcap-add-mailcap-entry): Keep alternative viewer.
-
-2000-04-24 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
-
- * gnus.el: Gnus v5.8.5 is released.
-
-2000-04-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-header-encoding-alist): Doc fix.
-
- * gnus-util.el (gnus-netrc-machine): Default to nntp.
-
- * mml.el (mml-generate-mime-1): Force 8bit on message/rfc822.
-
-2000-04-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Disable prepare-hook.
-
-2000-04-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Fix copyright statements.
-
- * gnus-sum.el (gnus-alter-articles-to-read-function): New
- variable.
- (gnus-articles-to-read): Use it.
-
- * message.el (message-get-reply-headers): Bind free variable.
-
-2000-04-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-get-reply-headers): Fix to-address.
-
-2000-04-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Hotmail fix. Add a debug function.
-
-2000-04-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (t): M-down and M-up.
-
-2000-04-22 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el: Doc fix.
-
-2000-04-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-egroups-article): Remove < and >.
-
-2000-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-dejanews-create-mapping): Remove the context
- string.
- (nnweb-request-group): Don't scan twice.
- (nnweb-request-scan): Don't nix out the hashtb.
-
- * message.el (message-get-reply-headers): Return a value.
-
-2000-04-22 David Aspinwall <aspinwall@TimesTen.com>
-
- * gnus-art.el (gnus-button-url-regexp): New value to match naked
- urls.
-
-2000-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cache.el (gnus-summary-insert-cached-articles): Reverse the
- order messages are inserted.
-
- * mml.el (mml-generate-mime-1): rfc2047-encode the heads of
- message/rfc822 parts.
-
- * gnus-art.el (gnus-article-read-summary-keys): Check for
- numerical values.
-
- * message.el (message-get-headers): Made into own function.
- (message-reply): Use it.
- (message-get-reply-headers): Renamed.
- (message-widen-reply): New command.
-
-2000-04-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-data): Report the error and return nil.
-
-2000-04-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Don't remove
- non-base64 text at the end if not found.
-
-2000-03-01 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-read-move-group-name):
- (gnus-summary-move-article): Use `gnus-group-method' to find out
- what method the manually entered group belong to.
- `gnus-group-name-to-method' doesn't return any method parameters
- and `gnus-find-method-for-group' uses `gnus-group-name-to-method'
- for new groups so they wouldn't work.
-
-2000-04-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to
- override.
-
-2000-04-21 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-cache-insert): Does some stuff that is
- probably good to do, or something. I dunno. I just write these
- ChangeLog entries, and my name is Lars.
-
-1999-12-06 Hrvoje Niksic <hniksic@iskon.hr>
-
- * message.el (message-caesar-region): Use translate-region.
-
-2000-04-21 Mike Fabian <mike.fabian@gmx.de>
-
- * gnus-group.el (gnus-group-catchup-current): Doc fix.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-setup-buffer): Don't kill local
- variables, because that makes Emacs flash.
-
- * gnus-group.el (gnus-group-insert-group-line): Don't call
- gnus-group-add-icon unconditionally.
-
- * gnus-group.el (gnus-group-glyph-directory): Don't depend on
- xmas.
- (gnus-group-glyph-directory): Removed.
-
-2000-04-21 Jaap-Henk Hoepman <hoepman@cs.utwente.nl>
-
- * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't do stuff if
- gnus-newsgroup-name is "".
-
-2000-04-21 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-util.el (mm-mime-mule-charset-alist): Add support for UTF-8
- in conjunction with MULE-UCS.
-
-1999-12-13 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * rfc2047.el (rfc2047-fold-region): Don't use the same break twice.
-
-1999-12-21 Jan Vroonhof <vroonhof@math.ethz.ch>
-
- * message.el (message-shorten-references): Only cater to broken
- INN for news. This caters for broken smtpd.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-info): Use the first match; not the
- last.
-
- * gnus-agent.el (gnus-category-kill): Save the category list.
-
-2000-04-21 Chris Brierley <brierley@pobox.com>
-
- * gnus-sum.el (gnus-summary-move-article): Do something or other.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-add-icon): Fixed indentation.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-add-icon): Fixed indentation.
-
-2000-04-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-prepare-flat-predicate): New function.
- (gnus-group-list-cached): Use it.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Update all the copyright notices.
-
-2000-04-21 Vladimir Volovich <vvv@vvv.vsu.ru>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Remove
- non-base64 text at the end.
-
-2000-04-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el: Don't autoload cancel-function-timers.
-
- * message.el (message-fetch-field): Fold case.
-
-2000-04-21 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-forward-before-signature): New variable.
-
-2000-04-21 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
-
- * gnus-mlspl.el: Fix stuff.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-update-article-line): Don't hide
- subjects when unthreaded.
-
-2000-04-21 David S. Goldberg <dsg@mitre.org>
-
- * gnus-art.el (gnus-boring-article-headers): Work on long CCs as
- well.
-
-2000-04-21 Rui Zhu <sprache@iname.com>
-
- * gnus-art.el (gnus-article-mode): Fix variable name.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el: Fix autoload.
-
- * flow-fill.el (flow-fill): Fix provide.
-
- * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to
- nil.
-
-2000-04-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-configure-windows): Revert to switch-to-buffer.
-
-2000-04-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-netrc-machine): Didn't work.
-
-2000-04-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-setup): Restore to mml.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * flow-fill.el: Renamed from fill-flowed.
-
- * message.el (message-forward-ignored-headers): Default to
- removing CTE.
-
-2000-04-21 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-mode): Don't fill headers.
-
-2000-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-pipe-buffer-body): Use shell
-
-2000-02-21 Yoshiki Hayashi <yoshiki@xemacs.org>
-
- * nnvirtual.el (nnvirtual-request-article):
- Bind gnus-override-method to nil.
- (nnvirtual-request-update-mark): Don't update mark when
- article is not there.
-
-2000-04-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Check forwarded message.
-
-2000-04-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-parse-netrc): Allow "port".
- (gnus-netrc-machine): Take a port param.
- (gnus-netrc-machine):
-
- * gnus-art.el (gnus-request-article-this-buffer): Allow
- re-selecting referenced articles.
-
- * message.el (message-cancel-news): Allow editing.
- (message-cancel-message): Add newline.
-
-2000-04-20 William M. Perry <wmperry@aventail.com>
-
- * mm-view.el (mm-inline-image-emacs): New function.
-
-2000-04-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-delete-incoming): Change default in
- cvs.
-
-2000-04-20 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * gnus-art.el (gnus-mime-view-part-as-type-internal): New
- function.
-
-2000-04-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnml.el (nnml-request-expire-articles): Use it.
-
- * nnmail.el (nnmail-expiry-target): New variable.
- (nnmail-expiry-target-group): New function.
-
-2000-04-20 Emerick Rogul <emerick@cs.bu.edu>
-
- * message.el (message-forward): Add non-MIME separators.
-
-2000-04-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-generate-headers): Respect the syntax check
- spec.
-
- * gnus-sum.el (gnus-remove-thread-1): Show thread.
- (gnus-remove-thread): Don't show all threads.
-
-2000-04-20 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.4 is released.
-
-2000-04-19 Dave Love <fx@gnu.org>
-
- * mailcap.el (mailcap-parse-mimetypes): Add ...mime.types.
-
-2000-04-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-type-definition): New egroups html.
- (nnwarchive-egroups-*): Ditto.
- (nnwarchive-url): Unibyte buffer and single line cookie.
-
-2000-04-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-char-or-char-int-p): New alias.
- * nnweb.el (nnweb-decode-entities): Check the validity of numeric
- entities.
-
-1999-11-30 Daiki Ueno <ueno@unixuser.org>
-
- * lisp/imap.el (imap-body-lines): Check Content-Type: of the
- article case insensitively.
-
-2000-04-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-webmail): Use the default
- password provided in mail-sources; use webmail:subtype:user as
- the key.
-
-2000-04-10 John Wiegley <johnw@gnu.org>
-
- * mail-source.el (mail-source-fetch-webmail): Use
- mail-source-password-cache.
-
-2000-04-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Add netscape mail and fix HotMail mail.
-
-2000-04-08 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-kerberos4-open): Work with recent `imtest's.
-
-2000-04-02 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-request-article): Use BODY.PEEK[] instead of
- RFC822.PEEK if server support IMAP4rev1.
- (nnimap-request-body): Use BODY.PEEK[TEXT] instead of
- RFC822.TEXT.PEEK if server support IMAP4rev1.
- (nnimap-request-head): Use BODY.PEEK[HEADER] instead of
- RFC822.HEADER if server support IMAP4rev1.
- (nnimap-request-article-part): Support bodydetail in response
- data.
-
-2000-03-11 Simon Josefsson <jas@pdc.kth.se>
-
- * fill-flowed.el: New file.
-
- * mm-decode.el (mm-dissect-singlepart): Create a MIME handle for
- text/plain parts with `format' parameters.
-
- * mm-view.el (autoload): Autoload fill-flowed.
- (mm-inline-text): For "plain" parts with a format=flowed
- parameter, call `fill-flowed'.
-
-2000-03-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-list): Fudge new-style
- slashdot ids.
-
-2000-03-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-list): Use the new slashdot
- format.
-
-2000-03-16 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el: GSSAPI support, support kerberos 4 with Cyrus v1.6.x
- `imtest' too.
- (imap-kerberos4-program): Renamed from `imap-imtest-program'.
- (imap-gssapi-program): New variable.
- (imap-streams): Add gssapi.
- (imap-stream-alist): Ditto.
- (imap-authenticators): Ditto.
- (imap-authenticator-alist): Ditto.
- (imap-kerberos4-stream-p): Rename from `imap-kerberos4s-p'.
- (imap-kerberos4-open): Loop over imtest programs, support Cyrus
- 1.6.x `imtest' syntax.
- (imap-gssapi-stream-p): New function.
- (imap-gssapi-open): Ditto.
- (imap-gssapi-auth-p): Ditto.
- (imap-gssapi-auth): Ditto.
- (imap-kerberos4-auth-p): Renamed from `imap-kerberos4a-p'.
- (imap-send-command): Use buffer-local `imap-client-eol' value.
-
- * nnimap.el (nnimap-retrieve-headers-progress): Fold continuation
- lines and turn TAB into SPC before parsing.
-
-2000-03-15 Simon Josefsson <jas@pdc.kth.se>
-
- * nnheader.el (nnheader-group-pathname): Make sure to return a
- directory.
- * nnmail.el (nnmail-group-pathname): Ditto.
-
-2000-02-08 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-fix-eudora-headers): Fix `In-Reply-To' too, it
- might split in the middle of a message-id.
-
-2000-03-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the
- groups from the server.
-
- * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec.
- (gnus-summary-toggle-header): Update the wash status.
-
- * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)):
- Moved here.
-
- * gnus-agent.el (gnus-agent-save-group-info): Respect old
- setting.
-
- * nnmail.el (nnmail-get-active): Use it.
- (nnmail-parse-active): New function.
-
- * mm-view.el (mm-inline-text): Support the new version of
- vcard.el.
-
- * gnus-sum.el (gnus-summary-move-article): Only delete article
- when moving junk.
- (gnus-deaden-summary): Bury the buffer.
-
- * nnmail.el (nnmail-group-pathname): Ditto.
-
- * nnheader.el (nnheader-group-pathname): Use expand-file-name.
-
-2000-03-13 Christoph Rohland <hans-christoph.rohland@sap.com>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode no matter
- whether Mule.
-
-2000-03-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Protect against unloaded Gnus.
-
- * gnus-topic.el (gnus-topic-update-topic-line): Don't update the
- parent.
- (gnus-topic-update-topic-line): Yes, do.
- (gnus-topic-goto-missing-group): Tally the correct number of
- unread articles before inserting the topic line.
-
-2000-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Ignore errors.
-
-2000-02-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-dissect-buffer): Ditto.
-
- * gnus-art.el (article-decode-charset): Strip CTE.
-
- * ietf-drums.el (ietf-drums-strip): New function.
-
- * gnus-sum.el (gnus-summary-move-article): Don't use the prefix
- when prompting in read-only groups.
-
-2000-02-23 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-send-command): Change EOL-chars when
- `imap-client-eol' differs from default, not only for kerberos4.
- (imap-mailbox-status): Get encoded mailbox's status.
-
-2000-02-19 Simon Josefsson <jas@pdc.kth.se>
-
- * mail-source.el (mail-source-fetch-imap): Copy `imap-password'
- into `mail-source-password-cache'.
-
-2000-02-17 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-util.el (mm-mime-charset): Check for presence of
- `coding-system-get' and `get-charset-property' (recent XEmacs has
- the former, but not the latter).
-
-2000-01-28 Dave Love <fx@gnu.org>
-
- * message.el (message-check-news-header-syntax): Fix typo
- `newsgroyps'.
- (message-talkative-question): Put temp buffer in fundamental-mode.
- (message-recover): Use fundamental-mode in the right buffer.
-
- * nnmail.el (nnmail-split-history): Use fundamental-mode in the
- right buffer.
-
-2000-01-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-decode-region): Add charset parameter.
- (quoted-printable-decode-string): Ditto.
-
- * gnus-art.el (article-de-quoted-unreadable): Use it.
-
-2000-01-21 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-split-predicate): New variable.
- (nnimap-split-articles): Use it.
-
-2000-01-20 Simon Josefsson <jas@pdc.kth.se>
-
- * utf7.el: Change email address.
-
-2000-01-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-catchup): Purge split history.
-
-2000-01-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-generate-active): Support extended group name.
- (nnmail-get-active): Ditto.
-
-2000-01-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-write-active): Since no prefix in
- group names, don't remove anything.
-
-2000-01-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-my-deja-open): My-deja changes.
-
-2000-01-13 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-retrieve-headers-progress): Create xref field.
-
-2000-01-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Translate full path.
-
-2000-01-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-other-frame): Fix typo.
-
-1999-06-25 Andreas Jaeger <aj@arthur.rhein-neckar.de>
-
- * gnus-cus.el (gnus-group-customize): Fix typo.
-
-2000-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-insert): Simplified.
-
-2000-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode-map): "e" is
- gnus-summary-edit-article.
-
-2000-01-06 Jari Aalto <jari.aalto@poboxes.com>
-
- * mailcap.el (mailcap-mime-extensions): Add .diff.
-
-2000-01-06 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * mm-decode.el (mm-mailcap-command): handle "%%" and the case
- where there is no "%s" in the method.
-
-2000-01-08 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * gnus-sum.el (gnus-summary-select-article): Return 'old.
-
-2000-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer.
-
- * gnus.el: Really always pop up a new frame.
-
- * parse-time.el (parse-time-rules): Allow 100-110 to be
- 2000-2010.
-
- * time-date.el (date-to-time): Don't use timezone.
-
-2000-01-06 Dave Love <fx@gnu.org>
-
- * time-date.el: Add keywords.
- (date-to-time): Add autoload cookie. Canonicalize with
- timezone-make-date-arpa-standard.
- (time-to-seconds): Avoid caddr.
- (safe-date-to-time): Add autoload cookie.
-
-2000-01-05 BrYan P. Johnson <beej@mindspring.net>
-
- * gnus-group.el (gnus-group-line-format-alist): Added %E for
- eyecandy.
- (gnus-group-insert-group-line): Now groks %E and inserts icon in
- group line using gnus-group-add-icon.
- (gnus-group-icons): Added customize group.
- (gnus-group-icon-list): Added variable.
- (gnus-group-glyph-directory): Added variable.
- (gnus-group-icon-cache): Added variable.
- (gnus-group-running-xemacs): Added variable.
- (gnus-group-add-icon): Added function. Add an icon to the current
- line according to gnus-group-icon-list.
- (gnus-group-icon-create-glyph): Added function.
-
-2000-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-select-article): Return whether we
- selected something new.
- (gnus-summary-search-article): Start searching at the window
- point.
-
- * gnus-group.el (gnus-fetch-group): Complete over
- gnus-active-hashtb.
-
-2000-01-05 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.3 is released.
-
-2000-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-preserve-marks): New variable.
- (gnus-summary-move-article): Use it.
- (gnus-group-charset-alist): Added more entries.
-
-2000-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-override-types): Removed duplicate.
-
- * gnus-uu.el (gnus-uu-mark-over): Use gnus-summary-default-score
- as the default score.
-
- * gnus-score.el (gnus-score-delta-default): Changed name.
-
-2000-01-04 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-parse-literal):
- (imap-parse-flag-list): Don't care about props.
- (imap-parse-string): Handle quoted characters.
-
-2000-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-goto-unread): Doc fix.
- (gnus-summary-mark-article): Doc fix.
- (gnus-summary-mark-forward): Doc fix.
- (t): Changed keystroke for gnus-summary-customize-parameters.
-
- * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for
- "e".
- (gnus-article-mode-map): No, don't.
-
- * gnus-sum.el (gnus-summary-next-subject): Don't show the thread
- of the final article.
-
- * mm-decode.el (mm-interactively-view-part): Error on no method.
-
-2000-01-02 Stefan Monnier <monnier+gnu/emacs@tequila.cs.yale.edu>
-
- * gnus-score.el (gnus-score-insert-help): Something.
-
- * gnus-art.el (gnus-button-alist): Exclude < from <URL:
-
- * gnus-win.el (gnus-configure-frame): Ditto.
-
- * gnus-mh.el (gnus-summary-save-in-folder): Use
- with-current-buffer.
-
-2000-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnwarchive.el: Changed file perms.
-
-1999-12-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-delete-groups): New command.
- (gnus-group-delete-group): Extra no-prompt parameters.
-
-1999-12-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-article): Translate <br> into
- <p>.
-
-1999-12-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-article): Don't insert message id.
-
-1999-12-28 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnimap.el (nnimap-split-fancy): New variable.
- (nnimap-split-fancy): New function.
-
-1999-12-28 Simon Josefsson <jas@pdc.kth.se>
-
- (nnimap-split-rule): Document symbol value.
-
-1999-12-28 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-retrieve-headers-progress): Let
- `nnheader-parse-head' parse article.
- (nnimap-retrieve-headers-from-server): Don't request ENVELOPE,
- request headers needed by `nnheader-parse-head'.
-
-1999-12-23 Florian Weimer <fw@s.netic.de>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Correct default
- value (crosspostings are handled), improve documentation.
-
- * nnultimate.el: Declare file coding system as iso-8859-1.
-
- * message.el: Dito.
-
- * gnus-cite.el: Dito.
-
- * gnus-spec.el: Dito.
-
-1999-12-21 Florian Weimer <fw@s.netic.de>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): New layout.
- (gnus-setup-message): No longer make `message-posting-charset'
- buffer-local.
- (gnus-setup-posting-charset): Reflect the new layout of
- `gnus-group-posting-charset-alist' and `message-posting-charset'.
-
- * message.el (message-send-mail): Bind `message-this-is-mail' and
- `message-posting-charset'.
- (message-send-news): Dito, and honour new layout of
- `message-posting-charset'.
- (message-encode-message-body): Ignore `message-posting-charset'.
-
- * mm-bodies.el (mm-body-encoding): Consider
- `message-posting-charset' when deciding whether to use 8bit.
-
- * rfc2047.el (rfc2047-encode-message-header): Back out change.
- (rfc2047-encodable-p): Now solely for headers; use
- `message-posting-charset'.
-
-1999-12-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-type-definition): Set default value.
-
-1999-12-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el (nnagent-server-opened): Optional.
- (nnagent-status-message): Optional.
-
-1999-12-19 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and
- end (referenced by instructions in
- `gnus-cited-opened-text-button-line-format-alist').
-
-1999-12-18 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-starttls-open): Typo.
-
-1999-12-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-after): Non-MULE case.
- * mail-prsvr.el (mail-parse-mule-charset): New variable.
- * rfc2047.el (rfc2047-dissect-region): Bind it.
-
-1999-12-18 Florian Weimer <fw@s.netic.de>
-
- * mml.el (mml-generate-multipart-alist): Correct default value.
-
- * mm-encode.el (mm-use-ultra-safe-encoding): New variable.
- (mm-safer-encoding): New function.
- (mm-content-transfer-encoding): Use both.
-
- * mm-bodies.el (mm-body-encoding): Use mm-use-ultra-safe-encoding.
- * qp.el (quoted-printable-encode-region): Dito.
-
-1999-12-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-article): Snarf the raw file.
-
-1999-12-18 Victor S. Miller <victor@idaccr.org>
-
- * webmail.el (webmail-hotmail-list): raw=0.
-
-1999-12-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-enter-history): Back-compatible in
- group name.
-
-1999-12-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-expire): Convert to symbol if stringp.
-
-1999-12-18 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el: Don't autoload digest-md5.
- (imap-starttls-open): Bind coding-system-for-{read,write}.
- (imap-starttls-p): Check if we can find starttls.el.
- (imap-digest-md5-p): Check if we can find digest-md5.el.
-
-1999-11-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * imap.el: Require `digest-md5' when compiling; add autoload
- settings for `digest-md5-parse-digest-challenge',
- `digest-md5-digest-response', `starttls-open-stream' and
- `starttls-negotiate'.
- (imap-authenticators): Add `digest-md5'.
- (imap-authenticator-alist): Setup for `digest-md5'.
- (imap-digest-md5-p): New function.
- (imap-digest-md5-auth): New function.
- (imap-stream-alist): Add STARTTLS entry.
- (imap-starttls-p): New function.
- (imap-starttls-open): New function.
-
-1999-12-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-enter-history): Bad group name.
-
-1999-12-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-dissect-region): Use mapcar instead of
- string-to-x function.
-
-1999-12-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-fold-region): Fold a line more than once.
-
-1999-12-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Enhance hotmail-snarf.
-
-1999-12-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-dissect-region): Rewrite.
-
-1999-12-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-list): Search no-error.
-
-1999-12-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: Support nov-is-evil.
- * gnus-bcklg.el (gnus-backlog-request-article): Buffer is optional.
- Set it if non-nil.
- * gnus-agent.el (gnus-agent-fetch-articles): Use it.
-
-1999-12-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el (nnagent-server-opened): Redefine.
- (nnagent-status-message): Ditto.
-
-1999-12-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc1843.el (rfc1843-decode-region): Use
- buffer-substring-no-properties.
- * gnus-art.el (article-decode-HZ): New function.
-
-1999-12-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-translate-file-chars): Only in full path.
-
-1999-12-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): mail-parse-charset is a
- MIME charset not a MULE charset.
-
-1999-12-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el: Translate more ugly characters.
- * nnheader.el (nnheader-translate-file-chars): Don't translate
- the second ':'.
-
-1999-12-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer): Use all refer
- method if cannot find the article.
-
-1999-12-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer): Don't use refer
- method if overrided.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-webmail): Parameter
- dontexpunge.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Support my-deja. Better error report.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-date-to-date): Error proof when input
- is bad.
- * gnus-sum.el (gnus-list-of-unread-articles): When (car read)
- is not 1.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-request-article): A space.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el: Support different backend with same name.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Support
- archived group.
- (nnslashdot-sane-retrieve-headers): Ditto.
- (nnslashdot-request-article): Ditto.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-insert): Narrow to point.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-insert): Follow refresh url.
- * nnslashdot.el: Use it.
-
-1999-12-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-decode-entities): Decode numerical entities.
- (nnweb-decode-entities-string): New function.
-
- * nnwarchive.el (nnwarchive-decode-entities-string): Rename to
- nnweb-* and move to nnweb.el.
- * nnwarchive.el: Use nnweb-decode-entities, etc.
- * webmail.el: Ditto.
-
- * nnslashdot.el: Use nnweb-decode-entities-string.
- (nnslashdot-decode-entities): Remove.
-
-1999-12-13 Eric Marsden <emarsden@mail.dotcom.fr>
-
- * nnslashdot.el: Decode entities.
-
-1999-12-12 Dave Love <fx@gnu.org>
-
- * gnus-agent.el (gnus-category-edit-groups)
- (gnus-category-edit-score, gnus-category-edit-predicate): Replace
- expansion of setf, fixed.
-
-1999-12-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el: Revoke last Dave Love's patch, because of
- incompatibility of XEmacs.
-
-1999-12-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el: Change headers.
- * rfc1843.el: Ditto.
- * uudecode.el: Ditto.
-
-1999-12-07 Dave Love <fx@gnu.org>
-
- * gnus-agent.el (gnus-category-edit-predicate)
- (gnus-category-edit-score, gnus-category-edit-score): Expand setf
- inside backquote to avoid it at runtime.
-
-1999-12-07 Dave Love <fx@gnu.org>
-
- * binhex.el: Require cl when compiling.
-
-1999-12-04 Dave Love <fx@gnu.org>
-
- * gnus-cus.el (gnus-group-parameters): Allow nil for banner.
-
-1999-12-04 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-delete-duplicates): New function.
- (mm-write-region): Use it.
-
- * mml.el (mml-minibuffer-read-type): Use mm-delete-duplicates.
-
- * mailcap.el (mailcap-mime-types): Require mm-util. Use
- mm-delete-duplicates.
-
- * imap.el (imap-open, imap-debug): Avoid mapc.
-
- * nnvirtual.el (nnvirtual-create-mapping): Likewise.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Avoid copy-list.
- (gnus-multi-decode-encoded-word-string): Avoid mapc.
-
- * gnus-start.el (gnus-site-init-file): Avoid ignore-errors at
- runtime.
-
- * gnus.el (gnus-select-method): Likewise.
-
- * nnheader.el (nnheader-nov-read-integer): Likewise.
-
- * mm-view.el (mm-inline-message): Require cl when compiling.
- Avoid ignore-errors at runtime.
- (mm-inline-text): Avoid mapc.
-
-1999-12-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Widen is bad.
-
-1999-12-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-after): `charset-after' may not be defined.
-
-1999-12-12 Florian Weimer <fw@s.netic.de>
-
- * rfc2047.el (rfc2047-encodable-p): New parameter header used to
- indicate that only US-ASCII is permitted.
- (rfc2047-encode-message-header): Use it. Now, Gnus should never
- use unencoded 8-bit characters in message headers.
-
-1999-12-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * ietf-drums.el (ietf-drums-narrow-to-header): Make it work with
- CRLF.
-
-1999-12-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Require url-cookie.
-
-1999-12-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-make-caesar-translation-table): A
- new function to make modified caesar table.
- (nnwarchive-from-r13): Use it.
- (nnwarchive-mail-archive-article): Improved.
-
-1999-12-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-url): Use mm-with-unibyte-current-buffer.
-
-1999-12-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-request-article): Return cons.
-
-1999-12-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-setup-default-charset): Typo.
-
-1999-12-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte): New macro.
- * nnweb.el (nnweb-init): Use it.
-
-1999-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-after): New function.
- (mm-find-mime-charset-region): Set charsets after
- delete-duplicates and use find-coding-systems-region.
- (mm-find-charset-region): Remove composition.
-
- * mm-bodies.el (mm-encode-body): Use mm-charset-after.
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto.
-
-1999-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-mime-charset-region): Revoke last change.
- * mml.el (mml-confirmation-set): New variable.
- (mml-parse-1): Ask user to confirm.
-
-1999-12-09 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Make sure all methods
- are scanned when we have directory mail-sources (the mail source
- is modified in that case, so we must scan it for all
- groups/methods).
-
-1999-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnml.el (nnml-request-move-article): Save nnml-current-directory
- and nnml-article-file-alist.
-
-1999-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-get-new-news-this-group): Binding
- nnmail-fetched-sources.
-
-1999-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): Use the last charset.
-
-1999-12-08 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-select-method): Made the option list prettier.
-
-1999-12-08 Florian Weimer <fw@s.netic.de>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1
- for the `de' newsgroups hierarchy, as it is common practice there.
-
-1999-12-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-mail-archive-article): Fix
- buffer-string arguments. Fix references.
-
-1999-12-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-confirmation-function): New variable.
- (gnus-agent-batch-fetch): Use it.
- (gnus-agent-fetch-session): Use it.
-
-1999-12-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-mime-charset-region): Delete nil.
-
-1999-12-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): Don't capitalize. Delete
- nil.
-
-1999-12-07 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnslashdot.el (nnslashdot-request-list): There were two
- top-level body-forms. Put a `progn' around them.
-
- * gnus.el (gnus-select-method): Use `condition-case'
- instead of `ignore-errors', since cl may not be loaded when the
- form is evaluated.
-
-1999-12-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: Support www.mail-archive.com.
-
-1999-12-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-get-new-mail): Remove fetched sources before
- do anything.
-
-1999-12-06 Simon Josefsson <jas@pdc.kth.se>
-
- * utf7.el: New file, written by Jon K Hellan.
-
- * imap.el (imap-use-utf7): Renamed from `imap-utf7-p', change
- default to t.
-
-1999-12-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-delete-group): New function.
-
- * gnus-sum.el (gnus-summary-refer-article): Work for lists with
- current.
- (gnus-refer-article-methods): New function.
- (gnus-summary-refer-article): Use it.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-retrieve-groups): Return active format.
-
- * nnimap.el (nnimap-replace-in-string): Removed.
- (nnimap-request-list):
- (nnimap-retrieve-groups):
- (nnimap-request-newgroups): Quote group instead of escaping SPC.
-
-1999-12-05 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el: Use format-spec for ssl program.
- * imap.el (imap-ssl-arguments): Removed.
- (imap-ssl-open-{1,2}): Removed.
-
-1999-12-04 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-start.el (gnus-site-init-file): Use `condition-case'
- instead of `ignore-errors', since cl may not be loaded when the
- form is evaluated.
-
-1999-12-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-8bit-char-regexps): Removed.
- (mm-7bit-chars): New variable.
- (mm-body-7-or-8): Use it in both cases.
-
-1999-12-04 Michael Welsh Duggan <md5i@cs.cmu.edu>
-
- * gnus-start.el (gnus-site-init-file): Don't use cl macros in
- defcustom definitions.
-
-1999-12-04 Simon Josefsson <jas@pdc.kth.se>
-
- * mm-decode.el (mm-display-part): Let mm-display-external return
- inline or external.
- (mm-display-external): For copiousoutput methods, insert output in
- buffer.
-
-1999-12-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-headers-with-xover): Goto the end of
- buffer.
-
-1999-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-audio.el: An M too far.
-
- * gnus-msg.el (gnus-setup-message): One backtick too many.
-
- * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is
- a function, not a variable.
-
-1999-12-04 Max Froumentin <masmef@maths.bath.ac.uk>
-
- * gnus-score.el (gnus-score-body): Widen before requesting.
-
-1999-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-prepare-flat): Comment fix.
-
-1999-12-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-webmail): Bind
- mail-source-string.
-
-1999-12-04 Matt Swift <swift@alum.mit.edu>
-
- * gnus-uu.el (gnus-uu-mark-by-regexp): Doc fix.
- (gnus-uu-unmark-by-regexp): Ditto.
-
- * gnus-group.el (gnus-group-catchup-current): Would bug out on
- dead groups.
-
-1999-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-setup-message): Allow the charset setting to
- do their real thing.
-
- * nnmh.el (nnmh-be-safe): Doc fix.
-
- * gnus-sum.el (gnus-summary-exit): Write cache active file.
-
- * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire
- status line has arrived before we count it.
-
- * mailcap.el (mailcap-mime-data): Removed save-file from audio/*.
-
- * gnus-sum.el (gnus-thread-header): Fixed after indent.
- Whitespace problems.
-
- * gnus-win.el (gnus-configure-windows): Error fix.
-
- * gnus-demon.el (gnus-demon-add-nntp-close-connection): Add the
- right function.
-
- * gnus.el: Fixed all the doc strings to match the FSF convetions.
- Indent all functions. Fix all comments to match the comment
- conventions. Double-space after full stop.
-
-1999-12-04 YAMAMOTO Kouji <kouji@pobox.com>
-
- * nnmail.el (nnmail-split-it): I redefined nnmail-split-fancy's
- value to divide received mails into my favorite groups and I met
- an error. It takes place if the length of a element "VALUE" in
- nnmail-split-fancy is less than two.
-
-1999-10-10 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * mml.el (mml-insert-part): New function.
-
-1999-12-02 Dave Love <fx@gnu.org>
-
- * mm-decode.el: Customize.
-
-1999-12-03 Dave Love <fx@gnu.org>
-
- * nnslashdot.el, nnultimate.el: Don't lose at compile time when
- the W3 stuff isn't available.
-
-1999-12-03 Dave Love <fx@gnu.org>
-
- * imap.el, mailcap.el, nnvirtual.el, rfc2104.el: Don't require cl
- at runtime.
-
-1999-12-04 Dan Christensen <jdc@jhu.edu>
-
- * gnus-score.el (gnus-score-headers): Fix orphan scoring.
-
-1999-12-01 Andrew Innes <andrewi@gnu.org>
-
- * nnmbox.el (nnmbox-read-mbox): Count messages correctly, and
- don't be fooled by "From nobody" lines added by respooling.
-
- * pop3.el (pop3-movemail): Write crashbox in binary.
- (pop3-get-message-count): New function.
-
- * mail-source.el (mail-source-primary-source): New variable.
- (mail-source-report-new-mail-interval): New variable.
- (mail-source-idle-time-delay): New variable.
- (mail-source-new-mail-available): New internal variable.
- (mail-source-fetch-pop): Clear new mail flag, when mail from
- primary source has been fetched.
- (mail-source-check-pop): New function.
- (mail-source-new-mail-p): New function.
- (mail-source-start-idle-timer): New function.
- (mail-source-report-new-mail): New function.
- (mail-source-report-new-mail): New internal variable.
- (mail-source-report-new-mail-timer): New internal variable.
- (mail-source-report-new-mail-idle-timer): New internal variables.
-
-1999-12-04 Andreas Schwab <schwab@suse.de>
-
- * gnus-cus.el (gnus-group-customize): Customize fix.
-
-1999-12-04 Andrea Arcangeli <andrea@suse.de>
-
- * message.el (message-send-mail-with-sendmail): Use
- message-make-address.
-
-1999-12-03 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.2 is released.
-
-1999-12-03 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.1 is released.
-
-1999-11-11 Hrvoje Niksic <hniksic@iskon.hr>
-
- * mml.el (mml-insert-tag): Don't close the tag.
- (mml-insert-empty-tag): New function.
- (mml-attach-file): Use mml-insert-empty-tag instead of
- mml-insert-tag.
- (mml-attach-buffer): Ditto.
- (mml-attach-external): Ditto.
- (mml-insert-multipart): Ditto.
-
-1999-12-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-article): Return -1 if not find
- the article number.
-
-1999-12-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-find-method-for-group): The method of a new group
- is not the native one.
-
-1999-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-embedded-url): Always call browse-url.
-
-1999-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Use
- mm-with-unibyte-current-buffer.
- (nnultimate-request-article): Ditto.
-
-1999-12-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-groups): Set to process buffer.
-
-1999-12-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-current-buffer): New macro.
- * nnweb.el (nnweb-retrieve-headers): Use it.
- (nnweb-request-article): Use it.
-
- * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in
- case matching failed.
-
-1999-12-02 John Wiegley <jwiegley@inprise.com>
-
- * mail-source.el (mail-source-keyword-map): Add backslash to
- Delete-flag.
-
-1999-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-group-charset-alist): Default nnweb groups to
- Latin-1.
- (gnus-group-charset-alist): No, don't.
-
- * nnweb.el (nnweb-init): Make the buffer unibyte.
-
-1999-12-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-set-common-1): Fix to get the
- default value.
-
-1999-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-read-groups): Unibyte.
-
- * nnultimate.el (nnultimate-request-list): Use unibyte.
-
- * gnus-uu.el (gnus-uu-grab-articles): Bind
- gnus-display-mime-function to nil.
-
- * message.el (message-send-mail-with-sendmail): Use the
- user-mail-address variable.
-
- * gnus-art.el (gnus-ignored-headers): More headers.
-
- * message.el (message-shorten-1): Use list.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-configure-posting-styles): Ignore nil
- signatures.
-
- * nnweb.el (nnweb-dejanews-create-mapping): Get the data.
- (nnweb-dejanews-create-mapping): Do the properish date.
-
-1999-12-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-common-keyword-map): New variable.
- (mail-source-bind-common): New macro.
- (mail-source-fetch): Support plugged mail source.
- * gnus-int.el (gnus-request-scan): Use them.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-message): Check whether charset is a
- string.
-
- * nnslashdot.el (nnslashdot-request-post): Insert <p>'s.
-
- * message.el (message-mode-map): Changed keystroke for
- message-yank-buffer.
-
-1999-11-26 Hrvoje Niksic <hniksic@iskon.hr>
-
- * message.el (message-shorten-references): Cut references to 31
- elements, then either fold them or shorten them to 988 characters.
- (message-shorten-1): New function.
- (message-cater-to-broken-inn): New variable.
-
-1999-12-01 Eric Marsden <emarsden@mail.dotcom.fr>
-
- * nnslashdot.el (nnslashdot-lose): New function.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-message): Not the right type of charset is
- being fetched here. Let the group charset rule.
- (mm-inline-message): Ignore us-ascii.
-
-1999-11-24 Carsten Leonhardt <leo@arioch.oche.de>
-
- * mail-source.el (mail-source-fetch-maildir): work around the
- ommitted "file-regular-p" in efs/ange-ftp
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Don't insert extra empty line.
- (mml-generate-mime-1): Use the encoding param.
-
- * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Require
- gnus-art before binding its variables.
-
- * gnus-art.el (gnus-article-prepare-display): Run the prepare
- after the MIME.
-
-1999-12-01 Rupa Schomaker <rupa-list@rupa.com>
-
- * message.el (message-clone-locals): Use it.
-
- * gnus-msg.el (gnus-configure-posting-styles): Make
- user-mail-address local.
-
-1999-11-20 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Scan each method only
- once.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-generate-new-buffer-clone-locals): Use varstr.
- (message-clone-locals): Ditto.
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Have the digest
- group inherit reply-to or from.
-
-1999-12-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Support numbered ARG
- for charset.
- (gnus-summary-show-article-charset-alist): New variable.
-
- * mm-bodies.el (mm-decode-string): Support gnus-all and
- gnus-unknown.
- (mm-decode-body): Ditto.
- * rfc2047.el (rfc2047-decode): Ditto.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-delete-incoming): Change default to
- t.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.99 is released.
-
-1999-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-refer-article): Wrong interactive
- spec.
-
- * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'.
- (gnus-configure-posting-styles): No, don't.
- (gnus-configure-posting-styles): Allow overriding files.
-
- * gnus-art.el (gnus-header-button-alist): Use browse-url
- directly.
-
- * mm-decode.el (mm-inline-media-tests): Check feature vcard.
-
- * gnus-msg.el (gnus-summary-yank-message): New command and
- keystroke.
-
- * message.el (message-yank-buffer): New command.
- (message-buffers): New function.
-
- * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select
- next group in a more normal fasion.
-
- * mml.el (mml-boundary-function): New variable.
- (mml-compute-boundary): Use it.
-
- * nnmh.el (nnmh-active-number): Skip past files that have buffers
- that exist for them.
-
- * gnus-async.el (gnus-async-prefetch-next): Cancel timers.
- (gnus-async-timer): New variable.
-
-1999-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-request-list): Be more lenient with
- root addresses.
-
-1999-11-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Do
- gnus-treat-capitalize-sentences.
-
-1999-11-30 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-article): Hotmail changes the
- format.
-
-1999-11-29 Simon Josefsson <jas@pdc.kth.se>
-
- * mm-decode.el (mm-display-external): For `copiousoutput' methods,
- switch to buffer after calling program.
- (mm-display-external): Use `shell-command-switch' instead of "-c".
-
-1999-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-possibly-change-server): Don't always
- read groups file.
-
- * nnslashdot.el (nnslashdot-request-article): Convert <br><br> to
- <p>.
-
-1999-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode): Doc fix.
-
-1999-11-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-emphasize): Check group variable.
- * rfc1843.el (rfc1843-decode-article-body): Ditto.
-
-1999-11-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any
- type.
-
-1999-11-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Support www.netaddress.com, i.e. usa.net.
-
-1999-11-23 Hrvoje Niksic <hniksic@iskon.hr>
-
- * mml.el (mml-quote-region): Insert ! after the hash.
-
-1999-11-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-warchive-address-history): Change to
- nil.
-
-1999-11-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Support mail.yahoo.com.
-
- * mail-source.el (mail-source-fetch-webmail): Add password check.
- (mail-source-keyword-map): Use `subtype'.
-
-1999-11-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-keyword-map): Add webmail.
- (mail-source-fetcher-alist): Ditto.
- (mail-source-fetch-webmail): New function.
- * webmail.el: New file.
-
-1999-11-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil.
-
-1999-11-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon.
-
-1999-11-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-request-list): Add fetch-time slot.
- (nnultimate-prune-days): New function.
- (nnultimate-create-mapping): Use it.
- (nnultimate-request-group): Only fetch the groups list if it has
- not been done before.
- (nnultimate-retrieve-headers): Don't write groups.
- (nnultimate-create-mapping): Off-by-one error.
-
-1999-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match
- threaded subjects.
-
-1999-11-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: Lots of changes make agent happy.
-
-1999-11-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-get-unread-articles): Assert group is in
- hashtb.
-
-1999-11-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Write region with binary
- mode.
-
-1999-11-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'.
-
-1999-11-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'.
- (mm-uu-test): Now it is in restricted region.
-
- * gnus-art.el (article-decode-charset): Don't mm-uu-test.
-
- * mm-view.el (mm-view-message): Fix buffer leak.
- (mm-inline-message): Support 'gnus-decoded.
-
- * mm-bodies.el (mm-decode-body): Ditto.
-
- * rfc2047.el (rfc2047-decode-region): Ditto.
-
-1999-11-18 Matthias Andree <ma@dt.e-technik.uni-dortmund.de>
-
- * imap.el (require): Added autoload for base64-encode-string.
-
-1999-11-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-refer-article-method): Made list value
- customizable.
-
-1999-11-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-recenter): set-window-start with
- NOFORCE in Emacs case.
-
-1999-11-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer): Set
- gnus-newsgroup-name.
-
-1999-11-17 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Check server before
- scanning.
-
-1999-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-valid-select-methods): nnslashdot is news.
-
- * nnslashdot.el (nnslashdot-login-name): New variable.
- (nnslashdot-password): Ditto.
- (nnslashdot-request-post): New function.
-
- * gnus-art.el (gnus-treat-buttonize): More testing.
-
- * mm-encode.el: Another CVS test.
-
- * gnus-art.el (gnus-treat-emphasize): Change default.
- (gnus-treat-buttonize): Ditto.
- (gnus-treat-buttonize): This is a test.
-
- * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset.
- (gnus-build-sparse-threads): Ditto.
- (gnus-build-all-threads): Ditto.
-
- * nnheader.el (make-full-mail-header): Make into a subst.
-
- * gnus.el (gnus-refer-article-method): Doc fix.
-
- * gnus-sum.el: Do not accept a prefix.
- (gnus-summary-refer-article): Accept a list of select methods.
-
-1999-11-11 Matt Pharr <mmp@graphics.stanford.edu>
-
- * message.el (message-forward): Pay attention to prefix argument
- again and forward all headers when it is set, regardless of the
- value of message-forward-ignored-headers.
-
-1999-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-ems.el: Check for cygwin32.
-
-1999-11-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Use 'non-viewer.
-
-1999-11-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before
- nntp-inhibit-erase.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Use
- nnfoo-retrieve-groups to find new news, if available.
- (gnus-read-active-file-2): New function.
- (gnus-get-unread-articles): Use it.
- (gnus-read-active-file-1): Ditto.
-
-1999-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-find-mime-charset-region): Make sure
- find-coding-systems-for-charsets is fbound.
-
- * gnus-ems.el: Typo fix.
-
-1999-11-13 Florian Weimer <fw@s.netic.de>
-
- * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if
- it's available and makes sense.
-
-1999-11-12 Fabrice POPINEAU <Fabrice.Popineau@supelec.fr>
-
- * gnus-score.el (gnus-score-save): Translate score file.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * mail-source.el (mail-source-keyword-map): For IMAP mail source,
- added fetchflag and dontexpunge keywords.
- (mail-source-fetch-imap): Use them.
-
-1999-11-12 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed,
- gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to
- `defconst'.
-
- * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to
- `defconst'.
- Mention that it is both for group and topic parameters.
- (gnus-extra-topic-parameters): New constant, including `subscribe'
- parameter.
- (gnus-extra-group-parameters): New constant.
- (gnus-group-customize): Use them.
-
- * gnus.el (gnus-select-method): Added default value and tag.
- (gnus-refer-article-method): Added `DejaNews' customization option.
-
-1999-11-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-int.el (gnus-server-opened): Ignore denied servers.
-
- * gnus-ems.el (gnus-mule-max-width-function): New backquote
- syntax.
-
- * nndoc.el (nndoc-mime-digest-type-p): Reinstated.
-
- * nnslashdot.el (nnslashdot-group-number): Changed default.
-
- * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja.
- (nnweb-dejanews-wash-article): Removed.
- (nnweb-type-definition): Fetch by id.
-
- * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless
- we mean it.
-
- * nnslashdot.el (nnslashdot-group-number): Doc fix.
- (nnslashdot-request-list): Use Ultramode as well.
- (nnslashdot-date-to-date): Be more lenient.
- (nnslashdot-threaded): New function.
-
-1999-11-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-internalize-part): Doc fix.
-
-1999-11-11 Steinar Bang <sb@metis.no>
-
- * nnweb.el (nnweb-type-definition): /=dnc
-
-1999-11-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Work with american
- dates.
- (nnultimate-retrieve-headers): Wrong ordering.
-
-1999-11-11 Matt Pharr <mmp@graphics.stanford.edu>
-
- * message.el (message-forward-as-mime): New variable.
-
-1999-11-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-dd-mmm): Beware buggy dates.
-
-1999-11-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-movemail-and-remove): New function.
- (mail-source-keyword-map): Add `function' for `maildir'.
- (mail-source-fetch-maildir): Use it.
-
-1999-11-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: New file.
- * gnus-group.el (gnus-group-make-warchive-group): New function.
- * gnus.el (gnus-valid-select-methods): Add `nnwarchive'.
-
-1999-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page
- subjects.
-
-1999-11-10 Rajappa Iyer <rajappa@mindspring.com>
-
- * gnus-salt.el (gnus-pick-article-or-thread): Don't move point.
-
-1999-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-open-server): Do address.
- (nnultimate-forum-table-p): New function.
-
- * nnweb.el (nnweb-insert-html): Renamed.
- (nnweb-insert): New function.
-
- * nnultimate.el (nnultimate-insert-html): New function.
-
- * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything
- if nov is evil.
- (nnslashdot-retrieve-headers): use the sane version instead.
-
-1999-11-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-article): Fold case.
-
- * nnultimate.el: New file.
-
- * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article
- unless wanted.
-
- * gnus-start.el (gnus-active-to-gnus-format): Catch errors.
- (gnus-read-active-file-1): Separated into own function.
- (gnus-read-active-file): Catch quits.
-
- * nnslashdot.el (nnslashdot-request-article): Search better on
- first article.
- (nnslashdot-request-list): Fold case.
- (nnslashdot-retrieve-headers): Ditto.
-
-1999-11-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Autoload gnus-subscribe-topics.
-
-1999-11-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-save-group-info): Remove backslash
- before dot.
- * gnus-util.el (gnus-write-active-file): Ditto.
-
-1999-11-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-replace-duplicate-chars-in-string): New
- function.
- * gnus-cache.el (gnus-cache-file-name): Use it.
- * gnus-agent.el (gnus-agent-group-path): Use it.
- * nnmail.el (nnmail-group-pathname): Use it.
-
-1999-11-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-active-to-gnus-format): Don't insert backslash
- if cooked.
- * gnus-util.el (gnus-write-active-file): Write cooked active file.
- * gnus-agent.el (gnus-agent-save-group-info): Ditto.
- * gnus.el (gnus-short-group-name): "..." proof.
-
-1999-11-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to
- support nnslashdot.
-
-1999-11-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too
- many articles.
- (nnslashdot-generate-active): New function.
- (nnslashdot-request-newgroups): Use it.
-
- * gnus-start.el (gnus-active-to-gnus-format): Intern strings group
- names.
-
- * nnslashdot.el (nnslashdot-request-newgroups): New function.
- (nnslashdot-request-list): Not moderated.
-
-1999-11-07 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-open-server): Remove error signal if
- nnimap-server-buffer is nil (the check should've been `boundp').
-
- * imap.el (imap-log):
- * nnimap.el (nnimap-debug): Disable debugging by default.
-
-1999-11-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix.
-
- * gnus-topic.el (gnus-subscribe-topic): New function.
-
- * nnslashdot.el (nnslashdot-request-list): Give out extended group
- names.
-
- * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars
- if starting with a quote.
-
-1999-11-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in
- group name.
-
-1999-11-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el: New file.
-
- * nnheader.el (nnheader-insert-header): New function.
-
- * gnus-art.el (gnus-mime-internalize-part): Bind
- mm-inlined-types.
-
- * nndraft.el (nndraft-request-expire-articles): Do all the backup
- files.
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-11-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in
- empty buffers.
-
-1999-11-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode-map): Use the summary article
- edit.
-
-1999-11-06 Jens-Ulrik Petersen <Jens-Ulrik.Petersen@nokia.com>
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix.
-
-1999-11-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-uu.el (gnus-uu-mark-thread): Don't move point around.
-
-1999-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-treat-predicate): Examine whether the argument
- is list or not before condition.
-
-1999-10-07 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
-
- * gnus-art.el (gnus-treat-predicate): Work for (typep "something").
-
-1999-11-06 Kevin the Bandicoot <user42@zip.com.au>
-
- * gnus-art.el (gnus-emphasis-alist): New value.
-
-1999-11-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and
- `buffer-substring'.
-
-1999-11-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-date-ut): Keep the updated timer.
- (gnus-emphasis-underline-italic): Doc fix.
-
- * gnus-msg.el (gnus-post-method): Doc fix.
- (gnus-post-method): Change default.
-
-1999-11-06 Francisco Solsona <flsc@hp.fciencias.unam.mx>
-
- * message.el (message-newline-and-reformat): Improvements.
-
-1999-11-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-newline-and-reformat): Don't insert too many
- newlines.
- (message-newline-and-reformat): Work even if not sc.
-
- * mm-view.el (mm-inline-message): Insert a delimiter at the end.
-
- * mm-decode.el (mm-inline-media-tests): Only if diff mode.
-
-1999-11-06 Toby Speight <Toby.Speight@streapadair.freeserve.co.uk>
-
- * mm-view.el (mm-display-patch-inline): New function.
-
-1999-11-06 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * mm-view.el (mm-display-patch-inline): New function.
-
-1999-11-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-read-move-group-name): Subscribe to the
- group.
-
- * message.el (message-forward): Narrow to the right header.
-
- * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus
- dates.
-
- * gnus-msg.el (gnus-configure-posting-styles): Use the
- user-full-name function.
-
- * mm-bodies.el (mm-body-encoding): Use the choosing function.
- (mm-body-charset-encoding-alist): Default to nil.
-
- * message.el (message-elide-ellipsis): Fix typo.
- (message-elide-region): Ditto.
- (message-elide-region): Don't insert a newline first.
-
-1999-11-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-cut-thread): Also cut for numberp
- gnus-fetch-old-headers.
- (gnus-cut-threads): Ditto.
- (gnus-summary-initial-limit): Ditto.
- (gnus-summary-limit-children): Ditto.
-
- * gnus-msg.el (gnus-configure-posting-styles): Allow `header'
- matches.
-
-1999-11-06 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-art.el (article-decode-encoded-words):
- (gnus-mime-display-single): Don't assume gnus-summary-buffer is
- live.
-
- * gnus.el (gnus-read-method): Add methods from
- `gnus-opened-servers' to completion. Map entered method/address
- into existing methods if possible.
-
- * gnus-group.el (gnus-group-make-group): Simplify method.
-
- * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method.
-
- * mml.el (mml-preview): Remove mail-header-separator before
- encoding.
-
-1999-11-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-read-from-minibuffer): New function.
-
-1999-11-05 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.98 is released.
-
-1999-11-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV.
-
-1999-11-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Read attached binary file in
- binary mode.
-
-1999-11-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug.
-
-1999-11-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-viewer-lessp): Fix bug.
-
-1999-11-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-search-article): Fix loop search bug.
-
-1999-10-31 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-mime-match-handle-first): New function.
- (gnus-article-mime-match-handle-function): New variable.
- (gnus-article-view-part): Make `b' customizable.
-
-1999-10-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-article-get-xrefs): Test eobp.
-
-1999-09-27 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-decode.el (mm-attachment-override-types): Exclude text/plain.
-
-1999-10-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-buffer): CTE may come without CTL.
-
-1999-10-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Use
- `buffer-substring' instead of `read'.
-
-1999-10-23 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el, imap.el, rfc2104.el: New files.
-
- * gnus.el (gnus-valid-select-methods): Add nnimap.
-
- * gnus-group.el (gnus-group-group-map): Add
- gnus-group-nnimap-edit-acl, gnus-group-nnimap-expunge.
- (gnus-group-nnimap-expunge): New function.
- (gnus-group-nnimap-edit-acl): New function.
-
- * gnus-agent.el (gnus-agent-group-mode-map): Add
- gnus-agent-synchronize.
- (gnus-agent-synchronize): New function.
- (gnus-agent-fetch-group-1): Check if server is open.
-
- * nnagent.el (nnagent-request-set-mark): Save marks.
-
- * mail-source.el (mail-source-keyword-map): New imap mail-source.
- (mail-source-fetcher-alist): Map to imap fetcher function.
- (mail-source-fetch-imap): New function.
-
- * gnus-art.el (article-hide-pgp): Hide all headers, not just
- Hash:.
-
-1999-10-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-sort-topics-1): New function.
- (gnus-topic-sort-topics): New function.
- (gnus-topic-make-menu-bar): Add sort-topics.
- (gnus-topic-move): New function.
- (gnus-topic-move-group): Move the topic if no group selected.
-
-1999-10-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak.
-
-1999-10-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Fix leaving group bug.
-
-1999-10-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-post-method): Use normal method if current is
- not available.
-
-1999-10-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-insert-xref): Dealing with empty articles.
- (nnmail-insert-lines): Ditto.
-
-1999-10-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank
- line.
-
- * message.el (message-unsent-separator): One more separator.
-
-1999-10-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-move-article): For empty article,
- search till (point-max).
- (nnfolder-retrieve-headers): Ditto.
- (nnfolder-request-accept-article): Ditto.
- (nnfolder-save-mail): Ditto.
- (nnfolder-insert-newsgroup-line): Ditto.
-
-1999-10-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Check eobp.
-
-1999-10-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem.
-
-1999-10-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-send-xover-command): Wait for nothing if not
- wait-for-reply.
-
-1999-09-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-forward-begin-line): Change the regexp.
- (mm-uu-forward-end-line): Ditto.
-
-1999-09-29 Didier Verna <verna@inf.enst.fr>
-
- * binhex.el (binhex-decode-region): don't consider the value of
- `enable-multibyte-characters' in XEmacs.
-
- * gnus-start.el (gnus-read-descriptions-file): ditto.
-
- * mm-util.el (mm-multibyte-p): ditto.
- (mm-with-unibyte-buffer): ditto.
- (mm-find-charset-region): use `mm-multibyte-p'.
-
- * mm-bodies.el (mm-decode-body): ditto.
- (mm-decode-string): ditto.
-
-1999-09-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-binary-coding-system): Try binary first.
-
-1999-09-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc1843.el (rfc1843-decode-article-body): Don't decode twice.
-
-1999-09-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-make-date-line): Add time-zone in iso8601
- format.
- (article-date-ut): Find correct insert position.
-
-1999-09-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable
- forwarded message.
-
-1999-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-find-groups): Work for unactivated
- groups.
-
- * message.el (message-resend): Use message mode when prompting.
-
- * gnus-art.el (article-hide-headers): Mark wash.
- (article-emphasize): Ditto.
-
-1999-09-27 Vladimir Volovich <vvv@vvv.vsu.ru>
-
- * message.el (message-newline-and-reformat): Work for SC.
-
-1999-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*.
-
- * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown.
-
-1999-10-20 David S. Goldberg <dsg@mitre.org>
-
- * mm-decode.el (mm-inline-override-types): New variable
-
- * mm-decode.el (mm-inline-override-p): New function
-
- * mm-decode.el (mm-inlined-p): Use it
-
-1999-10-20 David S. Goldberg <dsg@mitre.org>
-
- * mm-decode.el mm-inline-override-types: New variable
-
- * mm-decode.el (mm-inline-override-p): New function
-
- * mm-decode.el (mm-inlined-p): Use it
-
-1999-09-27 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.97 is released.
-
-1999-09-01 Brendan Kehoe <brendan@zen.org>
-
- * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use
- gnus-summary-next-group, not gnus-summary-next-article. Only give
- 3 args.
+ * gnus-sum.el (gnus-summary-insert-subject): Remove list
+ identifiers.
-1999-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ From Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp> (tiny change).
+ * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty.
+ (spam-stat-save): Accept prefix argument.
- * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group
- buffer for params.
+2004-09-01 Simon Josefsson <jas@extundo.com>
- * message.el (message-forward-ignored-headers): New variable.
+ * message.el (message-canlock-generate): Require sha1, not
+ sha1-el. (Can we get rid of this require alltogheter? It is ugly
+ to require within a function. Sadly, if sha1.el isn't loaded, the
+ let binding in m-c-g will hide the defcustom definition, which is
+ bad.)
- * gnus-art.el (gnus-article-prepare-display): Nix out
- gnus-article-wash-types.
+ * canlock.el: Require sha1, not sha1-el.
- * gnus-agent.el (gnus-agent-create-buffer): New function.
- (gnus-agent-fetch-group-1): Use it.
- (gnus-agent-start-fetch): Ditto.
+ * message.el: Don't autoload sha1 (there is a autoload cookie in
+ sha1.el).
- * gnus-sum.el (gnus-summary-exit): Don't use
- `gnus-use-adaptive-scoring'.
+ * sha1-el.el: Renamed to sha1.el.
- * mail-source.el (mail-source-fetch-pop): Only store password when
- successful.
+2004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-nocem.el (gnus-nocem-scan-groups): Message better.
+ * pgg-pgp.el (pgg-pgp-verify-region): Clean up.
-1999-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+2004-05-19 Michael Schierl <schierlm-usenet@gmx.de>
- * message.el (message-reply): Use it.
- (message-dont-reply-to-names): New variable.
+ * pgg-pgp.el (pgg-pgp-verify-region): Default when signature
+ isn't a string.
- * nntp.el (nntp-open-telnet): Don't erase-buffer.
+2004-03-05 Jesper Harder <harder@ifa.au.dk>
- * mm-util.el (mm-preferred-coding-system): Typo fix.
+ * sha1-el.el (sha1-maximum-internal-length): Doc fix.
- * message.el (message-bounce): Work for non-MIME.
+2004-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus.el (gnus-short-group-name): Short the right parts of the
- name.
+ * canlock.el: Don't autoload mail-fetch-field.
-1999-09-24 Johan Kullstam <kullstam@ne.mediaone.net>
+2004-01-19 Katsumi Yamaoka <yamaoka@jpl.org>
- * mm-encode.el (mm-qp-or-base64): New version.
+ * canlock.el (base64-encode-string): Don't autoload it.
-1999-09-10 Shenghuo ZHU <zsh@cs.rochester.edu>
+2004-01-14 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-art.el (article-make-date-line): Fix time-zone bug.
+ * canlock.el: Always require sha1-el.
+ (canlock-sha1): Bind sha1-maximum-internal-length to nil.
-1999-09-09 Shenghuo ZHU <zsh@cs.rochester.edu>
+2004-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-art.el (gnus-article-add-buttons): Don't delete markers out
- of restricted region.
- (gnus-mime-display-single): Set beg at correct point.
+ * message.el (message-canlock-generate): Require sha1-el.
-1999-09-09 Shenghuo ZHU <zsh@cs.rochester.edu>
+2004-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
- * nnmail.el (nnmail-process-maildir-mail-format): Typo.
+ * canlock.el (canlock-insert-header): Remove excessive grouping in
+ regexp.
-1999-09-09 Jens-Ulrik Petersen <jens-ulrik.petersen@nokia.com>
+2004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-msg.el (gnus-configure-posting-styles): Let
- `gnus-posting-styles' have its say in posting-style: local
- variable `styles' is already bound to `gnus-posting-styles' so
- don't rebind it to nil.
+ * sha1-el.el (sha1-string-external): Use with-temp-buffer.
-1999-09-24 Robert Bihlmeyer <robbe@orcus.priv.at>
+2004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-score.el (gnus-summary-increase-score): Allow editing of
- Message-ID.
+ * canlock.el (canlock-sha1-function): Remove.
+ (canlock-sha1-function-for-verify): Remove.
+ (canlock-openssl-program): Remove.
+ (canlock-openssl-args): Remove.
+ (canlock-ignore-errors): Remove.
+ (canlock-sha1-with-openssl): Remove.
+ (canlock-sha1): Use sha1 instead of to call canlock-sha1-function.
+ (canlock-verify): Don't use canlock-ignore-errors.
-1999-09-08 Shenghuo ZHU <zsh@cs.rochester.edu>
+ * sha1-el.el (sha1-string-external): Make it can return a string
+ in binary form.
+ (sha1-region-external): Ditto.
+ (sha1-string-internal): Ditto.
+ (sha1-region-internal): Ditto.
+ (sha1-region): Ditto.
+ (sha1-string): Ditto.
+ (sha1): Ditto.
- * mm-encode.el (mm-encode-content-transfer-encoding): Fold
- quoted-printable-encode-region.
+2003-11-15 Simon Josefsson <jas@extundo.com>
- * qp.el (quoted-printable-encode-region): Assume charset
- encoded. Fold every line in the region.
+ * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys)
+ (pgg-gpg-lookup-key): Use regexp match instead of
+ split-string (split-string is different between emacs 21.2 and
+ 21.4). Reported by ultrasoul@ultrasoul.com (David D. Smith).
-1999-09-02 Shenghuo ZHU <zsh@cs.rochester.edu>
+2004-07-28 Simon Josefsson <jas@extundo.com>
- * gnus-srvr.el (gnus-browse-foreign-server): Read the first line
- of active file.
+ * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign
+ parameter (but don't use it, for now).
-1999-09-01 Didier Verna <verna@inf.enst.fr>
+2004-02-03 Jesper Harder <harder@ifa.au.dk>
- * message.el (message-mode): allows whitespaces between multiple
- instances of the fill character ">".
+ * sieve.el (sieve-deactivate-all): Fix format string mismatch.
-1999-09-24 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
+2004-05-26 Simon Josefsson <jas@extundo.com>
- * mm-encode.el (mm-qp-or-base64): Fix.
-
-1999-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-send): Too much and.
-
-1999-09-24 Andreas Schwab <schwab@suse.de>
-
- * gnus-art.el (gnus-mime-view-part-as-type): Renamed.
-
-1999-08-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-headers): Work for nil scores.
-
-1999-08-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cache.el (gnus-cache-write-active): Write full names.
-
- * gnus-util.el (gnus-write-active-file): Accept full name.
-
- * mm-decode.el (mm-inlinable-p): Use string-match on the types.
- (mm-assoc-string-match): New function.
- (mm-display-inline): Use it.
-
- * gnus-group.el (gnus-group-set-info): Work for nil group params.
-
- * gnus-msg.el (gnus-configure-posting-styles): Allow eval.
-
-1999-08-27 Florian Weimer <fw@s.netic.de>
-
- * mml.el (mml-generate-multipart-alist): New variable.
-
-1999-08-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-predicate): Work for (not 5).
-
-1999-08-27 Peter von der Ahe <pahe@daimi.au.dk>
-
- * message.el (message-send): More helpful error message if sending
- fails
-
-1999-09-06 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * gnus-score.el (gnus-summary-increase-score): "Lars" was broken
- in newer emacsen, where ?r isn't equal 114.
-
-1999-08-27 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.96 is released.
-
-1999-08-17 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-groups-to-gnus-format): Only use agent
- to get active info if method is covered by agent, otherwise
- active info is lost.
-
-1999-08-17 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-summary-move-article): Report backend errors.
-
-1999-08-09 Dave Love <fx@gnu.org>
-
- * mm-util.el: Use `defalias', not `fset' for dummy functions.
-
-1999-08-09 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-art.el (gnus-ignored-headers): Remove "X-Pgp-*"
- (already matched by "^X-Pgp"), removed duplicate X-Mailing-List,
- added several new junk headers.
-
-1999-08-01 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-art.el (article-decode-charset): Don't assume
- gnus-summary-buffer is live.
-
-1999-08-27 Florian Weimer <fw@s.netic.de>
-
- * gnus-score.el (gnus-home-score-file): Work with absolute path
- names.
-
-1999-07-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-articles-to-read): Return cached articles if
- nothing else in the group.
-
-1999-07-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-bcklg.el (gnus-backlog-enter-article): Check the size of
- the article.
-
-1999-07-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Fix for base64 message.
-
-1999-07-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-forward-end-line): Support forwarded message
- from mutt.
-
-1999-07-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Delete
- whitespace.
-
-1999-07-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-text-coding-system-for-write): New variable.
- (mm-append-to-file): New function.
- (mm-write-region): New function.
-
- * gnus-art.el (gnus-output-to-file): Use it.
- * gnus-util.el (gnus-output-to-rmail): Ditto.
- (gnus-output-to-mail): Ditto.
- * gnus-uu.el (gnus-uu-binhex-article): Ditto.
-
-1999-07-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-find-file): Use mm-auto-mode-alist.
-
- * nnheader.el (nnheader-insert-file-contents): Revert and use
- mm-insert-file-contents.
- (nnheader-find-file-noselect): Use mm-auto-mode-alist.
- (nnheader-auto-mode-alist): Removed.
-
- * mm-util.el (mm-inhibit-file-name-handlers): New variable.
- (mm-insert-file-contents): Add a new parameter for inserting
- compressed file literally.
-
- * mml.el (mml-generate-mime-1): Insert non-text literally.
-
- * gnus.el: Change most mm-insert-file-contents back to nnheader.
-
-1999-07-13 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-unbuttonized-mime-types): Fix docstring.
-
-1999-08-27 Oleg S. Tihonov <ost@benetnash.ffke-campus.mipt.ru>
-
- * gnus-sum.el (gnus-group-charset-alist): Default fido7 to
- koi8-r.
-
-1999-07-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-mime): Decode text.
- (mml-to-mime): Narrow to headers-or-head.
-
-1999-07-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Check
- w3-meta-content-type-charset-regexp.
-
-1999-07-10 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Search topics for
- predicate.
-
-1999-07-10 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-mlspl.el: Documentation fixes.
-
-1999-08-27 Rui Zhu <sprache@iname.com>
-
- * gnus-sum.el (gnus-summary-limit-to-age): Prompt better.
-
-1999-08-27 Michael Cook <cook@sightpath.com>
-
- * gnus-art.el (gnus-article-setup-buffer): Kill all local
+ * starttls.el: Merge with my GNUTLS based starttls.el.
+ (starttls-gnutls-program, starttls-use-gnutls)
+ (starttls-extra-arguments, starttls-process-connection-type)
+ (starttls-connect, starttls-failure, starttls-success): New
variables.
-
-1999-08-27 Hrvoje Niksic <hniksic@srce.hr>
-
- * nnmail.el (nnmail-get-new-mail): "Done".
-
-1999-08-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when
- interactive.
-
-1999-07-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Fix broken CT.
-
-1999-07-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent
- overview buffer if it is killed.
-
-1999-08-27 Eric Marsden <emarsden@mail.dotcom.fr>
-
- * gnus-art.el (article-babel): New version.
-
-1999-08-27 Jon Kv <jonkv@ida.liu.se>
-
- * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus.texi (More Threading): Document new variable
- `gnus-sort-gathered-threads-function'.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus.texi (More Threading): Document new variable
- `gnus-sort-gathered-threads-function'.
-
-1999-07-11 Andreas Jaeger <aj@arthur.rhein-neckar.de>
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Delete file after
- usage.
-
-1999-07-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-running-xemacs): Removed.
- (mm-coding-system-p): New function.
- (mm-binary-coding-system): Safe guess.
- (mm-text-coding-system): Ditto.
- (mm-auto-save-coding-system): Ditto.
-
-1999-07-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el (mm-qp-or-base64): Also consider control chars.
- (mm-qp-or-base64): Reversed logic.
-
- * mm-decode.el (mm-save-part-to-file): Let coding system be
- binary.
-
-1999-07-15 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to
- be set in topic parameters.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-sum.el (gnus-sort-gathered-threads-function): New variable.
- (gnus-sort-gathered-threads): Allow the user to specify the
- function to use when sorting gathered threads.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't
- mark cached articles as `undownloaded'.
-
-1999-07-20 Peter von der Ahe <peter@ahe.dk>
-
- * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring
- to have buffer local values.
-
-1999-07-25 Matt Pharr <mmp@graphics.stanford.edu>
-
- * gnus-group.el (gnus-group-make-doc-group): Notice when user
- types 'g' for 'guess group type.
-
-1999-07-30 Simon Josefsson <jas@pdc.kth.se>
-
- * nnmail.el (nnmail-remove-list-identifiers): Remove whitespace
- after each regexp in nnmail-list-identifiers, not just after last
- one.
-
- * gnus-sum.el (gnus-list-identifiers): New variable.
- (gnus-summary-remove-list-identifiers): New function.
- (gnus-select-newsgroup): Use it.
- (gnus-summary-wash-hide-map): Bind
- `gnus-article-hide-list-identifiers' to W W l.
- (gnus-summary-make-menu-bar): Add list-identifiers command.
-
- * gnus-art.el (gnus-treat-strip-list-identifiers): New variable.
- (gnus-treatment-function-alist): Add variable.
- (article-hide-list-identifiers): New function.
- (mapcar): Add function.
- (gnus-article-hide): Use it.
-
-1999-07-10 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.95 is released.
-
-1999-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-mailcap-command): New function.
- (mm-display-external): Use it.
-
- * gnus-art.el (article-make-date-line): Work for India.
-
- * mm-encode.el (mm-qp-or-base64): Typo.
-
- * gnus-topic.el (gnus-topic-goto-topic): Made into command.
-
-1999-07-09 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.94 is released.
-
-1999-07-09 Stainless Steel Rat <ratinox@peorth.gweep.net>
-
- * pop3.el: New version.
-
-1999-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el (mm-qp-or-base64): New function.
- (mm-content-transfer-encoding): Use it.
-
- * gnus-util.el (gnus-parse-netrc): Allow quoted names.
-
-1999-07-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Fix typo and use 'non-viewer.
-
- * mailcap.el (mailcap-mailcap-entry-passes-test): Add needsterminal.
-
-1999-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-part-as-media): New command and
- keystroke.
-
- * mailcap.el (mailcap-mime-types): New function.
-
- * nnmh.el (nnmh-request-group): Update nnmh-group-alist.
-
- * message.el (message-goto-eoh): Really go to the end.
-
-1999-07-09 Puneet Goel <puneet@computer.org>
-
- * message.el (message-make-date): Do the right thing in with
- sub-hour time zones.
-
-1999-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-make-menu-bar): Removed double bug
- report.
-
-1999-07-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-rename-group): Create directory.
-
-1999-07-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcap): Skip \;.
- (mailcap-parse-mailcap-extras): Fix "nonterminal;" and empty name,
- and use t as default value.
-
-1999-07-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Don't assume
- gnus-summary-buffer is live.
-
-1999-07-09 Robert Pluim <rpluim@nortelnetworks.com>
-
- * mm-util.el (mm-enable-multibyte): Check whether var bound.
-
-1999-07-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-bounce): Do MIME bounces MIMEy.
-
- * gnus-sum.el (gnus-summary-read-group-1): Update mark positions.
-
-1999-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-extensions): Changed patch to
- text/x-patch.
-
- * mm-decode.el (mm-display-external): Wrong placement of paren.
-
-1999-07-07 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.93 is released.
-
-1999-07-08 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-cus.el (gnus-group-parameters): New entries for
- gnus-group-split.
-
- * gnus-mlspl.el: Renamed functions and variables so as to
- start with gnus-group-split.
-
- * gnus.el: Adjust autoload entries.
-
-1999-11-30 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-mlspl.el: Removed trailing t from comment and provide.
- Renamed functions and variables to start with gnus-mlsplit.
- Added autoload comments.
- * gnus.el: Added autoload entries.
-
-1999-07-06 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * nnmail.el (nnmail-split-it): Search the regexp multiple times,
- so that matches excluded by RESTRICTs do not cause the whole split
- to be ignored. This also fixes a long-standing bug in which a
- split with \N substitutions wouldn't cause cross-posting as
- expected.
-
- * nnmail.el (nnmail-split-fancy): Document RESTRICT clauses.
- (nnmail-split-it): Implement them.
-
- * nnmail.el (nnmail-split-fancy): Document ! splits.
-
-1999-07-07 Stainless Steel Rat <ratinox@peorth.gweep.net>
-
- * pop3.el: New version.
-
-1999-07-05 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Use read.
-
-1999-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-alternative): Do treatment.
-
-1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-write-active-file): Use real name.
-
- * gnus-agent.el (gnus-agent-expire): Update active file
- method by method.
-
-1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndraft.el (nndraft-request-article): Use difference
- coding-systems for queue and drafts.
-
- * gnus-sum.el (gnus-summary-setup-default-charset): Special-case
- nndraft:drafts.
-
- * mm-util.el (mm-auto-save-coding-system): New coding system.
-
- * message.el (message-draft-coding-system): Use it.
-
-1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el: More customizable and less aggressive.
-
-1999-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active
- when plugged.
-
- * mml.el (mml-generate-mime-1): Don't insert nofile files.
- (mml-insert-mml-markup): Accept a nofile.
- (mml-insert-mime): Insert nofile.
-
- * gnus-art.el (gnus-treat-strip-blank-lines): Removed.
-
- * mm-decode.el (mm-handle-media-type): New function.
- (mm-handle-media-supertype): New function.
- (mm-handle-media-subtype): New function.
- Use new functions throughout. "/"))
-
-1999-05-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-treat-predicate): Typo.
-
-1999-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-summary-score-entry): Made un-interactive.
-
-1999-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-date-ut): UT! Default it!
-
-1999-07-06 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.92 is released.
-
-1999-07-06 Johannes Weinert <Johannes.Weinert@Informatik.Uni-Oldenburg.DE>
-
- * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix.
-
-1999-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-retrieve-groups): Don't do anything when not
- connected.
-
- * gnus-start.el (gnus-active-to-gnus-format): Only save active
- when plugged.
-
- * mm-view.el (mm-inline-message): Ignore remove-spec.
-
- * gnus-agent.el (gnus-agent-write-active): Check whether orig sym
- is bound.
-
- * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines.
-
- * nndoc.el (nndoc-guess-type): Remove blank lines at the start.
-
- * nnfolder.el (nnfolder-read-folder): Remove blank lines at the
- start.
-
- * message.el (message-fill-yanked-message): Remove `t' arg.
-
- * gnus-group.el (gnus-group-kill-group): Message killing of
- groups.
-
- * mm-util.el (mm-preferred-coding-system): New function.
- (mm-mime-charset): Use it.
-
- * mml.el (mml-generate-mime-1): Charset-encode message parts.
-
-1999-07-06 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-mlsplt.el: New file.
-
-1999-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-Media-tests): Changed from forms to
- functions.
- (mm-attachment-override-p): Take a handle instead of a type.
- (mm-inlined-p): Ditto.
- (mm-automatic-display-p): Ditto,
- (mm-inlinable-p): Ditto.
-
- * nndraft.el (nndraft-request-expire-articles): Delete backup
- files.
-
- * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff.
-
- * gnus-sum.el (gnus-summary-limit-to-extra): Typo.
-
-1999-07-06 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * nnmail.el (nnmail-split-it): Allow .*.
-
-1999-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-large-images-p): Renamed.
-
- * gnus-art.el (article-date-ut): Always look in the current buffer
- for the Date header.
-
- * mml.el (mml-validate): New command.
-
- * mailcap.el (mailcap-possible-viewers): Revert to string-match
- since we are dealing with regexps.
-
-1999-07-04 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.91 is released.
-
-1999-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-save-active-1): New function.
- (gnus-agent-save-active): use it.
- (gnus-agent-save-groups): Ditto.
-
- * gnus-cache.el (gnus-cache-write-active): Use it.
-
- * gnus-agent.el (gnus-agent-write-active): Use it.
-
- * gnus-util.el (gnus-write-active-file): New function.
-
- * gnus-agent.el (gnus-agent-write-active): New function to keep
- lower boundaries and canceled groups.
- (gnus-agent-save-groups): Use it.
- (gnus-agent-save-active): Use it.
- (gnus-agent-save-group-info): Only write active files.
- (gnus-agent-expire): Update active file.
-
- * mm-decode.el (mm-inlinable-part-p): Removed.
- (mm-user-display-methods): Default to nil.
- (mm-user-display-methods): Removed.
- (add-mime-display-method): Removed.
- (mm-automatic-display): Renamed.
- (mm-automatic-display-p): Use it.
- (mm-inlined-types): New variable.
- (mm-inlined-p): New function.
-
- * message.el (message-reply): Bind message-this-is-mail.
-
-1999-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el (mm-encode-buffer): Check whether we have 7bit.
-
- * message.el (message-check-news-header-syntax): Protect against
- nil froms.
-
- * mm-util.el (mm-auto-mode-alist): New.
-
- * mml.el (mml-generate-mime-1): Ditto.
-
- * gnus.el: Use mm-insert-file-contents throughout instead of
- nnheader.
-
- * mm-util.el (mm-insert-file-contents): New function.
-
-1999-07-03 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.90 is released.
-
-1999-07-03 Sven Fischer <herpes@kawo2.rwth-aachen.de>
-
- * mailcap.el (mailcap-possible-viewers): Use string=.
-
-1999-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-forward-begin-line): New variable.
- (mm-uu-forward-end-line): New variable.
- (mm-uu-begin-line): Handle forwarded message.
- (mm-uu-identifier-alist): Ditto.
- (mm-uu-dissect): Ditto.
-
-1999-07-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-file-coding-system): Use raw-text.
- * gnus-agent.el (gnus-agent-file-coding-system): Ditto.
- * gnus-cache.el (gnus-cache-coding-system): Ditto.
-
- * nnfolder.el (nnfolder-file-coding-system): Use mm-text-coding-system.
- (nnfolder-file-coding-system-for-write): New variable.
- (nnfolder-active-file-coding-system): New variable.
- (nnfolder-active-file-coding-system-for-write): New variable.
- (nnfolder-save-active): New function.
- (nnfolder-save-buffer): Use them.
- (nnfolder-possibly-change-group): Ditto.
- (nnfolder-request-list-newsgroups): Ditto.
- (nnfolder-request-create-group): Ditto.
- (nnfolder-request-expire-articles): Ditto.
- (nnfolder-request-move-article): Ditto.
- (nnfolder-request-accept-article): Ditto.
- (nnfolder-request-delete-group): Ditto.
- (nnfolder-request-rename-group): Ditto.
- (nnfolder-possibly-change-folder): Ditto.
- (nnfolder-read-folder): Ditto.
- (nnfolder-request-list): Remove pathname-coding-system.
- (nnfolder-possibly-change-group): Use nnmail-pathname-coding-system.
-
- * nnmail.el (nnmail-file-coding-system): Use raw-text.
- (nnmail-file-coding-system-1): Removed.
- (nnmail-find-file): Use nnmail-pathname-coding-system.
- (nnmail-write-region): Ditto.
-
- * nnmbox.el (nnmbox-file-coding-system): New variable.
- (nnmbox-file-coding-system-for-write): New variable.
- (nnmbox-active-file-coding-system): New variable.
- (nnmbox-active-file-coding-system-for-write): New variable.
- (nnmbox-save-buffer): New function.
- (nnmbox-save-active): New function.
- (nnmbox-request-scan): Use them.
- (nnmbox-request-expire-articles): Ditto.
- (nnmbox-request-move-article): Ditto.
- (nnmbox-request-accept-article): Ditto.
- (nnmbox-request-replace-article): Ditto.
- (nnmbox-request-delete-group): Ditto.
- (nnmbox-request-rename-group): Ditto.
- (nnmbox-request-create-group): Ditto.
-
- * mm-util.el (mm-text-coding-system): raw-text or -dos.
- (mm-running-ntemacs): Removed.
-
- * nnml.el (nnml-file-coding-system): Use nnmail-file-coding-system.
-
-1999-07-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-read-folder): Use nnheader-file-coding-system.
-
-1999-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encoding-characters): Support lower case.
-
-1999-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): Fold before B-encoding.
- (rfc2047-b-encode-region): Encode line by line.
-
-1999-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-find-mime-charset-region): Fix.
-
-1999-06-30 KOSEKI Yoshinori <kose@yk.NetLaputa.ne.jp>
-
- * mm-util.el (mm-mime-mule-charset-alist): Fix iso-2022-jp(-2) bug.
- (mm-find-mime-charset-region): Ditto.
-
-1999-07-03 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-summary-move-article): Fix something or
- other.
-
-1999-06-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-ephemeral-charset): New variable.
- (gnus-newsgroup-ephemeral-ignored-charsets): New variable.
- (gnus-summary-enter-digest-group): Use them.
- (gnus-summary-setup-default-charset): Ditto.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-configure-posting-styles): Fix bug when
- gnus-newsgroup-name is nil.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): Chop the tail newline.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-emphasize): Use correct
- gnus-article-emphasis-alist.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Fix text/html bug.
-
-1999-06-28 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.89 is released.
-
-1999-06-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-file-coding-system-1): For NTEmacs in Windows.
- * message.el (message-draft-coding-system): Ditto.
- * mm-util.el (mm-running-ntemacs): Ditto.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Ignore error in w3-region.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el: require mm-decode.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Treat as head only if necessary.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-image): Fix image undisplayer.
-
-1999-06-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-multipart): Error in compeling-read.
- (mml-insert-tag): Match tags.
-
-1999-06-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-braid-nov): Fix coding-system bug.
- (gnus-cache-braid-heads): Ditto.
- (gnus-cache-retrieve-headers): Ditto.
-
-1999-06-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-send): Fix encoding bug.
-
-1999-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-read-summary-keys): Convert key events
- to string under XEmacs.
-
-1999-06-28 Petersen Jens-Ulrik <jens-ulrik.petersen@nokia.com>
-
- * gnus-start.el (gnus-find-new-newsgroups): Doc fix.
-
-1999-06-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Fix message view bug.
- * gnus-art.el (gnus-article-prepare): Ditto.
-
-1999-06-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Fetch headers.
-
-1999-06-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.88 is released.
-
-1999-06-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-save-parts): Destroy handles after
- usage.
-
- * nnmail.el (nnmail-get-new-mail): Save info.
-
-1999-06-14 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.87 is released.
-
-1999-06-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-file): Use prescript-delay.
- (mail-source-run-script): New function.
- (mail-source-fetch-pop): Use it.
-
-1999-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-setup-highlight-words): Moved here.
-
-1999-06-13 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.86 is released.
-
-1999-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-translate): New variable.
- (gnus-treat-predicate): Accept a list of regexps.
- (gnus-article-treat-custom): Allow a list of regexps.
-
-1999-06-09 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
-
- * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom
- type.
-
-1999-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-babel): Narrow a bit.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow.
-
-1999-06-12 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Operate on all
- articles, not only unread ones.
- (gnus-agent-fetch-headers): Fetch headers from unread and marked
- articles, not only unread ones.
-
-1999-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-limit-to-extra): New command and
- keystroke.
-
- * gnus-art.el (gnus-article-x-face-command): Ditto.
-
- * gnus-uu.el (gnus-uu-default-view-rules): Default to "display".
-
- * gnus.el (gnus-method-simplify): Accept server names.
-
-1999-06-13 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (article-babel-prompt): New function.
- (article-babel): New command.
-
-1999-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-part-wrapper): Go to part.
-
- * mml.el (mml-generate-mime-1): Don't insert literally.
-
- * gnus-util.el (gnus-parse-netrc): Skip lines with #'s.
- (gnus-netrc-syntax-table): Removed.
- (gnus-parse-netrc): Don't use syntax table; just use whitespace.
-
-1999-05-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Fix charset for text/html.
-
-1999-05-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-draft-coding-system): Use emacs-mule-dos.
-
-1999-06-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-split-incoming): Return the number of split
- mails.
- (nnmail-process-babyl-mail-format): Ditto.
- (nnmail-process-unix-mail-format): Ditto.
- (nnmail-process-mmdf-mail-format): Ditto.
- (nnmail-process-maildir-mail-format): Ditto.
-
- * mail-source.el (mail-source-callback): Return the number from
- the callback.
-
- * message.el (message-send-mail): Generate Lines.
-
- * mail-source.el (mail-source-call-script): New function.
- (mail-source-call-script): New function.
-
-1999-05-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-setup-highlight-words): New function.
- (gnus-select-newsgroup): Use it.
- (gnus-group-highlight-words-alist): New variable.
- (gnus-newsgroup-emphasis-alist): New variable.
- (gnus-summary-local-variables): Use it.
- * gnus-art.el (article-emphasize): Use it.
- (gnus-emphasis-highlight-words): New face.
- * gnus-cus.el (gnus-group-parameters): New parameter.
-
-1999-05-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Remove
- parameter `headers'.
- (gnus-cache-enter-article): Ditto.
- (gnus-cache-update-article): Ditto.
- * gnus-sum.el (gnus-summary-move-article): Ditto.
- (gnus-summary-mark-article-as-unread): Ditto.
- (gnus-summary-mark-article): Ditto.
-
-1999-06-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-message-insert-stylings): Removed.
- (gnus-posting-style-alist): Removed.
- (gnus-message-style-insertions): Ditto.
- (gnus-configure-posting-styles): Reimplementation.
-
- * mail-source.el (mail-source-fetch): Error the message.
-
- * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding.
-
-1999-06-12 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.85 is released.
-
-1999-04-20 Michael Cook <cook@sightpath.com>
-
- * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS
- Outlook citation regex.
-
-1999-06-12 Lars Magne Ingebrigtsen <pinard@iro.umontreal.ca>
-
- * nndoc.el (nndoc-mime-parts-type-p): Accept space before
- semicolon.
-
-1999-05-24 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Document range1
- modification, protect range2.
-
-1999-05-24 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks): Protect lists from
- gnus-remove-from-range, don't sort twice.
-
-1999-05-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-read-descriptions-file): Protect if no
- function in backend.
-
-1999-05-15 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-valid-move-group-p): Check for a
- request-accept-article function in the backend instead of using
- the 'respool capability.
-
-1999-04-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Handle
- spurious whitespace at eob.
-
-1999-06-12 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * nnmail.el (nnmail-get-new-mail): Check right variable.
-
-1999-06-12 Karl Kleinpaste <karl@justresearch.com>
-
- * mailcap.el (mailcap-mime-data): Fix rfc822.
-
-1999-06-12 TOZAWA Akihiko <miles@is.s.u-tokyo.ac.jp>
-
- * nndoc.el (nndoc-nsmail-type-p): New function.
- (nndoc-type-alist): Recognize nsmail.
-
-1999-05-12 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-art.el (gnus-treatment-function-alist): Display `x-face'
- *before* `article-hide-headers' deletes the information.
-
-1999-05-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-save-parts): New command and
- keystroke.
- (gnus-summary-save-parts-1): New function.
- (gnus-summary-iterate): Buggy.
-
- * mm-decode.el (mm-save-part-to-file): Made into own function.
-
-1999-05-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-set-info): Resist nils.
-
-1999-05-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-data): Ditto.
-
- * gnus-uu.el (gnus-uu-default-view-rules): Ditto.
-
- * gnus-art.el (gnus-article-x-face-command): Default to ee.
-
-1999-05-02 Gareth Jones <gdj1@gdjones.demon.co.uk>
-
- * gnus-art.el (article-make-date-line): Put X-Sent below Date if
- gnus-article-date-lapsed-new-header is t.
-
-1999-05-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.84 is released.
-
-1999-05-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-bug-message): Mime change.
-
-1999-04-22 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks): Process null mark lists.
-
-1999-04-21 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Recognize
- `x-uue'.
-
-1999-03-04 Aaron M. Ucko <amu@mit.edu>
-
- * mail-source.el (mail-source-fetch-pop): Only prompt for password
- when authentication is 'password.
-
-1999-05-02 Francois Pinard <pinard@iro.umontreal.ca>
-
- * gnus-win.el (gnus-configure-windows): Accept a setting.
-
-1999-04-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-quote-arg): Moved here.
-
- * mm-decode.el (mm-quote-arg): Quote more chars.
-
-1999-04-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (nnheader-parse-head): Message-ID in In-Reply-To
- with newlines would create buggy .nov files.
-
- * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil.
-
- * qp.el (quoted-printable-encode-region): Encode whitespace at the
- end of lines.
-
- * message.el (message-mode): Doc fix.
-
- * gnus-art.el (article-hide-headers): Delete the hidden headers.
-
- * gnus-msg.el (gnus-setup-posting-charset): Default group to "".
-
- * gnus-art.el (article-date-ut): Rewrite.
-
- * mm-decode.el (mm-preferred-alternative-precedence): Reverse the
- order.
-
- * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate
- headers.
-
- * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix.
-
-1999-04-18 Didier Verna <verna@inf.enst.fr>
-
- * gnus-art.el (gnus-article-date-lapsed-new-header): new variable.
- (article-date-ut): use it.
-
-1999-04-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-pop): Call script
- asynchronously.
-
-1999-04-18 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.83 is released.
-
-1999-04-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (gnus-draft-mode): Use mml minor mode.
-
- * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error.
-
- * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads.
-
- * gnus-art.el (gnus-mime-inline-part): Don't do a charset param.
-
- * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp.
-
- * message.el (message-generate-headers): Accept continuation
- headers.
-
-1999-04-18 Renaud Rioboo <Renaud.Rioboo@lip6.fr>
-
- * gnus-demon.el (gnus-demon-time-to-step): Not strings.
-
-1999-04-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): use
- maybe-hide-headers.
-
- * message.el (message-inhibit-body-encoding): Typo.
- (message-resend): Inhibit encoding.
-
- * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047.
-
- * gnus-art.el (article-remove-cr): Use re-search.
-
- * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME
- headers.
-
- * mm-decode.el (mm-quote-arg): Quote '.
-
- * gnus-ems.el (gnus-x-splash): Would place splash wrongly.
-
- * mm-decode.el (mm-insert-part): Use multibyte for text.
-
- * gnus-start.el (gnus-read-newsrc-file): New variable.
- (gnus-read-newsrc-file): Use it.
-
-1999-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnvirtual.el (nnvirtual-request-expire-articles): New function.
-
- * gnus-group.el (gnus-group-expire-articles-1): Made into own
- function.
-
-1999-04-17 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.82 is released.
-
-1999-04-15 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups
- for iso8859-2.
-
-1999-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from
- synonym alist.
-
-1999-04-17 Adam P. Jenkins <ajenkins@netway.com>
-
- * gnus-sum.el (gnus-summary-local-variables): Mark as global.
-
-1999-04-17 Ettore Perazzoli <ettore@comm2000.it>
-
- * mail-source.el (mail-source-fetch): Ask before bugging out.
-
-1999-03-19 Hrvoje Niksic <hniksic@srce.hr>
-
- * uudecode.el (uudecode-decode-region-external): Don't assume
- uudecode-temporary-file-directory ends with a slash.
-
-1999-03-18 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks):
- (gnus-update-read-articles):
- (gnus-summary-expire-articles): Check server.
-
-1999-03-16 Simon Josefsson <jas@pdc.kth.se>
-
- * mml.el (mml-preview): New function.
-
-1999-04-17 William M. Perry <wmperry@aventail.com>
-
- * mail-source.el (mail-source-fetch-file): Return the right
- value.
-
-1999-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-parameter): New function.
- (mml-insert-parameter-string): New function.
-
- * nnmail.el (nnmail-get-new-mail): Say how many new articles.
-
- * gnus-art.el (gnus-mime-multipart-functions): New variable.
- (gnus-mime-display-part): Use it.
-
- * mm-decode.el (mm-alternative-precedence): Removed.
- (mm-discouraged-alternatives): New variable.
- (mm-preferred-alternative-precedence): New function.
-
- * nnmail.el (nnmail-get-new-mail): Use mail-sources.
-
- * mail-source.el (mail-sources): New variable.
-
- * gnus-art.el (article-remove-cr): Remove several trailing CRs.
-
- * mm-decode.el (mm-valid-image-format-p): New function.
- (mm-inline-media-tests): Use it.
- (mm-valid-and-fit-image-p): New function.
-
- * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged.
- (gnus-agent-fetch-group): Ditto.
-
-1999-04-12 Didier Verna <verna@inf.enst.fr>
-
- * nnmail.el (nnmail-article-group): in case of a group name
- containing "\\n" constructs, be sure to pass the expanded value to
- nn*-save-mail.
-
-1999-04-17 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.81 is released.
-
-1999-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-get-split-value): Reverse result.
-
-1999-04-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-always-read-dribble-file): Doc fix.
-
-1999-04-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-tag): Insert concluding part.
-
- * message.el (message-send-mail): Encode later.
- (message-send-news): Ditto.
-
- * nnfolder.el: Don't use mail delim.
-
-1999-03-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cus.el (gnus-group-customize): Put point at min.
-
- * mm-view.el (mm-inline-text): Allow toggling html.
-
-1999-03-28 William M. Perry <wmperry@aventail.com>
-
- * mail-source.el: Added prescript and postscript to file.
-
-1999-03-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el: Reverted.
-
- * gnus-msg.el (gnus-setup-posting-charset): Didn't work.
- (gnus-setup-posting-charset): Did work.
-
-1999-03-28 Jae-you Chung <jay@pllab.kaist.ac.kr>
-
- * gnus.el (gnus-short-group-name): Use
- gnus-group-uncollapsed-levels.
-
-1999-03-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays.
-
-1999-03-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-strip-headers-in-body): New variable.
- (article-strip-headers-from-body): New command and keystroke.
-
-1999-03-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-pop): Check for symbol first.
-
- * nnheader.el (nnheader-insert-file-contents): Bind
- enable-local-eval to nil.
- (nnheader-find-file-noselect): Ditto.
-
- * nnmail.el (nnmail-article-group): Don't remove long lines.
- (nnmail-remove-long-lines): New function.
- (nnmail-split-header-length-limit): Removed.
-
- * mml.el (mml-generate-mime-1): Use unibyte buffers.
-
- * gnus-group.el (gnus-group-kill-all-zombies): Query user.
-
-1999-03-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-generic-mark): New function.
-
- * nnmail.el (nnmail-split-header-length-limit): Increased.
- (nnmail-article-group): Allow nil.
-
- * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion.
-
- * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers
- first.
-
- * mml.el (mml-minibuffer-read-type): Include types from
- mailcap-mime-data.
-
- * nndraft.el (nndraft-request-article): Would clobber Japanese.
-
-1999-03-05 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-insert-tag): New function.
- (mml-read-file): Renamed to mml-minibuffer-read-file to avoid
- confusion with functions like `mml-read-tag'.
- (mml-read-type): Ditto with `mml-minibuffer-read-type'.
- (mml-minibuffer-read-description): Ditto with
- `mml-minibuffer-read-description'.
- (mml-attach-buffer): New function.
- (mml-mode-map): New entry for /.
- (mml-minibuffer-read-type): Accept DEFAULT.
-
- * mml.el (mml-quote-region): Narrow the region.
-
- * message.el (message-mode-menu): message-mime-attach-file is now
- mml-attach-file.
-
-1999-03-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier.
-
-1999-03-05 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * mml.el (mml-attach-buffer): New command.
-
-1999-02-27 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range
- with a proper range. Compress range.
-
- * gnus-range.el (gnus-remove-from-range): Protect arguments.
-
-1999-03-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-get-image): Create a temporary file for xbms.
-
-1999-03-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-x-face-file-name): Removed.
- (gnus-picons-convert-x-face): Removed.
- (gnus-picons-article-display-x-face): Removed.
- (gnus-picons-x-face-sentinel): Ditto.
- (gnus-picons-display-x-face): Ditto.
-
-1999-03-04 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.80 is released.
-
-1999-03-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mm-display-part): Narrow to the part itself.
-
- * gnus-sum.el (gnus-with-article): Moved here.
-
- * mail-source.el (mail-source-fetch-pop): Ask for password even
- when program.
-
-1999-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-bug): Add description.
-
- * mml.el (mml-insert-mml-markup): Insert disposition.
-
- * message.el (message-send-mail): Always encode mail headers.
-
-1999-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-article): Only run the highlight stuff
- when requested.
-
- * nnmail.el (nnmail-current-spool): Removed.
-
- * gnus-salt.el (gnus-tree-inhibit): New varible.
-
- * gnus.el (mm-util): Required.
-
-1999-02-27 paul stevenson <spaul@mail.phy.ornl.gov>
-
- * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first.
-
-1999-02-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-bind): Doc fix.
-
-1999-02-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode): Doc fix.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit
- encoding.
-
- * gnus.el (gnus-methods-equal-p): Moved here.
-
- * mail-source.el: pop at 110.
-
- * pop3.el (pop3-movemail): Use write-region instead of
- append-to-file to avoid excessive messaging.
-
-1999-02-27 lantz moore <lmoore@contigo.com>
-
- * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of
- type directory.
-
-1999-03-04 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * gnus-art.el (article-hide-boring-headers): Field names must not
- contain whitespace.
-
-1999-02-26 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.79 is released.
-
-1999-02-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting.
-
- * mml.el (mml-mode): Don't use add-minor-mode.
-
- * message.el (messgage-inhibit-body-encoding): New variable.
- (message-encode-message-body): Use it.
-
-1999-02-26 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.78 is released.
-
-1999-02-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode): Switch on MML mode.
-
- * mml.el: Included commands and functions.
- (mml-mode-map): New keymap.
-
- * message.el: Removed the insertion commands and functions.
-
- * gnus-ems.el (gnus-mule-cite-add-face): Removed.
-
- * gnus-sum.el (gnus-summary-sort-by-chars): New command and
- keystroke.
-
- * gnus-art.el (gnus-narrow-to-page): Revert.
-
- * gnus-cite.el (gnus-cite-delete-overlays): New function.
- (gnus-cite-parse-maybe): Always reparse.
-
- * message.el (message-encode-message-body): Don't insert
- "multipart warning".
-
- * gnus-art.el (gnus-article-treat-head-custom): New variable.
-
-1999-02-25 Miles Bader <miles@ccs.mt.nec.co.jp>
-
- * mail-source.el (mail-source-fetch-pop): Return 1 for success.
-
- * nnmail.el: Require mm-util.
-
-1999-02-26 Justin Sheehy <justin@linus.mitre.org>
-
- * nnmail.el (nnmail-get-new-mail): Only get mail for the one
- group.
-
-1999-02-26 SeokChan LEE <chan@smoky-blue.com>
-
- * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr.
-
-1999-02-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-msg.el (gnus-extended-version): Better regexp.
-
-1999-02-25 Didier Verna <verna@inf.enst.fr>
-
- * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC
- is called with the result of SPLIT and should return a new split.
-
- * gnus.texi: update the doc.
-
-1999-02-23 Didier Verna <verna@inf.enst.fr>
-
- * gnus-picon.el (gnus-picons-display-bar-p): when picons are
- displayed in the article buffer, output bars if
- `gnus-picons-display-article-move-p'.
-
-1999-02-20 Aaron M. Ucko <amu@mit.edu>
-
- * mail-source.el (mail-source-fetch-pop): Typo.
-
-1999-02-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-toggle-header): Save restriction.
-
-1999-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-cite-parse-wrapper): Always parse.
-
-1999-02-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-buffer): New function.
-
- * message.el (message-forward): Insert the buffer in the buffer.
-
-1999-02-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Insert part in narrowed region.
-
-1999-02-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-toggle-header): Save restriction.
-
-1999-02-20 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.77 is released.
-
-1999-02-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-displaying-mime): New variable.
- (article-narrow-to-head): New function.
-
- * mail-source.el (mail-source-fetch-pop): Include pre/postscript.
- Default to pop instead of pop3.
-
-1999-02-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-hide-pgp): Goto body.
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer.
-
- * gnus-cite.el: Don't use goto-line.
-
- * gnus-art.el (gnus-article-treat-html): Removed.
- (gnus-treat-article): Save restriction.
-
-1999-02-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-send-mail): Don't untabify.
- (message-mode): Don't use tabs for indentation.
-
-1999-02-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Don't untabify.
-
- * nnml.el (nnml-save-mail): Typo fix.
-
-1999-02-19 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-cite-function): Add
- `message-cite-original-without-signature' customization option.
-
-1999-02-18 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-fix-eudora-headers): Mark as option to
- `nnmail-prepare-incoming-header-hook'.
-
-1999-02-19 Justin Sheehy <justin@linus.mitre.org>
-
- * gnus-util.el (gnus-make-sort-function-1): Typo fix.
-
-1999-02-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-get-new-news): Require nnmail.
-
-1999-02-18 Michael Cook <cook@sightpath.com>
-
- * Recognize Microsoft Outlook's cite attribution conventions.
-
-1999-02-19 James H. Cloos, Jr. <cloos@jhcloos.com>
-
- * gnus-sum.el: Bind M.
-
-1999-02-19 Neil Crellin <neilc@wallaby.cc>
-
- * mail-source.el (mail-source-fetch-pop): Bind pop3-port.
-
-1999-02-15 Didier Verna <verna@inf.enst.fr>
-
- * gnus-picon.el (gnus-group-display-picons): ensures that
- `article-goto-body' really goes to the article body.
-
-1999-02-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind url-standalone-mode.
-
- * gnus-msg.el (gnus-summary-mail-forward): Create unique names.
-
- * mm-view.el (mm-view-message): Enable multibyte.
-
-1999-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-get-new-mail): Message later.
-
- * mm-util.el (mm-find-charset-region): Revert to checking
- multibyte.
-
-1999-02-11 Matt Pharr <mmp@graphics.stanford.edu>
-
- * gnus-msg.el (gnus-bug): Encode environment info as a MIME
- attachment.
-
-1999-02-11 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.76 is released.
-
-1999-02-06 Felix Lee <flee@cygnus.com>
-
- * gnus.el (gnus-group-change-level-function): Typo.
-
-1999-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-nov-skip-field): Removed.
- (gnus-nov-field): Ditto.
- (gnus-nov-parse-extra): Ditto.
- (gnus-nov-read-integer): Ditto.
-
-1999-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-nov-read-message-id): New macro.
- (nnheader-parse-nov): Use it.
-
- * gnus-sum.el (gnus-nov-read-message-id): New macro.
- (gnus-nov-parse-line): Use it; use `(eobp)' instead of
- `(eq (char-after) ?\n)'.
-
-1999-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-other-frame): Always pop up a new frame.
-
-1999-02-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-range.el (gnus-range-add): Rewrite.
-
-1999-02-02 Carsten Leonhardt <leo@arioch.oche.de>
-
- * nnmail.el (nnmail-split-incoming): Added detection of maildir
- format.
- (nnmail-process-maildir-mail-format): New function.
-
- * mail-source.el (mail-source-fetch-maildir): New function.
- (mail-source-keyword-map): Add default for maildir method.
- (mail-source-fetcher-alist): Changed "qmail" to "maildir".
-
-1999-02-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetcher-alist): Remove apop.
-
- * nndoc.el (nndoc-type-alist): Remove MIME-digest.
- (nndoc-mime-digest-type-p): Removed.
-
-1999-02-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-read-summary-keys): Set the point
- where it is supposed to be.
- (gnus-treat-play-sounds): New variable.
-
- * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable.
-
- * gnus-art.el (article-display-x-face): Narrow to head.
- (gnus-article-washed-types): New variable.
- (article-hide-pgp): Is not a toggle.
- (gnus-article-hide-text-type): Save types.
- (article-decode-charset): Use it.
-
- * nnmail.el (nnmail-get-new-mail): Ignore procmail.
-
- * message.el (message-forward-start-separator): Removed.
- (message-forward-end-separator): Removed.
- (message-signature-before-forwarded-message): Removed.
- (message-included-forward-headers): Removed.
- (message-check-news-body-syntax): Don't check forward.
- (message-forward): Use MIME.
-
- * nnvirtual.el (nnvirtual-request-article): Bind
- gnus-article-decode-hook to nil.
-
-1999-02-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for
- us-ascii.
-
-1999-02-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * format-spec.el (format-spec): Be more robust.
-
- * message.el (message-encode-message-body): Default
- mail-parse-charset to mail-parse-charset.
-
- * gnus-sum.el (gnus-summary-edit-article-done): Don't encode.
- (gnus-summary-edit-article): Bind mail-parse-charset.
-
- * mml.el (mml-read-tag): Ignore white space after end of tag.
-
- * message.el (message-goto-body): Also work in separatorless
- articles.
-
- * mml.el (mml-translate-from-mime): New function.
- (mml-insert-mime): Ditto.
- (mml-to-mime): New function.
- (mime-to-mml): New name.
-
- * gnus-sum.el (gnus-summary-edit-article): Always select raw
- article.
-
- * gnus-group.el (gnus-group-catchup-current): Unmark groups.
-
- * gnus-sum.el (gnus-summary-setup-default-charset): Don't
- special-case nndraft groups.
-
-1999-02-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset.
- (gnus-get-newsgroup-headers): Already bound.
-
- * message.el (message-encode-message-body): Use posting charset.
-
- * mm-bodies.el (mm-encode-body): Use MIME charsets.
- (mm-body-encoding): Do CTE.
- (mm-body-7-or-8): New function.
-
- * mm-util.el (mm-mime-charset): Always fall back on alist.
- (mm-mime-mule-charset-alist): Include katakana-jisx0201.
- (mm-mime-mule-charset-alist): Add arabic-*-column.
- (mm-find-mime-charset-region): New function.
-
- * format-spec.el (format-spec-make): New function.
-
- * mail-source.el (format-spec): Required.
- (mail-source-fetch-with-program): Removed.
- (mail-source-fetch-with-program): New function.
-
- * format-spec.el: New file.
-
-1999-02-03 Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
-
- * mail-source.el (mail-source-fetch-with-program): Take optional
- parameter.
-
-1999-02-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el: Ignore some groups.
- (gnus-setup-news): Bind nnmail-fetched-sources.
-
- * message.el (message-send-mail): Remove all tabs.
-
- * mm-util.el (mm-find-charset-region): Just check whether
- find-charset-region is defined.
-
-1999-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-get-new-news): Use
- nnmail-fetched-sources.
-
- * nnmail.el (nnmail-fetched-sources): New variable.
- (nnmail-get-new-mail): Use it.
-
- * mail-source.el (mail-source-fetched-sources): New variable.
- (mail-source-fetch): Use it.
-
-1999-02-02 Mark W. Eichin <eichin@thok.org>
-
- * gnus.el (gnus-getenv-nntpserver): if the file that
- gnus-nntpserver-file names has a trailing newline, the
- string-match will always match, and thus the file will never be
- read. (^ matches start of "line", \\` matches start of "buffer",
- which is what was intended...)
-
-1999-02-02 Kim-Minh Kaplan <kmkaplan@western.fr>
-
- * gnus-picon.el (gnus-picons-parse-filenames): Quote group names.
-
-1999-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-read-active-file): Eliminate duplicated
- select methods.
-
-1999-01-27 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Sort second argument.
-
-1999-02-02 Scott Hofmann <shofmann@mindspring.com>
-
- * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd.
-
-1999-02-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-parameters): Charset as symbol, and fix
- a typo.
- * gnus-sum.el (gnus-summary-setup-default-charset): Set nndraft's
- charset to nil.
- * gnus-agent.el (gnus-agent-queue-setup): Remove charset setting.
- * gnus-start.el (gnus-start-draft-setup): Ditto.
-
-1999-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-directory): Use the predicate.
- (mail-source-value): Don't do variables.
-
- * nnmail.el (nnmail-get-new-mail): Set the predicate.
-
- * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t.
-
-1999-02-01 Michael Cook <cook@sightpath.com>
-
- * Defenestrate spurious ?a.
-
-1999-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-pop): Instead use
- :authentication.
-
-1999-02-01 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
-
- * lisp/mail-source.el : Support APOP authentication scheme.
-
-1999-02-02 Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
-
- * pop3.el (pop3-movemail): Return t.
-
-1999-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-fold-region): New function.
- (rfc2047-encode-message-header): Use it.
-
-1999-02-02 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * gnus-sum.el (gnus-group-charset-alist): Add more.
-
-1999-02-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.75 is released.
-
-1999-02-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-display-x-face): Don't narrow to head.
-
-1999-02-01 Michael Cook <cook@sightpath.com>
-
- * gnus-cite.el (gnus-cited-lines-visible): Accept a cons.
-
-1999-02-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-directory): Ignore
- directories.
-
- * gnus-cus.el (gnus-group-parameters): Addition.
-
- * gnus-art.el (article-strip-banner): Do symbolic banners.
- (article-strip-banner): New keystroke.
-
-1999-02-01 Michael Cook <cook@sightpath.com>
-
- * gnus-art.el (article-strip-banner): New command.
-
-1999-02-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-strip-banners): New variable.
-
-1999-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-read-passwd): Use `read-passwd' if it
- has been exist.
-
-1999-01-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-draft-coding-system): Check coding-system.
- * mm-util.el (mm-text-coding-system): Ditto.
-
-1999-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-fetch-pop): Save excursion.
-
-1999-01-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-movemail-args): Not constant.
- (mail-source-movemail-args): Removed.
- (mail-source-fetch-with-program): New function.
- (mail-source-fetch-pop): Use program and function.
- (mail-source-movemail-program): Removed.
-
- * gnus-art.el (gnus-treat-date-iso8601): New variable.
- (gnus-treat-date-user-defined): New variable.
-
-1999-01-28 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-fix-eudora-headers): New function.
-
-1999-01-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-encode-body): Use mail-parse-charset.
-
-1999-01-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Do
- gnus-article-add-buttons-to-head later.
- (gnus-treat-capitalize-sentences): New variable.
- (article-capitalize-sentences): New command and keystroke.
-
- * gnus-group.el (gnus-group-catchup-current): Do group.
-
- * message.el (message-default-charset): Add group.
-
-1999-01-27 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.74 is released.
-
-1999-01-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-fill-long-lines): Renamed.
- (article-fill-long-lines): New keystroke.
-
-1999-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-setup-posting-charset): Check for group.
-
- * gnus-group.el (gnus-group-catchup-current): Skip groups now
- displayed.
- (gnus-group-catchup-current): Be more robus.
-
- * gnus-sum.el (gnus-summary-select-article): Reselect for showing
- headers.
-
-1999-01-25 Dave Love <fx@gnu.org>
-
- * message.el (message-mode-menu): Add message-mime-attach-file.
- (message-mode): Doc fix.
-
-1999-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-check-duplication): Insert the mail source
- string.
-
- * mail-source.el (mail-source-fetch-pop): Bind mail-source-string.
- (mail-source-fetch-directory): Ditto.
- (mail-source-fetch-file): Ditto.
- (mail-source-string): New variable.
-
- * gnus-start.el (gnus-get-unread-articles): Nix out groups over
- the level.
-
- * rfc2047.el (rfc2047-encodable-p): Convert to MIME charsets
- before handling.
-
- * mm-util.el (mm-mime-charset): Use the parameters.
- (mm-mime-charset): Removed region paremeters.
-
- * nnmail.el (nnmail-get-new-mail): Don't message the entire
- source.
-
-1999-01-25 Lloyd Zusman <ljz@asfast.com>
-
- * nnmail.el (nnmail-get-split-group): Quote right.
-
-1999-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-movemail): Would kill an arbitrary
- buffer.
-
-1999-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-clear-inboxes-moved): Removed.
- (gnus-group-mode): Don't hook.
-
- * mail-source.el (mail-source-bind): Doc fix.
- (mail-source-bind): Take only one param.
-
- * gnus-art.el (gnus-treat-highlight-signature): typep.
-
- * mail-source.el (mail-source-movemail): Ignore empty file.
- (mail-source-callback): Check before deleting.
-
- * message.el (message-mime-attach-file): Include name.
-
-1999-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-read-charset): Return a symbol.
-
- * mm-view.el (mm-inline-text): Insert signature separator.
-
- * gnus-art.el (gnus-treat-predicate): New function.
- (gnus-treat-article): Allow all types to be checked.
-
- * gnus-util.el (gnus-or): New function.
- (gnus-and): Ditto.
-
- * gnus-art.el (gnus-mime-display-single): Use override.
-
- * mm-decode.el (mm-attachment-override-types): New variable.
- (mm-attachment-override-p): New function.
-
- * gnus-picon.el (gnus-group-display-picons): Don't go backward.
-
-1999-01-23 Andrew J. Cosgriff <ajc@bing.wattle.id.au>
-
- * mm-view.el (mm-inline-text): Do vcards.
-
-1999-01-23 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.73 is released.
-
-1999-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-spool-file): Changed to use mail-source.
- (nnmail-crash-box, nnmail-use-procmail, nnmail-procmail-directory,
- nnmail-procmail-suffix, nnmail-resplit-incoming): Removed.
- (nnmail-movemail-program): Removed.
- (nnmail-movemail-args): Removed.
- (nnmail-pop-password-required): Ditto.
- (nnmail-tmp-directory): Ditto.
- (nnmail-delete-incoming): Removed.
- (nnmail-pop-password, nnmail-moved-inboxes,
- nnmail-internal-password, nnmail-move-inbox): Removed.
- (nnmail-read-passwd): Ditto.
- (nnmail-get-spool-files): Removed.
- (nnmail-resplit-incoming): Reinstated.
-
- * mail-source.el: New file.
-
-1999-01-23 James H. Cloos, Jr. <cloos@jhcloos.com>
-
- * gnus-art.el (gnus-article-mode-map): Bind backspace.
-
-1999-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-make-date-line): Fix iso8601 display.
-
-1999-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-display-smileys): Check xpm.
-
- * gnus-picon.el (gnus-group-display-picons): Goto body.
-
- * gnus.el: Indented all functions; broke long lines; changed all
- instances of illegal/legal to invalid/valid. Yes, I'm bored.
-
-1999-01-20 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.72 is released.
-
-1999-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Cleaned up trailing whitespace.
-
- * mm-util.el (mm-read-charset): Work.
-
-1999-01-17 Matt Armstrong <mattdav+matt@best.com>
-
- * gnus-score.el (gnus-score-find-bnews): Match regexp on the
- nnheader-translate-file-chars'd group name.
-
-1999-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Fold case.
-
-1999-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-add): New function.
-
-1999-01-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-goto-body-goes-to-point-min-p): New variable.
- (article-goto-body): Use it.
- (gnus-treat-article): Ditto.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Remove the
- downloaded articles from the downloadeble list.
-
-1999-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Bind
- mail-parse-charset.
-
- * mm-util.el (mm-charset-synonym-alist): New variable.
- (mm-charset-to-coding-system): Use it.
- (mm-charset-coding-system-alist): Removed.
- (mm-charset-to-coding-system): Don't use it.
- (mm-find-charset-region): Use mail-parse-charset.
-
- * gnus-art.el (gnus-treatment-function-alist): Use
- gnus-article-display-picons.
- (gnus-treat-display-xface): Only do if we have xface feature.
- (gnus-part-display-hook): New function.
- (gnus-treat-article): Use it.
- (gnus-treat-article): Use gnus-visual.
-
- * gnus-msg.el (gnus-setup-posting-charset): Check elem.
-
- * gnus-art.el (gnus-mm-display-part): Fix the MIME button after
- displaying.
-
- * mm-decode.el (mm-insert-part): Use insert-buffer-substring.
-
- * gnus-score.el (gnus-score-find-bnews): Protect against invalid
- regexp file names.
-
-1999-01-16 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.71 is released.
-
-1999-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-image): Don't add a dot.
-
- * gnus-art.el (gnus-treat-article): New function.
-
- * gnus.el (gnus-article-display-hook): Removed.
-
- * gnus-art.el (gnus-article-treat-custom): New variable.
-
- * gnus-start.el (gnus-ignored-newsgroups-has-to-p): Removed.
-
- * gnus-msg.el (gnus-setup-posting-charset): Allow variables and
+ (starttls-program, starttls-extra-args): Doc fix.
+ (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New
functions.
+ (starttls-negotiate, starttls-open-stream): Check
+ `starttls-use-gnutls' and pass on to corresponding *-gnutls
+ function if it is set.
- * message.el (message-posting-charset): New variable.
- (message-send-mail): Use it.
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Moved here.
- (gnus-setup-posting-charset): New function.
- (gnus-setup-message): Use it.
-
- * message.el (message-encode-message-body): Just look for
- Content-Type before inserting a new one.
-
-1999-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-default-charset): Removed.
-
- * mail-prsvr.el: New file.
- (mail-parse-charset): New variable.
-
- * gnus-sum.el (gnus-newsgroup-charset): Changed name.
- Changed name.
-
- * gnus.el (gnus-charset): New group.
-
- * nnmail.el (nnmail-pathname-coding-system): Default to binary.
-
- * gnus-sum.el (gnus-default-charset): Default to nil.
- (gnus-newsgroup-iso-8859-1-forced-regexp): Removed.
- (gnus-newsgroup-iso-8859-1-forced): Removed.
-
- * mm-util.el (mm-known-charsets): Removed.
- (mm-default-coding-system): Removed.
- (mm-default-charset): Removed.
- (mm-read-charset): New function.
-
- * message.el (message-default-charset): Removed.
-
- * rfc2047.el (rfc2047-default-charset): Default to nil.
-
- * mm-util.el (mm-charset-iso-8859-1-forced): Removed.
-
-1999-01-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.70 is released.
-
-1999-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-save-part): Use mm-get-part.
- (mm-insert-part): New function.
- (mm-get-part): Use it.
- (mm-get-image): Ditto.
- (mm-display-external): Ditto.
-
- * mm-view.el (mm-inline-text): Ditto.
-
- * gnus-move.el (gnus-move-group-to-server): Protect against nil
- ranges.
-
- * mm-decode.el (mm-display-external): Save the buffer.
- (mm-remove-part): Kill it.
-
- * qp.el (quoted-printable-decode-region): Do the right thing at eobp.
-
- * nnagent.el (nnagent-request-set-mark): Defined stub.
-
-1999-01-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-load-score-alist): Bind
- coding-system-for-read.
-
- * gnus-sum.el (gnus-summary-exit): Do adaptive scoring before
- prepare-exit-hook.
-
- * mm-view.el (mm-setup-w3): Require w3.
-
-1999-01-13 Kiyokazu SUTO <suto@merry.xmath.ous.ac.jp>
-
- * lisp/nnspool.el (nnspool-retrieve-headers): Protect against empty
- body.
-
-1999-01-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el: Ditto.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Message the
- error.
-
- * mailcap.el (mailcap-mime-data): SAFER ps.
-
- * message.el (message-encode-message-body): Always insert a
- Content-Type header.
-
- * mm-decode.el (mm-inline-media-tests): Default all text/* to be
- shown inline.
-
- * mm-view.el (mm-inline-text): Handle all sorts of text.
-
- * mailcap.el (mailcap-mime-data): non-viewer for viewers that
- don't view.
-
- * mm-decode.el (mm-display-external): Use it.
-
- * gnus-art.el (gnus-visible-headers): Added bcc, gcc, fcc.
-
- * mm-decode.el (mm-save-part): Removed double code.
-
-1999-01-12 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mm-save-part): Avoid doubly-compressed
- application/octet-stream .gz & al files with jka-compr.
-
-1999-01-12 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-down-mouse-3): New variable.
- * gnus-art.el (gnus-mime-button-map): Use it.
- (gnus-mime-button-menu): Set the clicked-on buffer initially.
-
-1999-01-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-data): Added ImageMagic and ee.
-
-1999-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-kill-buffer): Don't kill article
- buffers.
-
- * gnus-sum.el (gnus-summary-exit): Destroy all MIME.
-
- * gnus-cache.el (gnus-cache-read-active): Reversed check.
-
-1999-01-12 Matt Armstrong <matta@geoworks.com>
-
- * mml.el (mml-parameter-string): Strip directory component.
-
-1999-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-use-demon): Removed.
-
-1999-01-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmail.el (nnmail-article-group): Don't infloop.
-
-1999-01-11 Colin Rafferty <colin@xemacs.org>
-
- * gnus-art.el (article-update-date-lapsed): Made it work with
- picons, and make it update on all visible frames.
- (article-date-ut): Get summary-buffer's current-headers.
-
-1999-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-setup-buffer): Don't set major mode.
- (gnus-picons-setup-p): New variable.
-
-1999-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-split-header-length-limit): Lowered to 512.
-
-1999-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit-no-update): Don't use run-hooks.
- (gnus-summary-exit-no-update): Use mapcar.
-
-1999-01-02 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-category-write): Make directory.
-
-1998-09-26 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-read-articles):
- (gnus-update-marks): Request backend update of mark.
-
-1999-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-body-encoding): Use mm-find.
-
-1999-01-03 Kim-Minh Kaplan <kmkaplan@western.fr>
-
- * gnus-picon.el (gnus-article-display-picons): Fix.
-
-1999-01-03 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.69 is released.
-
-1999-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-setup-buffer): Run the hook.
-
- * gnus-agent.el (gnus-agent-remove-group): New command and
- keystroke.
-
- * rfc2047.el (rfc2047-decode-region): Check for us-ascii.
-
-1999-01-02 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-agent-write-servers): Make directory.
-
-1998-12-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind current id.
-
- * mm-decode.el (mm-handle-id): New macro.
- (mm-make-handle): Accept id.
- (mm-dissect-singlepart): Use it.
-
-1998-12-23 Matt Pharr <mmp@graphics.stanford.edu>
-
- * message.el (message-cite-original-without-signature): Use
- message-signature-separator when searching for signature in
- message-cite-original-without-signature.
-
-1998-12-24 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-server-to-method): Check named methods.
-
-1998-12-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-view-message): Goto point-min.
-
- * nnmail.el (nnmail-article-group): Don't delete lines, only
- shorten them.
-
- * gnus-msg.el (gnus-configure-posting-styles): Also do nil
- values.
-
- * nnheader.el (nnheader-temp-directory): New variable.
- (nnheader-temp-directory): Removed.
-
-1998-12-22 Jack Vinson <jvinson@chevax.ecs.umass.edu>
-
- * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the
- list of files to check for mailcap entries under windows-nt.
-
-1998-12-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the
- summary buffer exists.
-
-1998-12-22 Aaron M. Ucko <amu@mit.edu>
-
- * nnsoup.el (nnsoup-store-reply): Remove code to deal with
- irrelevant Sun sendmail bug.
- (nnsoup-store-reply): Stop mucking with mail-header-separator.
-
- * message.el (message-send-news): Bind mail-header-separator to
- "" when asking backend to post.
-
-1998-12-22 Karl Kleinpaste <karl@justresearch.com>
-
- * mm-uu.el (mm-dissect-disposition): New variable.
- (mm-uu-dissect): Use it.
-
-1998-12-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind url-current-object.
-
-1998-12-06 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Rewrite.
-
-1998-12-09 SL Baur <steve@altair.xemacs.org>
-
- * gnus-picon.el (annotations): Remove bogus require 'xpm.
-
-1998-12-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-encode-message-body): Insert `MIME-Version'
- instead of `Mime-Version'.
-
-1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-insert-mime-part): Add the attachment
- disposition.
- (message-insert-mime-part): Make TYPE and DESCRIPTION optional.
- (message-mime-query-type): New function.
- (message-mime-query-description): Ditto.
- (message-mime-query-file): Ditto.
- (message-insert-mime-part): Use them.
- (message-mime-insert-external): Use the new stuff.
-
-1998-12-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-split-header-length-limit): New variable.
-
- * mm-decode.el (mm-dissect-buffer): Check syntax.
-
- * rfc2231.el (rfc2231-parse-string): Remove check for syntax.
-
- * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region.
- (rfc2047-dissect-region): Ditto.
-
-1998-12-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-view-message): Decode charset.
-
-1998-12-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid
- CT headers.
-
-1998-12-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Use
- mm-uu-*-function.
- * mm-uu.el (mm-uu-dissect): Use x-uuencode.
-
-1998-12-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Do MML first.
- (message-send-news): Ditto.
-
-1998-12-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-face): New face.
- (gnus-picons-try-face): Use it.
-
-1998-12-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.68 is released.
-
-1998-12-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.67 is released.
-
-1998-12-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.66 is released.
-
-1998-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-insert-mime-button): Decode description.
-
-1998-12-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-encoded-words): Rollback to 0.55.
- (gnus-decode-header-methods): Ditto.
- (gnus-decode-with-mail-decode-encoded-word-region): Ditto.
-
-1998-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-mime-headers): Encode description.
-
- * nnfolder.el (nnfolder-request-expire-articles): Go to the date
- line.
-
- * gnus-sum.el (gnus-default-charset): Doc fix.
-
-1998-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-part): Forward a line.
-
-1998-12-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-running-ntemacs): New variable.
- (mm-text-coding-system): Ditto.
- * nnmail.el (nnmail-incoming-coding-system): Ditto.
- (nnmail-split-incoming): Use nnmail-incoming-coding-system.
-
-1998-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-network-display-internal): Don't set
- buffer.
-
- * message.el (message-insert-headers): New command and keystroke.
-
-1998-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): Recognize x-xbitmap.
- (mm-get-image): Ditto.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Only for
- base64, uudecode and binhex.
-
-1998-12-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF
- in text/plain.
- * mm-uu.el (mm-uu-dissect): Use inline.
-
-1998-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-view-message): New function.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Changed to
- qp.
-
-1998-12-07 Karl Kleinpaste <karl@justresearch.com>
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Add an
- entry for message/rfc822 as 8bit.
-
-1998-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-extensions): Add patch.
-
-1998-12-05 Dale Hagglund <rdh@best.com>
-
- * gnus-sum.el (gnus-summary-display-buttonized): Use prefix
- argument to force all multipart/* to look like multipart/mixed.
-
- * gnus-art.el (gnus-mime-display-multipart-as-mixed): New
- variable.
- (gnus-mime-display-part): Use it.
-
-1998-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (gnus-draft-send): Only disable checks for
- non-interactive use.
- (gnus-draft-send-message): Use it.
-
-1998-12-06 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.65 is released.
-
-1998-12-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-prepare-display): Don't init w3.
-
- * mm-view.el (mm-inline-text): Bind url-standalone-mode here.
-
-1998-12-05 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.64 is released.
-
-1998-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-setup-w3): Don't load.
-
- * gnus-msg.el (gnus-setup-message): Set group name.
- (gnus-group-mail): Avoid leaking local vars.
-
- * message.el (message-attach-file): Renamed.
- (message-mime-attach-file): Renamed again.
-
-1998-12-05 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (article-decode-encoded-words): Bind
- rfc2047-default-charset here.
-
- * gnus-art.el (gnus-insert-mime-button): Nix slashes in file name.
-
-1998-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-setup-buffer): Run picons hook.
- (gnus-picons-setup-hook): New hook.
-
-1998-12-05 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mailcap.el (mailcap-mime-data): Remove "*" from documentation
- string.
- (mailcap-mime-extensions): Ditto. Made first sentense fit a
- line.
-
-1998-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-prepare-display): Setup w3.
- (gnus-mime-view-part): Ditto.
- (gnus-mime-inline-part): Dotii.
- (gnus-mime-externalize-part): Daddo.
- (gnus-mime-internalize-part): Tutti frutti.
- (gnus-widget-press-button): Da da do.
-
- * mm-view.el (mm-setup-w3): Require url-vars.
-
-1998-12-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-draft-coding-system): Fix for XEmacs-NT.
- * mm-util.el (mm-find-charset-region): Ditto.
-
-1998-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send): Don't encode here.
- (message-send-mail): But here.
- (message-send-news): And here.
-
-1998-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-message-insert-stylings): Don't insert twice.
-
-1998-12-04 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.63 is released.
-
-1998-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-base-boundary): Shorten.
-
- * message.el (message-insert-mime-part): Use default.
-
- * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long.
-
-1998-12-03 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio
- buttons, not [*].
-
-1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-insert-mime-button): Do proper help-echo.
-
-1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-insert-mime-button): Fix.
-
-1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-insert-mime-part): Nicify prompts.
- (message-insert-mime-part): Really delete duplicates.
- (message-insert-mime-part): Check against common errors.
- (message-insert-mime-part): Fix docstring.
-
-1998-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-internalize-part): Bugged out.
-
-1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-mime-button-line-format): Nicify.
- (gnus-insert-mime-button): Modify accordingly.
-
-1998-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-display-mime): Set window point.
-
- * mm-decode.el (mm-display-external): Only decode when not
- saving.
- (mm-alternative-precedence): Prefer multiparts.
- (mm-inline-media-tests): Inline multiparts.
-
- * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked.
- Ignore errors when requiring url.
-
- * mml.el (mml-quote-region): New command.
-
- * message.el (message-cite-original): Use it.
- (message-cite-original-without-signature): Ditto.
-
-1998-12-03 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.62 is released.
-
-1998-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-all-parts): Work with multiparts.
+2004-08-31 Simon Josefsson <jas@extundo.com>
-1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
+ * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for
+ ?* and ?\; (tiny patch). From Andreas Schwab <schwab@suse.de>.
- * mm-view.el (mm-inline-text): Use `point-min-marker' and
- `point-max-marker'.
+ * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\;
+ and ?\' to symbol instead of whitespace (tiny patch). From
+ Andreas Schwab <schwab@suse.de>.
-1998-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+2004-08-31 Jesper Harder <harder@ifa.au.dk>
- * mailcap.el (mailcap-mime-extensions): Use image/xpm for xpms.
+ * message.el (message-idna-to-ascii-rhs-1): Don't choke on
+ invalid addresses.
- * gnus-art.el (gnus-mime-display-single): Check for attachment
- before other tests.
+2004-08-31 Reiner Steib <Reiner.Steib@gmx.de>
-1998-12-03 Didier Verna <verna@inf.enst.fr>
+ * message.el (message-idna-to-ascii-rhs-1): Fix typo.
- * gnus-msg.el (gnus-configure-posting-styles): find a
- posting-style entry in the group parameters, if any, and honor it
- at the end.
+2004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-1998-12-03 Felix Lee <flee@teleport.com>
+ * message.el (message-idna-to-ascii-rhs-1): Don't use equalp.
- * nntp.el (nntp-after-change-function): Fix.
+2004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-1998-12-03 Mike McEwan <mike@lotusland.demon.co.uk>
+ * gnus-art.el (article-decode-idna-rhs): Don't use
+ message-idna-inside-rhs-p.
- * mml.el (mml-generate-mime-1): Insert literally.
+2004-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-1998-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * message.el (message-idna-inside-rhs-p): Removed.
+ (message-idna-to-ascii-rhs-1): Use proper address parsing.
- * mml.el (mml-insert-mime-headers): Removed debug.
+2004-08-31 Katsumi Yamaoka <yamaoka@jpl.org>
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
- * gnus-sum.el (gnus-summary-show-article): Destroy parts when
- prefixed.
+ * gnus-sum.el (gnus-newsgroup-variables): Doc fix (tiny change).
+ From Helmut Waitzmann <Helmut.Waitzmann@web.de>.
- * mm-encode.el (mm-content-transfer-encoding-defaults): Default
- application/emacs-lisp to 8bit.
+ * gnus-agent.el (gnus-agent-regenerate-group): Activate the group
+ when the group's active is not available.
-1998-12-03 Dale Hagglund <rdh@best.com>
+ * gnus-art.el (article-hide-headers): Refer to the values for
+ gnus-ignored-headers and gnus-visible-headers in the summary
+ buffer since a user may have set them as group parameters.
+ (gnus-article-next-page): Fix the way to find a real end-of-buffer
+ (tiny change). From YAGI Tatsuya <ynyaaa@ybb.ne.jp>.
+ (gnus-article-read-summary-keys): Restore new window-start and
+ hscroll to summary window.
+ (gnus-prev-page-map): Remove duplicated one.
- * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'.
+ * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option.
+ (gnus-cite-parse): Ignore quoted envelope From_. Suggested by
+ Karl Chen <quarl@nospam.quarl.org> and Reiner Steib
+ <Reiner.Steib@gmx.de>.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace
+ pp-to-string with gnus-pp-to-string.
- * gnus.el: Pterodactyl Gnus v0.61 is released.
+ * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-group.el (gnus-group-make-kiboze-group): Replace pp with
+ gnus-pp.
- * mml.el (mml-parse-1): Skipped parts.
- (mml-insert-mime-headers): Nil is a list.
- (mml-generate-mime-1): Don't insert literally.
- (mml-read-tag): Drop text props.
- (mml-read-part): Ditto.
- (mml-parse-singlepart-with-multiple-charsets): Ditto.
+ * gnus-msg.el (gnus-setup-message): Ignore an article copy while
+ parsing gnus-posting-styles when the message is not for replying.
+ (gnus-summary-resend-message-edit): Call mime-to-mml. Suggested
+ by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
+ (gnus-debug): Replace pp with gnus-pp.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * gnus-score.el (gnus-score-save): Replace pp with gnus-pp.
- * gnus.el: Pterodactyl Gnus v0.60 is released.
+ * gnus-spec.el (gnus-update-format): Replace pp-to-string with
+ gnus-pp-to-string.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-sum.el (gnus-read-header): Don't remove a header for the
+ parent article of a sparse article in the thread hashtb. From
+ Stefan Wiens <s.wi@gmx.net>.
- * mml.el (mml-parse-1): Don't throw contents away.
+ * gnus-util.el (gnus-bind-print-variables): New macro.
+ (gnus-prin1): Use it.
+ (gnus-prin1-to-string): Use it.
+ (gnus-pp): New function.
+ (gnus-pp-to-string): New function.
-1998-12-02 Hrvoje Niksic <hniksic@srce.hr>
+ * gnus.el: Don't make unnecessary *Group* buffer when loading.
- * mml.el (mml-compute-boundary-1): Regexp-quote the boundary.
+ * mail-source.el (mail-source-touch-pop): Doc fix.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * message.el (message-mode): Don't modify paragraph-separate there.
+ (message-setup-fill-variables): Add mml tags to paragraph-start
+ and paragraph-separate. Suggested by Andrew Korty <ajk@iu.edu>.
+ (message-smtpmail-send-it): Doc fix.
+ (message-exchange-point-and-mark): Don't activate region if it was
+ inactive. Suggested by Hiroshi Fujishima
+ <pooh@nature.tsukuba.ac.jp> and Jesper Harder <harder@ifa.au.dk>.
- * mml.el (mml-parse-singlepart-with-multiple-charsets): New
- function.
- (mml-parse-1): Use it.
+ * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to
+ t while entering a file name using the mm-with-multibyte macro.
+ Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
-1998-12-01 Shenghuo ZHU <zsh@cs.rochester.edu>
+ * mm-encode.el (mm-content-transfer-encoding-defaults): Use
+ qp-or-base64 for the application/* types.
+ (mm-safer-encoding): Consider 7bit is safe.
- * gnus-art.el (gnus-decode-with-mail-decode-encoded-word-region):
- Use gnus-newsgroup-default-charset.
- (article-decode-encoded-words): Remove charset codes.
- * gnus-sum.el (gnus-newsgroup-default-charset): Use
- gnus-default-charset.
+ * mm-util.el (mm-with-multibyte-buffer): New macro.
+ (mm-with-multibyte): New macro.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * mm-view.el (mm-inline-render-with-function): Use multibyte
+ buffer; decode html source by charset.
- * message.el (message-send-mail): Don't encode here.
- (message-send-news): Nor here.
- (message-send): ... but here instead.
+ * nndoc.el (nndoc-type-alist): Improve regexp for article-begin,
+ add generate-head-function and generate-article-function to the
+ rfc822-forward entry.
+ (nndoc-forward-type-p): Recognize envelope From_.
+ (nndoc-rfc822-forward-generate-article): New function.
+ (nndoc-rfc822-forward-generate-head): New function.
- * gnus-picon.el (gnus-picons-display-article-move-p): Changed
- default to nil.
- (gnus-article-display-picons): Replace From line.
- (gnus-group-display-picons): Replace Newsgroups line.
- (gnus-picons-display-glyph): Set baseline.
- (gnus-group-display-picons): Piconize the entire Newsgroups line.
- (gnus-picons-xbm-face): Revert to old, standard colors.
+ From David Hedbor <dhedbor@real.com>.
+ * nnmail.el (nnmail-split-lowercase-expanded): New user option.
+ (nnmail-expand-newtext): Lowercase expanded entries if
+ nnmail-split-lowercase-expanded is non-nil.
- * message.el (message-fetch-field): Remove text props.
+ * score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp.
- * gnus-art.el (gnus-article-normalized-header-length): New
- variable.
- (article-normalize-headers): New command and keystroke.
+ * webmail.el (webmail-debug): Replace pp with gnus-pp.
- * gnus-picon.el (gnus-picons-xbm-face): Changed colors.
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Bind
+ w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; use
+ w3m-minor-mode-map instead of mm-w3m-local-map-property.
+ (gnus-mime-save-part-and-strip): Use mm-complicated-handles
+ instead of mm-multiple-handles.
+ (gnus-mime-delete-part): Ditto.
-1998-12-02 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * mm-decode.el (mm-multiple-handles): Recognize a string as a mime
+ handle, as well as a list.
+ (mm-complicated-handles): Former definition of mm-multiple-handles.
+
+ * mm-view.el (mm-w3m-mode-map): Remove.
+ (mm-w3m-local-map-property): Remove.
+ (mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by
+ ARISAWA Akihiro <ari@mbf.sphere.ne.jp>.
+ (mm-w3m-cid-retrieve): Simplify.
+ (mm-inline-text-html-render-with-w3m): Decode html source by
+ charset; check META tags only when charsets are not specified in
+ headers; specify charset to w3m-region; use w3m-minor-mode-map
+ instead of mm-w3m-local-map-property.
- * gnus.el: Pterodactyl Gnus v0.59 is released.
+2004-08-30 Juanma Barranquero <lektu@terra.es>
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-mime-headers): Beep at multiple charsets.
-
- * gnus-art.el (gnus-mime-copy-part): Set buffer-file-name.
-
-1998-11-30 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-generate-mime-1): Handle unquoting end-tags.
-
-1998-12-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-all-images-fit): New variable.
- (mm-image-fit-p): Use it.
-
- * gnus-art.el (gnus-mime-display-single): Use it.
- (gnus-mime-internalize-part): New command and keystroke.
-
- * mm-decode.el (mm-user-automatic-external-display): New
- variable.
- (mm-automatic-external-display-p): New function.
-
- * gnus-picon.el (gnus-picons-xbm-face): Default to sensible
- colors.
-
-1998-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-repair-multipart): Reselect article.
-
- * gnus-art.el (gnus-with-article): Work in the original article
- buffer.
- (gnus-with-article): Work in read-only groups.
-
-1998-12-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-string): Return original string if not
- decode.
-
-1998-11-30 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Use mm-make-handle.
-
-1998-12-01 Francois Pinard <pinard@iro.umontreal.ca>
-
- * nndoc.el (nndoc-mime-parts-type-p): Do related.
-
-1998-12-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.58 is released.
-
-1998-11-30 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-decode.el (mm-get-image): Return a glyph, not an image
- specifier.
-
-1998-11-29 Hrvoje Niksic <hniksic@srce.hr>
-
- * rfc2047.el (rfc2047-decode): Bind mm-default-charset.
-
-1998-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-parse.el (rfc2045): Required.
-
-1998-12-01 William M. Perry <wmperry@aventail.com>
-
- * mm-view.el (mm-inline-text): Remove props.
-
-1998-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-setup-w3): Protect url-misc.
-
- * message.el (message-ignored-resent-headers): Remove
- Gnus-Warning.
-
- * mml.el (mml-insert-mime-headers): Use encoding.
- (mml-parameter-string): Ditto.
-
- * rfc2045.el: New file.
- (rfc2045-encode-string): New function.
-
-1998-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-parse.el (mail-header-encode-parameter): New function.
-
- * rfc2231.el (rfc2231-encode-string): New function.
-
-1998-11-30 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-string): New function.
- * mm-view.el (mm-inline-text): Use mm-decode-string.
-
-1998-11-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.57 is released.
-
-1998-11-23 Felix Lee <flee@cygnus.com>
-
- * nntp.el (nntp-async-needs-kluge): new setting.
- (nntp-async-timer): new var.
- (nntp-async-process-list): new var.
- (nntp-async-kluge): new function.
- (nntp-async-timer-handler): new function.
- (nntp-async-wait): new function.
- (nntp-async-stop): new function.
- (nntp-after-change-function): renamed, and split apart.
- (nntp-async-trigger): new function.
- (nntp-do-callback): new function.
- (nntp-accept-process-output): add optional timeout arg.
-
- * gnus-async.el (gnus-async-request-fetched-article): fixed.
- (gnus-async-wait-for-article): new function.
- (gnus-async-with-semaphore): s/asynch/async/.
-
-1998-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-with-article): Don't encode.
- (gnus-insert-mime-button): Fall back on filename from C-D.
- (gnus-mime-display-single): Have dots right on text/plain
- attachments.
-
- * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in
- broken parts.
-
- * gnus-art.el (gnus-with-article): Flush cache and backlog.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Also do
- binhex.
-
- * gnus-sum.el (gnus-summary-reparent-thread): Use new macro.
- (gnus-summary-repair-multipart): New command and keystroke.
-
- * gnus-art.el (gnus-with-article-buffer): New macro.
-
-1998-11-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Do not get part when
- undisplay the part.
-
-1998-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-make-sort-function-1): Allow lambdas.
-
- * mml.el (mml-read-part): Partition right.
-
- * mm-decode.el (mm-handle-set-cache): New macro.
- (mm-handle-cache): Ditto.
- (mm-make-handle): Ditto.
- (mm-dissect-singlepart): Use it.
- (mm-get-image): Use the cache.
-
-1998-11-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-mixed): Rewrite.
- (gnus-mime-display-single): Don't insert lines between parts.
-
-1998-11-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-file-coding-system-1): New variable.
- * nnfolder.el (nnfolder-file-coding-system): Ditto.
- (nnfolder-read-folder): Use nnfolder-file-coding-system.
- * nnml.el (nnml-file-coding-system): New variable.
- (nnml-request-article): Use nnml-file-coding-system.
-
-1998-11-29 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.56 is released.
-
-1998-11-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-part): New function.
- (gnus-mime-display-mixed): Use it.
-
- * mm-view.el (mm-setup-w3): Don't register.
-
- * message.el (message-cite-original): Cite parts.
-
-1998-11-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parameter-string): New function.
- (mml-insert-mime-headers): Separated into new function.
-
-1998-11-28 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-make-boundary): Use `make-string'.
-
-1998-11-27 Hrvoje Niksic <hniksic@srce.hr>
-
- * binhex.el (binhex-insert-char): Ditto.
-
- * uudecode.el (uudecode-insert-char): Code correctly.
-
-1998-11-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime): Don't generate multiparts for
- empties.
-
- * gnus-art.el (gnus-display-mime): Save excursion.
-
- * message.el (message-remove-first-header): New function.
- (message-encode-message-body): Use it.
-
-1998-11-27 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.55 is released.
-
-1998-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-setup-w3): New function.
-
- * mm-decode.el (mm-content-id-get-contents): New function.
- (mm-content-id-get-type): Ditto.
- (mm-content-id-get-encoding): Ditto.
- (mm-get-handle-by-content-id): Removed.
-
-1998-11-25 Colin Rafferty <colin@xemacs.org>
-
- * message.el (message-generate-new-buffers): Fix tag.
-
-1998-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-buffer-name): Check for unique first.
-
- * gnus-art.el (gnus-unbuttonized-mime-type-p): use
- gnus-inhibit-mime-unbuttonizing.
-
- * gnus-sum.el (t): Bind M-t.
- (gnus-inhibit-unbuttonizing): New variable.
- (gnus-summary-toggle-display-buttonized): New command.
-
- * gnus-art.el (gnus-display-mime): Select article window.
- (article-strip-trailing-space): New command and keystroke.
-
- * nneething.el (nneething-include-files): New variable.
- (nneething-create-mapping): Use it.
-
- * nntp.el (nntp-possibly-change-group): Use nntp-send-command.
-
- * nnvirtual.el (nnvirtual-request-update-mark): Only yodate
- ayto-expirable marks.
-
-1998-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-all-parts): Set buffer.
-
- * gnus-sum.el (gnus-summary-display-buttonized): Don't pass on
- ARG.
-
- * gnus-art.el (gnus-article-mode-line-format): Doc fix.
-
-1998-11-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-binary-coding-system): New variable.
- (mm-with-unibyte-buffer): Use mm-binary-coding-system.
- * mm-decode.el (mm-display-external): Ditto.
-
-1998-11-24 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.54 is released.
-
-1998-11-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj.
-
-1998-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-save-part): Unquote.
-
-1998-11-24 Matt Armstrong <matta@geoworks.com>
-
- * mm-decode.el (mm-save-part): Bind coding system for write.
-
-1998-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode-line-format): New default.
- (gnus-article-mime-part-status): New function.
-
- * message.el (message-send-news): Check the body syntax before
- encoding.
-
- * gnus-art.el (gnus-unbuttonized-mime-type): New function.
- (gnus-mime-display-single): Use it.
- (gnus-mime-display-alternative): Ditto.
-
- * mm-decode.el: Check for whether we are running under a term.
-
-1998-11-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-preferred-alternative): Default to first
- alternative.
- (mm-preferred-alternative): No, we dont.
-
-1998-11-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Use binary instead of
- no-conversion.
- * gnus-agent.el (gnus-agent-file-coding-system): Ditto.
- * nnheader.el (nnheader-file-coding-system): Ditto.
- * mm-util.el (mm-with-unibyte-buffer): Use binary instead of nil.
-
-1998-11-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-setup-default-charset): Use group
- name without method.
-
-1998-11-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-default-charset): Rename
- coding-system -> default-charset.
- (gnus-newsgroup-default-charset-alist): Ditto.
- (gnus-summary-local-variables): Ditto.
- (gnus-set-global-variables): Ditto.
- (gnus-get-newsgroup-headers): Ditto.
- (gnus-summary-from-or-to-or-newsgroups): Ditto.
- (gnus-get-newsgroup-headers-xover): Ditto.
- (gnus-newsgroup-setup-default-charset): Ditto.
- (article-decode-mime-words): Ditto.
- (article-decode-charset): Ditto.
- (article-decode-encoded-words): Ditto.
- (article-de-quoted-unreadable): Ditto.
- (gnus-mime-view-all-parts): Ditto.
- (gnus-mime-externalize-part): Ditto.
- (gnus-mm-display-part): Ditto.
- (gnus-mime-display-single): Ditto.
- (gnus-mime-display-alternative): Ditto.
-
-1998-11-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-decode-region): Do not decode nil charset.
- * gnus-art.el (article-decode-charset): Overlay
- rfc2047-default-charset.
- * message.el (message-draft-coding-system): New variable.
- (message-set-auto-save-file-name): Use message-draft-coding-system.
- * nndraft.el (nndraft-request-article): Ditto.
- * gnus-start.el (gnus-start-draft-setup): Set charset nil.
- * gnus-agent.el (gnus-agent-queue-setup): Ditto.
-
-1998-11-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-test): New function.
- (mm-uu-dissect): Inherit charset and cte from head.
- * gnus-art.el (article-decode-charset): Use mm-uu-test.
-
-1998-11-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.53 is released.
-
-1998-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-get-image): New function.
- (mm-image-fit-p): New function.
-
- * gnus-util.el (gnus-annotation-in-region-p): New definition.
-
- * gnus-art.el (gnus-article-insert-newline): New function.
- (article-goto-body): New function.
-
-1998-11-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-single): Insert blank line before
- buttons.
-
- * gnus-sum.el (gnus-summary-display-buttonized): New command and
- keystroke.
-
- * gnus-art.el (gnus-mime-display-single): Don't insert a blank
- line between parts.
-
- * message.el (message-remove-header): Go to end if wanted.
-
-1998-11-20 Karl Kleinpaste <karl@justresearch.com>
-
- * gnus-art.el (gnus-mime-display-alternative): Avoid window
- movement with save-window-excursion.
-
-1998-11-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Use argument as charset.
-
-1998-11-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-body): Remove buffer-file-coding-system.
-
-1998-11-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use
- gnus-newsgroup-coding-system.
- (gnus-get-newsgroup-headers): Ditto.
- (gnus-get-newsgroup-headers-xover): Ditto.
- (gnus-set-global-variables): Ditto.
- * gnus-art.el (article-decode-mime-words): Ditto.
- (article-decode-charset): Ditto.
- (article-decode-encoded-words): Ditto.
- (article-de-quoted-unreadable): Ditto.
- (gnus-mime-view-all-parts): Ditto.
- (gnus-mime-externalize-part): Ditto.
- (gnus-mm-display-part): Ditto.
- (gnus-mime-display-alternative): Ditto.
- (gnus-mime-display-single): Ditto.
- * mm-view.el (mm-inline-text): Use default coding system.
-
-1998-11-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-coding-system-alist): New variable.
- (gnus-newsgroup-iso-8859-1-forced-regexp): New variable.
- (gnus-newsgroup-coding-system): New local variable.
- (gnus-newsgroup-iso-8859-1-forced): New local variable.
- (gnus-summary-local-variables): Add two new local variables.
- (gnus-newsgroup-setup-coding-system): New function.
- (gnus-select-newsgroup): Setup coding system.
- * mm-util.el (mm-charset-iso-8859-1-forced): New variable.
- (mm-charset-to-coding-system): Use mm-charset-iso-8859-1-forced.
- * gnus-cus.el (gnus-group-parameters): Customizable
- iso-8859-1-forced.
-
-1998-11-20 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.52 is released.
-
-1998-11-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode the default
- encoding.
-
- * gnus-art.el (gnus-mime-display-single): Insert buttons for
- undisplayed text types.
-
- * mm-decode.el (mm-automatic-display-p): Only prefer inlinable
- types.
-
-1998-11-19 Felix Lee <flee@cygnus.com>
-
- * nntp.el (nntp-after-change-function-callback): recover from C-g.
-
-1998-11-19 Felix Lee <flee@cygnus.com>
-
- * gnus-async.el (gnus-asynch-obarray): rename to
- gnus-async-hashtb, and don't buffer-local it.
-
- (gnus-async-article-callback): new function.
- (gnus-make-async-article-function): use it.
-
- (gnus-async-current-prefetch-group): new var.
- (gnus-async-current-prefetch-article): new var.
- (gnus-async-request-fetched-article): are we fetching it already?
-
- (gnus-async-delete-prefected-entry): s/prefected/prefetched/
-
-1998-11-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-show-article): Require.
-
- * message.el: Provide before hooks.
- (message-send-news): Do MIME before headers.
-
- * gnus-art.el (gnus-article-check-buffer): New function.
- (gnus-article-read-summary-keys): Use it.
-
- * mm-decode.el (mm-user-automatic-display): Display all inline
- images.
-
- * gnus-art.el (gnus-mime-display-single): Don't buttonize so
- much.
- (gnus-unbuttonized-mime-types): New variable.
-
-1998-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t.
-
- * mm-decode.el (mm-quote-arg): Quote semicolons.
-
- * gnus-art.el (gnus-mime-display-single): Don't display
- attachments.
- (gnus-mime-externalize-part): New command and keystroke.
-
- * mm-decode.el (mm-dissect-buffer): Pass on the description info.
- (mm-alternative-precedence): Changed order.
-
-1998-11-07 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-method-simplify): New function.
- (gnus-native-method-p): New function.
- (gnus-secondary-method-p): Use gnus-method-equal.
-
- * gnus-start.el (gnus-group-change-level): Shorten select method.
-
-1998-11-19 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.51 is released.
-
-1998-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Applied patches from 5.6.45.
-
- * gnus-score.el (gnus-score-find-trace): Print complete file
- paths.
- (gnus-score-find-trace): Truncate lines.
-
- * gnus.el (gnus-message-archive-group): Allow function.
-
- * message.el (message-encode-message-body): Remove Mime-Version
- before inserting.
-
- * gnus-cus.el (gnus-group-customize): Optional topic.
-
- * gnus-sum.el (gnus-summary-customize-parameters): New command and
- keystroke.
-
-1998-11-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-encode-message-body): Rewrite.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-base-boundary): New variable.
- (mml-make-boundary): New function.
-
- * gnus-cache.el (gnus-cache-coding-system): New variable.
- (gnus-cache-request-article): Use it.
-
- * message.el (message-insert-mime-part): Delete duplicates.
-
-1998-11-18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-alternative): Set end of
- multipart and display even when nothing is preferred.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.50 is released.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): Check that device-type is
- fbound.
-
- * gnus-sum.el (gnus-summary-sort): Didn't do reverse.
-
-1998-11-07 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-similar-server-opened): Compare backend.
-
-1998-11-08 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-topic.el (gnus-topic-expire-articles): New function.
- (gnus-topic-mode-map): Bind it.
-
- * gnus.texi (Topic Commands): New expiry command. Reordered.
-
-1998-11-10 Miles Bader <miles@ccs.mt.nec.co.jp>
-
- * gnus-sum.el
- (gnus-auto-expirable-marks): New variable.
- (gnus-inhibit-user-auto-expire): New variable.
- (gnus-summary-mark-article-as-read, gnus-summary-mark-article):
- When looking to see if we should expire instead, check
- gnus-auto-expirable-marks instead of using a hard-wired list.
- (gnus-summary-mark-as-read-forward,
- gnus-summary-mark-as-read-backward):
- Pass gnus-inhibit-user-auto-expire for the no-expire argument to
- gnus-summary-mark-forward, instead of `t'.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-compute-boundary): New function.
- (mml-compute-boundary-1): New function.
- (mml-generate-mime-1): Use it.
-
-1998-11-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-generate-mime-1): Always precede closing boundary
- with newline.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Do right boundaries when several
- multiparts.
-
- * mm-decode.el (mm-user-automatic-display): Default to inline
- jpeg.
-
- * mml.el (mml-generate-mime-1): Encode non-text parts.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.49 is released.
-
-1998-11-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Require w3-vars.
-
- * gnus-setup.el (gnus-use-tm): Removed.
-
- * gnus-art.el (gnus-article-goto-part): Don't beep.
- (gnus-article-view-part): Check return value.
- (gnus-mime-display-alternative): Don't display when there is
- nothing to display.
-
- * mml.el (mml-generate-mime-1): Don't use a unibyte buffer.
- (mml-generate-mime-1): Use unibyte for binaries.
-
- * gnus-art.el (gnus-display-mime): Call
- gnus-article-mime-part-function.
- (gnus-mime-part-function): New function.
- (gnus-article-mime-part-function): New function.
-
- * mml.el (mml-generate-mime-1): Don't insert so many newlines.
-
-1998-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Do it in unibyte buffers.
-
- * message.el (message-font-lock-keywords): Highlight MML.
- (message-mml-face): New font.
-
-1998-11-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Clean up even when no handles.
- (gnus-mm-display-part): Do not select-window if the article window
- is not found.
-
-1998-11-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m.
-
-1998-11-16 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.48 is released.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-encode-body): Disbabled for nonmule.
-
- * mm-util.el (mm-find-charset-region): Bogus change for non-Mule.
-
- * message.el (message-cite-original-without-signature): Ditto.
- (message-cite-original): Quote parts.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.47 is released.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Insert MIME warning.
-
- * mml.el (mml-read-tag): Look for #tag.
-
- * mm-util.el (mm-find-charset-region): Check whether
- enable-multibyte-characters is bound.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.46 is released.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Insert headers at the
- right spot.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.45 is released.
-
-1998-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nndraft.el (nndraft-save-mime-part): Removed.
- (nndraft-get-mime-part): Ditto.
-
- * message.el (message-format-mime-old): Removed.
- (message-encode-message-body): Removed.
- (message-encode-message-body): Renamed.
-
-1998-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's.
-
- * message.el (message-format-mime): Check message-mime-part.
-
- * mm-encode.el (mm-mime-file-types): Removed.
- (mm-default-file-encoding): New definition.
-
-1998-11-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-image): Use mm-insert-inline.
- * gnus-art.el (gnus-mm-display-part): Go to correct position.
-
-1998-11-14 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.44 is released.
-
-1998-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-format-mime): New function.
-
- * nndraft.el (nndraft-save-mime-part): New function.
- (nndraft-get-mime-part): New function.
-
- * mm-encode.el (mm-default-file-encoding): New function.
- (mm-content-transfer-encoding): New function.
- (mm-encode-buffer): New function.
-
- * message.el: New command.
- (message-mime-part): New variable.
- (message-insert-mime-part): New command.
-
- * mm-encode.el (mm-encode-content-transfer-encoding): New
- function.
-
- * mm-util.el (mm-content-transfer-encoding-defaults): New
- variable.
- (mm-mime-file-types): Taken from TM.
-
-1998-11-14 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.43 is released.
-
-1998-11-07 Karl Kleinpaste <karl@jprc.com>
-
- * gnus-cus.el (gnus-score-customize): Add "Extra" element.
- * gnus-score.el (gnus-score-default-header): Ditto.
- (gnus-header-index): Ditto.
- (gnus-summary-increase-score): Ditto, & process "extra" requests.
- (gnus-summary-header): Handle extra headers.
- (gnus-summary-score-entry): Ditto, & provide new score element.
- (gnus-summary-score-effect): Ditto.
- (gnus-score-string): Avoid "extra" string sort, & modify match in
- "extra" case.
- * gnus-sum.el (gnus-make-score-map): Add "extra" element.
-
-1998-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-resend): Bind message-required-mail-headers
- to nil.
-
- * mm-view.el (mm-inline-text): Bind w3-strict-width.
-
- * nngateway.el (require): Require cl.
-
- * gnus-art.el (gnus-button-alist): Exclude more chars from news:
- things.
-
-1998-11-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Create directory even
- when no articles.
-
-1998-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-ignored-resent-headers): Remove X-Gnus.
-
-1998-11-10 Colin Rafferty <colin@xemacs.org>
-
- * gnus-sum.el (gnus-ignored-from-addresses): Only quote
- user-mail-address if non-nil.
-
-1998-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-make-sort-function): Do `reverse'.
- (gnus-make-sort-function-1): Ditto.
-
- * gnus-art.el (gnus-mm-display-part): Switch to mm in right
- window.
-
-1998-11-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-with-unibyte-buffer): Ditto.
-
- * binhex.el (binhex-decode-region): Quote.
-
-1998-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-charset): Don't downcase charset.
-
- * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's.
-
-1998-11-08 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.42 is released.
-
-1998-11-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Add id for alternative part.
-
-1998-11-08 Simon Josefsson <jas@pdc.kth.se>
-
- * nntp.el (nntp-send-mode-reader): Revert.
-
-1998-11-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-articles): Use with-temp-buffer.
-
-1998-11-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-make-date): Fix for negative time zones.
-
-1998-11-08 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.41 is released.
-
-1998-11-08 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-decode.el (mm-dissect-multipart): Quote regexp.
-
-1998-10-29 Sudish Joseph <sj@eng.mindspring.net>
-
- * gnus.el (gnus-short-group-name): When shortening foreign select
- methods, do not scan for plusses beyond the first colon.
-
-1998-11-07 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-save-group-info): Cater for group info
- lines where `group' is the last thing on the line.
-
-1998-11-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-view-part): Do alternative.
- (gnus-mime-display-alternative): Insert marker.
-
-1998-11-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-dissect-multipart): Quote regexp.
-
- * nnmail.el (nnmail-expired-article-p): Protect against bogus
- dates.
-
- * gnus-cus.el (gnus-topic): Required.
-
- * nnheader.el (nnheader-parse-nov): Parse extra.
- (nnheader-nov-parse-extra): New macro.
-
-1998-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-view-part): Internal move.
-
-1998-10-28 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-cus-new.el (gnus-custom-topic): New free variable.
- (gnus-group-customize): Support editing topic parameters.
-
-1998-10-29 Karl Kleinpaste <karl@jprc.com>
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add
- indicators.
-
-1998-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mm-display-part): Return.
- (gnus-article-view-part): Only go if external.
- (gnus-article-dumbquotes-map): Do 205.
-
- * mm-decode.el (mm-display-part): Return what was done.
-
- * message.el (message-buffer-naming-style): New variable.
- (message-generate-new-buffers): Extended.
- (message-buffer-naming-style): Removed.
- (message-buffer-name): Use it.
- (message-do-send-housekeeping): Rename new styling.
-
- * gnus-sum.el (gnus-summary-recenter): Allow
- gnus-auto-center-summary to be a number.
-
-1998-11-04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-open-server): Use "binary" instead of
- "no-conversion".
-
-1998-11-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Set
- gnus-browse-current-method to the result of gnus-server-to-method.
-
-1998-10-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-pull): Another optional argument.
- * nnweb.el (nnweb-request-delete-group): Delete from
- nnweb-group-alist and update active file.
-
-1998-10-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-make-group): Accept group of new
- method.
-
-1998-10-28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble.
-
-1998-10-27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Postion of html portion.
-
-1998-10-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-list-active-group): Waited for short strings.
- (nntp-send-mode-reader): Ditto.
- (nntp-open-connection): Ditto.
-
- * gnus-int.el (gnus-request-group-articles): New function.
-
- * nntp.el (nntp-request-listgroup): New function.
- (nntp-request-group-articles): Renamed.
-
-1998-10-27 Karl Kleinpaste <karl@jprc.com>
-
- * nnheader.el (nnheader-parse-nov): Supply extra.
-
-1998-10-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-push): Don't go to
- gnus-article-buffer.
-
- * mm-view.el (mm-inline-image): Add a newline.
-
- * gnus-start.el (gnus-check-first-time-used): Check more.
-
-1998-10-26 Francois Felix Ingrand <felix@laas.fr>
-
- * gnus-start.el (gnus-check-first-time-used): Check current.
-
-1998-10-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-find-charset-region): New function.
-
- * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header.
-
- * gnus-art.el (gnus-mime-button-menu): Fix.
-
-1998-10-26 Michael Welsh Duggan <md5i@cs.cmu.edu>
-
- * gnus-art.el (gnus-mime-button-menu): New definition.
-
-1998-10-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-charset): Downcase charset.
- (article-decode-charset): Pass on type.
- (article-decode-charset): Check nil charsets.
- (article-remove-cr): Translate CR to LF.
- (gnus-ignored-mime-types): Default to nil.
-
- * nnheader.el (nnheader-insert-nov): Work when not Xref.
-
- * gnus-sum.el (gnus-ignored-from-addresses): Default to
- user-mail-address.
- (gnus-nov-parse-extra): Didn't return right thing.
-
-1998-10-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header.
-
-1998-10-25 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.40 is released.
-
-1998-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-mark-forward): Show thread.
-
- * gnus-start.el (gnus-check-first-time-used): Ignore dribble.
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Bind name.
-
- * nnml.el (nnml-possibly-create-directory): Check before making.
-
-1998-10-25 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnheader.el (nnheader-insert-nov): Don't infloop.
-
-1998-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-set-mode-line): Check that the spec has been
- set up.
-
-1998-10-25 Joerg Lenneis <lenneis@statrix2.wu-wien.ac.at>
-
- * nneething.el (nneething-file-name): New definition.
-
-1998-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Fix.
- (gnus-summary-save-in-rmail): Use gnus-output-to-rmail.
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Recognize first part.
-
-1998-10-25 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.39 is released.
-
-1998-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-ignored-mime-types): New variable.
- (gnus-mime-display-single): Use it.
- (gnus-treatment-function-alist): New variable.
-
- * gnus.el (gnus-mime): New group.
-
- * gnus-art.el (gnus-mime-display-alternative): Don't destroy
- things for other parts.
- (gnus-mime-display-alternative): Place point.
-
- * gnus.el: autoload gnus-uu-post-news.
-
- * mailcap.el (mailcap-mailcap-entry-passes-test): Also check
- needsterm/DISPLAY.
-
- * mm-decode.el (mm-display-part): Default to inline text/.*
- parts.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Default to
- 8bit.
-
- * gnus-art.el (gnus-mime-copy-part): Use normal-mode.
- (gnus-mime-display-single): Inline all text parts.
- (gnus-article-narrow-to-signature): Removed mime:: stubs.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnml.el (nnml-possibly-create-directory): Rewrite.
- (nnml-request-create-group): Change to right server.
-
- * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width.
-
- * gnus.el: rmail-output-to-rmail-file autoload.
-
- * gnus-util.el (gnus-output-to-rmail): Didn't work if not in
- Gnus.
-
- * nnheader.el (nnheader-parse-head): Checked wrong variable.
-
- * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks.
-
-1998-10-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-mixed): Multipart in
- mixed part.
-
-1998-10-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Ditto.
-
-1998-10-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Create pseudo multipart head.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a
- value.
-
- * gnus-art.el (gnus-article-hidden-text-p): Return nil when not
- hidden.
-
- * gnus-spec.el (gnus-update-format-specifications): Use the
- article mode line spec.
-
- * gnus-art.el (gnus-insert-mime-button): Put right type.
- (gnus-insert-prev-page-button): Ditto.
- (gnus-insert-next-page-button): Dutti.
-
- * pop3.el: New version installed.
-
-1998-10-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline
- and display last part.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.38 is released.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-mime-decode-quoted-printable-buffer):
- Removed.
- (article-de-quoted-unreadable): Narrow to default.
-
- * qp.el (quoted-printable-encode-region): Encode before QP-ing.
-
- * gnus-art.el (article-decode-charset): Decode even when broken
- MIME.
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return
- name.
-
- * gnus-msg.el (gnus-copy-article-buffer): Delete headers.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Use
- nnheader.
-
- * nnmail.el (nnmail-extra-headers): New variable.
-
- * nnheader.el (nnheader-insert-nov): Insert extra.
-
- * gnus.el (gnus-summary-line-format): Doc fix.
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Parse extra.
- (gnus-nov-parse-line): Ditto.
- (gnus-nov-parse-extra): New macro.
- (gnus-header): New function.
- (gnus-update-summary-mark-positions): Change.
- (gnus-ignored-from-addresses): New variable.
- (gnus-summary-insert-from-or-to): New function.
-
- * gnus.el (gnus-extra-headers): New variable.
-
- * nnheader.el (make-mail-header): Expand.
- (mail-header-extra): New macro.
- (mail-header-set-extra): Ditto.
- (make-full-mail-header): Expand.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.37 is released.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-body): Check for multibyticity.
-
- * mm-util.el (mm-enable-multibyte): Don't always switch multibyte
- on.
-
-1998-10-22 Didier Verna <verna@inf.enst.fr>
-
- * gnus-spec.el (gnus-balloon-face-function): new function
- (gnus-parse-format): understand the %< %> specifiers
- (gnus-parse-complex-format): ditto.
-
-1998-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Changed following-char to char-after throughout.
-
-1998-10-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Protect more and message.
-
-1998-10-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-mixed): Multipart in
- mixed part.
-
-1998-10-21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Ditto.
-
-1998-10-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Create pseudo multipart head.
-
-1998-10-21 Hrvoje Niksic <hniksic@srce.hr>
-
- * mailcap.el (mailcap-save-binary-file): Use unwind-protect.
-
- * mm-decode.el (mm-display-external): Set undisplayer to mm
- buffer, not the current buffer; use unwind-protect.
-
-1998-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit): Destroy parts.
- (gnus-summary-exit-no-update): Ditto.
-
-1998-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): Look for w3.
-
- * mailcap.el (mailcap-mime-data): Inline html.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.36 is released.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-translate-strings):
- (gnus-article-dumbquotes-map): Don't dot.
-
- * pop3.el (pop3-open-server): Set point right.
-
- * mm-decode.el (mm-dissect-multipart): Dissect hierarchically.
- (mm-dissect-buffer): Ditto.
- (mm-destroy-part): Ignore non-handles.
- (mm-remove-part): Ditto.
- (mm-destroy-parts): New function.
- (mm-remove-parts): Ditto.
-
- * gnus-art.el (gnus-mm-display-part): Don't move point.
-
-1998-10-20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el : New file.
-
- * gnus-art.el (gnus-display-mime): Dissect uu stuffs.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as
- a function.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Check before selecting.
-
-1998-09-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite.
-
- * gnus-sum.el (gnus-decode-encoded-word-methods): New variable.
-
- * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New
- variable.
-
- * gnus-sum.el (gnus-encoded-word-method-alist): Deleted.
-
- * gnus-art.el (gnus-decode-header-methods): New variable.
-
- * gnus-art.el (gnus-decode-header-methods-cache): New variable.
-
- * gnus-art.el (gnus-multi-decode-header): New function.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.35 is released.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * uudecode.el (uudecode-decode-region-external): Insert
- literally.
-
- * mm-bodies.el (mm-decode-body): Optional encoding.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-ems.el (gnus-mouse-3): New variable.
-
- * binhex.el (binhex-decode-region-external): Don't use -internally.
-
-1998-10-16 Simon Josefsson <jas@pdc.kth.se>
-
- * mailcap.el (mailcap-parse-mailcaps): Only open regular
- files.
-
-1998-09-27 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-group.el (gnus-add-marked-articles): Request backend update
- of flags.
-
-1998-09-26 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-read-articles):
- (gnus-update-marks): Request backend update of mark.
-
-1998-09-26 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Optional Backend Functions): New item,
- nnchoke-request-set-mark.
-
-1998-09-26 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Don't add stuff in list
- to range.
-
-1998-10-20 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-summary-exit-no-update): Don't expire.
-
-1998-10-14 SL Baur <steve@altair.xemacs.org>
-
- * gnus-sum.el: Move gnus-save-hidden-threads above where it is
- first used.
-
-1998-10-10 SL Baur <steve@altair.xemacs.org>
-
- * mm-view.el: Require mm-decode for macros.
-
- * mm-decode.el (mm-handle-type): Move macro declarations above the
- place where they are used.
-
-1998-10-18 Kurt Swanson <ksw@dna.lth.se>
-
- * gnus-msg.el (gnus-summary-mail-forward): Erase old forward
- buffer.
-
-1998-10-20 Katsumi Yamaoka <yamaoka@ga.sony.co.jp>
-
- * nnagent.el (nnagent-open-server): Error message.
-
-1998-10-20 Joerg Lenneis <lenneis@statrix2.wu-wien.ac.at>
-
- * nnheader.el (nnheader-article-p): Recognize lower-case headers.
-
-1998-10-19 Hrvoje Niksic <hniksic@srce.hr>
-
- * score-mode.el (gnus-score-mode-map): Ditto.
-
- * message.el (message-mode-map): Ditto.
-
- * gnus-uu.el (gnus-uu-post-news): Ditto.
-
- * gnus-kill.el (gnus-kill-file-mode-map): Ditto.
-
- * gnus-eform.el (gnus-edit-form-mode-map): Ditto.
-
- * gnus-art.el (gnus-article-edit-mode-map): Use
- `set-keymap-parent' rather than `copy-keymap'.
-
-1998-10-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-mime-button-commands): New variable.
- (gnus-mime-button-map): Initialize it from
- `gnus-mime-button-commands'.
- (gnus-mime-button-menu): New function.
- (gnus-insert-mime-button): Use `gnus-mime-button-map'.
-
-1998-10-11 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-insert-to): Make `nobody' and `poster'
- synonymous to `never' and `always' in Mail-Copies-To.
- (message-reply): Ditto.
- (message-followup): Ditto.
-
-1998-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-data): Save sound.
-
-1998-09-24 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-ignored-supersedes-headers): Include
- `NNTP-Posting-Date'.
-
-1998-10-19 Jonas Steverud <d4jonas@dtek.chalmers.se>
-
- * gnus-art.el (gnus-article-dumbquotes-table): New variable.
-
-1998-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Use
- uudecode.
-
-1998-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Don't switch on save.
-
-1998-10-18 Andy Piper <andyp@parallax.co.uk>
-
- * nnmail.el (nnmail-movemail-args): New variable.
-
-1998-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-translate-strings):
-
-1998-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-view-part): Use it.
- (gnus-mm-display-part): New function.
- (article-de-quoted-unreadable): Yse mm-default-coding-system.
-
- * mm-decode.el (mm-handle-displayed-p): New function.
-
- * gnus-art.el (gnus-mime-copy-part): Create better names.
- (gnus-mime-button-line-format): Include dots spec.
-
-1998-10-15 Matt Pharr <mmp@graphics.stanford.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old
- forward buffer first.
-
-1998-10-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-set-window-start): New function.
-
- * message.el (message-send): Don't check changed.
-
-1998-10-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-setup-buffer): Set params.
-
- * mm-decode.el (mm-user-display-methods): Inline
- "message/delivery-status".
-
-1998-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-auto-save-directory): Rename.
- (message-mode): Dof fix.
-
- * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat".
- (gnus-summary-save-in-pipe): No, check gnus-last-shell-command.
-
- * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving.
-
- * message.el (message-make-date): Avoid locale.
-
- * gnus-art.el (gnus-article-edit-done): Allow update before doing
- cache.
-
- * mm-decode.el (mm-display-inline): Goto point-min.
-
- * gnus-art.el (gnus-article-prepare-display): Not read-only.
-
- * mm-decode.el (mm-display-external): Reverse before sorting.
-
- * gnus-draft.el (gnus-draft-send): Allow mail.
-
-1999-11-30 -SL Baur <steve@altair.xemacs.org>
-
- * message.el (message-check): Move message-check macro above where
- it is first used.
-
- * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line.
-
-1998-10-11 Lloyd Zusman <ljz@asfast.com>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Fix.
-
-1998-10-11 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.34 is released.
-
-1998-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): delivery-status.
-
- * mm-view.el (mm-inline-text): Provide default.
-
-1998-10-11 Lloyd Zusman <ljz@asfast.com>
-
- * mailcap.el (mailcap-possible-viewers): Fix nils.
-
-1998-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-edit-exit): Don't do updates.
- (article-update-date-lapsed): Record the buffer.
- (article-update-date-lapsed): Do all windows that display article
- buffers.
-
- * nnml.el (nnml-generate-nov-databases-1): Ditto.
-
- * gnus-score.el (gnus-score-score-files-1): Ignore dotted files.
-
- * gnus-art.el (gnus-insert-mime-button): Mark buttons as
- annoations.
-
- * gnus-msg.el (gnus-summary-mail-forward): Decode properly.
-
-1998-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-category-add): Change default category to
- 'false.
-
- * nnvirtual.el (nnvirtual-update-read-and-marked): Don't nix out
- scores.
-
- * gnus-draft.el (gnus-draft-send): Check server more.
-
- * gnus-art.el (gnus-article-view-part): New command and keystroke.
- (gnus-article-goto-part): New function.
-
- * mm-view.el (mm-inline-text): Insert richtext properly.
-
- * gnus-art.el (gnus-insert-mime-button): Store handle in alist.
-
-1998-10-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * parse-time.el (parse-time-rules): Accept dates far into the past
- and the future, and parse single-digit numbers as years.
-
-1998-10-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Chop off directories.
-
-1998-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * uudecode.el (uu-decode-region-external): Use
- insert-file-contents-literally.
-
- * gnus-cache.el (gnus-cache-generate-active): Translate _ to :.
-
-1998-10-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * uudecode.el: New file.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Do
- x-uuencode.
-
-1998-10-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-alternative): Set faces.
-
- * message.el (message-fetch-field): Unfold properly.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF
- in text/plain.
-
-1998-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-first-unread-subject): New command.
- (gnus-auto-select-first): Removed.
- (gnus-auto-select-first): Extended.
- (gnus-summary-read-group-1): Use new value.
-
-1998-09-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-fix-before-sending): Space.
-
- * nnmail.el (nnmail-find-file): Don't erase.
-
-1998-10-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Do not decode headers.
-
-1998-10-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-add-article): Do not decode headers.
-
-1998-10-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-pack-packet): Pack only if necesary.
-
-1998-09-26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-buffer): Make it work in XEmacs
- 20.4.
-
-1998-09-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-all-parts): New command and
- keystroke.
-
- * mm-decode.el (mm-display-external): Translate slashes.
-
- * nnmail.el (nnmail-find-file): Restrict auto-mode-alist.
-
- * nndraft.el (nndraft-retrieve-headers): Don't copy so much.
-
- * mm-decode.el (mm-quote-arg): Quote spaces.
- (mm-display-external): Quote args.
-
-1998-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inlinable-part-p): New function.
-
-1998-09-26 Simon Josefsson <jas@pdc.kth.se>
-
- * mm-util.el (mm-disable-multibyte): New function.
-
-1998-09-24 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.33 is released.
-
-1998-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-insert-mime-button): Get buffer size.
-
- * mm-decode.el (mm-display-external): Don't switch for externals.
- (mm-dissect-multipart): Don't include end-sep.
-
- * mm-util.el (mm-get-coding-system-list): New function.
- (mm-coding-system-list): New variable.
-
-1998-09-24 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-parameters): Add charset as a parameter
-
-1998-09-24 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-customize): Use variable as cons not as
- group
-
-1998-09-24 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-interactively-view-part): Typo.
-
-1998-09-24 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-multipart): Display last part when the
- article has no close-delimiter
-
-1998-09-24 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-buffer): Display parts which have no
- content-type.
-
-1998-09-24 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Typo.
-
-1998-09-24 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.32 is released.
-
-1998-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-kill.el (gnus-batch-score): Protect against errors.
-
- * gnus-art.el: Protect against broken headers.
-
- * mm-decode.el (mm-display-external): Respect needsterm.
- (mm-display-external): Create buffer for external commands.
-
-1998-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-info): Return the proper viewer.
-
- * mm-decode.el (mm-display-external): Use file name.
-
-1998-09-22 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
-
- * gnus-util.el (gnus-output-to-rmail): Adjust to
- `rmail-output-to-rmail-file'.
-
-1998-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-output-to-rmail): Reinstated function.
-
- * gnus-sum.el (gnus-select-newsgroup): Set global variables before
- headers.
-
- * gnus-art.el (article-decode-charset): Fold case.
-
-1998-09-17 Simon Josefsson <jas@pdc.kth.se>
-
- * mailcap.el (mailcap-save-binary-file): Goto point-min.
-
-1998-09-23 Aaron M. Ucko <amu@mit.edu>
-
- * nnmail.el (nnmail-check-duplication): Enter into duplicate list
- after being stored.
-
-1998-09-15 Kurt Swanson <ksw@dna.lth.se>
-
- * gnus-salt.el (gnus-pick-setup-message): Return from whence ye
- come.
-
-1998-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-ems.el (gnus-widget-button-keymap): New variable.
-
-1998-09-20 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): remove part if necessary
-
-1998-09-23 Matt Armstrong <matta@geoworks.com>
-
- * gnus-art.el (article-decode-charset): Narrow to the correct
- region.
-
- * mm-bodies.el: Fix autoload.
-
-1998-09-22 Lee Willis <lee@gbdirect.co.uk>
-
- * gnus-art.el (gnus-mime-button-line-format): Doc fix.
-
-1998-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-decode): Use rfc2047-default-charset.
-
-1998-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-insert-mime-button): Specify keymap.
- (gnus-article-add-button): Ditto.
-
- * gnus-sum.el (gnus-summary-insert-pseudos): Use mm.
-
- * gnus-art.el (gnus-article-prepare-display): Make article mode.
- (gnus-article-prepare-display): Bind url-standalone-mode.
-
- * mm-decode.el (mm-remove-part): Also delete directory.
- (mm-display-external): Create a private sub-dir.
-
- * mailcap.el (mailcap-binary-suffixes): New variable.
- (mailcap-command-p): Use it.
-
-1998-09-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmbox.el (nnmbox-request-group): Change server.
- (nnmbox-possibly-change-newsgroup): Enable multibyte.
-
- * message.el (message-encode-message-body): Don't stomp MIME
- headers.
-
- * gnus-sum.el (gnus-summary-edit-article-done): Don't encode
- unless useful.
- (gnus-summary-exit): Check for a live article buffer.
- (gnus-summary-exit-no-update): Ditto.
-
- * gnus-int.el (gnus-request-replace-article): Accept no-encode
- param.
-
- * gnus-sum.el (gnus-article-decoded-p): New variable.
-
- * mm-decode.el (mm-display-external): Use no-conv.
-
- * rfc2047.el (rfc2047-q-encode-region): Bound properly.
- (rfc2047-charset-encoding-alist): Use B encoding for koi8-r.
-
- * gnus-art.el (gnus-article-mode-map): Bind button2 to
- mouse-click.
-
-1998-09-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-expire): Protect against nil infos.
-
-1998-09-14 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.31 is released.
-
-1998-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit): Destroy MIME.
-
- * mm-decode.el (mm-display-part): Accept no-default.
-
- * gnus-art.el (gnus-insert-mime-button): buffer-size doesn't take
- a parameter.
-
- * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces.
- (gnus-summary-prepare-threads): Ditto.
-
- * gnus.el (gnus-article-mode-map): Make sparse keymap.
-
- * gnus-art.el (gnus-mime-button-line-format-alist): Allow a %d spec.
- (gnus-mime-button-line-format): Doc fix.
- (gnus-insert-mime-button): Use it.
- (gnus-article-add-button): Use widget-convert-button.
-
- * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to
- ignore.
-
- * mm-decode.el (mm-alternative-precedence): Ditto.
-
-1998-09-14 Conrad Sauerwald <conrad@stack.nl>
-
- * mm-decode.el (mm-user-automatic-display): Use enriched.
-
-1998-09-14 Paul Fisher <rao@gnu.org>
-
- * mm-decode.el (mm-dissect-multipart): Have the part start on the
- right place.
-
-1998-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-inews-add-send-actions): Mark silently.
-
- * gnus-art.el (article-update-date-lapsed): Only update header if
- buffer is dispalyed in frame.
- (gnus-article-prepare-display): New function.
- (gnus-article-prepare): Use it.
-
-1998-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-inline-part): New command and keystroke.
-
- * mm-view.el (mm-insert-inline): New function.
-
- * mm-decode.el (mm-pipe-part): Bugged.
-
- * gnus-agent.el (gnus-agent-send-mail): Don't encode.
-
- * mm-bodies.el (mm-encode-body): Move over the body.
-
- * nnmbox.el (nnmbox-read-mbox): Enable multibyte.
-
- * rfc2047.el (rfc2047-q-encode-region): Would bug out.
-
-1998-09-13 Francois Pinard <pinard@iro.umontreal.ca>
-
- * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all
- related functions. Handle message/rfc822 parts. Display subject on
- multipart summary lines. Display name on sub-parts when available.
-
-1998-09-14 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * mailcap.el (mailcap-command-p): New version.
-
-1998-09-13 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed
- groups.
-
-1998-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-make-date): Remove weekday name.
-
- * mm-decode.el (mm-dissect-buffer): Protect against broken
- headers.
-
- * mailcap.el (mailcap-command-in-path-p): New function.
- (mailcap-command-p): Renamed.
-
-1998-09-13 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * rfc2047.el (eval): Autoload.
-
-1998-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-decode-encoded-word-functions): New variable.
- (gnus-multi-decode-encoded-word-string): New function.
- (gnus-encoded-word-method-alist): New variable.
- (gnus-decode-encoded-word-functions): Removed.
-
-1998-09-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-int.el (gnus-request-replace-article): Replace
- message-narrow-to-headers with message-narrow-to-head
-
-1998-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * drums.el (drums-quote-string): Reversed match.
-
- * message.el (message-make-date): Use weekday name.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.30 is released.
-
-1998-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-encoded-words): Use it.
- (gnus-decode-header-function): New variable.
-
- * gnus-sum.el (gnus-nov-parse-line): Use it.
- (gnus-decode-encoded-word-function): New variable.
-
- * gnus-msg.el (gnus-copy-article-buffer): Decode the right
- buffer.
-
- * gnus-art.el (gnus-insert-mime-button): Use widget.
- (gnus-widget-press-button): New function.
- (gnus-article-prev-button): Removed.
- (gnus-article-next-button): Ditto.
- (gnus-article-add-button): Ditto.
-
- * gnus.el (gnus-article-mode-map): Inherit from widget.
- (gnus-article-mode-map): No, don't.
-
- * mm-decode.el (mm-dissect-buffer): Store Content-ID things.
- (mm-content-id-alist): New variable.
- (mm-get-content-id): New function.
-
- * gnus-art.el (gnus-request-article-this-buffer): Only decode
- articles if we are fetching to the article buffer.
-
-1998-09-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-move-article): Don't decode accepting
- articles.
-
-1998-09-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-mime-charset): Try to use safe-charsets.
- (mm-default-mime-charset): New variable.
-
- * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials.
-
- * drums.el (drums-quote-string): Reversed test.
-
-1998-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-insert-rfc822-headers): Possibly not quote
- string.
-
- * drums.el (drums-quote-string): New function.
-
- * rfc2047.el (rfc2047-encode-message-header): Goto point-min.
- (rfc2047-b-encode-region): Chop lines.
- (rfc2047-q-encode-region): Ditto.
-
-1998-09-12 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.29 is released.
-
-1998-09-12 Istvan Marko <imarko@pacificnet.net>
-
- * mm-decode.el (mm-save-part): Message right.
-
-1998-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * drums.el (drums-parse-address): Returned a list instead of a
- string.
- (drums-remove-whitespace): Skip comments.
- (drums-parse-addresses): Didn't work.
-
-1998-09-12 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.28 is released.
-
-1998-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-button-map): Use the article keymap as a
- starting point.
- (article-decode-encoded-words): Rename.
-
- * message.el (message-narrow-to-headers-or-head): New function.
-
- * gnus-int.el (gnus-request-accept-article): Narrow to the right
- region.
-
- * message.el (message-send-news): Encode body after checking
- syntax.
-
- * gnus-art.el (gnus-mime-button-line-format): Allow descriptions.
-
- * mm-decode.el (mm-save-part): Use Content-Disposition filename.
-
- * gnus-art.el (gnus-display-mime): Respect disposition.
-
- * mm-decode.el (mm-preferred-alternative): Respect disposition.
-
- * gnus-art.el (article-strip-multiple-blank-lines): Don't delete
- text with annotations.
-
- * message.el (message-make-date): Fix sign for negative time
- zones.
-
- * mm-view.el (mm-inline-image): Insert a space at the end of the
- image.
-
- * mail-parse.el: New file.
-
- * rfc2231.el: New file.
-
- * drums.el (drums-content-type-get): Removed.
- (drums-parse-content-type): Ditto.
-
- * mailcap.el (mailcap-mime-data): Use symbols instead of strings.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.27 is released.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-alternative-precedence): New variable.
- (mm-preferred-alternative): New function.
-
- * gnus-art.el (gnus-mime-copy-part): New command.
-
- * mm-decode.el (mm-get-part): New function.
-
- * mm-view.el: New file.
-
- * mm-decode.el (mm-dissect-buffer): Downcase cte.
- (mm-display-part): Default to mailcap-save-binary-file.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.26 is released.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-interactively-view-part): New function.
-
- * gnus-art.el (gnus-mime-view-part): New command.
-
- * mm-decode.el (mm-last-shell-command): New variable.
-
- * mailcap.el (mailcap-mime-info): Allow returning all matches.
-
- * mm-decode.el (mm-save-part): New function.
-
- * gnus-art.el (article-decode-charset): Protect against buggy
- content-types.
- (gnus-mime-pipe-part): New command.
- (gnus-mime-save-part): New command.
- (gnus-mime-button-map): New keymap.
- (gnus-mime-button-line-format): New variable.
- (gnus-insert-mime-button): New function.
- (gnus-display-mime): Use it.
-
- * gnus-util.el (gnus-dd-mmm): Removed length spec.
-
- * mm-decode.el (mm-inline-text): Decode charsets.
-
- * gnus-art.el (gnus-article-save): Comment fix.
-
- * gnus-int.el (gnus-start-news-server): When in batch, don't
- prompt.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Don't
- decode.
-
- * mm-decode.el (mm-inline-media-tests): Add audio.
- (mm-inline-audio): New function.
-
-1998-09-11 Katsumi Yamaoka <yamaoka@ga.sony.co.jp>
-
- * gnus-art.el (article-make-date-line): Didn't work.
-
- * parse-time.el (parse-time-string): One too many nils.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.25 is released.
-
-1998-09-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-remove-trailing-blank-lines): Don't remove
- annotations.
-
- * gnus.el ((featurep 'gnus-xmas)): New
- 'gnus-annotation-in-region-p alias.
-
-1998-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-with-unibyte-buffer): New function.
-
- * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed.
-
- * mm-decode.el (mm-inline-media-tests): New variable.
-
- * gnus-sum.el (gnus-summary-exit): Destroy handles.
-
- * gnus-art.el (gnus-article-mime-handles): New variable.
-
- * drums.el (drums-narrow-to-header): New function.
-
- * gnus-art.el (article-decode-charset): Use it.
-
- * drums.el (drums-content-type-get): New function.
-
- * mm-util.el (mm-content-type-charset): Removed.
-
- * drums.el (drums-syntax-table): @ is word.
- (drums-parse-content-type): New function.
-
- * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01
- EDT" times.
-
- * gnus-util.el (gnus-date-get-time): Use safe date.
-
- * gnus-sum.el (gnus-show-mime): Removed.
- (gnus-summary-toggle-mime): Removed.
-
- * gnus-art.el (gnus-strict-mime): Removed.
- (gnus-article-prepare): Don't do MIME.
- (gnus-decode-encoded-word-method): Removed.
- (gnus-show-mime-method): Removed.
-
-1998-09-10 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.24 is released.
-
-1998-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-show-article): Don't decode chars if
- PREFIX.
-
- * parse-time.el (parse-time-rules): Accept times that look like
- "h:mm".
-
- * message.el (message-make-date): Use zone properly.
-
- * gnus.el: Autoload gnus-batch.
-
- * gnus-art.el (article-de-quoted-unreadable): Do not do
- gnus-article-decode-rfc1522.
-
- * gnus-msg.el (gnus-inews-do-gcc): Use it.
-
- * gnus-int.el (gnus-request-accept-article): Accept a no-encode
- param.
-
- * message.el (message-encode-message-body): Check for us-ascii.
-
- * gnus-msg.el (gnus-extended-version): Move Gnus version comments
- to the left.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-charset): Rename.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.23 is released.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-parent-id): Ditto.
- (gnus-put-text-property-excluding-newlines): Ditto.
-
- * gnus-sum.el (gnus-dependencies-add-header): Make into subst.
-
-1998-09-08 Karl Kleinpaste <karl@jprc.com>
-
- * message.el (message-generate-headers): Generate User-Agent
- instead of X-Mailer & X-Newsreader.
-
- * gnus-msg.el (gnus-extended-version): Reformat for USEFOR
- User-Agent header format.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.22 is released.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-multibyte-p): Typo.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.21 is released.
-
-1998-09-08 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (article-treat-dumbquotes): Handle \224 correctly.
-
-1998-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-multibyte-p): New function.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.20 is released.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-decode-region): Only decode when in
- multibyte.
-
- * nnheader.el (nnheader-pathname-coding-system): Changed to binary.
-
- * gnus-int.el (gnus-request-replace-article): Encode.
- (gnus-request-accept-article): Encode.
-
- * gnus-art.el (gnus-request-article-this-buffer): Decode charsets
- here.
-
- * gnus.el (gnus-article-display-hook): Take the charset functions
- out.
-
- * time-date.el (safe-date-to-time): New function.
-
- * gnus-util.el (gnus-dd-mmm): Protect against bogus dates.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.19 is released.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-mime-charset): New function.
-
- * gnus-draft.el (gnus-draft-edit-message): Delete article.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.18 is released.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-and-exit): Return t on success.
- (message-make-date): Make a proper time zone.
-
- * gnus-draft.el (gnus-draft-send): Only remove article if the
- sending is successful.
-
- * drums.el (drums-get-comment): Return the last comment.
- (drums-parse-address): Parse old-style From headers.
-
-1998-09-07 SL Baur <steve@altair.xemacs.org>
-
- * gnus-sum.el (gnus-data-compute-positions): Move below
- `gnus-save-hidden-threads' so the former is correctly detected as
- a macro.
-
-1998-09-06 Dave Love <fx@gnu.org>
-
- * gnus/nnweb.el (require): Wrap requirement of w3 and url in
- ignore-errors too, eval'd when compile. Require w3 stuff at load
- time for nicer failure if it's not available.
-
-1998-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * time-date.el (time-to-seconds): Renamed.
-
- * parse-time.el (parse-time-string): Downcase before handling.
- (parse-time-rules): Times without seconds have 0 seconds.
-
- * rfc2047.el (rfc2047-encode-region): New version.
- (rfc2047-dissect-region): New function.
-
-1998-09-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-make-date): Use symbolic zone.
-
-1998-09-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * time-date.el (parse-time): Always use parse-time.
-
- * parse-time.el (parse-time-syntax): Use vectors.
-
-1998-09-06 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.17 is released.
-
-1998-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * time-date.el: Renamed from "date".
-
- * gnus.el: Removed all timezone dependencies.
-
- * score-mode.el: Removed.
- (gnus-score-edit-insert-date): Use date.
-
- * date.el (float-to-time): New function.
-
- * nnspool.el (nnspool-seconds-since-epoch): Removed.
-
- * date.el (time-to-float): New function.
-
- * message.el (message-make-date): Use format-time-string.
- (message-make-expires): Use make-date.
-
- * gnus-util.el (gnus-dd-mmm): Use date.
- (gnus-sortable-date): Ditto.
-
- * message.el (message-make-date): Take an optional time.
-
- * gnus: Applied patches from 5.6.43.
-
- * date.el (if): Use parse-time.
-
- * gnus-score.el (gnus-summary-score-entry): Make into a command
- again.
-
- * gnus-group.el (gnus-group-get-new-news-this-group): Only call if
- gnus-agent.
-
- * gnus.el (gnus-agent-meta-information-header): Moved here.
-
-1998-09-05 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-scoreable-headers): New variable.
- (gnus-agent-fetch-group-1): Score article headers using normal
- group score files if the download score rule of a category/group
- is `file'.
- (gnus-agent-fetch-group-1): Don't parse the entire .overview when
- deciding what articles to download.
- (gnus-agent-fetch-group-1): Don't push headers through scoring and
- predicate processing if predicate is `true' or `false'.
-
-1998-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-load-score-alist): Bind coding system.
-
- * gnus-art.el (gnus-article-setup-buffer): Enable multibyte.
-
- * score-mode.el (score-mode-coding-system): New variable.
- (gnus-score-edit-exit): Use it.
-
-1998-09-04 Jason R Mastaler <jason@4b.org>
-
- * drums.el: Corrected typo.
-
-1998-09-06 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * mm-bodies.el (mm-body-encoding): Faster version.
-
-1998-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-charset): Only decode text
- things.
-
- * message.el (message-output): Use rmail.
-
- * rfc2047.el (rfc2047-encoded-word-regexp): Allow spaces in the
- word part.
-
- * mm-util.el (mm-charset-to-coding-system): Use
- rfc2047-default-charset.
- (mm-known-charsets): New variable.
-
- * message.el (message-caesar-region): Bugged out.
-
-1998-09-06 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when
- specifying `agent-predicate' in a group's parameters.
-
-1998-09-05 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.16 is released.
-
-1998-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-expired-article-p): Use predicate.
-
- * date.el (time-less-p): Renamed.
-
- * gnus-art.el (gnus-article-decode-charset): Really fetch headers
- from the headers.
-
- * rfc2047.el (rfc2047-decode-region): Use the mm decoding
- functions.
-
- * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at
- all.
- (gnus-group-sort-selected-groups-by-alphabet): Changed interface
- to all functions.
-
-1998-09-05 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.15 is released.
-
-1998-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * date.el: New file.
-
- * gnus-util.el (gnus-encode-date): Removed.
- (gnus-time-less): Ditto.
-
- * nnmail.el (nnmail-date-to-time): Removed.
- (nnmail-time-less): Ditto.
- (nnmail-days-to-time): Ditto.
- (nnmail-time-since): Ditto.
-
- * drums.el: New file.
-
-1998-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Encode headers with
- body encoding.
-
- * rfc2047.el (rfc2047-default-charset): Renamed.
- (rfc2047-encodable-p): Use it.
-
-1998-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-post-method): Peel off real info from opened
- servers.
-
- * gnus-util.el (gnus-output-to-rmail): Removed.
-
- * gnus-art.el (gnus-summary-save-in-rmail): Use
- gnus-output-to-rmailrmail-output-to-rmail-file.
-
- * rfc2047.el (rfc2047-decode-region): Fold case.
- (rfc2047-decode): Use decode-string.
-
- * mm-util.el: Provide mm-char-int.
-
-1998-09-03 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.14 is released.
-
-1998-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-body-encoding): Go through the buffer to make
- sure we have 7bit.
-
-1998-09-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-post-method): Use opened servers, and remove
- ducplicates.
- (gnus-inews-insert-mime-headers): Removed.
-
- * message.el (message-caesar-region): Protect against MULE chars.
-
-1998-09-02 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * mm-util.el (if): fset the right function.
-
-1998-09-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-charset): Use real
- read-coding-system.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-body): Protect against malformed
- base64.
- (mm-decode-body): Check that buffer-file-coding-system is
- non-nil.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.13 is released.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-strip-whitespace): Already defined.
- Removed.
-
- * gnus-art.el (gnus-article-decode-charset): Strip whitespace.
-
- * gnus-util.el (gnus-strip-whitespace): New function.
-
- * mm-util.el (mm-content-type-charset): Downcase.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-charset): Accept a prefix.
- (gnus-article-decode-charset): Don't fetch all headers.
-
- * mm-util.el (mm-read-coding-system): New function.
-
- * mm-bodies.el (mm-decode-body): Check the right charset.
-
- * gnus-sum.el (gnus-summary-mode-line-format): Ditto.
-
- * gnus-art.el (gnus-article-mode-line-format): Use short group
- format.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.12 is released.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-body): Don't do charset unless MULE.
-
- * gnus-art.el (gnus-article-decode-charset): Supply cte.
- (gnus-article-decode-charset): Always run.
-
- * mm-bodies.el (mm-decode-body): Decode cte.
-
-1998-09-01 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.11 is released.
-
-1998-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Ditto.
-
- * gnus-art.el (gnus-article-decode-mime-words): New command and
- keystroke.
- (gnus-article-decode-charset): Ditto.
- (gnus-article-decode-charset): Only work under MULE.
-
- * mm-util.el (mm-content-type-charset): New function.
-
- * nnmail.el (nnmail-delete-incoming): Changed to nil.
-
- * message.el (message-send-mail): Insert MIME headers.
- (message-check-news-body-syntax): Don't warn for escape sequences.
- (message-check-news-body-syntax): Insert MIME headers.
-
- * mm-bodies.el (mm-body-encoding): New function.
-
- * message.el (message-encode-message-body): New function.
-
- * mm-bodies.el: New file.
-
- * mm-util.el (mm-narrow-to-head): New function.
-
- * rfc2047.el (rfc2047-encode): Use it.
-
- * mm-util.el: Provide mm-encode-coding-region.
-
- * gnus-sum.el (gnus-summary-mode): Enable multibyte.
-
- * gnus-util.el (gnus-set-work-buffer): Enable multibyte.
-
- * mm-util.el (mm-enable-multibyte): New function.
-
- * message.el (message-set-work-buffer): Set multibyte.
-
- * gnus.el (gnus-continuum-version): Be valid forever and ever.
-
- * gnus-util.el (gnus-point-at-eol): Removed.
- (gnus-point-at-bol): Ditto.
-
-1998-08-31 Didier Verna <verna@inf.enst.fr>
-
- * gnus-msg.el (gnus-group-mail): make it behave like
- gnus-group-post-news with regards to the prefix (this enables the
- use of posting styles).
-
-1998-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-article-display-hook): Added
- gnus-article-decode-rfc1522 to hook.
-
-1998-08-31 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.10 is released.
-
-1998-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow
- hook to be run.
-
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-encodable-p): Use find-charset-region.
-
- * mm-util.el (mm-charsets-in-region): Removed.
-
- * rfc2047.el: Renamed file.
-
- * gnus-msg.el (gnus-copy-article-buffer): Multibyte.
-
- * message.el (message-mode): Set multibyte.
-
- * mm-util.el (mm-charsets-in-region): Copied here.
-
- * gnus-util.el: Removed gnus-truncate-string.
-
- * gnus-art.el (gnus-article-decode-mime-words): Use 1522.
-
- * rfc1522.el (rfc1522-unencoded-charsets): New variable.
- (rfc1522-encodable-p): New function.
- (rfc1522-encode-message-header): Use it.
-
-1998-08-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.9 is released.
-
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el: Shadow encode-coding-string.
-
- * rfc1522.el (rfc1522-narrow-to-field): Copied here.
-
- * mm-util.el: New file.
-
- * mm-decode.el: Somewhat depleted.
- * mm-encode.el: Ditto.
-
- * rfc1522.el: New file.
-
- * mm-util.el (mm-replace-chars-in-string): Copied here.
-
- * mm-encode.el (mm-q-encode-region): New function.
-
- * qp.el (quoted-printable-encode-region): Take an optional CLASS
- param.
-
- * mm-encode.el (mm-encode-word-region): Downcase.
-
-1998-08-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.8 is released.
-
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Encode headers.
-
- * qp.el (quoted-printable-encode-region): Encode 8-bit words.
- (quoted-printable-encode-region): Upcase.
-
- * message.el (message-default-charset): New variable.
+ * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant.
- * qp.el (quoted-printable-encode-region): Optional param FOLD.
+2004-08-30 Andreas Schwab <schwab@suse.de>
- * message.el (message-narrow-to-field): Changed name.
+ * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting.
- * mm-encode.el: New file.
+ * gnus-score.el (gnus-summary-increase-score): Fix format string.
- * message.el (message-narrow-to-header): New function.
+2004-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
- * gnus-art.el (gnus-article-decode-mime-words): Place point in the
- right buffer.
+ * nnimap.el (nnimap-demule): Avoid string-as-multibyte.
-1998-08-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+2004-08-30 Kim F. Storm <storm@cua.dk>
- * gnus.el: Pterodactyl Gnus v0.7 is released.
+ * nntp.el (nntp-authinfo-file): Add :group 'nntp.
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache):
+ Add :group 'nnimap.
- * gnus.el: Remove autoload for
- gnus-article-mime-decode-quoted-printable.
+2004-08-23 Reiner Steib <Reiner.Steib@gmx.de>
- * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to
- be decoded in non-MULE Emacsen.
+ * mm-decode.el (mime-display, mime-security): Fix custom-manual
+ entries.
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-art.el (gnus-article): Ditto.
- * mm-decode.el: Check for coding-system-list.
+2004-08-23 Katsumi Yamaoka <yamaoka@jpl.org>
-1998-08-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * gnus-art.el (article-hide-list-identifiers): Bind
+ inhibit-read-only as t.
- * gnus.el: Pterodactyl Gnus v0.6 is released.
+2004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-mlspl.el (gnus-group-split-update): Fix docstring.
- * nnheader.el (fboundp): Protect code-coding-string.
+2004-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
- * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte
- is available.
+ * gnus-art.el: Use inhibit-read-only instead of buffer-read-only.
+ (gnus-narrow-to-page): Don't assume point-min == 1.
+ (gnus-article-edit-mode): Derive from message-mode.
-1998-08-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume
+ point-min == 1.
- * gnus.el: Pterodactyl Gnus v0.5 is released.
+ * imap.el (imap-parse-address-list, imap-parse-body-ext):
+ Disable incorrect use of `assert'.
-1998-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * message.el (message-mode): Set comment-start-skip.
- * gnus-art.el (gnus-article-mode): Make article buffer multibyte.
- (gnus-hack-decode-rfc1522): Removed.
+2004-08-22 Sam Steingold <sds@gnu.org>
- * mm-decode.el (mm-charset-coding-system-alist): Check better.
+ * pop3.el (pop3-leave-mail-on-server): New user variable.
+ (pop3-movemail): Delete mail only when it is nil.
-1998-08-30 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+2004-08-17 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus.el: Gnus v0.4 is released.
+ * netrc.el, tls.el: Removed; use files from ../net instead.
-1998-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+2004-08-16 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-article-decode-mime-words): New command and
- keystroke.
+ * gnus-mule.el, smiley-ems.el: Removed obsolete files.
- * qp.el (quoted-printable-decode-region): Don't use hexl.
+ * mailcap.el (mailcap-mime-data): Mark as risky.
- * gnus-sum.el (gnus-parse-headers-hook): Default to nil.
- (gnus-structured-field-decoder): Removed.
- (gnus-unstructured-field-decoder): Ditto.
+ * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): Fix
+ custom-manual entries.
- * mm-decode.el: New file.
+ * time-date.el: Removed. Merged into ../calendar/time-date.el.
- * qp.el: New file.
+2004-08-02 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (article-mime-decode-quoted-printable): Removed.
+ * blink.pbm, blink.xpm, braindamaged.xpm, cry.xpm, dead.xpm,
+ evil.xpm, forced.xpm, frown.xpm, grin.xpm, indifferent.xpm,
+ reverse-smile.xpm, sad.pbm, sad.xpm, smile.xpm, time-date.el,
+ wry.xpm: Added new files from the v5_10 branch of Gnus.
- * gnus-ems.el (fboundp): Removed gnus-split-string.
+2004-07-22 Andreas Schwab <schwab@suse.de>
- * gnus.el (gnus-splash-face): Doc fix.
+ Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
- * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p.
+2004-05-23 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-art.el (article-mime-decode-quoted-printable): Don't use
- hexl.
+ * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in
+ addition to emacs-w3m.
- * nnheader.el (nnheader-temp-write): Removed.
+2004-05-19 Reiner Steib <Reiner.Steib@gmx.de>
-1998-08-29 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * gnus-msg.el (gnus-summary-followup-with-original): Document
+ yanking of region when active.
- * gnus.el: Gnus v0.3 is released.
+2004-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
-1998-08-29 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+ * gnus-agent.el: Merged 7.3 through 7.7 updates into branch.
+ Revision 7.2 changes excluded to maintain compatibility with all
+ targeted emacs versions.
- * gnus.el: Gnus v0.2 is released.
+ * gnus-cus.el: Merged revisions 7.2 through 7.5 into branch to support
+ gnus-agent.el update and incorporate bug fixes.
;; Local Variables:
;; coding: iso-2022-7bit
;; End:
- Copyright (C) 2002 Free Software Foundation, Inc.
+ Copyright (C) 2002 2004 Free Software Foundation, Inc.
Copying and distribution of this file, with or without modification,
are permitted provided the copyright notice and this notice are preserved.
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
new file mode 100644
index 00000000000..c36aad0a6e9
--- /dev/null
+++ b/lisp/gnus/ChangeLog.2
@@ -0,0 +1,18924 @@
+2004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Gnus v5.10.6 is released.
+
+2004-01-04 Kai Grossjohann <kai@emptydomain.de>
+
+ * gnus-sum.el (gnus-summary-print-article): Doc fix.
+
+2004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Gnus v5.10.5 is released.
+
+2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-face-from-file): Message 9.
+
+2004-01-03 Romain FRANCOISE <romain@orebokech.com>
+
+ * gnus-fun.el (gnus-face-from-file): Use gnus-message.
+
+2004-01-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic): Treat Gmane
+ addresses specially. Fix returned value and messages.
+
+ * mm-decode.el (mm-enable-external): New variable.
+ (mm-display-part): Use it.
+ (mm-display-external): Fix message in case of nil handle.
+
+ * Update copyright for several files.
+
+ * spam-report.el (spam-report-gmane): Adjust verbosity.
+ Delete trailing whitespace. Update copyright.
+
+ * spam.el: Fix many (but not all) checkdoc complaints.
+ Delete trailing whitespace.
+
+ * message.el (message-header-synonyms): Defcustom.
+ (message-get-reply-headers): Catch `Original-To'.
+ (message-carefully-insert-headers): Added comment.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Improved "Washing" menu.
+
+2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Use cat.
+
+ * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): New
+ cat.
+
+ * gnus.el (gnus-user-agent): Moved here.
+
+ * gnus-msg.el (gnus-user-agent): Moved from here.
+
+ * gnus.el (gnus-version-number): Bump.
+
+2004-01-03 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Gnus v5.10.4 is released.
+
+2004-01-02 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.el (gnus-mode-line-buffer-identification): Show version in
+ help-echo.
+ (gnus-read-group): Allow most group names. Changed warning.
+
+2004-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-dired.el (gnus-dired-mode-map): Change keymaps.
+
+2004-01-02 Arne J,Ax(Brgensen <arne@arnested.dk>
+
+ * smime.el (smime-crl-check): Doc fix.
+
+2004-01-02 Edwin Steiner <edwin.steiner@gmx.net>
+
+ * gnus-nocem.el (gnus-nocem-enter-article): Use the real group
+ hashtb (tiny patch).
+
+2004-01-02 Kai Grossjohann <kai@emptydomain.de>
+
+ * nnml.el (nnml-save-mail): Grok compressed articles. From
+ Michael Albinus <Michael.Albinus@alcatel.de>.
+
+2004-01-02 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-copy-or-move-routine): use spam-list-articles
+ (spam-list-articles): rewritten to only check a mark once per
+ invocation
+
+2004-01-01 Simon Josefsson <jas@extundo.com>
+
+ * mml-sec.el (mml-default-encrypt-method)
+ (mml-default-sign-method): Defcustom.
+
+2003-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-generate-mime-1): Remove extra ).
+
+ * gnus-group.el (gnus-group-set-current-level): Signal errors on
+ topic lines.
+ (gnus-group-set-current-level): Fix fix.
+
+2003-12-31 Jeremy Maitin-Shepard <jbms@attbi.com>
+
+ * mml.el (mml-generate-mime-1): Use mml-compute-boundary (tiny
+ change).
+
+2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-group.el: Removed `(when t ...)' around `gnus-define-keys'.
+ (gnus-group-group-map): Added `gnus-group-read-ephemeral-group'
+ (already in previous commit inadvertently).
+ (gnus-group-make-menu-bar): Added `gnus-group-read-ephemeral-group'.
+ (gnus-group-read-ephemeral-group): Made interactive.
+
+ * gnus-score.el (gnus-score-find-trace): Added comment on sync
+ with `gnus-score-edit-file-at-point'.
+
+ * gnus-logic.el (gnus-score-advanced): Ditto.
+
+ * gnus-score.el (gnus-score-edit-file-at-point): Fix for
+ advanced scoring.
+
+2003-12-30 Simon Josefsson <jas@extundo.com>
+
+ * gnus-score.el (gnus-score-edit-file-at-point): Use
+ gnus-point-at-*, for portability.
+
+2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-treat-body-boundary): Fix doc-string and
+ custom type.
+ (gnus-button-mid-or-mail-regexp): Don't be too restrictive.
+ Suggested by Felix Wiemann <Felix.Wiemann@gmx.net>.
+ (gnus-button-alist): Added "M-x ... RET" and "mid:" buttons.
+ Added comments about relevant RFCs.
+
+ * gnus-sum.el (gnus-summary-mode): Untabify doc-string.
+ (gnus-summary-goto-article): Allow `%40'.
+ (gnus-summary-refer-article): Convert `%40' to `@'.
+
+2003-12-30 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-crl-check): New.
+ (smime-verify-region): Use it. From Arne J,Ax(Brgensen
+ <arne@arnested.dk> in <87llpk9v5q.fsf@seamus.arnested.dk> (tiny
+ change).
+
+2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-score.el (gnus-score-edit-file-at-point): Consider the
+ whole match element. From Karl Pfl,Ad(Bsterer <sigurd@12move.de>.
+ (gnus-score-find-trace): Use it. Added `f' and `t' commands,
+ added quick help. With some suggestions from Karl Pfl,Ad(Bsterer
+ <sigurd@12move.de>.
+
+ * gnus-util.el (gnus-emacs-version): Added doc-string.
+
+ * mml.el (mml-minibuffer-read-disposition): New function.
+ (mml-attach-file): Use it.
+ (mml-preview): Added MIME preview to gnus-buffers.
+
+2003-12-30 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add ellipses.
+
+2003-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-get-unread-articles): Inline gnus-server-get-method.
+ (gnus-get-unread-articles): Cache methods.
+ (gnus-get-unread-articles-in-group): Indent.
+
+ * gnus.el (gnus-version-number): Bump.
+ (gnus-secondary-method-p): Extend servers to methods before comparing.
+ (gnus-secondary-method-p): Revert.
+
+2003-12-30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Gnus v5.10.3 is released.
+
+2003-12-29 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agentize): Improve auto-agentizing logic.
+ Suggested by Steinar Bang <sb@dod.no>.
+ (gnus-agent-auto-agentize-methods): Customize.
+
+2003-12-29 Kevin Greiner <kgreiner@xpediantsolutions.com>
+ * gnus.el (gnus-server-to-method): Fixed bug in 2003-12-22
+ check-in.
+
+2003-12-28 Adrian Lanz <lanz@fowi.ethz.ch>
+
+ * mail-source.el (mail-source-fetch-imap): Prevent storing of
+ identical entries for imap mail sources, when retrieving mail
+ messages from an imap server within the same Gnus session several
+ times (tiny change).
+
+2003-12-28 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-view.el (mm-text-html-washer-alist): Use
+ mm-inline-wash-with-stdin for w3m-standalone.
+
+ * mm-decode.el (mm-text-html-renderer): Add w3m-standalone.
+
+ * mml1991.el (mml1991-pgg-encrypt): Decode according to CTE before
+ encrypting.
+
+2003-12-28 Jesper Harder <harder@ifa.au.dk>
+
+ * mml1991.el (mml1991-pgg-sign): Use unibyte when re-encoding.
+ From Ivan Boldyrev <boldyrev@uiggm.nsc.ru> (tiny change).
+
+2003-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el: Add an advice to byte-optimize-form-code-walker to
+ avoid the warning ``...called for effect'' for the pop form when
+ running Emacs 21.3.
+
+2003-12-26 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-body-encoding): Don't use 7bit if the body
+ contains "^From " and mm-use-ultra-safe-encoding is true.
+
+2003-12-25 Jesper Harder <harder@ifa.au.dk>
+
+ * mml1991.el (mml1991-pgg-sign): Encode and decode according to
+ CTE header. Don't insert gpg output as unibyte.
+
+2003-12-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Remove display-time-event-handler and open-ssl-stream;
+ add delete-extent for Emacs; rearrange bindings assuming w3 may
+ not be available and XEmacs without the file-coding feature may be
+ used.
+
+2003-12-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (dgnushack-compile): Increase the value for
+ max-specpdl-size when compiling Gnus with Emacs 20.
+
+2003-12-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
+ * gnus-int.el (gnus-open-server): Fixed the server status such
+ that an agentized server, when opened offline, has a status of
+ offline. Also fixes bug whereby the agent's backend was called
+ twice to open each server.
+
+ * gnus-start.el (gnus-get-unread-articles-in-group): Autoload
+ gnus-agent-possibly-alter-active rather than inline to resolve
+ compiler warnings.
+
+ * gnus.el (gnus-server-to-method): Added fallback of iterating
+ over gnus-newsrc-alist to resolve names of foreign servers.
+ Should fix recent agent bug.
+
+2003-12-22 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-score.el (gnus-summary-lower-score)
+ (gnus-summary-increase-score): Mention symbolic prefix in the
+ doc-string. Suggested by Karl Pfl,Ad(Bsterer <sigurd@12move.de>.
+
+2003-12-21 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-agent.el (gnus-agent-read-agentview): Use
+ car-less-than-car.
+
+2003-12-20 Artem Chuprina <ran@ran.pp.ru> (tiny change)
+
+ * message.el (message-yank-buffer): Bind message-reply-buffer to
+ a buffer rather than a string.
+
+2003-12-19 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-summary-followup): Correct documentation.
+
+2003-12-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-inews-add-send-actions): `yanked' can be a
+ list of lists. Reported by Dmitri Paduchikh <paduch@imm.uran.ru>.
+
+2003-12-18 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mm-url.el (mm-url-insert-file-contents-external)
+ (mm-url-insert-file-contents): Added doc-strings. Autoload.
+
+2003-12-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-cus.el (defvar): defvar
+ gnus-agent-cat-disable-undownloaded-faces.
+
+2003-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-forward-subject-name-subject): Use
+ gnus-extract-address-components instead of
+ mail-header-parse-address because it may be called with non-ascii
+ text.
+
+2003-12-16 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * nnmail.el (nnmail-split-fancy): The widget now supports
+ restrictions.
+
+2003-12-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnheader.el (nnheader-find-etc-directory): Find the newest one.
+
+2003-12-16 Simon Josefsson <jas@extundo.com>
+
+ * sha1-el.el (autoload): Don't use ignore-errors.
+ (sha1-use-external): Use condition-case. Suggested by Katsumi
+ Yamaoka <yamaoka@jpl.org>.
+
+2003-12-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnmail.el (nnmail-split-fancy): Make it customizable with Emacs
+ 20 as well.
+
+2003-12-15 Simon Josefsson <jas@extundo.com>
+
+ * sha1-el.el (autoload): Ignore errors for
+ executable-find. (XEmacs ecrypto does not require sh-script where
+ executable.el is located.)
+ (sha1-use-external): Likewise.
+
+ * sha1-el.el (sha1): Add defgroup.
+ (sha1-maximum-internal-length, sha1-program, sha1-use-external)
+ (sha1-program): Use 'sha1sum' from GNU CoreUtils instead of OpenSSL.
+ (sha1): Autoload.
+
+ * nndraft.el (nndraft-request-move-article): Copy definition of
+ nnmh-request-move-article instead of calling it, because the nnmh
+ version uses nnmh-request-article which isn't the same as the
+ nndraft version.
+
+2003-12-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: added some gnus-registry autoloads
+ (spam-split-symbolic-return): makes spam-split return 'spam
+ instead of the value of spam-split-group when spam is detected
+ (spam-split-symbolic-return-positive): makes spam-split return
+ 'ham instead of nil when ham is detected
+ (spam-autodetect-recheck-messages): tells spam.el whether it
+ should recheck all messages in a group, or only the unseen ones
+ (spam-split-last-successful-check): spam-split will set this to
+ the last successful check; this was seen as a cleaner approach
+ than returning a cell like '(spam spam-use-bogofilter)
+ (spam-list-of-checks): documentation appended
+ (spam-split): accomodate the spam-split-symbolic-return and
+ spam-split-symbolic-return-positive variables
+ (spam-find-spam): new function called when the summary is built
+ (spam-log-registered-p): checks if a ham or spam registration has
+ already been done for an article
+ (spam-check-regex-headers, spam-check-blackholes, spam-check-BBDB)
+ (spam-check-ifile, spam-check-stat, spam-check-whitelist)
+ (spam-check-blacklist, spam-check-bogofilter-headers)
+ (spam-check-spamoracle): respect the spam-split-symbolic-return
+ and spam-split-symbolic-return-positive variables
+ (spam-initialize): add spam-find-spam to gnus-summary-prepare-hook
+ (spam-unload-hook): remove spam-find-spam from
+ gnus-summary-prepare-hook
+
+ * gnus.el (spam-autodetect, spam-autodetect-methods): new
+ configuration items for spam autodetection
+
+2003-12-12 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-draft.el (gnus-draft-mode-map): Bind `e' to
+ `gnus-draft-edit-message'. We still have `B w' for
+ `gnus-summary-edit-article'.
+
+2003-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnheaderxm.el (nnheader-xmas-run-at-time): Use a simple function
+ definition if there is not a bug in start-itimer.
+
+ * pgg.el (pgg-run-at-time): Ditto.
+
+2003-12-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-possibly-alter-active): New Function.
+ (gnus-agent-regenerate-group): When necessary, alter the group's
+ active range to include articles newly recognized as being
+ downloaded.
+ (gnus-agent-regenerate): Removed code that updated the agent's
+ active file as the new gnus-agent-possibly-alter-active function
+ obsolesced it.
+
+ * gnus-cus.el (gnus-agent-customize-category): Added missing
+ agent-disable-undownloaded-faces parameter.
+
+ * gnus-start.el (gnus-activate-group): Backed out my 2003-11-29
+ patch as it was too late at adjusting the active range.
+ (gnus-get-unread-articles-in-group): Added call to new
+ gnus-agent-possibly-alter-active to adjust the active range.
+
+2003-12-10 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-get-reply-headers): Narrow to headers.
+
+2003-12-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-disable-spam-split-during-ham-respool): new
+ variable. From lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly)
+ (spam-ham-copy-or-move-routine): respect
+ spam-disable-spam-split-during-ham-respool. From
+ lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly)
+ (spam-split-disabled): new variable. From
+ lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly)
+ (spam-split): respect spam-split-disabled. From
+ lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly)
+
+2003-12-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnheaderxm.el (nnheader-xmas-run-at-time): Make it work
+ correctly for the first argument.
+
+ * pgg.el (pgg-run-at-time): New function.
+ (pgg-add-passphrase-cache): Use it.
+
+2003-12-10 Simon Josefsson <jas@extundo.com>
+
+ * pgg-parse.el (pgg-decode-packets): Rewrite to handle corrupt
+ input.
+ (pgg-decode-armor-region): Don't parse packet if decoding fail.
+
+2003-12-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-bogofilter): run in the correct buffer.
+ From lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly).
+ (spam-bogofilter-database-directory): correct customization
+ group. From Xavier Maillard <zedek@gnu-rox.org>.
+
+2003-12-09 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * nnmail.el (nnmail-lazy, nnmail-split-fancy): New widgets.
+ (nnmail-split-fancy): Use it.
+
+2003-12-08 Joel Ray Holveck <joelh@piquan.org> (tiny change)
+
+ * gnus-sum.el (gnus-summary-save-parts-1): Consider the "name"
+ parameter of Content-Type.
+
+2003-12-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el: Revert 2003-12-03 change, instead, provide the
+ compiler macro for rmail-select-summary if rmail is not available,
+ and bind rmail-summary-displayed and rmail-maybe-display-summary
+ in order to silence the compiler even if tm is not available.
+
+2003-12-08 Simon Josefsson <jas@extundo.com>
+
+ * flow-fill.el (fill-flowed-encode-tests, fill-flowed-test): Add.
+
+2003-12-08 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-extended-version): Bind float-output-format to
+ nil.
+
+2003-12-08 Simon Josefsson <jas@extundo.com>
+
+ * mml-smime.el (mml-smime-sign): Replace CRLF with LF in OpenSSL
+ output. Reported by Arne J,Ax(Brgensen <arne@arnested.dk>.
+
+2003-12-07 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-recipient-arg): Add.
+ (pgg-gpg-encrypt-region): Use it. Tiny patch from Lloyd Zusman
+ <ljz@asfast.com>.
+ (pgg-gpg-recipient-argument): Doc fix. Renamed fro p-g-r-a.
+ (pgg-gpg-encrypt-region): Update.
+
+2003-12-07 Jesper Harder <harder@ifa.au.dk>
+
+ * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Don't
+ use = or zerop to test the return value of call-process, because
+ it can be a string.
+
+ * mail-source.el (mail-source-fetch-with-program): do.
+
+ * mailcap.el (mailcap-viewer-passes-test): do.
+
+ * gnus-uu.el (gnus-uu-treat-archive, gnus-uu-post-encode-mime)
+ (gnus-uu-post-encode-file): do.
+
+ * gnus-soup.el (gnus-soup-pack, gnus-soup-unpack-packet): do.
+
+ * message.el (message-fix-before-sending): Fix detection of
+ non-printables. Don't replace unencodable utf-8.
+
+2003-12-05 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-url.el (mm-url-predefined-programs): Add user-agent for wget.
+ (mm-url-insert-file-contents-external): Signal an error if program
+ fails.
+
+2003-12-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam-report.el (spam-report-gmane): iterate over articles
+ instead of a single one; remove interactive usage
+
+2003-12-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dns.el: Fix misplaced eval-when-compile.
+
+ * gnus-util.el: Require alist and provide tm-view when compiling
+ with XEmacs.
+
+2003-12-03 Steve Youngs <sryoungs@bigpond.net.au>
+
+ * gnus-xmas.el: Add autoloads for macros defined in gnus.el.
+ From Jerry James <james@xemacs.org>.
+
+ * gnus-util.el: Get rmail definitions when compiling.
+ From Jerry James <james@xemacs.org>.
+
+ * dns.el: Require gnus-xmas at compile time instead of trying to
+ autoload `gnus-xmas-open-network-stream' because it wasn't picking
+ up the macro.
+ From Jerry James <james@xemacs.org>.
+
+2003-12-01 Kevin Greiner <kgreiner@xpediantsolutions.com>
+ * gnus-agent.el (gnus-agent-consider-all-articles): Updated
+ docstring.
+ (gnus-predicate-implies-unread, gnus-predicate-implies-unread-1):
+ Fixed implementation such that the predicate `true' no longer
+ evaluates to t.
+
+2003-12-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-bogofilter): check the bogofilter headers
+ AFTER the save-excursion scope is over. From Adrian Lanz
+ <lanz@fowi.ethz.ch>.
+ (spam-fetch-field-message-id-fast): doc fix
+
+2003-12-01 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agent-expire-days): Doc fix.
+
+2003-11-30 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agent-expire-group-1): Bind message-log-max
+ when messaging "X % completed" to inhibit logging them to the
+ message buffer.
+ (gnus-agent-expire-group-1): Mention group name in messages.
+ (gnus-agent-expire-group-1): Only print a message for an article
+ when there actually was something done to it.
+
+ * mm-util.el (mm-enable-multibyte): Call set-buffer-multibyte with
+ 'to argument. Fixes something or other in Emacs 22, and is
+ backwards compatible. From Kenichi Handa <handa@m17n.org>.
+
+ * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Custom fix.
+
+2003-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-covered-methods): Remove nil methods.
+
+2003-11-29 Kevin Greiner <kgreiner@xpediantsolutions.com>
+ * gnus-start.el (gnus-activate-group): The active range of the
+ group must include the articles known to the agent.
+
+ * gnus.el (gnus-agent-method-p): Accept a server name as the
+ method being tested.
+
+2003-11-29 Alexander Kreuzer <alex@freesources.org> (tiny change)
+
+ * nnrss.el (nnrss-check-group): Set xml when nnrss-use-local is t.
+
+2003-11-29 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-make-menu-bar): Add
+ gnus-group-make-rss-group.
+
+2003-11-28 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el: Added custom-manual links to all variables that have
+ an index entry in the message manual.
+ (message-generate-headers-first): Fixed doc-string.
+
+2003-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-yank-message): Don't bind
+ gnus-display-mime-function to nil so that non-ascii text is
+ decoded and attachments are not shown.
+
+ * message.el (message-cite-original-without-signature): Replace
+ the value of message-reply-headers with the yanked article since
+ it may be a different article from the original.
+ (message-cite-original): Ditto.
+
+2003-11-25 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-blacklist-ignored-regexes): new variable, so
+ blacklisting can ignore certain regular expressions (e.g. the
+ user's e-mail address)
+ (spam-bogofilter-spam-strong-switch,
+ spam-bogofilter-ham-strong-switch): options used when articles are
+ already registered as the opposite classification
+ (spam-old-ham-articles, spam-old-spam-articles): lists of ham and
+ spam articles, generated when a summary buffer is entered, and
+ consulted when it's exited so we know what articles are changing
+ state from spam to ham or vice-versa
+ (spam-xor): everyone needs a little convenience
+ (spam-list-of-processors): lookup table for old-style spam/ham
+ exits processors
+ (spam-group-processor-p): support old-style and new-style spam/ham
+ exit processors
+ (spam-group-processor-multiple-p): handle new-style spam/ham exit
+ processors
+ (spam-summary-prepare): use spam-old-{ham,spam}-articles; change
+ logic to iterate over list of processors instead of manual
+ individual lookup, unregister any articles that change from ham to
+ spam or vice-versa in the course of the summary buffer usage; use
+ the new spam-register-routine
+ (spam-ham-copy-routine, spam-ham-move-routine,
+ spam-mark-spam-as-expired-and-move-routine): check that the list
+ of groups is not nil, because apply doesn't like to apply a
+ function across nil
+ (spam-registration-functions): variable for looking up spam/ham
+ registration/unregistration functions based on a spam-use-* symbol
+ (spam-classification-valid-p, spam-process-type-valid-p)
+ (spam-registration-check-valid-p)
+ (spam-unregistration-check-valid-p): convenience functions
+ (spam-registration-function, spam-unregistration-function): look
+ up the registration/unregistration function based on a
+ classification and the check (spam-use-* symbol)
+ (spam-list-articles): generate list of spam/ham articles from a
+ given list of articles
+ (spam-register-routine): do the heavy work of registering and
+ unregistering articles, using all the articles in the group or
+ specific ones as needed
+ (spam-generic-register-routine): removed, no longer used
+ (spam-log-unregistration-needed-p, spam-log-undo-registration):
+ handle article registration/unregistration with a given spam/ham
+ processor and group
+ (BBDB, ifile, spam-stat, blacklists, whitelists, spam-report,
+ bogofilter, spamoracle): rewrite registration/unregistration
+ functions to take a list of articles and the unregister option.
+ Much hilarity ensues.
+ (spam-initialize): spam-stat-maybe-{save,load} already respect spam-use-stat
+ (spam-stat-register-ham-routine, spam-stat-register-spam-routine):
+ don't load and save unnecessarily
+
+ * spam-stat.el (spam-stat-dirty): new variable, set when the stats
+ database is modified
+ (spam-stat-buffer-is-spam, spam-stat-buffer-is-non-spam)
+ (spam-stat-buffer-change-to-spam, spam-stat-to-hash-table)
+ (spam-stat-buffer-change-to-non-spam): set spam-stat-dirty when
+ needed
+ (spam-stat-save): respect spam-stat-dirty, unless the force
+ parameter is specified
+ (spam-stat-load): clear spam-stat-dirty
+
+ * gnus.el (gnus-install-group-spam-parameters): marked the
+ old-style exit processors as obsolete in the docs, added the
+ new-style exit processors while the old ones are still allowed
+
+
+2003-11-25 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (article-hide-boring-headers): Don't hide Reply-To
+ unless its list of addresses is identical to From.
+
+2003-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (mapc): Add the compiler macro for Emacs 20.
+
+2003-11-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
+ * gnus-srvr.el (gnus-server-insert-server-line): The server names
+ used in gnus-agent are different (for example, the native server
+ uses the alias "native") from the names in gnus-srvr.
+ Compensating by adding a second text property storing the name
+ expected by gnus-agent.
+ (gnus-server-named-server): New function.
+ * gnus-agent.el (gnus-agent-remove-server, gnus-agent-add-server):
+ No longer expect an argument as it was ignored anyway. Uses the
+ new gnus-server-named-server function to get gnus-agent compatible
+ names from the server buffer.
+
+2003-11-20 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus.el (gnus-agent-covered-methods): Documented use of
+ named servers, not methods, to identity agentized groups.
+ Users may now change their server configurations without having
+ the server become "unagentized".
+ (gnus-agent-covered-methods): Removed from gnus-variable-list to
+ avoid storing two copies of gnus-agent-covered-methods, one in
+ .newsrc.eld and the other in agent/lib/servers.
+ (gnus-server-to-method): Do not cache server for the nil method.
+ (gnus-method-to-server): New function. Associate named server
+ with all, even foreign, methods.
+ (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated
+ simple last-response cache to offset performance lose of having to
+ always convert methods to named servers.
+ * gnus-agent.el (gnus-agent-expire-days): Removed obsolete
+ documentation.
+ (gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server):
+ Modified to support new definition of gnus-agent-covered-method.
+ (gnus-agent-read-servers): Rewritten to convert old method data
+ into server names.
+ (gnus-agent-read-servers-validate)
+ (gnus-agent-read-servers-validate-native): New functions.
+ (gnus-agent-write-servers): No longer use gnus-method-simplify as
+ it failed to simplify foreign methods.
+ (gnus-agent-close-connections, gnus-agent-synchronize-flags)
+ (gnus-agent-possibly-synchronize-flags, gnus-agent-fetch-session)
+ (gnus-agent-regenerate): Uses new gnus-agent-covered-methods
+ function as gnus-agent-covered-methods variable no longer provides
+ methods.
+ (gnus-agent-covered-methods): New function
+ (gnus-agent-expire-group, gnus-agent-expire): Final message will,
+ if gnus-verbose is greater than 4, report statistics of NOV
+ entries and files deleted as well as total bytes recovered.
+ (gnus-agent-expire-done-message): New function
+ (gnus-agent-unread-articles): Bug fix. No longer drops last
+ unread article onto read list.
+ (gnus-agent-regenerate-group): Changed prompt to use typical
+ style.
+ (gnus-agent-group-covered-p): Rewrote to internally use
+ gnus-agent-method-p.
+ * gnus-int.el (gnus-start-news-server): Partially convert old
+ gnus-agent-covered-methods to new format so that gnus-open-server
+ functions correctly.
+ * gnus-srvr.el (gnus-server-insert-server-line): Replaced
+ gnus-agent-covered-methods with gnus-agent-method-p.
+ * gnus-start.el (gnus-clear-system): Added
+ gnus-agent-covered-methods to compensate for removing it from
+ gnus-variable-list.
+ (gnus-setup-news): Complete conversion of old
+ gnus-agent-covered-methods to new format so that secondary and
+ foreign servers can be correctly opened.
+
+2003-11-20 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-copy-or-move-routine): add respooling
+ support, not working well yet
+
+ * gnus.el (ham-process-destination): make 'respool option the
+ only one, so it can't be chosen together with other groups
+
+2003-11-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-track-extra): make it a set of
+ choices instead of a boolean
+ (gnus-registry-track-subject-p, gnus-registry-track-sender-p):
+ new convenience functions
+ (gnus-registry-split-fancy-with-parent): use convenience
+ functions, also don't return extra tracking info if sender or
+ subject is found in more than one groups
+ (gnus-registry-add-group): use new convenience functions to
+ decide if sender and subject should be tracked
+
+ * gnus.el (ham-process-destination): add 'respool option,
+ unused by spam.el yet
+
+2003-11-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-score.el (gnus-decay-score): Return a surely smaller value
+ than the argument in XEmacs.
+
+2003-11-18 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-insert-to): Don't use `gnus-message'.
+ (message-header-synonyms): New variable.
+ (message-carefully-insert-headers): Use it (check for synonyms).
+ Added doc-string. From Sam Steingold <sds@gnu.org>.
+
+2003-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * html2text.el (html2text-remove-tags): Remove the tag in a
+ simpler way to avoid inflooping.
+
+2003-11-17 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-gssapi-auth-p): Don't check capability (some
+ servers remove AUTH=GSSAPI from capability response returned after
+ successful authentication).
+
+2003-11-16 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-getenv-nntpserver): Fix regexp and simplify.
+ Reported by Artem Chuprina <ran@ran.pp.ru>.
+
+2003-11-14 Simon Josefsson <jas@extundo.com>
+
+ * mm-util.el (mm-charset-synonym-alist): Map BIG5-HKSCS to BIG5
+ when it isn't available.
+
+2003-11-13 Alex Schroeder <alex@gnu.org>
+
+ * nnrss.el (nnrss-check-group): Use dc:contributor if neither
+ rss:author nor dc:creator is provided.
+
+2003-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-dissect-buffer): Save start="<id>" value
+ contained in Content-Type header of multipart/related messages.
+
+ * mm-view.el (mm-w3m-cid-retrieve-1): New function.
+ (mm-w3m-cid-retrieve): Use it.
+
+ * mml.el (mml-generate-mime-1): Add start="<id>" to Content-Type.
+ (mml-insert-mime-headers): Insert Content-ID header.
+ (mml-insert-mml-markup): Insert start="<id>" value.
+
+2003-11-12 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * nnml.el (nnml-request-accept-article): pass sender to
+ nnmail-cache-insert
+
+ * nnmh.el (nnmh-request-accept-article): pass sender to
+ nnmail-cache-insert
+
+ * nnmbox.el (nnmbox-request-accept-article): pass sender to
+ nnmail-cache-insert
+
+ * nnfolder.el (nnfolder-request-accept-article): pass sender to
+ nnmail-cache-insert
+
+ * nnbabyl.el (nnbabyl-request-accept-article): pass sender to
+ nnmail-cache-insert
+
+ * nnmail.el (nnmail-cache-insert): accept sender parameter and
+ pass it to the nnmail-spool-hook
+
+ * gnus-registry.el (gnus-registry-track-extra): clarify doc
+ (gnus-registry-action): add sender lexical var and pass it to
+ gnus-registry-add-group
+ (gnus-registry-spool-action): take a sender parameter, pass to
+ gnus-registry-add-group
+ (gnus-registry-split-fancy-with-parent): trace by sender in
+ addition to subject
+ (gnus-registry-fetch-sender-fast): new function
+ (gnus-registry-add-group): accept sender parameter
+
+2003-11-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-copy-routine, spam-ham-move-routine)
+ (spam-mark-spam-as-expired-and-move-routine): allow for the
+ groups to be a list of a single item
+
+ * gnus.el (gnus-install-group-spam-parameters):
+ ham-process-destination and spam-process-destination allow lists now
+
+2003-11-10 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-insert-to): Do error out when the user
+ requested no Cc. Don't insert empty To. Can be added to
+ `message-setup-hook' now. From Sam Steingold <sds@gnu.org>.
+ (message-mode-field-menu): Moved some entries, added
+ `message-insert-wide-reply'.
+ (message-change-subject): Fixed comment.
+
+2003-11-10 Simon Josefsson <jas@extundo.com>
+
+ * pgg-def.el (pgg-encrypt-for-me): Change default from nil to t.
+
+2003-11-09 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Cache passphrase under hex
+ key id too (for decryption).
+ (pgg-gpg-sign-region): Likewise.
+
+2003-11-09 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-all-secret-keys): New variable.
+ (pgg-gpg-lookup-all-secret-keys): New function.
+ (pgg-gpg-select-matching-key): Likewise.
+ (pgg-gpg-decrypt-region): Use new functions. From Satyaki Das
+ <satyakid@stanford.edu>.
+
+2003-11-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * nnmail.el (nnmail-cache-insert): make sure that the
+ nnmail-spool-hook is called with a valid newsgroup name (though
+ it may be wrong)
+
+ * gnus.el (gnus-group-real-prefix): return nil if group is not a
+ string, instead of triggering an error
+
+2003-11-06 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.el (gnus-group-guess-full-name-from-command-method): new function
+
+ * gnus-registry.el (gnus-registry-fetch-group): use long names if
+ requested
+ (gnus-registry-split-fancy-with-parent): when long names are in
+ use, strip the name if we're in the native server, or else return nothing
+ (gnus-registry-spool-action, gnus-registry-action): use
+ gnus-group-guess-full-name-from-command-method instead of
+ gnus-group-guess-full-name
+
+ * spam.el (spam-mark-spam-as-expired-and-move-routine)
+ (spam-ham-copy-or-move-routine): prevent article deletions or
+ moves unless the backend allows it
+
+ * gnus.el (gnus-install-group-spam-parameters): fixed parameters
+ to list spamoracle as well, suggested by Jean-Marc Lasgouttes
+ <Jean-Marc.Lasgouttes@inria.fr>
+
+ * spam.el (spam-spamoracle): doc change, suggested by Jean-Marc
+ Lasgouttes <Jean-Marc.Lasgouttes@inria.fr>
+
+2003-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-score.el (gnus-decay-score): Protect against arithmetic
+ errors. Tiny patch from Norbert Koch <viteno@xemacs.org>.
+
+2003-10-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el
+ (spam-log-processing-to-registry): improved message and comments
+ (spam-log-unregistration-needed-p): new function
+ (spam-ifile-register-spam-routine)
+ (spam-ifile-register-ham-routine, spam-stat-register-spam-routine)
+ (spam-stat-register-ham-routine)
+ (spam-blacklist-register-routine)
+ (spam-whitelist-register-routine)
+ (spam-bogofilter-register-spam-routine)
+ (spam-bogofilter-register-ham-routine)
+ (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): change
+ spam-log-processing-to-registry invocations appropriately
+
+2003-10-31 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-kerberos4-open): Ignore output from ATHENA imtest.
+ Tiny patch from Derek Atkins <warlord@MIT.EDU>.
+ (imap-process-connection-type): Improve docstring. Suggested by
+ Derek Atkins <warlord@MIT.EDU>.
+
+2003-10-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (autoload): autoload the gnus-registry functions we'll
+ need
+ (spam-log-to-registry): new variable for interfacing with the
+ gnus-registry
+ (spam-install-hooks): variable had the wrong customization group
+ (spam-fetch-field-message-id-fast): convenience function for fetch
+ a message ID quickly
+ (spam-log-processing-to-registry): new function
+ (spam-ifile-register-spam-routine)
+ (spam-ifile-register-ham-routine, spam-stat-register-spam-routine)
+ (spam-stat-register-ham-routine)
+ (spam-blacklist-register-routine)
+ (spam-whitelist-register-routine)
+ (spam-bogofilter-register-spam-routine)
+ (spam-bogofilter-register-ham-routine)
+ (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): add
+ spam-log-processing-to-registry invocations
+
+ * gnus-registry.el: fixed docs in the preface to mention
+ gnus-registry-initialize
+ (gnus-registry-store-extra): remove cached extra entry
+ information when new extra entry is stored
+
+2003-10-29 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-forward-make-body-plain): Fix ARG=1 mode
+ after separating m-f-m-b.
+
+2003-10-29 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-forward-make-body-plain): Remove ignored
+ headers. Tiny patch from Andre Srinivasan <andre@e2open.com>.
+ (message-forward-make-body-plain): Fix ARG=1.
+
+2003-10-28 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-forward-subject-name-subject)
+ (message-forward-subject-author-subject): Decode non-ASCII
+ newsgroup names.
+ (autoload): Autoload gnus-group-decoded-name.
+
+2003-10-27 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): New optional
+ parameter key, overrides the key id used to store passphrase
+ under (uses true key id from gpg output if nil).
+ (pgg-gpg-encrypt-region): Search for passphrase using user suplied
+ string STR, instead of (pgg-lookup-key STR t).
+ (pgg-gpg-encrypt-region): Store passphrase under user suplied
+ string, instead of real key id taken from gpg output.
+ (pgg-gpg-decrypt-region): Likewise.
+ (pgg-gpg-sign-region): Likewise.
+ * pgg.el (pgg-decrypt-region): Don't set pgg-default-user-id.
+
+2003-10-27 Romain FRANCOISE <romain@orebokech.com>
+
+ * gnus-art.el (gnus-article-goto-prev-page): Doc fix.
+
+2003-10-27 Simon Josefsson <jas@extundo.com>
+
+ * mm-bodies.el (mm-body-encoding): Don't use QP when message body
+ only consists of short lines and ASCII, when
+ mm-use-ultra-safe-encoding. Refer to 'About foo' thread in
+ gnus-bug, e.g. <ilullrg4k7p.fsf@extundo.com>, for more discussion.
+ This make it possible to pipe the raw RFC 822 message into 'gpg'
+ and have the signature work. Potential problem: what if message
+ contain data that would be dash-escaped by OpenPGP
+ implementations? Then PGP 2.x might not be able to parse the raw
+ RFC 822 message correctly. If that problem is worth fixing, it
+ should be fixed by detecting the situation, instead of applying QP
+ to everything. Based on discussion with "John A. Martin"
+ <jam@jamux.com>.
+
+2003-10-27 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-mark-spam-as-expired-and-move-routine)
+ (spam-ham-copy-or-move-routine): don't ask when deleting copied
+ articles, and use move instead of copy when possible
+ (spam-split): added the option of specifying a string as a
+ spam-split parameter; such a string will override
+ spam-split-group temporarily.
+
+ * nnmail.el (nnmail-cache-insert): protect from nil message IDs,
+ but should we do something else?
+
+ * gnus-registry.el (gnus-registry-spool-action): protect from nil
+ message IDs
+
+2003-10-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Allow & in mailto URLs.
+ (gnus-header-button-alist): Likewise.
+ (gnus-url-mailto): Handle ?to parameters. Replace \r\n with \n.
+ Reverse parameter list to use same order as in the URL. Reported
+ by f95-msv@f.kth.se (M,Ae(Brten Svantesson).
+
+2003-10-25 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-move-spam-nonspam-groups-only): documentation fix
+ for the variable
+
+2003-10-25 Steve Youngs <sryoungs@bigpond.net.au>
+
+ * Makefile.in (clean-some): Remove auto-autoloads.* and
+ custom-load.* as well.
+ (distclean): Ditto.
+
+ * dgnushack.el (dgnushack-make-load): Add a local vars section to
+ the dummy gnus-load.el.
+
+2003-10-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-copy-or-move-routine): do not delete if copy
+ is t, also don't intepret the list of groups as a list of lists
+ (spam-mark-spam-as-expired-and-move-routine)
+ (spam-ham-copy-or-move-routine): delete articles only if 1 or
+ more groups were specified (and "copy" was not specified for
+ spam-ham-copy-or-move-routine) (fixed twice)
+
+2003-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nndoc.el (nndoc-guess-type): Reverse the sort order. Suggested
+ by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+ (nndoc-dissect-buffer): Don't miss even-numbered articles.
+
+2003-10-24 Steve Youngs <sryoungs@bigpond.net.au>
+
+ * dgnushack.el (dgnushack-gnus-load-file): Set to
+ "auto-autoloads.el" if building with XEmacs.
+ (dgnushack-cus-load-file): Set to "custom-load.el" if building
+ with XEmacs.
+ (dgnushack-make-cus-load): We don't delete the resulting file if
+ building with XEmacs so byte-compile it.
+ (dgnushack-make-load): When building with XEmacs do nothing except
+ byte-compile the autoload file and create a dummy gnus-load.el
+ file.
+
+2003-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-make-fqdn): Bind case-fold-search.
+ Suggested by Christopher Richards <richards@CS.Princeton.EDU>.
+
+2003-10-23 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.el (spam-process-destination, ham-process-destination):
+ allow multiple groups as a choice
+
+ * spam.el (spam-check-blackholes): remove "[IP address]"
+ requirement, now just "IP address" is enough for detection for
+ blackhole checking
+ (spam-check-blackholes): oops, the dots were not escaped
+ (spam-mark-spam-as-expired-and-move-routine): added multiple group
+ support (multiple copies, then delete)
+ (spam-ham-copy-routine): new function
+ (spam-ham-move-routine): new function
+ (spam-ham-copy-or-move-routine): new function (used to be
+ spam-ham-move-routine), handle multiple groups
+ (spam-summary-prepare-exit): call the new functions
+
+2003-10-23 Simon Josefsson <jas@extundo.com>
+
+ * flow-fill.el (fill-flowed-encode, fill-flowed): Autoload.
+
+2003-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-emphasis-strikethru): Use the :strike-through
+ attribute in Emacs.
+
+2003-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-bounce): Don't erase except bounced header.
+
+2003-10-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-reverse-ip-string): new function to reverse an IP
+ address in a string
+ (spam-check-blackholes): use spam-reverse-ip-string
+
+2003-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-narrow-to-page): Clear as well as set the
+ value for gnus-page-broken.
+
+ * gnus-sum.el (gnus-summary-beginning-of-article): Use
+ gnus-break-pages instead of gnus-page-broken.
+ (gnus-summary-end-of-article): Use gnus-break-pages instead of
+ gnus-page-broken; narrow to the end of a page beforehand.
+ (gnus-summary-toggle-header): Use gnus-break-pages instead of
+ gnus-page-broken; remove delimiter buttons unless gnus-break-pages
+ is non-nil.
+
+2003-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-picon.el (gnus-picon-transform-address): Protect against
+ errors.
+
+2003-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (nnspool-rejected-article-hook): Remove defvar.
+ (xemacs-codename): Move defvar to gnus-util.el.
+
+ * gnus-util.el (xemacs-codename): Defvar when compiling.
+
+2003-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * spam-report.el (spam-report-url-ping-plain): Include a
+ User-Agent.
+
+ * gnus-msg.el (gnus-extended-version): Use it.
+
+ * gnus-util.el (gnus-emacs-version): Separated out into own
+ function.
+
+2003-10-19 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-mode-field-menu): Added
+ message-generate-unsubscribed-mail-followup-to.
+ (message-forward-subject-fwd): Avoid double "Fwd: "
+ (message-change-subject): Added comment.
+
+2003-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-nov-parse-line): Remove condition-cases.
+
+ * mml.el (mml-insert-mime): Quote mml.
+
+2003-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-remove-odd-characters): Use
+ mm-subst-char-in-string instead of subst-char-in-string.
+ (gnus-summary-refer-article): Use gnus-replace-in-string instead
+ of replace-regexp-in-string.
+
+2003-10-19 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-uu.el (gnus-uu-uustrip-article): Really strip directory
+ from file name.
+
+2003-10-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-save-parts-last-directory): Default
+ to mm-default-directory.
+ (gnus-summary-save-parts-1): Use mm-file-name-rewrite-functions.
+
+2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * pop3.el (pop3-read-response): Check whether the process is
+ alive.
+
+ * gnus-sum.el (gnus-summary-refer-article): Strip spaces.
+
+ * rfc2047.el (rfc2047-encode-region): Do error out on invalid
+ strings.
+
+ * nntp.el (nntp-retrieve-headers-with-xover): Get error messages
+ right.
+
+ * gnus-agent.el (gnus-agent-read-servers): Remove sit-for.
+
+ * gnus-art.el (article-treat-dumbquotes): Doc fix.
+
+ * message.el (message-field-value): New function.
+ (message-insert-disposition-notification-to): Use Reply-To, too.
+
+ * imap.el (imap-mailbox-status): Upcase STATUS commands.
+
+ * gnus-sum.el (gnus-remove-odd-characters): New function.
+ (gnus-nov-parse-line): Use it.
+
+2003-10-18 Matt Swift <swift@alum.mit.edu>
+
+ * mm-decode.el (mm-inline-media-tests): Recognize pjpeg as jpeg.
+
+2003-10-18 Romain FRANCOISE <romain@orebokech.com>
+
+ * message.el (message-forward-make-body): does both
+ m-f-make-body-mml and m-f-make-body-plain, resulting in a strange
+ message buffer.
+
+2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-narrow-to-page): Only break page if it's
+ broken.
+
+ * nnrss.el (nnrss-find-rss-via-syndic8): Return nil if xml-rpc
+ isn't available.
+
+ * message.el (message-hidden-headers): Doc fix.
+
+2003-10-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-summary-resend-message-edit): Avoid error when
+ fields aren't found.
+
+2003-10-18 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-forward-make-body-plain)
+ (message-forward-make-body-mime, message-forward-make-body-mml)
+ (message-forward-make-body-digest-plain)
+ (message-forward-make-body-digest-mime)
+ (message-forward-make-body-digest): New, derived from
+ message-forward-make-body.
+ (message-forward-make-body): Use them.
+ (message-forward-show-mml): New default 'best.
+ (message-forward-make-body): Support it.
+
+2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-mode): Set gnus-page-broken to nil.
+ (gnus-article-prepare): Don't set to t.
+ (gnus-narrow-to-page): Set to t if we break.
+
+2003-06-11 Daniel N,Ai(Bri <dne@mayonnaise.net>
+
+ * message.el (message-resend): Generate Resent-Message-ID header.
+
+2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-next-page): Don't go to the next line
+ before checking end-of-buffer.
+ (gnus-mime-delete-part): Don't insert parts twice.
+
+2003-10-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-update-date-lapsed): Make sure point
+ doesn't move around (much).
+
+2003-07-28 Vasily Korytov <deskpot@myrealbox.com>
+
+ * mail-source.el (mail-source-keyword-map): List "cur" before
+ "new" for maildirs.
+
+2003-10-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): ogroup, nor
+ group.
+
+ * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the parent
+ name for gcc-self.
+ (gnus-inews-insert-archive-gcc): Paren mistake.
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Add
+ parent-group.
+
+ * gnus-art.el (gnus-ignored-headers): Add more headers.
+
+ * rfc2047.el (rfc2047-encode): See which encoding is shorter --
+ base64 or QP.
+
+ * nnmail.el (nnmail-article-group): Default to "bogus".
+
+ * mail-source.el (mail-source-delete-incoming): Change to nil.
+
+2003-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mail-source.el (mail-source-fetch-imap): Fix mismatched parens.
+
+2003-10-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (defvar): Add post/pre/scripts.
+ (mail-source-fetch-imap): Use them.
+
+ * nndraft.el (nndraft-request-move-article): Fix infinite
+ recursion.
+
+ * gnus-group.el (gnus-group-mark-regexp): Jump to groups.
+
+2003-10-16 Ed L. Cashin <ecashin@uga.edu>
+
+ * imap.el (imap-interactive-login): Set imap-password to nil if
+ login fails.
+
+2003-10-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-inserted-headers): New variable.
+ (message-mode): Make local.
+ (message-mode): Set all the local action variables to nil.
+
+2003-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-inline-text-html-with-images): Doc fix.
+ (mm-w3m-safe-url-regexp): Doc fix.
+
+2003-10-12 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-respool-query): Don't narrow to head,
+ it's done by nnmail-article-group.
+
+ * gnus-uu.el (gnus-uu-grab-articles): Fix misplaced parens.
+ From Mark Hood <markhood@speakeasy.net> (tiny change)
+
+2003-10-10 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-file-name-delete-gotchas): Avoid infloop in
+ XEmacs.
+
+2003-10-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-initialize): new function, does the spam-face
+ update and all the hooks, replaces spam-install-hooks-function
+
+ * gnus-registry.el (gnus-registry-initialize): new autoloaded
+ function to explicitly initialize the registry
+
+2003-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-w3m-safe-url-regexp): Doc fix.
+
+ * mm-view.el (mm-w3m-mode-map): Doc fix.
+ (mm-inline-text-html-render-with-w3m): Add a comment.
+
+2003-10-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el: Remove superfluous eval-when-compiles.
+
+2003-10-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-suspend): Reset gnus-backlog-articles.
+
+2003-10-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dns.el (query-dns): Don't error out on malformed resolv files.
+
+2003-10-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-group-faq-directory): Update .tw entry. From
+ Albert Chun-Chieh Huang <mr894348@cs.nthu.edu.tw>
+
+2003-10-03 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-blackholes): exit the loop if matches are
+ found (idea from Adrian Lanz <lanz@fowi.ethz.ch>)
+ (spam-check-bogofilter-headers, spam-check-blackholes, spam-check-BBDB)
+ (spam-from-listed-p): use nnmail-fetch-field instead of message-fetch-field
+
+
+2003-10-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-attachment-file-modes): Change the default
+ value into 384 from ?\600 which doesn't mean an integer in XEmacs.
+
+2003-10-03 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-file-name-delete-control)
+ (mm-file-name-delete-gotchas): New functions.
+ (mm-file-name-rewrite-functions): Use them.
+ (mm-attachment-file-modes): New option.
+ (mm-save-part-to-file): Use it.
+
+2003-10-02 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * spam.el (spam-install-hooks-function): Added Autoload cookie.
+
+2003-10-02 Jesper Harder <harder@ifa.au.dk>
+
+ * pgg-def.el (pgg-default-keyserver-address): Change to
+ subkeys.pgp.net. From Michael Shields <shields@msrl.com>
+
+2003-10-01 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-idna-to-ascii-rhs-1): RHS can be terminated
+ by ',', as in 'foo@example.org, bar@example.org'.
+
+2003-10-01 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-send): Fix reversed logic of supersedes
+ check.
+
+2003-09-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-article-view-part-as-charset): Doc fix,
+ suggested by Norbert Koch <viteno@xemacs.org>.
+
+2003-09-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-topic.el (gnus-topic-goto-missing-topic): Revert 2003-02-09
+ change in order to correct the position where an invisible topic
+ (because gnus-topic-display-empty-topics is nil) may be inserted.
+
+2003-09-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-ignored-supersedes-headers): Add X-Payment.
+
+2003-09-20 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc2047.el (rfc2047-encode): Limit line length to 76 characters.
+
+2003-09-20 Simon Josefsson <jas@extundo.com>
+
+ * tls.el (tls-process-connection-type): Doc fix.
+
+ * imap.el (imap-starttls-open): Rewrite, should support both old
+ starttls.el and new starttls.el that uses GNUTLS.
+
+2003-09-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-treat-display-x-face): Use set-default instead
+ of custom-set-default which isn't available in old XEmacsen.
+
+2003-09-17 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-summary-resend-message-edit): Don't convert
+ to MML. MIME -> MML -> MIME does not work for PGP/MIME.
+
+ * message.el (message-bounce, message-forward-show-mml): do.
+
+2003-09-13 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc2047.el (rfc2047-charset-encoding-alist): Add viscii.
+ (rfc2047-encode): Add factors for big5, gb2312 and euc-kr.
+
+ * nnweb.el (nnweb-google-parse-1): Fix parsing.
+
+2003-09-12 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-fetch-control): ISC changed
+ compression from .Z to .gz.
+
+ * rfc2047.el (rfc2047-header-encoding-alist): Add "Approved" to
+ address-mime.
+
+2003-09-11 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc2047.el (rfc2047-encode): Restrict encoded-words to 75
+ characters.
+
+2003-09-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-group-charter-alist): Update.
+
+2003-09-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam-report.el: use mm-url.el functions for external URL
+ loading when the built-in HTTP GET is insufficient (e.g. proxies
+ are in the way). From Eric Knauel
+ <knauel@informatik.uni-tuebingen.de>.
+ (spam-report-url-ping-function): new option, defaults to the
+ built-in HTTP GET (spam-report-url-ping-plain)
+ (spam-report-url-ping): calls spam-report-url-ping-function now
+ (spam-report-url-ping-plain): new function, does what
+ spam-report-url-ping used to do
+ (spam-report-url-ping-mm-url): function that delegates to
+ mm-url.el (autoloaded)
+
+2003-09-08 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-delete-id): function to
+ completely delete an ID, including all the cache hashtables
+ (gnus-registry-delete-group): use gnus-registry-delete-id
+ (gnus-registry-simplify-subject): only run if the argument is a
+ string, return nil otherwise
+
+2003-09-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-summary-resend-bounced-mail): Docstring fix.
+
+2003-09-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-split-fancy-with-parent): yet
+ another error *sigh*
+
+ * gnus-registry.el (gnus-registry-fetch-extra-entry): don't use
+ puthash unless gnus-registry-entry-caching is on
+ (gnus-registry-split-fancy-with-parent): misplaced parenthesis
+ made everything a part of the 'else'
+ (gnus-registry-save): used 'entry-caching' instead of 'caching'
+
+2003-09-05 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-button-alist): Improve Info regexp.
+
+2003-09-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el: added brief explanation of basics
+ (gnus-registry-track-extra): new variable for tracking of message
+ subjects
+ (gnus-registry-entry-caching): caching parameter, used for extra
+ data
+ (gnus-registry-minimum-subject-length): minimum subject length
+ before it's considered when tracing subjects
+ (gnus-registry-save): accomodate extra data entry caching
+ (gnus-registry-action): change function name, add the subject and
+ pass it to gnus-registry-add-group
+ (gnus-registry-spool-action): change function name, add the
+ subject and pass it to gnus-registry-add-group
+ (gnus-registry-split-fancy-with-parent): add subject tracking
+ (gnus-registry-register-message-ids): pass subject to
+ gnus-registry-add-group
+ (gnus-registry-simplify-subject)
+ (gnus-registry-fetch-simplified-message-subject-fast): new
+ functions
+ (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): add
+ extra data entry caching
+ (gnus-registry-add-group): handle the extra subject parameter
+ (gnus-registry-install-hooks, gnus-registry-unload-hook): fix the
+ gnus-register-* function names
+
+ * nnmail.el (nnmail-cache-insert): add subject parameter, pass it
+ on to the nnmail-spool-hook
+
+ * nnbabyl.el (nnbabyl-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+ * nndiary.el (nndiary-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+ * nnfolder.el (nnfolder-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+ * nnimap.el (nnimap-split-articles): added subject to
+ nnmail-cache-insert call
+ (nnimap-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+ * nnmbox.el (nnmbox-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+ * nnmh.el (nnmh-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+ * nnml.el (nnml-request-accept-article): added subject to
+ nnmail-cache-insert call
+
+2003-09-04 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-button-handle-info-url)
+ (gnus-button-handle-info-url-gnome)
+ (gnus-button-handle-info-url-kde, gnus-button-alist): Handle GNOME
+ and KDE style Info URLs.
+
+ * gnus-util.el (gnus-url-unhex-string): Don't replace "+" with " ".
+
+2003-09-02 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc2047.el (rfc2047-fold-region): Don't fold at the beginning
+ of the field.
+
+2003-09-01 Simon Josefsson <jas@extundo.com>
+
+ * mml.el (mml-insert-mime-headers-always): New variable.
+ (mml-insert-mime-headers): Use it. Based on (tiny) patch from
+ Lars Balker Rasmussen <lars@balker.org>.
+
+2003-08-30 Simon Josefsson <jas@extundo.com>
+
+ * mail-source.el (mail-source-fetch-imap): Pass correct buffer to
+ imap-open, reverts 2003-03-17 change. Reverse remove before
+ calling gnus-compress-sequence. From Gaute Strokkenes
+ <gs234@srcf.ucam.org> (tiny change).
+
+2003-08-29 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-delete-group): Doc fix. Suggested by
+ Jochen K,A|(Bpper <jochen@jochen-kuepper.de>.
+
+2003-08-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-display-x-face): Make it possible to set
+ the gnus-article-x-face-command variable to the lambda form.
+
+2003-08-27 Simon Josefsson <jas@extundo.com>
+
+ * mm-decode.el (mm-remove-part): Try to kill external displayers
+ cleanly first (if it refuses, C-g aborts loop and kill process
+ unconditionally). Also make sure process is dead before we remove
+ the files it may be using. Reported by David Coe
+ <davidc@debian.org>.
+
+2003-08-27 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-cache.el (gnus-cache-generate-active): Fix bug in
+ replacement. From Vagn Johansen <v@johansen.mail.dk> (tiny
+ change).
+
+2003-08-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el: Don't use defvaralias.
+ (gnus-treat-display-x-face): Warn if the obsolete variable
+ `gnus-treat-display-xface' exists.
+
+2003-08-25 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-treat-display-face): Fix typo.
+ (gnus-treat-display-xface): Rename to gnus-treat-display-x-face
+ (reported by Jochen K,A|(Bpper <jochen@jochen-kuepper.de>)
+
+2003-08-24 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-header-button-alist, gnus-button-alist): Fix
+ type.
+
+2003-08-22 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-make-forward-subject-function): Fix
+ customize mismatch.
+
+ * gnus.el (gnus-message-archive-method): do.
+
+2003-08-20 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.el (gnus-read-group): Offer to continue only if the invalid
+ char is `/' and add more information for the user.
+
+ * gnus-art.el (gnus-button-alist): Add `+' (gnus-button-handle-man).
+ (gnus-header-button-alist): Added `In-Reply-To'.
+
+ * nnimap.el (nnimap-open-connection): Allow different user names
+ on the same server (and in the same authinfo file).
+
+2003-08-20 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sieve.el (gnus-sieve-crosspost): Fix type.
+
+ * message.el (message-make-forward-subject-function): Add
+ message-forward-subject-name-subject to choices.
+
+ * gnus-art.el (gnus-article-edit-done, gnus-article-edit-exit):
+ Redisplay article after editing.
+
+2003-08-20 Simon Josefsson <jas@extundo.com>
+
+ * gnus.el (gnus-read-group): Added check to ask confirmation if
+ Group name contains invalid character. You can use '/' in IMAP,
+ but not in filenames. G m cannot know what the user is creating,
+ so let user decide. See thread m2oeysiev3.fsf@naima.lensflare.org.
+ Tiny patch from letters@hotpop.com (Jari Aalto+mail.linux).
+
+2003-08-13 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-score.el (gnus-summary-score-effect): Fix interactive use.
+
+2003-08-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-draft.el (gnus-draft-send-all-messages): ask if all drafts
+ should be sent unless gnus-expert-user is on
+
+2003-08-09 Jesper Harder <harder@ifa.au.dk>
+
+ * pgg-gpg.el (pgg-gpg-extra-args): Fix customization type.
+
+2003-08-07 Jesper Harder <harder@ifa.au.dk>
+
+ * pgg-gpg.el (pgg-gpg-process-region): Bind
+ default-enable-multibyte-characters to nil.
+
+2003-08-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * canlock.el (canlock-password): Fix customization type.
+ (canlock-password-for-verify): Ditto.
+ * deuglify.el (gnus-outlook-deuglify-unwrap-min): Ditto.
+ (gnus-outlook-deuglify-unwrap-max): Ditto.
+ (gnus-outlook-deuglify-unwrap-stop-chars): Ditto.
+ * gnus-sum.el (gnus-sum-thread-tree-root): Ditto.
+ (gnus-sum-thread-tree-false-root): Ditto.
+ (gnus-sum-thread-tree-single-indent): Ditto.
+ * message.el (message-archive-note): Ditto.
+ (message-subscribed-address-file): Ditto.
+ (message-user-fqdn): Ditto.
+ * spam-report.el (spam-report-gmane-regex): Ditto.
+ * spam.el (spam-blackhole-good-server-regex): Ditto.
+
+ * gnus-start.el (gnus-save-killed-list): Fix last change.
+ * message.el (message-courtesy-message): Ditto.
+
+2003-08-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-header-face-alist): Revert previous change.
+ (gnus-header-newsgroups-face): Explain that it's only used for
+ crossposts.
+
+2003-08-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-registry.el (gnus-registry-max-entries): Fix customization
+ type.
+ * gnus-score.el (gnus-adaptive-word-length-limit): Ditto.
+ * gnus.el (gnus-refer-article-method): Ditto.
+ * message.el (message-courtesy-message): Ditto.
+
+2003-08-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-header-face-alist): Fix "Newsgroups" entry.
+ From Chunyu Wang <spr@db.cs.hit.edu.cn> (tiny patch)
+
+2003-08-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-save-killed-list): Fix customization type.
+ * gnus-sum.el (gnus-thread-hide-subtree): Ditto.
+ * gnus.el (gnus-use-long-file-name): Ditto.
+
+2003-08-04 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-rename-group): Don't allow renaming to
+ an existing name.
+
+ * gnus-sum.el (gnus-summary-highlight): Add uncached to docstring.
+
+ * nnmail.el (nnmail-large-newsgroup): Docstring fix.
+
+ * nntp.el (nntp-large-newsgroup): do.
+
+ * nnspool.el (nnspool-large-newsgroup): do.
+
+ * gnus-cus.el (gnus-group-parameters): Typo.
+
+2003-07-31 Simon Josefsson <jas@extundo.com>
+
+ * mml-sec.el (mml-signencrypt-style-alist): Use separate S/MIME
+ method by default (revert partial 2003-07-10 patch).
+
+2003-07-28 Dave Love <fx@gnu.org>
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el: Require cl when compiling.
+
+2003-07-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-install): add an initial
+ registry read to the loading when gnus-registry-install is set
+
+2003-07-26 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * flow-fill.el (fill-flowed): Empty lines separate paragraphs
+ even if the preceding line ends with a soft break. Tiny patch
+ from Mark Thomas <swoon@bellatlantic.net>.
+
+2003-07-25 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-regex-body, spam-regex-body-spam)
+ (spam-regex-body-ham): new variables, default to nil/empty/empty
+ (spam-install-hooks): added spam-use-regex-body to list or
+ pre-install conditions
+ (spam-list-of-checks): added spam-use-regex-body and
+ spam-check-regex-body to list of checks
+ (spam-list-of-statistical-checks): added spam-use-regex-body to
+ list of statistical checks
+ (spam-check-regex-body): invokes spam-check-regex-headers with
+ appropriate variable masking
+ (spam-check-regex-headers): changes to print "body" or "header"
+ where appropriate
+
+2003-07-25 Jesper Harder <harder@ifa.au.dk>
+
+ * smime.el (smime-ask-passphrase): Use read-passwd rather than
+ comint-read-noecho. The former is more secure.
+
+2003-07-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-cache-whitespace): make "adding
+ whitespace" message level 5 instead of 4
+ (gnus-registry-clean-empty-function): new function to remove empty
+ registry entries
+ (gnus-registry-clean-empty): new variable to enable cleaning the
+ registry when saving it by calling gnus-registry-clean-empty-function
+
+ * spam.el (spam-summary-prepare-exit): use spam-process-ham-in-spam-groups
+ (spam-process-ham-in-spam-groups): new variable
+
+2003-07-24 Jesper Harder <harder@ifa.au.dk>
+
+ * pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options.
+
+ * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el, pgg.el: Reapply changes
+ from 2003-04-03 to fix security problem. See
+ http://www.debian.org/security/2003/dsa-339
+
+2003-07-23 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.el (gnus-install-group-spam-parameters): add the
+ gnus-ticked-mark to the possible choices of ham marks
+
+ * spam.el (spam-process-ham-in-nonham-groups): new variable
+ (spam-summary-prepare-exit): use spam-process-ham-in-nonham-groups
+
+2003-07-23 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc2047.el (rfc2047-header-encoding-alist): Add Mail-Followup-To
+ and Mail-Copies-To to address-mime.
+ (rfc2047-narrow-to-field): Use rfc2047-point-at-bol.
+
+2003-07-19 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-coding-system-priorities): Docstring improvement.
+
+2003-07-17 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-thread-latest-date): Move condition-case to
+ the right place.
+
+2003-07-14 Simon Josefsson <jas@extundo.com>
+
+ * mail-source.el (mail-source-fetch-imap): Don't assume
+ imap-error-text returns something.
+
+2003-07-12 Nevin Kapur <kapur@mts.jhu.edu>
+
+ * nnimap.el (nnimap-request-newgroups): Use the pattern in
+ nnimap-list-pattern instead of "*".
+
+2003-07-10 Simon Josefsson <jas@extundo.com>
+
+ * mml-sec.el (mml-signencrypt-style-alist): Use "combined" by
+ default. Improve docstring.
+
+2003-07-10 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * imap.el (imap-arrival-filter): Fix test for missing process
+ buffer.
+
+2003-07-09 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+ From Gaute B Strokkenes <gs234@cam.ac.uk> (tiny patch).
+
+ * imap.el (imap-wait-for-tag): Clarify comment. Use timeout zero
+ for second, after-process-has-died, accept-process-output.
+ (imap-arrival-filter): If PROC has no buffer, do nothing.
+
+2003-07-09 Jesper Harder <harder@ifa.au.dk>
+
+ * flow-fill.el: Docstring and message fixes.
+
+ * deuglify.el: do.
+
+ * gnus-int.el: do.
+
+ * gnus-msg.el: do.
+
+ * gnus-util.el: do.
+
+ * gnus-draft.el: do.
+
+ * gnus-start.el: do.
+
+ * gnus.el: do.
+
+ * gnus-group.el: do.
+
+ * gnus-art.el: do.
+
+ * gnus-sum.el: do.
+
+ * mail-source.el (mail-source-movemail): Handle non-numerical
+ return values.
+
+2003-07-08 Jesper Harder <harder@ifa.au.dk>
+
+ * mailcap.el (mailcap-parse-args-syntax-table)
+ (mailcap-viewer-passes-test): Docstring fix.
+
+ * mm-bodies.el (mm-long-lines-p): Docstring fix.
+
+ * mm-decode.el (mm-w3m-safe-url-regexp, mm-verify-option)
+ (mm-decrypt-option, mm-handle-set-external-undisplayer)
+ (mm-file-name-replace-whitespace): Docstring fix.
+
+ * mm-uu.el (mm-uu-emacs-sources-regexp): Docstring fix.
+ (mm-uu-pgp-signed-test): Fix message.
+
+ * mml.el (mml-tweak-sexp-alist): Docstring fix.
+ (mml-parse-1, mml-insert-mime-headers): Fix message.
+
+ * message.el (message-archive-header)
+ (message-subscribed-address-functions)
+ (message-subscribed-addresses, message-subscribed-regexps)
+ (message-canlock-generate)
+ (message-generate-new-buffer-clone-locals): Docstring fixes.
+
+2003-07-07 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * imap.el (imap-wait-for-tag): After the process has died, look
+ for more output still pending. From Gaute B Strokkenes
+ <gs234@cam.ac.uk> (tiny patch).
+
+2003-07-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-bogofilter-score): redisplay article normally
+ after spam-bogofilter-score is called
+
+2003-07-06 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-send-mail-with-sendmail): Handle
+ non-numeric return values.
+
+ * gnus-sum.el (gnus-print-buffer): Apply emphasis.
+ From Michael Piotrowski <mxp@dynalabs.de> (tiny change).
+
+ * gnus-start.el (gnus-clear-system): Revert change from
+ 2003-06-19.
+
+2003-07-04 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-q-encode-region): Exclude especials from
+ characters not encoded, and make the list more legible.
+
+2003-07-04 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-make-from): Revert change from 2002-01-08.
+
+2003-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheader.el (nnheader-init-server-buffer): Don't add
+ nntp-server-buffer to list of Gnus buffers.
+
+2003-06-25 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-parse-list): prevent empty ("") strings
+
+2003-06-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-parse-list): use gnus-extract-address-components
+ instead of ietf-drums-parse-addresses
+ (spam-from-listed-p): let* was unnecessary
+
+2003-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-ems.el (gnus-put-image): Mark the right text segment with
+ gnus-image-category.
+
+ * gnus-srvr.el (gnus-browse-unsubscribe-group): Strip prefix from
+ native groups.
+
+ * gnus-topic.el (gnus-group-prepare-topics): Update topic line
+ format specs.
+
+ * gnus-picon.el: Written by moi, moi, moi.
+
+ * gnus-group.el (gnus-group-kill-group): Clean up.
+
+2003-06-23 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-from-listed-p, spam-parse-list): use
+ ietf-drums-parse-addresses to extract the address portion of the
+ whitelist/blacklist file if it looks like an address can be found
+
+2003-06-23 Didier Verna <didier@xemacs.org>
+
+ * gnus-ems.el (gnus-put-image): New argument CATEGORY. Add it as a
+ text property.
+ (gnus-remove-image): New argument CATEGORY. Only remove if
+ category matches.
+ * gnus-xmas.el (gnus-xmas-put-image):
+ (gnus-xmas-remove-image): Ditto, with extents.
+ * gnus-art.el (gnus-delete-images): Pass CATEGORY argument to
+ gnus-[xmas-]remove-image.
+ (article-display-face): Don't always act as a toggle. Call
+ `gnus-put-image' with CATEGORY argument.
+ (article-display-x-face): Call `gnus-put-image' with CATEGORY
+ argument.
+ * smiley.el (smiley-region): Ditto.
+ * gnus-fun.el (gnus-display-x-face-in-from): Ditto.
+ * gnus-picon.el (gnus-picon-insert-glyph): Ditto.
+ (gnus-treat-mail-picon): Don't always act as a toggle.
+ * gnus-picon.el (gnus-treat-newsgroups-picon): Ditto.
+
+2003-06-23 Didier Verna <didier@xemacs.org>
+
+ * gnus-art.el (article-display-face): Check for existence of the
+ original article buffer before switching to it.
+
+2003-06-20 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by
+ Dan Jacobson <jidanni@jidanni.org>.
+
+ * mm-view.el (mm-inline-message): Bind
+ gnus-original-article-buffer to the buffer in the mml handle
+ holding the message.
+
+2003-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (sender, from): No need to bind them.
+
+2003-06-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-enter-list): search-forward specified wrong
+
+2003-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el: Comment fix.
+
+2003-06-20 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-configure-posting-styles): Remove unused
+ variable. From Jan Rychter <jan@rychter.com>.
+
+ * spam.el (spam-spamoracle-learn): insert-string is obsolete.
+
+2003-06-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-enter-list): do not enter duplicate addresses into
+ the whitelist/blacklist
+
+2003-06-19 Jesper Harder <harder@ifa.au.dk>
+
+ * nnheader.el (nnheader-init-server-buffer): Add
+ nntp-server-buffer to gnus-buffers.
+
+ * gnus-start.el (gnus-clear-system): Now we don't need to kill
+ nntp-server-buffer separately.
+
+2003-06-18 Didier Verna <didier@xemacs.org>
+
+ * gnus-art.el (article-display-face): Correctly toggle between
+ display and hiding. Handle multiple Face headers.
+
+2003-06-17 Dave Love <fx@gnu.org>
+
+ * nnimap.el: Require cl when compiling.
+
+ * message.el (message-fix-before-sending): Reinstate nullifying
+ the invisible text property.
+ (sender, from): Defvar when compiling.
+ (message-is-yours-p): Remove autoload cookie.
+
+2003-06-17 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-util.el (gnus-extract-address-components): Added
+ doc-string.
+
+2003-06-16 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * nnml.el (nnml-current-group-article-to-file-alist): Don't read
+ overview when using compressed files. From Michael Albinus
+ <Michael.Albinus@alcatel.de>.
+
+2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-refer-parent-article): Extract
+ Message-ID from In-Reply-To header.
+
+2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-is-yours-p): Narrow to head; extract from
+ and sender by itself.
+ (message-cancel-news, message-supersede): Remove useless things.
+
+2003-06-15 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind
+ `gnus-article-emulate-mime'.
+
+2003-06-15 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+ From Tommi Vainikainen <thv+gnus@iki.fi>.
+
+ * message.el (message-is-yours-p): New function. Separated common
+ code from message-cancel-news and message-supersede. Added
+ matching code which uses message-alternative-emails regexp as last
+ resort.
+ (message-cancel-news, message-supersede): Use message-is-yours-p.
+
+2003-06-13 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * nnimap.el (nnimap-split-articles): Narrow the right buffer to
+ the headers. From Niklas Morberg <niklas.morberg@axis.com>.
+
+2003-06-12 Dave Love <fx@gnu.org>
+
+ * nnheader.el (nnheader-functionp): Deleted.
+
+ * nnmail.el (nnmail-split-fancy-syntax-table): Define all in
+ defvar.
+ (nnmail-version): Deleted.
+ (nnmail-check-duplication, nnmail-expiry-target-group): Don't use
+ nnheader-functionp.
+
+2003-06-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-bogofilter-headers): fix for when the score
+ is requested but the message is not spam
+
+2003-06-09 Teodor Zlatanov <tzz@lifelogs.com>
+ From Eric
+ <knauel@informatik.uni-tuebingen.de>
+
+ * spam.el (spam-use-spamoracle): new variable
+ (spam-install-hooks): add spamoracle to the list of conditions
+ for activation of spam-install-hooks
+ (spam-spamoracle): new variable customization group
+ (spam-spamoracle, spam-spamoracle): new variables
+ (spam-group-spam-processor-spamoracle-p)
+ (spam-group-ham-processor-spamoracle-p): new functions
+ (spam-summary-prepare-exit): added spamoracle ham/spam exit processing
+ (spam-list-of-checks, spam-list-of-statistical-checks): add
+ spam-use-spamoracle
+ (spam-check-spamoracle, spam-spamoracle-learn)
+ (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): new functions
+
+ * gnus.el (gnus-group-spam-exit-processor-spamoracle)
+ (gnus-group-ham-exit-processor-spamoracle): new variables for SpamOracle
+ (spam-process, ham-process): added spamoracle spam/ham processors
+
+2003-06-08 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-beginning-of-line): Docstring improvement.
+ Suggested by Michael R. Wolf <MichaelRunningWolf@att.net>
+
+2003-06-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Removed ["Add buttons"
+ gnus-summary-display-buttonized t]
+
+2003-06-07 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * nnmail.el (nnmail-split-fancy-match-partial-words): Doc string
+ fix. Reported by Johan Bockg,Ae(Brd <bojohan+news@dd.chalmers.se>.
+
+2003-06-07 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-beginning-of-line): Docstring improvement.
+
+2003-06-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Parse garbage NNTP
+ groups correctly.
+
+2003-06-06 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+ From Benjamin Rutt <rutt+news@cis.ohio-state.edu>.
+
+ * message.el (message-fetch-field): Augment documentation to state
+ the narrowed-to-headers restriction.
+ (message-change-subject, message-reduce-to-to-cc)
+ (message-generate-unsubscribed-mail-followup-to)
+ (message-insert-importance-high, message-insert-importance-low)
+ (message-insert-or-toggle-importance)
+ (message-insert-disposition-notification-to): Narrow to headers
+ before calling message-fetch-field or message-remove-header.
+
+2003-06-06 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-trim): fix for when
+ gnus-registry-max-entries is nil
+
+2003-06-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * qp.el (quoted-printable-decode-region): Don't error out on
+ malformed text.
+
+2003-06-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * rfc2047.el (rfc2047-encode-region): Don't error out on invalid
+ strings.
+
+2003-06-04 Jesper Harder <harder@ifa.au.dk>
+
+ * mml1991.el (mml1991-pgg-sign): Insert pgg output as unibyte.
+ From: Ivan Boldyrev <boldyrev+nospam@cgitftp.uiggm.nsc.ru> (tiny
+ change)
+
+2003-06-03 Dave Love <fx@gnu.org>
+
+ * gnus-soup.el (gnus-soup-send-packet): Don't use
+ message-functionp.
+
+ * gnus.el (gnus-agent-cache): Doc fix.
+ (gnus-other-frame): Quote lambda used as hook.
+
+ * message.el: Doc fixes.
+ (message-functionp): Deleted. Callers changed.
+ (message-fix-before-sending): Highlight with overlays. Clarify
+ `illegible text' messages.
+ (rmail-enable-mime-composing, gnus-message-group-art): Defvar when
+ compiling.
+ (gnus-find-method-for-group, nnvirtual-find-group-art): Autoload.
+
+2003-06-03 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * nnmail.el (nnmail-split-fancy-match-partial-words): New user
+ option.
+ (nnmail-split-it): Obey it. Don't let-bind regexp twice.
+
+ * message.el (message-fetch-field): Mention narrow-to-headers
+ requirement.
+
+2003-06-03 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-xmas.el (gnus-xmas-create-image): Use
+ insert-file-contents-literally. From: Eric Eide
+ <eeide@cs.utah.edu>
+
+2003-06-02 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-fetch-group): always return the
+ short name of the group
+
+2003-06-02 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-cus.el (defvar): Silence byte-compiler warnings.
+
+ * gnus-sum.el (gnus-get-newsgroup-headers): Unfold headers.
+
+2003-05-31 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (article-unsplit-urls): Use gnus-treat-article
+ rather than gnus-display-mime-function.
+
+2003-05-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-use-long-group-names): new variable
+ (gnus-registry-add-group): use it
+ (gnus-registry-trim-articles-without-groups): new variable
+ (gnus-registry-delete-group): use it
+ (gnus-registry-unload-hook): uninstall all the hooks
+
+ * spam.el (spam-install-hooks-function, spam-unload-hook): new
+ functions so users that load spam.el for customization don't get
+ all the hooks installed
+ (spam-install-hooks): new variable, set to t by default if user
+ has one of the spam-use-* variables set
+
+ * spam-stat.el (spam-stat-install-hooks, spam-stat-unload-hook): new
+ functions so users that load spam-stat.el for customization don't get
+ all the hooks installed
+
+2003-05-30 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-decode): Don't use
+ mm-with-unibyte-current-buffer.
+
+ * qp.el (quoted-printable-decode-string): Use
+ mm-with-unibyte-buffer.
+
+2003-05-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-save): allow forced saving even
+ when registry is not dirty. Use gnus-registry-trim to shorten the
+ gnus-registry-alist.
+ (gnus-registry-max-entries): new variable
+ (gnus-registry-trim): new function, trim gnus-registry-alist to
+ size gnus-registry-max-entries, sorting by entry mtime so the
+ newest entries stick around
+
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format): instead of
+ just one specific variable, allow a list of specific variables
+
+2003-05-28 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-encode-region): Skip ASCII at beginning and
+ end of region.
+
+2003-05-28 Jesper Harder <harder@ifa.au.dk>
+
+ * lpath.el: Add put-char-table and get-char-table.
+
+2003-05-28 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-dirty): flag for modified registry
+ (gnus-registry-save, gnus-registry-read)
+ (gnus-registry-store-extra, gnus-registry-clear): use it (note
+ that gnus-registry-store-extra is invoked for all modifications to
+ set the mtime, so gnus-registry-dirty only needs to be set there)
+
+2003-05-23 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (mml1991-pgg-sign): Use mml-sender instead of
+ message-sender.
+
+ * gnus-art.el (gnus-use-idna): Check if idna-program is installed.
+
+ * message.el (message-use-idna): Ditto.
+
+2003-05-20 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-q-encoding-alist): Deleted.
+ (rfc2047-q-encode-region): Don't use it.
+ (rfc2047-encode-message-header) <(eq method 'mime)>: Bind
+ rfc2047-encoding-type to `mime'.
+ (rfc2047-encode-string, rfc2047-encode): Doc fix.
+
+2003-05-20 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-send-mail): Don't insert a courtesy copy
+ notice in base64 encoded messages.
+
+2003-05-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-move-article): Don't copy expirable
+ marks if the destination group is not auto-expirable.
+
+2003-05-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (assq-delete-all): Removed the compiler macro.
+
+2003-05-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agentize): Updated documentation to match
+ usage.
+ (gnus-agent-expire-group-1): Do not skip over a group when the
+ force argument is set.
+ * gnus.el (gnus-agent): Updated documentation to reflect that
+ gnus-agent now defaults to t.
+
+2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-05-14 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Gnus v5.10.2 is released.
+
+2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-delete-incoming): Changed to t.
+
+ * rfc2047.el (rfc2047-syntax-table): Funcall.
+
+ * lpath.el ((featurep 'xemacs)): Added set-char-table-range.
+ ((featurep 'xemacs)): No, don't.
+
+ * rfc2047.el (rfc2047-encodable-p): Use the header charset.
+
+ * gnus-sum.el (gnus-summary-reselect-current-group): Supply
+ leave-hidden.
+
+2003-05-14 Jonathan Kamens <jik@kamens.brookline.ma.us>
+
+ * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny
+ patch.)
+
+2003-05-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-registry.el (gnus-registry-store-extra-entry): Use
+ gnus-assq-delete-all.
+
+ * gnus-xmas.el (gnus-xmas-assq-delete-all): New function.
+
+ * message.el (message-ignored-bounced-headers): Add Delivered-To.
+
+ * gnus-sum.el (gnus-summary-find-next): Indent.
+ (gnus-summary-find-prev): Ditto.
+ (gnus-summary-catchup): Doc fix.
+ (gnus-summary-mark-current-read-and-unread-as-read): New function.
+ (gnus-summary-catchup): Really mark after point.
+
+ * gnus-util.el (gnus-user-date): Use %d instead of %m.
+ (gnus-user-date): Use floating point time so that we don't get
+ overflows.
+
+ * gnus-sum.el (gnus-summary-local-variables): Clean up.
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Don't use centering
+ since none of the other image things do.
+
+2003-05-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (assq-delete-all): New compiler macro for Emacs 20.
+
+2003-05-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind find-coding-system.
+
+ * dgnushack.el (dgnushack-make-load): Remove redundant format call
+ in message. Suggested by Yoichi NAKAYAMA <yoichi@geiin.org>.
+ * pop3.el (pop3-movemail): Ditto.
+
+2003-05-12 Colin Marquardt <c.marquardt@alcatel.de> (tiny change)
+
+ * gnus.el (gnus-agent): Docstring fix.
+
+2003-05-12 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-install): new variable
+ (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry)
+ (gnus-registry-store-extra-entry, gnus-registry-delete-group)
+ (gnus-registry-add-group): add a modification timestamp to each entry
+ (gnus-registry-install-hooks): new function
+
+2003-05-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-cat-name): Eval macro while compiling.
+ (gnus-agent-cat-disable-undownloaded-faces): New function.
+ Accessor for new agent property
+ 'agent-disable-undownloaded-faces'.
+ gnus-cus.el (gnus-agent-parameters): Added
+ agent-disable-undownloaded-faces and corrected documentation.
+ (gnus-agent-cat-prepare-category-field,
+ gnus-agent-customize-category): Changed to avoid creating free
+ references to each field's symbol.
+ gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable.
+ (gnus-select-newgroup): Initialize it.
+ (gnus-summary-highlight-line): Use it.
+
+2003-05-12 Dave Love <fx@gnu.org>
+
+ * mm-util.el (mm-read-charset): Deleted.
+ (mm-coding-system-mime-charset): New.
+ (mm-read-coding-system, mm-mule-charset-to-mime-charset)
+ (mm-charset-to-coding-system, mm-mime-charset)
+ (mm-find-mime-charset-region): Use it.
+ (mm-default-multibyte-p): Fix non-mule case.
+
+ * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval
+ and compile.
+ (rfc2047-syntax-table): Fix building table to work in Emacs 22.
+ (rfc2047-unfold-region): Delete unused var `leading'.
+
+2003-05-12 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-temp-buffer-show-function): Reuse existing visible
+ output window if one is available. Tiny patch from Ville Skytt,Ad(B
+ <scop@xemacs.org>.
+
+2003-05-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added
+ space.
+
+2003-05-11 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Don't do article
+ washing etc.
+ (gnus-handle-ephemeral-exit): Don't reload article after exiting.
+
+ * nndoc.el (nndoc-type-alist): `mime-digest' should be before
+ `mime-parts'.
+
+2003-05-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-cite.el (gnus-article-hide-citation-maybe): Make toggling
+ work. Update mode-line.
+
+2003-05-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-logo-color-alist): Added no colours.
+
+2003-05-09 Dave Love <fx@gnu.org>
+
+ * utf7.el (mm-util): Require.
+ (utf7-direct-encoding-chars, utf7-imap-direct-encoding-chars):
+ Defconst, not defvar.
+ (utf7-utf-16-coding-system): New.
+ (utf7-encode-internal): Hoist concat out of loop.
+ (utf7-fragment-encode): Use mm-with-unibyte-current-buffer.
+ (utf7-get-u16char-converter) [utf7-utf-16-coding-system]: New
+ case.
+ (utf7-latin1-u16-char-converter): Encode the region.
+ (utf7-u16-latin1-char-converter): Decode the region.
+ (utf7-encode, utf7-decode): Fix multibyteness.
+
+ * mm-bodies.el (mm-body-7-or-8): Don't special-case mule.
+ (mm-encode-body): Use mm-read-coding-system, not mm-read-charset.
+ (mm-uu-yenc-decode-function): Defvar when compiling.
+ (mm-encode-body, mm-decode-body): Doc fix.
+
+2003-05-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-unregistered-group-regex):
+ removed in favor of the group/topic/global variables
+ (gnus-registry-register-message-ids): fixed test to omit
+ gnus-registry-unregistered-group-regex
+
+ * gnus.el (gnus-variable-list): removed gnus-registry-alist and
+ gnus-registry-headers-alist from the list
+ (gnus-registry-headers-alist): removed
+ (registry-ignore): new parameter, with accompanying
+ gnus-registry-ignored-groups global variable
+
+ * gnus-start.el (gnus-clear-system): no need to clear the
+ registry, we can do it ourselves
+ (gnus-gnus-to-quick-newsrc-format): extra parameters so it can be
+ used by gnus-registry.el
+
+ * gnus-registry.el (gnus-registry-cache-file): new file variable
+ (gnus-registry-cache-read, gnus-registry-cache-save): new
+ functions
+ (gnus-registry-cache-whitespace): new function. From Dan
+ Christensen <jdc@chow.mat.jhu.edu>
+ (gnus-registry-save, gnus-registry-read): use the new
+ gnus-registry-cache-{read|save} functions, and change the name
+ from gnus-registry-translate-{from|to}-alist
+ (gnus-registry-clear): fixed so it doesn't refer to old function name
+
+2003-05-09 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-picon.el (gnus-picon-transform-address): Parse the encoded
+ address.
+
+2003-05-08 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-start.el (gnus-clear-system): added gnus-registry-alist to
+ the list of cleared variables
+
+ * gnus-registry.el (gnus-registry-split-fancy-with-parent):
+ nnmail-split-fancy-with-parent-ignore-groups can be a single regex
+ in addition to a list of regexes.
+
+ * spam.el (spam-use-regex-headers): docstring fix. From Niklas
+ Morberg <niklas.morberg@axis.com>
+
+2003-05-08 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * gnus-sum.el (gnus-summary-next-page): Mention
+ `gnus-article-skip-boring' in docstring.
+
+2003-05-08 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc2231.el (rfc2231-parse-string): "=" should have whitespace
+ syntax here.
+
+ * ietf-drums.el (ietf-drums-syntax-table): "=" should not have
+ whitespace syntax class when parsing email addresses.
+
+ * message.el (message-forward-subject-name-subject): Don't use
+ mail-decode-encoded-word-string before parsing from.
+
+2003-05-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-setup-1): Setup alternative email before
+ generate-headers.
+
+ (message-forward-subject-name-subject): Fix the case when the
+ field "from" doesn't exist.
+
+2003-05-07 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-encode-region): Skip \n as whitespace.
+
+ * mm-util.el (mm-find-mime-charset-region): Expurgate utf-16 from
+ possible values.
+
+2003-05-07 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-kill-to-signature): Fix.
+
+2003-05-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-auto-goto-ignores): Docstring fix.
+
+ * gnus-art.el (gnus-mime-display-multipart-as-mixed)
+ (gnus-mime-display-multipart-related-as-mixed)
+ (gnus-button-mid-or-mail-heuristic-alist): do.
+
+2003-05-05 Dave Love <fx@gnu.org>
+
+ * mm-util.el (mm-default-multibyte-p): New.
+ (mm-coding-system-p): Maybe use find-coding-systems.
+
+2003-05-04 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (with-syntax-table): Define if necessary.
+ (rfc2047-syntax-table): Fix last change for XEmacs.
+ (rfc2047-parse-and-decode): Revert last change.
+
+2003-05-03 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el: Don't test for `mm-guess-mime-charset'.
+
+ * mm-util.el (mm-guess-mime-charset): Remove. Not used any more.
+
+ * gnus.el (gnus-default-charset): Set default value to
+ `undecided'.
+
+ * gnus-art.el (article-decode-charset): Don't supply 4th arg to
+ mm-decode-body.
+
+ * mm-bodies.el (mm-decode-coding-region-safely): Remove.
+ (mm-decode-body): Don't use mm-decode-coding-region-safely.
+
+2003-05-03 Vasily Korytov <deskpot@despammed.com> (tiny change)
+
+ * gnus-util.el (gnus-multiple-choice): Add ", ?".
+
+2003-05-03 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-syntax-table): Don't call make-char-table
+ with 2 args.
+ (rfc2047-decode-string): Don't set the buffer multibyte before
+ calling buffer-string.
+
+ * mm-encode.el (mm-long-lines-p): Autoload.
+ (mm-encode-content-transfer-encoding): Doc fix. Don't make buffer
+ unibyte. Signal error on unknown encoding.
+ (mm-encode-buffer, mm-qp-or-base64): Doc fix.
+
+ * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New.
+ Callers of gnus- versions changed to use them.
+ (rfc2047-header-encoding-alist): Add `address-mime' part. Doc
+ fixes.
+ (rfc2047-encoding-type): New.
+ (rfc2047-encode-message-header): Use mm-charset-to-coding-system.
+ Don't include header name field in encoding. Add `address-mime'
+ case and bind rfc2047-encoding-type for `mime' case.
+ (rfc2047-encodable-p): Deleted.
+ (rfc2047-syntax-table): New.
+ (rfc2047-encode-region, rfc2047-encode): Rewritten to take account
+ of rfc2047 rules with respect to rfc2822 tokens and to do encoding
+ in place rather than by passing strings.
+ (rfc2047-encode-string): Doc fix.
+ (rfc2047-q-encode-region): Don't use
+ mm-with-unibyte-current-buffer.
+ (rfc2047-encoded-word-regexp): eval-and-compile.
+ (rfc2047-decode-region): Avoid concatenation in loop.
+ (rfc2047-parse-and-decode): Remove useless disjunction.
+
+2003-05-02 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use
+ mm-with-unibyte-current-buffer.
+ (ietf-drums, gnus-util): don't require.
+
+ * sieve.el (sieve-manage-mode-menu): Define before use.
+
+ * mml-smime.el (message-narrow-to-headers): Autoload.
+
+ * mm-util.el (mm-coding-system-p): Don't override nil from
+ coding-system-p.
+ (mm-mule4-p, mm-disable-multibyte-mule4)
+ (mm-with-unibyte-current-buffer-mule4): Deleted.
+ (mm-multibyte-p): Use defun, not defalias.
+ (mm-make-temp-file): Moved to group at top of file.
+ (mm-point-at-eol, mm-point-at-bol): New.
+
+ * gnus-cite.el (gnus-art): Require.
+
+ * gnus-ems.el (gnus-get-buffer-create)
+ (nnheader-find-etc-directory, message-text-with-property):
+ Autoload.
+ (gnus-tmp-unread, gnus-tmp-replied, gnus-tmp-score-char)
+ (gnus-tmp-indentation, gnus-tmp-opening-bracket, gnus-tmp-lines)
+ (gnus-tmp-name, gnus-tmp-closing-bracket, gnus-tmp-subject-or-nil)
+ (gnus-check-before-posting): Only defvar when compiling.
+
+ * gnus-int.el (gnus-agent-expire): Autoload, don't defun.
+
+ * gnus-util.el (rmail-default-rmail-file, mm-text-coding-system):
+ Defvar when compiling.
+ (gnus-output-to-rmail): Require mm-util.
+
+ * mail-source.el (mail-source-callback): Use mm-make-temp-file.
+ (mail-source-make-complex-temp-name): Deleted.
+
+ * message.el (message-use-idna): Use mm-coding-system-p.
+ (message-tokenize-header, message-make-organization)
+ (message-make-from): Use with-temp-buffer.
+ (message-set-work-buffer): Deleted.
+ (message-fill-paragraph): Use `if' not `and' for compiler warning.
+ (message-check-news-header-syntax): Remove useless lambda.
+ (message-forward-make-body): Use mm-disable-multibyte,
+ mm-with-unibyte-current-buffer, mm-enable-multibyte.
+ (message-replace-chars-in-string): Deleted.
+
+ * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte.
+ (mm-extern-url): Use mm-with-unibyte-current-buffer,
+ mm-disable-multibyte.
+ (mm-extern-anon-ftp): Use mm-disable-multibyte.
+
+ * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use
+ mm-with-unibyte-current-buffer.
+
+ * mml2015.el (mml): Require.
+ (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use
+ mm-with-unibyte-current-buffer.
+
+ * nnheader.el (gnus-util): Require.
+
+ * nntp.el (format-spec, format-spec-make, open-tls-stream):
+ Autoload.
+
+ * rfc2231.el (mail-header-remove-comments, mm-encode-body)
+ (mail-header-remove-whitespace): Autoload.
+
+ * sieve-manage.el (starttls-negotiate): Autoload.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnrss.el (nnrss-find-rss-via-syndic8): Indent.
+
+2003-05-01 Mark A. Hershberger <mah@everybody.org>
+
+ * nnrss.el (nnrss-find-rss-via-syndic8): Don't error out.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-05-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam-report.el (spam-report-gmane-regex): docstring fix. From
+ Jon Ericson <Jon.Ericson@jpl.nasa.gov> (tiny change)
+
+ * gnus.el (gnus-install-group-spam-parameters): docstring fix.
+ From Jon Ericson <Jon.Ericson@jpl.nasa.gov> (tiny change)
+
+ * gnus-registry.el (gnus-registry-fetch-extra)
+ (gnus-registry-store-extra, gnus-registry-group-count): new functions
+ (gnus-registry-fetch-group, gnus-registry-delete-group)
+ (gnus-registry-add-group): changed to work with extra data element
+ if present
+
+2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Gnus v5.10.1 is released.
+
+2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.24 is released.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dgnushack.el (when): Check whether defadvice is fbound.
+
+2003-05-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-unregistered-group-regex): new variable
+ (gnus-registry-register-message-ids): use it
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+ * gnus.el: Update copyright for several files.
+
+2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.23 is released.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * spam-stat.el (spam-stat-test-directory): Compare against zero.
+
+2003-05-01 Trey Jackson <tjackson@ichips.intel.com> (tiny change)
+
+ * spam-stat.el (spam-stat-test-directory): Skip 0 length files.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-forward-subject-name-subject): Decode
+ string when forwarding.
+
+2003-05-01 Oystein Viggen <oysteivi@tihlde.org>
+
+ * dgnushack.el (when): Add defadvice.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.22 is released.
+
+2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.21 is released.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.20 is released.
+
+2003-05-01 Vasily Korytov <deskpot@despammed.com>
+
+ * gnus-dired.el (gnus-dired-mode-map): Move to C-c C-l.
+
+2003-04-30 Mark A. Hershberger <mah@everybody.org>
+
+ * mm-url.el (mm-url-insert-file-contents): set url-current-object
+ in the case where mm-url-use-external is set.
+
+ * nnrss.el (nnrss-request-article): Change the messages created to
+ multipart/alternative. Hopefully fixes a problem interaction with
+ w3m.
+ (nnrss-find-rss-via-syndic8): Better handling if xml-rpc.el isn't
+ around.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-check-news-header-syntax): Alter "posting"
+ message.
+
+ * nnrss.el (nnrss-node-text): Don't use char classes.
+
+2003-05-01 David Z. Maze <dmaze@mit.edu>
+
+ * nnrss.el (nnrss-find-rss-via-syndic8): Have an `error' branch
+ in condition-case.
+
+2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-required-headers): Remove In-Reply-To.
+
+ * gnus-int.el (gnus-open-server): Revert changes.
+
+2003-04-30 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * gnus-int.el (gnus-open-server): Try to open unagentized servers
+ even when unplugged.
+
+2003-04-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-prefer-mid-or-mail): Fixed typo in
+ doc-string.
+
+2003-05-01 Steve Youngs <youngs@xemacs.org>
+
+ * lpath.el: Add a section for non-Mule XEmacsen.
+ fbind `find-charset-string' and `coding-system-base' in that
+ section.
+
+ * gnus-util.el (gnus-completing-read-maybe-default): New.
+ (gnus-completing-read): Use it.
+
+ * mm-view.el (mm-view-pkcs7-decrypt): Ditto.
+
+ * gnus-art.el (gnus-read-string): New.
+ (gnus-summary-pipe-to-muttprint): Use it.
+
+ * gnus-xmas.el (gnus-xmas-open-network-stream): New.
+
+ * dns.el (dns-make-network-process): Use it.
+
+ Take care of some differences between XEmacs 21.1 and newer
+ versions of XEmacs.
+
+2003-04-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-split-fancy-with-parent): added
+ diagnostic message
+ (gnus-registry-grep-in-list): don't run when word is nil
+ (gnus-registry-fetch-message-id-fast): new function
+ (gnus-registry-delete-group, gnus-registry-add-group): make sure
+ the id and group are not nil
+ (gnus-registry-register-message-ids): new function
+ (gnus-register-action): optimized logical flow
+ (gnus-summary-prepare-hook): added gnus-registry-register-message-ids
+
+2003-04-30 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * gnus-delay.el (gnus-delay-article): Call
+ `gnus-agent-queue-setup' to create the delay group.
+
+ * gnus-agent.el (gnus-agent-queue-setup): Support optional arg
+ for the (queue) group name.
+
+2003-04-30 Simon Josefsson <jas@extundo.com>
+
+ * mm-util.el (mm-charset-to-coding-system): Use user specified
+ charset unless coding-system-get is fboundp.
+
+2003-04-30 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name):
+ Wrapped in eval-when-compile.
+ (gnus-agent-mode): Bind gnus-agent-go-online to nil as you
+ shouldn't be asked twice to go online with each server.
+ (gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles,
+ gnus-agent-crosspost, gnus-agent-flush-cache,
+ gnus-agent-fetch-session, gnus-agent-unread-articles,
+ gnus-agent-uncached-articles, gnus-agent-regenerate-group,
+ gnus-agent-group-covered-p): Expanded pop macros used for
+ effect. Avoids compilation warning in emacs 21.3.
+
+ * gnus-int.el (gnus-open-server): Restructured to only open
+ nnagent when gnus-plugged is nil.
+
+2003-04-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind string-to-multibyte.
+
+2003-04-30 Steve Youngs <youngs@xemacs.org>
+
+ * dgnushack.el: Add some missing autoloads for XEmacs 21.1.
+
+2003-04-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-registry-fetch-group): faster
+ (gnus-registry-delete-group): new function
+ (gnus-registry-add-group): new function
+ (gnus-register-spool-action): use it
+ (gnus-register-action): use it
+ (gnus-registry-translate-from-alist)
+ (gnus-registry-translate-to-alist): remove the headers registry
+ for now
+
+2003-04-29 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-alist): Fixed CTAN regexp.
+
+2003-04-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam-report.el (spam-report-gmane): gnus-summary-article-number
+ is not necessary, just use the function parameter
+
+2003-04-29 Karl Pflysterer <sigurd@12move.de>
+
+ * spam-stat.el (spam-stat-save): No longer font-locks the file
+ when saving
+
+2003-04-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * canlock.el: Bind mail-header-separator when compiling (XEmacs
+ provides it in mail-lib/auto-autoloads.el).
+
+2003-04-29 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-sign): Use mml-sender instead of
+ message-sender.
+
+ * mml.el (mml-generate-mime-1): Set mml-sender too.
+
+2003-04-29 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-display-while-building): Docstring fix.
+
+ * mm-url.el (mm-url-use-external): do.
+
+2003-04-29 Simon Josefsson <jas@extundo.com>
+
+ * canlock.el (mail-fetch-field): Autoload it (fix xemacs compile
+ warnings).
+
+ * sieve-mode.el (c-mode): Ditto.
+
+ * pgg.el (run-at-time): Ditto.
+
+ * mm-url.el (require): Require timer when compiling for
+ with-timeout macro (fix xemacs compile warnings).
+
+2003-04-28 Dave Love <fx@gnu.org>
+
+ * gnus-util.el (nnheader): Don't require.
+ (Nnheader-narrow-to-headers, nnheader-replace-chars-in-string):
+ Autoload.
+
+ * spam.el: Require cl when compiling.
+
+ * dns.el: Require cl when compiling.
+
+2003-04-28 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-goto-next-page)
+ (gnus-article-goto-prev-page): Revert 2003-02-12 change to make
+ gnus-pick-mode work.
+
+2003-04-28 Steve Youngs <youngs@xemacs.org>
+
+ * Makefile.in (FLAGS): Use @FLAGS@.
+
+2003-04-27 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-mime-display-multipart-as-mixed)
+ (gnus-mime-display-multipart-alternative-as-mixed)
+ (gnus-mime-display-multipart-related-as-mixed): Added doc-strings,
+ allow customization.
+
+2003-04-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * dgnushack.el (dgnushack-compile-verbosely): New function. Not
+ currently called (See source for explanation).
+
+2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages.
+ (gnus-summary-mark-read-and-unread-as-read): Take an optional
+ mark.
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-04-27 06:47:31 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.19 is released.
+
+2003-04-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-registry.el (gnus-register-spool-action): Replaced literal
+ carriage-return character with its escape sequence.
+
+2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-catchup-from-here): Doc fix.
+
+ * nnrss.el (nnrss-node-text): Use only one
+ gnus-replace-in-string.
+
+ * gnus.el: Remove gnus-functionp throughout.
+
+ * gnus-util.el (gnus-functionp): Removed.
+
+ * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix.
+
+ * message.el (message-required-headers): Add In-Reply-To.
+
+2003-04-27 Marshall T. Vandegrift <vandem2@rpi.edu>
+
+ * gnus-fun.el (gnus-face-from-file): Bind coding-system-for-read
+ to binary.
+
+2003-04-27 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-preview): do.
+
+ * message.el (message-mode): do.
+
+ * gnus-undo.el (gnus-undo-mode): do.
+
+ * gnus-topic.el (gnus-topic-mode): do.
+
+ * gnus-sum.el (gnus-summary-mode, gnus-summary-edit-article): do.
+
+ * gnus-msg.el (gnus-setup-message)
+ (gnus-inews-add-send-actions, gnus-configure-posting-styles): do.
+
+ * gnus-gl.el (gnus-grouplens-mode): do.
+
+ * gnus-art.el (gnus-mime-save-part-and-strip)
+ (gnus-mime-delete-part): Use it.
+
+ * gnus-util.el (gnus-make-local-hook): New function.
+
+2003-04-25 Simon Josefsson <jas@extundo.com>
+
+ * nnrss.el (nnrss-node-text): Don't use a star.
+ (nnrss-node-text): Use g-r-i-s, not g-r-r-i-s which doesn't exist.
+
+2003-04-24 Dave Love <fx@gnu.org>
+
+ * mm-encode.el (mm-long-lines-p): Autoload.
+ (mm-encode-content-transfer-encoding): Don't try to make buffer
+ unibyte before decoding. Don't ignore errors for base64 encoding.
+
+ * qp.el (quoted-printable-decode-region): Use mm-insert-byte.
+ Signal error on malformed text, as for base64.
+ (quoted-printable-encode-region): DTRT in Emacs 22.
+
+ * mm-util.el (mm-make-temp-file, mm-insert-byte): New.
+ (mm-auto-save-coding-system): Consider utf-8-emacs.
+ (mm-mime-mule-charset-alist, mm-mule-charset-to-mime-charset)
+ (mm-charset-to-coding-system, mm-mime-charset)
+ (mm-find-mime-charset-region): Check for :mime-charset coding
+ systems property.
+
+ * mml-sec.el (mml2015, mml1991): Don't require.
+ (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt)
+ (message-goto-body, mml-insert-tag): Autoload.
+
+ * mm-decode.el (mm-tmp-directory): Re-write to help avoid warnings.
+
+ * gnus-start.el (message-make-date): Autoload rather than
+ requiring message.
+
+ * gnus-group.el (gnus-group-name-charset-group-alist): Use
+ mm-coding-system-p.
+ (gnus-cache-active-altered): Defvar when compiling.
+ (gnus-group-delete-group): Re-write to help avoid warnings.
+
+ * gnus-art.el (gnus-use-idna): Use mm-coding-system-p.
+
+ * pgg.el: Split eval-when-compile forms.
+
+2003-04-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-group.el (gnus-large-ephemeral-newsgroup)
+ (gnus-fetch-old-ephemeral-headers): News variables.
+ (gnus-group-read-ephemeral-group): Use them.
+
+2003-04-24 Simon Josefsson <jas@extundo.com>
+
+ * sieve.el (sieve-upload): Don't use replace-regexp-in-string.
+
+ * nnrss.el (nnrss-node-text): Ditto.
+
+2003-04-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Make sure the obsolete variable
+ gnus-inews-mark-gcc-as-read exists.
+
+2003-04-23 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sieve.el (gnus-sieve-generate): Rewrite regexp search so it
+ doesn't exceed the regexp stack space.
+
+2003-04-23 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-inews-mark-gcc-as-read): Don't defvar it.
+
+ * gnus-art.el (gnus-article-hide-pgp-hook): do.
+
+2003-04-23 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mml.el (mml-preview): Bind `=', RET, and mouse-2.
+
+2003-04-23 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-decode-body): Don't override supplied charset.
+
+2003-04-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (merge, copy-list): Remove compiler macros.
+ (butlast): Add a compiler macro.
+
+2003-04-22 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-util.el (gnus-merge): Added "type" argument to match CL
+ merge and gnus-sum.el's expectations.
+
+2003-04-21 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-url-regexp): Added nntp.
+
+ * message.el (message-generate-headers-first): Default to
+ '(references).
+
+ * gnus-art.el (gnus-mime-delete-part): Require confirmation.
+
+2003-04-21 Jesper Harder <harder@ifa.au.dk>
+
+ * smime.el (smime-decrypt-region): Insert From header.
+
+2003-04-21 Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
+
+ * gnus-fun.el (gnus-face-from-file, gnus-convert-png-to-face):
+ Max length of header is 726, not 740. From Gaute B Strokkenes
+ <gs234@cam.ac.uk>.
+
+2003-04-20 Jesper Harder <harder@ifa.au.dk>
+
+ * nndb.el, mml1991.el: Fix license template.
+
+2003-04-20 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-articles): Don't download body unless
+ required.
+
+ * imap.el (imap-gssapi-open, imap-ssl-open): Erase buffer before
+ starting process, like imap-kerberos4-open does.
+
+ * mml-smime.el, rfc1843.el, dig.el, smime.el, uudecode.el: Fix
+ license template.
+
+ * mml-sec.el: Fix license template.
+
+ * gnus-sieve.el, sieve.el, sieve-manage.el, sieve-mode.el: Fix
+ license template.
+
+ * pgg-def.el, pgg.el, pgg-gpg.el, pgg-parse.el, pgg-pgp5.el,
+ pgg-pgp.el: Fix license template.
+
+2003-04-19 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-delete-article): Improve docstring.
+
+2003-04-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-move-spam-nonspam-groups-only): dumb typo fix
+
+2003-04-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-split): allow a particular check as a parameter,
+ e.g. (: spam-split 'spam-use-bogofilter)
+ (spam-mark-only-unseen-as-spam): new parameter, see doc
+ (spam-mark-junk-as-spam-routine): use
+ spam-mark-only-unseen-as-spam, simplify routine to take advantage
+ of gnus-newsgroup-unread as well as gnus-newsgroup-unseen
+
+2003-04-17 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.el (gnus-group-short-name, gnus-group-prefixed-p): new functions
+ (gnus-group-guess-full-name): don't prefix the group twice
+
+ * nnmail.el (nnmail-split-fancy-with-parent): docstring fix
+
+ * gnus-registry.el (gnus-registry-clear)
+ (gnus-registry-fetch-group, gnus-registry-grep-in-list)
+ (gnus-registry-split-fancy-with-parent): new functions
+ (gnus-register-spool-action, gnus-register-action): simplified the format
+ (gnus-registry): new customization group
+ (gnus-registry-unfollowed-groups): new variable
+
+2003-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-button-alist): Add nntp: urls.
+ (gnus-header-button-alist): Ditto.
+
+2003-04-17 Dave Love <fx@gnu.org>
+
+ * gnus-util.el (gnus-string-equal): Revert last change.
+
+2003-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-browse-make-menu-bar): Fix typo.
+
+2003-04-17 Mike Woolley <mike@ariel.co.uk>
+
+ * gnus-sum.el (gnus-sum-thread-tree-false-root): New variable.
+
+2003-04-15 Michael Shields <shields@msrl.com>
+
+ * gnus-art.el (article-hide-boring-headers): Hide Reply-To: if
+ the broken-reply-to group parameter is set. Idea from Vasily
+ Korytov <deskpot@myrealbox.com>.
+
+2003-04-17 Steve Youngs <youngs@xemacs.org>
+
+ * dgnushack.el: 'setenv' is in env.el for XEmacsen <= 21.4, but in
+ process.el in XEmacsen >= 21.5.
+
+2003-04-17 Steve Youngs <youngs@xemacs.org>
+
+ * dgnushack.el: Add a whole swag of autoloads and defaliases to
+ satisfy the byte-compiler when building with XEmacs.
+
+ * lpath.el (maybe-bind): Add 'w3-meta-content-type-charset-regexp'
+ and 'w3-meta-charset-content-type-regexp' in XEmacs. The upstream
+ W3 doesn't have these.
+
+ * mailcap.el: Maybe require 'lpr in XEmacs.
+
+2003-04-16 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-sign): Bind pgg-default-user-id to MML
+ sender tag, if available.
+
+2003-04-16 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-registry.el (gnus-register-action)
+ (gnus-register-spool-action, hashtable-to-alist)
+ (gnus-registry-translate-from-alist, alist-to-hashtable)
+ (gnus-registry-translate-to-alist, gnus-registry-headers-hashtb):
+ new variables and function fixes
+
+ * gnus.el (gnus-registry-headers-alist): new variable to hold
+ article header data
+ (gnus-variable-list): save gnus-registry-headers-alist
+
+ * spam-report.el (Module): new module for spam reporting
+
+ * gnus.el (spam-process): added
+ gnus-group-spam-exit-processor-report-gmane to the list of choices
+ (gnus-install-group-spam-parameters): defined new spam exit processor
+
+ * spam.el (autoload): autoload spam-report-gmane when needed
+ (spam-report-gmane-register-routine): glue for spam-report.el
+ (spam-group-spam-processor-report-gmane-p): glue for the
+ gnus-group-spam-exit-processor-report-gmane spam processor
+ (spam-summary-prepare-exit): check the report-gmane spam processor
+ and run spam-report-gmane-register-routine if it's active
+
+ From John Wiegley <johnw@gnu.org>
+
+ * spam.el (spam-bogofilter-score): check bogofilter headers before
+ checking bogofilter itself
+
+2003-04-16 Dave Love <fx@gnu.org>
+
+ * gnus-agent.el: Wrap defsetf in eval-when-compile.
+ (gnus-agent-cat-defaccessor): Don't use gensym.
+
+ * mml1991.el: Require cl, mm-util when compiling.
+ (quoted-printable-decode-region, quoted-printable-encode-region):
+ Autoload.
+
+ * pgg.el: Require cl when compiling.
+
+ * nnmail.el (gnus): Require.
+
+ * gnus-util.el: Move provide to end.
+ (gnus-string-equal): Maybe use compare-strings.
+ (gnus-merge): New.
+
+ * gnus-sum.el (gnus-summary-prepare-threads): Don't use copy-list.
+ (gnus-summary-insert-articles): Use gnus-merge.
+
+ * gnus-fun.el: Require cl and mm-util when compiling.
+
+ * gnus-diary.el (gnus-diary-delay-format-french)
+ (gnus-diary-delay-format-english): Don't use setf with nthcdr.
+
+ * nndiary.el (nndiary-compute-reminders): Don't use setf with
+ nthcdr.
+
+2003-04-16 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-make-cat): Added optional parameter to
+ specify a predicate other than false.
+ (gnus-category-read): Use the new feature to create a 'default'
+ category with a 'short' predicate.
+
+2003-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-unique-id): Comment change.
+
+ * gnus-art.el (gnus-article-next-page-1): New function.
+ (gnus-article-next-page): Use it.
+
+2003-04-15 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-split): added save-restriction to save-excursion
+
+2003-04-15 Reiner Steib <Reiner.Steib@gmx.de>
+ From Julien Avarre <julien@avarre.com>
+
+ * gnus-fun.el: Fixed autoload cookie.
+
+2003-04-15 Paul Jarc <prj@po.cwru.edu>
+ From Remi Letot <remi.letot@easynet.be>
+
+ * nnmaildir.el (nnmaildir-request-scan): Use gnus-remove-if
+ instead of remove-if.
+
+2003-04-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-news-other-window): Use delq and
+ copy-sequence instead of remove which is a cl run-time function in
+ Emacs 20.
+
+2003-04-14 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-summary-news-other-window): Make a buffer
+ local copy of gnus-discouraged-post-methods with the current
+ method removed.
+
+2003-04-14 Simon Josefsson <jas@extundo.com>
+
+ * mailcap.el (mailcap-mime-data): Add application/pgp-keys.
+
+2003-04-13 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mm-util.el (mm-sort-coding-systems-predicate): Convert elements
+ of `mm-coding-system-priorities' to base coding system.
+
+ * gnus-sum.el: Added coding cookie ("middle dot" in
+ gnus-summary-morse-message).
+
+2003-04-13 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (article-fill-long-lines)
+ (article-verify-x-pgp-sig, article-decode-group-name)
+ (gnus-mime-button-menu): Split >80 character lines.
+
+2003-04-13 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-local-variables): Use defvar since
+ we're let-binding it.
+
+ * nnmbox.el (nnmbox-mbox-buffer): It's not a constant.
+
+2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-hide-headers): Don't do intangible.
+
+ * gnus.el (gnus-group-prefixed-name): Comment out the test for
+ colon.
+
+ * gnus-srvr.el (gnus-browse-read-group): Don't give the real name
+ to the ephemeral entry, but the prefixed name.
+
+ * gnus.el (gnus-group-prefixed-name): Clean up.
+
+2003-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-group-pathname): Bind
+ gnus-command-method so that gnus-agent-directory will always
+ return a valid directory.
+ * gnus-cache.el (gnus-cache-enter-article): Remove article from
+ gnus-newsgroup-undownloaded so that the summary will display the
+ article as downloaded.
+ (gnus-cache-remove-article): If the article isn't in the agent,
+ remove it from gnus-newsgroup-undownloaded so that the summary
+ will display the article as undownloaded.
+
+2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-04-13 01:12:01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.18 is released.
+
+2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-draft.el (gnus-draft-send): Add message-hidden-headers.
+
+2003-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-next-page): Use
+ gnus-article-over-scroll.
+ (gnus-article-over-scroll): New variable.
+
+ * message.el (message-newline-and-reformat): Place a boundary
+ before filling.
+ (message-make-forward-subject-function): Changed default to
+ message-forward-subject-name-subject.
+ (message-forward-subject-name-subject): New function.
+
+ * nnimap.el (nnimap-split-fancy): Ditto.
+
+ * gnus-sum.el (gnus-summary-line-message-size): Ditto.
+
+ * gnus-cus.el (gnus-group-parameters): Removed "which see".
+
+ * mml.el (mml-minibuffer-read-file): Bind
+ completion-ignored-extensions to nil.
+
+ * message.el (message-fix-before-sending): Comment fix.
+ (message-fix-before-sending): Make hidden headers visible.
+ (message-hide-headers): Bind after-change-functions to nil.
+ (message-forbidden-properties): Put invisible and intangible
+ back.
+ (message-strip-forbidden-properties): Ignore message-hidden text.
+
+ * gnus-msg.el: Hide headers.
+
+ * message.el (message-hidden-headers): New variable.
+ (message-hide-headers): New function.
+ (message-hide-header-p): New function.
+ (message-hide-header-p): Change logic.
+ (message-forbidden-properties): Remove intangible nil invisible
+ nil.
+ (message-hide-headers): Narrow to headers.
+
+ * lpath.el (featurep): Bind Info-directory, Info-menu.
+
+2003-04-12 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-body-charset-encoding-alist): UTF-16 *must* be
+ encoded.
+ (mm-encode-body): Don't corrupt UTF-16.
+ (mm-body-encoding): Pay attention to mm-body-charset-encoding-alist.
+
+2003-04-10 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): Articles in
+ the CACHE are now detected and handled the same as an article
+ downloaded into the agent.
+ (gnus-agent-group-path): Modified to match nnmail-group-pathname
+ so that the agent front-end and back-end (nnagent) always use the
+ same directory.
+ (gnus-agent-group-pathname): New function. Wrapper for
+ nnmail-group-pathname.
+ (gnus-agent-expire-unagentized-dirs): New variable. May be
+ customized to disable gnus-agent-expire-unagentized-dirs.
+ (gnus-agent-expire-unagentized-dirs): Expand gnus-agent-directory
+ as the directories in gnus-agent-expire-current-dirs were
+ expanded.
+
+2003-04-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Encrypt
+ body" entry in read only groups.
+
+2003-04-09 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Import file"
+ and "Create article" items in non-editable groups.
+
+2003-04-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-write-active): Added option of
+ replacing, rather than updating, the agent's active file. Do NOT
+ use the fully qualified group name as gnus-active-to-gnus-format
+ blindly prefixes group names with server names.
+ (gnus-agent-save-group-info): Merge BOTH min/max of current active
+ range, was just merging min, with specified active range.
+ (gnus-agent-expire): Save agent's active ranges after
+ expiring all groups.
+ (gnus-agent-expire-group-1): Update min of agent's active range to
+ min article currently fetched.
+ (gnus-agent-expire-unagentized-dirs): Avoid asking to delete the
+ same ancestor multiple times.
+
+ * gnus-async.el (gnus-asynchronous): Moved defcustom of
+ gnus-asynchronous away from defgroup of gnus-asynchronous. This
+ seems to fix an intermittant error in which loading gnus-async
+ fails to define gnus-asynchronous (the variable).
+
+ * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is
+ non-essential. Removed on all platforms.
+ (gnus-select-newsgroup): When the agent is active, expand the
+ group's active range to include fetched articles that are no
+ longer in the server's active range.
+
+ * gnus-util.el (gnus-with-output-to-file): Removed all of the
+ print-* bindings as they should be handled by the function doing
+ the printing.
+
+2003-04-09 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-uu.el (mm-uu-copy-to-buffer): buffer-file-coding-system
+ might be unbound in non-MULE XEmacsen.
+
+2003-04-08 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-uu.el (mm-uu-diff-groups-regexp, mm-uu-type-alist)
+ (mm-uu-diff-extract, mm-uu-diff-test): New functionality:
+ recognize diffs.
+
+ * mm-bodies.el (mm-decode-body): Use the supplied charset
+ unconditionally if `code-pages' hasn't been loaded.
+
+2003-04-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (article-verify-x-pgp-sig): Don't use
+ `insert-buffer', the docstring says "This function is meant for
+ the user to run interactively. Don't call it from programs!"
+
+ * mm-extern.el (mm-extern-mail-server): do.
+
+ * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-sign)
+ (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign)
+ (mml1991-pgg-encrypt): do.
+
+ * pgg.el (pgg-decrypt-region): do.
+
+ * mm-view.el (mm-view-pkcs7-decrypt): do.
+
+ * mml-smime.el (mml-smime-verify): do.
+
+ * mml.el (mml-insert-mime, mml-preview): do.
+
+ * mml2015.el (mml2015-gpg-decrypt-1, mml2015-gpg-sign)
+ (mml2015-gpg-encrypt, mml2015-pgg-clear-decrypt)
+ (mml2015-pgg-encrypt): do.
+
+2003-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-bodies.el (mm-decode-body): Silence XEmacs when compiling.
+
+2003-04-06 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-uu.el (mm-uu-copy-to-buffer): Copy
+ `buffer-file-coding-system' to the new buffer.
+ (mm-uu-pgp-signed-extract-1): Don't copy
+ `buffer-file-coding-system' here.
+
+ * mm-bodies.el (mm-decode-body): last-coding-system-used doesn't
+ exist in XEmacs.
+ (mm-decode-body): Add missing quote.
+
+ * mm-uu.el (mm-uu-pgp-signed-extract-1): Set
+ buffer-file-coding-system.
+
+ * mm-bodies.el (mm-decode-body): Set buffer-file-coding-system to
+ last-coding-system-used.
+
+ * mml2015.el (mml2015-pgg-clear-verify): Encode the text
+ according to buffer-file-coding-system.
+
+ * pgg-gpg.el (pgg-gpg-process-region): Revert previous change.
+
+ * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region)
+ (pgg-pgp-snarf-keys-region): do.
+
+ * pgg-pgp5.el (pgg-pgp5-verify-region)
+ (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do.
+
+ * pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do.
+
+2003-04-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-split): (save-excursion) around (widen)
+ (spam-ham-move-routine): Use spam-group-ham-mark-p, not
+ spam-group-spam-mark-p (from Michael Shields <shields@msrl.com>)
+
+2003-04-05 Steve Youngs <youngs@xemacs.org>
+
+ * gnus-sum.el: XEmacs doesn't support the 5th arg to 'load', so
+ don't use it when loading gnus-sum.el if we're in XEmacs.
+
+2003-04-05 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
+ print-escape-nonascii to fix more characters in compiled format
+ specs.
+
+2003-04-05 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player):
+ Fix customization type.
+
+2003-04-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
+ print-quoted, print-readably, print-escape-multibyte, and
+ print-level to match original behavior of gnus-prin1. This should
+ repair the format of .newsrc.eld when using compiled format specs.
+
+2003-04-04 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (tool-bar-map): defvar it.
+
+ * gnus-art.el (tool-bar-map): do.
+
+ * gnus-sum.el (tool-bar-map): do.
+
+2003-04-03 Jesper Harder <harder@ifa.au.dk>
+
+ * earcon.el (earcon-regexp-alist): catmeow is a wav file.
+
+2003-04-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-ctan-directory-regexp): Changed meaning
+ and value.
+ (gnus-button-alist): Use it.
+
+2003-04-03 Jesper Harder <harder@ifa.au.dk>
+
+ * pgg-gpg.el (pgg-gpg-process-region): do.
+
+ * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region)
+ (pgg-pgp-snarf-keys-region): do.
+
+ * pgg-pgp5.el (pgg-pgp5-verify-region)
+ (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): Use it.
+
+ * pgg.el (pgg-make-temp-file): New function. `make-temp-name' is
+ unsafe.
+ (pgg-temporary-file-directory): Remove.
+
+2003-04-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind Info-directory and Info-menu.
+
+2003-04-02 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-util.el (gnus-message): Added doc-string.
+
+ * gnus-score.el (gnus-score-find-trace): Changed behavior of `q'.
+ (gnus-score-edit-file-at-point): Goto first match when using `e'.
+
+2003-04-01 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-ctan-directory-regexp): New variable.
+ (gnus-button-alist): Use it. Changed CTAN and "setq" entries.
+
+2003-04-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-via-rlogin-command-switches): Doc fix.
+ (nntp-open-via-rlogin-and-telnet): Disable the telnet linemode.
+
+2003-03-31 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
+ print-escape-newlines to print escape sequences rather than
+ literal newline characters.
+
+2003-03-31 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-valid-fqdn-regexp): Use
+ `message-valid-fqdn-regexp' for initialization.
+ (gnus-button-handle-info-url): Renamed and extended version of
+ `gnus-button-handle-info'.
+ (gnus-button-message-level): Renamed from `gnus-button-mail-level'
+ (gnus-button-handle-symbol, gnus-button-handle-library)
+ (gnus-button-handle-info-keystrokes): New functions.
+ (gnus-button-browse-level): New variable.
+ (gnus-button-alist): Use them. Added levels.
+ (gnus-header-button-alist): Added levels.
+
+2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-03-31 20:08:19 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.17 is released.
+
+2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-unload): Removed.
+
+ * pop3.el (pop3-read-response): Use
+ nnheader-accept-process-output.
+ (pop3-retr): Ditto.
+
+ * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx.
+ (mm-text-html-washer-alist): Ditto.
+
+2003-03-31 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-gssapi-program): Also try GNU SASL.
+ (imap-gssapi-open): Accept GNU SASL greeting.
+ (imap-read-timeout): New.
+ (imap-wait-for-tag): Use it.
+
+2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-accept-process-output): Use new function.
+
+ * nnheader.el (nnheader-read-timeout): New variable.
+ (nnheader-accept-process-output): New function.
+
+ * nntp.el (nntp-read-timeout): Removed.
+
+ * gnus-sum.el (gnus-summary-prepare-threads): Add comment.
+
+2003-03-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cache.el (gnus-cache-braid-nov): Revoke last change.
+
+2003-03-30 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-idna-inside-rhs-p): Narrow to header before
+ searching.
+
+ * gnus-art.el (article-decode-idna-rhs): More restrictive regexp.
+
+2003-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-process-mmdf-mail-format): Indent.
+
+2003-03-28 Vasily Korytov <deskpot@myrealbox.com>
+
+ * message.el (message-make-in-reply-to): Use
+ mail-extract-address-components to determine sender's
+ name/address.
+
+2003-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nndoc.el (nndoc-type-alist): Move mime-parts further ahead.
+
+ * gnus-registry.el (gnus-registry-translate-to-alist): Make a
+ valid lambda.
+ (gnus-registry-translate-from-alist): Ditto.
+
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind
+ print-length to nil.
+
+ * gnus-sum.el (gnus-summary-highlight-line-0): Indent.
+
+ * gnus-fun.el (gnus-fun-ppm-change-string): New function.
+ (gnus-grab-cam-face): Use it.
+
+2003-03-28 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-set-mark)
+ (nnmaildir-close-group): Allow each mark directory in a group to
+ have its own inode for mark files, to accommodate AFS.
+
+2003-03-28 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-start.el (gnus-read-newsrc-el-hook): new hook called by
+ gnus-read-newsrc-el-file
+ (gnus-read-newsrc-el-file): call the gnus-read-newsrc-el-hook
+
+ * gnus-registry.el (gnus-registry-translate-to-alist)
+ (gnus-registry-translate-from-alist, alist-to-hashtable)
+ (hashtable-to-alist): new functions
+ (gnus-register-spool-action): add a spool item to the registry
+
+ * gnus.el (gnus-variable-list): added gnus-registry-alist to the
+ list of saved variables
+ (gnus-registry-alist): new variable
+
+2003-03-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (article-decode-group-name): Be correct instead of
+ smart.
+
+2003-03-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Bind url-current-object for Emacs; bind
+ gnus-agent-expire-current-dirs for XEmacs; fbind open-ssl-stream
+ for both Emacsen.
+
+2003-03-27 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-article-loose-mime)
+ (gnus-article-emulate-mime): Move to gnus-article-mime customize
+ group.
+
+ * gnus-msg.el (gnus-mailing-list-groups): Fix customize type and
+ doc string.
+
+2003-03-26 Kevin Ryde <user42@zip.com.au>
+
+ * gnus-sum.el (gnus-summary-find-for-reselect): Renamed from
+ gnus-summary-find-uncancelled, skip temporary articles inserted by
+ "refer" functions.
+
+2003-03-26 Vasily Korytov <deskpot@myrealbox.com>
+
+ * smiley.el (smiley-buffer): New function.
+
+2003-03-26 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Replaced
+ gnus-summary-update-line (which updated the article's face) with
+ gnus-summary-update-download-mark (which updates the article's
+ face by calling gnus-summary-update-line AND updates the download
+ mark to show that the article was fetched).
+
+2003-03-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Provides
+ option of deleting agent directories for groups/servers that are
+ not currently agentized.
+ (gnus-agent-expire): Use gnus-agent-expire-unagentized-dirs.
+
+ * gnus-int.el (gnus-open-server): Report backend errors in
+ condition handler.
+
+2003-03-23 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-idna-to-ascii-rhs-1): Don't continue outside
+ header.
+
+ * rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To
+ same as Newsgroups.
+
+ * nntp.el (nntp-open-connection-function): Mention
+ nntp-open-tls-stream.
+ (nntp-open-tls-stream): New function.
+
+ * tls.el: New file.
+
+ * nnimap.el (nnimap-server-port, nnimap-stream): Say TLS/SSL
+ instead of SSL.
+ (nnimap-stream): Add other streams, link to imap variables.
+ (nnimap-authenticator): Add other authenticator, link to imap
+ variables.
+
+ * imap.el: Autoload open-tls-stream.
+ (imap-streams): Add tls in front of ssl.
+ (imap-stream-alist): Add tls.
+ (imap-default-tls-port): New variable.
+ (imap-tls-p, imap-tls-open): New functions.
+
+2003-03-22 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-url.el (mm-url-insert-file-contents): parse url only if
+ results is a list.
+
+2003-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch-imap): Revert.
+
+2003-03-22 Svend Tollak Munkejord <stm@bacchus.pvv.org>
+
+ * deuglify.el (gnus-outlook-repair-attribution-outlook): Use a
+ less strict regexp.
+
+2003-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch-imap): Use buffer name for
+ more imap function.
+
+2003-03-21 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (article-decode-group-name): Replace Newsgroups and
+ Followup-To data inline.
+
+2003-03-21 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-treat-display-xface): Don't enable if
+ icontopbm isn't available.
+
+2003-03-21 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-int.el (gnus-open-server): Catch errors in backend's
+ open-server method. Returns nil rather than crashing startup.
+
+ * gnus-sum.el (eval-when-compile): Modified to resolve
+ compile-time warnings.
+
+ * gnus-uu.el (gnus-uu-mark-series): Added informative msg.
+ Reports length of series so that the user can compare N with a
+ subject that should, if the entire series is present, contain
+ '(.../N)'.
+ (gnus-uu-delete-work-dir): Avoid hanging when O/S forbids deletion
+ of temp file (Win-XP may leave the temp file locked when the
+ uudecode process fails).
+
+2003-03-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-split-line): Ignore error.
+
+ * lpath.el (split-line): Avoid split-line warning message.
+
+2003-03-20 Kim F. Storm <storm@cua.dk>
+
+ * message.el (message-split-line): New function.
+ (message-mode-map): Remap split-line to message-split-line.
+
+2003-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-make-overlay): Defalias it to make-overlay.
+ (message-delete-overlay): Defalias it to delete-overlay.
+ (message-overlay-put): Defalias it to overlay-put.
+ (message-idna-to-ascii-rhs-1): Use them.
+
+ * messagexmas.el (message-xmas-redefine): Defalias some overlay
+ functions to extent functions.
+
+2003-03-20 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-check-news-header-syntax): Fixed regexp.
+
+2003-03-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2231.el (rfc2231-decode-encoded-string): Downcase charset.
+
+ * mm-url.el (mm-url-insert): Move url-current-object stuff into
+ mm-url-insert-file-contents.
+
+ * nnrss.el (nnrss-fetch): Fetch the local stuff.
+ (nnrss-check-group): Use it.
+
+2003-03-20 Mark A. Hershberger <mah@everybody.org>
+
+ * nnrss.el: Primitive XML Name-space support. This means that RSS
+ feeds like Kevin Burton's[1] can now be read in Gnus.
+
+ Implemented support for Mark Pilgrim's RSS Autodiscovery.[2] This
+ means that if you want to read the RSS feed for example.com, all
+ you have to do is hit "G R http://www.example.com/ RET" and
+ nnrss.el will find and the feed listed on the site or (if you have
+ loaded xml-rpc.el) look it up on syndic8.com.
+
+ Marked the message as HTML (by adding a Content-Type header) so
+ that Gnus will render it as html if the user wants that.
+
+ Implemented the ability to save nnrss-group-alist so that any new
+ feeds the you subscribe to will be found the next time you start
+ up.
+
+ Implemented support for RSS 2.0 elements (author, pubDate).
+
+ Prefer for <content:encoded> over <description> where both
+ elements exist.
+
+ * mm-url.el (mm-url-insert): Set url-current-object.
+
+ * gnus-group.el (gnus-group-make-rss-group): New function.
+
+2003-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-idna-to-ascii-rhs-1): Don't use replace-*
+ for highlight overlays.
+
+2003-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cache.el (gnus-cache-braid-nov): Test if a line looks like
+ a NOV.
+
+2003-03-20 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-use-idna): Disable if UTF-8 unavailable.
+ (message-idna-to-ascii-rhs): Use it.
+
+ * gnus-art.el (gnus-use-idna): Disable if UTF-8 unavailable.
+
+2003-03-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p)
+ (spam-group-ham-marks, spam-group-spam-marks): new functions
+ (spam-spam-marks, spam-ham-marks): removed in favor of the
+ spam-marks and ham-marks parameters
+ (spam-generic-register-routine, spam-ham-move-routine): use the
+ new spam-group-{spam,ham}-mark-p functions
+
+ * gnus.el (spam-marks, ham-marks): new group parameters with
+ default values same as the old spam-spam-marks and spam-ham-marks
+
+2003-03-19 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-article-decode-hook): Add IDNA.
+ (gnus-use-idna): New variable.
+ (article-decode-idna-rhs): New function.
+
+ * message.el (message-use-idna): New variable.
+ (message-mode-field-menu): Add entry for IDNA.
+ (message-idna-inside-rhs-p, message-idna-to-ascii-rhs-1)
+ (message-idna-to-ascii-rhs): New function.
+ (message-generate-headers): Invoke IDNA code.
+
+2003-03-19 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--system-name): New function.
+ (nnmaildir-request-accept-article): Use it.
+
+2003-03-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el (gnus-byte-compile): Make it work silently as the
+ gnus-compile function does.
+
+ * gnus-sum.el (gnus-summary-highlight-line-0): Revoke the last
+ bogus change.
+
+2003-03-19 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-mule-charset-to-mime-charset): Test if
+ sort-coding-systems is defined.
+
+2003-03-18 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-open-server, nnmaildir-request-scan)
+ (nnmaildir-request-create-group, nnmaildir-request-delete-group):
+ Replace create-directory with target-prefix.
+
+2003-03-18 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-decode-coding-region-safely): Don't use
+ find-charset-string which is slooow in XEmacs.
+
+2003-03-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-highlight-line-0): Silence the byte-
+ compiler under XEmacs.
+
+2003-03-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-treat-highlight-signature): Make the default
+ work for multipart/signed where the message text isn't `last'.
+
+2003-03-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-setup-w3m): Set w3m-display-inline-images to
+ the value of mm-inline-text-html-with-images.
+ (mm-inline-text-html-render-with-w3m): Don't bind
+ w3m-display-inline-images.
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Don't bind
+ w3m-display-inline-images.
+
+ * lpath.el: Bind w3m-display-inline-images; bind mm-w3m-mode-map
+ regardless of an Emacs flavor.
+
+2003-03-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump.
+
+2003-03-18 00:38:22 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.16 is released.
+
+2003-03-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * lpath.el (featurep): Bind mm-w3m-mode-map.
+
+2003-03-17 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmail.el (nnmail-cache-primary-mail-backend): Not all
+ 'respool-able backends define a global nnchoke-get-new-mail
+ variable.
+
+2003-03-17 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-mime-delete-part): New function.
+ (gnus-mime-action-alist, gnus-mime-button-commands): Use it.
+
+2003-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-check-news-header-syntax): Don't push
+ groups twice onto list of unknown groups.
+
+ * nndoc.el (nndoc-type-alist): Move exim-bounce a bit further
+ back.
+
+ * nnheader.el (nnheader-find-etc-directory): Doc fix.
+
+ * gnus-msg.el (gnus-inews-add-send-actions): Don't restore window
+ config unless the summary buffer exists.
+
+ * gnus-sum.el (gnus-summary-next-group): Semi-exit group first to
+ that target group is computed correctly when articles are marked
+ as read by Xref handling.
+
+ * mail-source.el (mail-source-fetch-imap): Pass buffer-name to
+ imap-open.
+
+ * message.el (message-send-mail): Add courtesy string to Bcc's,
+ too.
+
+ * gnus-cite.el (gnus-cited-line-p): New function.
+
+2003-03-15 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-decode-body): Add new optional parameter,
+ force, to use the supplied charset unconditionally.
+
+ * gnus-art.el (article-decode-charset): Use it.
+
+2003-03-14 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-decode-coding-region-safely): New function.
+ (mm-decode-body): Use it.
+
+ * rfc2047.el (rfc2047-decode-region): do.
+ (rfc2047-decode-string): Guess coding system if the default is
+ invalid.
+
+2003-03-12 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-update-info): Pretend missing
+ articles are marked 'read, so we get correct article counts.
+
+2003-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-insert-mime-button): Exclude a newline from
+ the button.
+ (gnus-insert-prev-page-button): Ditto.
+ (gnus-insert-next-page-button): Ditto.
+ (gnus-insert-mime-security-button): Ditto.
+
+ * mm-view.el (mm-inline-image-emacs): Open the bottom of an image
+ one line. Suggested by Greg Klanderman <gak@klanderman.net>.
+ (mm-inline-image-xemacs): Ditto.
+
+2003-03-12 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--parse-filename, nnmaildir--sort-files,
+ nnmaildir--scan, nnmaildir-request-accept-article): Changes for
+ the recent filename uniqueness discussion.
+
+2003-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-inline-image-emacs): Make it delete an excessive
+ newline next time.
+ (mm-inline-image-xemacs): Ditto.
+
+2003-03-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use
+ kill-line.
+
+2003-03-09 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use
+ kill-line.
+
+2003-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just
+ fixing the code to match the documentation.
+ (gnus-agent-fetch-selected-article): Replaced
+ gnus-summary-update-article-line with gnus-summary-update-line as
+ the former did not correctly recalculate the thread indentation.
+ (gnus-agent-find-parameter): The agent-predicate, if not found
+ anywhere else, defaults to the value of gnus-agent-predicate.
+ (gnus-agent-fetch-session): Fixed typo; now executes
+ gnus-agent-fetched-hook rather than the undocumented
+ gnus-agent-fetch-hook.
+ (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The
+ default agent predicate is now provided by
+ gnus-agent-find-parameter.
+ (gnus-agent-message): New macro. This macro avoids potentially
+ costly parameter evaluation when the message's level is too high
+ to display.
+ (gnus-agent-expire-group-1): Disabled undo tracking in temp
+ overview buffer. Uses new gnus-agent-message macro to reduce
+ overhead of optional messages. Reversed message levels to
+ emphasize percent completion messages. Detailed messages of
+ little use except when debugging code.
+
+2003-03-08 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine): use
+ spam-mark-ham-unread-before-move-from-spam-group
+ (spam-mark-ham-unread-before-move-from-spam-group): new variable
+
+2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: load nnimap.el when compiling
+ (spam-setup-widening): use
+ nnimap-split-download-body-default instead of
+ nnimap-split-download-body which is a user-customizable variable
+
+2003-03-07 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-download-body-default): New, holds
+ default for n-s-d-b.
+ (nnimap-split-download-body): Add new setting (symbol default),
+ which uses contents of n-s-d-b-d, and made it the default.
+
+2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-hashcash): new variable
+ (spam-list-of-checks): added spam-use-hashcash with associated
+ spam-check-hashcash
+ (spam-check-hashcash): new function, installed iff hashcash.el is
+ loaded
+ (spam-setup-widening): don't use (return)
+
+2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Added default
+ predicate of `false' to avoid an error when a group defines no
+ predicate. Fixed typo that disabled agent scoring (i.e. the
+ low/high predicates should now work).
+
+2003-03-06 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: add spam-maybe-spam-stat-load to
+ gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook
+ (spam-bogofilter-register-with-bogofilter): use
+ spam-bogofilter-spam-switch and spam-bogofilter-ham-switch
+ (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): new
+ custom variables to replace "-s" and "-n"
+
+ * gnus-group.el (gnus-group-get-new-news): call the new
+ gnus-get-top-new-news-hook hook
+
+ * gnus-start.el (gnus-get-top-new-news-hook): new hook, run ONLY
+ by gnus-get-new-news, NOT by gnus-group-get-new-news-this-group
+
+2003-03-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message.
+
+2003-03-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cus.el (gnus-group-customize): Don't use delete-if which is
+ a cl run-time function.
+
+2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding
+ on gnus-agent-short-article.
+ (gnus-category-read): Replaced CL function mapcar* with new macro:
+ gnus-mapcar.
+ * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to
+ support functions that accept multiple parameters. A separate
+ sequence must be provided for each parameter in the function.
+ Iteration stops when the end of the shortest list is reached.
+
+2003-03-06 Jesper Harder <harder@ifa.au.dk>
+
+ * nnimap.el (nnimap-request-accept-article): Use delete-region.
+
+ * html2text.el (html2text-clean-dtdd, html2text-delete-tags)
+ (html2text-delete-single-tag, html2text-clean-anchor)
+ (html2text-remove-tags): Use delete-region.
+ (html2text-fix-paragraphs): Simplify.
+
+ * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt)
+ (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign)
+ (mml1991-pgg-encrypt, mml1991-pgg-encrypt): Use delete-region, not
+ kill-region.
+
+2003-03-04 John Paul Wallington <jpw@gnu.org>
+
+ * gnus-agent.el (gnus-agent-enable-expiration)
+ (gnus-agent-article-alist, gnus-agent-article-alist)
+ (gnus-agent-cat-defaccessor): Doc fixes.
+
+2003-03-04 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-function-implies-unread-1): Grok
+ byte-compiled functions.
+
+2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides
+ customization between new maneuvering (which permits selecting
+ undownloaded articles) and old maneuvering (which skipped over
+ undownloaded articles) behaviors.
+ (gnus-summary-find-next): Pass through the unread and subject
+ parameters when calling gnus-summary-find-prev.
+ (gnus-summary-find-next,gnus-summary-find-prev): Apply
+ gnus-auto-goto-ignores to filter out unacceptable articles.
+
+2003-03-04 Jesper Harder <harder@ifa.au.dk>
+
+ * mail-source.el (mail-source-read-passwd): Remove. `read-passwd'
+ exists in all supported Emacs versions, so we don't need this
+ compatibility function.
+ (mail-source-fetch-pop, mail-source-check-pop)
+ (mail-source-fetch-webmail): Use read-passwd.
+
+ * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo)
+ (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use
+ read-passwd.
+
+ * nnwarchive.el (nnwarchive-open-server): Use read-passwd.
+
+ * imap.el (imap-read-passwd): Remove.
+ (imap-interactive-login): Use read-passwd.
+
+ * canlock.el (canlock-read-passwd): Remove.
+ (canlock-insert-header, canlock-verify): Use read-passwd.
+
+ * sieve-manage.el (sieve-manage-read-passwd): Remove.
+ (sieve-manage-interactive-login): Use read-passwd.
+
+ * pop3.el (pop3-read-passwd): Remove.
+ (pop3-movemail, pop3-get-message-count, pop3-apop): Use
+ read-passwd.
+
+ * pgg.el (pgg-read-passphrase): Simplify.
+
+2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports
+ 'plugged' when actually 'unplugged' bug.
+ (gnus-category-read): Ignore nil values when converting an
+ old-format category so that the new-format category will default
+ those attributes to the global variables.
+
+2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed
+ doc-string.
+
+2003-03-03 Jesper Harder <harder@ifa.au.dk>
+
+ * nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'.
+ * nndoc.el (nndoc-dissect-mime-parts-sub): do.
+ * nndb.el (nndb-request-accept-article, nndb-status-message): do.
+ * mm-url.el (mm-url-decode-entities-string): do.
+ * mml1991.el (mml1991-mailcrypt-sign, mml1991-gpg-sign): do.
+ * mm-decode.el (mm-find-raw-part-by-type): do.
+ * message.el (message-send-mail-partially)
+ (message-send-mail-with-sendmail): do.
+ * gnus-uu.el (gnus-uu-save-article, gnus-uu-reginize-string): do.
+ * gnus-kill.el (gnus-pp-gnus-kill): do.
+ * gnus-art.el (gnus-article-treat-unfold-headers)
+ (gnus-article-encrypt-body): do.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mail-source.el (mail-source-delete-incoming): Allow integer value.
+ (mail-source-delete-old-incoming-confirm): New variable.
+ (mail-source-delete-old-incoming): Use it. New function.
+ (mail-source-callback): Call `mail-source-delete-old-incoming' if
+ `mail-source-delete-incoming' is a nonnegative integer.
+
+2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config.
+ (gnus-user-agent): Fixed typo.
+
+2003-03-03 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation.
+ (gnus-agent-expire-group-1): Removed invalid (interactive) specifier.
+
+2003-03-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message.
+ (gnus-agent-fetch-session): Allow debugging to take place.
+
+2003-03-03 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-highlight-selected-summary)
+ (gnus-article-get-xrefs, gnus-summary-show-thread): Use
+ `gnus-point-at-bol' and `gnus-point-at-eol' instead of
+ `(progn (beginning-of-line) (point))'. It's shorter, faster,
+ and makes it clear that we don't need the side effect.
+ * gnus-util.el (gnus-delete-line): do.
+ * gnus-xmas.el (gnus-group-add-icon): do.
+ * nnmail.el (nnmail-article-group, nnmail-cache-fetch-group): do.
+ * nntp.el (nntp-send-authinfo-from-file): do.
+ * nnml.el (nnml-header-value): do.
+ * nnheader.el (nnheader-insert-references): do.
+ * gnus-cite.el (gnus-article-highlight-citation)
+ (gnus-cite-parse): do.
+ * gnus-score.el (gnus-score-followup): do.
+ * gnus-draft.el (gnus-draft-send): do.
+ * gnus-group.el (gnus-group-highlight-line): do.
+ * gnus-cache.el (gnus-cache-braid-nov): do.
+ * nnfolder.el (nnfolder-retrieve-headers)
+ (nnfolder-request-article): do.
+ * gnus-art.el (article-hide-boring-headers)
+ (gnus-article-hide-header): do.
+
+ * nnheader.el (nnheader-find-nov-line): Use gnus-delete-line.
+ * nnml.el (nnml-request-replace-article): do.
+ * nnmbox.el (nnmbox-request-move-article, nnmbox-delete-mail): do.
+ * nnfolder.el (nnfolder-request-move-article): do.
+ * gnus-cache.el (gnus-cache-possibly-remove-article): do.
+ * gnus-art.el (gnus-mm-display-part): do.
+
+ * gnus-art.el (gnus-article-goto-part): Use gnus-goto-char.
+
+2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * nntp.el (nntp-possibly-change-group): Avoid calling
+ process-buffer on nil (Which happened when you lost your
+ connection while fetching); instead signal a "Server Closed
+ Connection" error.
+
+2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-enable-expiration): New
+ variable. Either ENABLE or DISABLE. Sets default behavior for
+ selecting which groups are expired.
+ (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor,
+ gnus-agent-set-cat-groups): Provides abstract interface for
+ accessing agent category. Category now implemented by an alist.
+ (gnus-agent-add-group, gnus-agent-remove-group,
+ gnus-category-insert-line, gnus-category-edit-predicate,
+ gnus-category-edit-score, gnus-category-edit-groups,
+ gnus-category-copy, gnus-category-add, gnus-group-category): Use
+ new agent category abstraction.
+ (gnus-agent-find-parameter): New function. Search for agent
+ configuration parameter first in the group's parameters, then its
+ topics (if any), and then the group's category. If not found
+ anywhere, use the original defined constants.
+ (gnus-agent-fetch-headers, gnus-agent-fetch-group-1): Use new
+ gnus-agent-find-parameter.
+ (gnus-agent-fetch-headers, gnus-agent-uncached-articles): Clearing
+ gnus-agent-cache now blocks retrieving headers and articles from
+ the local cache. Fetched content is still added to the cache
+ before being returned.
+ (gnus-agent-fetch-session): Use error-message-string to generate
+ displayed error message.
+ (gnus-agent-customize-category): New Command. 'e' in category
+ buffer opens category customization buffer.
+ (gnus-category-read): Reads either positional or alist format;
+ returns alist format.
+ (gnus-category-write): Writes category file compatible with
+ current, and previous, versions of gnus-agent.
+ (gnus-category-make-function, gnus-category-make-function-1):
+ Corrected documentation; parameter is predicate NOT category.
+ (gnus-predicate-implies-unread): Now works in more cases per the
+ todo comment.
+ (gnus-function-implies-unread-1): New function. Supports
+ gnus-predicate-implies-unread.
+ (gnus-agent-expire-group): Command now provides default of group
+ under point.
+ (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and
+ agent-days-until-old parameters. No longer supports
+ gnus-agent-expire-days being set to an alist.
+ (gnus-agent-request-article): Now performs its own checks of
+ gnus-agent, gnus-agent-cache, and gnus-plugged rather than
+ assuming that the caller will do them correctly.
+ (): Added one-time hook to gnus-group-prepare-hook. Detects when
+ gnus-agent-expire-days is set to an alist. Converts said alist
+ into group parameter so that gnus-agent-expire-days will not be
+ needed.
+ * gnus-art.el (gnus-request-article-this-buffer): Conditional
+ checks surrounding gnus-agent-request-article removed; now
+ performed by gnus-agent-request-article.
+ * gnus-cus.el (gnus-agent-parameters): New variable. List of
+ customizable group/topic parameters that regulate the agent.
+ (gnus-group-customize): Uses gnus-agent-parameters. Replaced
+ kill-buffer with gnus-kill-buffer to remove the killed buffer from
+ the list of gnus buffers.
+ (gnus-trim-whitespace): Removes leading and trailing whitespace
+ from multiline strings.
+ (gnus-agent-cat-prepare-category-field,
+ gnus-agent-customize-category): Constructs a category
+ customization buffer.
+ * gnus-int.el (gnus-retrieve-headers,
+ gnus-request-expire-articles): No longer checks gnus-agent-cache
+ as it is handled internally by the agent.
+ (gnus-request-head, gnus-request-body): Conditional checks
+ surrounding gnus-agent-request-article removed; now performed by
+ gnus-agent-request-article.
+
+ * gnus-start.el (): Added defvar statements to resolve compilation
+ warnings.
+ (gnus-long-file-names): New function. Isolates platform dependent
+ msdos-long-file-names.
+ (gnus-save-startup-file-via-temp-buffer): New variable. Provides
+ option of writing directly to file. Avoids memory exhausted
+ errors when .newsrc.eld is huge.
+ (gnus-save-newsrc-file): Uses new
+ gnus-save-startup-file-via-temp-buffer.
+ (gnus-gnus-to-quick-newsrc-format): Rewritten to write to
+ standard-output.
+ (gnus-display-time-event-handler): Changed to alias from a defun
+ to avoid a compile-time warning when display-time-event-handler is
+ not defined.
+ * gnus-util.el (gnus-with-output-to-file): New macro. Binds
+ standard-output such that prin1 and princ will write directly to a
+ file.
+
+ * gnus.el (gnus-agent-cache): Expanded documentation.
+ (gnus-summary-high-undownloaded-face): Removed second bold keyword
+ so that this face is actually bold.
+
+ * nnkiboze.el (nnkiboze-request-article): Only use the cache when
+ gnus-use-cache has been set.
+
+2003-03-02 Jesper Harder <harder@ifa.au.dk>
+
+ * nnvirtual.el (nnvirtual-update-xref-header): Simplify.
+
+2003-03-01 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-refer-article): Be more permissive.
+
+2003-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * spam.el: Fix typo.
+
+2003-03-01 Satyaki Das <satyaki@theforce.stanford.edu>
+ (Trivial patch.)
+
+ * pgg-gpg.el (pgg-gpg-process-region): Insert process status into
+ errors-buffer. This produces a nicer error message in case of
+ problems.
+
+2003-03-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-maybe-spam-stat-load, spam-maybe-spam-stat-load):
+ load stats iff spam-use-stat is on
+
+ * spam.el: add spam-maybe-spam-stat-load to gnus-startup hook,
+ also use spam-maybe-spam-stat-load and spam-maybe-spam-stat-save
+ instead of spam-stat-load and spam-stat-save in the
+ gnus-get-new-news-hook and gnus-save-newsrc-hook, respectively
+
+2003-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-text): Ignore errors from enriched-decode.
+
+2003-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-make-fqdn): Protect against nil user-mail.
+
+2003-02-28 Vasily Korytov <deskpot@myrealbox.com>
+
+ * gnus-art.el (gnus-boring-article-headers): New values:
+ 'to-list and 'cc-list.
+
+2003-02-28 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-setup-widening): new function to set
+ nnimap-split-download-body, we add it to gnus-get-new-news-hook
+ (spam-list-of-statistical-checks): list of statistical splitter
+ checks
+ (spam-split): added a widen call when a statistical check is
+ enabled
+
+2003-02-28 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-msg.el (gnus-user-agent): Changed default to
+ 'emacs-gnus-type, renamed 'full.
+
+2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-accept-article): Don't use
+ mail-header-unfold-field.
+
+2003-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * imap.el (imap-ssl-open): Don't depend on ssl.el.
+ * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el.
+
+2003-02-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: add spam-stat-load to gnus-get-new-news-hook
+ (spam-split): remove spam-stat-load call
+
+2003-02-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-toggle-header): Run
+ gnus-article-decode-hook instead of calling a-decode-encoded-words
+ directly (the latter is run as part of the former).
+
+2003-02-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-expire-group): Remove debug.
+
+2003-02-25 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-sendmail-envelope-from): New option.
+ (message-sendmail-envelope-from): New function.
+ (message-send-mail-with-sendmail): Use it.
+
+2003-02-25 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added
+ compensation for TDMA addresses.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-msg.el (gnus-user-agent): New variable.
+ (gnus-version-expose-system): Removed. Obsoleted by
+ `gnus-user-agent'.
+ (gnus-extended-version): Use `gnus-user-agent'.
+
+2003-02-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-stat-register-spam-routine,
+ spam-stat-register-ham-routine): remove spam-stat-save
+ (spam-stat hook): add spam-stat-save to the gnus-save-newsrc-hook
+
+2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-group.el (gnus-topic-mode-p): Fixed free variable
+ reference.
+
+2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * nnheader.el (nnheader-find-nov-line): Changed midpoint
+ calculation to avoid integer overflow.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-start.el (gnus-backup-startup-file): Fixed custom type.
+
+2003-02-24 Ted Zlatanov <tzz@lifelogs.com>
+ * spam.el: disabled spam-get-article-as-filename
+
+ From Michael Shields <shields@msrl.com>
+
+ * gnus-group.el (gnus-group-is-exiting-without-update-p): New.
+ * gnus-sum.el (gnus-summary-exit-no-update): Use it.
+ * gnus-sum.el (gnus-summary-expire-articles): Use it.
+ * spam.el (spam-summary-prepare-exit): Use it.
+ * gnus.el (gnus-install-group-spam-parameters): New.
+ * spam.el (spam-group-ham-processor-copy-p): New.
+ * spam.el (spam-summary-prepare-exit): Support for ham copying.
+ * spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug
+ that would cause the current message to be moved if the group had
+ no spam.
+ * spam.el (spam-ham-move-routine): New `copy' argument.
+
+2003-02-24 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+ From Martin Thornquist <martint@ifi.uio.no>
+
+ * gnus-topic.el (gnus-topic-select-group): Select last group if
+ after last group.
+ * gnus-group.el (gnus-group-select-group): Ditto.
+
+2003-02-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (popup-menu): Compiler macro for Emacs 20.
+ (gnus-article-refer-article): Use gnus-point-at-(b|e)ol instead of
+ point-at-(b|e)ol which aren't available in Emacs 20.
+
+ * gnus-registry.el (puthash): Alias to cl-puthash for Emacs 20.
+
+2003-02-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-start.el (gnus-activate-group): Re-enabled the catch error
+ clause of the condition-case statement. Errors connecting to a
+ server no longer terminate gnus.
+
+ * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to
+ make its use obvious. Added no-nothing case to avoid
+ opening(closing) servers when already open(closed).
+ (gnus-agent-while-plugged): Added macro to facilitate internal use
+ of gnus-agent-toggle-plugged.
+ (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to
+ temporarily open servers.
+ (gnus-agent-get-undownloaded-list): Sort list of article numbers
+ as sorting gnus-newsgroup-headers is wrong.
+ (gnus-agent-summary-fetch-group): Use new gnus-agent-while-plugged
+ to temporarily open servers. Corrected logic to handle setting
+ gnus-agent-mark-unread-after-downloaded.
+ (gnus-agent-fetch-articles): Now handles headers with missing
+ article sizes and/or missing article lengths. Now clears the
+ message buffer when finished.
+ (gnus-agent-fetch-group-1): Position point before calling
+ gnus-summary-set-agent-mark.
+ (gnus-get-predicate): Corrected description, parameter is
+ predicate not category.
+ (gnus-agent-expire-group): Adapted the gnus-agent-expire-* code to
+ provide a separate single group expiration function.
+ (gnus-agent-regenerate-group): Now clears the message buffer when
+ finished.
+
+2003-02-23 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.el (gnus-agent-target-move-group-header): New variable.
+ * gnus-draft.el (gnus-draft-send): If special header
+ "X-Gnus-Agent-Target-Move-Group" is present, do like Gcc into
+ that group, instead of performing the regular sending functions.
+
+2003-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg.
+
+2003-02-20 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-user-fqdn, message-valid-fqdn-regexp): New
+ variables.
+ (message-make-fqdn): Use it. Improved validity check.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-user-mail-address): Check whether
+ user-mail-address looks valid.
+
+ * gnus-msg.el (gnus-mailing-list-followup-to): New function.
+
+ * gnus-util.el (gnus-fetch-original-field): New function.
+
+2003-02-23 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * message.el (message-mode): \\(...\\) around additional
+ paragraph-separate alternative.
+
+2003-02-23 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-mime-button-commands): Add ellipsis.
+ (gnus-mime-button-menu): Define MIME popup menu with easy-menu to
+ display key bindings.
+ (gnus-mime-button-menu): Rewrite.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-button-url-regexp): Removed `.
+
+2003-02-23 Max Froumentin <mf@w3.org>
+
+ * gnus-art.el (gnus-button-url-regexp): Remove `, enter '.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-action-on-part): Require a match
+ interactively.
+
+ * gnus-start.el (gnus-save-newsrc-file): Use
+ gnus-backup-startup-file.
+ (gnus-backup-startup-file): New variable.
+
+2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-summary-buffer-name): Moved function here.
+
+ * gnus-draft.el (defun): Remove debug.
+
+2003-02-22 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-refer-article): Skip method if we
+ can't open server.
+
+2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-draft.el (defun): Configure posting styles.
+
+ * gnus-start.el (gnus-get-unread-articles-in-group): Make sure
+ the entry for the group exists before we alter it.
+
+2003-02-22 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * message.el (message-mode): MML tags separate paragraphs. Small
+ change from David S Goldberg <david.goldberg6@verizon.net>.
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort
+ `gnus-newsgroup-headers'.
+
+ * gnus-art.el (gnus-article-refer-article): Grok more message id
+ formats. From Karl Pfl,Ad(Bsterer <sigurd@12move.de>.
+
+2003-02-22 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't
+ use "path name".
+
+2003-02-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sum.el (gnus-summary-move-article)
+ (gnus-summary-expire-articles): send data header for article, not
+ just article ID
+
+ * gnus-registry.el (gnus-registry-hashtb, gnus-register-action)
+ (gnus-register-spool-action): added hashtable of message ID keys
+ with message motion data
+
+2003-02-21 Florian Weimer <fw@deneb.enyo.de>
+ From Reiner Steib <Reiner.Steib@gmx.de>.
+
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New
+ variable, used in `gnus-button-mid-or-mail-heuristic'.
+ (gnus-button-mid-or-mail-heuristic): New function derived from
+ Florian Weimer's Perl script.
+ (gnus-button-handle-mid-or-mail): Allow a function instead of
+ 'guess.
+ (gnus-button-guessed-mid-regexp): Removed.
+
+2003-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-resend): Bind message-setup-hook to nil;
+ remove X-Draft-From header.
+
+2003-02-20 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-simplify-subject-fully, gnus-subject-equal)
+ (gnus-newsgroup-undownloaded)
+ (gnus-summary-save-parts-default-mime, gnus-auto-select-next):
+ Doc fixes.
+
+2003-02-17 John Paul Wallington <jpw@gnu.org>
+
+ * gnus.el (gnus-shell-command-separator, gnus-email-address)
+ (gnus-default-charset, gnus-other-frame-parameters): Doc fixes.
+
+2003-02-20 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-spec.el (gnus-xmas-format): Use insert instead of
+ insert-string which is obsolete in Emacs 21.4.
+
+ * message.el (message-cross-post-followup-to-header): do.
+
+ * spam.el (spam-ifile-register-with-ifile)
+ (spam-stat-register-spam-routine)
+ (spam-stat-register-ham-routine)
+ (spam-bogofilter-register-with-bogofilter): do.
+
+ * mailcap.el (mailcap-mime-data): Fix typo.
+
+ * gnus-topic.el (gnus-topic-make-menu-bar): Add ellipsis.
+
+2003-02-19 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-cite.el (gnus-cite-unsightly-citation-regexp)
+ (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to
+ `gnus-cite-unsightly-citation-regexp'.
+
+2003-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-copy-article-buffer): Copy an article header
+ even if there's just a header.
+
+2003-02-19 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-fix-before-sending): Fix highlighting of
+ illegible and invisible text.
+
+ * gnus-util.el (gnus-multiple-choice): Separate choices with
+ ",,A (B". Suggested by Dan Jacobson <jidanni@dman.ddts.net>.
+
+2003-02-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer.
+
+2003-02-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine)
+ (spam-mark-spam-as-expired-and-move-routine): use
+ gnus-summary-kill-process-mark and gnus-summary-yank-process-mark
+ around process-mark manipulation on the group
+
+2003-02-17 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart
+ submenu.
+
+2003-02-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch): Reverse the return value of
+ the continuation question.
+
+2003-02-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nndraft.el (nndraft-request-move-article): Bind
+ nnmh-allow-delete-final to t.
+
+2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-uu-filename): Fix use of character constant.
+
+2003-02-11 Stefan Monnier <monnier@cs.yale.edu>
+
+ * nntp.el (nntp-accept-process-output): Don't use point-max to get
+ the buffer's size.
+
+2003-01-31 Joe Buehler <jhpb@draco.hekimian.com>
+
+ * nnheader.el: Added cygwin to system-type comparisons.
+
+2003-01-27 Juanma Barranquero <lektu@terra.es>
+
+ * imap.el (imap-mailbox-status): Fix typo.
+
+2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-prepare): Don't set agent mark if
+ online.
+
+2003-02-14 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all
+ commands.
+ * gnus-sum.el: Small change from Frank Weinberg
+ <frank@usenet-rundfahrt.de>:
+ (gnus-auto-center-group): New variable.
+ (gnus-summary-read-group-1): Use it.
+ (gnus-summary-next-group): Fix docstring.
+
+2003-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el (gnus-faces-at): Simplify.
+
+2003-02-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine)
+ (spam-mark-spam-as-expired-and-move-routine): made the article
+ move conditional, so it's not called even if there's nothing to move
+
+2003-02-13 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * message.el (message-unix-mail-delimiter): Accept any whitespace
+ after the email address and before the date; do not require the
+ space character. From Kurt B. Kaiser <kbk@shore.net>.
+
+2003-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-only-boring-p): Make sure that the
+ gnus-article-boring-faces variable is bound; use gnus-faces-at.
+
+ * gnus-util.el (gnus-faces-at): New macro.
+
+2003-02-13 Michael Shields <shields@msrl.com>
+
+ * gnus-cite.el
+ (gnus-cite-attribution-suffix, gnus-cite-parse):
+ Better handling for Microsoft citation styles.
+ (gnus-unsightly-citation-regexp): New.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * gnus-art.el (article-strip-banner): Strip both per-group and
+ per-user-address banners.
+ (article-really-strip-banner): New.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * gnus-sum.el (gnus-article-goto-next-page,
+ gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of
+ relying on the summary bindings of `n' and `p'.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * gnus-art.el (gnus-article-only-boring-p): New.
+ (gnus-article-skip-boring): New.
+ * gnus-cite.el (gnus-article-boring-faces): New.
+ * gnus-sum.el (gnus-summary-next-page): Use
+ gnus-article-only-boring-p.
+
+2003-02-12 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-mark-spam-as-expired-and-move-routine)
+ (spam-ham-move-routine): unmark all articles before marking those
+ of interest and calling gnus-summary-move-article
+
+2003-02-12 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-kill-buffer): Move to gnus.el because it's
+ logically the complement of gnus-get-buffer-create and
+ gnus-add-buffer.
+
+ * gnus-util.el (gnus-kill-buffer): do.
+
+ * nnmail.el: Autoload gnus-kill-buffer.
+
+2003-02-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-summary-set-agent-mark): Added call to
+ gnus-summary-goto-subject as gnus-summary-update-mark operates on
+ the current LINE.
+ (gnus-agent-summary-fetch-group): Minimized the number of times
+ that the article is updated in the buffer.
+
+2003-02-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine): use the process-mark instead of
+ gnus-current-article when moving articles
+ (spam-mark-spam-as-expired-and-move-routine): ditto, use the process-mark
+
+2003-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-expire-articles): Recursive.
+ (gnus-topic-catchup-articles): Ditto.
+ (gnus-topic-mark-topic): Reverse recursive logic.
+
+2003-02-11 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-refer-thread): Handle case where
+ gnus-refer-thread-limit is t.
+
+2003-02-10 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-mule-charset-to-mime-charset): Use
+ sort-coding-systems to prefer utf-8 over utf-16.
+
+2003-02-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-expire-days):
+ gnus-request-move-article depends on gnus-agent-expire to clean up
+ the cache after moving the article. Therefore, g-a-e-d can NOT
+ default to nil or can gnus-agent-expire be disabled by doing so.
+ If you don't want to run gnus-agent-expire, don't call it.
+ (gnus-agent-expire): The broken test to disable gnus-agent-expire
+ when g-a-e-d was NOT nil was removed.
+ (gnus-agent-article-name): Removed unnecessary input test as
+ article IDs are always strings.
+ (gnus-agent-regenerate-group): Added check to protect against
+ servers that generate absurdly long article IDs. Valid IDs are
+ less than 10 digits to avoid overflow errors. Fixed logic error
+ when ensuring that the final article ID is present in the new
+ alist.
+
+2003-02-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the
+ next line after finding the parent.
+
+2003-02-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bumped.
+
+2003-02-08 23:23:27 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.15 is released.
+
+2003-02-08 Michael Welsh Duggan <md5i@cs.cmu.edu>
+
+ * nnmail.el (nnmail-split-it): If a message ends up matching the
+ same mailbox more than once, it will cause duplicates to appear
+ in the mailbox.
+
+2003-02-08 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-select-article): Remove blink removal
+ code that only worked under Emacs.
+
+ * pgg-gpg.el (pgg-gpg-process-region): Don't blink. From Satyaki
+ Das <satyaki@chicory.stanford.edu>.
+
+2003-02-08 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-refer-article): Use
+ gnus-replace-in-string.
+
+ * gnus-util.el (gnus-map-function): Remove unneeded let-binding.
+ (gnus-remove-duplicates): do.
+
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-int.el (gnus-internal-registry-spool-current-method): new variable
+ (gnus-request-scan): set
+ gnus-internal-registry-spool-current-method to gnus-command-method
+ before a request-scan operation
+
+ * gnus-registry.el (regtest-nnmail): use
+ gnus-internal-registry-spool-current-method
+
+2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch): Typo fix.
+
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * nnmail.el (nnmail-spool-hook): new hook
+ (nnmail-cache-insert): call nnmail-spool-hook
+
+ * gnus-registry.el: new file with examples of using the hooks
+
+ * gnus.el (gnus-registry): added registry customization group
+ (gnus-group-prefixed-name): improve function to return full group
+ name optionally
+ (gnus-group-guess-prefixed-name): shortcut to
+ gnus-group-prefixed-name, using just the group name
+ (gnus-group-full-name): always get a group's full name
+ (gnus-group-guess-full-name): shortcut, using just the group name
+
+ * gnus-sum.el (gnus-summary-article-move-hook)
+ (gnus-summary-article-delete-hook)
+ (gnus-summary-article-expire-hook): new hooks
+ (gnus-summary-move-article, gnus-summary-expire-articles)
+ (gnus-summary-delete-article): invoke the new hooks
+
+2003-02-07 Frank Weinberg <frank@usenet-rundfahrt.de>
+
+ * gnus-art.el (gnus-article-refer-article): Strip leading "news:"
+ from message-ID
+
+2003-02-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-util.el (gnus-run-hooks): Use save-current-buffer.
+
+2003-02-07 John Paul Wallington <jpw@gnu.org>
+
+ * mm-util.el (mm-delete-duplicates, mm-append-to-file)
+ (mm-write-region, mm-detect-coding-region): Doc fixes.
+
+2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch): Ignore errors.
+ (mail-source-ignore-errors): New variable.
+
+ * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current
+ articles.
+
+ * gnus-msg.el (gnus-version-expose-system): Change default.
+
+2003-02-07 Vasily Korytov <deskpot@myrealbox.com>
+
+ * gnus-msg.el (gnus-version-expose-system): New variable.
+
+2003-02-07 Simon Josefsson <jas@extundo.com>
+
+ * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny
+ patch from deskpot@myrealbox.com (Vasily Korytov).
+
+2003-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-display-face): Get the Face header from
+ the current buffer.
+
+2003-02-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-view-part-internally): Bind
+ buffer-read-only to nil.
+
+2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-expire-1,2): Pass the dir argument
+ from g-a-e-1 to g-a-e-2.
+
+2003-02-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-BBDB): no need to regexp-quote the argument
+ of bbdb-search-simple, use spam-use-BBDB-exclusive
+ (spam-check-whitelist): use spam-use-whitelist-exclusive
+ (spam-use-whitelist-exclusive): new variable affecting
+ spam-use-whitelist
+ (spam-use-BBDB-exclusive): new variable affecting spam-use-BBDB
+
+2003-02-05 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agent-expire-days): Change default to nil.
+ (gnus-agent-expire): Don't expire if g-a-e-d is nil.
+ (gnus-agent-expire): Move most code into gnus-agent-expire-1.
+ (gnus-agent-expire-1): New.
+ (gnus-agent-expire-1): Move code into gnus-agent-expire-2.
+ (gnus-agent-expire-2): New.
+
+2003-02-05 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-util.el (gnus-delete-if): Rename to gnus-remove-if.
+ "delete-if" is misleading because it isn't actually destructive.
+
+ * gnus-topic.el (gnus-group-prepare-topics): Use new name.
+
+ * nnmail.el (nnmail-purge-split-history): do.
+
+ * gnus-win.el (gnus-get-buffer-window): do.
+
+ * gnus-sum.el (gnus-simplify-whitespace): Remove unnecessary
+ let-binding.
+ (gnus-simplify-all-whitespace): do.
+
+2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-delay.el (gnus-delay-article): Fix binding of the
+ nndraft:delayed group.
+
+2003-02-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.el (spam group parameters): change 'other to 'const in
+ the group parameter definitions to soothe XEmacs
+
+2003-02-04 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-delay.el (gnus-delay-article): Really create
+ nndraft:delayed group if it doesn't exist.
+
+2003-02-04 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-search-article): Speed up by
+ disabling various visual features while searching.
+ (gnus-summary-recenter): Test gnus-auto-center-summary first.
+
+2003-02-03 Jesper Harder <harder@ifa.au.dk>
+
+ * spam.el (spam-list-of-checks): Don't quote nil and t in
+ docstrings. From the elisp manual:
+
+ When a documentation string refers to a Lisp symbol, write
+ it [..] with single-quotes around it. [..] There are two
+ exceptions: write t and nil without single-quotes.
+
+ * messcompat.el (message-from-style): do.
+
+ * message.el (message-send-mail): do.
+
+ * gnus-util.el (gnus-use-byte-compile): do.
+
+ * gnus-score.el (gnus-score-lower-thread): do.
+
+ * gnus-int.el (gnus-server-unopen-status): do.
+
+ * gnus.el (gnus-define-group-parameter, gnus-large-newsgroup)
+ (large-newsgroup-initial, gnus-install-group-spam-parameters): do.
+
+ * gnus-cus.el (gnus-group-customize, gnus-score-parameters)
+ (gnus-group-parameters): do.
+
+ * gnus-art.el (gnus-article-mime-match-handle-function): do.
+
+ * mm-decode.el (mm-text-html-renderer): do.
+
+2003-02-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnheader.el (nnheader-directory-separator-character): Change the
+ way to compute the dafault value.
+
+2003-02-02 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-button-handle-describe-key): Implement it.
+ (gnus-button-alist): Fix regexp for describe-key.
+ (gnus-button-handle-describe-function)
+ (gnus-button-handle-describe-variable)
+ (gnus-button-handle-apropos, gnus-button-handle-apropos-command)
+ (gnus-button-handle-apropos-variable)
+ (gnus-button-handle-apropos-documentation): Docstring fix.
+
+ * gnus-util.el (gnus-kill-buffer): Use get-buffer.
+
+2003-02-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-draft.el (gnus-group-send-queue): Bind gnus-posting-styles
+ to nil.
+
+ * nnmail.el: Removed gnus-util autoload.
+
+ * gnus.el: Use gnus-prin1-to-string throughout.
+
+ * gnus-util.el (gnus-prin1-to-string): Bind print-length and
+ print-level.
+
+ * gnus-art.el (article-display-x-face): Removed grey x-face stuff.
+ (gnus-treat-display-grey-xface): Removed.
+
+ * gnus-fun.el (gnus-grab-cam-face): New.
+ (gnus-convert-image-to-gray-x-face): Removed.
+ (gnus-convert-gray-x-face-to-xpm): removed.
+ (gnus-convert-gray-x-face-region): Removed.
+ (gnus-grab-gray-x-face): Removed.
+
+ * nnmail.el (nnmail-expiry-wait-function): Doc indent.
+
+2003-01-31 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-util.el (gnus-kill-buffer): Functions in gnus-util
+ shouldn't depend on the rest of Gnus, so test if gnus-buffers is
+ bound.
+
+ * nnmail.el (nnmail-cache-close): Use gnus-kill-buffer.
+
+2003-01-30 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-cite.el (gnus-cite-reply-regexp, gnus-cite-always-check):
+ Remove -- these are bogus options which are never used.
+
+2003-01-29 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-mode): Use summary tool bar.
+
+2003-01-27 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-blackholes)
+ (spam-blackhole-good-server-regex): new variable to skip some IPs
+ when checking blackholes; use it
+ (spam-check-bogofilter-headers)
+ (spam-bogofilter-bogosity-positive-spam-header): new variable, in
+ case more X-Bogosity is used than just "Yes/No"
+ (spam-ham-move-routine): semi-fixed, only first article is
+ properly moved now
+
+2003-01-27 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers
+ as well.
+
+ * gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer.
+
+ * gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do.
+
+ * gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do.
+
+ * gnus-bcklg.el (gnus-backlog-shutdown): do.
+
+ * gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do.
+
+2003-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-face-encode): New function.
+ (gnus-convert-png-to-face): Use it.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks.
+
+2003-01-26 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-dissection-list): Remove.
+ (mm-dissect-singlepart): Don't push to mm-dissection-list, it's
+ only used in mm-remove-all-parts.
+ (mm-remove-all-parts): Remove it, it's never called.
+
+2003-01-25 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-make-group): Report errors.
+
+ * nnimap.el (nnimap-request-create-group): Ditto.
+
+ * sieve-manage.el (sieve-manage-is-okno): Parse literal strings.
+
+ * sieve.el (sieve-upload): Fix error printing.
+
+ * mm-encode.el (mm-qp-or-base64): Always QP iff
+ mm-use-ultra-safe-encoding and cleartext PGP.
+
+ * gnus-sum.el (gnus-summary-select-article): Inhibit
+ redisplay (mainly for secured messages).
+
+ * nnmail.el (nnmail-article-group): Copy body too (but don't
+ process it).
+
+2003-01-25 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-setup-buffer): Reset
+ gnus-button-marker-list.
+
+2003-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-read-timeout): Default to using a second delay
+ under Microsoft Windows.
+
+2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheader.el (nnheader-directory-separator-character): New
+ variable.
+
+2003-01-24 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-max-fetch-size)
+ (gnus-agent-article-alist, gnus-agent-get-undownloaded-list)
+ (gnus-agent-catchup, gnus-agent-summary-fetch-group)
+ (gnus-agent-fetch-articles, gnus-agent-backup-overview-buffer)
+ (gnus-agent-flush-cache, gnus-agent-fetch-headers)
+ (gnus-agent-braid-nov, gnus-agent-load-alist)
+ (gnus-agent-article-alist-save-format)
+ (gnus-agent-read-agentview, gnus-agent-save-alist)
+ (gnus-agent-fetch-group-1, gnus-agent-expire)
+ (gnus-agent-uncached-articles, gnus-agent-retrieve-headers)
+ (gnus-agent-regenerate-group): Reformat to keep under eighty
+ columns. Reword docstrings so that first line is under eighty
+ chars and a complete sentence. Still need to work on the rear
+ end of the file, in particular gnus-agent-expire.
+
+2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agentize): Indent.
+
+ * gnus.el (gnus-version-number): Bumped.
+
+2003-01-24 20:32:44 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.14 is released.
+
+2003-01-24 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-prepare-threads): Reset state for %B
+ before beginning. Tiny patch from Mark Thomas
+ <swoon@bellatlantic.net>.
+
+2003-01-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-blackholes, spam-split)
+ (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): added
+ gnus-message calls to show to users what spam.el is doing
+
+2003-01-24 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-message-replysign)
+ (gnus-message-replyencrypt): Fix typo.
+
+2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-security-show-details): Toggle showing
+ details.
+
+2003-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-press-button): let* -> let.
+ (gnus-mime-security-show-details): Cleaned up.
+ (gnus-mime-security-press-button): Save excursion.
+ (gnus-insert-mime-security-button): Clean up.
+
+ * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Doc fix.
+
+ * gnus-async.el (gnus-async-wait-for-article): Don't use a
+ timeout.
+
+ * nntp.el (nntp-accept-process-output): Removed timeout.
+ (nntp-read-timeout): New variable.
+ (nntp-accept-process-output): Use it.
+
+ * gnus-sum.el (gnus-data-find-list): Remove *.
+
+2003-01-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I
+ introduced on 2002-01-22.
+ (gnus-summary-first-unseen-or-unread-subject): Ditto.
+
+2003-01-23 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-regex-headers, spam-list-of-checks)
+ (spam-regex-headers-spam, spam-regex-headers-ham): added spam/ham
+ checks of incoming mail based on simple header regexp matching
+
+2003-01-22 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sum.el (gnus-spam-mark): set to `$'
+
+2003-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes
+ gnus-newsgroup-unfetched, the list of articles whose headers have
+ not been fetched from the server.
+
+ * gnus-sum.el (gnus-summary-find-next): Removed undownloaded
+ parameter as it never worked due to a bug. Added check to prevent
+ selection of any article in the gnus-newsgroup-unfetched list.
+ (gnus-summary-find-prev): Added check to prevent selection of any
+ article in the gnus-newsgroup-unfetched list.
+ (gnus-summary-first-subject): Documented API. Modified
+ implementation so that constraints are handled independently.
+ Added check to prevent selection of any article in the
+ gnus-newsgroup-unfetched list.
+ (gnus-summary-first-unseen-subject): Updated parameters in
+ gnus-summary-first-subject call to match new API.
+ (gnus-summary-first-unseen-or-unread-subject): Ditto.
+ (gnus-summary-catchup): Do not mark unfetched articles as read.
+
+2003-01-22 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook):
+ make-obsolete-variable allows only two arguments in XEmacs and
+ Emacs 20.
+
+ * gnus-sum.el (gnus-summary-wash-hide-map): Remove
+ gnus-article-hide-pgp.
+ (gnus-summary-make-menu-bar): do.
+
+ * gnus-art.el (gnus-treat-strip-pgp): Make obsolete.
+ (gnus-treatment-function-alist): Remove gnus-treat-strip-pgp and
+ gnus-article-hide-pgp.
+ (article-hide-pgp): Remove.
+ (gnus-article-hide): Remove gnus-article-hide-pgp.
+
+ * gnus.el: Remove gnus-article-hide-pgp
+
+2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-required-headers): Doc fix.
+
+2003-01-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-group-ham-processor-bogofilter-p): fixed bug
+ (spam-ifile-register-ham-routine, spam-ifile-ham-category): new
+ option to make ifile a purely binary classifier
+
+2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml-sec.el (mml-secure-sign-pgpauto): Renamed.
+ (mml-secure-encrypt-pgpmime): Removed double.
+
+ * gnus-sum.el (gnus-summary-mark-article-as-replied): Added
+ debugging statements.
+
+2003-01-21 Andreas Fuchs <asf@void.at>
+
+ * mml-sec.el (mml-sign-alist): Added pgpauto.
+
+2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bumped version number.
+
+2003-01-21 07:15:41 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.13 is released.
+
+2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-button-url-regexp): Removed |.
+
+ * message.el (message-send-hook): Doc fix.
+
+ * gnus-win.el (gnus-buffer-configuration): Display article
+ instead of article-copy when `reply'.
+
+2003-01-21 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-format): Change customize group to gnus.
+ (gnus-cache): Add link.
+ (gnus-group-charter-alist): Fix docstring.
+
+2003-01-20 Jesper Harder <harder@ifa.au.dk>
+
+ * mailcap.el (mailcap-print-command): lpr-command might be
+ unbound in XEmacs.
+
+2003-01-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form.
+
+ * gnus-sum.el (gnus-summary-update-article-line): Fixed
+ calculation of net characters added for use in the gnus-data
+ structure.
+
+2003-01-18 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nnmail.el (nnmail-process-unix-mail-format): Improve error
+ message. Suggested by Jari Aalto.
+
+2003-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-followup-with-original): Clean up.
+ (gnus-article-reply-with-original): Ditto.
+
+ * gnus-sum.el (gnus-summary-catchup): Make sure downloadable,
+ read articles don't become unread.
+
+2003-01-17 Simon Josefsson <jas@extundo.com>
+
+ * gnus-fun.el (gnus-x-face-from-file):
+ (gnus-face-from-file): Suggest image format in minibuffer prompt.
+
+ * gnus-fun.el (gnus-convert-image-to-x-face-command)
+ (gnus-convert-image-to-face-command): Doc fix.
+
+2003-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-convert-face-to-png): Protect against errors.
+
+2003-01-17 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-mime-print-part): Use mm-save-part-to-file to
+ avoid encoding problems.
+
+ * mailcap.el (mailcap-ps-command): New variable.
+ (mailcap-mime-data): Add print entry where applicable. Use
+ pdftotext on a tty.
+
+2003-01-16 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-alter-header-function): Add type and group.
+
+2003-01-16 Simon Josefsson <jas@extundo.com>
+
+ * gnus-fun.el (gnus-convert-image-to-x-face-command)
+ (gnus-convert-image-to-face-command, gnus-x-face-from-file)
+ (gnus-face-from-file): Doc fix; don't mention image format.
+
+2003-01-16 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-get-article-as-filename): new function (unused for now)
+ (spam-get-article-as-buffer): new function
+ (spam-get-article-as-string): use spam-get-article-as-buffer
+ (spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis
+
+2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el: Don't use `path'.
+ From the GNU coding standards:
+
+ Please do not use the term ``pathname'' that is used in Unix
+ documentation; use ``file name'' (two words) instead. We use
+ the term ``path'' only for search paths, which are lists of
+ directory names.
+
+ * nnsoup.el (nnsoup-file-name): Ditto.
+
+ * nnmail.el (nnmail-pathname-coding-system): Ditto.
+ (nnmail-group-pathname): Ditto.
+
+ * nnimap.el (nnimap-group-overview-filename): Ditto.
+
+ * nnheader.el (nnheader-pathname-coding-system): Ditto.
+ (nnheader-group-pathname): Ditto.
+
+ * nnfolder.el (nnfolder-group-pathname): Ditto.
+
+ * gnus.el (gnus-home-directory): Ditto.
+
+ * gnus-group.el (gnus-group-icon-list): Ditto.
+
+2003-01-16 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type.
+
+ * message.el (message-mode-menu): Use it.
+ (message-mode-menu): Deactivate "Yank Original" if there's no
+ reply buffer.
+
+ * messagexmas.el (message-xmas-redefine): Redefine in XEmacs.
+
+ * message.el (message-mark-active-p): New function.
+
+2003-01-15 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header)
+ (spam-bogofilter-database-directory): new variables
+ (spam-check-bogofilter-headers, spam-check-bogofilter)
+ (spam-bogofilter-register-with-bogofilter)
+ (spam-bogofilter-register-spam-routine)
+ (spam-bogofilter-register-ham-routine)
+ (spam-group-ham-processor-bogofilter-p): new functions for the new
+ Bogofilter interface
+ (spam-summary-prepare-exit): use the new Bogofilter functions
+ (spam-list-of-checks): added spam-use-bogofilter-headers
+ (spam-bogofilter-score): rewrote function
+ (spam-check-bogofilter): optional score parameter, uses
+ spam-check-bogofilter-headers better
+ (spam-check-bogofilter-headers): optional score parameter
+
+ * gnus.el (gnus-install-group-spam-parameters): new variable, t by
+ default, in the gnus-start customization group. Used to disable
+ the spam-*/ham-* parameters.
+ (gnus-group-ham-exit-processor-bogofilter): new ham processor
+
+2003-01-15 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-xmas.el (gnus-xmas-redefine): Use region-exists-p in
+ XEmacs.
+
+ * gnus-ems.el (gnus-mark-active-p): do.
+
+2003-01-15 Kevin Ryde <user42@zip.com.au>
+
+ * gnus.texi (Using MIME): Mention auto-compression-mode with
+ gnus-mime-copy-part.
+
+2003-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-send): Don't warn about duplicates when
+ superseding.
+
+2003-01-15 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-download-body): New variable.
+ (nnimap-split-articles): Use it.
+
+2003-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): This data
+ integrity checker was incorrectly flagging, and removing, articles
+ whose article number was negative.
+ (gnus-agent-fetch-group-1): When executed in the group's summary
+ buffer, refresh each downloaded line to update the status flag and
+ font. Preserve the value of gnus-newsgroup-headers so that
+ gnus-agent-fetch-articles can split the requests by size.
+ (gnus-agent-expire): Corrected day calculation for when
+ gnus-agent-expire-days contains a list.
+
+2003-01-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-audio.el (gnus-audio-au-player): Use executable-find.
+
+2003-01-13 Jhair Tocancipa Triana <jhair_tocancipa@@gmx.net>
+
+ * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use
+ /usr/bin/play as default player.
+ (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play.
+
+2003-01-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-inews-add-send-actions): Allow a list of
+ articles to be marked as well.
+
+2003-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): Include the
+ fictious headers generated by nnagent (ie. Undownloaded Article
+ ####) in the list of articles that have not been downloaded.
+
+ * gnus-int.el (): Added require declarations to resolve
+ compile-time warnings.
+ (gnus-open-server): If the server status is set to offline,
+ recursively execute gnus-open-server to open the offline backend
+ (e.g. nnagent).
+
+2003-01-14 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-reply-with-original): Use
+ gnus-mark-active-p.
+ (gnus-article-followup-with-original): do.
+
+2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-sum.el: Removed `(when t ...)' around `gnus-define-keys'.
+
+2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-score.el (gnus-score-edit-file-at-point): New function.
+ (gnus-score-find-trace): Bind it to `e' key. Added `q' for quit.
+
+2003-01-13 Romain FRANCOISE <romain@orebokech.com>
+
+ * gnus-fun.el (gnus-x-face-from-file): Quote file name.
+ (gnus-face-from-file): Ditto.
+
+2003-01-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-articles-to-read): Don't just apply
+ gnus-alter-articles-to-read-function to the unread articles.
+
+2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * deuglify.el (gnus-article-outlook-unwrap-lines)
+ (gnus-article-outlook-repair-attribution)
+ (gnus-article-outlook-rearrange-citation): New function names,
+ renamed from "gnus-outlook-" to "gnus-article-outlook-". Changed
+ doc-string.
+
+ * gnus-sum.el (gnus-summary-mode-map): Use new function names,
+ removed `W k' key binding (use `W Y f' instead).
+ (gnus-summary-make-menu-bar): Use new function names.
+
+2003-01-13 Simon Josefsson <jas@extundo.com>
+
+ * gnus-fun.el (gnus-random-x-face): Doc fix.
+ (gnus-insert-random-x-face-header): New function.
+
+2003-01-13 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Deactivate items if
+ mark is not active.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Comment.
+
+ * gnus-ems.el (gnus-mark-active-p): New function.
+
+ * gnus-group.el (gnus-topic-mode-p): New function.
+ (gnus-group-make-menu-bar): Show more key bindings in topic mode.
+ Deactivate items if mark is not active.
+
+2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bumped version.
+ (gnus-summary-line-format): Doc fix.
+
+2003-01-12 22:02:49 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.12 is released.
+
+2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-sources): Removed autoload to make it
+ compile under XEmacs.
+
+2003-01-12 Raymond Scholz <ray-2003@zonix.de>
+
+ * gnus-msg.el (gnus-confirm-mail-reply-to-news): May be a
+ regexp or a function too.
+ (gnus-confirm-treat-mail-like-news): New variable. Ask for
+ confirmation even if the original article is mail.
+
+2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-inews-add-send-actions): Get the right
+ articles to be marked when not yanking.
+
+2003-01-12 Fran,Ag(Bois-David Collin <Francois-David.Collin@curie.fr>
+
+ * mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer.
+
+2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-face-from-file): Autoload.
+
+ * gnus-cite.el (gnus-cite-delete-overlays): Protect against more
+ errors.
+
+2003-01-12 Simon Josefsson <jas@extundo.com>
+
+ * sieve.el (sieve-upload-and-bury): New. Suggested by
+ kai.grossjohann@uni-duisburg.de (Kai Gro,A_(Bjohann).
+
+ * sieve-mode.el (sieve-mode-map): Bind s-u-a-b to C-c C-c.
+ Suggested by kai.grossjohann@uni-duisburg.de (Kai Gro,A_(Bjohann).
+
+2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-ignored-headers): Don't include the ^ and :
+ in every string.
+
+ * gnus.el (gnus-version-number): Bumped version number.
+
+2003-01-12 13:46:20 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.11 is released.
+
+2003-01-12 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-fetch-reply-field): Narrow to headers.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Don't try to mark GCC's as read
+ if Gnus isn't alive.
+
+2003-01-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Remove downloadable
+ marks from articles that are already stored in the agent.
+ (gnus-agent-backup-overview-buffer): New debug tool. Creates a
+ backup copy of an invalid .overview file for later analysis.
+
+2003-01-12 Gregorio Gervasio, Jr. <gtgj@pacbell.net>
+
+ * gnus-sum.el (gnus-summary-exit): Reverse change to make group
+ exit work with two frames.
+
+2003-01-11 Fran,Ag(Bois-David Collin <Francois-David.Collin@wanadoo.fr>
+
+ * message.el (message-forward-make-body): Use mule4.
+
+2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-mode-map): Move wide-reply command.
+
+2003-01-10 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): Added
+ castellano.
+ (gnus-outlook-display-hook): New variable.
+ (gnus-outlook-display-article-buffer): New function.
+ (gnus-outlook-unwrap-lines, gnus-outlook-repair-attribution)
+ (gnus-outlook-deuglify-article): Made them interactive and added
+ optional arg. Use `g-o-d-a-b'.
+ (gnus-article-outlook-deuglify-article): Use `g-o-d-a-b'.
+
+ * gnus-sum.el: Added autoloads.
+ (gnus-summary-mode-map): Added gnus-summary-wash-deuglify-map.
+ (gnus-summary-make-menu-bar): Added "(Outlook) Deuglify" menu.
+
+2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-display-mime): Use the mime emulation
+ variable.
+
+ * gnus-sum.el (gnus-article-emulate-mime): New variable.
+
+ * gnus-start.el (gnus-read-newsrc-el-file): Make sure that the
+ newsrc-alist is initialized properly.
+
+ * mail-source.el (mail-sources): Autoload.
+
+ * gnus-sum.el (gnus-summary-make-false-root-always): Default to
+ nil.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Make sure we don't
+ insert two newlines.
+
+ * message.el (message-check-news-header-syntax): Compute the
+ header length correctly.
+
+2003-01-10 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-expire): Do not remove article from
+ alist when keeping fetched article file.
+ (gnus-agent-retrieve-headers): When parsing response for article
+ numbers, use the same algorithm as gnus-agent-braid-nov to protect
+ against garbage in the server's response.
+
+ * gnus-int.el (gnus-request-expire-articles,
+ gnus-request-move-article): Only expire when the group's server
+ has been agentized.
+
+2003-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-cite.el (gnus-cite-delete-overlays): Protect against
+ errors when deleting overlays.
+
+ * gnus-score.el (gnus-score-followup): Allow tracing.
+
+ * gnus-art.el (gnus-treat-display-face): New variable.
+ (article-display-face): New command.
+
+ * gnus-fun.el (gnus-face-from-file): New function.
+ (gnus-convert-face-to-png): Ditto.
+
+ * gnus-art.el (gnus-ignored-headers): Added Face.
+
+2003-01-10 Simon Josefsson <jas@extundo.com>
+
+ * nndraft.el (nndraft-request-group): Avoid crash in
+ directory-files when draft directory doesn't exists.
+
+ * gnus-sum.el (gnus-select-article-hook): Add :option.
+
+2003-01-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-stat): new variable
+ (spam-group-spam-processor-stat-p)
+ (spam-group-ham-processor-stat-p): new convenience functions
+ (spam-summary-prepare-exit): add spam/ham processors to sequence
+ (spam-list-of-checks): add spam-use-stat to list of checks
+ (spam-split): conditionally load the spam-stat tables
+ (spam-stat-register-spam-routine, spam-stat-register-ham-routine,
+ spam-check-ifile): new functions
+
+ * spam-stat.el (spam-stat): typo fix
+ (spam-stat-install-hooks): new variable
+ (spam-stat-split-fancy-spam-group): added documentation clarification
+ (spam-stat-split-fancy-spam-threshhold): new variable
+ (spam-stat-install-hooks): make hooks conditional
+ (spam-stat-split-fancy): use spam-stat-split-fancy-spam-threshhold
+
+ * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): add
+ spam-stat ham/spam processor symbols
+
+2003-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-read-newsrc-el-file): Make sure the .eld
+ file exists.
+
+2003-01-10 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-read-group-1): Don't select first
+ undownloaded/downloadable only when unplugged.
+
+2003-01-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Optimize inner loop.
+
+2003-01-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-ifile): fixed call-process-region to use the
+ db parameter only if it's set
+ (spam-ifile-register-with-ifile): ditto
+
+2003-01-09 Alex Schroeder <alex@emacswiki.org>
+
+ * spam-stat.el (spam-stat-save): Set spam-stat-ngood and
+ spam-stat-nbad before creating the hash table.
+ (spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0.
+ Changed copyright statement to FSF.
+
+2003-01-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-catchup): Do not mark cached nor
+ processable articles as read.
+ (gnus-agent-summary-fetch-series): Remove processable and
+ downloadable marks on all downloaded articles in the series.
+
+ * nntp.el (nntp-report): Throw error after reporting the problem.
+ (nntp-accept-process-output): Corrected error check to report an
+ error when the process is nil.
+
+2003-01-09 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-tool-bar-map): Add preview.
+
+2003-01-09 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-preview): Get rid of MIME handles and buffers after
+ previewing.
+
+2003-01-08 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--grp-add-art): Fix wrong-type-argument
+ bug when the (n+1)th article to be added to a group has a smaller
+ number than the n articles already added.
+
+2003-01-08 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-mode-field-menu): Use backquote.
+
+2003-01-08 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: fixed the BBDB autoloads again, using
+ bbdb-search-simple now (which is not a macro, thank god)
+
+ * lpath.el (bbdb-search): removed function from maybe-fbind list
+
+ * gnus.el (ham-process-destination): added new parameter for
+ destination of ham articles found in spam groups at summary exit
+
+ * spam.el (spam-get-ifile-database-parameter): use spam-ifile-database-path
+ (spam-check-ifile, spam-ifile-register-with-ifile): use spam-get-ifile-database-parameter
+ (spam-ifile-database-path): added new parameter for ifile's database
+ (spam-move-spam-nonspam-groups-only): new parameter to determine
+ if spam should be moved from all groups or only some
+ (spam-summary-prepare-exit): fixed logic to use
+ spam-move-spam-nonspam-groups-only when deciding to invoke
+ spam-mark-spam-as-expired-and-move-routine; always invoke that
+ routine after the spam has been expired-or-moved in case there's
+ some spam left over; use spam-ham-move-routine in spam groups
+ (spam-ham-move-routine): new function to move ham articles to the
+ ham-process-destinations group parameter
+
+2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-spec.el (gnus-parse-complex-format): %~ => ~*.
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Use
+ gnus-summary-update-article-line.
+
+2003-01-08 Simon Josefsson <jas@extundo.com>
+
+ * nnmail.el (nnmail-expiry-target-group): Request group, create it
+ not successful.
+
+2003-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el (bbdb-records): Fbind it for both Emacs and XEmacs.
+
+2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-ifile): fixed the spam-ifile-all-categories
+ logic, finally
+
+2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-spec.el (gnus-parse-format): %C is a complex format.
+ (gnus-parse-format): Change to %~.
+
+ * message.el (message-generate-headers): Don't generate optional
+ empty headers.
+
+2003-01-07 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-cross-post-default)
+ (message-cross-post-note-function, message-shoot-gnksa-feet)
+ (message-strip-subject-trailing-was, message-change-subject)
+ (message-mark-insert-file, message-cross-post-followup-to)
+ (message-cross-post-followup-to, message-mode-map)
+ (message-generate-unsubscribed-mail-followup-to)
+ (message-make-mail-followup-to): Minor changes to doc-strings and
+ error messages. Updated copyright line.
+
+ * message.el (message-make-mail-followup-to,
+ message-generate-unsubscribed-mail-followup-to): New function
+ names. Renamed functions: "-mft" -> "-mail-followup-to".
+ (message-make-mft, message-gen-unsubscribed-mft): Removed function
+ names.
+
+ * mml.el (mml-preview-insert-mail-followup-to): New function name.
+ (mml-preview-insert-mft): Removed function name.
+ (mml-preview): Use new function names.
+
+ * gnus-art.el (gnus-article-edit-mode-map): Use new function names.
+
+ * message.el (message-mode-field-menu): Moved header related
+ commands from "Message" to "Field" menu.
+
+2003-01-07 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-generate-headers-first): Added customization
+ if variable is a list.
+
+2003-01-07 Michael Shields <shields@msrl.com>
+
+ * gnus-art.el (gnus-article-next-page): Correctly handle the case
+ where the last line of the article is the last line of the window.
+
+2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-debug): Use ignore-errors.
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Use
+ `gnus-summary-update-line'.
+
+2003-01-08 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-unbuttonized-mime-types)
+ (gnus-buttonized-mime-types): Doc fix.
+
+2003-01-08 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-inline-media-tests): .xpm is 'x-xpixmap'.
+
+2003-01-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-group-alist): Add and clear up.
+
+2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: removed unnecessary condition-case for loading bbdb-com.el
+
+ * lpath.el (bbdb-search): added BBDB functions for a better way to
+ fix missing functions
+
+ * spam.el (spam-check-ifile): if should be an unless
+
+ * spam.el: define 'ignore alias for spam-BBDB-register-routine,
+ spam-enter-ham-BBDB, and bbdb-create-internal initially to hush up warnings
+ (spam-ifile-all-categories): doc string fixed to be less than 80 chars
+
+2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Added
+ gnus-summary-refer-thread to thread menu.
+
+2003-01-07 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a
+ summary buffer, articles that cannot be fetched are marked as
+ canceled.
+
+ * nntp.el (nntp-with-open-group): The quit signal handler must
+ propagate the quit signal to the next outer handler so that the
+ caller knows that the request aborted abnormally.
+
+2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-ifile, spam-ifile-register-with-ifile)
+ (spam-ifile-register-spam-routine)
+ (spam-ifile-register-ham-routine): added ifile functionality that
+ does not use ifile-gnus.el to classify and register articles
+ (spam-get-article-as-string): convenience function
+ (spam-summary-prepare-exit): added ifile spam and ham registration
+ (spam-ifile-all-categories, spam-ifile-spam-category)
+ (spam-ifile-path, spam-ifile): added customization options
+
+ * gnus.el (gnus-group-ham-exit-processor-ifile): added ifile ham
+ exit processor
+ (spam-process): added gnus-group-ham-exit-processor-ifile to the
+ list of choices
+
+2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-score.el (gnus-score-followup): Also score immediate
+ followups.
+
+2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnweb.el (nnweb-asynchronous-p): Changed to nil.
+
+2003-01-07 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-mode-menu): Fix receipt balloon help.
+
+2003-01-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-group-post-news): Don't assume that "" will
+ always be interpreted as news.
+
+2003-01-07 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sieve.el (gnus-sieve-script): Use the crosspost argument to
+ gnus-sieve-script, instead of the global variable
+ gnus-sieve-crosspost. One-line patch from Steinar Bang
+ <sb@dod.no>.
+
+2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus.el: Renamed gnus-summary-*-uncached-face as
+ gnus-summary-*-undownloaded-face to avoid confusing the agent with
+ the cache.
+
+ * gnus-sum.el: Ditto.
+
+2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution
+ in either the group or summary buffer.
+ New command "JS", in summary buffer, will fetch articles per the
+ group's category, predicate, and processable flags.
+ (gnus-agent-summary-fetch-series): Rewritten to call
+ gnus-agent-session-fetch-group once with all articles in the
+ series.
+ (gnus-agent-summary-fetch-group): Fixed bug and modified code to
+ return list of fetched articles.
+ (gnus-agent-fetch-articles): Split fetch list into sublists such
+ that the article buffer is only slightly larger than
+ gnus-agent-max-fetch-size. Added unwind-protect to ensure that
+ the group's article alist is saved.
+ (gnus-agent-fetch-headers): The 'killed' and 'cached' marks no
+ longer result in the agent trying to fetch an article.
+ (gnus-agent-fetch-group-1): Can now be called in either the group
+ or summary buffer. Removed the max-fetch-size code that I added
+ on 2002-12-13 as that capability is now part of
+ gnus-agent-fetch-articles. Added code to update summary buffer.
+ When called in the group buffer, articles that can not be fetched
+ are AUTOMATICALLY MARKED AS READ.
+
+ * gnus-sum.el (): Modified eval-when-compile to minimize
+ misleading compilation warnings.
+ (gnus-update-summary-mark-positions): Changed code to use
+ gnus-undownloaded-mark rather than gnus-downloaded-mark.
+
+ * nnheader.el (nnheader-insert-nov-file): Do not try to insert an
+ empty file as the parser assumes that the file isn't empty.
+
+ * nntp.el (nntp-send-string): The process-send-string call can,
+ because it performs I/O on the process, change the process' state
+ from open to closed. If this happens, call nntp-report
+ immediately to report the broken connection.
+ (nntp-report): Rewritten to avoid needing a global variable to
+ determine the appropriate course of action. Instead, two function
+ implementations are provided and the nntp-report function value is
+ bound to the appropriate implementation.
+ (nntp-retrieve-data): Moved nntp-report call to end of implementation.
+ (nntp-with-open-group): Now binds nntp-report's function cell
+ rather than binding gnus-with-open-group-first-pass. Added a
+ condition-case to detect a quit during a nntp command. When the
+ quit occurs, the current connection is closed as a fetch articles
+ request could have several megabytes queued up for reading.
+ (nntp-retrieve-headers): Bind articles to itself. If
+ nntp-with-open-group repeats this command, I must have access to
+ the original list of articles.
+ (nntp-retrieve-groups): Ditto for groups.
+ (nntp-retrieve-articles): Ditto for articles.
+ (*): Replaced nntp-possibly-change-group calls to
+ nntp-with-open-group forms in all, but one, occurrance.
+ (nntp-accept-process-output): Bug fix. Detect when called with
+ null process.
+
+2003-01-06 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-find-mime-charset-region): Don't do Latin-9 hack
+ if we don't need to.
+ (mm-iso-8859-x-to-15-region): Fix misplaced parenthesis.
+
+2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-make-web-group): Pass the select
+ method on to group-create.
+ (gnus-group-line-format-alist): %U is an integer.
+
+ * gnus-sum.el (gnus-summary-exit-no-update): Don't update
+ ephemeral groups.
+ (gnus-summary-read-group-1): Ditto.
+ (gnus-group-make-articles-read): Ditto.
+
+ * mm-url.el (mm-url-program): Doc fix.
+
+ * message.el (message-mode-map): Rebound
+ message-insert-wide-reply.
+
+2003-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-xmas.el (gnus-xmas-group-startup-message): Bind the oort
+ color as `gnus-group-startup-message' does.
+
+2003-01-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: fixed line lengths to 80 chars or less
+
+ * gnus-sum.el (gnus-read-mark-p): added the spam-mark as a
+ "not-read" mark
+ (gnus-summary-mark-forward): added the spam-mark to the list of
+ marks not to be marked as "read" when viewed
+
+2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-inews-make-draft): Quote article-reply.
+
+ * gnus-group.el (gnus-number-of-unseen-articles-in-group):
+ Protect against unactive groups.
+
+ * message.el (message-check-news-header-syntax): Check long
+ header lines.
+ (message-check-news-header-syntax): Update `start'.
+
+ * gnus-group.el (gnus-group-expire-articles): Doc fix.
+ (gnus-group-line-format): %U.
+ (gnus-group-line-format-alist): ?U.
+ (gnus-number-of-unseen-articles-in-group): New function.
+
+ * nntp.el (nntp-accept-process-output): Use a 0.1 second timeout.
+
+ * gnus.el (gnus-version-number): Bump version number.
+
+2003-01-05 01:53:30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.10 is released.
+
+2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Fix version number.
+
+2003-01-05 01:40:09 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.08 is released.
+
+2003-01-04 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el: Add mm-string-make-unibyte.
+
+ * gnus-group.el (gnus-group-jump-to-group): Make it work for
+ UTF-8 groups.
+
+2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-variable-list): Write gnus-format-specs last.
+
+ * gnus-sum.el (gnus-summary-goto-subjects): Fix typo.
+
+2003-01-04 Kevin Ryde <user42@zip.com.au>
+
+ * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New
+ function.
+
+2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p.
+ (gnus-summary-read-group-1): Update group line.
+ (gnus-summary-exit-no-update): Update group on exit.
+
+ * gnus-group.el (gnus-group-line-format): Add %*.
+ (gnus-group-line-format-alist): Ditto.
+ (gnus-group-insert-group-line): Set it.
+ (gnus-group-is-exiting-p): New variable.
+ (gnus-group-insert-group-line): Use it.
+
+2003-01-03 Teodor Zlatanov <tzz@beld.net>
+
+ * spam.el (spam-enter-ham-BBDB, spam-BBDB-register-routine):
+ enable BBDB ham processing
+ (spam-blacklist-register-routine): enable blacklist spam processing
+ (spam-whitelist-register-routine): enable whitelist ham processing
+ (spam-fetch-field-from-fast): fast fetching of the "from" field
+ from (gnus-data-list)
+ (spam-summary-prepare-exit): works completely now
+ (spam-use-blacklist): oops, should be nil by default
+ (spam-summary-prepare-exit): spam-use-PROCESSOR is only for
+ split processing now; before it was for summary exit as
+ well but that's done with the spam-contents and spam-process
+ parameters now
+
+2003-01-03 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-insert-tag): Don't quote non-ASCII unibyte
+ characters.
+
+2003-01-02 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-group-spam-contents-p, spam-group-ham-contents-p)
+ (spam-group-processor-p, spam-group-processor-bogofilter-p)
+ (spam-group-processor-ifile-p, spam-group-processor-blacklist-p)
+ (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p)
+ (spam-mark-spam-as-expired-and-move-routine)
+ (spam-generic-register-routine, spam-BBDB-register-routine)
+ (spam-ifile-register-routine, spam-blacklist-register-routine)
+ (spam-whitelist-register-routine): new functions
+ (spam-summary-prepare-exit): added summary exit processing (expire
+ or move) of spam-marked articles for spam groups; added slots for
+ all the spam-*-register-routine functions
+
+2003-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * pop3.el (pop3-retr): Wait 500 msecs.
+ (pop3-read-response): Ditto.
+
+ * gnus-msg.el (gnus-setup-message): Get the evaliation order
+ right.
+ (gnus-inews-make-draft): New function.
+ (gnus-setup-message): Use it.
+
+ * message.el (message-required-headers): Add From.
+
+2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org>
+ Trivial patch from Norbert Koch <nk@viteno.net>.
+
+ * gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-generate-headers): Let header formatters do
+ their work.
+
+2003-01-02 Raymond Scholz <ray-2003@zonix.de>
+
+ * deuglify.el (gnus-article-outlook-deuglify-article):
+ Rehighlight, reapply treatments and call
+ `gnus-article-prepare-hook'. Suggested by Niels Olof Bouvin.
+ (gnus-outlook-repair-attribution-block): Recognize cited
+ attributions. Suggested by Niklas Morberg.
+
+2003-01-02 Pete Kazmier <pete@kazmier.com>
+
+ * gnus-art.el (gnus-treat-predicate): Check condition first.
+
+2003-01-02 Jesper Harder <harder@ifa.au.dk>
+
+ * lpath.el: Add url-http-file-exists-p.
+
+ * gnus-group.el (gnus-group-fetch-charter): Use
+ http://TLH.news-admin.org/charters/GROUPNAME as a fallback.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-draft-headers): Also generate From to get a
+ nicer draft buffer summary.
+
+ * gnus-xmas.el (gnus-xmas-read-event-char): Take an optional
+ parameter.
+
+ * gnus-art.el (article-wash-html): Clean up.
+ (article-wash-html): Typo fix.
+
+ * gnus-msg.el (gnus-summary-mail-forward): Clean up.
+ (gnus-summary-mail-forward): To many lists of lists.
+
+ * gnus-art.el (article-wash-html): Clean up.
+
+2003-01-02 pete-temp <pete-temp-12-29-2002@kazmier.com>
+
+ * gnus-art.el (gnus-treat-wash-html): New variable.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-check-news-header-syntax): Allow posting.
+ (message-check-news-header-syntax): Fix logic for sure, this
+ time.
+
+2003-01-02 Matthieu Moy <Matthieu.Moy@imag.fr>
+
+ * message.el (message-check-news-header-syntax): Check syntax of
+ continuation headers.
+
+2003-01-02 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-url-regexp,
+ (gnus-button-mid-or-mail-regexp, gnus-button-alist,
+ (gnus-header-button-alist): Regexps are case insensitive here.
+
+2003-01-02 Simon Josefsson <jas@extundo.com>
+
+ * dig.el (query-dig): Doc fix.
+
+2003-01-02 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Update whole
+ summary buffer line, not just the download mark.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-goto-subjects): New function.
+ (gnus-summary-insert-dormant-articles): New command and
+ keystroke.
+
+ * gnus-cache.el (gnus-summary-insert-cached-articles): Use new
+ function for mass insertion of subjects.
+
+ * nndraft.el (nndraft-generate-headers): Don't move point.
+
+ * gnus.el (nnheader): Require nnheader.
+
+ * nndraft.el (nndraft-request-associate-buffer): Use
+ make-local-variable.
+
+2003-01-02 Michael Shields <shields@msrl.com>
+
+ * nndraft.el (nndraft-request-associate-buffer): Make
+ write-contents-hooks buffer-local before setting it.
+
+2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-group-parameter-value): Take an extra param.
+ (gnus-group-fast-parameter): Let group param results be nil.
+
+ * gnus-art.el (gnus-article-forward-header): New function.
+ (article-date-ut): Use it to remove continuation date headers.
+
+ * gnus-sum.el (gnus-summary-walk-group-buffer): Supply prompt to
+ read-event.
+ (gnus-summary-remove-bookmark): Clean up.
+ (gnus-summary-set-bookmark): Clean up.
+
+ * gnus-util.el (gnus-read-event-char): Take an optional prompt.
+
+ * gnus.el (gnus-group-startup-message): Bind data-directory to
+ the Gnus etc directory.
+
+2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-summary-prepare-exit): added slots for spam- and
+ ham-processing of articles; use the new
+ spam-group-(spam|ham)-contents-p functions
+ (spam-group-spam-contents-p, spam-group-ham-contents-p): new
+ convenience functions
+ (spam-mark-junk-as-spam-routine): use the new
+ spam-group-spam-contents-p function
+
+ * gnus.el (spam-process, spam-contents, spam-process-destination):
+ added new parameters with corresponding global variables
+ (gnus-group-spam-exit-processor-ifile,
+ gnus-group-spam-exit-processor-bogofilter,
+ gnus-group-spam-exit-processor-blacklist,
+ gnus-group-spam-exit-processor-whitelist,
+ gnus-group-spam-exit-processor-BBDB,
+ gnus-group-spam-classification-spam,
+ gnus-group-spam-classification-ham): added new symbols for the
+ spam-process and spam-contents parameters
+
+ * spam.el (spam-ham-marks, spam-spam-marks): changed list
+ customization and list itself to store mark symbol rather than
+ mark character.
+ (spam-bogofilter-register-routine): added logic to generate mark
+ values list from spam-ham-marks and spam-spam-marks, so (member)
+ would work.
+
+2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-cross-post-followup-to): Fix comment.
+
+2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-marks, spam-spam-marks): changed list
+ customization and list itself to store mark symbol rather than
+ mark character.
+ (spam-bogofilter-register-routine): added logic to generate mark
+ values list from spam-ham-marks and spam-spam-marks, so (member)
+ would work.
+
+2003-01-01 Raymond Scholz <ray-2002@zonix.de>
+
+ * message.el (message-signature-insert-empty-line): New variable.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el: Renamed functions and variables: "xpost" ->
+ "cross-post", "-fup2" -> "-followup-to".
+ (message-cross-post-old-target, message-cross-post-default,
+ message-cross-post-note, message-followup-to-note,
+ message-cross-post-note-function): New variables names.
+ (message-xpost-old-target, message-xpost-default,
+ message-xpost-note, message-fup2-note,
+ message-xpost-note-function): Removed variable names.
+ (message-cross-post-followup-to-header,
+ message-cross-post-insert-note, message-cross-post-followup-to):
+ New function names.
+ (message-xpost-fup2-header, message-xpost-insert-note,
+ message-xpost-fup2): Removed function names.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-send-mail): Added message-cleanup-headers to
+ prevent newlines in headers.
+
+2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dns.el (dns-make-network-process): Comment.
+
+ * gnus-sum.el (gnus-summary-display-while-building): Default to
+ nil.
+
+2003-01-01 Wes Hardaker <wes@hardakers.net>
+
+ * gnus-sum.el (gnus-summary-display-while-building): New
+ variable.
+
+2003-01-01 Raymond Scholz <ray-2003@zonix.de>
+
+ * deuglify.el (gnus-outlook-rearrange-article): Kill overlays
+ before rearranging the article.
+
+2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nndraft.el (nndraft-generate-headers): New function.
+ (nndraft-request-associate-buffer): Use it to write headers on
+ buffer save.
+
+ * message.el (message-generate-headers): Let the function be a
+ lambda form.
+ (message-draft-headers): New variable.
+
+ * gnus-msg.el (gnus-inews-make-draft-meta-information): New
+ function.
+ (gnus-setup-message): Use it.
+
+ * message.el (message-generate-headers-first): Doc fix.
+ (message-setup-1): Use new function for getting which headers to
+ generate.
+ (message-headers-to-generate): New function.
+
+2003-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-save-alist): Make directory.
+
+2002-12-31 Reiner Steib <4uce.02.r.steib@gmx.net>
+
+ * gnus-sum.el (gnus-summary-limit-to-age): Make prompt string
+ mention negatives.
+
+2002-12-31 Raymond Scholz <ray-2002@zonix.de>
+
+ * deuglify.el (gnus-outlook-rearrange-article): Use
+ `transpose-regions' instead of tempering the kill-ring.
+ (gnus-article-outlook-deuglify-article): Rehighlight article
+ instead of a complete redisplay.
+
+2002-12-31 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: most defvars are defcustoms now
+
+ patches from Michael Shields <shields@msrl.com>
+
+ * spam.el (spam-bogofilter-articles): Select the article
+ body using gnus-summary-show-article t instead of
+ gnus-summary-select-article; this presents the raw text
+ without running any hooks.
+
+ * spam.el (spam-bogofilter-articles): Use message-remove-header
+ to remove headers; the old way incorrectly removed just the first
+ line of folded headers.
+
+2002-12-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-load): Replace `ding-file' with `file'.
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-load): New function.
+ (gnus-read-newsrc-el-file): Use it.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-valid-fqdn-regexp): New variable.
+ (gnus-button-handle-apropos-documentation): New function.
+ (gnus-button-handle-ctan): New function.
+ (gnus-button-alist): Use them. Improve some regexps.
+ (gnus-button-prefer-mid-or-mail): Addition to doc-string.
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-subscribed-p): New function.
+ (message-send-mail): Use it.
+ * mml.el (mml-preview-insert-mft): New function.
+ (mml-preview): Use it.
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-thread-latest-date): Protect against errors
+ when sorting by date.
+
+ * gnus-art.el (gnus-article-edit-mode): New variable.
+ (gnus-article-setup-buffer): Warn user about discarding edits.
+
+ * gnus-sum.el (gnus-summary-pipe-output): Clean up.
+ (gnus-summary-pipe-output): Take a symbolic prefix to save all
+ headers.
+
+ * mm-uu.el (mm-uu-configure-list): Default to (shar . disabled).
+
+2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-completion-alist): Added "Mail-Followup-To"
+ and "Mail-Copies-To".
+
+2002-07-21 Jesper harder <harder@ifa.au.dk>
+
+ * gnus-group.el: Add key bindings for
+ gnus-group-sort-groups-by-real-name and
+ gnus-group-sort-selected-groups-by-real-name.
+
+2002-07-21 Jesper harder <harder@ifa.au.dk>
+
+ * gnus.texi (Sorting Groups): Add key bindings for
+ gnus-group-sort-groups-by-real-name and
+ gnus-group-sort-selected-groups-by-real-name.
+
+2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-dig): new variable for blackhole checking
+ through dig.el
+ (spam-check-blackholes): added dig.el checking functionality and
+ more verbose reporting; query-dig is autoloaded from dig.el
+ (spam-use-blackholes): disabled by default
+ (spam-blackhole-servers): removed rbl.maps.vix.com from the
+ blackhole servers list
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-required-headers): New variable.
+
+2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * dig.el (query-dig): new function
+
+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * flow-fill.el (fill-flowed): Don't infloop on too long fill
+ prefixes.
+
+ * dns.el (query-dns): Protect against errors.
+
+ * gnus-msg.el (gnus-article-yanked-articles): New variable.
+ (gnus-inews-add-send-actions): Mark all answered messages as
+ answered.
+
+2002-08-10 Jari Aalto <jari.aalto@poboxes.com>
+
+ * nnmail.el (nnmail-split-it): Added tracing to
+ `:' split rule
+
+2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
+
+ * mm-decode.el (mm-mailcap-command): Remove the quotes around '%s'
+ and "%s" so we don't overquote them.
+
+2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
+
+ * (mm-display-external): Display the actual command that has been
+ executed in the echo area.
+
+2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-display-missing-topic): Bind entry.
+
+ * message.el (message-with-reply-buffer): New macro.
+ (message-fetch-reply-field): Use it.
+ (message-insert-wide-reply): New command and keystroke.
+ (message-carefully-insert-headers): New function.
+ (message-insert-to): Use new function.
+
+ * gnus-topic.el (gnus-topic-display-missing-topic): New function.
+ (gnus-topic-goto-missing-group): Use it.
+
+ * message.el (message-required-news-headers): Removed Lines.
+ (message-reply): Don't insert References first.
+ (message-followup): Ditto.
+ (message-make-references): New function.
+ (message-followup): Set message-reply-headers before generating
+ the buffer stuff.
+
+2002-12-29 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-generate-mime-1): Reverse the order of
+ encoding/flowing.
+
+2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-expiry-target-group): Mark articles as read
+ after moving them.
+
+ * gnus-sum.el (gnus-summary-dummy-line-format): Update format to
+ fit with newer standard format.
+ (gnus-summary-make-false-root-always): New variable.
+ (gnus-gather-threads-by-subject): Use it.
+
+ * message.el (message-get-reply-headers): Take an address list
+ optional argument.
+
+2002-12-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-keep-backlog): Change default to 20.
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Start from
+ start.
+ (gnus-agent-check-overview-buffer): Remove negative article
+ numbers.
+
+ * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): Doc fix.
+ (nnmail-cache-ignore-groups): Doc fix.
+
+ * nnimap.el (nnimap-debug): Made into a flag and defcustomed.
+ (nnimap-debug-buffer): New variable.
+ (nnimap-debug): Use it.
+
+2002-12-28 Lars Magne Ingebrigtsen <kgreiner@xpediantsolutions.com>
+
+ * gnus.el (gnus-summary-high-uncached-face): New color scheme.
+
+2002-12-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Sort lines if
+ they aren't already sorted.
+
+2002-12-28 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-mode-menu): Add ellipses to menu items
+ expecting user interaction.
+ (message-mode-field-menu): do.
+
+2002-12-26 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-highlight-line): Don't bind `list' --
+ it isn't used any more.
+
+2002-12-22 Jesper Harder <harder@ifa.au.dk>
+
+ * binhex.el (binhex-decoder-program): Fix docstring.
+
+2002-12-21 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * mm-decode.el (mm-mailcap-command): Do not backslash-quote
+ special chars if the mailcap file uses single quotes around %s.
+ From Laurent Martelli <laurent@bearteam.org>.
+
+2002-12-19 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-int.el (gnus-request-update-info): nnchoke-r-u-i might not
+ return the info object.
+
+2002-12-18 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-int.el (gnus-request-update-info): Artificially add
+ (1 . (1- min)) to the read range, in case the backend doesn't
+ store marks for nonexistent articles.
+
+2002-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * binhex.el (binhex-insert-char): Eval-and-compile.
+
+2002-12-17 Jesper Harder <harder@ifa.au.dk>
+
+ * lpath.el: Add tool-bar-local-item-from-menu.
+
+ * message.el (message-tool-bar-local-item-from-menu): New function.
+ (message-tool-bar-map): Use it.
+
+2002-12-14 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-uu.el (gnus-uu-digest-headers): Mention nil value in docstring.
+
+ * gnus-art.el (gnus-article-header-rank): Last header in
+ gnus-sorted-header-list should have higher rank than non-members.
+
+2002-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-close-agent): Don't blank out the list of
+ covered methods.
+
+2002-12-12 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nntp.el (nntp-with-open-group-first-pass): Do not wrap in
+ eval-when-compile. Suggested by Kevin Greiner.
+
+2002-12-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-max-fetch-size): New, defcustom.
+ (gnus-agent-fetch-headers): Initialize gnus-agent-overview-buffer
+ even though no headers may have been fetched
+ (gnus-agent-fetch-group-1, and perhaps others, require this
+ behavior).
+ (gnus-agent-fetch-group-1): Fetch articles in chucks so that the
+ server buffer is constrained by gnus-agent-max-fetch-size.
+ Multiple chunks in the same group may perform arbitrarily large
+ updates.
+
+2002-12-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to
+ gnus-summary-update-download-mark to update the article in the
+ summary.
+
+2002-12-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus.el (gnus-summary-high-uncached-face,
+ gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face)
+ New faces.
+
+ * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I
+ added this on 2002-11-23 but it just wasn't working out as
+ intended. The idea isn't entirely dead, three new faces
+ gnus-summary-*-uncached-face are being added to gnus.el to provide
+ the basis for an improved implementation.
+ (gnus-agent-read-servers): Undo the change made on 2002-11-23. The
+ proper file to open is lib/servers.
+ (gnus-summary-set-agent-mark): Expanded documentation. Unmarking
+ (i.e. removing the article from gnus-newsgroup-downloadable) will
+ now restore the article's default mark rather than simply setting
+ no mark.
+ (gnus-agent-get-undownloaded-list): Corrected documentation.
+ Added code to set new summary local variable,
+ gnus-newsgroup-agentized. Reworked impl so that it doesn't create
+ a temporary list. No longer sets gnus-newsgroup-downloadable.
+ (gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded
+ up to date. Call new gnus-summary-update-download-mark to keep
+ summary buffer up-to-date.
+ (gnus-agent-fetch-selected-article): Keep
+ gnus-newsgroup-undownloaded up to date.
+ (gnus-agent-fetch-articles): Return list of articles that were
+ successfully fetched.
+ (gnus-agent-check-overview-buffer): No more thingatpt.
+ (gnus-agent-expire): No longer deletes NOV entries of unread
+ articles.
+ (gnus-agent-unread-articles): New function.
+ (gnus-agent-regenerate-group): The article number must be
+ terminated by a tab character. Added more messages to report
+ repairs. Inhibit quits while writing changes so it is now safe
+ have to quit regeneration. Renamed gnus-tmp-downloaded back to
+ downloaded to 1) resolve the unbound references and 2) avoid
+ confusing this list with the gnus-tmp-downloaded in gnus-sum.el
+
+ * gnus-art.el (gnus-article-prepare): The agent
+ downloaded/undownloaded mark is no longer stored as the article's
+ mark.
+
+ * gnus-salt.el (gnus-tree-highlight-node): Added uncached as
+ gnus-summary-highlight may use it. Added downloaded as
+ gnus-summary-highlight was using it.
+
+ * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as
+ the download mark now follows Kai's +/- convention.
+ (gnus-downloaded-mark): Added ?+ mark.
+ (gnus-summary-highlight): Added rules to select
+ gnus-summary-high-uncached-face,
+ gnus-summary-normal-uncached-face, and
+ gnus-summary-low-uncached-face. Removed the
+ gnus-agent-downloaded-article-face.
+ (gnus-summary-line-format-alist): Implemented the download flag
+ format (?O) as named in the manual. This implementation displays
+ either gnus-undownloaded-mark, gnus-downloaded-mark, or
+ gnus-no-mark.
+ (gnus-newsgroup-agentized): New local variable that identifies
+ which groups are agentized. While the agent is now on by default,
+ you don't have to agentize every server that you use.
+ (gnus-update-summary-mark-positions): Completed support for the
+ download type of mark.
+ (gnus-summary-insert-line): Added undownloaded to the parameters.
+ (gnus-summary-prepare-threads): Set gnus-tmp-downloaded for
+ reference by the gnus-summary-line-format-spec.
+
+ * nntp.el (nntp-with-open-group): This macro handles dropped or
+ broken connections by opening a new connection and repeating the
+ failed command.
+ (nntp-retrieve-headers-with-xover): Some NNTP servers respond to
+ XOVER commands preceeding the active articles with the nov entry
+ of the first available article. When gnus connected to such a
+ server, the unexpected nov entry would result in duplicate lines
+ in the agent's overview file. This patch fixes the duplicate
+ lines problem and improves performance by skipping over all
+ articles IDs that preceed the first nov entry in the server's
+ reply.
+
+2002-12-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-tmp-downloaded): New internal variable.
+ (gnus-summary-highlight): Use it instead of `downloaded'.
+ (gnus-summary-highlight-line): Ditto.
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Ditto.
+
+2002-12-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-variable-list): Add gnus-agent-covered-methods.
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Remove debug
+ calls.
+
+ * gnus-sum.el (gnus-summary-highlight-line): Don't set the
+ downloaded variable if we're in an uncovered group.
+
+ * gnus-agent.el (gnus-agent-downloaded-article-face): Change the
+ font to soemthing less noticeable.
+ (gnus-agent-group-covered-p): New function.
+
+2002-12-09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-braid-nov): Remove corrupted lines.
+ Because of an unknown bug, the group buffer is saved in .overview
+ file.
+
+2002-12-09 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nntp.el (nntp-send-command): Braino in last commit. Replace
+ `and' with `or'.
+
+2002-12-08 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nntp.el (nntp-send-command): Assume that echo does not happen
+ when nntp-open-connection-function is nntp-open-network-stream.
+ Suggested by Sebastian D.B. Krause <krause@my.gnus.org>.
+
+2002-12-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-retrieve-headers-1): Update the parser.
+
+2002-12-06 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-group): bugfix: don't erase
+ nntp-server-buffer if we aren't going to write to it.
+
+2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
+ Trivial patch from Itai Zukerman <zukerman@math-hat.com>.
+
+ * mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis.
+
+2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * rfc2047.el (rfc2047-decode-region): Remove newlines between
+ decoded words.
+
+2002-12-03 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.el (fboundp): After loading mm-util, make sure it was the
+ right one.
+
+2002-11-29 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from
+ gnus-sum. Made into a user option.
+
+ * gnus-sum.el (gnus-simplify-ignored-prefixes)
+ (gnus-summary-mark-article-as-unread)
+
+2002-11-29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * time-date.el (date-to-time): Typo.
+
+ * parse-time.el: Typo.
+
+ * nnsoup.el (nnsoup-retrieve-headers): Typo.
+
+ * nnmail.el (nnmail-split, nnmail-process-unix-mail-format): Typos.
+
+ * nnimap.el:
+ (nnimap-split-rule, nnimap-find-minmax-uid): Typos.
+
+ * mm-encode.el (mm-safer-encoding): Typo.
+
+ * messcompat.el: Typo.
+
+ * message.el (message-face-alist): Typo.
+
+ * imap.el (imap-interactive-login, imap-open): Typos.
+
+ * ietf-drums.el (ietf-drums-text-token, ietf-drums-qtext-token): Typos.
+
+ * gnus.el: Typo.
+
+ * gnus-win.el (gnus-configure-frame): Typo.
+
+ * gnus-util.el (gnus-atomic-progn-assign): Typo.
+
+ * gnus-topic.el (gnus-topic-sort-topics): Typo.
+
+ * gnus-sum.el (gnus-summary-article-number)
+ (gnus-summary-read-group-1, gnus-summary-mark-article)
+ (gnus-summary-fetch-faq, gnus-refer-article-methods): Typos.
+
+ * gnus-mule.el (gnus-mule-add-group): Typo.
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Typo.
+
+ * gnus-group.el (gnus-group-fetch-faq): Typo.
+
+ * gnus-art.el (gnus-decode-header-methods): Typo.
+
+ * flow-fill.el: Typo.
+
+2002-11-19 Stefan Monnier <monnier@cs.yale.edu>
+
+ * binhex.el (binhex-decode-region): Don't hardcode point-min == 1.
+
+2002-11-29 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-simplify-ignored-prefixes)
+ (gnus-summary-mark-article-as-unread)
+ (gnus-mark-article-as-unread, gnus-summary-highlight-line):
+ Reformatting to avoid long lines.
+ (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art.
+
+2002-11-28 Daiki Ueno <ueno@unixuser.org>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Article numbers should
+ be accessed through `mail-header-number'.
+
+2002-11-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): No longer passes
+ compressed range to gnus-summary-insert-articles.
+
+2002-11-26 Kevin Ryde <user42@zip.com.au>
+
+ * gnus-art.el (gnus-mime-copy-part): Look for filename
+ parameter under content-disposition, not content-type.
+
+ * gnus-sum.el (gnus-summary-find-uncancelled): New function.
+ (gnus-summary-reselect-current-group): Use it.
+
+2002-11-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-uncached-articles): if
+ gnus-agent-load-alist fails, return ARTICLES.
+
+ * nnrss.el (nnrss-group-alist): Update the link of Jabber.
+
+2002-11-26 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Remove
+ superfluous function call.
+ (gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit):
+ Add warning to docstring.
+
+2002-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el: Autoload number-at-point instead.
+ (gnus-agent-check-overview-buffer): No warning for deactivate-mark.
+
+2002-11-26 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly
+ require thingatpt (for number-at-point) and protect against
+ deactivate-mark being unbound (on XEmacs).
+
+2002-11-25 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-check-overview-buffer): Make debugger
+ print message on entry.
+
+ From Kevin Greiner <kgreiner@xpediantsolutions.com>.
+
+ * gnus-range.el (gnus-range-difference): New function.
+ * gnus-sum.el (gnus-summary-insert-old-articles): Use it.
+
+2002-11-24 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Use
+ gnus-remove-from-range instead of gnus-range-difference which
+ doesn't exist.
+
+2002-11-23 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+ From Kevin Greiner <kgreiner@xpediantsolutions.com>.
+
+ * gnus-agent.el (gnus-agent-downloaded-article-face): New face,
+ used for showing which articles have been downloaded.
+ (gnus-agent-article-alist): Format change. Add documentation.
+ (gnus-agent-summary-mode-map): New keybinding `J s' for fetching
+ process-marked articles.
+ (gnus-agent-summary-fetch-series): Command for `J s'. Articles
+ in the series are individually fetched to minimize lose of
+ content due to an error/quit.
+ (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use
+ gnus-message instead of message.
+ (gnus-agent-read-servers): Use file lib/methods instead of
+ lib/servers. TODO: Why?
+ (gnus-summary-set-agent-mark): Adapt to new agent-alist format.
+ (gnus-agent-get-undownloaded-list): Remove articles that appear to
+ come from the agent. This means that they are not downloaded.
+ (gnus-agent-fetch-selected-article): Don't use history.
+ (gnus-agent-save-history, gnus-agent-enter-history)
+ (gnus-agent-article-in-history-p, gnus-agent-history-path):
+ Removed function; history is not used anymore.
+ (gnus-agent-fetch-articles): Fix handling of crossposted articles.
+ (gnus-agent-crosspost): Started rewrite then realized that a typo
+ in gnus-agent-fetch-articles ensures that this function is never
+ called. This will need to be fixed later.
+ (gnus-agent-check-overview-buffer): Some sanity checks on the
+ agent overview buffer. This is a safety net used during
+ development.
+ (gnus-agent-flush-cache): The gnus-agent-article-alist format has
+ changed, write a number to the file indicating this.
+ (gnus-agent-fetch-headers): Rewrite to respect
+ gnus-agent-consider-all-articles without relying on the
+ `.fetched' files. Make it fast.
+ (gnus-agent-braid-nov): Change resulting from
+ gnus-agent-fetch-headers change.
+ (gnus-agent-load-alist, gnus-agent-save-alist): Don't use
+ `.fetched' files.
+ (gnus-agent-read-agentview): New function, used by
+ gnus-agent-load-alist.
+ (gnus-agent-load-fetched-headers): Remove.
+ (gnus-agent-save-alist): Rewrite to accomodate new format.
+ (gnus-agent-fetch-group-1): Make sure list of articles is in the
+ same order as in gnus-newsgroup-headers.
+ (gnus-agent-expire): Document and implement extra args ARTICLES,
+ GROUP, FORCE. Do not restrict usage.
+ (gnus-agent-uncached-articles): New function.
+ (gnus-agent-retrieve-headers): Use it.
+ (gnus-agent-regenerate-group): No longer needs to be called from
+ gnus-agent-regenerate. Individual groups may be regenerated. The
+ regeneration code now fixes duplicate, and mis-ordered, NOV entries.
+ The article fetch dates are validated in the article alist. The
+ article alist is pruned of entries that do not reference existing
+ NOV entries. All changes are computed then applied with
+ inhibit-quit bound to t. As a result, it is now safe to quit out of
+ regeneration. The optional clean parameter has been replaced with
+ an optional reread parameter. Clean is no longer necessary as
+ regeneration gets the appropriate setting from
+ gnus-agent-consider-all-articles. The new reread parameter will
+ result in fetched, or all, articles being marked as unread.
+ (gnus-agent-regenerate): Removed code to regenerate the history
+ file as it is no longer used.
+
+ * gnus-start.el (gnus-make-ascending-articles-unread): New
+ function, for efficient mass-marking.
+
+ * gnus-sum.el (gnus-summary-highlight): Use new face for
+ downloaded articles.
+ (gnus-article-mark): Prefer to indicate read/unread status over
+ downloaded status.
+ (gnus-summary-highlight-line-0): New function, maybe rehighlights
+ line.
+ (gnus-summary-highlight-line): Use new face for downloaded
+ articles.
+ (gnus-summary-insert-old-articles): Improved performance by
+ replacing the initial LIST of older articles with a compressed
+ RANGE of older articles. Some servers appear to lie about
+ their active range so the original list could contain millions
+ of article numbers. The range is not expanded into a list
+ until the optional ALL parameter has been applied.
+
+2002-11-18 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-category-mode): Typo in doc string.
+
+2002-11-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el:
+ added patch from Andreas Fuchs <asf@void.at> to prevent apply errors
+
+ * spam.el: added `M s t' and `M s x' key mappings
+
+2002-11-20 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-morse-message): Narrow to body.
+
+2002-11-19 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-morse-message): Load
+ morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs).
+ (unmorse-region): Autoload it instead.
+
+2002-11-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-morse-message): New function.
+ (gnus-summary-wash-map): Bind to `W m'.
+ (gnus-summary-make-menu-bar): Add.
+
+ * nnimap.el (nnimap-request-expire-articles): Compress sequence
+ before storing \Deleted mark on expired articles.
+
+2002-11-17 Shenghuo Zhu <zsh@cs.rochester.edu>
+ Trivial patch from Markus Rost <rost@math.ohio-state.edu>
+
+ * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open
+ parens in column 0.
+
+2002-11-17 Juanma Barranquero <lektu@terra.es>
+
+ * nnweb.el (nnweb-google-create-mapping): Fix typo.
+
+ * nnlistserv.el (nnlistserv-kk-create-mapping): Likewise.
+
+ * gnus-nocem.el (gnus-nocem-liberal-fetch): Likewise.
+
+2002-11-17 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-set-auto-save-file-name): Use
+ make-directory, to avoid the dependence on gnus-util.
+
+2002-11-16 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-callback-callback-function):
+ (nnimap-callback-buffer): Removed, these cannot be global but must
+ be embedded into the callback.
+ (nnimap-make-callback): New. Embedd article number, callback and
+ buffer in function.
+ (nnimap-callback, nnimap-request-article-part): Update.
+
+2002-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mml.el (mml-preview): Bind message-this-is-mail if it is mail.
+
+2002-11-13 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.el (gnus-summary-line-format): Document %C.
+
+2002-11-11 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display
+ output when called interactively.
+
+2002-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-edit-exit): Kill local variables.
+
+ * message.el (message-draft-coding-system): Improve comment; use
+ mm-auto-save-coding-system for the default value.
+
+ * nndraft.el (nndraft-request-article): Revert to the state before
+ 2002-10-29; regexp-quote mail-header-separator.
+
+2002-11-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-draft.el (gnus-draft-setup): Set gnus-message-group-art to
+ allow editing of drafts from an nnvirtual group.
+
+2002-11-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nndraft.el (nndraft-request-article): Replace emacs-mule with
+ mm-auto-save-coding-system.
+
+ * message.el (message-draft-coding-system): Default to
+ iso-2022-7bit.
+
+ * mm-util.el (mm-auto-save-coding-system): Undo last change to
+ restore the default value to emacs-mule or escape-quoted.
+
+2002-11-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-encrypt-body): Inhibit encrypting of
+ a delayed or a queued article as well as a draft.
+
+ * gnus-sum.el (gnus-summary-edit-article): Inhibit editing of a
+ delayed or a queued article in the raw format; treat a delayed
+ article as a raw article as well as a draft.
+ (gnus-summary-setup-default-charset): Clear gnus-newsgroup-charset
+ for the delayed group.
+
+ * nndraft.el (nndraft-request-article): Ignore auto save files for
+ a delayed or a queued article; don't bother to decode a queued
+ article; don't bind nnmail-file-coding-system for a queued article.
+
+ * nnmail.el (nnmail-split-fancy-with-parent): Ignore the delayed
+ and the queue group.
+
+2002-11-04 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-delete-group):
+ gnus-cache-active-hashtb might be void.
+
+2002-11-02 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Makes PGG respect the
+ setting of the default user ID. From Raymond Scholz
+ <ray-2002@zonix.de>.
+
+2002-11-01 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-body-encoding): Don't return 8bit for 7bit
+ charset.
+
+2002-10-31 Ted Zlatanov <tzz@lifelogs.com>
+ From Alex Schroeder <alex@emacswiki.org>
+ * spam-stat.el (spam-stat-process-directory): add dir to message
+ (spam-stat-reduce-size): No longer remove words
+ with values close to 0.5, because the default value is 0.2.
+
+2002-10-31 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-util.el (gnus-user-date-format-alist): Clarify and correct
+ documentation.
+
+2002-10-28 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-fetched-headers)
+ (gnus-agent-load-fetched-headers)
+ (gnus-agent-save-fetched-headers): Remove variable and two
+ functions. Kevin Greiner's version of gnus-agent-fetch-headers
+ works better.
+ (gnus-agent-fetch-headers): New implementation from Kevin
+ Greiner. Uses gnus-agent-article-alist to store information
+ about fetched messages which aren't on the server anymore. The
+ trick is to return a list of considered messages to the caller,
+ but to only fetch those which haven't been fetched yet.
+
+2002-10-30 Simon Josefsson <jas@extundo.com>
+
+ * pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom.
+
+ * pgg.el (pgg-passphrase-cache-expiry): Removed.
+
+2002-10-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * mm-view.el (mm-w3m-local-map-property): Make it work with older
+ versions of emacs-w3m than 1.3.3.
+
+ * lpath.el: Bind w3m-minor-mode-map.
+
+ * mm-view.el (mm-w3m-mode-command-alist)
+ (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed.
+ (mm-w3m-mode-map): Undefined for Emacs21 and XEmacs.
+ (mm-setup-w3m): Simplified.
+ (mm-w3m-local-map-property): New function.
+ (mm-inline-text-html-render-with-w3m): Use it.
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Use
+ mm-w3m-local-map-property.
+
+2002-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-util.el (mm-auto-save-coding-system): Default to
+ iso-2022-7bit.
+
+ * nndraft.el (nndraft-request-article): Decode an article using
+ the coding-system emacs-mule if it seems to have been saved using
+ emacs-mule.
+ (nndraft-request-replace-article): Use message-draft-coding-system
+ instead of mm-auto-save-coding-system for the draft or delayed
+ group.
+
+2002-10-28 Josh <huber@alum.wpi.edu>
+
+ * mml.el (mml-mode-map): Fixed keybindings for mml-secure-*
+ functions.
+
+2002-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
+ From mah@everybody.org (Mark A. Hershberger).
+
+ * mm-url.el (mm-url-insert-file-contents): Make it return the same
+ type values ("url" size) regardless of the values of
+ mm-url-use-external.
+
+2002-10-26 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * nnimap.el (nnimap-request-article-part): Try harder to show
+ group name in debugging message.
+
+2002-10-25 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-save-fetched-headers): Create
+ directory if it doesn't exist.
+ (gnus-agent-fetch-headers): Remove old cruft that tried to
+ abstain from downloading articles more than once if
+ gnus-agent-consider-all-articles was true. This is now done
+ properly via the .fetched files.
+
+2002-10-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nndraft.el (nndraft-request-article): Treat delayed articles
+ like drafts.
+
+2002-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-load-alist): Fix parenthesis.
+
+2002-10-24 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-save-alist, gnus-agent-load-alist):
+ Remove unused optional arg DIR and corresponding code.
+
+ * nnimap.el (nnimap-request-article-part): Include group name in
+ debugging output.
+
+2002-10-24 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Add some comments.
+
+2002-10-23 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-fetched-headers): New variable,
+ contains range of headers that have been fetched by the agent
+ already. Compare gnus-agent-article-alist.
+ (gnus-agent-file-header-cache): Like
+ gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers.
+ (gnus-agent-fetch-headers): Improve comment. Revert to old
+ seen/recent logic.
+ Remember which headers have been fetched before and don't fetch
+ them again the next time round.
+ (gnus-agent-load-fetched-headers)
+ (gnus-agent-save-fetched-headers): New functions, for remembering
+ which headers have been fetched before.
+
+2002-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Remove useless bindings.
+
+2002-10-22 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-execute-command): Disable visual
+ features while searching.
+
+2002-10-22 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * pgg.el (pgg-snarf-keys): Do not refer unbinded local variables.
+
+2002-10-22 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify)
+ (pgg-snarf-keys): Add.
+
+2002-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind bbdb-records.
+
+ * spam.el: Don't autoload bbdb-records.
+
+2002-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam.el: Set autoload for bbdb-records after loading bbdb-com to
+ prevent inf-loop.
+
+2002-10-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el: Removed some test lines.
+ More test.
+
+2002-10-21 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Remove articles that
+ are known to be downloaded already.
+
+2002-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-text-html-renderer-alist): Add w3m-standalone.
+ (mm-text-html-washer-alist): Ditto.
+
+2002-10-19 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nnheader.el (nnheader-remove-body): Fix an error of detecting
+ boundary between headers and body.
+ * nnml.el (nnml-parse-head): Ditto.
+
+2002-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-generate-active): Ignore any bogus
+ entries.
+
+ * gnus-group.el (gnus-fetch-group): Allow an optional
+ specification of the articles to select.
+
+ * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr.
+
+2002-10-20 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): After fetching
+ headers from the group, update variable `articles' to contain
+ only those numbers where headers exist. (When fetching all
+ articles in a group, Gnus creates lots of numbers where there is
+ no articles.)
+
+2002-10-20 Steve Youngs <youngs@xemacs.org>
+
+ * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs
+ doesn't have the 'alist custom type, use cons cells instead.
+ (pgg-parse-symmetric-key-algorithm-alist): Ditto.
+ (pgg-parse-hash-algorithm-alist): Ditto.
+ (pgg-parse-compression-algorithm-alist): Ditto.
+ (pgg-parse-signature-type-alist): Ditto.
+
+ * pgg-gpg.el (pgg-gpg-extra-args): Fix custom mismatch.
+
+ * pgg-pgp5.el (pgg-pgp5-extra-args): Ditto.
+
+ * pgg-pgp.el (pgg-pgp-extra-args): Ditto.
+
+2002-10-19 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-open-server): Check imap-state in IMAP server
+ buffer.
+
+2002-10-18 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-spec.el (gnus-make-format-preserve-properties)
+ (gnus-xmas-format, gnus-parse-simple-format): Preserve text
+ properties also on XEmacs. `gnus-xmas-format' is like format but
+ preserves text properties on XEmacs (though it only understands
+ simple format specs). The variable
+ `gnus-make-format-preserve-properties' controls whether the
+ function is used, and is checked in `gnus-parse-simple-format'.
+ Patch by Paul Moore <gustav@morpheus.demon.co.uk>.
+
+ * gnus-agent.el (gnus-agent-fetch-articles): More debugging
+ output.
+ (gnus-agent-consider-all-articles): New variable.
+ (gnus-agent-get-undownloaded-list): Comment that marks todo item.
+ (gnus-agent-fetch-headers): Depending on
+ gnus-agent-consider-all-articles, maybe get all articles.
+ (gnus-category-predicate-alist, gnus-agent-read-p): New predicate
+ `read'.
+ (gnus-predicate-imples-unread): New function.
+ (gnus-agent-fetch-headers): Optimize to call
+ gnus-list-of-unread-articles if that is sufficient.
+ Check unseen and recent instead of seen and recent.
+ (gnus-agent-fetch-headers): Abstain from calling
+ gnus-list-range-intersection if range (a . b) would have (> a b).
+
+2002-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-send-mail): Make it possible to perform
+ edebug-defun.
+
+2002-10-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-man-handler): Change default to
+ `manual-entry' (defined in both emacsen).
+ (gnus-button-man-handler): Remove emacsen difference and use
+ `manual-entry'.
+
+2002-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam.el: Wrap autoload settings for bbdb-records,
+ executable-find and ifile-spam-filter with eval-and-compile.
+ (spam-display-buffer-contents): Remove.
+ (spam-bogofilter-score): Merge spam-display-buffer-contents.
+
+2002-10-17 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-display-buffer-contents): New function.
+ (spam-bogofilter-score): use spam-display-buffer-contents, patch
+ from Katsumi Yamaoka <yamaoka@jpl.org>.
+
+2002-10-17 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nnheader.el (nnheader-parse-naked-head): New function.
+ (nnheader-parse-head): Use the above function, in order to handle
+ continuation lines properly.
+ (nnheader-remove-body): New function.
+ (nnheader-remove-cr-followed-by-lf): New function.
+ (nnheader-ms-strip-cr): Use the above function.
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Call
+ `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of
+ `nnheader-parse-head'.
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Ditto.
+
+ * gnus-msg.el (gnus-inews-yank-articles): Do not unfold
+ continuation lines by itself; call `nnheader-parse-naked-head'
+ instead of `nnheader-parse-head'.
+ * nndiary.el (nndiary-parse-head): Ditto.
+ * nnfolder.el (nnfolder-parse-head): Ditto.
+ * nnimap.el (nnimap-retrieve-headers-progress): Ditto.
+ * nnmaildir.el (nnmaildir--update-nov): Ditto.
+ * nnml.el (nnml-parse-head): Ditto.
+
+2002-10-17 Steve Youngs <youngs@xemacs.org>
+
+ * gnus-art.el (gnus-button-man-handler): Add 'manual-entry' for
+ XEmacs, default to it if featurep 'xemacs.
+
+2002-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam-stat.el: Check for the existence of hash functions instead
+ of the Emacs version to decide whether to load cl. Suggested by
+ Kai Gro,A_(Bjohann.
+
+2002-10-15 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Open history
+ if it isn't open yet.
+
+2002-10-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-group.el: Require mm-url only when compiling.
+ (gnus-group-fetch-charter): Require mm-url.
+
+ * spam-stat.el: Require cl for the functions gethash,
+ hash-table-count, make-hash-table and mapc for Emacs 20.
+ (puthash): Alias to cl-puthash for Emacs 20.
+ (with-syntax-table): New macro for Emacs 20.
+
+2002-10-12 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-spec.el (gnus-pad-form): Use gnus-string-width-function.
+
+2002-10-11 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-check-ifile): added ifile as a spam checking
+ backend, and spam-use-ifle as the variable to toggle that check.
+
+2002-10-12 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-beginning-of-line): New variable.
+ (message-beginning-of-line): Use it.
+
+2002-10-11 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: more compilation fixes for BBDB
+
+ * spam-stat.el added code from Alex Schroeder <alex@gnu.org>
+ (spam-stat-reduce-size): Interactive.
+ (spam-stat-reset): New function.
+ (spam-stat-save): Interactive.
+
+2002-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el: Autoload gnus-delay-initialize.
+
+ * message.el: Autoload gnus-delay-article.
+
+2002-10-11 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-spec.el (gnus-balloon-face-function): Use the help-echo
+ text property in Emacs.
+
+2002-10-11 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt)
+ (mml2015-pgg-verify, mml2015-pgg-clear-verify): Remove CR.
+
+ * mml1991.el (mml1991-pgg-sign): Remove CR.
+
+2002-10-10 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-decrypt): Set gnus details even when
+ decrypt failed.
+ (mml2015-trust-boundaries-alist): Removed.
+ (mml2015-gpg-extract-signature-details): Don't use it.
+ (mml2015-unabbrev-trust-alist): New.
+ (mml2015-gpg-extract-signature-details): Use it.
+
+2002-10-10 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: compilation fixes, spam-check-bbdb function is nil if no
+ BBDB installed
+
+ * spam-stat.el: added code from Alex Schroeder <alex@gnu.org> to do
+ statistical analysis of spam in Lisp only
+
+2002-10-10 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-open-server): Re-open server if it isn't in
+ auth, selected or examine state.
+
+ * pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output
+ buffer and error buffer depending on type of information.
+
+ * mml2015.el (mml2015-gpg-extract-signature-details): Parse
+ --status-fd stuff even if gpg.el is not used (revert earlier
+ change).
+ (mml2015-pgg-{clear-,}verify): Store both output and errors as
+ gnus details.
+ (mml2015-pgg-{clear-,}verify): Extract signature info from errors
+ buffer.
+
+ * pgg.el (pgg-verify-region): Use it.
+
+ * pgg-def.el (pgg-query-keyserver): New variable.
+
+ * pgg.el (pgg-decrypt-region): Bind pgg-default-user-id to
+ key-identifier in packet. Is this a good idea?
+
+ * mml.el (mml-mode-map): Add security commands that operates on
+ MIME parts.
+ (mml-menu): And menu items for them.
+
+ * mml1991.el (mml1991-pgg-encrypt): Remove headers.
+
+ * mml.el (mml-parse-1): Support sender in #secure tags.
+
+ * mml1991.el (mml1991-pgg-sign): Only use message-sender if it is
+ defined.
+
+ * mml-sec.el (mml-smime-encrypt-buffer): Warn about combined signing.
+ (mml-pgp-encrypt-buffer): Support combined signing.
+
+ * mml1991.el (mml1991-mailcrypt-encrypt): Support combined signing.
+ (mml1991-gpg-encrypt): Ditto.
+ (mml1991-pgg-encrypt): Ditto.
+ (mml1991-encrypt): Pass sign parameter.
+
+ * mml-sec.el (mml-signencrypt-style-alist): Defcustom.
+ (mml-signencrypt-style): Mention the variable.
+
+2002-10-09 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (mml1991-pgg-sign): Bind pgg-default-user-id, not
+ pgg-gpg-user-id.
+
+ * pgg.el (pgg-insert-url-with-w3): Ignore errors.
+ (pgg-fetch-key-function): Nil if w3 is not installed.
+
+2002-10-08 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Bind
+ gnus-agent-current-history.
+
+2002-10-06 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-status): Don't use read to read token.
+
+2002-10-05 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Do nothing
+ for methods not covered by the agent, and when unplugged.
+
+2002-10-05 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Query passphrase when
+ signing.
+
+ * gnus-agent.el (gnus-agent-read-servers): If getting method from
+ a named server fails, ignore the server.
+
+ * mml1991.el (mml1991-pgg-sign): Do QP.
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt really
+ work.
+
+2002-10-04 Simon Josefsson <jas@extundo.com>
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work.
+
+ * pgg-pgp.el (pgg-pgp-verify-region): Inline
+ binary-write-decoded-region from MEL.
+
+ * pgg.el (pgg-encrypt-region): Support sign.
+
+ * pgg-gpg.el (pgg-gpg-encrypt-region): Ditto.
+
+ * mml2015.el (mml2015-pgg-encrypt): Ditto.
+
+ * pgg.el, pgg-def.el, pgg-parse.el, pgg-gpg.el, pgg-pgp5.el,
+ pgg-pgp6.el: Moved from ../pgg/. Modifications compared to EMIKO
+ branch where PGG was taken from in the ChangeLog entries below.
+
+2002-10-01 Simon Josefsson <jas@extundo.com>
+
+ * pgg-pgp.el: Don't require mel. Don't use luna.
+ (pgg-scheme-pgp-instance, pgg-make-scheme-pgp): Remove.
+ (pgg-pgp-process-region): Use expand-file-name instead of concat.
+ (pgg-pgp-process-region): Don't use binary-funcall.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Don't use binary-funcall.
+
+ * pgg-gpg.el (pgg-gpg-process-region): Use expand-file-name
+ instead of concat.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
+
+2002-09-29 Simon Josefsson <jas@extundo.com>
+
+ * pgg-parse.el (pgg-char-int, pgg-string-as-unibyte): Prevent byte
+ compile warnings.
+
+ * pgg.el (pgg-decrypt-region): Don't parse packet.
+
+ * pgg.el, pgg-gpg.el, pgg-pgp5.el: Don't depend on luna.el.
+
+2002-09-29 Daiki Ueno <ueno@unixuser.org>
+
+ * pgg.el: Remove dependency on calist.el.
+
+2002-09-28 Simon Josefsson <jas@extundo.com>
+
+ * pgg.el (pgg-temporary-file-directory): New variable.
+ (pgg-verify-region): Don't assume set-buffer-multibyte exists.
+
+ * pgg-pgp5.el (pgg-pgp5-process-region, pgg-scheme-verify-region)
+ (pgg-scheme-snarf-keys-region): Use pgg-temporary-file-directory.
+
+ * pgg-parse.el (pgg-char-int): Defalias.
+ (pgg-format-key-identifier, pgg-byte-after, pgg-read-byte)
+ (pgg-read-bytes, pgg-read-body): Use it.
+ (pgg-decode-packets): Don't use MEL, use base64-*.
+ (pgg-parse-armor): Don't assume set-buffer-multibyte exists.
+ (pgg-string-as-unibyte): Defalias.
+ (pgg-parse-armor-region): Use it.
+
+ * pgg-gpg.el (pgg-gpg-process-region): Use
+ pgg-temporary-file-directory.
+
+ * luna.el: Don't def-edebug.
+
+ * pgg-pgp5.el (pgg-scheme-verify-region): Inline
+ binary-write-decoded-region from MEL.
+
+ * pgg-pgp5.el, pgg-gpg.el: Don't require mel.
+
+ * alist.el, calist.el: Don't require product/APEL.
+
+ * pgg-parse.el (top-level): Remove dependency on static.el,
+ pccl.el, mel.el.
+ (pgg-parse-crc24, pgg-parse-crc24-string): Only define if
+ `define-ccl-program' is boundp, instead of using broken.
+
+2002-10-01 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-required-mail-headers): Remove Lines:.
+
+2002-10-03 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Jesper Harder.
+
+ * gnus-group.el (gnus-group-fetch-charter,
+ gnus-group-fetch-control): Prompt for group if given a prefix
+ argument.
+ * gnus-sum.el (t): Add gnus-group-fetch-charter and
+ gnus-group-fetch-control to summary key map and menu.
+
+2002-10-03 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article
+ number when there are no articles.
+
+2002-10-03 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-summary-fetch-group): Optional prefix
+ arg ALL means to fetch all articles, not only downloadable ones.
+ (gnus-agent-fetch-selected-article): New function for
+ gnus-select-article-hook or gnus-mark-article-hook.
+
+2002-10-02 Katsumi Yamaoka <yamaoka@jpl.org>
+ From Peter von der Ahe <nospam2159@daimi.au.dk>.
+
+ * gnus-ems.el (gnus-x-splash): Set coding-system-for-read to
+ raw-text.
+
+2002-09-30 Ted Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: merged changes from pinard@iro.umontreal.ca (Fran,Ag(Bois
+ Pinard).
+ Major revamp of the code, documentation is in comments in the file
+ for now.
+
+2002-09-30 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-pgg-clear-verify): Verifying in a unibyte
+ buffer seem to be needed?
+
+2002-09-29 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (pgg-output-buffer, pgg-errors-buffer): Prevent byte
+ compile warnings.
+
+ * mml1991.el (mml1991-function-alist): Add pgg.
+ (mml1991-pgg-sign, mml1991-pgg-encrypt): New functions.
+ (mml1991-pgg-encrypt): Fix recipients querying.
+
+2002-09-28 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (autoload): Autoload correct files. Trivial patch
+ from dme@dme.org.
+ (mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or
+ handle is returned.
+
+2002-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news):
+ Protect against non-existent of `nnimap-mailbox-info'.
+
+2002-09-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): New.
+ (gnus-setup-news-hook): Use it.
+ (gnus-after-getting-new-news-hook): Ditto.
+
+ * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Remove.
+
+2002-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
+ From Mats Lidell <matsl@contactor.se>.
+
+ * gnus-art.el (gnus-article-mode-syntax-table): Replace "-" to " ".
+
+2002-09-27 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * gnus-sum.el (gnus-nov-parse-line): When an error is signaled in
+ the part to decode encoded words, use raw words instead of decoded
+ words.
+
+2002-09-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnimap.el (nnimap-update-unseen): Use gnus-gethash-safe.
+
+ * mm-view.el (mm-w3m-mode-ignored-keys): New variable.
+ (mm-setup-w3m): Use it.
+
+2002-09-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in
+ article buffers.
+
+ * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload
+ it just in case.
+ (nnimap-update-unseen): New function; update unseen count in
+ `n-m-info'.
+ (nnimap-close-group): Call it.
+
+ * gnus-start.el (gnus-setup-news-hook): Add n-f-u-a-g-n-n.
+ (gnus-after-getting-new-news-hook): Ditto.
+
+ * nnimap.el (nnimap-retrieve-groups): Move the quick mail check
+ message into verboselevel 9. Change slow mail check message.
+ (nnimap-retrieve-groups): Use prefixed names in n-mailbox-info.
+ (nnimap-fixup-unread-after-getting-new-news): New function, to be
+ used as a hook after getting new mail.
+
+2002-09-26 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-resp-text-code): The UNSEEN value in
+ SELECT/EXAMINE is first unseen article, not number of unseen
+ articles. Make them distinct by renaming the former to
+ `first-unseen' instead of `unseen'.
+
+ * nnimap.el (nnimap-retrieve-groups): Get uidvalidity and unseen
+ too.
+ (nnimap-retrieve-groups): Don't used cached data if uidvalidity
+ changed.
+ (nnimap-retrieve-groups): Store uidvalidity and unseen data too.
+
+ * gnus-int.el (gnus-server-unopen-status): Defcustom.
+
+ * mml-sec.el (mml-signencrypt-style): Docstring to font-lock
+ better.
+
+ * mml2015.el (mml2015-pgg-decrypt): Only add security information
+ if dissecting resulting buffer actually had any information.
+
+2002-09-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-group.el (gnus-group-sort-by-method): Remove `symbol-name'
+ because the function `string<' allows symbols.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Ditto.
+
+2002-09-25 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-forward-make-body): Revert an early change
+ because 8-bit utf-8 emails.
+
+2002-09-25 Bj,Av(Brn Torkelsson <torkel@acc.umu.se>
+
+ * gnus-agent.el (gnus-category-line-format): Doc fixes (mostly added
+ links to Info)
+ * gnus-art.el (gnus-treat-highlight-signature):
+ * gnus-art.el (gnus-treat-buttonize):
+ * gnus-art.el (gnus-treat-buttonize-head):
+ * gnus-art.el (gnus-treat-emphasize):
+ * gnus-art.el (gnus-treat-strip-cr):
+ * gnus-art.el (gnus-treat-unsplit-urls):
+ * gnus-art.el (gnus-treat-leading-whitespace):
+ * gnus-art.el (gnus-treat-hide-headers):
+ * gnus-art.el (gnus-treat-hide-boring-headers):
+ * gnus-art.el (gnus-treat-hide-signature):
+ * gnus-art.el (gnus-treat-fill-article):
+ * gnus-art.el (gnus-treat-hide-citation):
+ * gnus-art.el (gnus-treat-hide-citation-maybe):
+ * gnus-art.el (gnus-treat-strip-list-identifiers):
+ * gnus-art.el (gnus-treat-strip-pgp):
+ * gnus-art.el (gnus-treat-strip-pem):
+ * gnus-art.el (gnus-treat-strip-banner):
+ * gnus-art.el (gnus-treat-highlight-headers):
+ * gnus-art.el (gnus-treat-highlight-citation):
+ * gnus-art.el (gnus-treat-date-ut):
+ * gnus-art.el (gnus-treat-date-local):
+ * gnus-art.el (gnus-treat-date-english):
+ * gnus-art.el (gnus-treat-date-lapsed):
+ * gnus-art.el (gnus-treat-date-original):
+ * gnus-art.el (gnus-treat-date-iso8601):
+ * gnus-art.el (gnus-treat-date-user-defined):
+ * gnus-art.el (gnus-treat-strip-headers-in-body):
+ * gnus-art.el (gnus-treat-strip-trailing-blank-lines):
+ * gnus-art.el (gnus-treat-strip-leading-blank-lines):
+ * gnus-art.el (gnus-treat-strip-multiple-blank-lines):
+ * gnus-art.el (gnus-treat-unfold-headers):
+ * gnus-art.el (gnus-treat-fold-headers):
+ * gnus-art.el (gnus-treat-fold-newsgroups):
+ * gnus-art.el (gnus-treat-overstrike):
+ * gnus-art.el (gnus-treat-display-xface):
+ * gnus-art.el (gnus-treat-display-smileys):
+ * gnus-art.el (gnus-treat-from-picon):
+ * gnus-art.el (gnus-treat-mail-picon):
+ * gnus-art.el (gnus-treat-newsgroups-picon):
+ * gnus-art.el (gnus-treat-body-boundary):
+ * gnus-art.el (gnus-treat-capitalize-sentences):
+ * gnus-art.el (gnus-treat-fill-long-lines):
+ * gnus-art.el (gnus-treat-play-sounds):
+ * gnus-art.el (gnus-treat-translate):
+ * gnus-art.el (gnus-treat-x-pgp-sig):
+ * gnus-art.el (gnus-mime-button-line-format):
+ * gnus-art.el (gnus-button-man-level):
+ * gnus-art.el (gnus-button-emacs-level):
+ * gnus-cus.el (gnus-group-parameters):
+ * gnus-gl.el (bbb-build-mid-scores-alist):
+ * gnus-group.el (gnus-group-line-format):
+ * gnus-mlspl.el (gnus-group-split-setup):
+ * gnus-mlspl.el (gnus-group-split):
+ * gnus-msg.el (gnus-mailing-list-groups):
+ * gnus-msg.el (gnus-posting-styles):
+ * gnus-nocem.el (gnus-nocem-issuers):
+ * gnus-score.el (gnus-score-regexp-bad-p):
+ * gnus-srvr.el (gnus-server-line-format):
+ * gnus-topic.el (gnus-topic-line-format):
+ * gnus.el (gnus-summary-line-format):
+ * mail-source.el (mail-sources):
+ * message.el (message-subscribed-address-file):
+ * nnmail.el (nnmail-split-fancy):
+
+2002-09-24 Evgeny Roubinchtein <zhenya@freeshell.org>
+
+ * mail-source.el(mail-source-run-script): use `functionp' to test
+ whether the argument `script' is in fact a function.
+ (mail-sources): adjust the defcustom to allow users to specify a
+ function or a string as the value of the `:prescript' and
+ `:postscript' arguments of the `file' and `pop3' mail sources.
+
+2002-09-25 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--grp-add-art): fix minimum article
+ number when article 1 does not exist.
+
+2002-09-25 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (gnus-button-handle-apropos-variable): Fall back to
+ apropos if apropos-variable does not exist.
+ (gnus-button-guessed-mid-regexp)
+ (gnus-button-handle-describe-prefix, gnus-button-alist): Better
+ regexes. From Reiner Steib.
+ (gnus-button-handle-describe-function)
+ (gnus-button-handle-describe-variable): Doc fix. From Reiner Steib.
+ (gnus-button-handle-describe-key, gnus-button-handle-apropos)
+ (gnus-button-handle-apropos-command): Doc fix. From Reiner Steib.
+
+2002-09-25 Mark A. Hershberger <mah@everybody.org>
+ Trivial patch.
+
+ * nnrss.el (nnrss-save-server-data): Save nnrss-group-alist in
+ the file.
+
+2002-09-24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-1): Create nndraft:queue, nndraft:drafts.
+
+2002-09-24 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (top-level): Require mm-util for mm-make-temp-file.
+ (mml2015-use): Prefer PGG if installed.
+ (mml2015-function-alist): Add PGG wrappers.
+ (mml2015-gpg-extract-signature-details): Check mml2015-use too.
+ (mml2015-gpg-extract-signature-details): PGG strips "gpg: "
+ prefix, make regexp optionally skip it.
+ (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt)
+ (mml2015-pgg-verify, mml2015-pgg-clear-verify, mml2015-pgg-sign)
+ (mml2015-pgg-encrypt): New functions.
+ (defvar, autoload): Prevent byte-compile warnings.
+
+2002-09-24 Katsumi Yamaoka <yamaoka@jpl.org>
+ From TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
+
+ * gnus-art.el (article-strip-banner): Check for the existence of
+ from header.
+
+2002-09-23 Kai Gro,b_(Bjohann <grossjoh@ls6.informatik.uni-dortmund.de>
+
+ * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp.
+ (gnus-button-alist): Improved regexp for
+ gnus-button-handle-mid-or-mail (false positives), fixed
+ gnus-button-handle-man entries.
+ From Reiner Steib.
+
+2002-09-23 Paul Jarc <prj@po.cwru.edu>
+ From Josh Huber.
+
+ * nnmaildir.el (nnmaildir--update-nov): fix wrong-type error when
+ nnmail-extra-headers is non-nil.
+
+2002-09-23 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el: Store article numbers persistently. General
+ revision.
+ (nnmaildir-request-expire-articles): handle 'immediate and 'never
+ for nnmail-expiry-wait; delete instead of moving if 'force is
+ given.
+
+2002-09-23 Simon Josefsson <jas@extundo.com>
+ Trivial fix from beaker@iavmb.pl (Krzysztof J,Bj(Bdruczyk).
+
+ * smime.el (smime-sign-buffer): Get key and extra certs.
+ (smime-get-key-with-certs-by-email): Utility function.
+
+2002-09-21 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Micha Wiedenmann <mw-u1@gmx.de>
+
+ * gnus-soup.el (gnus-soup-add-article): Mark as read only when the
+ article exists.
+
+2002-09-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-next-group): Switch to the summary buffer.
+
+2002-09-20 Kai Gro,b_(Bjohann <grossjoh@ls6.informatik.uni-dortmund.de>
+ From Reiner Steib.
+
+ * gnus-art.el (gnus-button-handle-custom,
+ gnus-button-handle-mid-or-mail,
+ gnus-button-handle-describe-{function,variable,key},
+ gnus-button-handle-apropos{,command,variable}): New functions.
+ (gnus-button-prefer-mid-or-mail,gnus-button-guessed-mid-regexp,
+ gnus-button-{man,emacs,mail}-level): New variables.
+ (gnus-button-alist): Use the above to buttonize emacs and mail
+ related links.
+
+2002-09-18 Juanma Barranquero <lektu@terra.es>
+
+ * gnus-int.el (gnus-status-message): Fix spacing.
+
+ * imap.el (imap-continuation): Fix typos.
+
+2002-09-18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-configure-posting-styles): Sort results.
+
+ * gnus-art.el (gnus-article-reply-with-original): Correct
+ with-current-buffer scope.
+
+ * message.el (message-completion-alist): Add Reply-To, From, etc.
+
+2002-09-18 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-request-expire-articles): Make flag setting
+ conditional. From Nevin Kapur <nevin@jhu.edu>.
+
+2002-09-17 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): Don't search for which
+ articles exists here.
+ (nnimap-request-expire-articles): Do it here instead. Only expire
+ when articles are found. Suggested by Nevin Kapur
+ <nevin@jhu.edu>.
+
+2002-09-17 Kai Gro,A_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Reiner Steib <reiner.steib@gmx.de>.
+
+ * message.el (message-strip-subject-trailing-was)
+ (message-change-subject, message-add-archive-header)
+ (message-xpost-fup2-header, message-xpost-insert-note)
+ (message-xpost-fup2, message-reduce-to-to-cc): New functions
+ adopted from message-utils.el. Add functions to the keymap, mode
+ describtion and menu.
+ (message-change-subject,message-xpost-fup2): Signal error if
+ current header is empty.
+ (message-xpost-insert-note): Changed insert position.
+ (message-archive-note): Ensure to insert note in message body (not
+ in head).
+ (message-archive-header, message-archive-note)
+ (message-xpost-default, message-xpost-note, message-fup2-note)
+ (message-xpost-note-function): New variables adopted from
+ message-utils.el. Changed some doc-strings.
+ (message-mark-insert-{begin,end}): Rename from
+ message-{begin,end}-inserted-text-mark (message-utils.el), changed
+ values.
+ (message-subject-trailing-was-query)
+ (message-subject-trailing-was-ask-regexp)
+ (message-subject-trailing-was-regexp): New variables.
+ (message-to-list-only): Added doc-string and menu entry.
+
+ * message-utils.el: Removed. Functions are now in message.el.
+
+2002-09-16 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-reply-with-original,
+ gnus-article-followup-with-original): Switch to
+ gnus-summary-buffer before reply/followup.
+
+2002-09-15 John Paul Wallington <jpw@shootybangbang.com>
+
+ * gnus-sum.el (gnus-summary-toggle-header): The article window may
+ not exist. Toggle it anyway.
+
+2002-09-13 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-copy-article-buffer): Bind mail-header-separator.
+
+ * gnus-art.el (article-fill-long-lines): Fill-paragraph properly.
+ Trivial patch from Urban Engberg <ue@ccieurope.com>.
+
+ * rfc2047.el (message-posting-charset): Defvar it.
+ (rfc2047-charset-encoding-alist): Use B for iso-8859-7 and
+ iso-8859-8. Fix doc. Suggested by Dave Love <fx@gnu.org>.
+
+ * mail-source.el (mail-source-fetch): Hide password.
+
+ * gnus-sum.el (gnus-summary-next-group): Semi-exit only when needed.
+
+2002-09-12 Katsumi Yamaoka <yamaoka@jpl.org>
+ From John Paul Wallington <jpw@shootybangbang.com>.
+
+ * gnus.el (gnus-visual, gnus-meta): Fix typo.
+
+2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-address-banner-alist): Doc fix.
+
+2002-09-11 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): Only expiry-target existing articles.
+ (nnimap-split-rule): Doc fix.
+ (nnimap-request-expire-articles): Cleanup code.
+
+2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
+ From TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
+
+ * gnus-art.el (gnus-article-address-banner-alist): New option.
+ (article-strip-banner): Refer the above option to split banners of
+ free mail servers, when no group parameter is specified.
+
+2002-09-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-wait-for-string): Check for a process in the
+ current buffer instead of `nntp-server-buffer'.
+
+2002-09-09 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-man-handler): New variable.
+ (gnus-button-alist): Use g-b-handle-man.
+ (gnus-button-handle-man): New, call g-b-man-handler.
+
+2002-09-08 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Buttonize man page links.
+
+2002-09-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-dumbquotes-map): Add \230.
+
+2002-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-browse-make-menu-bar): Add "d".
+
+ * gnus-sum.el (gnus-summary-limit-to-unseen): New command and
+ keystroke.
+
+ * gnus-srvr.el (gnus-browse-describe-group): New command and
+ keystroke.
+
+2002-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-treat-body-boundary): Don't quote a
+ value for gnus-decoration property.
+
+2002-09-06 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-cache-fetch-group): Don't return "" (empty
+ string) as group name in case we have a CRLF in the file.
+
+2002-09-04 Jesper Harder <harder@ifa.au.dk>
+
+ * rfc1843.el (rfc1843-decode-loosely): Move to mime customization
+ group.
+ (rfc1843-decode-hzp): do.
+ (rfc1843-newsgroups-regexp): do.
+
+2002-09-04 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-canlock-generate): Make sure sha1 doesn't
+ call external programs.
+
+2002-09-03 Simon Josefsson <jas@extundo.com>
+
+ * nntp.el (nntp-wait-for-string): Dont infloop if process died.
+
+ * gnus-agent.el (gnus-agent-batch): Add doc.
+
+2002-09-03 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-msg.el (gnus-summary-handle-replysign): Change the order we
+ check for signed and encrypted parts.
+ * mml.el (mml-parse-1): Correct small typo which preventing
+ setting recipients in a secure tag.
+
+2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-util.el (mm-coding-system-priorities): Default to a list of
+ iso-2022-jp and others for the Japanese environment.
+
+2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el (gnus-frame-or-window-display-name): Exclude
+ invalid display names.
+
+2002-08-30 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-fetch-control): Fix typo in last
+ commit. From Reiner Steib <4uce.02.r.steib@gmx.net>.
+
+2002-08-26 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-group-charter-alist): New option.
+ (gnus-group-fetch-control-use-browse-url): New option.
+
+ * gnus-group.el (gnus-group-fetch-charter): New function.
+ (gnus-group-fetch-control): New function.
+ Add them to the keymap and menu. Require mm-url.
+
+2002-08-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Doc fix.
+ From Alex Schroeder <alex@emacswiki.org>.
+
+2002-08-29 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-group.el (gnus-group-make-menu-bar): Add ellipses to menu
+ items expecting user interaction.
+
+ * gnus-topic.el (gnus-topic-make-menu-bar): do.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): do.
+
+ * gnus-srvr.el (gnus-server-make-menu-bar): do.
+
+ * mml.el (mml-menu): do.
+
+2002-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mail-source.el (mail-source-touch-pop): New function.
+
+ * message.el (message-smtpmail-send-it): New function.
+ (message-send-mail-function): Add it for a candidate.
+
+2002-08-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (posting-charset-alist): Use
+ gnus-define-group-parameter instead of defcustom.
+ (gnus-put-message): Handle SPC in GCC.
+ (gnus-inews-insert-gcc): Ditto.
+ (gnus-inews-insert-archive-gcc): Ditto.
+
+2002-08-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agent-auto-agentize-methods): New variable.
+ (gnus-agentize): Auto agentize all nntp and nnimap groups.
+ (gnus-agent-possibly-save-gcc): Autoload.
+ Suggested by (KOSEKI Yoshinori) <kose@meadowy.org>.
+
+2002-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-other-frame-function): New user option.
+ (gnus-other-frame): Use it; add a doc-string; make it work with
+ the gnuclient program.
+
+ * gnus-util.el (gnus-frame-or-window-display-name): New function.
+
+ * lpath.el: Fbind `frame-parameter', `make-frame-on-display',
+ `device-connection' and `dfw-device'.
+
+2002-08-22 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (gnus-emphasis-alist): Strikethru had a lot of false
+ positives, make it stricter. From Jochen Hein (trivial change).
+
+2002-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-other-frame): Trivial fix.
+
+2002-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-other-frame-parameters): New user option.
+ (gnus-other-frame-object): New variable.
+ (gnus-other-frame): Make it search for existing Gnus frame; don't
+ read new news; delete frame on exit.
+
+ * gnus-util.el (gnus-select-frame-set-input-focus): New function.
+
+ * lpath.el: Fbind w32-focus-frame and x-focus-frame.
+
+2002-08-20 Katsumi Yamaoka <yamaoka@jpl.org>
+ From $B>.4X(B $B5HB'(B (KOSEKI Yoshinori) <kose@meadowy.org>.
+
+ * message.el (message-set-auto-save-file-name): Add support for
+ the Cygwin Emacs; the system-type is `cygwin'.
+ * nnheader.el (nnheader-file-name-translation-alist): Ditto.
+
+2002-08-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-button-url-regexp): Use POSIX regexp if possible.
+
+ * nnmh.el (nnmh-request-list-1): Use %.0f instead of %d to
+ avoid arithmetic errors.
+
+2002-08-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el: Don't fbind `gnus-article-replace-with-quoted-text'.
+
+2002-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-ignored-supersedes-headers): Add X-Hashcash.
+ (message-ignored-resent-headers): Add envelope From.
+
+2002-08-18 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.el (gnus-summary-line-format): Document %k specifier.
+
+2002-08-17 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-summary-line-message-size): New function.
+ (gnus-summary-line-format-alist): Use it.
+
+2002-08-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-make-date-line): Refer to the value for
+ `gnus-article-time-format' in the summary buffer.
+
+ * message.el (message-cite-prefix-regexp): Exclude ":" and ",A;(B".
+
+2002-08-14 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Use ' not ` for default value
+ quoting.
+ (gnus-button-alist): Fix doc.
+ (gnus-header-button-alist): Use ' not ` for default value quoting.
+ (gnus-header-button-alist): Don't inline gnus-button-url-regexp,
+ rationale similar to 2002-05-01 change.
+ (gnus-article-add-buttons-to-head): Evaluate expression.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME button option.
+
+2002-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-font-lock-keywords): Refer to the value for
+ `message-cite-prefix-regexp' dynamically.
+
+2002-08-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-decode-header-methods): Doc fix.
+
+2002-08-12 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-shell-open): Allow non-list `imap-shell-program'.
+ (imap-shell-open): Skip initial junk before IMAP greeting.
+
+2002-08-11 Simon Josefsson <jas@extundo.com>
+
+ * message-utils.el (message-xpost-default,
+ message-xpost-fup2-header, message-xpost-fup2): Fixed
+ Typos. Trivial changes from Reiner Steib
+ <4uce.02.r.steib@gmx.net>.
+
+2002-08-09 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-canlock-password): Set
+ canlock-password-for-verify to newly generated canlock-password.
+ When Emacs is restarted, Custom makes sure this is set, but during
+ the same session we must set it manually.
+
+2002-08-07 Jesper Harder <harder@ifa.au.dk>
+
+ * yenc.el: New file.
+
+ * mm-uu.el (mm-uu-yenc-decode-function): New variable.
+ (mm-uu-type-alist): Add yenc.
+ (mm-uu-yenc-filename): New function.
+ (mm-uu-yenc-extract): New function.
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Add yenc.
+
+2002-08-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (merge): Don't use coerce.
+
+2002-05-27 Jesper Harder <harder@ifa.au.dk>
+
+ * mailcap.el (mailcap-mime-data): Test window-system rather than
+ mm-device-type.
+ (mailcap-mime-data): Call xdvi and gv with "-safer".
+
+ * mm-util.el: Don't define mm-device-type.
+
+2002-08-05 Simon Josefsson <jas@extundo.com>
+
+ * mm-util.el (mm-coding-system-priorities): coding-system type not
+ supported everywhere.
+
+2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bumped version number.
+
+2002-08-04 01:48:57 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.07 is released.
+
+2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-thread-sort-functions): Doc fix.
+ (gnus-article-sort-functions): Doc fix.
+ (t): New keystroke.
+ (gnus-article-sort-by-random): New function.
+ (gnus-thread-sort-by-random): New function.
+
+2002-08-02 Simon Josefsson <jas@extundo.com>
+
+ * gnus-logic.el (gnus-advanced-integer): Swap arguments in
+ funcall. From Scott A Crosby <scrosby@cs.rice.edu>.
+
+2002-07-31 Danny Siu <dsiu@adobe.com>
+
+ * nnimap.el (nnimap-split-articles): do not call nnmail-fetch-field
+ when splitting malformed messages without message-id
+
+2002-07-28 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Niklas Morberg <niklas.morberg@axis.com>.
+
+ * nnweb.el (nnweb-type, nnweb-type-definition)
+ (nnweb-gmane-create-mapping, nnweb-gmane-wash-article)
+ (nnweb-gmane-search, nnweb-gmane-identity): Added gmane
+ functionality.
+ * nnweb.el: Removed old non-functioning search engines.
+
+2002-07-27 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-forward-make-body): Don't use
+ `message-forward-ignored-headers' when doing a "raw" followup (it
+ is important to preserve e.g. CTE).
+
+ * flow-fill.el (fill-flowed): Disable filladapt-mode.
+
+ * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't
+ regexp-quote, Cyrus Sieve is fixed.
+
+ * sieve-manage.el (sieve-manage-deletescript): New function.
+
+ * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3.
+ (sieve-manage-mode): Fix menubar.
+ (sieve-activate): Change some messages.
+ (sieve-deactivate-all): New function.
+ (sieve-deactivate): New alias.
+ (sieve-remove): New function.
+ (sieve-help): Fix help.
+ All suggested by Ned Ludd.
+
+2002-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-inline-text-html-with-images): Doc fix.
+ (mm-w3m-safe-url-regexp): New user option.
+
+ * mm-view.el (mm-inline-text-html-render-with-w3m): Use
+ `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'.
+
+2002-07-23 Karl Kleinpaste <karl@charcoal.com>
+
+ * gnus-sum.el (gnus-summary-delete-article): Force
+ nnmail-expiry-target to 'delete, so that absolute deletion
+ happens when absolute deletion is requested.
+
+2002-07-21 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Nevin Kapur <nevin@jhu.edu>.
+
+ * nnmail.el (nnmail-fancy-expiry-target): Treat nonexisting
+ headers as empty headers.
+
+2002-07-21 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Jochen Hein <jochen@jochen.org>.
+
+ * gnus-art.el (gnus-emphasis-alist): Add strikethrough and
+ correct typo.
+ (gnus-emphasis-strikethru): New face.
+
+2002-07-20 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Jason Merrill <jason@redhat.com>.
+
+ * nnfolder.el (nnfolder-retrieve-headers): Avoid searching the
+ entire file for each of a sequence of missing articles.
+
+ * gnus-salt.el (gnus-binary-display-article): Respect an existing
+ value for gnus-view-pseudos.
+
+ * gnus-sum.el (gnus-summary-insert-new-articles): Count down to
+ avoid nreverse.
+
+2002-07-14 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Ted Zlatanov <teodor.zlatanov@divine.com>.
+
+ * gnus-sum.el (gnus-auto-expirable-marks): Remove `spam'.
+ (gnus-summary-mode-line-format-alist): Add %h for number of
+ spams.
+ (gnus-newsgroup-spam-marked): New variable.
+ (gnus-summary-local-variables): Add gnus-newsgroup-spam-marked.
+ (gnus-article-read-p, gnus-article-mark)
+ (gnus-set-global-variables, gnus-set-global-variables)
+ (gnus-article-marked-p, gnus-summary-mark-article-as-read)
+ (gnus-summary-mark-article-as-unread)
+ (gnus-summary-mark-article-as-unread, gnus-summary-mark-article)
+ (gnus-mark-article-as-read, gnus-mark-article-as-unread)
+ (gnus-mark-article-as-unread, gnus-summary-catchup): Grok spam.
+
+2002-07-10 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-to-groups): Allow group string to be a
+ function. From KANEMATSU Daiji <kdaiji@bea.com>.
+
+2002-07-09 Nevin Kapur <nevin@jhu.edu>
+
+ * gnus-sum.el (gnus-summary-delete-article): Respect group
+ parameters while expiring.
+
+2002-07-08 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (article-make-date-line): Fix string. From Henrik
+ Enberg.
+
+2002-07-08 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (article-unsplit-urls): Only display MIME when this
+ function is called interactively. From Niklas Morberg.
+
+2002-07-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change
+ cdaar to cdar and car.
+
+ * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type)
+ (nnsoup-read-active-file, nnsoup-article-to-area): Ditto.
+
+2002-07-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-toggle-header): Show headers anyway;
+ don't break a narrowed article.
+
+ * nntp.el (nntp-via-rlogin-command-switches): Doc fix.
+ (nntp-open-via-rlogin-and-telnet): Ditto.
+
+2002-07-02 Didier Verna <didier@xemacs.org>
+
+ * nnmail.el (nnmail-split-methods): fix custom type.
+
+2002-07-02 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (article-unsplit-urls): Keep URL buttonized after
+ unsplitting. From Niklas Morberg <niklas.morberg@axis.com>.
+
+2002-07-01 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-msg.el (gnus-summary-resend-default-address): New user option.
+ (gnus-summary-resend-message): Use it.
+
+2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-via-rlogin-command-switches): New variable.
+ (nntp-open-via-rlogin-and-telnet): Re-revert; use the var above.
+
+2002-06-28 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-font-lock-keywords): Don't fontify
+ headers in the message body, only in the header.
+ (message-font-lock-make-header-matcher): New function, used by
+ message-font-lock-keywords.
+ From Katsumi Yamaoka <yamaoka@jpl.org>.
+
+2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-open-via-rlogin-and-telnet): Revert last change.
+
+2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-open-via-rlogin-and-telnet): Hide commandline args.
+
+2002-06-26 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-font-lock-keywords): Revert 2002-06-22
+ change.
+
+2002-06-24 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-font-lock-keywords): Put colon in header
+ name match.
+
+2002-06-22 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-font-lock-keywords): Don't use header faces
+ in the body. Thanks to Stefan Monnier for the hint on the
+ implementation.
+
+2002-05-09 Miles Bader <miles@gnu.org>
+
+ * gnus-cite.el (gnus-cite-blank-line-after-header): New variable.
+ (gnus-article-hide-citation): Respect it.
+
+2002-04-12 Juanma Barranquero <lektu@terra.es>
+
+ * pop3.el (pop3-open-server): Fix typo.
+
+2002-06-18 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus.el (gnus-find-subscribed-addresses): Use add-to-list
+ instead of push to ignore duplicate to-(list|address) values.
+ * nnmail.el (nnmail-cache-ignore-groups): New.
+ * nnmail.el (nnmail-cache-insert): Obey nnmail-cache-ignore-groups
+
+2002-06-18 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-send-queue): Delete the delay header
+ before sending. Suggested by Jan Rychter.
+
+2002-06-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (remove): New compiler macro.
+ (last, coerce, subseq): Remove compiler macros for those built-in
+ or unused functions.
+
+2002-06-17 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make
+ sure to write byte-compiled versions of gnus-*-format-alist to
+ .newsrc.eld. From Simon Josefsson.
+
+2002-06-16 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-agent.el (gnus-agent-read-servers)
+ (gnus-agent-write-servers): Put server name (string like
+ "nnchoke:frumple") in the file instead of a server specification
+ (Lisp expression like (nnchoke "frumple" ...parameters...)).
+ From Bj,Ax(Brn Mork <bmork@dod.no>.
+
+2002-06-16 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cache.el (gnus-cache-remove-article): n is &optional. From
+ Reiner Steib <4uce.02.r.steib@gmx.net>.
+
+2002-06-15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnheader.el (nnheader-file-name-translation-alist): Set the
+ default value for MS Windows systems.
+
+ * gnus-ems.el (nnheader-file-name-translation-alist): Removed.
+
+2002-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-beginning-of-line): Keep the region active
+ in XEmacs. Suggested by TAKAHASHI Kaoru <kaoru@kaisei.org>.
+
+2002-06-13 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-msg.el (gnus-summary-followup): Use g-s-handle-replysign.
+ * gnus-msg.el (gnus-summary-reply): Ditto.
+ * gnus-msg.el (gnus-summary-handle-replysign): New.
+
+2002-06-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-send-mail-with-sendmail): Kill errbuf even
+ if sending failed.
+
+2002-06-11 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-start.el (gnus-dribble-enter): Don't call set-window-point anymore
+ * mml2015.el (mml2015-mailcrypt-encrypt): Accept optional argument
+ to sign while encrypting.
+
+2002-06-11 Simon Josefsson <jas@extundo.com>
+
+ * gnus-int.el (gnus-request-move-article): Agent expire article if
+ successfuly moved.
+
+ * nnweb.el (nnweb-google-create-mapping): Honors the value of
+ nnweb-max-hits. From Niklas Morberg <niklas.morberg@axis.com>.
+
+2002-06-10 Simon Josefsson <jas@extundo.com>
+
+ * gnus-int.el (gnus-request-expire-articles): Fix last change?
+
+2002-06-09 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-delete-article): Don't agent expire here.
+
+ * gnus-int.el (gnus-request-expire-articles): Do it here instead.
+
+2002-06-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * flow-fill.el (fill-flowed): Ignore errors.
+
+2002-06-06 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-send-mail-with-sendmail): Improve error message.
+
+2002-06-06 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-interactive): Change default from nil to t.
+ Better to be safe than to be fast.
+
+2002-06-05 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-send-mail-with-sendmail): Check return value
+ from call-process-region.
+
+2002-06-04 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (gnus-group-mail, gnus-group-news)
+ (gnus-group-post-news, gnus-summary-mail-other-window)
+ (gnus-summary-news-other-window, gnus-summary-post-news): Bind
+ gnus-article-copy to nil, thereby inhibiting the `header' posting
+ style match to use data from last viewed article.
+ Suggested by Hrvoje Niksic.
+
+2002-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * spam.el (spam-point-at-eol): New alias.
+ (spam-parse-whitelist): Use it.
+
+2002-06-03 Simon Josefsson <jas@extundo.com>
+
+ * nnmail.el (nnmail-mail-splitting-decodes): New variable.
+ (nnmail-article-group): Use it.
+
+2002-05-30 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-msg.el (gnus-inews-yank-articles): Merge split header lines
+ so that code reading them won't be surprised. From Jesper Harder
+ <harder@ifa.au.dk>.
+
+2002-05-29 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-delete-article): Agent expire deleted
+ articles.
+
+ * gnus.el (gnus-agent-cache): Doc fix.
+ (gnus-agent): Change default to t.
+
+ * gnus-agent.el (gnus-agent-expire): Make it accept optional
+ ARTICLES, GROUP and FORCE parameters.
+
+2002-05-28 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-line-format): Doc fix.
+
+2002-05-28 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-msg.el (gnus-inews-yank-articles): Unfold headers of
+ original article before yanking. From Jesper Harder
+ <harder@ifa.au.dk>.
+
+2002-05-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-menu-split): New function.
+ (gnus-summary-make-menu-bar): Split charset submenu.
+ (gnus-summary-menu-maxlen): New variable.
+ (gnus-summary-menu-split): Use it.
+
+2002-05-25 Simon Josefsson <jas@extundo.com>
+
+ * mml.el (mml-preview): Generate some headers.
+
+ * gnus.el (gnus-large-newsgroup): Fix :type.
+
+ * nnimap.el (nnimap-nov-is-evil): Change default to t (because the
+ Agent cache NOV's by default now).
+ (nnimap-nov-is-evil): Make it default to `gnus-agent' instead.
+
+2002-05-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-dependencies-add-header): Avoid one unecessary
+ call to gnus-parent-id when we check for References loops.
+ (gnus-summary-prepare-threads): Avoid simplifying every Subject
+ twice by saving the simplified subject string in simp-subject.
+
+2002-05-23 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (gnus-confirm-mail-reply-to-news): Typo. Trivial
+ change from Benjamin Rutt <rutt+news@cis.ohio-state.edu>.
+
+ * nnweb.el (nnweb-type): Remove dejanewsold. Trivial change from
+ Niklas Morberg <niklas.morberg@axis.com>.
+
+2002-05-22 Simon Josefsson <jas@extundo.com>
+
+ * sieve.el (sieve-change-region): Define it before it is used.
+
+ * gnus-msg.el (gnus-confirm-mail-reply-to-news)
+ (gnus-summary-reply): Ask for confirmation when replying to news.
+ Defaults to not ask. From Benjamin Rutt
+ <rutt+news@cis.ohio-state.edu>.
+
+ * nnimap.el (nnimap-nov-is-evil): Improve doc.
+
+2002-05-21 Simon Josefsson <jas@extundo.com>
+
+ * sieve-mode.el (sieve-manage): Fix autoloads.
+
+ * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL
+ name (makes it work with recent Cyrus timsieved).
+
+2002-05-20 Jason <jbaker@cs.utah.edu>
+ Trivial patch.
+
+ * gnus-art.el (gnus-request-article-this-buffer): Try
+ reconnecting if you don't get the message.
+
+2002-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Only get
+ Reply-To headers from the headers.
+
+2002-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-url.el (mm-url-insert): Remove junk message.
+
+2002-05-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-request-list): Parse new html.
+ (nnslashdot-use-front-page): New variable.
+ (nnslashdot-request-list): Use it.
+
+ * mm-url.el (mm-url-timeout): New variable.
+ (mm-url-retries): Ditto.
+ (mm-url-insert): Use it.
+
+2002-05-16 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-simplify-all-whitespace): New function.
+ (gnus-simplify-subject-functions): Mention g-s-a-w.
+
+2002-05-15 Josh Huber <huber@alum.wpi.edu>
+
+ * nnbabyl.el (nnbabyl-request-accept-article): Pass group to
+ nnmail-cache-insert.
+ * nndiary.el (nndiary-request-accept-article): Ditto.
+ * nnfolder.el (nnfolder-request-accept-article): Ditto.
+ * nnimap.el (nnimap-request-accept-article): Ditto.
+ * nnmail.el (nnmail-process-unix-mail-format): Ditto.
+ * nnmail.el (nnmail-check-duplication): Ditto. (from gnus-art)
+ * nnmbox.el (nnmbox-request-accept-article): Ditto.
+ * nnmh.el (nnmh-request-accept-article): Ditto.
+ * nnmail.el (nnmail-cache-insert): Change group to required,
+ removed code which tried to figure out the group.
+
+2002-05-13 Josh Huber <huber@alum.wpi.edu>
+
+ * mml.el (mml-generate-mime-1): Fix mml generation for signed only
+ messages. From Hans de Graaff <hans@degraaff.org>.
+ * nnml.el (nnml-request-accept-article): Pass in the group name to
+ nnmail-cache-insert, since it's available.
+
+2002-05-10 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndoc.el (nndoc-mime-digest-type-p): Set proper file-end.
+
+2002-05-08 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Florian Weimer <fw@deneb.enyo.de>.
+
+ * gnus.el (subscribed): New group parameter.
+ (gnus-find-subscribed-addresses): Use it.
+
+2002-05-08 Josh Huber <huber@alum.wpi.edu>
+
+ * mml-sec.el (mml-signencrypt-style-alist): Rename. Also, changed
+ the default for pgpmime to support pgp v2.
+ * mml-sec.el (mml-signencrypt-style): New accessor function to
+ allow users to get/set the signencrypt style more easily without
+ frobbing the alist directly.
+ * mml.el (mml-generate-mime-1): Use accessor function.
+
+2002-05-08 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (gnus-article-mode-syntax-table): Specify matching
+ parenthesis for "<" and ">". Suggested by Andreas Schwab
+ <schwab@suse.de>.
+
+2002-05-07 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-cache-insert): Prefer group-art over group
+ when intuiting the group the message is written to. From Josh
+ Huber <huber@alum.wpi.edu>.
+
+2002-05-06 Simon Josefsson <jas@extundo.com>
+
+ * gnus-topic.el (gnus-group-topic-parameters): Work when group
+ buffer doesn't show group. From Matt Armstrong <matt@lickey.com>.
+
+2002-05-06 Josh Huber <huber@alum.wpi.edu>
+
+ * mml2015.el (mml2015-gpg-encrypt): Changed name of optional
+ argument, and fixed compiler warning. (added autoload for
+ gpg-encrypt).
+
+2002-05-04 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (mml1991-function-alist): Doc fix.
+
+ * mml.el (mml-preview): Bind gnus-newsrc-hashtb temporarily if it
+ doesn't exist (for previewing messages without having Gnus
+ started).
+
+ * mm-util.el (mm-coding-system-priorities): Defcustom.
+
+ * mm-encode.el (mm-content-transfer-encoding-defaults): Defcustom.
+
+2002-05-01 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-msg.el (gnus-message-replysignencrypted): enabled by
+ default.
+ * mml-sec.el:
+ * mml-sec.el (mml-signencrypt-style): New.
+ * mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional
+ argument `sign'.
+ * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to
+ signencrypt.
+ * mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto.
+ * mml.el (mml-generate-mime-1): Changed logic so a part which is
+ both signed & encryped is processed in one operation. (rather than
+ two separate ops: sign, then encrypt)
+ * mml2015.el (mml2015-gpg-extract-signature-details): Give some
+ indication if a message is signed by an expired key.
+ * mml2015.el (mml2015-gpg-encrypt): Accept optional argument which
+ enables combined sign & encrypt operation. (this was always on
+ before).
+ * mml2015.el (mml2015-encrypt): Accept optional argument `sign'.
+
+2002-05-01 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-retrieve-groups): Use separate data for each
+ server.
+ (nnimap-mailbox-info): defvar instead of defvoo.
+
+2002-05-01 20:09:21 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.06 is released.
+
+2002-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * lpath.el: Bind url-package-version.
+
+2002-05-01 Simon Josefsson <jas@extundo.com>
+
+ * nnfolder.el (nnfolder-request-delete-group): Figure out nov/mrk
+ filename before deleting the group itself, because the presence of
+ a group filename decides if long filenames are used or not.
+
+ * gnus-art.el (gnus-button-alist): Don't inline
+ gnus-button-url-regexp. This makes it possible to change g-b-u-r
+ without also modifying g-button-alist.
+ (gnus-button-alist): Fix type to allow variable as well as regexp.
+ (gnus-article-add-buttons): Evaluate regexp. Strings evaluate to
+ themselves, variables to its contents.
+ (gnus-button-entry): Ditto.
+
+2002-05-01 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-resp-text-code, imap-parse-status): Treat
+ UIDNEXT as a string.
+
+ * nnimap.el (nnimap-string-lessp-numerical): New function.
+ (nnimap-retrieve-groups): Compare UIDNEXT as strings instead of
+ integers.
+
+2002-04-29 Simon Josefsson <jas@extundo.com>
+
+ * nnmail.el (nnmail-cache-insert): Accept optional group
+ parameter.
+
+ * nnimap.el (nnimap-retrieve-groups): Don't send STATUS when
+ n-r-g-a is disabled.
+
+2002-04-29 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-fancy): Fix doc.
+ (nnimap-split-fancy): Fix doc.
+
+ * nnimap.el (nnimap-retrieve-groups-asynchronous): New variable.
+ (nnimap-mailbox-info): New internal variable.
+ (nnimap-retrieve-groups): Implement faster new mail check.
+
+ * nnimap.el (nnimap-split-articles): Support
+ nnmail-cache-accepted-message-ids.
+ (nnimap-request-accept-article): Ditto.
+
+ * imap.el (imap-mailbox-status-asynch): New command.
+
+2002-04-29 Nevin Kapur <nevin@jhu.edu>
+
+ * gnus.el (gnus-find-subscribed-addresses): Return nil when there
+ are no subscribed mail groups.
+ - Strip quoted names when comparing addresses
+
+2002-04-28 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-text-html-renderer): Change customize type to
+ const.
+
+ * gnus-msg.el (gnus-discouraged-post-methods): Fix typo.
+ (gnus-debug-exclude-variables): do.
+
+2002-04-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-article-mail): Use gnus-msg-mail instead.
+ Trivial change from Karl Pfl,Ad(Bsterer <sigurd@12move.de>.
+
+2002-04-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dns.el (dns-make-network-process): New macro.
+ (query-dns): Use it.
+
+2002-04-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-summary-reply): Remove unbound variable
+ article-buffer.
+
+ * mm-url.el (mm-url-package-name): New variable.
+ (mm-url-package-version): New variable.
+ (mm-url-insert-file-contents): Bind url-package-name and
+ url-package-version here.
+ * nnrss.el (nnrss-insert-w3): Move the bindings.
+
+ * nnrss.el (nnrss-insert-w3): Bind url-package-name and
+ url-package-version. Trivial change from Andrew J Cosgriff
+ <ajc@polydistortion.net>
+
+ * mm-decode.el (mm-save-part): Fill in file name when GUI saving
+ attachments. Trivial change from Peter 'Luna' Runestig
+ <peter@runestig.com>.
+
+2002-04-19 Jesper Harder <harder@ifa.au.dk>
+
+ * nnkiboze.el (nnkiboze-request-scan): Call
+ nnkiboze-possibly-change-group.
+ (nnkiboze-generate-group): Use mm-with-unibyte to avoid encoding
+ problems.
+ (nnkiboze-generate-group): Set newsrc to the *highest* article
+ number kibozed, not the lowest.
+
+2002-04-15 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (article-unsplit-urls): Allow trailing SPC.
+
+2002-04-24 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Dan Christensen <jdc+news@uwo.ca>.
+
+ * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p)
+ (nndoc-transform-lanl-gov-announce, nndoc-generate-lanl-gov-head):
+ Recognize math postings. Extract Date (now ignores "(15kb)").
+ Extract email address using gnus-extract-address-components
+ instead of just taking the first word. Create Date and From
+ headers for message which are missing these headers. Get rid
+ of spurious \\ lines (purely cosmetic). Extend body-end and
+ file-end regexps, to exclude more garbage from the message.
+ Make URL rephrasing regexp more flexible, to match current
+ format.
+
+2002-04-23 Simon Josefsson <jas@extundo.com>
+
+ * netrc.el: New file, functions copied from gnus-util.el by Ted
+ Zlatanov <tzz@lifelogs.com>.
+
+ * gnus-util.el: Require netrc.
+ (gnus-netrc-get, gnus-netrc-machine, gnus-parse-netrc): Aliased to
+ new code in netrc.el.
+
+2002-04-23 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-msg.el (gnus-summary-resend-message-edit): Remove
+ message-ignored-resent-headers, too. From Matthieu Moy
+ <Matthieu.Moy@imag.fr>.
+
+2002-04-22 Bj,Av(Brn Torkelsson <torkel@acc.umu.se>
+
+ * gnus-srvr.el (gnus-server-browse-in-group-buffer): it is a
+ boolean not a string
+ * gnus-group.el (gnus-group-line-format): add description of %C
+ * gnus-group.el (gnus-group-line-format-alist): add gnus-tmp-comment
+ as %C
+ * gnus-group.el (gnus-group-insert-group-line): add gnus-tmp-comment
+
+2002-04-22 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-scan): typo: set
+ nnmaildir-get-new-mail, not nnmaildir-new-mail. Don't call
+ nnmail-get-new-mail for 'find-new-groups.
+
+2002-04-21 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-update-info,
+ nnmaildir-request-group, nnmaildir-retrieve-groups): remove
+ unnecessary calls to nnmaildir-request-scan.
+
+2002-04-20 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-msg.el:
+ * gnus-msg.el (gnus-message-replysign): New.
+ * gnus-msg.el (gnus-message-replyencrypt): New.
+ * gnus-msg.el (gnus-message-replysignencrypted): New.
+ * gnus-msg.el (gnus-summary-reply): Use the three new variables
+ (above) to automatically encrypt/sign to encrypted/signed
+ messages.
+ * message.el:
+ * message.el (message-mode-map): Add keybinding for
+ `message-to-list-only'
+ * message.el (message-mode): Add description for
+ `message-to-list-only'
+ * message.el (message-to-list-only): New.
+ * message.el (message-make-mft): Changed to use the cl loop macro,
+ and added optional flag to return only the matched list. (for use
+ in new message-to-list-only function)
+
+2002-04-20 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-msg.el:
+ * gnus-msg.el (gnus-message-replysign):
+ * gnus-msg.el (gnus-replysign): New.
+ * gnus-msg.el (gnus-replyencrypt): New.
+ * gnus-msg.el (gnus-replysignencrypted): New.
+ * gnus-msg.el (gnus-summary-reply):
+ * message.el:
+ * message.el (message-mode-map):
+ * message.el (message-mode):
+ * message.el (message-to-list-only): New.
+ * message.el (message-make-mft):
+
+2002-04-19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-configure-windows-hook): Fix typo.
+
+2002-04-18 Josh Huber <huber@alum.wpi.edu>
+
+ * message.el (message-gen-unsubscribed-mft): accept a prefix
+ argument so CC can be included with C-u C-c C-f C-a
+
+2002-04-17 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Ted Zlatanov <teodor.zlatanov@divine.com>.
+
+ * spam.el (spam-whitelist, spam-blacklist, spam-enter-whitelist):
+ Improve docstring.
+ (spam-enter-blacklist): New command.
+
+ * gnus-sum.el (gnus-spam-mark): New mark.
+ (gnus-auto-expirable-marks): Add gnus-spam-mark.
+ (gnus-summary-make-tool-bar): Correct conditional.
+ (gnus-summary-limit-to-unread): Add gnus-spam-mark.
+ (gnus-summary-mark-as-spam): New command.
+
+2002-04-13 Josh Huber <huber@alum.wpi.edu>
+
+ * mml-sec.el (mml-secure-message): changed to support arbritrary
+ modes.
+ * mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)):
+ changed to support "signencrypt" mode.
+ * mml.el (mml-parse-1): changed to support different secure modes
+ more easily. (for signencrypt)
+
+2002-04-11 Stefan Monnier <monnier@cs.yale.edu>
+
+ * gnus-sum.el (gnus-update-summary-mark-positions)
+ (gnus-summary-toggle-header):
+ * gnus-uu.el (gnus-uu-binhex-article, gnus-uu-reginize-string)
+ (gnus-uu-expand-numbers, gnus-uu-post-make-mime)
+ (gnus-uu-post-encoded):
+ * nnfolder.el (nnfolder-possibly-change-group):
+ * nnimap.el (nnimap-retrieve-headers):
+ * nnmbox.el (nnmbox-create-mbox): Don't assume point-min == 1.
+
+2002-04-08 Stefan Monnier <monnier@cs.yale.edu>
+
+ * nnml.el (nnml-save-nov, nnml-generate-nov-file):
+ * pop3.el (pop3-md5): Don't hardcode point-min == 1.
+
+2002-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-srvr.el (gnus-server-set-info): Clear
+ `gnus-server-method-cache' when `gnus-server-alist' is changed.
+ From Daiki Ueno <ueno@unixuser.org>.
+
+2002-04-11 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Force
+ viewing of security buttons. Thanks to Nicolas Kowalski
+ <Nicolas.Kowalski@imag.fr>.
+
+ * smime.el (smime-CA-directory): Fix doc. Thanks to Arne
+ J,Ax(Brgensen <arne+usenet@daimi.au.dk>.
+ (smime-sign-buffer): Work in XEmacs. Thanks to Nicolas Kowalski
+ <Nicolas.Kowalski@imag.fr>.
+ (smime-decrypt-buffer): Ditto.
+
+2002-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-prepare): Place point on the emtpy
+ header line.
+
+2002-04-11 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-refer-article-method): Change `dejanews' to `google'.
+
+2002-04-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-delete-marked-with): Fix typo.
+
+2002-04-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-text-html-render-with-w3): Don't ignore
+ errors when debug.
+
+2002-04-07 Josh Huber <huber@alum.wpi.edu>
+
+ * message.el (message-make-mft): Changed MFT code from using
+ message-recipients (which included Bcc) to use only the To and CC
+ headers.
+
+2002-04-05 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-art.el (gnus-treat-from-picon): Add to gnus-picon group and
+ add link.
+ (gnus-treat-mail-picon): Ditto.
+ (gnus-treat-newsgroups-picon): Ditto.
+ (gnus-picon-databases): Fix custom type.
+ (gnus-picon-databases): Add link.
+ (gnus-article-x-face-command): Add to gnus-picon group.
+
+2002-04-01 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-buffer-naming-style): Remove.
+
+2002-04-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-make-tool-bar): Load tool-bar first.
+
+ * message.el (message-tool-bar-map): Ditto.
+
+ * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
+
+2002-04-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnwarchive.el (nnwarchive-mail-archive-article): Fix typo.
+
+2002-04-01 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el: fixed some buggy invocations of nnmaildir--pgname.
+
+2002-03-31 Andrew Cohen <cohen@andy.bu.edu>
+ Trivial patch.
+
+ * dns.el: open-network-stream under XEmacs does udp.
+
+2002-03-31 Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
+
+ * spam.el (spam-enter-whitelist): New function.
+ (spam-parse-whitelist): Ditto.
+ (spam-refresh-list-cache): Ditto.
+ (spam-address-whitelisted-p): New function.
+
+ * dns.el (query-dns): Use TCP when make-network-process isn't
+ available.
+ (dns-servers): New variable.
+ (dns-parse-resolv-conf): New function.
+ (query-dns): Use it.
+
+ * spam.el: New file.
+
+ * dns.el (query-dns): Test.
+
+2002-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * lpath.el (featurep): Bind make-network-process.
+
+2002-03-31 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el: Use defstruct. Use a single copy of
+ nnmail-extra-headers to save memory. Store server's group name
+ prefix instead of each group's prefixed name.
+ * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase
+ nntp-server-buffer.
+
+2002-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dns.el: New file.
+
+2002-03-28 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-dummy-line-format):
+ * gnus.el (gnus-summary-line-format): Fixing links to Info.
+ Trivial change from Bj,Av(Brn Torkelsson <torkel@pdc.kth.se>.
+
+2002-03-29 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-summary-move-article)
+ (gnus-summary-copy-article): Mention `gnus-move-split-methods' in
+ the doc string.
+
+2002-03-28 Simon Josefsson <jas@extundo.com>
+
+ * mml-sec.el (mml-secure-message): Search after
+ mail-header-separator from top of message.
+
+2002-03-28 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el: Cosmetic changes.
+ (nnmaildir--with-nntp-buffer, nnmaildir--with-work-buffer,
+ nnmaildir--with-nov-buffer, nnmaildir--with-move-buffer,
+ nnmaildir--group-ls): New macros/functions. Use them.
+ (nnmaildir--unlink): Evalutate argument only once.
+
+2002-03-27 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-highlight): Use `eq' when comparing
+ symbols.
+ (gnus-summary-highlight-line): Use `gnus-point-at-bol' and
+ `gnus-point-at-eol'.
+
+2002-03-27 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--subdir, nnmaildir--nov-dir,
+ nnmaildir--marks-dir): New macros. Use them.
+ Use inhibit-quit for atomicity instead of in-memory journaling.
+ (nnmaildir--edit-prep): New function.
+ (Local Variables): Use it.
+
+2002-03-26 Pavel@Janik.cz (Pavel Jan,Am(Bk)
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo.
+
+2002-03-25 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-mode): Fix doc.
+
+2002-03-25 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-subject-re-regexp): Skip Re[42]: junk. From
+ Matthieu Moy <Matthieu.Moy@imag.fr>.
+
+2002-03-24 Jesper Harder <harder@ifa.au.dk>
+
+ * mml-sec.el (mml-unsecure-message): Add docstring.
+
+2002-03-23 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-large-newsgroup): Fix doc, allow non-numeric
+ value.
+ Trivial change from andre@slamdunknetworks.com
+
+2002-03-22 Josh Huber <huber@alum.wpi.edu>
+
+ * mml.el (mml-mode-map): Added a keybinding for
+ `mml-unsecure-message'. Also, added a menu entry for said
+ function in the Attachments menu.
+
+2002-03-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * canlock.el (canlock-version): Remove.
+ (canlock-sha1-with-openssl): Don't use `canlock-string-as-unibyte'
+ here; simplify \x insertions.
+ (canlock-sha1): New function, always return a unibyte string.
+ (canlock-make-cancel-key): Use `canlock-sha1'; simplify truncation
+ of a password.
+ (canlock-insert-header): Use `canlock-sha1'.
+ (canlock-verify): Ditto.
+
+2002-03-21 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-fix-before-sending): Add an option that
+ ignores illegible text.
+ Trivial change from Mark Milhollan <mlm@attglobal.net>
+
+ * message.el (message-font-lock-keywords): Support multi-line MML
+ tags.
+
+ * gnus-sum.el (gnus-print-buffer): Remove gnus-decoration.
+ Trivial change from lorentey@elte.hu (L,Bu(Brentey K,Aa(Broly)
+
+2002-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Use intern'ed function
+ symbols for "View as different encoding" submenu.
+
+2002-03-19 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add "View as different
+ encoding" submenu.
+
+2002-03-19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-process-prefix): Make sure there is a mark.
+
+2002-03-19 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-sum-thread-tree-root)
+ (gnus-sum-thread-tree-single-indent)
+ (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent)
+ (gnus-sum-thread-tree-leaf-with-other)
+ (gnus-sum-thread-tree-single-leaf): Make customizable.
+
+2002-03-16 Simon Josefsson <jas@extundo.com>
+
+ * gnus-util.el (gnus-extract-address-components): Don't break on
+ names such as James "Kibo" Parry. From Francis Litterio
+ <franl@world.std.com>.
+
+2002-03-13 Simon Josefsson <jas@extundo.com>
+
+ * pop3.el (pop3-open-server): Revert multibyte change. From
+ Pavel@Janik.cz (Pavel Jan,Am(Bk).
+
+ * message.el (message-send-mail-with-qmail): Make it work. From
+ Pavel@Janik.cz (Pavel Jan,Am(Bk).
+
+2002-03-13 Josh Huber <huber@alum.wpi.edu>
+
+ * message.el (message-make-mft): Set case-fold-search while
+ generating the MFT. Also, a little cleanup in the MFT code.
+
+2002-03-12 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-qmail-inject-args): May be function.
+ (message-send-mail-with-qmail): Call function if m-q-i-a is
+ function. From fn@hungry.org (Faried Nawaz).
+
+2002-03-12 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-abbrevs-loaded): Remove.
+ (mailabbrev): Require it.
+
+ * nnslashdot.el (nnslashdot-request-article): Remove IFRAME.
+
+2002-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * pop3.el (pop3-open-server): Set process buffer unibyte.
+
+2002-03-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-subscribe-to-mailing-list): New function.
+
+2002-03-10 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-request-article): Remove javascript
+ too.
+
+2002-03-09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-save-parts-default-mime): Remove
+ duplication.
+ (gnus-summary-save-parts-type-history): Ditto.
+ (gnus-summary-save-parts-last-directory): Ditto.
+ Trivial change from andre@slamdunknetworks.com
+
+2002-03-09 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-start.el (gnus-auto-subscribed-groups): Include nnmaildir.
+
+2002-03-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-request-article): Use "<!-- no ad 6
+ -->" as the end of the first article.
+
+ * gnus-msg.el (gnus-summary-resend-message-edit): New function.
+ From Matthieu Moy <Matthieu.Moy@imag.fr>
+
+ * message.el (message-add-action): Use add-to-list.
+ (message-delete-action): New function.
+
+ * nndoc.el (nndoc-mail-in-mail-type-p): Break a long regexp into
+ pieces.
+
+2002-03-05 Paul Jarc <prj@po.cwru.edu>
+
+ * nnnil.el: New file.
+ * gnus.el (gnus-valid-select-methods): Include nnnil.
+
+2002-03-05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-syntax-checks): Because canlock is
+ supported, we disable sender syntax check.
+ (message-shoot-gnksa-feet): Add cancel-messages option doc.
+
+ * gnus-draft.el (gnus-draft-send): If interactive, use its default
+ value of message-syntax-checks.
+
+ * qp.el (quoted-printable-decode-region): Doc addition.
+ From: Eli Zaretskii <eliz@is.elta.co.il>
+
+ * mail-source.el (make-source-make-complex-temp-name): Use
+ make-temp-file.
+
+ * mm-util.el (mm-make-temp-file): New function.
+ * nneething.el (nneething-file-name): Use it.
+ * mml-smime.el (mml-smime-encrypt): Ditto.
+ * mm-view.el (mm-inline-wash-with-file): Ditto.
+ * mm-decode.el (mm-display-external, mm-create-image-xemacs): Ditto.
+ * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view)
+ (gnus-uu-digest-mail-forward, gnus-uu-initialize): Ditto.
+ * gnus-start.el (gnus-slave-save-newsrc): Ditto.
+ * gnus-fun.el (gnus-convert-image-to-gray-x-face): Ditto.
+ * gnus-art.el (gnus-mime-print-part): Ditto.
+
+2002-03-04 Paul Jarc <prj@po.cwru.edu>
+
+ * message.el (nnmaildir-article-number-to-base-name): New
+ function.
+ (nnmaildir-base-name-to-article-number): New function.
+
+2002-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * smime.el (smime-make-temp-file): Don't quote
+ `temporary-file-directory'.
+
+2002-03-04 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-sign-region): Rename argument keyfiles to
+ keyfile. You only sign something with one key.
+ (smime-sign-buffer): Better completing-read prompt.
+ (smime-decrypt-buffer): Ditto.
+
+ * smime.el (smime-make-temp-file): Make it work under XEmacs.
+
+ * mm-view.el (mm-view-pkcs7-decrypt): Better prompt for
+ completing-read.
+ (mm-view-pkcs7-decrypt): CRLF->LF.
+
+2002-03-04 Paul Jarc <prj@po.cwru.edu>
+
+ * message.el (message-hierarchical-addresses): New variable.
+ (message-get-reply-headers): Use it.
+ From Ted Zlatanov <teodor.zlatanov@divine.com>
+
+2002-03-03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-mode): If buffer-file-name, don't set auto
+ save file name.
+ Trivial change from Geoff Greene <ggreene@wpi.edu>
+
+2002-03-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-multiple-choice): Use message. XEmacs only
+ takes one argument in read-char.
+
+ * message.el (message-fix-before-sending): Forward a char.
+ Check mmu-multibyte-p, add control-1.
+
+2002-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-read-init-file): Ditto.
+
+ * gnus-agent.el (gnus-agent-fetch-session): Ditto.
+
+ * dgnushack.el (dgnushack-make-load): Ditto.
+
+ * mail-source.el (mail-source-fetch): Extract the right error
+ code.
+
+ * message.el (message-fix-before-sending): Check illegible text.
+
+ * gnus-util.el (gnus-multiple-choice): New function.
+
+ * gnus-kill.el (gnus-score-insert-help): Removed, because it is
+ also defined in gnus-score.el.
+
+2002-03-01 Paul Jarc <prj@po.cwru.edu>
+
+ * message.el (message-get-reply-headers): downcase email addresses
+ for comaparisons for duplicate removal.
+
+2002-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-view-pkcs7-verify): New function. A bogus
+ implementation of PKCS#7, which just allows users read the
+ message.
+ (mm-view-pkcs7): Use it.
+
+2002-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (large-newsgroup-initial): New parameter.
+
+ * gnus-sum.el (gnus-articles-to-read): Use large-newsgroup-initial.
+ (gnus-summary-insert-old-articles): Ditto.
+
+2002-02-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-articles-to-read): `gnus-large-newsgroup' is
+ used as the default answer of the question, "How many articles?".
+ From TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nnagent.el (nnagent-retrieve-headers): Remove articles with
+ small numbers.
+
+2002-02-24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * deuglify.el: Fix comments.
+
+2002-02-23 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * html2text.el (html2text-clean-anchor): If there is no HREF,
+ insert nothing.
+
+ * mml.el (mml-generate-mime-1): Add cdr.
+ From: andre@slamdunknetworks.com
+
+ * mm-view.el (mm-text-html-renderer-alist): Add html2text.
+ (mm-text-html-washer-alist): Ditto.
+
+ * mm-decode.el (mm-text-html-renderer): Add html2text.
+
+ * html2text.el: Face lift.
+
+ * html2text.el: New file from Joakim Hove <hove@phys.ntnu.no>.
+
+2002-02-22 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el: Add gnus-article-outlook-deuglify-article.
+
+ * deuglify.el: Change copy right. Add autoload. Add coding-system.
+
+ * deuglify.el: New file. The original file name is
+ gnus-outlook-deuglify.el from Raymond Scholz <rscholz@zonix.de>.
+
+ * mm-decode.el (mm-display-external): Use
+ mm-file-name-rewrite-functions. From <andre@slamdunknetworks.com>
+
+2002-02-22 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-list): Report the highest
+ article number, not the total number of articles.
+
+2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el: Move uu key map here.
+ (gnus-summary-make-menu-bar): Add gnus-summary-save-parts.
+
+2002-02-21 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-expire-articles): Use
+ nnmail-expiry-wait* if expire-age parameter is not set.
+
+2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-sort-groups-by-real-name): New
+ function.
+ (gnus-group-sort-selected-groups-by-real-name): New function.
+ (gnus-group-make-menu-bar): Add sort by real name.
+
+ * gnus-sum.el (gnus-dependencies-add-header): If replaced, don't
+ rebuild.
+ (gnus-summary-edit-article-done): Gnus-get-newsgroup-headers takes
+ nil as dependencies as well.
+
+2002-02-20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndoc.el (nndoc-dissect-mime-parts-sub): Fix MIME-Version header
+ for mime-parts.
+
+ * gnus-art.el (gnus-article-edit-done): Widen the buffer.
+
+ * gnus-group.el (gnus-group-name-decode): Don't test
+ multibyte-string, because it breaks XEmacs.
+ From: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * message.el (message-send-mail): Be talkative.
+
+ * mm-decode.el (mm-inlined-types): Add application/x-emacs-lisp.
+ (mm-automatic-display): Ditto.
+
+ * mailcap.el (mailcap-mime-data): Ditto.
+ From: Reiner Steib <4uce.02.r.steib@gmx.net>
+
+2002-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * many files: Remove trailing whitespaces, replace spc+tab with
+ tab, replace leading whitespaces with tabs.
+
+2002-02-19 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-sum.el (gnus-summary-toggle-header): Fix handling of
+ articles with no body and no blank line after the header.
+
+2002-02-19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-dissect-multipart): Consider the case of empty
+ parts.
+
+ * ietf-drums.el (ietf-drums-syntax-table): Modify syntax of
+ non-ascii chars.
+
+ * rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
+
+ * gnus-art.el (gnus-article-wash-html-with-w3): Remove
+ w3-delay-image-loads.
+ * mm-view.el (mm-inline-text-html-render-with-w3): Ditto.
+ (mm-w3-prepare-buffer): Ditto.
+
+ * mail-source.el (mail-source-fetch-directory): Run scripts.
+
+2002-02-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-respond-to-confirmation): Do the right thing
+ for Majordomo confirmations.
+
+2002-02-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-respond-to-confirmation): New command.
+
+2002-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Clean up.
+
+2002-02-18 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-util.el (gnus-parent-id): Ignore trailing whitespace in the
+ References header field. From Mark Thomas <mthomas@cmu.edu>.
+
+2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-render-with-file): With unibyte buffer.
+ (mm-inline-render-with-stdin): Ditto.
+ (mm-inline-render-with-function): Ditto.
+ (mm-inline-wash-with-file): Bind coding-system-for-write.
+ (mm-inline-wash-with-stdin): Ditto.
+
+2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ Suggested by Felix Natter <fnatter@gmx.net>
+
+ * gnus-art.el (gnus-mime-view-part-externally): Rename from
+ gnus-mime-externalize-view.
+ (gnus-mime-view-part-internally): Rename from
+ gnus-mime-internalize-view.
+ (gnus-article-view-part-externally): Rename from
+ gnus-article-externalize-part.
+ (gnus-mime-action-alist): Change correspondingly.
+ (gnus-mime-button-commands): Ditto.
+ (gnus-mime-action-alist): Remove duplication.
+
+ * gnus-sum.el (gnus-summary-mime-map): Change correspondingly.
+
+2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-dissect-buffer): Add loose-mime parameter.
+
+ * gnus-art.el (gnus-display-mime): Use it.
+
+ * mm-partial.el (mm-partial-find-parts): Use it.
+
+ * gnus-sum.el (gnus-article-loose-mime): Rename from
+ gnus-article-no-strict-mime.
+ (gnus-summary-save-parts): Use it.
+
+2002-02-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Remove unused
+ local variable.
+
+ * gnus-art.el (article-display-x-face): Don't sort multiple
+ X-Faces.
+
+2002-02-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
+ up. Suggested by Yuuichi Teranishi <teranisi@gohome.org>.
+
+ * gnus-art.el (article-display-x-face): Sort gray X-Faces.
+
+2002-02-17 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ Some ideas is inspired by code from Hrvoje Niksic
+ <hniksic@arsdigita.com>
+
+ * gnus-art.el (gnus-article-wash-function): Set the default to
+ nil, so that we use mm-text-html-renderer instead.
+ (article-wash-html): Use mm-text-html-renderer.
+
+ * mm-decode.el (mm-inline-media-tests): Use mm-inline-text-*.
+ (mm-text-html-renderer): New variable.
+ (mm-inline-text-html-renderer): Set the default to nil, so that we
+ use mm-text-html-renderer instead.
+
+ * mm-view.el (mm-inline-text-html): New function.
+ (mm-text-html-renderer-alist): New variable.
+ (mm-inline-text-vcard): New function.
+ (mm-inline-text): Split.
+ (mm-links-remove-leading-blank): New function.
+ (mm-inline-render-with-file): New function.
+ (mm-inline-render-with-stdin): New function.
+ (mm-inline-render-with-function): New function.
+ (mm-text-html-washer-alist): New variable.
+ (mm-inline-wash-with-file): New function.
+ (mm-inline-wash-with-stdin): New function.
+
+2002-02-17 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message-utils.el: Fix installation doc.
+ From: Reiner Steib <4uce.02.r.steib@gmx.net>
+
+2002-02-16 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-discouraged-post-methods): New variable.
+ (gnus-post-method): Use it.
+ (gnus-summary-cancel-article): Find the correct post-method.
+
+ * gnus-soup.el (gnus-soup-send-packet): Via ... using ...
+ * message.el (message-send-news): Ditto.
+ Suggested by Lloyd Zusman <ljz@asfast.com> and IPmonger
+ <ipmonger@delamancha.org>
+
+ * gnus.el (gnus-select-method): Fix doc.
+ (gnus-server-string): Use 'using nntp'.
+
+ * gnus-agent.el (gnus-slave-unplugged): New command.
+ From: Felix Natter <fnatter@gmx.net>
+
+2002-02-15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-edit-done): Kill-all-local-variables.
+ Call edit-done-function first, then change the window
+ configuration.
+ (gnus-article-edit-mode-map): Add message key bindings. Add menu.
+ (gnus-article-edit-mode): mml-mode.
+
+ * gnus-util.el (gnus-byte-compile): Work around a bug in XEmacs
+ 21.4. Suggested by Russ Allbery <rra@stanford.edu> .
+
+ * message-utils.el: Adopt the file.
+
+ * message-utils.el: New file.
+ From Holger Schauer <Holger.Schauer@gmx.de>
+
+2002-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-move-article): Select-article only
+ when gnus-move-split-methods is non-nil. And we don't render or
+ mark the article.
+
+ * gnus-fun.el (gnus-shell-command-to-string): New function.
+ (gnus-shell-command-on-region): New function.
+ (gnus-random-x-face): Use them.
+ (gnus-x-face-from-file): Ditto.
+ (gnus-convert-image-to-gray-x-face): Ditto.
+ (gnus-convert-gray-x-face-to-xpm): Ditto.
+ (gnus-convert-image-to-x-face-command): Don't use 2>/dev/null.
+
+2002-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-treat-display-xface): Don't use
+ `shell-command-to-string' when compiling.
+ (gnus-treat-display-grey-xface): Ditto.
+
+2002-02-13 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--article-count): If the group is
+ completely empty, report minimum article number as 1 instead of 0.
+
+2002-02-13 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-get-predicate): Use nconc.
+
+ * gnus-sum.el (gnus-summary-display-make-predicate): Use
+ gnus-summary-display-cache as cache.
+
+ * nndoc.el (nndoc-type-alist): Add mail-in-mail type.
+ (nndoc-mail-in-mail-type-p): New function.
+ (nndoc-mail-in-mail-article-begin): New function.
+
+2002-02-12 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mailcap.el (mailcap-mime-data): Use enriched-decode.
+
+ * gnus-cite.el (gnus-article-fill-cited-article): Bind
+ use-hard-newlines to nil.
+
+ * gnus-xmas.el (gnus-xmas-image-type-available-p): Assume that
+ image is not available if window-system is not available.
+
+ * gnus-sum.el (gnus-summary-display-make-predicate): Add unread.
+
+2002-02-11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-article-unpropagated-mark-lists): Don't propagate
+ bookmark, because update-mark doesn't handle it correctly.
+
+2002-02-09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-soup.el (gnus-soup-send-packet): Send news and mail
+ directly instead of calling message-send-mail.
+
+ * gnus-start.el (gnus-read-descriptions-file): Use
+ gnus-default-charset.
+
+ * mm-util.el (mm-guess-mime-charset): New function.
+
+ * gnus.el (gnus-default-charset): Use it.
+ (gnus-group-charset-alist): Remove .*, Let gnus-default-charset be
+ the default.
+
+2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-treat-display-grey-xface): New variable.
+ (article-display-x-face): Use it. Disable grey xface, if
+ uncompface is not found.
+
+ * message.el (message-mode): Don't enable multibyte on an indirect
+ buffer.
+
+ * nnrss.el (nnrss-content-function): New variable.
+ (nnrss-request-article): Use it.
+
+2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: Add article-unsplit-urls.
+ * gnus-sum.el: Ditto.
+ * gnus-art.el (gnus-treat-strip-cr): New variable.
+ (gnus-treatment-function-alist): Use it.
+ (article-unsplit-urls): New function.
+ (gnus-article-make-menu-bar): Use it.
+ From: Michael Cook <michael.cook@cisco.com>
+
+2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-braid-nov): Find the first article to
+ copy.
+
+2002-02-07 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus-util.el (gnus-split-references): Allow (broken) Message-IDs
+ with internal whitespace.
+ (gnus-parent-id): Ditto.
+
+2002-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-treat-body-boundary): Add
+ gnus-decoration property.
+ * gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration.
+
+ * message.el (message-mode): Set local-abbrev-table.
+ From Matt Armstrong <matt@lickey.com>.
+
+ * gnus-art.el (gnus-article-treat-unfold-headers): Don't remove
+ too many spaces.
+
+ * rfc2047.el (rfc2047-unfold-region): Ditto.
+ (rfc2047-decode-region): Don't unfold. Let
+ gnus-article-treat-unfold-headers do it.
+
+ * gnus-sum.el (gnus-dependencies-add-header): Fix typo.
+ From: Jesper Harder <harder@ifa.au.dk>
+
+2002-02-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-posting-styles): Add x-face-file.
+ (gnus-configure-posting-styles): Use it.
+ (gnus-configure-posting-styles): Remove trailing newspaces.
+
+2002-02-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-articles-to-read): Fetch all if the predicate
+ is non-nil.
+
+ * mm-util.el (mm-use-find-coding-systems-region): Add doc.
+
+ * gnus.el (gnus-server-to-method): Switch position with
+ gnus-server-get-method.
+ (gnus-agent): Add doc.
+
+ * gnus-sum.el (gnus-article-no-strict-mime): New variable.
+ (gnus-summary-save-parts): Use it.
+
+ * gnus-art.el (gnus-display-mime): Use it.
+ * mm-partial.el (mm-partial-find-parts): Use it.
+
+ * nnweb.el (nnweb-google-parse-1): Use a correct format of date.
+
+ * gnus-agent.el (gnus-agent-summary-make-menu-bar): Fix typo.
+ From Stefan Reich,Av(Br <xsteve@riic.at>.
+
+ * nnagent.el (nnagent-request-expire-articles): Don't delete
+ files.
+
+2002-02-05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-gen-unsubscribed-mft): New function.
+ From Sriram Karra <karra@cs.utah.edu>.
+
+ * gnus.el (gnus-article-unpropagated-mark-lists): Backslash the
+ open parenthesis.
+
+ * mm-view.el (mm-w3-prepare-buffer): Bind url-gateway-unplugged.
+ (mm-inline-text-html-render-with-w3): Ditto.
+ * gnus-art.el (gnus-article-wash-html-with-w3): Ditto.
+ Suggested by Dave Love <d.love@dl.ac.uk>.
+
+ * mm-url.el (mm-url-load-url): Require w3-vars for old versions.
+
+ * nntp.el (nntp-send-command-and-decode): Check PROCESS.
+ * nntp.el (nntp-send-command): Ditto.
+ * nntp.el (nntp-send-command-nodelete): Ditto.
+
+2002-02-04 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-url.el (mm-url-load-url): New function.
+ (mm-url-insert-file-contents): Use it.
+
+ * gnus-msg.el (gnus-summary-mail-forward): Use gnus-article-charset.
+
+ * message.el (message-forward-make-body): Correctly copy
+ forward-buffer.
+
+ * rfc2047.el (rfc2047-decode-region): Don't decode us-ascii characters.
+
+2002-02-04 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-article-followup-with-original): Mark with
+ force, prevent errors when following up from article buffer.
+ (gnus-article-reply-with-original): Ditto.
+
+ * binhex.el (binhex-decoder-switches): Fix doc. From
+ Pavel@Janik.cz (Pavel Jan,Am(Bk).
+
+2002-02-04 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-treatment-function-alist): Move hide-citation,
+ highlight-citation after emphasize.
+
+2002-02-04 Simon Josefsson <jas@extundo.com>
+
+ * nnfolder.el (nnfolder-open-marks):
+
+ * nnml.el (nnml-open-marks): Message when done. From David
+ Edmondson <dme@sun.com>.
+
+2002-02-03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * imap.el (imap-anonymous-auth): Fix typo.
+ From: Steinar Bang <sb@dod.no>
+
+ * gnus-cache.el (gnus-cache-braid-nov): Use set-buffer instead of
+ save-excursion.
+ (gnus-cache-braid-heads): Ditto.
+
+ * gnus-agent.el (gnus-agent-copy-nov-line): Move to the correct
+ line, because there are extra articles in the overview buffer.
+
+ * nntp.el (nntp-retrieve-groups): Check whether BUF is live.
+
+ * message.el (message-forward-rmail-make-body): Directly use
+ rmail-msg-restore-non-pruned-header to avoid calling
+ vertical-motion.
+
+2002-02-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-cache.el (gnus-summary-insert-cached-articles):
+ (gnus-summary-limit-include-cached): gnus-newsgroup-cached is sorted.
+
+ * gnus-group.el (gnus-group-mark-article-read): Nreverse
+ gnus-newsgroups-unselected.
+
+ * gnus-agent.el (gnus-summary-set-agent-mark): Use
+ gnus-add-to-sorted-list.
+
+ * gnus-sum.el (gnus-summary-update-info): gnus-newsgroup-unreads
+ gnus-newsgroup-unselected are sorted. Use gnus-sorted-union.
+ (gnus-build-all-threads): Use gnus-add-to-sorted-list.
+ (gnus-update-read-articles): UNREAD is sorted.
+ (gnus-newsgroup-unreads, gnus-newsgroup-unselected)
+ (gnus-newsgroup-marked, gnus-newsgroup-cached)
+ (gnus-newsgroup-expirable, gnus-newsgroup-downloadable)
+ (gnus-newsgroup-dormant): Require sorted.
+
+ * gnus-dired.el (gnus-dired-find-file-mailcap): Correctly handle
+ directories.
+ (gnus-dired-print): New function.
+
+ * gnus-art.el (gnus-mime-print-part): Add argument filename. Call
+ ps-despool.
+
+2002-02-02 Simon Josefsson <jas@extundo.com>
+
+ * gnus-dired.el (turn-on-gnus-dired-mode): Autoload. Make defun.
+
+2002-02-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-1): Call gnus-agentize if gnus-agent is
+ t. This makes gnus-agent customizable without putting
+ gnus-agentize into .gnus.
+
+ * gnus.el (gnus-agent): Make it customizable.
+
+ * gnus-dired.el: New file.
+ From Benjamin Rutt <brutt@bloomington.in.us>
+
+ * gnus-cache.el (gnus-cache-articles-in-group): Remove from active
+ if no article.
+ (gnus-cache-possibly-remove-article): Ditto.
+ (gnus-cache-possibly-enter-article): Use gnus-add-to-sorted-list.
+
+2002-02-01 Simon Josefsson <jas@extundo.com>
+
+ * gnus-int.el (gnus-request-accept-article): Use gnus-get-function.
+
+2002-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-w3m-mode-dont-bind-keys): New variable.
+ (mm-setup-w3m): Don't bind keys listed in the above.
+
+2002-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-inline-text-html-render-with-w3m): Bind
+ `w3m-safe-url-regexp' with nil if `mm-inline-text-html-with-images'
+ is non-nil; bind `w3m-force-redisplay' with nil.
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto.
+
+ * mm-decode.el (mm-inline-text-html-with-images): Supplement docs.
+
+2002-01-31 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't
+ use mail-header-unfold-field.
+
+ * gnus-cache.el (gnus-summary-insert-cached-articles): Use
+ gnus-summary-limit.
+
+ * gnus-range.el (gnus-add-to-sorted-list): New function.
+ * gnus-sum.el (gnus-mark-article-as-read): Use it.
+ (gnus-mark-article-as-unread): Ditto.
+ (gnus-summary-mark-article-as-unread): Ditto.
+ (gnus-build-get-header): Ditto.
+ (gnus-summary-prepare-threads): Ditto.
+ (gnus-summary-insert-pseudos): Ditto.
+ (gnus-articles-to-read): Use gnus-sorted-union and gnus-sorted-nunion.
+ (gnus-summary-insert-new-articles): Use gnus-sorted-nunion.
+ (gnus-summary-insert-old-articles): Ditto.
+
+ * gnus-msg.el (gnus-posting-styles): Add new format of header.
+ (gnus-configure-posting-styles): Support the new format.
+
+ * mail-source.el (mail-source-bind, mail-source-bind-common): Set
+ edebug-form-spec to (sexp body).
+ Suggested by Joe Wells <jbw@izanami.cee.hw.ac.uk>.
+
+ * message.el (message-reply-headers): Add doc.
+
+2002-01-30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-delete-group): Nix the entry in
+ gnus-cache-active-hashtb.
+
+ * gnus-agent.el (gnus-agent-mark-unread-afer-downloaded): New variable.
+ (gnus-agent-summary-fetch-group): Use it.
+
+ * gnus-msg.el (gnus-debug-files): New variable.
+ (gnus-debug-exclude-variables): New variable.
+ (gnus-debug): Use them.
+
+ * gnus-range.el (gnus-range-length): Don't use gnus-uncompress-range.
+
+2002-01-30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-cite-prefix-regexp): Use text-mode-syntax-table.
+ (message-mode-syntax-table): Move back the previous position.
+
+ * nnagent.el (nnagent-retrieve-headers): Use gnus-sorted-difference.
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Use
+ gnus-sorted-difference.
+
+ * nnsoup.el (nnsoup-request-expire-articles): Use
+ gnus-sorted-difference.
+
+ * nnheader.el: Autoload gnus-sorted-difference.
+
+ * nnfolder.el (nnfolder-request-expire-articles): Use
+ gnus-sorted-difference.
+
+ * gnus-cache.el (gnus-cache-retrieve-headers): Use
+ gnus-sorted-difference.
+
+ * gnus-range.el: Autoload cookies.
+ (gnus-sorted-difference): New function.
+ (gnus-sorted-ndifference): New function.
+ (gnus-sorted-nintersection): Rename from
+ gnus-set-sorted-intersection.
+ (gnus-sorted-nunion): Rename from gnus-set-sorted-union.
+ (gnus-list-range-difference): Rename from
+ gnus-inverse-list-range-intersection.
+ (gnus-inverse-list-range-intersection): Use defalias.
+
+ * gnus-sum.el (gnus-select-newsgroup): Use gnus-sorted-difference,
+ gnus-sorted-ndifference, and gnus-sorted-nintersection.
+ (gnus-articles-to-read): Use gnus-sorted-difference.
+ (gnus-summary-limit-mark-excluded-as-read): Use
+ gnus-sorted-intersection and gnus-sorted-ndifference.
+ (gnus-list-of-read-articles): Use gnus-list-range-difference.
+ (gnus-summary-insert-articles): Use gnus-sorted-difference.
+
+ * gnus-sum.el (gnus-summary-update-info): Use gnus-sorted-union.
+
+2002-01-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Add keymap
+ property to the buffer for using emacs-w3m command keys.
+
+ * mm-decode.el (mm-inline-text-html-with-w3m-keymap): New user
+ option.
+
+ * mm-view.el (mm-w3m-mode-map): New variable.
+ (mm-w3m-mode-command-alist): New variable.
+ (mm-w3m-minor-mode): Removed.
+ (mm-setup-w3m): Setup `mm-w3m-mode-map'; don't add minor mode.
+ (mm-inline-text-html-render-with-w3m): Add keymap property to the
+ buffer for using emacs-w3m command keys.
+
+2002-01-29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-mode-syntax-table): Move forward.
+ (message-cite-prefix-regexp): Auto detect non word constituents.
+ (message-cite-prefix-regexp): Don't use with-syntax-table.
+
+ * gnus-sum.el (gnus-summary-update-info): Use
+ gnus-list-range-intersection.
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Use
+ gnus-list-range-intersection.
+
+ * gnus-range.el (gnus-range-normalize): Use correct predicate.
+ (gnus-list-range-intersection): Use it.
+ (gnus-inverse-list-range-intersection): Ditto.
+ (gnus-sorted-intersection): Add doc.
+ (gnus-set-sorted-intersection): Add doc.
+ (gnus-sorted-union): New function.
+ (gnus-set-sorted-union): New function.
+
+ * gnus-range.el (gnus-list-range-intersection): Correct the logic.
+ (gnus-inverse-list-range-intersection): Ditto.
+
+2002-01-29 Karl Kleinpaste <karl@charcoal.com>
+
+ * mm-uu.el (mm-uu-type-alist): Add optional leading `0'.
+
+ * gnus-uu.el (gnus-uu-shar-name-marker): Add optional leading `0'
+ and permit `:' and `\' in order to handle full Windows pathnames.
+ (gnus-uu-begin-string): Add optional leading `0'. Leading `0' is
+ technically not correct per standard, but seems to have common use.
+
+2002-01-29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-uu.el (gnus-uu-expand-numbers): Ignore errors when
+ replacing numbers.
+
+2002-01-28 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-followup-with-original): Use (mark).
+
+ * gnus-score.el (gnus-score-insert-help): Move to (point-min).
+ Don't split when the window is small, e.g. when a small *BBDB*
+ window is the lowest one.
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Use
+ nnheader-find-nov-line to speed up. Use nreverse, because it is
+ sorted. Use nnheader-insert-nov-file.
+
+2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-inline-text-html-with-images): New user option.
+
+ * mm-view.el (mm-inline-text-html-render-with-w3m): Bind the value
+ of `w3m-display-inline-images' with the value of
+ `mm-inline-text-html-with-images'.
+ From: TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto.
+
+2002-01-27 Richard M. Stallman <rms@gnu.org>
+
+ * time-date.el: Add autoload cookies. Many doc fixes.
+ (time-add): New function.
+ (time-subtract): Renamed from subtract-time.
+ (subtract-time): New alias for time-subtract.
+
+2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Replace w3m to
+ emacs-w3m in doc-string.
+
+ * lpath.el: Bind `w3m-cid-retrieve-function-alist' and
+ `w3m-current-buffer'.
+
+2002-01-27 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Handle cid: URLs.
+
+ * mm-view.el (mm-setup-w3m): Add `mm-w3m-cid-retrieve' to
+ `w3m-cid-retrieve-function-alist' for `gnus-article-mode'.
+ (mm-w3m-cid-retrieve): New function.
+ (mm-inline-text-html-render-with-w3m): Handle cid: URLs.
+
+2002-01-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-fetch-articles): Don't save empty articles.
+
+2002-01-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el (gnus-cache-file-contents): Don't use equalp.
+
+2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheader.el (nnheader-insert-nov-file): Increased cutoff to
+ 32K.
+
+ * gnus-sum.el (gnus-summary-expire-articles): Clean up.
+
+ * nnmail.el (nnmail-article-group): Decode headers before running
+ split rules over them.
+ (nnmail-mail-splitting-charset): New variable.
+
+ * smiley.el: Replaced with smiley-ems.el.
+
+2002-01-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-url.el (mm-url-predefined-programs): Add w3m.
+ (mm-url-program): Ditto.
+
+2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnml.el (nnml-use-compressed-files): New variable.
+ (nnml-filenames-are-evil): Removed.
+ (nnml-current-group-article-to-file-alist): Don't use.
+ (nnml-update-file-alist): Inhibit.
+ (nnml-article-to-file): Use new var.
+
+2002-01-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-parse-without-error): Add edebug-form-spec.
+
+ * nnagent.el (nnagent-retrieve-headers): loop until eobp.
+
+2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-load-alist): Use new caching
+ function.
+
+ * gnus-util.el (gnus-cache-file-contents): New function.
+
+ * gnus-agent.el (gnus-agent-file-loading-cache): New variable.
+ (gnus-agent-load-alist): Use it.
+
+ * nnagent.el (nnagent-retrieve-headers): Use optimized function.
+
+ * nnheader.el (nnheader-insert-nov-file): New function.
+
+ * gnus-util.el (gnus-parse-without-error): Correct the loop.
+
+ * gnus-sum.el (gnus-dependencies-add-header): Use in-reply-to if
+ there are no references.
+ (gnus-extract-message-id-from-in-reply-to): New function.
+ (gnus-nov-parse-line): Use in-reply-to if there are no
+ references.
+
+2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnagent.el (nnagent-retrieve-headers): Use new macro.
+
+ * gnus-util.el (gnus-parse-without-error): New macro.
+
+2002-01-25 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-wash-html-with-w3m): Call w3m-region.
+ (gnus-article-wash-function): use locate-library to decide which
+ to use.
+
+2002-01-25 Simon Josefsson <jas@extundo.com>
+
+ * pop3.el (pop3-munge-message-separator): Work if no date.
+ Trivial patch from Marius Vollmer <mvo@zagadka.ping.de>.
+
+2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-save-alist): Fix.
+
+ * nnagent.el (nnagent-retrieve-headers): Must have cut too much by
+ mistake. Reinstated lost code.
+
+2002-01-25 Josh Huber <huber@alum.wpi.edu>
+
+ * mml2015.el (mml2015-mailcrypt-decrypt): Display a signature if
+ one exists in the case of an encrypted message with an internal
+ signature.
+
+2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-save-alist): Optimized.
+
+2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el: Commented out the experimental code.
+
+2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-range.el (gnus-inverse-list-range-intersection): Off-by-one
+ error.
+
+ * gnus.el (gnus-server-to-method): Made into subst.
+ (gnus-server-method-cache): New variable.
+ (gnus-server-to-method): Use it.
+ (gnus-group-method-cache): New variable.
+ (gnus-find-method-for-group-1): Renamed.
+ (gnus-find-method-for-group): New function.
+ (gnus-group-method-cache): Removed.
+
+ * gnus-sum.el (gnus-compute-unseen-list): Use new optimized
+ function.
+
+ * gnus-range.el (gnus-members-of-range): New function.
+ (gnus-list-range-intersection): Renamed.
+ (gnus-inverse-list-range-intersection): New function.
+
+ * gnus-sum.el (gnus-compute-unseen-list): Made into own function.
+
+ * nnagent.el (nnagent-retrieve-headers): New implementation.
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): New, faster
+ implementation.
+
+2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind `w3m-charset-to-coding-system'; bind
+ `w3m-meta-content-type-charset-regexp'.
+
+ * mm-view.el (mm-inline-text-html-render-with-w3m): Decode
+ charset-encoded html contents.
+
+2002-01-24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-request-article): Make sure it is not
+ an empty file.
+
+ * nnweb.el (url): Ignore errors when request url.
+
+ * nnrss.el: Clean up the comments.
+
+2002-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lpath.el: Fbind `w3m-region'; bind `w3m-mode-map'.
+
+ * mm-decode.el (mm-inline-text-html-renderer): New user option.
+ (mm-inline-media-tests): Test whether the value of
+ `mm-inline-text-html-renderer' is a function for text/html.
+
+ * mm-view.el (mm-inline-text-html-render-with-w3): New function
+ separated from `mm-inline-text'.
+ (mm-w3m-minor-mode): New variable.
+ (mm-w3m-setup): New variable.
+ (mm-setup-w3m): New function.
+ (mm-inline-text-html-render-with-w3m): New function.
+ (mm-inline-text): Funcall `mm-inline-text-html-renderer' for
+ text/html.
+
+2002-01-23 Paul Jarc <prj@po.cwru.edu>
+
+ * lpath.el: fbind make-symbolic-link and unix-sync for nnmaildir.
+
+2002-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-xmas.el (gnus-xmas-redefine): Quote `gnus-completing-read'
+ and `gnus-xmas-completing-read'.
+
+2002-01-19 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nneething.el (nneething-message-id-number): Abolished.
+ (nneething-encode-file-name): Not encode numerical characters.
+ (nneething-make-head): `nneething-message-id-number' is not
+ used to generate message IDs.
+
+2002-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-emphasis-alist): Include !? as sentence-ending
+ characters.
+
+2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-xmas.el (gnus-xmas-completing-read): New function.
+ (gnus-xmas-redefine): Redefine conditionally.
+
+2002-01-22 Josh Huber <huber@alum.wpi.edu>
+
+ * mml.el (mml-parse-1): Fixed usage of recipients in the secure
+ tag.
+
+2002-01-22 Josh Huber <huber@alum.wpi.edu>
+
+ * message.el (message-font-lock-keywords): Added the secure tag.
+ * mml-sec.el: Added functions to generate/modify/remove the secure
+ tag while in message mode.
+ * mml-sec.el (mml-secure-message): New.
+ * mml-sec.el (mml-unsecure-message): New.
+ * mml-sec.el (mml-secure-message-sign-smime): New.
+ * mml-sec.el (mml-secure-message-sign-pgp): New.
+ * mml-sec.el (mml-secure-message-sign-pgpmime): New.
+ * mml-sec.el (mml-secure-message-encrypt-smime): New.
+ * mml-sec.el (mml-secure-message-encrypt-pgp): New.
+ * mml-sec.el (mml-secure-message-encrypt-pgpmime): New.
+ * mml.el (mml-parse-1): Added code to recognise the secure tag and
+ convert it to either a part or multipart depending on if there are
+ other parts in the message.
+ * mml.el (mml-mode-map): Changed default sign/encrypt keybindings
+ to use the secure tag, rather than the part tag.
+ * mml.el (mml-preview): Added a save-excursion to keep cursor
+ position after doing an MML preview.
+
+2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheader.el (nnheader-parse-overview-file): New function.
+ (nnheader-write-overview-file): New function.
+
+2002-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-group-fast-parameter): Check better if expansion
+ in wanted.
+
+ * nnweb.el (nnweb-type-definition): Clean up.
+
+2002-01-21 Alastair Burt <burt@dfki.de>
+ Trivial patch.
+
+ * gnus-art.el (gnus-mm-display-part): Make sure that the summary
+ buffer exists before jumping to it.
+
+2002-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-wash-html-with-w3): Made into own
+ function.
+ (article-wash-html): Use it.
+ (gnus-article-wash-function): New variable.
+ (gnus-article-wash-html-with-w3m): New function.
+
+2002-01-20 Bj,Av(Brn Torkelsson <torkel@acc.umu.se>
+
+ * dgnushack.el (dgnushack-compile): Compile smiley-ems for
+ XEmacs.
+
+2002-01-20 John H. Palmieri <palmieri@math.washington.edu>
+
+ * gnus-fun.el (gnus-convert-image-to-gray-x-face): More standard
+ command line.
+
+2002-01-21 Simon Josefsson <jas@extundo.com>
+
+ * canlock.el (base64-encode-string): Autoload it from base64.
+ (canlock-make-cancel-key): Base64 encode unibyte string.
+
+2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnfolder.el (nnfolder-request-accept-article): Unfold
+ x-from-line.
+ (nnfolder-request-replace-article): Ditto.
+
+2002-01-20 Nevin Kapur <nevin@jhu.edu>
+
+ * gnus-group.el (gnus-group-best-unread-group): Use the right
+ positioning function.
+
+2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * smiley-ems.el (smiley-region): Use new function.
+ (smiley-update-cache): Use general image functions.
+ (smiley-region): Use general functions.
+
+ * gnus-util.el (gnus-graphic-display-p): New function.
+
+ * nnmail.el (nnmail-article-group): Allow outputting traces of
+ non-strings.
+
+ * nndoc.el (nndoc-type-alist): Rules for exim bounces.
+ (nndoc-exim-bounce-type-p): New function.
+
+ * message.el (message-dont-send): Doc fix.
+
+ * gnus-util.el (gnus-completing-read): Remove
+ inherit-input-method.
+
+ * gnus-art.el (gnus-treat-smiley): Doc fix.
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Ignore seen and recent
+ articles.
+
+2002-01-19 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-gssapi-open): Don't wait for logout to complete.
+ (imap-kerberos4-open): Ditto.
+ (imap-open): Set port correctly, don't set auth.
+
+2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bump version number.
+
+2002-01-20 05:33:30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.05 is released.
+
+2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnkiboze.el (nnkiboze-generate-group): Make sure the directory
+ exists.
+
+ * gnus-spec.el (gnus-string-width-function): New function.
+ (gnus-tilde-cut-form): Use it.
+ (gnus-tilde-max-form): Ditto.
+ (gnus-use-correct-string-widths): Default to (featurep 'xemacs).
+ (gnus-substring-function): Use it.
+ (gnus-tilde-cut-form): Ditto.
+ (gnus-substring-function): New function.
+
+ * message.el (message-check-news-header-syntax): New message.
+
+ * gnus.el (gnus-slave-no-server): Doc fix.
+
+ * gnus-spec.el (gnus-use-correct-string-widths): Default to t.
+
+2002-01-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-adjust-marked-articles): Fix the record for
+ `seen' if it looks like (seen NUM1 . NUM2). It should be
+ (seen (NUM1 . NUM2)).
+
+2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-catchup-articles): Update article
+ number in closed topics.
+
+2002-01-19 Daniel Pittman <daniel@rimspace.net>
+
+ * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New
+ functions.
+
+2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-group-find-parameter): Clean up.
+
+ * gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical
+ articles.
+
+ * gnus-util.el (gnus-completing-read-with-default): Renamed.
+
+ * nnmail.el (nnmail-article-group): Clean up.
+
+2002-01-19 Paul Stodghill <stodghil@cs.cornell.edu>
+
+ * gnus-agent.el (gnus-category-name): Intern the category name.
+
+2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-move-group): Use gnus-topic-history.
+
+ * gnus-util.el (gnus-completing-read): New function.
+
+2002-01-19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-add-wash-type): Use add-to-list.
+
+ * smiley-ems.el (smiley-region): Register smiley.
+ (smiley-toggle-buffer): Rewrite the function.
+ (smiley-active): Removed.
+
+2002-01-19 Simon Josefsson <jas@extundo.com>
+
+ * gnus-util.el (gnus-parent-id): Optimize null n case. From
+ Jesper Harder <harder@ifa.au.dk>.
+
+2002-01-18 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * gnus-art.el (gnus-request-article-this-buffer): Call
+ `nneething-get-file-name' to extract the file name from the
+ message id.
+
+ * nneething.el (nneething-encode-file-name): New function.
+ (nneething-decode-file-name): Ditto.
+ (nneething-get-file-name): Ditto.
+ (nneething-make-head): Encode the file name and encapsulate it
+ into the field of the message id.
+
+2002-01-18 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-request-update-info): Don't erase flags that isn't
+ stored in .marks.
+
+ * nnfolder.el (nnfolder-request-update-info): Ditto.
+
+2002-01-18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-url-parse-query-string): Allow new line in value.
+
+2002-01-18 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-starttls-p): Don't check for binary.
+ (imap-gssapi-auth-p): Ditto.
+ (imap-kerberos4-auth-p): Ditto.
+ (imap-open): Change logic. Iterate through all possible streams,
+ instead of bailing out after first failure. Move authenticator
+ decision to `imap-authenticate'.
+ (imap-authenticate): Change logic, now finds the authenticator to
+ use, was previously in `imap-open'.
+ (imap-open): Return nil on failure.
+ (imap-open): Setup temp buffer correctly.
+ (imap-open): Return buffer only on success.
+ (imap-interactive-login, imap-interactive-login): Tell the user
+ which stream/authenticator is used for the queried
+ username/password.
+ (imap-open, imap-authenticate): Set variables.
+ (imap-gssapi-auth-p, imap-kerberos4-auth-p): Fix typo.
+ (imap-open): Don't assume how `with-temp-buffer' is implemented.
+
+2002-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-grab-cam-x-face): New function.
+
+2002-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-emphasis-alist): Allow matching "*this*.)".
+
+2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-toggle-group-plugged): New function.
+ (gnus-agent-group-mode-map): Bind it to "Jo".
+ (gnus-agent-group-make-menu-bar): Add it into menu bar.
+
+2002-01-17 Karl Kleinpaste <karl@charcoal.com>
+
+ * gnus-xmas.el (gnus-group-toolbar): Add .newsrc save button.
+ (gnus-summary-mail-toolbar): Add mail article deletion button.
+
+ * smiley.el (smiley-deformed-regexp-alist): Eliminate noseless
+ false positives for lines of "^^^^".
+
+ * gnus-picon.el (gnus-picon-find-face): faces database is all
+ lowercase.
+
+2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer.
+ (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove
+ duplications.
+ (gnus-agent-batch): Bind gnus-agent-confirmation-function.
+
+2002-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-initial-limit): Inline
+ gnus-summary-limit-children.
+ (gnus-summary-initial-limit): Don't limit if
+ gnus-newsgroup-display is nil.
+ (gnus-summary-initial-limit): No, don't.
+
+ * gnus-util.el
+ (gnus-put-text-property-excluding-characters-with-faces): Inline
+ gnus-put-text-property.
+
+ * gnus-spec.el (gnus-default-format-specs): New variable.
+
+ * gnus-start.el (gnus-read-newsrc-file): Don't clear
+ gnus-format-specs.
+ (gnus-read-newsrc-el-file): Default to gnus-default-format-specs.
+
+ * gnus-spec.el (gnus-update-format-specifications): Really check
+ the Gnus version of the .newsrc.eld file.
+ (gnus-format-specs): Save the new default summary format.
+
+ * gnus-util.el (gnus-parent-id): Check whether references is empty
+ before splitting.
+
+ * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some
+ functions.
+ (gnus-gather-threads-by-references): Inline
+ `gnus-split-references'.
+
+ * gnus-spec.el (gnus-summary-line-format-spec): New, optimized
+ default value of gnus-summary-line-format-spec.
+
+2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-retrieve-headers-1): A better error
+ message.
+ (nnslashdot-request-list): Ditto.
+ (nnslashdot-sid-strip): Removed.
+
+2002-01-15 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-close-asynchronous): Enable.
+ (nnimap-close-group): Expunge.
+
+2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-user-date-format-alist): Typo.
+ From: Frank Schmitt <usereplyto@Frank-Schmitt.net>
+
+2002-01-15 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nneething.el (nneething-request-article): Set
+ `nnmail-file-coding-system' to `binary' locally, in order to read
+ files without any conversion.
+
+2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Use
+ nnheader-file-coding-system and nnmail-active-file-coding-system.
+ (gnus-agent-regenerate-group): Ditto.
+ (gnus-agent-regenerate): Ditto.
+ (gnus-agent-write-active): Ditto.
+ Suggested by Katsumi Yamaoka <yamaoka@jpl.org>
+
+2002-01-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-button-alist): Don't highlight <URL:.
+ Suggested by Ian Fitchet <ian.fitchet@lunanbay.com>
+
+2002-01-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: We don't need gnus-article-show-all-headers.
+
+ * gnus-art.el (article-show-all, gnus-article-show-all-header):
+ Ditto.
+
+ * gnus-sum.el (gnus-summary-select-article): Don't call
+ show-all-headers, because hidden headers are not hidden text any
+ more.
+
+2002-01-13 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-newline-and-reformat): Use `newline' instead
+ of inserting \n, so that the newline is marked as hard.
+
+ * gnus-spec.el (gnus-pad-form): Don't evaluate EL multiple times.
+ From Jesper Harder <harder@ifa.au.dk>.
+
+2002-01-12 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * imap.el (imap-close): Keep going if quit.
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Erase
+ nntp-server-buffer.
+
+2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-display-inline-fontify): Require font-lock to
+ avoid unbinding shadowed variables.
+
+ * gnus-art.el (gnus-picon-databases): Moved here.
+ (gnus-picons-installed-p): Moved here.
+ (gnus-article-reply-with-original): Use `mark'.
+
+ * gnus.el (gnus-picon): Moved here and renamed.
+
+ * gnus-art.el (gnus-treat-from-picon): Only be on if picons are
+ installed.
+ (gnus-treat-mail-picon): Ditto.
+ (gnus-treat-newsgroups-picon): Ditto.
+
+ * gnus-picon.el (gnus-picons-installed-p): New function.
+
+2002-01-12 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-go-online): Fix doc.
+
+2002-01-12 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-need-unselect-to-notice-new-mail)
+ (nnimap-before-find-minmax-bugworkaround): Use it.
+ (nnimap-find-minmax-uid): Don't reselect current mailbox.
+ (nnimap-dont-close): New variable.
+ (nnimap-close-group): Use it.
+
+2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-reply-with-original): Use
+ `mark-active'.
+
+ * gnus-msg.el (gnus-summary-reply): Don't bug out on regions.
+
+ * gnus-logic.el (gnus-advanced-score-rule): Thinko fix.
+ (gnus-score-advanced): Clean up.
+ (gnus-score-advanced): Accept a multiple of the score.
+
+2002-01-12 Simon Josefsson <jas@extundo.com>
+
+ * flow-fill.el (fill-flowed-display-column)
+ (fill-flowed-encode-columnq): New variables. Suggested by
+ Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann).
+ (fill-flowed-encode, fill-flowed): Use them.
+
+ * message.el (message-send-news, message-send-mail): Use
+ m-b-s-n-p-e-h-n.
+
+ * mml.el (autoload): Autoload fill-flowed-encode.
+ (mml-buffer-substring-no-properties-except-hard-newlines): New
+ function.
+ (mml-read-part): Use it.
+ (mml-generate-mime-1): Encode format=flowed if appropriate.
+ (mml-insert-mime-headers): Insert format=flowed.
+
+ * flow-fill.el (fill-flowed-encode): New function.
+ (fill-flowed): Bind fill-column to window width.
+
+2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if
+ it exists.
+ (gnus-summary-setup-buffer): Wake up dead summary buffers.
+ (gnus-summary-buffer-name): Don't return the dead name after all.
+ (gnus-summary-setup-buffer): Kill the dead buffer.
+
+ * gnus-art.el (gnus-article-followup-with-original): Store the
+ value of the mark before deactivating it.
+
+2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Fake it.
+ From: Karl Kleinpaste <karl@charcoal.com>
+
+ * gnus-art.el (article-display-x-face): Ditto.
+ (gnus-article-reply-with-original): Use gnus-region-active-p.
+ (gnus-article-followup-with-original): Ditto.
+
+ * gnus-sum.el (gnus-summary-read-group-1): Don't select
+ downloadable article either.
+
+2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-display-x-face): Insert From:.
+
+ * gnus-sum.el (gnus-summary-move-article): Don't draw the
+ article. Bind gnus-display-mime-function and
+ gnus-article-prepare-hook.
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview.
+ (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move
+ gnus-agent-possibly-synchronize-flags to the last.
+ (gnus-agent-go-online): New function. New variable.
+
+2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-regenerate-group): Add clean option.
+ (gnus-agent-regenerate): Ditto.
+
+2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-ignored-news-headers)
+ (message-ignored-mail-headers): Add X-Gnus-Agent-Meta-Information:.
+ Suggested by ARISAWA Akihiro <ari@atesoft.advantest.co.jp>
+
+ * gnus.el (gnus-gethash-safe): New macro.
+
+ * gnus-agent.el (gnus-agent-regenerate-history): New function.
+ (gnus-agent-regenerate): Show messages.
+
+2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-regenerate-group): New function.
+ (gnus-agent-regenerate): New function.
+ (gnus-agent-save-alist): Sort.
+ (gnus-agent-copy-nov-line): Test eobp.
+ (gnus-agent-retrieve-headers): Erase buffer.
+
+2002-01-10 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-charset-to-coding-system): Change charset to cs.
+ From: Torsten Hilbrich <email@myrkr.in-berlin.de>
+
+ * gnus.el (gnus-agent-covered-methods): Move here.
+ (gnus-online): New function.
+ (gnus-agent-method-p): Move here.
+
+ * nnagent.el (nnagent-retrieve-headers): Check whether arts is
+ nil. Remove articles-alist.
+
+ * gnus-start.el (gnus-get-unread-articles): Check online.
+ (gnus-groups-to-gnus-format): Ditto.
+ (gnus-active-to-gnus-format): Ditto.
+
+ * gnus-agent.el (gnus-agent-get-function): Use it.
+ (gnus-agent-get-undownloaded-list): Ditto.
+ (gnus-agent-fetch-session): Only fetch online methods.
+
+ * gnus-srvr.el (gnus-server-make-menu-bar): Add offline.
+ (gnus-server-mode-map): Ditto.
+ (gnus-server-offline-face): New face.
+ (gnus-server-offline-face): New variable.
+ (gnus-server-font-lock-keywords): Add offline.
+ (gnus-server-insert-server-line): Ditto.
+ (gnus-server-offline-server): New function.
+
+ * gnus-int.el (gnus-open-server): Turn to offline.
+ (gnus-server-unopen-status): New variable.
+
+2002-01-10 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnkiboze.el (nnkiboze-request-article): Use
+ gnus-agent-request-article.
+
+ * nnagent.el (nnagent-retrieve-headers): Don't use nnml
+ function. Insert undownloaded NOV.
+
+ * gnus-agent.el (gnus-agent-retrieve-headers): New function.
+ (gnus-agent-request-article): New function.
+
+ * gnus.el (gnus-agent-cache): New variable.
+
+ * gnus-int.el (gnus-retrieve-headers): Use
+ gnus-agent-retrieve-headers.
+ (gnus-request-head): Use gnus-agent-request-article.
+ (gnus-request-body): Ditto.
+
+ * gnus-art.el (gnus-request-article-this-buffer): Use
+ gnus-agent-request-article.
+
+ * gnus-sum.el (gnus-summary-read-group-1): Don't show the first
+ article if it is undownloaded.
+
+2002-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-spec.el (gnus-spec-tab): Deal with wide characters.
+
+2002-01-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * canlock.el (canlock-string-as-unibyte): New macro.
+ (canlock-sha1-with-openssl): Return a unibyte string.
+ (canlock-make-cancel-key): Treat Message-ID as a unibyte string.
+
+2002-01-09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-expand-group-parameters): Match \N or \& only.
+
+2002-01-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-encode.el (mm-content-transfer-encoding-defaults): Add
+ application/x-emacs-lisp.
+
+ * gnus-msg.el (gnus-bug): Use application/emacs-lisp.
+
+ * nntp.el (nntp-request-article): Add group parameter.
+ (nntp-request-head): Ditto.
+ (nntp-find-group-and-number): Add parameter group. Figure out
+ number if the status line doesn't give (e.g. quimby.gnus.org).
+
+2002-01-08 Simon Josefsson <jas@extundo.com>
+
+ * mml.el (mml-generate-mime-1): Set recipient correctly.
+
+2002-01-08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-read-from-minibuffer): Add parameter
+ initial-contents.
+ * gnus-msg.el (gnus-summary-resend-message): Use it.
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Restore the old
+ behavior of quit-config.
+
+ * message.el (message-make-from): Don't quote fullname.
+ From: Bj,Ax(Brn Mork <bmork@dod.no>
+
+ * gnus-group.el (gnus-group-suspend): Don't kill message buffers.
+ From: <andre@slamdunknetworks.com>
+
+2002-01-07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-mark-article-read): Typo. Increase n.
+
+ * gnus-art.el (gnus-header-button-alist): Handle mailto.
+
+ * mml.el (mml-preview): Bind gnus-original-article-buffer because
+ article-decode-group-name uses it. Bind gnus-article-prepare-hook
+ because bbdb may use it.
+
+2002-01-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * nneething.el (nneething-request-article): When a non-text file
+ is converted to an article, its data is encoded in base64. Call
+ `nneething-make-head' with options to specify MIME types.
+ (nneething-make-head): Add optional arguments to specify MIME
+ types.
+
+2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Fake a "From: "
+ header if there is not.
+
+ * gnus-xmas.el (gnus-xmas-put-image): Insert " " if bobp.
+
+ * gnus-msg.el (gnus-gcc-mark-as-read): New variable.
+ (gnus-inews-mark-gcc-as-read): Obsolete variable.
+ (gnus-inews-do-gcc): Use them.
+
+ * gnus-group.el (gnus-group-mark-article-read): Put holes into
+ gnus-newsgroup-unselected.
+
+2002-01-06 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use
+ condition-case, not ignore-errors.
+
+2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-insert-old-articles): Bind
+ gnus-fetch-old-headers.
+
+ * gnus-art.el (article-display-x-face): Use the current buffer
+ unless `W f'. Otherwise, X-Face may be shown in the header of a
+ forwarded part.
+ (gnus-treatment-function-alist): Treat xface before hiding
+ headers.
+
+2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Fix
+ parameters.
+
+2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-multibyte-p): Define conditionally when load.
+ (mm-guess-charset): New function.
+ (mm-charset-after): Use it.
+ (mm-detect-coding-region): New function.
+ (mm-detect-mime-charset-region): New function.
+
+ * gnus-sum.el (gnus-summary-show-article): Use
+ mm-detect-coding-region.
+
+2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-make-fqdn): Be less violent.
+
+ * gnus.el (gnus-logo-color-style): Compute custom form
+ automatically.
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Feed the adaptive
+ score file of the parent to the document group.
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Add an optional
+ parameters parameter.
+
+ * gnus-score.el (gnus-score-load-file): Clean up.
+
+2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-thread-sort-by-most-recent-number): Fix typo.
+ From: Damien Wyart <damien.wyart@free.fr>
+
+ * gnus-util.el (gnus-local-map-property): In Emacs 21, use keymap.
+
+2002-01-05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-select-group-hook): Typo.
+
+ * rfc2047.el (rfc2047-decode-string): Return immediately if there
+ is no quoted-printable-encoded STRING.
+ From: Jesper Harder <harder@ifa.au.dk>
+
+ (rfc2047-decode-string): Decode it.
+
+2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-logo-color-alist): Added more colors from Luis.
+
+2002-01-05 Keiichi Suzuki <keiichi@nanap.org>
+ Trivial patch.
+
+ * nntp.el (nntp-possibly-change-group): Erase contents of nntp
+ buffer to get rid of junk line.
+
+2002-01-05 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-mode-map): Bind message-goto-from to C-c C-f
+ C-o.
+ (message-mode-map): Bind message-insert-or-toggle-importance to
+ C-c C-u.
+ (message-mode-map): Bind message-disposition-notification-to to
+ C-c M-n.
+ (message-mode-menu): Add m-d-n-t.
+ (message-mode-field-menu): Add m-goto-from.
+ (message-mode): Doc fix.
+ (message-goto-from): New function.
+ (message-insert-disposition-notification-to): New function.
+ (message-tool-bar-map): Add receipt button.
+
+2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-thread-latest-date): New function.
+ (gnus-thread-sort-by-most-recent-number): Renamed.
+ (gnus-thread-sort-functions): Doc fix.
+ (gnus-select-group-hook): Don't use setq on a hook.
+ (gnus-thread-latest-date): Use date, not number
+
+ * gnus-agent.el (gnus-agent-expire-days): Doc fix.
+ (gnus-agent-expire): Allow regexp of expire-days.
+
+ * gnus-art.el (gnus-article-reply-with-original): Deactivate
+ region.
+ (gnus-article-followup-with-original): Ditto.
+
+ * gnus-sum.el (gnus-thread-highest-number): Doc fix.
+
+ * gnus-art.el (gnus-mime-display-alternative): Use
+ gnus-local-map-property.
+ (gnus-mime-display-alternative): Ditto.
+ (gnus-insert-mime-security-button): Ditto.
+ (gnus-insert-next-page-button): Ditto.
+ (gnus-button-prev-page): Take optional args.
+ (gnus-insert-prev-page-button): widget-convert.
+
+ * gnus-util.el (gnus-local-map-property): New function.
+
+ * gnus-art.el (gnus-prev-page-map): Use parent map.
+ (gnus-next-page-map): Ditto.
+
+ * gnus-spec.el (gnus-parse-format): Clean up.
+ (gnus-parse-format): Do complex formatting for %=.
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Add the string
+ "X-Face: " to the data in the built-in scenario.
+
+ * gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form.
+ (gnus-correct-pad-form): Renamed.
+ (gnus-tilde-max-form): Clean up.
+ (gnus-pad-form): Use gnus-use-correct-string-widths.
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Use native xface
+ support if that is available.
+
+ * gnus-sum.el (gnus-thread-highest-number): New function.
+ (gnus-thread-sort-by-most-recent-thread): New function.
+ (gnus-thread-sort-functions): Doc fix.
+
+2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-select-article): Disable multibyte in
+ all cases.
+ (gnus-summary-mode): Enable it in all cases.
+ (gnus-summary-display-article): Ditto.
+ (gnus-summary-edit-article): Ditto.
+
+ * gnus-ems.el (gnus-put-image): Really return glyph.
+
+ * gnus-art.el (gnus-article-x-face-command): Fix :type.
+ (gnus-treat-smiley): Don't take "P" in the interactive form.
+
+2002-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * compface.el (uncompface): XEmacs and Emacs have differing
+ capabilities.
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Use face.
+
+ * gnus-ems.el (gnus-article-xface-ring-internal): Removed.
+ (gnus-article-xface-ring-size): Removed.
+ (gnus-article-display-xface): Removed.
+ (gnus-remove-image): Cleaned up.
+
+ * gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm.
+ (gnus-xmas-create-image): Take pbm files.
+ (gnus-x-face): Removed.
+ (gnus-xmas-article-display-xface): Removed.
+
+ * gnus-fun.el (gnus-display-x-face-in-from): Bind
+ default-enable-multibyte-characters.
+
+ * compface.el (uncompface): Doc fix.
+
+ * gnus-art.el (gnus-article-x-face-command): Use
+ gnus-display-x-face-in-from.
+
+ * gnus-xmas.el (gnus-xmas-put-image): Return the image.
+
+ * gnus-ems.el (gnus-put-image): Return the image.
+
+ * gnus-fun.el (gnus-display-x-face-in-from): New function.
+ (gnus-x-face): Moved here.
+
+2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-xmas-put-image): Don't insert SPC or make
+ invisible if string is nil.
+ (gnus-xmas-article-display-xface): Use it.
+
+ * gnus-ems.el (gnus-put-image): Explicitly use SPC, and add text
+ property when string is nil.
+ (gnus-article-display-xface): Use it.
+
+2002-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-display-x-face): Check whether valid grey
+ face was returned.
+ (article-display-x-face): Place image in the right spot.
+
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Get rid of
+ stderr.
+ (gnus-convert-gray-x-face-to-xpm): Check whether output is valid.
+
+2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-xmas.el (gnus-xmas-create-image): Take optional
+ parameters.
+ (gnus-xmas-put-image): Allow non-strings to be passed.
+
+ * gnus-art.el (article-display-x-face): Use optional parameters.
+
+ * gnus-ems.el (gnus-create-image): Take optional parameters.
+
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface.
+
+ * compface.el (compface-xbm-p): Removed.
+
+ * gnus-ems.el (gnus-article-compface-xbm): Removed.
+ (gnus-article-display-xface): Use compface.
+
+ * compface.el: New file.
+
+ * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes.
+ (gnus-convert-image-to-x-face-command): Ditto.
+ (gnus-random-x-face): Quote argument.
+ (gnus-x-face-from-file): Ditto.
+
+2002-01-03 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-expire-articles): evaluate
+ the expire-group parameter once per article rather than once
+ per group; bind `nnmaildir-article-file-name' and `article'
+ for convenience. Leave article alone when expire-group
+ specifies the current group.
+ (nnmaildir--update-nov): be more concurrency-friendly with
+ temp file names.
+
+2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-read-init-file): Cleaned up.
+
+2002-01-03 Dave Love <d.love@dl.ac.uk>
+
+ * gnus-start.el (gnus-startup-file-coding-system): Removed.
+ (gnus-read-init-file): Don't use it.
+
+2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-fetch-session): Run hook.
+
+2002-01-03 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-start.el (gnus-read-init-file): Don't force coding system
+ for ~/.gnus. From Dave Love <fx@gnu.org>.
+
+2002-01-03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-send-buffer): Use mm-with-unibyte-current-buffer.
+ * nnspool.el (nnspool-request-post): Ditto.
+
+ * mm-util.el (mm-use-find-coding-systems-region): New variable.
+ (mm-find-mime-charset-region): Use it.
+
+2002-01-03 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-summary-line-format): Added :link.
+ * gnus-topic.el (gnus-topic-line-format): Ditto.
+ * gnus-sum.el (gnus-summary-dummy-line-format): Ditto.
+ * gnus-srvr.el (gnus-server-line-format): Ditto.
+ * gnus-group.el (gnus-group-line-format): Ditto.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Use correct syntax for
+ :keys, it works on both Emacsen.
+
+2002-01-03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-charset-to-coding-system): Don't setq charset.
+
+2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-summary-send-map): Fix binding for very-wide.
+
+2002-01-03 Reiner Steib <reiner.steib@gmx.de>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Menu bar entries for
+ very wide reply.
+
+2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-picon.el (gnus-picon-transform-address): Cache stuff.
+ (gnus-picon-cache): New variable.
+ (gnus-picon-transform-newsgroups): Cache stuff.
+
+ * gnus-art.el (gnus-article-reply-with-original): New command.
+ (gnus-article-followup-with-original): New command.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Take optional BEG and
+ END parameters.
+ (gnus-summary-followup): Take a list of list of articles.
+ (gnus-inews-yank-articles): Allow lists of article/regions.
+
+ * gnus-art.el (gnus-article-read-summary-keys): `R' and `F' are no
+ longer the usual commands.
+
+ * gnus-fun.el (gnus-convert-image-to-gray-x-face): Use pnmnoraw.
+ (gnus-convert-gray-x-face-to-xpm): Don't use six parameters to
+ shell-command-on-region.
+
+2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-picon.el (gnus-picon-transform-newsgroups): Fix for the case
+ "Newsgroups: rec.music.beatles.moderated, rec.music.beatles".
+
+2002-01-03 Steve Youngs <youngs@xemacs.org>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): XEmacs doesn't
+ understand ':keys', wrap it in an featurep 'xemacs.
+
+2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ems.el (gnus-article-display-xface): Show xface in the
+ order of headers (Actually, it is called in a reversed order). Add
+ 'gnus-image-text-deletable property.
+ (gnus-remove-image): Remove text with such a property.
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Don't use
+ gnus-put-image.
+
+ * gnus-art.el (gnus-article-treat-fold-newsgroups): Replace ", *"
+ with ", "
+
+2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed.
+
+ * gnus-art.el (gnus-ignored-headers): Hide all X-Faces.
+ (article-display-x-face): Display grey X-Faces.
+
+ * gnus-fun.el (gnus-convert-gray-x-face-region): New function.
+ (gnus-convert-gray-x-face-to-ppm): Ditto.
+ (gnus-convert-image-to-gray-x-face): Ditto.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add a :keys to
+ gnus-summary-show-raw-article.
+
+2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ Display picons in XEmacs without showing text.
+
+ * gnus-xmas.el (gnus-xmas-create-image): Don't use
+ mm-create-image-xemacs to create xbm glyph, because it deletes
+ temporary files.
+ (gnus-xmas-put-image): Use end-glyph. Make text invisible.
+ (gnus-xmas-remove-image): Make text visible, remove glyph.
+
+ * gnus-picon.el (gnus-picon-transform-newsgroups)
+ (gnus-picon-transform-address): Insert spec backward, due to the
+ incompatibility of gnus-xmas-put-image.
+
+2002-01-02 Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix.
+
+2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el: Doc fix.
+
+ * gnus-art.el: Doc fix.
+
+ * gnus-agent.el: Doc fix.
+
+2002-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-diary.el, gnus-delay.el: Fix copyright lines.
+
+2002-01-01 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--update-nov): automatically parse
+ NOV data out of the message again if nnmail-extra-headers has
+ changed.
+
+2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-fun.el: New file.
+ (gnus-convert-image-to-x-face-command): New variable.
+ (gnus-insert-x-face): New function.
+ (gnus-random-x-face): Renamed.
+ (gnus-x-face-from-file): Renamed.
+
+ * gnus-art.el (gnus-body-boundary-delimiter): Changed default to
+ "_".
+ (gnus-body-boundary-delimiter): Typo fix.
+
+2002-01-02 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-article-treat-body-boundary): Handle nil.
+ (gnus-body-boundary-delimiter): Fix type.
+
+2002-01-01 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-treat-buttonize, gnus-treat-buttonize-head)
+ (gnus-treat-emphasize, gnus-treat-strip-cr)
+ (gnus-treat-leading-whitespace, gnus-treat-hide-headers)
+ (gnus-treat-hide-boring-headers, gnus-treat-hide-signature)
+ (gnus-treat-fill-article, gnus-treat-hide-citation)
+ (gnus-treat-hide-citation-maybe)
+ (gnus-treat-strip-list-identifiers, gnus-treat-strip-pgp)
+ (gnus-treat-strip-pem, gnus-treat-strip-banner)
+ (gnus-treat-highlight-headers, gnus-treat-highlight-citation)
+ (gnus-treat-date-ut, gnus-treat-date-local)
+ (gnus-treat-date-english, gnus-treat-date-lapsed)
+ (gnus-treat-date-original, gnus-treat-date-iso8601)
+ (gnus-treat-date-user-defined, gnus-treat-strip-headers-in-body)
+ (gnus-treat-strip-trailing-blank-lines)
+ (gnus-treat-strip-leading-blank-lines)
+ (gnus-treat-strip-multiple-blank-lines)
+ (gnus-treat-unfold-headers, gnus-treat-fold-headers)
+ (gnus-treat-fold-newsgroups, gnus-treat-overstrike)
+ (gnus-treat-display-xface, gnus-treat-display-smileys)
+ (gnus-treat-from-picon, gnus-treat-mail-picon)
+ (gnus-treat-newsgroups-picon, gnus-treat-body-boundary)
+ (gnus-treat-capitalize-sentences, gnus-treat-fill-long-lines)
+ (gnus-treat-play-sounds, gnus-treat-translate)
+ (gnus-treat-x-pgp-sig): Doc fix, add link to manual.
+
+ * gnus-art.el (gnus-body-boundary-delimiter): New variable.
+ (gnus-article-treat-body-boundary): Use it.
+
+ * message.el (message-mode): Fix doc.
+ (message-mode-menu): Fix names.
+
+2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-first-subject): Really go to unseen
+ articles.
+
+ * gnus-picon.el (gnus-picon-find-face): Search MISC for all types.
+ (gnus-picon-transform-address): Search for unknown faces as well.
+ (gnus-picon-find-face): Don't search "news" for MISC.
+ (gnus-picon-user-directories): Changed default back to exclude
+ "unknown".
+
+ * gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic.
+
+ * gnus-picon.el (gnus-picon-find-face): Search through all
+ databases.
+ (gnus-picon-find-face): New implementation.
+
+ * gnus-topic.el (gnus-topic-goto-previous-topic): New command and
+ keystroke.
+ (gnus-topic-goto-next-topic): Ditto.
+
+ * gnus.el (gnus-summary-line-format): Changed default.
+
+ * nnmail.el (nnmail-extra-headers): Change default.
+
+ * gnus-sum.el (gnus-extra-headers): Change default.
+
+ * message.el (message-news-other-window): Changed "news" to
+ "posting".
+ (message-news-other-frame): Ditto.
+ (message-do-send-housekeeping): Ditto.
+
+ * gnus-sum.el (gnus-summary-maybe-hide-threads): Use predicate
+ function.
+ (gnus-article-unread-p): New function.
+ (gnus-article-unseen-p): New function.
+ (gnus-dead-summary-mode-map): Typo.
+
+ * gnus-util.el (gnus-make-predicate): New function.
+ (gnus-make-predicate-1): New function.
+
+ * gnus-sum.el: New function.
+ (gnus-map-articles): New function.
+
+ * gnus-art.el (gnus-treat-fold-headers): New variable.
+ (gnus-article-treat-fold-headers): New command and keystroke.
+
+ * gnus-sum.el (gnus-dead-summary-mode-map): Clean up.
+ (gnus-dead-summary-mode-map): Bind q to bury-buffer.
+
+2002-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-fcc-externalize-attachments): New variable.
+ (message-do-fcc): Use it.
+
+ * gnus-msg.el (gnus-gcc-externalize-attachments): New variable.
+ (gnus-inews-do-gcc): Use it.
+
+ * mml.el (mml-tweak-sexp-alist): New variable.
+ (mml-externalize-attachments): New variable.
+ (mml-tweak-part): Use mml-tweak-sexp-alist.
+ (mml-tweak-externalize-attachments): New function.
+
+2002-01-01 Steve Youngs <youngs@xemacs.org>
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment
+ 'set-glyph-face' so x-face back/foreground can be set.
+
+2001-12-31 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-fix-before-sending): Fix a typo.
+
+2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treat-smiley): Renamed command.
+ (gnus-article-remove-images): New command and keystroke.
+
+ * gnus-sum.el (gnus-summary-toggle-smiley): Removed.
+
+ * smiley-ems.el (gnus-smiley-display): Removed.
+
+ * gnus.el (gnus-version-number): Update version.
+
+ * message.el (message-text-with-property): Renamed and moved
+ here.
+ (message-fix-before-sending): Highlight invisible text and place
+ point there.
+
+2002-01-01 02:32:53 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.04 is released.
+
+2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-delay.el (gnus-delay-send-queue): Renamed.
+
+ * gnus-art.el (gnus-ignored-headers): More headers,
+
+ * ietf-drums.el (ietf-drums-parse-addresses): Use `error' instead
+ of `scan-error', since XEmacs doesn't seem to support that.
+
+2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-best-unread-article): Take a prefix
+ arg.
+ (gnus-summary-best-unread-subject): Ditto.
+ (gnus-summary-best-unread-subject): No, don't.
+ (gnus-summary-better-unread-subject): New command.
+
+ * gnus-xmas.el (gnus-xmas-put-image): Insert the string itself.
+
+ * lpath.el ((featurep 'xemacs)): fbind url function.
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Use data, not
+ buffer.
+ (gnus-xmas-remove-image): Implementation that does something.
+ (gnus-xmas-article-display-xface): Mark images properly.
+
+ * gnus-art.el (gnus-mime-print-part): Use mm-temp-directory.
+
+2001-12-31 Florian Weimer <fw@deneb.enyo.de>
+
+ * gnus.el (gnus): Warn if trying to run Gnus un-byte-compiled.
+
+2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-line-format): Added %O to the default
+ value.
+
+ * gnus-util.el (gnus-text-with-property): The smallest point is
+ point-min.
+
+ * smiley-ems.el (smiley-region): Return images.
+ (gnus-smiley-display): Allow toggling.
+ (smiley-region): Use text properties, not overlays.
+
+ * gnus-xmas.el (gnus-xmas-remove-image): New function, not
+ implemented yet.
+
+ * smiley-ems.el (smiley-update-cache): Check for valid types.
+
+ * gnus-art.el (gnus-with-article-buffer): New macro.
+
+ * gnus-picon.el (gnus-picon-transform-newsgroups): Keep the
+ strings as well as the glyphs.
+ (gnus-picon-transform-address): Ditto.
+ (gnus-picon-insert-glyph): Ditto.
+ (gnus-picon-transform-newsgroups): Toggle.
+ (gnus-picon-transform-address): Toggle.
+
+ * gnus-ems.el (gnus-remove-image): New function.
+ (gnus-put-image): Take an optional string.
+
+ * gnus-util.el (gnus-text-with-property): New function.
+
+ * gnus-art.el (gnus-delete-images): New function.
+
+ * gnus-ems.el (gnus-article-display-xface): Mark and store image.
+
+ * gnus-art.el (gnus-article-wash-status-entry): Renamed.
+ (gnus-article-wash-status): Use it.
+ (gnus-signature-toggle): Clean up.
+ (gnus-add-wash-status): New function.
+ (gnus-delete-wash-status): New function.
+ (gnus-article-hide-text-type): Use them throughout.
+ (gnus-add-image): New function.
+
+ * gnus-ems.el (gnus-article-display-xface): Use new interface.
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Use new
+ interface.
+
+ * gnus-art.el (article-display-x-face): Cleaned up.
+
+ * rfc2047.el (rfc2047-field-value): New function.
+
+ * mail-parse.el (mail-header-field-value): New alias.
+
+ * gnus-art.el (gnus-mime-print-part): Fix typos.
+
+ * smiley-ems.el (gnus-smiley-file-types): New variable.
+ (smiley-update-cache): Use it.
+ (smiley-regexp-alist): Suffix-less smiley names.
+ (smiley-regexp-alist): Added more smileys.
+
+ * gnus-sum.el (gnus-print-buffer): Made into own function.
+ (gnus-summary-print-article): Use it.
+
+ * mailcap.el (mailcap-mime-info): Actually return the bit that we
+ looked for when REQUEST is a string.
+
+ * gnus-art.el (gnus-mime-button-commands): Add printing
+ keystroke.
+ (gnus-mime-copy-part): Doc fix.
+ (gnus-mime-print-part): New command.
+
+2001-12-31 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-fetch): Notice empty flags responses. From
+ Nic Ferrier <nferrier@tf1.tapsellferrier.co.uk>.
+
+2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-picon.el (gnus-treat-from-picon): Autoload.
+ (picon): Fix doc.
+
+ * gnus-win.el (gnus-window-to-buffer): gnus-picon-buffer-name no
+ longer exists. Remove those codes.
+ * gnus.el (gnus-use-picons): Ditto.
+
+2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't
+ infloop.
+
+ * gnus-sum.el (t): New `W D' map.
+
+ * gnus-art.el (gnus-treat-fold-newsgroups): New variable.
+ (gnus-article-treat-body-boundary): Clean up.
+ (gnus-body-boundary-face): Removed.
+ (gnus-article-goto-header): Moved here.
+ (gnus-article-goto-header): Allow better regexps.
+ (gnus-article-treat-fold-newsgroups): New command.
+
+ * gnus-sum.el (gnus-summary-move-article): We have to select an
+ article to give `gnus-read-move-group-name' an opportunity to
+ suggest an appropriate default.
+
+ * rfc2047.el (rfc2047-fold-line): New function.
+ (rfc2047-unfold-line): Ditto.
+ (rfc2047-fold-region): Don't fold just after the header name.
+
+ * mail-parse.el (mail-header-fold-line): New alias.
+ (mail-header-unfold-line): Ditto.
+
+ * gnus-art.el (gnus-body-boundary-face): Renamed.
+ (gnus-article-treat-body-boundary): Use it.
+ (gnus-article-treat-body-boundary): Use an invisible header and a
+ line of underline characters.
+
+2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * ietf-drums.el (ietf-drums-parse-addresses): Recover from errors.
+
+ * gnus-picon.el (gnus-picon-transform-address): Skip bad addresses.
+ (gnus-picon-split-address): New function.
+ (gnus-picon-find-face): Use it.
+ (gnus-picon-transform-address): Use it. Set first to t for each
+ address.
+
+ * gnus-art.el (gnus-with-article-headers): Move to here. Define
+ the macro then use it.
+ (gnus-treatment-function-alist): Treat picons earlier.
+
+2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-body-separator-face): New variable.
+ (gnus-article-treat-body-boundary): Use a blank, colored line.
+
+ * gnus-picon.el (gnus-picon-find-face): Look into misc/MISC as
+ well.
+
+ * gnus-art.el (gnus-treat-body-boundary): New variable.
+ (gnus-article-treat-unfold-headers): Use helper macro.
+ (gnus-article-treat-body-boundary): New command.
+
+ * gnus.el (gnus-logo-color-style): Change the default color.
+ (gnus-splash-face): Gray, gray.
+
+ * gnus-xmas.el (gnus-xmas-group-startup-message): Use general
+ colors.
+
+ * gnus.el (gnus-logo-color-alist): Moved here and renamed.
+ (gnus-logo-color-style): Ditto.
+ (gnus-logo-colors): Ditto.
+
+ * gnus-picon.el (gnus-picon-create-glyph): Cache glyphs.
+
+ * gnus-art.el (gnus-treat-newsgroups-picon): New variable.
+
+ * gnus-picon.el (gnus-treat-newsgroups-picon): New function.
+ (gnus-picon-transform-newsgroups): New function.
+
+ * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil
+ string.
+
+ * gnus-picon.el (gnus-treat-mail-picon): Renamed.
+
+ * gnus-art.el (gnus-treat-cc-picon): New variable.
+ (gnus-treat-mail-picon): Renamed.
+
+ * gnus-picon.el: New implementation.
+ (gnus-picon-find-face): Renamed.
+ (gnus-treat-from-picon): Use it.
+ (gnus-picon-transform-address): Renamed.
+ (gnus-treat-from-picon): Use it.
+ (gnus-picon-create-glyph): Renamed.
+ (gnus-picon-transform-address): Use it.
+ (gnus-treat-cc-picon): New command.
+
+ * mm-decode.el (mm-create-image-xemacs): Separated out into
+ function.
+ (mm-get-image): Use it.
+
+ * gnus-art.el (gnus-treat-display-picons): Simplify.
+ (gnus-treat-from-picon): Renamed.
+
+ * gnus-ems.el (gnus-create-image): New function.
+ (gnus-put-image): New function.
+
+ * gnus-art.el (gnus-article-treat-unfold-headers): Doc fix.
+ (gnus-with-article-headers): New macro.
+ (gnus-article-goto-header): New function.
+
+ * gnus-xmas.el (gnus-image-type-available-p): New function.
+
+ * gnus-ems.el (gnus-image-type-available-p): New function.
+
+2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-check-group): Find the correct tag, because
+ xml.el is changed.
+
+2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-treat-unfold-headers): Only fold when
+ lines are shorter than the window width.
+ (gnus-ignored-headers): More headers.
+
+2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treat-unfold-lines): New variable.
+ (gnus-treat-unfold-headers): Renamed.
+ (gnus-article-treat-unfold-headers): New command and keystroke.
+
+ * rfc2047.el (rfc2047-encode-message-header): Clean up.
+
+ * gnus-int.el (gnus-open-server): Mark quit-ed server as denied.
+
+2001-12-29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * sha1-el.el (sha1-use-external): New variable.
+ (sha1-region): Use it.
+ (sha1-string): Ditto.
+
+ * dgnushack.el (dgnushack-compile): Compile gnus-picon for Emacs.
+ * gnus-picon.el: Less warnings when compile.
+
+2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-picon.el (gnus-picons-news-directories): Removed obsolete
+ alias.
+ (gnus-picons-database): Default to list.
+ (gnus-picons-lookup-internal): Use it.
+
+ * nnmail.el (nnmail-article-group): Default nnmail-split-methods
+ to "bogus".
+
+ * gnus-win.el (gnus-configure-windows-hook): New hook.
+
+2001-12-29 Sascha L,A|(Bdecke <sascha@meta-x.de>
+
+ * gnus-win.el (gnus-configure-windows): Minimize tree buffer.
+
+2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-update-marks): Don't uncompress the seen
+ lists.
+ (gnus-select-newsgroup): Don't append; push.
+ (gnus-adjust-marked-articles): Remove obsolete ranges from
+ `seen'.
+ (gnus-update-marks): Clean up.
+ (gnus-select-newsgroup): Don't stomp gnus-newsgroup-seen.
+
+2001-12-29 Frank Schmitt <usereplyto@Frank-Schmitt.net>
+
+ * gnus-sum.el (gnus-summary-limit-to-age): Allow negative days.
+
+2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-auto-select-subject): New variable.
+ (gnus-summary-best-unread-subject): New function.
+ (gnus-summary-best-unread-article): Use it.
+ (gnus-summary-first-unseen-subject): New function and command.
+
+ * gnus-art.el (gnus-treatment-function-alist): Emphasize after
+ other treatments.
+
+ * gnus-util.el (gnus-put-overlay-excluding-newlines): New
+ function.
+
+ * gnus-art.el (gnus-article-show-hidden-text): Remove the type
+ from the list of hidden types.
+
+ * mm-view.el (mm-inline-text): Ditto.
+ (mm-inline-text): Ditto.
+ (mm-w3-prepare-buffer): Ditto.
+
+ * gnus-art.el (article-wash-html): Inhibit more remote fetching.
+
+2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-ignored-headers): Added more headers.
+
+2001-12-29 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Compute the prefix
+ once.
+
+2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-server-browse-in-group-buffer): Doc fix.
+
+2001-12-28 Simon Josefsson <jas@extundo.com>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. From
+ Jesper Harder <harder@ifa.au.dk>.
+
+2001-12-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-select-newsgroup): Make
+ `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen'
+ contain all articles (instead of none) when no seen marks have
+ been set for the group.
+ (gnus-update-marks): Use `gnus-range-add' on a uncompressed list
+ instead, it seems to result in shorter ranges.
+
+2001-12-26 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-iso-8859-x-to-15-region): Use
+ insert-before-markers.
+ From Jesper Harder <harder@ifa.au.dk>
+
+2001-12-26 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-save-mail): create the destination
+ groups if they do not exist.
+
+2001-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * canlock.el (canlock-sha1-with-openssl): Remove unused variable.
+
+2001-12-22 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): Call
+ gnus-group-real-name.
+
+ * gnus-sum.el (gnus-decode-encoded-word-methods): Backslash paren.
+ (gnus-newsgroup-variables): Ditto.
+
+ * gnus.el (gnus-group-prefixed-name): If group name is prefixed,
+ return it.
+
+2001-12-21 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus.el (gnus-valid-select-methods): Include nnmaildir.
+ * nnmaildir.el (top-level): Add commentary.
+ (nnmaildir-version): Indicate that nnmaildir is now a standard
+ part of Gnus, not separately released.
+
+2001-12-21 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el, gnus-picon.el, gnus-sieve.el, gnus-sum.el:
+ * gnus-xmas.el, imap.el, mailcap.el, mm-util.el, nnfolder.el:
+ * nnheader.el, nnmail.el: Nil/NIL vs. nil.
+ From Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+2001-12-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmaildir.el: Copyright changes. Require cl only at compile time.
+
+2001-12-20 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (top-level): Don't require cl. Suggested by ShengHuo
+ ZHU <zsh@cs.rochester.edu>.
+ (nnimap-close-group): Don't quote KEYLIST items. Suggested by
+ Brian P Templeton <bpt@tunes.org>.
+
+2001-12-19 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmaildir.el: New file.
+ From Paul Jarc <prj@po.cwru.edu>.
+
+2001-12-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndoc.el (nndoc-type-alist): Move forward to the end.
+
+2001-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-find-subscribed-addresses): Replace `mapc' with
+ `dolist'.
+
+2001-12-19 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-frames-on-display-list): New function.
+ (gnus-get-buffer-window): Use it.
+
+2001-12-19 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnwarchive.el (nnwarchive-mail-archive-xover): Fix the regexp.
+
+2001-12-18 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-get-buffer-window): Use gnus-delete-if.
+
+2001-12-18 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Harald Meland <Harald.Meland@usit.uio.no>
+
+ * gnus-win.el (gnus-get-buffer-window): New function.
+ (gnus-all-windows-visible-p): Use it.
+
+ * gnus-util.el (gnus-horizontal-recenter)
+ (gnus-horizontal-recenter, gnus-horizontal-recenter)
+ (gnus-horizontal-recenter, gnus-set-window-start): Use it.
+
+ * gnus-score.el (gnus-score-insert-help): Use it.
+
+ * gnus-salt.el (gnus-tree-recenter, gnus-generate-tree)
+ (gnus-generate-tree, gnus-highlight-selected-tree)
+ (gnus-highlight-selected-tree, gnus-tree-highlight-article): Use
+ it.
+
+ * gnus-art.el (gnus-article-set-window-start)
+ (gnus-mm-display-part, gnus-request-article-this-buffer)
+ (gnus-button-next-page, gnus-button-prev-page)
+ (gnus-article-button-next-page, gnus-article-button-prev-page):
+ Use it.
+
+2001-12-18 Josh Huber <huber@alum.wpi.edu>
+
+ * ChangeLog, ChangeLog.1, nnwfm.el, smiley.el:
+ * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el:
+ * mml1991.el, nnultimate.el: Removed buffer-file-coding-system tag.
+
+2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el:
+ * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el:
+ * mml1991.el, nnultimate.el: Add `coding'.
+
+2001-12-17 Josh Huber <huber@alum.wpi.edu>
+
+ * ChangeLog: changed coding to buffer-file-coding-system
+ * ChangeLog.1: same
+ * nnwfm.el: same
+ * gnus-smiley.el: same
+ * gnus-cite.el: moved -*- magic cookie -*- to Local Variables
+ * gnus-delay.el: same
+ * gnus-spec.el: same
+ * message.el: same
+ * mml1991.el: same
+ * nnultimate.el: same
+
+2001-12-16 Simon Josefsson <jas@extundo.com>
+ Inspired by code by Dirk Meyer <dischi@tzi.de>.
+
+ * gnus-sum.el (gnus-summary-muttprint-program): New variable.
+ (gnus-summary-save-map): Add muttprint.
+ (gnus-summary-make-menu-bar): Ditto.
+ (gnus-summary-muttprint): New function.
+
+ * gnus-art.el (gnus-summary-pipe-to-muttprint): New function.
+
+2001-12-14 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * uudecode.el (uudecode-decode-region-internal): Speedup by using
+ temporary list instead of buffer.
+
+ * mm-url.el (executable-find): autoload.
+
+2001-12-12 Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Doc fix (add reference
+ to variable, follow doc-string conventions).
+
+2001-12-13 Josh Huber <huber@alum.wpi.edu>
+
+ * gnus-cus.el (gnus-extra-topic-parameters): added topic parameter
+ subscribe-level
+ * gnus-topic.el (gnus-subscribe-topics): use it.
+
+2001-12-13 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-summary-mail-forward): Forward all marked
+ messages. (A small patch with indentation)
+ From Sean Neakums <sneakums@zork.net>.
+
+ * gnus-uu.el (gnus-uu-grab-articles): Set gnus-current-article to
+ nil after shooting down the gnus-original-article-buffer.
+
+2001-12-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * uudecode.el (uudecode-use-external): New variable.
+ (uudecode-decode-region): Automatically detect external program.
+
+ * binhex.el (binhex-use-external): New variable.
+ (binhex-decode-region-internal): New function.
+ (binhex-decode-region): Automatically detect external program.
+
+ * mm-uu.el (mm-uu-decode-function,mm-uu-binhex-decode-function):
+ Use them.
+
+2001-12-12 Simon Josefsson <jas@extundo.com>
+
+ * nnvirtual.el (nnvirtual-always-rescan)
+ (nnvirtual-component-regexp): Fix doc.
+
+ * nnoo.el (defvoo): Add doc to defvoo variables.
+
+ * nnml.el (nnml-directory, nnml-active-file)
+ (nnml-newsgroups-file, nnml-get-new-mail, nnml-nov-is-evil)
+ (nnml-marks-is-evil, nnml-filenames-are-evil)
+ (nnml-prepare-save-mail-hook, nnml-inhibit-expiry): Fix doc.
+
+ * nnmh.el (nnmh-directory, nnmh-get-new-mail)
+ (nnmh-prepare-save-mail-hook, nnmh-be-safe): Fix doc.
+ (nnmh-possibly-change-directory): Use `nnheader-report' instead of
+ `error'.
+
+ * nnmbox.el (nnmbox-mbox-file, nnmbox-active-file)
+ (nnmbox-get-new-mail, nnmbox-prepare-save-mail-hook):
+
+ * nnfolder.el (nnfolder-directory, nnfolder-active-file)
+ (nnfolder-newsgroups-file, nnfolder-get-new-mail)
+ (nnfolder-save-buffer-hook, nnfolder-inhibit-expiry)
+ (nnfolder-nov-is-evil, nnfolder-marks-is-evil): Fix doc.
+
+ * nnbabyl.el (nnbabyl-mbox-file, nnbabyl-active-file)
+ (nnbabyl-get-new-mail, nnbabyl-prepare-save-mail-hook): Fix doc.
+
+ * imap.el, nnimap.el: Fix indentation.
+
+ * gnus-sieve.el (gnus-sieve-article-add-rule): Autoload it.
+
+2001-12-12 Didier Verna <didier@xemacs.org>
+
+ * gnus-msg.el (gnus-group-news): New function.
+ * gnus-group.el (gnus-group-mode-map): bind it to `i'.
+ * gnus-group.el (gnus-group-make-menu-bar): add a menu item for it.
+ * gnus-salt.el (gnus-carpal-group-buffer-buttons): add a button
+ for it.
+ * gnus-msg.el (gnus-summary-news-other-window): New function.
+ * gnus-msg.el ((gnus-summary-send-map "S" gnus-summary-mode-map)):
+ bind it to `i'.
+ * gnus-sum.el (gnus-summary-mode-map): bind it to `i'.
+ * gnus-sum.el (gnus-summary-make-menu-bar): add a menu item for it.
+ * gnus-salt.el (gnus-carpal-summary-buffer-buttons): add a button
+ for it (called with a prefix).
+ * gnus-msg.el (gnus-configure-posting-styles): add an optional
+ group-name argument.
+ * gnus-msg.el (gnus-setup-message): use it.
+
+2001-12-12 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-show-article): Fix doc.
+
+2001-12-10 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mime-to-mml): Remove Content-Disposition too.
+
+2001-12-09 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-buffer-name): Decode group name.
+ * gnus-group.el (gnus-group-name-decode): Decode unibyte
+ strings only.
+ From TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+2001-12-08 Nevin Kapur <nevin@jhu.edu>
+
+ * nnmail.el (nnmail-fancy-expiry-targets): New variable.
+ (nnmail-fancy-expiry-target): Use it.
+ Suggestions from Simon Josefsson <jas@extundo.com>.
+
+2001-12-07 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-show-article): Recount lines if not exist.
+
+2001-12-07 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnwfm.el (nnwfm-create-mapping): Use gnus-url-unhex-string.
+
+ * gnus-util.el (gnus-url-unhex-string): Move here.
+
+2001-12-07 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-decode-entities-unibyte-string): Use
+ mm-url-decode-entities-nbsp.
+
+ * nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el:
+ * webmail.el, nnwfm.el: Use mm-url.
+
+ * mm-url.el (mm-url-fetch-form): Move from nnweb.
+ (mm-url-remove-markup): Move from nnweb.
+ (mm-url-fetch-simple): Move from webmail.
+
+ * nnslashdot.el (nnslashdot-request-post): Use mm-url-fetch-form.
+
+2001-12-07 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-print-truncate-and-quote): New function.
+ (gnus-summary-print-article): Use it.
+
+ * gnus-util.el (gnus-replace-in-string): Typo.
+
+2001-12-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnweb.el (nnweb-replace-in-string): Removed.
+
+ * gnus-util.el (gnus-replace-in-string): New function.
+ (gnus-mode-string-quote): Use it.
+
+ * nnrss.el (nnrss-format-string): Use gnus-replace-in-string.
+ * nnwfm.el (nnwfm-create-mapping): Ditto.
+
+2001-12-06 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (dgnushack-compile): nnrss.el and
+ nnslashdot.el don't depend on nnweb, url, w3.
+
+ * nnrss.el: Use mm-url.
+
+2001-12-06 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-url.el (mm-url-insert-file-contents): Support file:.
+
+2001-12-05 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el: Lower case for the description line. Sync from the
+ Emacs CVS.
+
+2001-12-05 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-find-new-groups): Fix doc.
+ From: Stefan Monnier <monnier@cs.yale.edu>
+
+2001-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.wl (mm-inline-text): Decode a charset-encoded rich text.
+
+2001-12-04 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-url.el: Require executable.
+ Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
+
+2001-12-03 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * pop3.el (pop3-munge-message-separator): Only use valid date.
+ Trivial patch from Michael Welsh Duggan <md5i@cs.cmu.edu>.
+
+ * Makefile.in: gnus-load.elc may not be generated.
+
+2001-12-03 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-url.el: New file.
+ * nnslashdot.el: Use it.
+ * mm-extern.el (mm-extern-url): Use it.
+
+2001-12-01 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-save-article): Nix
+ gnus-display-mime-function and gnus-article-prepare-hook.
+
+ * gnus-spec.el (gnus-parse-complex-format): Properly handle %C at
+ the beginning of lines.
+ (gnus-complex-form-to-spec): Ditto.
+
+2001-12-01 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-make-mft): Fix the m-s-a-file regexp.
+ From Paul Jarc <prj@po.cwru.edu>.
+
+2001-11-30 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el: New variable message-subscribed-address-file;
+ use it in message-make-mft. From Paul Jarc <prj@po.cwru.edu>.
+
+2001-11-30 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-tab-body-function): Set to nil.
+ (message-tab): Use text-mode-map or global-map.
+ Suggested by Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>.
+
+2001-11-30 Simon Josefsson <jas@extundo.com>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Use gnus-range-add
+ instead of gnus-union, for speed. Suggested by Christoph Conrad
+ <christoph.conrad@gmx.de>.
+ (gnus-agent-fetch-group-1): Add verbose message.
+
+2001-11-29 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-write-active): Make sure sym is a cons
+ of integers.
+
+2001-11-29 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-newgroups-header-regexp)
+ (message-completion-alist, message-tab-body-function): Use
+ defcustom rather than defvar.
+ (message-tab): Mention `message-tab-body-function' in doc.
+ Suggested by Karl Eichwalder.
+
+2001-11-28 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-uu.el (gnus-uu-save-article): Use #part instead of #mml.
+
+2001-11-28 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnheader.el (nnheader-find-nov-line): Don't use macro
+ gnus-delete-line.
+
+ * gnus-group.el (gnus-group-name-decode): Defun instead of defsubst.
+ (gnus-group-name-charset): Ditto.
+
+ * gnus-util.el (gnus-buffer-live-p): Ditto.
+
+2001-11-28 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * sieve-manage.el (sieve-manage-stream-alist): Backslash before
+ open parenthesis in doc.
+ (sieve-manage-authenticator-alist): Typo in doc.
+ * imap.el (imap-authenticator-alist): Typo in doc.
+ (imap-stream-alist): Backslash.
+
+ * gnus-sum.el (gnus-summary-limit-to-author): Missing arguments.
+ Thanks to david.goldberg6@verizon.net (David S. Goldberg)
+
+2001-11-27 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-topic.el (gnus-topic-mode): Add LOCAL for add-hook.
+
+ * message.el (message-mode): make-local-hook is harmless in Emacs 21.
+
+ * gnus-msg.el (gnus-configure-posting-styles): use
+ make-local-hook. Add LOCAL for add-hook.
+
+2001-11-27 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-mode): Use `make-local-hook' unless
+ obsolete.
+ Patch by Katsumi Yamaoka <yamaoka@jpl.org>.
+
+2001-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * canlock.el: Remove sha1.el and base64.el stuff.
+
+2001-11-26 Didier Verna <didier@xemacs.org>
+
+ * nnmbox.el (nnmbox-create-mbox): create the mbox file directory
+ if needed.
+
+2001-11-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-tamago-not-in-use-p): New function.
+ (message-strip-forbidden-properties): Use it.
+
+2001-11-26 Didier Verna <didier@xemacs.org>
+
+ * gnus-start.el (gnus-check-first-time-used): only check for
+ existence of .el[d] files.
+
+2001-11-25 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-coding-system-priorities): Add backslash in the doc.
+
+ * message.el (message-setup-1): Clean up mc-*.
+
+2001-11-25 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-directory-sep-char-regexp): New variable.
+ * gnus-score.el (gnus-score-find-bnews): Use it.
+
+ * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version.
+ (gnus-summary-limit-to-author): Ditto.
+ (gnus-summary-limit-to-extra): Ditto.
+ (gnus-summary-find-matching): Support not-matching argument.
+
+2001-11-25 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-wash-subject): Use `insert' rather than
+ `insert-string', which is deprecated.
+
+2001-11-24 Simon Josefsson <jas@extundo.com>
+
+ * mm-encode.el (mm-encode-content-transfer-encoding): Fix error
+ message. (Gnus does not "default" to using 8bit for the message,
+ it default to use 8bit encoding and the user-supplied CTE
+ value. Calling this behaviour "treating it as 8bit" is perhaps
+ better.)
+
+ * mm-bodies.el (mm-body-encoding): Intern encoding if needed
+ (compare mm-charset-to-coding-system).
+
+2001-11-23 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * canlock.el (canlock-sha1-with-openssl): Use unibyte
+ buffer. Correctly decode hex.
+
+2001-11-21 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-category-insert-line): Convert category
+ names to strings.
+
+2001-11-20 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (sha1): eval-and-compile.
+
+2001-11-20 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-allow-no-recipients): New variable.
+ (message-send): Use it, customize the prompting when posting to
+ Gcc/Fcc alone. From prj@po.cwru.edu (Paul Jarc).
+
+2001-11-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-coding-system-priorities): New variable.
+ (mm-sort-coding-systems-predicate): New function.
+ (mm-find-mime-charset-region): Resort coding systems if needed.
+ Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
+
+2001-11-20 Didier Verna <didier@xemacs.org>
+
+ * gnus-group.el (gnus-group-make-help-group): new optional
+ argument to control the error behavior.
+ * gnus-start.el (gnus-check-first-time-used): use it to avoid
+ erroring.
+
+2001-11-19 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-mode-map): Use C-c C-f C-i for Importance:
+ instead of C-c C-u. Suggested by Per Abrahamsen
+ <abraham@dina.kvl.dk>.
+
+2001-11-18 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-read-folder): Use group instead of
+ nnfolder-current-group.
+ Suggested by Lorentey Karoly <lorentey@elte.hu>.
+
+2001-11-17 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-send): Ask user if Fcc/Gcc should be
+ performed when no other sender was specified.
+ Suggested by prj@po.cwru.edu (Paul Jarc).
+
+2001-11-17 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-mode, message-mode-map): Use C-c C-u for
+ Importance: instead of C-c C-p (used by SC).
+
+2001-11-16 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-insert-importance-high)
+ (message-insert-importance-low): Save point.
+
+ * mail-source.el (mail-source-fetch-imap): Fix BODY.PEEK return
+ value.
+
+2001-11-16 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-strip-special-text-properties): New option.
+ (message-strip-forbidden-properties): Obey it.
+
+2001-11-14 Sam Steingold <sds@gnu.org>
+
+ * gnus-score.el: Fixed some doc strings to properly quote symbols.
+
+2001-11-15 Simon Josefsson <jas@extundo.com>
+
+ Support "Importance:" header in Message.
+
+ * message.el (message-mode-map): Bind C-c C-p to
+ `message-insert-or-toggle-importance'
+ (message-mode-menu): Add message-insert-importance-{high,low}.
+ (message-insert-importance-high, message-insert-importance-low)
+ (message-insert-or-toggle-importance): New functions.
+ (message-tool-bar-map): Add {un,}important.
+ (message-mode): Doc fix.
+
+2001-11-15 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-tool-bar-map): Fix attach toolbar tooltip.
+
+ * mml.el (mml-menu): Fix toolbar tooltip.
+
+2001-11-15 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-save-marks): gnus-prin1 takes one argument.
+ * nnml.el (nnml-save-marks): Ditto.
+
+ * gnus-sum.el (gnus-newsgroup-variables): Fix doc.
+
+2001-11-15 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-save-marks):
+ * nnfolder.el (nnfolder-save-marks): Use `gnus-prin1'.
+ Suggested by Istvan Marko <mi-gnus@imarko.dhs.org>.
+
+2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-art.el (gnus-article-wash-status-strings): Use
+ `copy-sequence', not `copy-seq'.
+
+2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-art.el (gnus-article-wash-status-strings): New constant.
+ (gnus-gnus-article-wash-status-entry): New function.
+ (gnus-article-wash-status): Use it.
+
+2001-11-13 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml1991.el: Add coding header.
+
+2001-11-12 Simon Josefsson <jas@extundo.com>
+
+ * mml1991.el (mml1991-use, mml1991-function-alist): New variables.
+ (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from
+ `mml1991-sign' and `mml1991-encrypt'.
+ (mml1991-encrypt, mml1991-sign): New glue functions.
+ (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions.
+
+ * mml.el (mml-mode-map): `C-c RET o' map for PGP.
+ (mml-menu): Add PGP to menu.
+
+ * mml-sec.el (top-level): Require mml1991. Don't require smime.
+ (mml-sign-alist, mml-encrypt-alist): Add "pgp".
+ (mml-pgp-sign-buffer, mml-pgp-encrypt-buffer)
+ (mml-secure-sign-pgp, mml-secure-encrypt-pgp): New glue functions.
+
+ * mml2015.el: Mention RFC 3156.
+
+ * mml1991.el: New file. From Sascha L,A|(Bdecke <sascha@meta-x.de>.
+
+2001-11-12 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-auto-subscribed-groups): Use ^nnml.
+
+ * gnus-sum.el (gnus-summary-move-article): Use number-to-string.
+ From <Michael.Cook@cisco.com>
+
+2001-11-11 Simon Josefsson <jas@extundo.com>
+
+ * message.el (top-level): Autoload sha1.
+ (message-canlock-generate): Use sha1 instead of md5 (sha1 used by
+ canlock, no need to require two different hash algs). Suggested
+ by Ferenc Wagner <wferi@bolyai1.elte.hu>.
+
+2001-11-09 Simon Josefsson <jas@extundo.com>
+
+ * gnus.el (gnus-local-domain): Fix doc. From Pavel Jan,Am(Bk
+ <Pavel@Janik.cz>.
+
+2001-11-09 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-point-in-header-p): New function.
+ (message-do-auto-fill): Use it.
+ (message-beginning-of-line): New function. Goes to beginning of
+ header value (i.e., end of header name), or to beginning of line
+ if already at beginning of value. Behaves like
+ `beginning-of-line' when in message body.
+ (message-mode-map): Bind it.
+
+2001-11-08 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (gnus-posting-styles): Add doc.
+
+2001-11-07 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sieve.el (gnus-sieve-generate): Don't invoke sieve-mode.
+
+ * sieve-mode.el (sieve-control-commands-face)
+ (sieve-control-commands-face, sieve-action-commands-face)
+ (sieve-test-commands-face, sieve-tagged-arguments-face): New
+ faces.
+ (sieve-font-lock-keywords): Use them.
+ (sieve-mode): Only set font-lock-defaults in emacs.
+
+ * gnus-art.el (gnus-default-article-saver): Add
+ gnus-summary-save-body-in-file.
+ (gnus-summary-write-to-file): Fix doc.
+
+2001-11-07 Simon Josefsson <jas@extundo.com>
+
+ * gnus-art.el (gnus-treat-highlight-signature): Add cross
+ reference to the correct chapter in the manual.
+
+ * mml.el (mml-mode): Add cross reference to Emacs MIME manual.
+ Suggested by "Golubev I. N." <gin@mo.msk.ru>.
+
+2001-11-07 06:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-preview): Bind mail-header-separator.
+
+2001-11-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el: Always require canlock.
+ (message-ignored-supersedes-headers): Include Cancel-Lock and
+ Cancel-Key.
+ (message-insert-canlock): Don't require canlock.
+ (message-cancel-news): Don't check whether canlock is available.
+ (message-supersede): Support cancel-locks.
+
+ * gnus-art.el: Don't autoload canlock.
+
+2001-11-06 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mail-source.el (mail-source-fetch-imap): ASYNC param.
+ From: <andre@slamdunknetworks.com>
+
+2001-11-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * many files: Fix copyright lines.
+
+2001-11-05 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-generate-mime-1): Use mm-with-unibyte-current-buffer.
+ Suggested by Dave Love <fx@gnu.org>.
+
+2001-11-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-kill-buffer): Remove auto-save file after
+ confirm.
+
+ * message.el (message-send-mail): Call message-generate-headers
+ once. Suggested by Matt Armstrong <matt@lickey.com>.
+
+ * gnus-topic.el (gnus-topic-rename): Initial-input.
+ Suggested by Katsuhiro Hermit Endo <hermit@koka-in.org>.
+
+2001-11-03 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-forbidden-properties): New constant.
+ (message-strip-forbidden-properties): New function.
+ (message-mode): Activate it.
+
+2001-11-02 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-iso-8859-15-compatible): Fix doc.
+ (mm-hack-charsets): Fix doc.
+
+2001-11-02 Simon Josefsson <jas@extundo.com>
+
+ * gnus-int.el (gnus-check-server): Message "...done" when done.
+
+ * imap.el (imap-close): Don't message (imap-send-command-wait
+ returns if the connection is dropped).
+ (imap-wait-for-tag): Nix out message only when necessary.
+
+ * gnus-sieve.el (gnus-sieve-script): Use "stop" instead of "elsif"
+ for non-crossposting.
+ (gnus-sieve-crosspost): Default to t to be consistent with other
+ parts of Gnus.
+
+2001-11-01 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-iso-8859-15-compatible): Add inconvertible chars.
+ (mm-iso-8859-x-to-15-table): Ditto.
+ (mm-iso-8859-x-to-15-region): Ditto.
+ (mm-find-mime-charset-region): Ditto.
+
+2001-11-01 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-close-asynchronous): New variable.
+ (nnimap-close-group): Use it.
+ (nnimap-expunge): Don't use it.
+
+ * imap.el (imap-callbacks): New variable.
+ (imap-remassoc): Copied from `gnus-remassoc'.
+ (imap-add-callback): New function.
+ (imap-mailbox-expunge, imap-mailbox-close): Support asynchronous
+ behaviour.
+ (imap-parse-response): Call the callback.
+
+ * message.el (message-insert-canlock): New variable.
+ (message-canlock-generate, message-canlock-password)
+ (message-insert-canlock): New functions.
+ (message-send-news): Call `message-insert-canlock'.
+ (top-level): Require canlock when compiling.
+ (message-insert-canlock): Require canlock before we need it.
+
+2001-11-01 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-copy-article-buffer): Copy sequence.
+
+2001-11-01 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (dgnushack-make-load): A workaround for
+ custom-add-loads bug in some versions of XEmacs.
+
+2001-11-01 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-charset-synonym-alist): Revert (some).
+
+2001-11-01 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-iso-8859-x-to-15-region): New function.
+ (mm-hack-charsets): New variable.
+ (mm-iso-8859-15-compatible): New variable.
+ (mm-iso-8859-x-to-15-table): New variable.
+ (mm-find-mime-charset-region): Add parameter hack-charsets.
+
+ * mm-bodies.el (mm-encode-body): Use it.
+ * mml.el (mml-parse-1): Ditto.
+
+2001-11-01 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-make-menu-bar): Add Sieve.
+
+2001-11-01 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-charset-to-coding-system): Return nil, if charset
+ is nil.
+
+2001-11-01 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * smiley-ems.el (smiley-update-cache): Auto detect file type.
+
+ * message.el (message-forward-rmail-make-body): Use
+ save-window-excursion.
+ (message-encode-message-body): Search with noerror.
+ (message-setup-1): Convert compose-mail send-actions to
+ message-send-actions.
+
+2001-11-01 Simon Josefsson <jas@extundo.com>
+
+ * sieve.el: Don't require easy-mmode. Suggested by Katsumi Yamaoka
+ <yamaoka@jpl.org>.
+
+2001-10-31 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * sieve-manage.el (sieve-string-bytes): No complain.
+
+2001-11-01 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-mode-map): Bind "D u" to
+ `gnus-sieve-update' and "D g" to `gnus-sieve-generate'. (Functions
+ has autoload cookies, so no `require' should be necessary.)
+
+ * sieve.el, sieve-mode.el, sieve-manage.el, gnus-sieve.el: New
+ files.
+
+2001-10-31 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cus.el (gnus-group-parameters): Support integer `display'
+ parameter.
+
+ * gnus-sum.el (gnus-select-newsgroup): If group parameter
+ `display' is a number (and C-u wasn't used to enter group), only
+ fetch that number of articles.
+
+2001-10-31 Matt Armstrong <matt@lickey.com>
+
+ * gnus.el (gnus-find-subscribed-addresses): Doc fix:
+ not-subscribed -> subscribed.
+
+2001-10-31 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From: Josh Huber <huber@alum.wpi.edu>
+
+ * message.el (message-subscribed-address-functions): New variable.
+ (message-subscribed-addresses): New variable.
+ (message-subscribed-regexps): New variable.
+ (message-goto-mail-followup-to): New function.
+ (message-send-mail): Add Mail-Followup-To.
+ (message-make-mft): New function.
+
+ * gnus.el (gnus-find-subscribed-addresses): New function.
+
+2001-10-31 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mail-source.el (mail-source-fetch): If debug, don't regain signals.
+ (mail-source-fetch-pop): Ditto.
+ (mail-source-check-pop): Ditto.
+
+ * gnus-start.el (gnus-read-init-file): Ditto.
+ (gnus-activate-group): Ditto.
+ (gnus-read-newsrc-el-file): Ditto.
+
+2001-10-30 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-get-reply-headers): Make sure there is ", ".
+
+ * mm-util.el (mm-mime-mule-charset-alist): Move down and call
+ mm-coding-system-p. Don't correct it only in XEmacs.
+ (mm-charset-to-coding-system): Use mm-coding-system-p and
+ mm-get-coding-system-list.
+ (mm-emacs-mule, mm-mule4-p): New variables.
+ (mm-enable-multibyte, mm-disable-multibyte,
+ mm-enable-multibyte-mule4, mm-disable-multibyte-mule4,
+ mm-with-unibyte-current-buffer,
+ mm-with-unibyte-current-buffer-mule4): Use them.
+ (mm-find-mime-charset-region): Treat iso-2022-jp.
+
+ From Dave Love <fx@gnu.org>:
+
+ * mm-util.el (mm-mime-mule-charset-alist): Make it correct by
+ construction.
+ (mm-charset-synonym-alist): Remove windows-125[02]. Make other
+ entries conditional on not having a coding system defined for
+ them.
+ (mm-mule-charset-to-mime-charset): Use
+ find-coding-systems-for-charsets if defined.
+ (mm-charset-to-coding-system): Don't use
+ mm-get-coding-system-list. Look in mm-charset-synonym-alist
+ later. Add last resort search of coding systems.
+ (mm-enable-multibyte-mule4, mm-disable-multibyte-mule4)
+ (mm-with-unibyte-current-buffer-mule4): Just treat Mule 5 like
+ Mule 4.
+ (mm-find-mime-charset-region): Re-write.
+ (mm-with-unibyte-current-buffer): Restore buffer as well as
+ multibyteness.
+
+2001-10-30 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * canlock.el, sha1-el.el, hex-util.el: Move from contrib
+ directory. Thanks to Katsumi Yamaoka <yamaoka@jpl.org> and Shuhei
+ KOBAYASHI <shuhei@aqua.ocn.ne.jp>.
+
+2001-10-30 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-display-x-face): Nix buffer-read-only
+ again.
+
+ * mml2015.el (mml2015-gpg-verify): Convert <LF> to <CR><LF>.
+
+2001-10-30 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-spec.el (gnus-parse-simple-format): Use
+ buffer-substring-no-properties.
+
+2001-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-verify-cancel-lock): New function.
+
+ * nnheader.el (nntp-process-response): New variable.
+ (nnheader-init-server-buffer): Make `nntp-process-response'
+ buffer-local in `nntp-server-buffer'.
+
+ * nntp.el (nntp-prepare-post-hook): New hook.
+ (nntp-wait-for): Save a server's ID in `nntp-process-response'.
+ (nntp-async-trigger): Ditto.
+ (nntp-request-post): Insert a server's ID if there's no Message-ID
+ header; run `nntp-prepare-post-hook'.
+
+2001-10-30 04:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-decode-group-name): Use nnmail-fetch-field
+ instead.
+
+ * message.el (message-forward-subject-author-subject): Don't use
+ message-news-p, which widens the buffer.
+ (message-forward-make-body): New function.
+ (message-forward): Use it.
+ (message-insinuate-rmail): New function.
+ (message-forward-rmail-make-body): New function.
+
+2001-10-30 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-extern.el (mm-extern): Provide it.
+
+ * mm-partial.el (mm-partial): Provide it.
+
+2001-10-28 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-setup-message): Call post-command-hook.
+
+2001-10-29 Simon Josefsson <jas@extundo.com>
+
+ * mml.el (mml-preview): Bind message-this-is-news if it is
+ news. From Jesper Harder <harder@myrealbox.com>.
+
+2001-10-28 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-group-make-articles-read): Inline group.
+
+2001-10-29 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * smiley-ems.el (smiley-regexp-alist): Add support for sad and
+ ironic smilies.
+
+2001-10-27 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-indent-citation): Don't add trailing
+ whitespace when citing text.
+
+ * gnus.el (gnus-group-faq-directory): Fix. From Jesper Harder
+ <harder@ifa.au.dk>.
+
+2001-10-26 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnweb.el (nnweb-possibly-change-server): Create nnweb-hashtb if
+ not available.
+ (nnweb-request-scan): Nix nnweb-hashtb if ephemeral.
+ (nnweb-type-definition): Add google as alias of dejanews.
+ (nnweb-google-parse-1): Forward 1 line.
+
+2001-10-26 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-msg.el (gnus-summary-mail-forward): Doc fix: add pointer to
+ variable `message-forward-ignored-headers'.
+
+2001-10-24 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-expand-group-parameter): New function.
+ (gnus-expand-group-parameters): Call it.
+ (gnus-group-fast-parameter): New function.
+ (gnus-group-find-parameter): Call it.
+
+2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-news-group-p): Rewrote. Now accepts a header
+ vector (it didn't before because of a bug).
+ * gnus-msg.el (gnus-post-news): Use header vector directly, if
+ available. Before it converted it to an article number.
+
+ This makes followup to news articles with negative numbers in
+ nnvirtual groups use news instead of mail.
+
+2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (post-method): Use `native' instead of `nil'.
+
+ * gnus-msg.el (gnus-post-method): Ditto.
+
+2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-define-group-parameter): Grammar fix.
+
+2001-10-22 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (gnus-extended-version): Include
+ system-configuration.
+ Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann).
+
+2001-10-22 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (post-method): Customization fix: `native' is not a
+ valid value.
+ * gnus-msg.el (gnus-post-method): Doc and customization fix:
+ `native' is not a valid value.
+
+2001-10-21 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap): Defgroup
+ (nnimap-strict-function, nnimap-strict-function-match): New
+ widget, from Per Abrahamsen <abraham@dina.kvl.dk>.
+ (nnimap-split-crosspost, nnimap-split-inbox)
+ (nnimap-split-rule, nnimap-split-predicate)
+ (nnimap-split-predicate): Defcustom.
+ (nnimap-split-inbox, nnimap-expunge-search-string)
+ (nnimap-importantize-dormant): Remove "*" from doc.
+
+2001-10-20 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-summary-limit-to-score): Prompt for score if
+ not supplied via prefix arg. From Lisp, make arg mandatory.
+ Suggested by Frank Schmitt.
+
+2001-10-20 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-do-auto-fill): Avoid calling
+ 'rfc822-goto-eoh'.
+
+2001-10-20 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Paul Jarc <prj@po.cwru.edu>.
+
+ * message.el (message-get-reply-headers): Restructure the logic
+ and add comments. From Paul Jarc <prj@po.cwru.edu>.
+
+2001-10-20 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-cancel-news): Support cancel-locks.
+ Suggested by Per Abrahamsson.
+
+ * nnml.el (nnml-marks-changed-p): Use `equal' when comparing
+ conses. From David Z Maze <dmaze@MIT.EDU>.
+
+ * nnfolder.el (nnfolder-marks-changed-p): Ditto.
+
+2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * mm-decode.el (mm-default-directory): Fix customize type.
+
+ * message.el (message-setup-fill-variables): Kludge to use
+ normal-auto-fill-function even if auto fill is already activated.
+
+2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-do-auto-fill): New version that does not
+ rely on text properties, by Simon Josefsson <jas@extundo.com>.
+ (message-setup-1): Removed the `message-field' property.
+
+ * gnus-draft.el (gnus-draft-edit-message): Removed the
+ `message-field' property.
+
+2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-draft.el (gnus-draft-edit-message): Change `field' to
+ `message-field'. The `field' property has a special significance in
+ Emacs 21.
+
+ * message.el (message-send, message-setup-1): Ditto.
+
+2001-10-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-group-make-articles-read): Call g-r-set-mark
+ when undoing.
+
+2001-10-18 Simon Josefsson <jas@extundo.com>
+ From Frank Schmitt <usereplyto@Frank-Schmitt.net>
+
+ * gnus-sum.el (gnus-summary-limit-to-display-predicate): Fix typo.
+ (gnus-summary-make-menu-bar): Ditto.
+
+2001-10-17 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): Make sure it is back to the
+ server. Suggested by ShengHuo ZHU <zsh@cs.rochester.edu>.
+
+2001-10-17 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-line-format-alist): user-date entry.
+ * gnus-util.el (gnus-user-date): New function.
+ From Frank Schmitt <usenet@Frank-Schmitt.net>.
+
+2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-check-news-header-syntax): Special case
+ nnvirtual groups.
+
+ * gnus-sum.el (gnus-summary-respool-default-method): Changed
+ customize type to `symbol'.
+
+2001-10-17 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-spec.el (gnus-parse-simple-format): Support extended spec
+ %&foo;.
+ (gnus-parse-simple-format): Support user extended spec too.
+ %u&foo; invokes gnus-user-format-function-foo.
+
+2001-10-17 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnml.el (nnml-request-expire-articles): Make sure it is back to
+ the server.
+ * nnmbox.el (nnmbox-request-expire-articles): Ditto.
+ * nnfolder.el (nnfolder-request-expire-articles): Ditto.
+ * nnbabyl.el (nnbabyl-request-expire-articles): Ditto.
+ * nndiary.el (nndiary-request-expire-articles): Ditto.
+ (nndiary-schedule): Defsubst it before use it.
+ (nndiary-error): eval-and-compile.
+
+2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-msg.el (gnus-post-method): Changed two instances of
+ `active' to `current' and one `null' to `not'.
+
+2001-10-16 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Katsumi Yamaoka <yamaoka@jpl.org>.
+
+ * message.el (message-setup-fill-variables): Use
+ `normal-auto-fill-function' instead of `auto-fill-function'.
+
+2001-10-16 Simon Josefsson <jas@extundo.com>
+
+ * mml2015.el (mml2015-fix-micalg): Fix for Mutt-bug.
+ (mml2015-gpg-decrypt-1): Decanonicalize decrypted MIME
+ body. (Mailcrypt seem to do this, but gpg.el doesn't.)
+
+2001-10-16 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ Patch by Oliver Scholz <oscholz@my.gnus.org>.
+
+ * gnus-draft.el (gnus-draft-edit-message): Add text property
+ `field' with value `header' to message headers.
+ * message.el (message-setup-1): Really add text property to all of
+ the header, not just part of it.
+
+2001-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-sort-by-server): Use it.
+
+ * gnus.el (gnus-method-to-full-server-name): New, bogus function.
+
+ * gnus-topic.el (gnus-topic-sort-groups-by-server): New command
+ and keystroke.
+
+2001-10-14 Simon Josefsson <jas@extundo.com>
+
+ * dig.el: Doc fix.
+
+ * smime.el: Doc fix.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Port header encoded-word
+ charset magic from message.el.
+
+2001-10-12 Simon Josefsson <jas@extundo.com>
+ Suggested by david.goldberg6@verizon.net (David S. Goldberg)
+
+ * gnus-cite.el (gnus-article-toggle-cited-text): Don't remove
+ 'cite from g-a-wash-types.
+ (gnus-cite-toggle): Ditto. Add 'cite. Set modeline.
+ (gnus-article-hide-citation): Fix.
+
+ * gnus-cite.el (gnus-article-hide-citation): Add `c' mode line
+ character.
+ (gnus-article-toggle-cited-text): Toggle `c' mode line character.
+
+ * gnus-art.el (gnus-treat-hide-citation-maybe): Remove duplicate
+ definition.
+ (gnus-signature-toggle): Toggle `s' mode line character.
+
+ * gnus-art.el (article-emphasize): Set `g-a-wash-types' after
+ doing stuff that clears it.
+
+2001-10-12 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cache.el (gnus-summary-limit-include-cached): Rewrite.
+ From Eric Marsden <emarsden@laas.fr>.
+
+2001-10-12 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-do-auto-fill): Use gnus-point-at-bol.
+ (autoload): Add some autoloads.
+
+2001-10-12 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ Suggested by Oliver Scholz <epameinondas@gmx.de>.
+
+ * message.el (message-do-auto-fill): New function. Like
+ `do-auto-fill' but don't fill when in the message header.
+ (message-setup-1): Put a text property on the message header.
+ (message-setup-fill-variables): Use `message-do-auto-fill'.
+
+2001-10-10 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-send-mail-partially): Insert an empty line
+ first, because of the change of message-make-lines.
+
+2001-10-10 Florian Weimer <fw@deneb.enyo.de>
+
+ * mm-util.el (mm-charset-synonym-alist): If Emacs doesn't support
+ iso-8859-15, make it an alias for iso-8859-1.
+
+2001-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-send-news): Don't modify the value of
+ `message-syntax-checks' if it is not a list (possibly it is
+ `dont-check-for-anything-just-trust-me').
+
+2001-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-group.el (gnus-group-name-charset-group-alist): Use
+ `find-coding-system' for XEmacs to check whether the coding-system
+ `utf-8' is available.
+
+2001-10-09 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (dgnushack-compile): Detect mh-e and xml.
+
+2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-send-news): Oops, missed case with no
+ "Followup-To" header...
+
+2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-send-news): Allow
+ `gnus-group-name-charset-group-alist' to affect encoding of the
+ "Newsgroups" and "Followup-To" headers.
+
+2001-10-07 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * Makefile.in (install-el): Depend on gnus-load.el.
+
+2001-10-07 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * Makefile.in (install-el): Use -f.
+ From: Amos Gouaux <amos+lists.ding@utdallas.edu>
+
+2001-10-07 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-send-news): Don't encode Followups-To when
+ `gnus-group-name-charset-group-alist is' ".*". [Yuck]
+
+ * gnus-util.el (gnus-decode-newsgroups): No space in newsgroup
+ header.
+
+ * gnus-art.el (article-decode-group-name): Also decode
+ "Followup-To".
+
+ * rfc2047.el (rfc2047-encode-message-header): Encode without
+ asking for null methods.
+
+ * gnus-group.el (gnus-group-name-charset-group-alist): Make utf-8
+ default charset for newsgroup names in accordance with USEFOR.
+
+ * gnus-group.el (gnus-group-name-charset-method-alist,
+ gnus-group-name-charset-group-alist): Removed "*" from doc
+ strings, "*" should not be used for complex variables.
+
+2001-10-06 Simon Josefsson <jas@extundo.com>
+
+ Support UTF-8 group names better.
+
+ * message.el (message-check-news-header-syntax): Encode group
+ names before comparison.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Run all
+ `gnus-article-decode-hook's except `article-decode-charset'
+ instead of hardcoding call to one of them.
+
+ * gnus-art.el (gnus-article-decode-hook): Add
+ `article-decode-group-name'.
+ (article-decode-group-name): New function, use `g-d-n'.
+
+ * gnus-group.el (gnus-group-insert-group-line): Decode
+ gnus-tmp-group using `g-d-n'.
+
+ * gnus-util.el (gnus-decode-newsgroups): New function.
+
+2001-10-06 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Fixed bug non-nil
+ `gnus-group-name-charset-group-alist'.
+
+2001-10-06 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * Makefile.in: Install el in install. Add uninstall.
+
+2001-10-05 Simon Josefsson <jas@extundo.com>
+
+ * nnheader.el (gnus-verbose-backends, gnus-nov-is-evil): Custom.
+
+ * gnus-sum.el (gnus-summary-move-article): Also activate new groups.
+
+ * nnfolder.el (nnfolder-normalize-buffer): Don't insert \n\n in
+ empty folders.
+
+ * gnus-sum.el (gnus-select-newsgroup): Don't enable `display'
+ limiting if read-all (C-u RET) was used.
+
+2001-10-04 Simon Josefsson <jas@extundo.com>
+
+ * mail-source.el (mail-source-movemail-program): New variable.
+ (mail-source-movemail): Use it. Suggested by Taylor Hutt
+ <thutt@thutt.vmware.com>.
+
+2001-10-03 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): New param.
+ (gnus-summary-line-format-alist): Fix param.
+
+2001-10-02 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-request-move-article): Use imap.el directly,
+ don't go through `nnimap-request-expire-articles' to delete the
+ article. Thanks to prj@po.cwru.edu (Paul Jarc).
+
+2001-10-02 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-write-active): The min in the
+ agent/active may be larger than that in the server/active.
+
+2001-10-01 Simon Josefsson <jas@extundo.com>
+
+ * mail-source.el (mail-source-fetch-imap): Use BODY.PEEK if server
+ is IMAP4rev1.
+
+ * nnml.el (gnus-article-unpropagatable-p): Autoload gnus-sum.
+
+ * nnfolder.el: Ditto.
+
+2001-09-30 Dan Christensen <jdc@uwo.ca>
+
+ * gnus-sum.el (gnus-summary-extract-address-component): New function.
+ (gnus-summary-from-or-to-or-newsgroups): Optimize.
+
+2001-09-29 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-mode-map): Keybinding for `gnus-delay-article'.
+ (message-mode-menu): Menu item for same.
+
+ * gnus-group.el (gnus-group-make-menu-bar): Menu item for sending
+ delayed articles.
+
+ * gnus-delay.el (gnus-delay-send-drafts): Do nothing if
+ nndraft:delayed does not exist.
+ (gnus-delay-initialize): Don't set up keymap, that's done from
+ message.el now.
+ (gnus-delay, gnus-delay-group, gnus-delay-header)
+ (gnus-delay-default-delay, gnus-delay-default-hour): Customize.
+
+2001-09-29 Simon Josefsson <jas@extundo.com>
+
+ * mm-util.el (mm-mime-mule-charset-alist): Encode mule-utf-8 as
+ utf-8, not eight-bit-control.
+
+ * imap.el (imap-shell-host, imap-default-user, imap-use-utf7)
+ (imap-log, imap-debug): Custom.
+ (imap-log-buffer, imap-debug-buffer): New constants.
+ (imap-kerberos4-open, imap-gssapi-open, imap-ssl-open)
+ (imap-network-open, imap-shell-open, imap-starttls-open)
+ (imap-send-command-1, imap-send-command, imap-arrival-filter)
+ (imap-debug): Use imap-*-buffer.
+
+ * nndoc.el (nndoc-article-type): Add mailman.
+ (nndoc-type-alist): Ditto.
+ (nndoc-mailman-type-p): New function.
+
+2001-09-28 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-article-x-face-command): Merge it into
+ gnus-art.el.
+
+2001-09-27 Simon Josefsson <jas@extundo.com>
+
+ * gnus-topic.el (gnus-topic-mode-map): Add catchup.
+ (gnus-topic-catchup-articles): New function. Suggested by Robin
+ S. Socha <robin-dated-1001857693.185e29@socha.net>.
+
+2001-09-27 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Gerd M,Av(Bllmann <gerd@gnu.org>.
+
+ * gnus-ems.el (gnus-article-display-xface): Insert xface after
+ previous ones.
+
+2001-09-27 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Daiki Ueno <ueno@unixuser.org>
+
+ * gnus-sum.el (gnus-summary-show-article): The arglist of
+ detect-coding-region is incompatible.
+
+2001-09-26 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Katsuhiro Hermit Endo <hermit@koka-in.org>
+
+ * gnus-group.el (gnus-group-delete-group): Typo.
+
+2001-09-26 Simon Josefsson <jas@extundo.com>
+
+ * nnmail.el (nnmail-expiry-target-group): Add doc warning.
+
+ * nnimap.el (nnimap-expiry-target): Use temp buffer.
+
+2001-09-26 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-cus.el (gnus-group-parameters): Display as sexp.
+
+2001-09-22 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-open-marks): Remove unpropagatable marks.
+
+ * nnfolder.el (nnfolder-open-marks): Ditto.
+
+ * gnus-sum.el (gnus-article-unpropagatable-p): New function.
+ (gnus-update-marks): Use it.
+ (gnus-update-marks): Use `gnus-article-mark-to-type' instead of
+ hardcoded list.
+
+ * gnus.el (gnus-article-special-mark-lists): Add killed.
+ (gnus-article-unpropagated-mark-lists): New constant.
+
+2001-09-22 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-mode-hook): Add gnus-pick-mode as
+ custom option.
+
+2001-09-23 Simon Josefsson <jas@extundo.com>
+
+ * gnus-draft.el (gnus-draft-setup): Add mark in backend as well.
+
+2001-09-23 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-button-mailto): Hack save-selected-window-window.
+
+2001-09-22 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-group.el (gnus-group-sort-function): Fix customize type to
+ accept lists of functions.
+
+2001-09-20 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-catchup): Update expire marks in
+ backend. Also, if ALL also set expire marks on tick/dormant.
+
+2001-09-20 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-tab-body-function): New variable.
+ * message.el (message-tab): Use it.
+
+2001-09-19 Sam Steingold <sds@gnu.org>
+
+ * gnus-win.el (gnus-buffer-configuration): Respect
+ `gnus-bug-create-help-buffer'.
+
+2001-09-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-spec.el (gnus-correct-pad-form): Re-revert.
+ (gnus-parse-simple-format): Re-revert.
+
+2001-09-16 Katsuhiro Hermit Endo <hermit@koka-in.org>
+ Trivial patch.
+
+ * gnus-spec.el (gnus-parse-complex-format): Don't fold search
+ case. (Thanks to Daiki Ueno <ueno@unixuser.org>.)
+
+2001-09-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-spec.el (gnus-correct-pad-form): Remove until papers are
+ signed.
+ (gnus-parse-simple-format): Don't use it.
+
+2001-09-17 Miles Bader <miles@gnu.org>
+
+ * gnus-srvr.el (gnus-server-insert-server-line): Don't let an
+ error querying a backend abort the whole process.
+
+2001-09-17 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-server-mode): Fix bogus fontification.
+ From Gerd M,Av(Bllmann <gerd@gnu.org>.
+
+2001-09-17 Didier Verna <didier@xemacs.org>
+
+ * nndiary.el: version 0.2-b14.
+ * gnus-diary.el (gnus-diary-check-message): fix `read-string'
+ compatibility problem with XEmacs 21.1.
+
+2001-09-15 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-line-format): Document %c.
+
+ * nnml.el (nnml-parse-head): Handle CRLF files.
+ (nnml-generate-nov-file): Ditto.
+ (nnml-retrieve-headers): Ditto.
+
+2001-09-15 Michael Welsh Duggan <md5i@cs.cmu.edu>
+
+ * gnus-spec.el (gnus-parse-format): Don't treat %c as %C.
+
+2001-09-13 Martin Kretzschmar <Martin.Kretzschmar@inf.tu-dresden.de>
+
+ * gnus-spec.el (gnus-correct-substring): Still stopped one
+ character before we wanted (never included last character).
+ (gnus-tilde-max-form, gnus-tilde-cut-form) Made readable again,
+ add missing "," (once per function)
+
+2001-09-14 Simon Josefsson <jas@extundo.com>
+
+ * gnus-start.el (gnus-group-mode-hook): Moved from gnus-group
+ (otherwise e.g. gnus-agentize in .gnus overrides the customized
+ default before gnus-group is loaded and the variable set.)
+
+ * nnimap.el (nnimap-request-set-mark): Do not store bookmark,
+ killed or unsent marks.
+
+ * gnus-draft.el (gnus-draft-setup): Don't set mark when there
+ isn't an article to set it on (e.g. when you `a' in a group).
+
+2001-09-12 Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * mm-util.el (mm-charset-synonym-alist): add windows-1250 so we
+ can read e-mails from Microsoft Outlook users not using ISO
+ 8859-2 character set.
+
+2001-09-12 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-diary.el: Minor modifications to avoid warnings.
+ (gnus-summary-misc-menu): defvar.
+ (gnus-diary-check-message): Use gnus-point-at-eol.
+ (gnus-diary-kill-entire-line): eval-and-compile.
+
+2001-09-12 Didier Verna <didier@xemacs.org>
+
+ * nndiary.el: new version (0.2-b13).
+ * nndiary.el (nndiary-mail-sources): doc update.
+ * nndiary.el (nndiary-split-methods): ditto.
+ * nndiary.el (nndiary-request-accept-article-hooks): New.
+ * nndiary.el (nndiary-request-accept-article): use it, check
+ message validity.
+ * nndiary.el (nndiary-get-new-mail): changed default to nil.
+ * nndiary.el (nndiary-schedule): fix bug (misplaced
+ condition-case): it didn't return nil on error.
+ * gnus-diary.el: new version.
+ * gnus-diary.el (gnus-diary-summary-line-format): removed %I.
+ * gnus-diary.el (gnus-diary-header-value-history): New.
+ * gnus-diary.el (gnus-diary-narrow-to-headers): New.
+ * gnus-diary.el (gnus-diary-add-header): New.
+ * gnus-diary.el (gnus-diary-check-message): New.
+ * gnus-diary.el (message-mode-map): bind the above to `C-c D c'.
+ * gnus-diary.el (gnus-article-edit-mode-map): ditto.
+
+2001-09-10 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Make
+ `gnus-current-select-method' buffer-local.
+
+ * gnus-art.el (gnus-request-article-this-buffer): Refer
+ `gnus-current-select-method' in the current summary buffer.
+
+2001-09-10 Simon Josefsson <jas@extundo.com>
+ From Daniel Pittman <daniel@rimspace.net>
+
+ * gnus-spec.el (gnus-correct-pad-form): Fix.
+
+2001-09-09 Simon Josefsson <jas@extundo.com>
+
+ * mm-decode.el (mm-inline-media-tests): Add
+ application/x-emacs-lisp.
+ (mm-attachment-override-types): Add
+ application/{x-,}pkcs7-signature.
+
+ * gnus-srvr.el (gnus-server-mode-hook, gnus-server-exit-hook)
+ (gnus-server-line-format, gnus-server-mode-line-format)
+ (gnus-server-browse-in-group-buffer): Customize.
+
+2001-09-08 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnml.el (nnml-marks-changed-p): Typo.
+ (nnml-save-marks, nnml-open-marks): Use gnus-sethash.
+ (nnml-marks-changed-p): Use gnus-gethash.
+ (nnml-marks-modtime): Use gnus-make-hashtable.
+
+ * nnfolder.el (nnfolder-marks-changed-p): Typo.
+ (nnfolder-request-expire-articles, nnfolder-save-marks)
+ (nnfolder-open-marks): Typo.
+ (nnfolder-save-marks, nnfolder-open-marks): Use gnus-sethash.
+ (nnfolder-marks-changed-p): Use gnus-gethash.
+ (nnfolder-marks-modtime): Use gnus-make-hashtable.
+
+2001-09-08 Simon Josefsson <jas@extundo.com>
+
+ * nnfolder.el (nnfolder-marks-modtime): New variable.
+ (nnfolder-marks-changed-p): New function.
+ (nnfolder-save-marks, nnfolder-open-marks): Save modtime.
+ (nnfolder-request-update-info): Don't update if marks didn't change.
+
+ * nnml.el (nnml-marks-modtime): New variable.
+ (nnml-marks-changed-p): New function.
+ (nnml-save-marks, nnml-open-marks): Save modtime.
+ (nnml-request-update-info): Don't update if marks didn't change.
+
+ * gnus-agent.el (gnus-agent-any-covered-gcc)
+ (gnus-agent-add-server, gnus-agent-remove-server): Use
+ gnus-agent-method-p.
+
+ * gnus-art.el (gnus-buttonized-mime-types): New variable.
+ (gnus-unbuttonized-mime-type-p): Use it.
+
+ * gnus-agent.el (gnus-agent-fetch-group): If online, actually
+ fetch group.
+
+2001-09-08 Simon Josefsson <jas@extundo.com>
+ From Daniel Pittman <daniel@rimspace.net>
+
+ * gnus-spec.el (gnus-correct-pad-form): New function.
+ (gnus-parse-simple-format): Use it.
+
+2001-09-07 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-group-sort-groups): Unmark all groups.
+ (gnus-group-sort-selected-groups): Ditto. Suggested by Harry
+ Putnam <reader@newsguy.com>.
+ (gnus-group-sort-selected-groups): Touch dribble file.
+
+2001-09-07 Raja R Harinath <harinath@cs.umn.edu>
+
+ * nnml.el (nnml-filenames-are-evil): New variable.
+ (nnml-article-to-file-alist): Rename to ...
+ (nnml-current-group-article-to-file-alist): ... this.
+ Respect `nnml-filenames-are-evil'.
+ (nnml-active-number): Update.
+ (nnml-update-file-alist): Update.
+ (nnml-request-article): Use nnheader-article-to-file-alist.
+ (nnml-request-rename-group): Likewise.
+
+2001-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-insert-line): Fix.
+
+2001-09-06 Bj,Av(Brn Torkelsson <torkel@acc.umu.se>
+
+ * gnus-sum.el: Bind g-s-t-s to "W g".
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add g-s-t-s.
+ * gnus-sum.el (gnus-summary-toggle-smiley): New function. Toggles
+ display of graphical smilies.
+
+2001-09-07 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-setup-news): A typo.
+ From Bill White <billw@wolfram.com>.
+
+2001-09-06 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-insert-line): Insert forwarded, recent
+ and unseen marks.
+
+2001-09-05 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-split-fancy): Document `junk'.
+
+2001-09-04 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-search): Don't error if server is broken.
+
+2001-09-02 Benjamin Rutt <brutt@bloomington.in.us>
+
+ * nnmbox.el (nnmbox-find-article): Fix infinite loop when
+ searching for an article that isn't in the mbox.
+
+2001-09-02 23:12:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnslashdot.el (nnslashdot-retrieve-headers-1): Get references
+ right, and get all the comments.
+
+2001-09-02 Simon Josefsson <jas@extundo.com>
+ Suggested by Dan Christensen <jdc+news@uwo.ca>
+
+ * nnfolder.el (nnfolder-request-update-info): Fix message.
+
+ * nnml.el (nnml-request-update-info): Ditto.
+
+2001-09-01 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-request-expire-articles): Also bind
+ `nnml-current-group' and `nnml-article-file-alist' when using
+ expiry-target. (Otherwise nnml will be in a inconsistent internal
+ state causing all kind of problems.)
+ (nnml-request-expire-articles): If `nnml-article-to-file' or
+ `file-attributes' failes, return article as un-expirable instead
+ of treating it as expired.
+
+2001-08-31 Sam Steingold <sds@gnu.org>
+
+ * imap.el (imap-mailbox-examine, imap-mailbox-examine-1): Fix a
+ typo: `exmine' --> `examine'.
+
+2001-08-30 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndoc.el (nndoc-forward-type-p): It is not a digest.
+
+2001-08-30 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnml.el (nnml-check-directory-twice): Remove.
+ (nnml-retrieve-headers): Ditto.
+ (nnml-article-to-file): Use nnheader-directory-files-is-safe.
+
+2001-08-30 Andrew Innes <andrewi@gnu.org>
+
+ * nnheader.el (nnheader-directory-files-is-safe): No need to read
+ directory twice on Windows, or on GNU Emacs-21.
+
+2001-08-30 Andrew Innes <andrewi@gnu.org>
+
+ * nnml.el (nnml-request-article): Use nnml-article-to-file-alist.
+ (nnml-request-rename-group): Ditto.
+ (nnml-active-number): Ditto.
+ (nnml-request-create-group): Use nnml-directory-articles.
+ (nnml-request-expire-articles): Use nnml-directory-articles, which
+ gets list from nov database if available.
+ (nnml-get-nov-buffer): New function.
+ (nnml-open-nov): Use it.
+ (nnml-update-file-alist): Use nnml-article-to-file-alist, which
+ gets alist from nov database if available.
+ (nnml-directory-articles): New function.
+ (nnml-article-to-file-alist): New function.
+
+2001-08-30 Andrew Innes <andrewi@gnu.org>
+
+ * mm-decode.el (mm-display-external): Use `name' as filename, if
+ `filename' attribute is not present.
+
+2001-08-30 Andrew Innes <andrewi@gnu.org>
+
+ * mail-source.el (mail-source-flash): New defcustom.
+ (mail-source-new-mail-p): Ring visible bell if appropriate.
+ (mail-source-start-idle-timer): Use unwind-protect to ensure idle
+ timer is cleared even if mail check signals an error.
+
+2001-08-29 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-move-article): Only update marks of
+ type 'list.
+
+2001-08-29 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * flow-fill.el (fill-flowed): eol might be point-max.
+
+2001-08-27 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-request-update-info): Fix message.
+ (nnml-open-marks): Ditto.
+
+ * nnfolder.el (nnfolder-request-update-info):
+ (nnfolder-open-marks): Fix message.
+
+2001-08-25 Simon Josefsson <jas@extundo.com>
+
+ * nnfolder.el (nnfolder-save-marks): Don't create directory named
+ after group in ~/.
+
+2001-08-25 Simon Josefsson <jas@extundo.com>
+ From Andreas Jaeger <aj@suse.de>
+
+ * nnfolder.el (nnfolder-open-marks): Fix typo.
+ * nnml.el (nnml-open-marks): Likewise.
+
+2001-08-25 Simon Josefsson <jas@extundo.com>
+
+ Make nnfolder groups self-contained as far as marks are concerned.
+
+ * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil)
+ (nnfolder-marks, nnfolder-marks-file-suffix): New variables.
+ (nnfolder-open-server): Make marks directory.
+ (nnfolder-request-delete-group): Delete marks file.
+ (nnfolder-request-delete-group): Check of nov/marks file exist
+ before deleting.
+ (nnfolder-request-rename-group): Rename marks file.
+ (nnfolder-request-rename-group): Only rename nov/mark if they exists.
+ (nnfolder-request-set-mark, nnfolder-request-update-info)
+ (nnfolder-group-marks-pathname, nnfolder-save-marks)
+ (nnfolder-open-marks): New functions.
+ (top-level): Require gnus.
+
+2001-08-25 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnweb.el (nnweb-type-definition): Use google raw file.
+ (nnweb-google-parse-1): Ditto.
+ (nnweb-google-identity): Ditto.
+ (nnweb-reference-wash-article): Move nnweb-decode-entities here.
+ (nnweb-altavista-wash-article): Ditto.
+ (nnweb-request-article): Remove nnweb-decode-entities.
+
+ * nnml.el: Require 'gnus.
+
+2001-08-25 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-marks-is-evil): Add doc.
+
+2001-08-25 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-save-marks): Wrap saving marks in a
+ condition-case, to allow user to start Gnus if saving marks failed
+ for some reason.
+
+2001-08-24 16:05:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-spec.el (gnus-compile): Don't compile gnus-version.
+
+ * gnus-group.el (gnus-update-group-mark-positions): Bind
+ gnus-group-update-hook to nil.
+
+2001-08-24 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-generate-mime-1): Force as multibyte string.
+
+2001-08-24 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-insert-line)
+ (gnus-summary-prepare-threads): gnus-tmp-lines should be a string.
+ From Martin Kretzschmar <Martin.Kretzschmar@inf.tu-dresden.de>
+
+ * gnus-spec.el (gnus-correct-substring): Take optional END.
+
+ * nnrss.el (nnrss-request-article): Remove \n.
+ (nnrss-retrieve-headers): Lines number is -1.
+
+2001-08-24 Simon Josefsson <jas@extundo.com>
+
+ * gnus-group.el (gnus-info-clear-data): Call
+ nnfoo-request-set-mark to propagate marks. Fix bug:
+ `gnus-group-update-line' doesn't update read range unless we call
+ `gnus-get-unread-articles-in-group' first.
+
+ * nnimap.el (nnimap-request-set-mark): Don't propagate seen flags
+ to server.
+
+2001-08-23 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-create-info-command): Return an interactive
+ function.
+
+2001-08-23 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-spec.el (gnus-parse-complex-format): Use equal.
+
+2001-08-23 18:43:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Use it.
+
+ * gnus-util.el (gnus-not-ignore): New function.
+
+ * lpath.el (featurep): Don't fbind char-int.
+
+ * gnus-util.el (gnus-create-info-command): New function.
+
+ * gnus-group.el (gnus-group-edit-group): Make C-c C-i go to the
+ right node.
+
+ * gnus-sum.el (gnus-select-newsgroup): Clean up.
+ (gnus-summary-limit-children): Use 'identity instead of `all'.
+ (gnus-summary-limit-to-display-predicate): New command and
+ keystroke.
+
+2001-08-23 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-group-alist): Use fm-releases.rdf.
+
+ * gnus-spec.el (gnus-format-specs): Miss a right parenthesis.
+
+2001-08-23 18:43:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-spec.el: Add the Gnus version.
+ (gnus-update-format-specifications): If the Gnus version changes,
+ nix out the format spec cache.
+
+ * gnus.el (gnus-continuum-version): Made into a command and
+ optionalize the VERSION.
+
+ * gnus-spec.el (gnus-parse-complex-format): Remove %C specs from
+ the start of the lines.
+
+2001-08-22 00:06:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-visual-p): Define function before use of
+ function.
+
+2001-08-21 23:28:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-adjust-marked-articles): Use new variable.
+ (gnus-article-mark-to-type): New function.
+ (gnus-update-missing-marks): Only update marks of type 'list.
+
+ * gnus.el (gnus-article-special-mark-lists): New variable.
+
+2001-08-21 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-limit-children): Check 'all.
+ (gnus-select-newsgroup): Still use 'all.
+ (gnus-summary-initial-limit): Comparing with 'all.
+
+2001-08-20 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-activate-group): If dont-check, don't update
+ active.
+
+2001-08-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace
+ nnslashdot-*-retrieve-headers.
+ (nnslashdot-request-article): Fix for slashcode 2.2.
+ (nnslashdot-make-tuple): New function.
+ (nnslashdot-read-groups): Use it.
+
+2001-08-20 01:34:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-expand-group-parameters): Don't alter the variable
+ list.
+
+ * gnus-sum.el (gnus-summary-move-article): Don't select article.
+
+2001-08-20 Simon Josefsson <jas@extundo.com>
+
+ * gnus-msg.el (gnus-inews-do-gcc): If archive server can't be
+ opened, error instead of continuing (and exploding later).
+
+2001-08-20 01:34:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-expand-group-parameters): Return the parameter
+ list.
+
+ * gnus-sum.el (gnus-summary-show-article): Doc fix.
+ (gnus-summary-show-article): Guess at charset if required.
+
+ * gnus-spec.el (gnus-correct-substring): Stopped one character
+ before we wanted.
+
+2001-08-19 Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * earcon.el (earcon-auto-play): Remove unused option.
+
+2001-08-19 16:14:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-score.el (gnus-score-headers): Move the "Scoring..."
+ message down in levels, since it happens very fast.
+
+ * smiley-ems.el (smiley-update-cache): Respect the symbol version
+ of smiley-regexp-alist.
+
+ * mm-view.el (mm-inline-text): Ignore vcard errors.
+
+ * gnus-art.el (gnus-ignored-headers): Added more junk headers.
+
+ * gnus-score.el (gnus-all-score-files): Use append instead of
+ nconc.
+
+ * gnus.el (gnus-splash-face): Doc fix.
+
+ * mm-decode.el (mm-mailcap-command): Use
+ mm-path-name-rewrite-functions.
+ (mm-path-name-rewrite-functions): New variable.
+
+ * gnus-spec.el (gnus-parse-complex-format): React to ?=.
+ (gnus-complex-form-to-spec): Insert tab.
+ (gnus-spec-tab): New function.
+
+ * gnus-sum.el (gnus-select-newsgroup): Set the marks before
+ entering the group.
+
+ * gnus-spec.el (gnus-complex-form-to-spec): Insert Lisp to match
+ the positional spec.
+ (gnus-parse-complex-format): React to %C.
+
+ * gnus-ems.el (gnus-char-width): Moved here.
+
+ * gnus-sum.el (gnus-select-newsgroup): Set
+ gnus-newsgroup-articles.
+ (gnus-unseen-mark): New variable.
+ (gnus-newsgroup-unseen): Ditto.
+ (gnus-newsgroup-seen): Ditto.
+ (gnus-adjust-marked-articles): Use them.
+ (gnus-update-marks): Use them.
+ (gnus-summary-update-secondary-mark): Display.
+ (gnus-summary-prepare-threads): Display.
+
+ * gnus-msg.el (gnus-inews-group-method): Use and return the
+ method, not the server.
+
+2001-08-19 Simon Josefsson <jas@extundo.com>
+
+ * gnus-srvr.el (gnus-server-agent-face): New.
+ (gnus-server-agent-face): New.
+ (gnus-server-mode): Turn on font-lock-mode.
+
+ * gnus.el (gnus-server-visual): Add defgroup.
+
+2001-08-19 Simon Josefsson <jas@extundo.com>
+ From Joe Casadonte <jcasadonte@northbound-train.com>
+
+ * gnus-srvr.el (gnus-server-opened-face, gnus-server-closed-face,
+ gnus-server-denied-face): New.
+ (gnus-server-opened-face, gnus-server-closed-face,
+ gnus-server-denied-face): New.
+ (gnus-server-font-lock-keywords): Add.
+
+2001-08-19 Simon Josefsson <jas@extundo.com>
+
+ * nnml.el (nnml-request-set-mark): Return nil.
+ (nnml-save-marks): Use nnml-possibly-create-directory.
+ (nnml-open-marks): Only work in temp buffer when inserting/reading
+ .marks file.
+
+2001-08-18 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-expand-group-parameters): Fix.
+
+ * gnus-spec.el (gnus-char-width): New function.
+ (gnus-correct-substring, gnus-correct-length): Use it.
+
+ * message.el (message-required-mail-headers): Fix doc.
+
+2001-08-18 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-group-make-articles-read): gnus-request-set-mark.
+
+ * mm-decode.el (mm-save-part-to-file): Insert the handle.
+
+2001-08-18 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-threaded-retrieve-headers):
+ slashdot 2.2 (not fully fixed yet).
+ (nnslashdot-request-article): Ditto.
+
+2001-08-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Moved from
+ nnimap.
+
+ * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Moved to
+ gnus-util.
+ (nnimap-request-update-info-internal): Use new functions.
+
+ * nnml.el (nnml-request-set-mark, nnml-request-update-info): Use
+ new functions.
+
+2001-08-18 Simon Josefsson <jas@extundo.com>
+
+ Make nnml groups self-contained as far as marks are concerned.
+
+ * nnml.el (nnml-request-delete-group): Delete marks file.
+ (nnml-request-rename-group): Move marks file.
+ (nnml-marks-file-name, nnml-marks-is-evil, nnml-marks): New server
+ variables.
+ (nnml-request-set-mark, nnml-request-update-info): New server
+ functions.
+ (nnml-save-marks, nnml-open-marks): New functions.
+
+2001-08-18 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-move-article): Use `add' instead of
+ `set' when setting marks.
+
+2001-08-17 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-info-find-node): Take an argument.
+
+ * gnus-art.el (gnus-button-handle-info): New function.
+ (gnus-url-unhex-string): Replace "+" with " ".
+
+2001-08-17 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-check-news-header-syntax): Check bad From.
+
+2001-08-18 00:14:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-spec.el (gnus-correct-length): New function.
+ (gnus-correct-substring): New function.
+ (gnus-tilde-max-form): Use it.
+
+2001-08-17 Nevin Kapur <nevin@jhu.edu>
+
+ * nnmh.el: Docstring changes as below.
+
+ * nnml.el: Docstring changes as below.
+
+ * nnbabyl.el: Docstring changes as below.
+
+ * nnmbox.el: Docstring changes as below.
+
+ * nnfolder.el: Added docstrings identifying each virtual server
+ parameter.
+
+2001-08-18 Simon Josefsson <jas@extundo.com>
+
+ * mml.el (mml-menu): Collapse Attach, Insert and Security submenu.
+
+2001-08-17 Bj,Av(Brn Torkelsson <torkel@acc.kth.se>
+
+ * message.el: rename "Abort Message" to "Postpone Message".
+ Remove "Attach file as MIME" from Message menu, it's already in
+ the MIME menu.
+
+2001-08-17 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * smime.el (smime-point-at-eol): eval-and-compile.
+ (smime-make-temp-file): New function.
+ (smime-sign-region, smime-encrypt-region, smime-decrypt-region):
+ Use it.
+
+2001-08-17 10:41:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-fetch-group): Go online if offline.
+ (gnus-agent-summary-fetch-group): New command and keystroke.
+
+ * gnus-art.el (gnus-insert-mime-button): Tiny clean-up.
+ (gnus-mime-display-security): Make it respect
+ gnus-unbuttonized-mime-type-p.
+
+ * gnus-sum.el (gnus-articles-to-read): Comments.
+ (gnus-article-marked-p): New function.
+ (gnus-summary-display-make-predicate): New function.
+ (gnus-select-newsgroup): Use them.
+
+ * mm-decode.el (mm-save-part-to-file): Made it not error.
+
+2001-08-17 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-wait-for-tag): If process-status isn't open or
+ run, return nil instead of sit-for looping.
+
+2001-08-17 10:41:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * lpath.el (featurep): fbind xml-parse-region.
+
+ * gnus.el (gnus-message-archive-method): Default to "archive".
+ (gnus-message-archive-method): Doc fix.
+ (gnus-parameters-get-parameter): Cleaned up.
+ (gnus-expand-group-parameter): New function.
+
+ * gnus-start.el (gnus-setup-news): Push the archive server only
+ the server list.
+
+ * mml.el (mml-menu): Changed name to "Attachments".
+
+ * mm-decode.el (mm-destroy-postponed-undisplay-list): Only message
+ when there is something to detroy.
+
+2001-05-21 17:11:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-server-browse-in-group-buffer): Default to
+ nil.
+
+2001-08-15 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-article): Allow "01:23" time spec,
+ which specifies a time today or tomorrow.
+
+2001-08-15 Simon Josefsson <jas@extundo.com>
+ From Pavel@Janik.cz (Pavel Jan,Am(Bk)
+
+ * gnus-agent.el (gnus-agent-make-mode-line-string)
+ (gnus-agent-toggle-plugged): Use new API.
+
+2001-08-14 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-send-drafts): Fix check whether
+ deadline has expired.
+
+2001-08-12 Simon Josefsson <jas@extundo.com>
+ Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE
+
+ Support `recent' mark indicating newly arrived messages (to
+ separate from old but unread messages).
+
+ * nnimap.el (nnimap-retrieve-groups): Push dummy article into
+ `nnmail-split-history' if recent is > 0.
+ (nnimap-request-update-info-internal): Update `recent' marks.
+ (nnimap-request-set-mark): Never set `recent' marks.
+ (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): Add
+ recent.
+
+ * gnus-sum.el (gnus-recent-mark): New mark.
+ (gnus-newsgroup-recent): New variable.
+ (gnus-summary-local-variables): Add gnus-newsgroup-recent.
+ (gnus-summary-prepare-threads): Mark recent articles.
+ (gnus-summary-add-mark): Support recent.
+ (gnus-summary-update-secondary-mark): Support recent.
+
+ * gnus.el (gnus-article-mark-lists): Add recent.
+
+2001-08-12 Simon Josefsson <jas@extundo.com>
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Returns
+ whether successful decoding took place. Add doc.
+
+2001-08-12 Simon Josefsson <jas@extundo.com>
+ Suggested by Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-summary-line-format, gnus-parameters):
+ * gnus-gl.el (gnus-summary-grouplens-line-format):
+ * gnus-salt.el (gnus-summary-pick-line-format):
+ * gnus-spec.el (gnus-format-specs): %n is 23 chars.
+
+2001-08-11 09:40:00 Karl Kleinpaste <karl@charcoal.com>
+ Committed by Kai Gro,b_(Bjohann.
+
+ * gnus-score.el (gnus-score-string): Fix `match' regexp
+ for `extra' header case.
+
+2001-08-10 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmbox.el (nnmbox-read-mbox): No warning.
+
+2001-08-10 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndoc.el (nndoc-article-type): Fix doc.
+ (nndoc-generate-article-function): New variable.
+ (nndoc-dissection-function): New variable.
+ (nndoc-type-alist): Add oe-dbx.
+ (nndoc-oe-dbx-type-p): New function.
+ (nndoc-oe-dbx-dissection): New function.
+ (nndoc-oe-dbx-generate-article): New function.
+
+2001-08-11 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-send-drafts): Cleaner way to check
+ whether deadline has been reached. Patch from Dan Nicolaescu
+ <dann@godzilla.ics.uci.edu>.
+
+2001-08-10 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ml.el (turn-on-gnus-mailing-list-mode): Use
+ gnus-group-find-parameter. Suggested by Janne Rinta-Manty
+ <rintaman@cs.Helsinki.FI>.
+
+ * mail-source.el (mail-source-movemail): The error buffer is
+ modified, but nothing in it.
+
+2001-08-10 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-bogus-system-names): New variable.
+ (message-make-fqdn): Use it.
+
+2001-08-09 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndraft.el (nndraft-request-group): Use
+ nndraft-auto-save-file-name.
+
+2001-08-09 Simon Josefsson <jas@extundo.com>
+
+ * mm-view.el (mm-view-pkcs7-decrypt): Operate in current buffer.
+ Don't ask whether to decrypt. Just leave result in buffer (don't
+ call mm).
+
+ * mm-decode.el (mm-dissect-buffer): Possibly verify/decrypt single
+ parts as well.
+ (mm-inline-media-tests): Ignore application/{x-,}pkcs7-mime.
+ (mm-possibly-verify-or-decrypt): Support application/{x-,}pkcs7-mime.
+
+2001-08-09 Simon Josefsson <jas@extundo.com>
+
+ * mm-decode.el (mm-insert-part): Return decoding success status.
+ (mm-save-part-to-file): Error if decoding failed.
+
+2001-08-09 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-tab): Use indent-relative.
+ (message-mode): Don't bind indent-line-function to indent-relative.
+
+2001-08-09 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-get-reply-headers): Fix string. Suggested by
+ Christoph Conrad <cc@cli.de>.
+
+2001-08-08 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-tab): Use the current value of
+ indent-line-function.
+ (message-mode): Bind indent-line-function to indent-relative.
+
+2001-08-08 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-gssapi-auth-p, imap-kerberos4-auth-p): Also check
+ whether `imtest' is installed.
+
+2001-08-04 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
+
+ * gnus-sum.el (gnus-summary-show-article): Call
+ gnus-summary-update-secondary-secondary-mark.
+ * gnus-sum.el (gnus-summary-edit-article-done): Ditto.
+ * gnus-sum.el (gnus-summary-reparent-thread): Ditto.
+
+2001-08-07 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Misc -> Gnus.
+
+ * gnus-group.el (gnus-group-make-menu-bar): Ditto.
+
+ * mm-uu.el (mm-uu-dissect): Autoload. From Gerd M,Av(Bllmann
+ <gerd@gnu.org>.
+
+ * gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
+
+ * gnus-util.el (gnus-output-to-rmail): Ditto.
+ (gnus-output-to-mail): Ditto.
+
+ * nnmail.el (nnmail-pathname-coding-system): Set default to nil.
+
+2001-08-06 Florian Weimer <fw@deneb.enyo.de>
+
+ * message.el (message-indent-citation): Use
+ `message-yank-cited-prefix' for empty lines.
+
+2001-08-05 Florian Weimer <fw@deneb.enyo.de>
+
+ * message.el (message-indent-citation): Quote only lines starting
+ with ">" using `message-yank-cited-prefix'.
+
+2001-08-05 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
+ Trivial patch.
+
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Use
+ gnus-cache-fully-p.
+
+2001-08-04 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cache.el (gnus-cache-possibly-update-active): Create active
+ file if it doesn't exist (by calling gnus-cache-read-active).
+
+2001-08-04 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Revert.
+ (gnus-cache-passively-or-fully-p): Removed.
+ (gnus-cache-fully-p): Fix it.
+
+ * mm-view.el (mm-pkcs7-signed-magic): Support more ASN.1 lengths.
+
+2001-08-04 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cache.el (gnus-cache-fully-p)
+ (gnus-cache-passively-or-fully-p): New functions.
+ (gnus-cache-possibly-enter-article): Cosmetic change, use
+ `g-c-p-o-f-p'.
+ (gnus-cache-possibly-enter-article): Use `g-c-p-u-a'; last change
+ was bogus (`g-c-p-a-a' does not change active info, just change
+ the functions parameters).
+ (gnus-cache-possibly-remove-articles-1): Make sure articles are
+ not removed in groups that match `gnus-uncacheable-groups'.
+
+ Reported and modifications based on discussions with Nuutti
+ Kotivuori <nuutti.kotivuori@smarttrust.com>.
+
+2001-08-04 Simon Josefsson <jas@extundo.com>
+ Trivial patch from Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
+
+ * gnus-cache.el (gnus-cache-possibly-update-active): New function;
+ calls `gnus-cache-update-active' if bounds has been extended.
+
+2001-08-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-security-verify-or-decrypt): Insert
+ before remove.
+ (gnus-mime-security-show-details): Ditto.
+
+2001-08-04 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-split-fancy-with-parent): Correct `mapconcat'
+ syntax. Protect string-match against nil string and regexp.
+
+2001-08-03 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-find-charset-region): Remove control-1.
+
+2001-08-03 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-readable-p): Emacs 20 takes one argument.
+
+2001-08-04 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-sign-region, smime-encrypt-region): Fix details
+ buffer. Delete MIME-Version header.
+
+2001-08-03 Simon Josefsson <jas@extundo.com>
+
+ * gnus-cache.el (gnus-cache-possibly-enter-article): The article
+ that is entered does not necessarily have the highest article
+ number in the group, so use `gnus-cache-possibly-alter-active'
+ instead of `gnus-cache-update-active'.
+
+2001-08-03 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-gpg-extract-signature-details): Don't barf.
+
+2001-08-03 Simon Josefsson <jas@extundo.com>
+
+ * mml.el (mml-menu): Rename from MML to Mime. Collapse Security
+ menu.
+
+2001-08-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (post-method): New group parameter. It also provides
+ the user option `gnus-post-method-alist' and the internal function
+ `gnus-parameter-post-method'.
+
+ * gnus-msg.el (gnus-post-method): Bind the value of
+ `gnus-post-method' to the group parameter if it is defined.
+
+2001-08-02 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-extra-arguments): Removed.
+ (smime-call-openssl-region): Don't use it.
+
+2001-08-02 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-sign-region): Handle stderr.
+ (smime-encrypt-region): Ditto.
+
+ * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. Don't
+ match the ASN.1 length bytes.
+ (mm-pkcs7-enveloped-magic): Ditto.
+ (mm-view-pkcs7-get-type): Don't regexp quote.
+
+2001-08-01 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Andreas Fuchs <asf@void.at>
+
+ * mml2015.el (mml2015-trust-boundaries-alist): Typo.
+
+2001-08-01 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-header-button-alist): References regexp.
+
+2001-08-01 Gerd Moellmann <gerd@gnu.org>
+
+ * mm-view.el (autoload): Don't autoload `diff-mode' if it's
+ already fboundp. Add INTERACTIVE arg to autoload form.
+
+2001-08-01 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-init): Add as gnus buffer.
+
+ * nnmail.el (nnmail-cache-open): Ditto.
+
+2001-07-31 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-button-fetch-group): Fix the regexp.
+
+2001-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-post-method): Refer to `gnus-parameters'.
+
+2001-07-31 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Originally from Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * gnus-agent.el (gnus-agent-make-mode-line-string): New function.
+ (gnus-agent-toggle-plugged): Use it.
+
+2001-07-31 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-startup-file-coding-system): Revert to binary.
+ (gnus-ding-file-coding-system): New variable.
+ (gnus-read-newsrc-el-file, gnus-save-newsrc-file)
+ (gnus-slave-save-newsrc): Use it.
+
+2001-07-31 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-initialize): Use standard define-key
+ syntax.
+
+2001-07-30 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Originally from Andreas Fuchs <asf@void.at>
+
+ * mml2015.el (mml2015-trust-boundaries-alist): New variable.
+ (mml2015-gpg-pretty-print-fpr): New function.
+ (mml2015-gpg-extract-signature-details): More details, rename from
+ `m-g-e-from'.
+ (mml2015-gpg-verify): Use them.
+ (mml2015-gpg-clear-verify): Use them.
+
+2001-07-31 Simon Josefsson <jas@extundo.com>
+
+ * mml-smime.el (mml-smime-sign, mml-smime-encrypt): Goto end of
+ buffer when done.
+
+2001-07-30 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-call-openssl-region): Revert previous change,
+ just pass on buf to `call-process-region'.
+ (smime-verify-region): Doc fix. Don't message stuff. Use
+ `smime-new-details-buffer'. Inserts error messages into buffer.
+ (smime-noverify-region): Ditto.
+ (smime-decrypt-region): Ditto. Handles stderr separately.
+ (smime-verify-buffer, smime-noverify-buffer)
+ (smime-decrypt-buffer): Doc fix.
+ (smime-new-details-buffer): New function.
+ (smime-pkcs7-region, smime-pkcs7-certificates-region)
+ (smime-pkcs7-email-region): Use `smime-new-details-buffer'.
+ (smime-sign-region, smime-encrypt-region): Don't use
+ `insert-buffer'.
+
+ * mml-smime.el (mml-smime-verify): Fix security button strings.
+
+2001-07-30 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-save-part-and-strip): Save
+ gnus-article-mime-handles.
+
+2001-07-29 Simon Josefsson <jas@extundo.com>
+
+ * mail-source.el (top-level): Require message for message-directory.
+ (mail-source-directory): Change default to message-directory.
+
+ * smime.el (smime-keys, smime-CA-directory, smime-CA-file)
+ (smime-certificate-directory, smime-openssl-program)
+ (smime-encrypt-cipher, smime-dns-server): Fix doc (leading "*").
+ (smime-extra-arguments): New variable.
+ (smime-dns-server): Fix customize group.
+ (smime-call-openssl-region): Use `smime-extra-arguments'.
+
+2001-07-29 Simon Josefsson <jas@extundo.com>
+ From Vladimir Volovich <vvv@vsu.ru>
+
+ * smime.el (smime-call-openssl-region): Ignore stderr.
+
+2001-07-29 Simon Josefsson <jas@extundo.com>
+ From Christoph Conrad <christoph.conrad@gmx.de>
+
+ * gnus-agent.el (gnus-agent-save-group-info): Don't destroy active
+ file.
+
+2001-07-29 Simon Josefsson <jas@extundo.com>
+
+ * mm-view.el (mm-view-pkcs7-decrypt): Adhere to `mm-decrypt-option'.
+
+ Support S/MIME decryption.
+
+ * mm-decode.el (mm-inline-media-tests):
+ (mm-inlined-types):
+ (mm-automatic-display):
+ (mm-attachment-override-types): Add application/{x-,}pkcs7-mime.
+
+ * mm-view.el (mm-pkcs7-signed-magic):
+ (mm-pkcs7-enveloped-magic): New variables.
+ (mm-view-pkcs7-get-type): New function; identify PKCS#7 type.
+ (mm-view-pkcs7): New function; mm viewer for PKCS#7 blobs.
+ (mm-view-pkcs7-decrypt): New function; mm viewer for encrypted
+ PKCS#7 blobs.
+
+ * smime.el (smime-decrypt-region): Expand keyfile.
+
+2001-07-29 Simon Josefsson <jas@extundo.com>
+
+ * nntp.el (nntp-open-ssl-stream): Don't mess with internal
+ `ssl.el' variables.
+
+ * gnus-agent.el (gnus-agent-save-group-info): Delete everything
+ but line instead of narrowing to it, because `nnmail-parse-active'
+ calls widen. Thanks to Christoph Conrad
+ <christoph.conrad@gmx.de>.
+
+2001-07-29 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*'
+ for %B spec.
+
+ * gnus-sum.el (gnus-summary-prepare-threads): If
+ gnus-sum-thread-tree-root is nil, use subject instead.
+ (gnus-sum-thread-tree-root, gnus-sum-thread-tree-single-indent)
+ (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent)
+ (gnus-sum-thread-tree-leaf-with-other)
+ (gnus-sum-thread-tree-single-leaf): Documentation.
+ (gnus-sum-thread-tree-single-indent): Allow nil.
+
+2001-07-28 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-fill-paragraph): Do nothing if the user
+ wants filladapt-mode.
+
+2001-07-27 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-image-type-from-buffer): New function.
+ (mm-get-image): Use it.
+
+2001-07-27 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-large-newsgroup): Add doc, "If it is nil, ..."
+
+ * gnus-art.el (gnus-mime-view-all-parts): buffer-read-only covers
+ mm-display-parts too.
+
+2001-07-27 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-accept-article): Bind
+ nntp-server-buffer.
+
+ * nnmail.el (nnmail-parse-active): Read from buffer instead of
+ nntp-server-buffer.
+
+2001-07-27 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-check-news-header-syntax): Use
+ message-post-method.
+ (message-send-news): Bind message-post-method.
+
+2001-07-27 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-tweak-type-alist): New variable.
+ (mml-tweak-function-alist): New variable.
+ (mml-tweak-part): New function.
+ (mml-generate-mime-1): Use it.
+
+2001-07-26 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-accept-article): Replace
+ nnfolder-request-list.
+
+2001-07-27 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-open-server): Set nnimap-server-buffer if
+ nnoo-change-server failed to do it.
+
+2001-07-26 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-parameters): Make it customizable.
+
+2001-07-26 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mm-display-part): Narrow to point if eobp.
+
+ * message.el (message-set-auto-save-file-name): More
+ poor-system-types.
+
+ * mailcap.el (mailcap-parse-mimetypes): poor-system-types.
+
+ * gnus-ems.el (nnheader-file-name-translation-alist): M$Windows-NT
+ supports +.
+
+2001-07-26 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-readable-p): New function.
+ (mm-inline-media-tests): Fix the default testers.
+
+2001-07-26 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-version): Bump version number.
+
+2001-07-26 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Steven E. Harris <seh@speakeasy.org>
+
+ * nnheader.el (nnheader-translate-file-chars): cygwin32 is running
+ in M$Windows too.
+
+2001-07-26 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-send-drafts): Don't `error'.
+
+2001-07-25 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-bcklg.el (gnus-backlog-shutdown): Make interactive.
+
+ * mm-decode.el (mm-get-image): Guess then use the type.
+
+ * gnus-art.el (gnus-mime-view-part-as-type): Don't copy cache.
+
+2001-07-25 12:54:00 Danny Siu <dsiu@adobe.com>
+
+ * gnus-sum.el (gnus-summary-prepare-threads): Shouldn't do tree
+ display (%B) for threads if threading is off.
+
+2001-07-25 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Henrik Enberg <henrik@enberg.org>
+
+ * gnus-msg.el: Customization patch.
+
+2001-07-25 22:22:22 Raymond Scholz <rscholz@zonix.de>
+
+ * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): New
+ variable.
+ (nnmail-split-fancy-with-parent): Ignore certain groups.
+
+2001-07-25 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-byte-compile): New function.
+ (gnus-use-byte-compile): New variable.
+ (gnus-make-sort-function): Use it.
+
+ * nnmail.el (nnmail-get-new-mail): Use it.
+
+ * gnus-agent.el (gnus-category-make-function): Simple function or
+ compiled function.
+ (gnus-agent-fetch-group-1): Don't use (caaddr predicate).
+
+ * gnus-gl.el (bbb-build-rate-command): Remove quote before lambda.
+ * gnus-topic.el (gnus-topic-sort-topics-1): Ditto.
+ (gnus-topic-sort-topics-1): Use gnus-byte-compile.
+
+ * message.el (message-check-news-header-syntax): Remove quote.
+
+2001-07-24 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-use-mail-followup-to): `t' is not a
+ documented value.
+
+2001-07-24 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-display-arrow): Test fboundp.
+
+2001-07-24 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-encode.el (mm-encode-buffer): Don't use 7bit encoding if
+ there are long lines.
+
+2001-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (copy-list): New compiler macro.
+
+2001-07-24 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-bounce): If no Return-Path, the whole
+ content is considered as the original message.
+
+ * nnml.el (nnml-check-directory-twice): New variable.
+ (nnml-article-to-file): Use it.
+ (nnml-retrieve-headers): Hack it.
+
+2001-07-24 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-buffer-configuration): New configure.
+
+ * gnus-art.el (gnus-mm-display-part): Don't select-window if it is
+ not alive.
+
+ * mm-decode.el (mm-remove-part): Don't murder the current window (nil).
+ (mm-display-external): Use display-term configure.
+
+2001-07-24 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-default-hour): New variable.
+ (gnus-delay-article): Allow specific date in YYYY-MM-DD format.
+
+2001-07-23 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Karl Kleinpaste <karl@charcoal.com>
+
+ * gnus-sum.el (gnus-summary-line-format-alist): Add %B.
+ (gnus-summary-prepare-threads): Ditto.
+
+ * gnus.el (gnus-summary-line-format): Add %B.
+
+2001-07-23 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-articles-to-read): Use gnus-group-decoded-name.
+
+ * mm-util.el (mm-string-as-multibyte): New function.
+
+ * nnmh.el (nnmh-request-list-1): Encode, not decode!
+
+2001-07-23 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-universal-coding-system): New variable.
+
+ * gnus-start.el (gnus-startup-file-coding-system): Use it.
+
+ * score-mode.el (score-mode-coding-system): Use it.
+
+2001-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-setup-news): Call
+ `gnus-check-bogus-newsgroups' just after the native server is
+ opened.
+
+2001-07-23 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-do-request-post): Util function to be used by
+ `nnchoke-request-post' for all nnmail-derived backends.
+
+ * nnml.el (nnml-request-post): Use it.
+
+ * gnus.el (gnus-valid-select-methods): nnml is a post-mail
+ backend, for it groks nnml-request-post.
+
+ * gnus-group.el (gnus-group-highlight, gnus-group-highlight-line):
+ Treat `mail-post' backends like `mail' backends, not like `news'
+ backends.
+
+2001-07-22 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-setup-message): make-local-hook.
+
+2001-07-22 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el (gnus-delay-article): Fix `read-string' for
+ XEmacs. Allow more units. Submitted by Karl Kleinpaste
+ <karl@charcoal.com>, slightly changed by Kai.
+
+ * message.el (message-check-news-header-syntax): When checking
+ whether the groups exist, check the right server based on
+ `gnus-post-method'.
+
+2001-07-21 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-delay.el: New file.
+
+2001-07-21 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-read-coding-system): Take two arguments.
+
+ * gnus-sum.el (gnus-summary-show-article): Use
+ mm-read-coding-system.
+
+ * gnus-art.el (article-de-quoted-unreadable):
+ (article-de-base64-unreadable, article-wash-html):
+ (gnus-mime-inline-part, gnus-mime-view-part-as-charset): Ditto.
+
+2001-07-21 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnml.el (nnml-request-post): New function. Can be used for
+ annotations in nnml groups.
+
+2001-07-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS
+ command.
+
+ * gnus-start.el (gnus-find-new-newsgroups): Use
+ `message-make-date' instead of `current-time-string'.
+ (gnus-ask-server-for-new-groups): Ditto.
+ (gnus-check-first-time-used): Ditto.
+
+2001-07-20 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-score.el (gnus-home-score-file): nnheader-translate-file-chars.
+
+2001-07-18 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * message.el (message-shorten-references): Change `maxcount' and
+ `cut' to obey USEFOR draft 5.
+
+2001-07-12 Colin Walters <walters@cis.ohio-state.edu>
+
+ * gnus-sum.el (gnus-summary-display-arrow): New variable.
+ (gnus-summary-set-article-display-arrow): New function.
+ (gnus-summary-goto-subject): Use it.
+
+2001-07-18 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-import-article): Insert date if
+ doesn't exist.
+
+2001-07-18 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-content-type-parameters): New variable.
+ (mml-content-disposition-parameters): New variable.
+ (mml-insert-mime-headers): Use them.
+ (mml-parse-1): Accept charset.
+
+2001-07-17 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-select-group): Doc fix.
+
+ * gnus-eform.el (gnus-edit-form-done): Return nil if end-of-file.
+
+2001-07-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (dgnushack-make-auto-load): Advise `make-autoload'
+ to handle `define-derived-mode'.
+
+2001-07-16 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From: Stefan Monnier <monnier@cs.yale.edu>
+
+ * message.el (message-mode): Use define-derived-mode.
+ (message-tab): message-completion-alist.
+
+ * imap.el (imap-interactive-login): Use make-local-variable.
+ (imap-open): Ditto.
+ (imap-authenticate): Ditto.
+
+ * gnus-msg.el (gnus-setup-message): Change-major-mode-hook.
+
+ * gnus-art.el (gnus-article-edit-mode): Use define-derived-mode.
+
+2001-07-16 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-citation-line-function): Refer to
+ gnus-cite-attribution-suffix.
+
+2001-07-15 Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * gnus-art.el,...: Error convention changes.
+
+2001-07-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-rebuild-thread): Count hidden lines too.
+
+2001-07-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-read-group-data): Nuke emacs-lisp-mode-hook.
+ (nnrss-read-server-data): Ditto.
+
+2001-07-13 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-setup.el (gnus-use-installed-gnus): Typo.
+ * Cleanup files.
+ From Pavel@Janik.cz (Pavel Jan,Am(Bk).
+
+2001-07-13 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-summary-line-format): Add %o.
+
+ * gnus-sum.el (gnus-summary-pipe-output): Don't configure as pipe
+ unless shell outputs something.
+
+2001-07-13 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-boring-article-headers): Better doc.
+ (article-hide-headers): Better regexp.
+ Suggested by Matt Swift <swift@alum.mit.edu>.
+
+ * nnheader.el (nnheader-max-head-length): Better doc.
+ (nnheader-header-value): Skip spaces.
+ (nnheader-parse-head): Remove space.
+ Suggested by Matt Swift <swift@alum.mit.edu>.
+
+ * gnus-sum.el (gnus-summary-show-raw-article): New function.
+ (gnus-get-newsgroup-headers): Remove space.
+
+2001-07-12 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-msg-treat-broken-reply-to): Add force.
+ (gnus-summary-reply): Use it.
+ (gnus-summary-reply-broken-reply-to): New function.
+ (gnus-msg-force-broken-reply-to): New function.
+
+ * mm-view.el (mm-inline-text): Showing as text/plain when error.
+
+2001-07-12 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-draft.el (gnus-draft-setup): Restore gnus-newsgroup-name.
+
+2001-07-12 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-external-terminal-program): New variable.
+ (mm-display-external): Use it. Use term to display when no
+ window-system.
+
+2001-07-12 Bj,Av(Brn Torkelsson <torkel@hpc2n.umu.se>
+
+ * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the
+ Browse->Next entries to Browse->Prev
+
+2001-07-11 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Don't test gnus-alive-p.
+
+2001-07-11 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-encode.el (mm-content-transfer-encoding-defaults): Use base64
+ for the default encoding.
+
+ * nnrss.el (nnrss-url-field): New field.
+ (nnrss-request-article): Add newsgroups.
+
+ * nnfolder.el (nnfolder-read-folder): Force to use a multibyte buffer.
+
+2001-07-11 04:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndraft.el (nndraft-request-restore-buffer): Don't remove Date.
+
+ * gnus-draft.el (gnus-draft-edit-message): Remove Date here.
+ (gnus-draft-setup): Remove backlog.
+
+2001-07-10 Pavel Jan,Am(Bk <Pavel@Janik.cz>
+
+ * gnus-logic.el, gnus-srvr.el, gnus-vm.el, nnheaderxm.el, nnoo.el:
+ Cleanup.
+
+2001-07-09 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-bug): Erase buffer.
+
+ * nnfolder.el (nnfolder-possibly-change-group): Don't create group.
+
+2001-07-09 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-attachment-override-p): Fix typo.
+
+2001-03-19 05:28:00 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-kill.el (gnus-execute): Work with the extra headers.
+ * gnus-sum.el (gnus-summary-execute-command): Ditto.
+
+2001-07-09 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-text): w3-coding-system-for-mime-charset
+ may not defined. From: Raja R Harinath <harinath@cs.umn.edu>.
+
+ * message.el (message-send-mail-real-function): New variable.
+ (message-send-mail-partially, message-send-mail):
+
+ * nngateway.el (nngateway-request-post): Use it.
+
+ * gnus-agent.el (gnus-agentize): Use it.
+
+ * nnsoup.el (nnsoup-old-functions, nnsoup-set-variables)
+ (nnsoup-revert-variables): Use it.
+
+2001-07-09 Colin Walters <walters@cis.ohio-state.edu>
+
+ * mm-decode.el (mm-inline-media-tests): Default to displaying as
+ text/plain if the type doesn't match any other media types.
+ (mm-inlined-types): Doc fix.
+ (mm-display-inline): Revert previous change (now handled by a
+ default type in `mm-inline-media-tests'.
+ (mm-inlinable-p): Revive.
+ (mm-display-part): Call `mm-inlinable-p'.
+ (mm-attachment-override-p): Ditto.
+ (mm-inlined-p): Doc fix.
+
+ * gnus-art.el (gnus-mime-display-single): Call `mm-inlinable-p' as
+ well as `mm-inlined-p'.
+
+2001-07-09 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-send-command, nntp-send-command-nodelete):
+ (nntp-send-command-and-decode): Use gnus-point-at-bol.
+
+2001-07-09 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Paul Jarc <prj@po.cwru.edu>
+
+ * message.el (message-use-mail-followup-to): New variable.
+ (message-get-reply-headers): Use it.
+
+2001-07-04 Gerd Moellmann <gerd@gnu.org>
+
+ * nnheader.el (nnheader-init-server-buffer): Make sure the
+ *nntpd* buffer is made multibyte instead of a random buffer.
+
+2001-07-09 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-get-newsgroup-headers-xover): Get headers only
+ when it returns headers.
+
+2001-07-07 Simon Josefsson <jas@extundo.com>
+
+ * rfc2047.el (rfc2047-encode-message-header): Skip header when
+ trying to fold. Thanks to Colin Walters
+ <walters@cis.ohio-state.edu>
+
+2001-07-06 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-parse-address-list, imap-parse-flag-list)
+ (imap-parse-body-extension, imap-parse-body-ext, imap-parse-body):
+ Add information in `assert's.
+
+ * nnimap.el (nnimap-possibly-change-group): Ignore uidvalidity
+ changes. (From nnimaps' point of view, `nnimap-verify-uidvalidity'
+ and `nnimap-group-overview-filename', should handle all
+ change-of-uidvalidity related issues. But there may be other
+ problems.)
+
+2001-07-05 Colin Walters <walters@cis.ohio-state.edu>
+
+ * rfc2047.el (rfc2047-encode-message-header): Don't include the
+ header name when folding.
+
+2001-07-05 Colin Walters <walters@cis.ohio-state.edu>
+
+ * mm-decode.el (mm-inlined-types): Document relationship with
+ `mm-inline-media-tests'.
+ (mm-display-inline): Default to displaying as plain text if no
+ inlining handler is available.
+ (mm-inlinable-p): Remove.
+ (mm-inlined-p): Don't call `mm-inlinable-p'.
+ (mm-automatic-display-p): Ditto.
+ (mm-attachment-override-p): Ditto.
+
+2001-07-04 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-importantize-dormant): New variable.
+ (nnimap-request-update-info-internal): Use it.
+ (nnimap-request-set-mark): Ditto.
+
+2001-07-04 Didier Verna <didier@lrde.epita.fr>
+
+ * nntp.el (nntp-send-command): don't pass a buffer argument to
+ `point'. Only XEmacs accepts this.
+ * nntp.el (nntp-send-command-nodelete): ditto.
+ * nntp.el (nntp-send-command-and-decode): ditto.
+
+2001-07-04 Didier Verna <didier@lrde.epita.fr>
+
+ * nntp.el (nntp-open-connection-function): doc update.
+ * nntp.el (nntp-pre-command): New.
+ * nntp.el (nntp-via-rlogin-command): New.
+ * nntp.el (nntp-via-telnet-command): New.
+ * nntp.el (nntp-via-telnet-switches): New.
+ * nntp.el (nntp-via-user-name): New.
+ * nntp.el (nntp-via-user-password): New.
+ * nntp.el (nntp-via-address): New.
+ * nntp.el (nntp-via-envuser): New.
+ * nntp.el (nntp-via-shell-prompt): New.
+ * nntp.el (nntp-open-telnet-stream): New.
+ * nntp.el (nntp-open-via-rlogin-and-telnet): New.
+ * nntp.el (nntp-open-via-telnet-and-telnet): New.
+ * nntp.el (nntp-wait-for): check for possibly echo'ed commands.
+ * nntp.el (nntp-send-command): ditto.
+ * nntp.el (nntp-send-command-nodelete): ditto.
+ * nntp.el (nntp-send-command-and-decode): ditto.
+
+2001-06-30 YAGI Tatsuya <yagi@is.titech.ac.jp>
+ Trivial patch.
+
+ * gnus-start.el (gnus-check-first-time-used): Use `if' instead of
+ `when'.
+
+2001-07-03 Simon Josefsson <jas@extundo.com>
+ From Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
+
+ * flow-fill.el (fill-flowed): Use (1+ (point-at-eol)) instead.
+
+2001-07-03 Simon Josefsson <jas@extundo.com>
+
+ * flow-fill.el (fill-flowed): If `fill-region' inserts empty line,
+ remove it (workaround XEmacs `fill-region' bug).
+
+2001-07-01 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-date-days-ago): Defeat locale.
+
+2001-06-28 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-format-error): New function.
+ (mml2015-mailcrypt-decrypt, mml2015-mailcrypt-clear-decrypt)
+ (mml2015-mailcrypt-verify, mml2015-gpg-clear-verify)
+ (mml2015-mailcrypt-clear-verify, mml2015-gpg-verify): Use it.
+
+2001-06-26 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-retrieve-headers): The description may not exist.
+ Suggested by Christoph Conrad <C.Conrad@cli.de>.
+
+ * gnus-sum.el (gnus-summary-set-local-parameters): Don't override
+ group variables.
+
+2001-06-25 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-write-groups): Use gnus-prin1.
+
+ * nnrss.el (nnrss-save-server-data): Bind print-level and print-length.
+ (nnrss-save-group-data): Ditto.
+
+ * gnus-agent.el (gnus-agent-save-alist): Ditto.
+
+2001-06-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-do-send-housekeeping): Narrow to headers.
+
+2001-06-24 Simon Josefsson <jas@extundo.com>
+
+ * rfc2047.el (rfc2047-fold-region): The check to skip WSP
+ insertion when breaking lines looked for " \t" instead of "[ \t]".
+ (rfc2047-encode-message-header): Fold lines even if
+ no QP encoding is done.
+
+2001-06-23 Simon Josefsson <jas@extundo.com>
+ From Samuel Tardieu <sam@inf.enst.fr>
+
+ * smime.el (smime-keys): Support additional certificates.
+ (smime-make-certfiles): New function.
+ (smime-sign-region): Use previous variables.
+ (smime-get-certfiles): New function.
+ (smime-sign-buffer): Use it.
+ (smime-verify-region): Support both CAfile and CApath.
+
+2001-06-23 Simon Josefsson <jas@extundo.com>
+
+ * smime.el (smime-decrypt-region): Perhaps work.
+
+2001-06-22 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-copy-article-buffer): Typo.
+
+2001-04-06 Ralph Schleicher <rs@nunatak.allgaeu.org>
+
+ * mm-decode.el (mm-save-part): Rewrite file name.
+ (mm-file-name-rewrite-functions): New variable.
+ (mm-file-name-delete-whitespace): New function.
+ (mm-file-name-trim-whitespace): New function.
+ (mm-file-name-collapse-whitespace): New function.
+ (mm-file-name-replace-whitespace): New variable and function.
+
+2001-06-22 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-make-date): Workaround locale for weekdays.
+
+2001-06-21 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-goto-body): Return nil if not found. (revert!)
+
+2001-06-21 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Fremlin <chief@bandits.org>
+
+ * message.el (message-goto-body): Some messages have no header.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Use it.
+
+2001-06-21 Ralph Schleicher <rs@nunatak.allgaeu.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Date fix.
+
+2001-06-21 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-make-date): Add week day.
+ Suggested by Jason R. Mastaler <jason@mastaler.com>.
+
+2001-06-19 Simon Josefsson <jas@extundo.com>
+
+ * message.el (message-yank-prefix): Doc fix.
+ (message-yank-cited-prefix): Ditto.
+ (message-delete-not-region): Keep citation prefix on first line,
+ if possible and appropriate.
+
+2001-06-19 Simon Josefsson <jas@extundo.com>
+
+ * imap.el (imap-process-connection-type): New variable.
+ (imap-kerberos4-open, imap-gssapi-open): Use it. This makes
+ recent `imtest's work completely (no line length issues), while
+ making making old `imtest's unusable. Thanks to NAGY Andras
+ <nagya@inf.elte.hu> for his work.
+
+2000-12-30 NAGY Andras <nagya@inf.elte.hu>
+
+ * imap.el (imap-ssl-program): Add -quiet to shut up
+ OpenSSL/SSLeay's internal debug talk.
+
+2001-06-19 Matt Armstrong <matt@lickey.com>
+
+ * imap.el (imap-parse-flag-list): Workaround bug in Courier IMAP
+ server.
+
+2001-06-19 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-article-buffer): New variable.
+ (nnmail-split-incoming): Use it.
+
+2001-06-15 Eli Zaretskii <eliz@is.elta.co.il>
+
+ * qp.el (quoted-printable-decode-region): If called interactively,
+ use coding-system-for-read.
+
+2001-06-16 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-check-news-header-syntax): Check Reply-To.
+
+2001-06-16 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-parse-1): Use message options.
+
+ * message.el (message-do-fcc): Don't do anything if there is no
+ FCC.
+
+2001-06-16 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-articles): Support 'junk to-groups.
+ (nnimap-expunge-search-string): New variable.
+ (nnimap-request-expire-articles): Use it.
+
+2001-06-15 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-send-mail-with-qmail): wrong exit status is
+ 100 not 1. Reported by Paul Jarc <prj@po.cwru.edu>.
+
+2001-06-15 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-strip-multiple-blank-lines): Use
+ delete-region instead of replace-match.
+
+2001-06-14 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnweb.el (nnweb-google-parse-1): Fix Google content regexp.
+ (nnweb-google-wash-article): Ditto.
+
+2001-06-14 Ferenc Wagner <wferi@bolyai1.elte.hu>
+
+ * nnweb.el (nnweb-google-parse-1): Fix Google url regexp.
+
+2001-06-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-define-group-parameter): Don't quote the defcustom
+ specs.
+
+2001-06-13 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-email-address): Move it here.
+
+ * gnus-art.el (article-de-quoted-unreadable): Read charset if
+ requested.
+ (article-de-base64-unreadable): Ditto.
+ (article-wash-html): Ditto.
+
+2001-06-12 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-options-set-recipient): Don't add ", "
+ unless necessary. Suggested by Josh Huber <huber@alum.wpi.edu>.
+
+2001-06-12 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-group-alist): Use |fr| instead of [fr].
+
+2001-06-12 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-plain-save-name): Use file-relative-name.
+ From Marc Lefranc <Marc.Lefranc@univ-lille1.fr>.
+
+ * nnrss.el (nnrss-node-text): Node might be nil.
+
+2001-06-11 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-uu.el (gnus-uu-save-article): Use mml tag instead of
+ part. From Katsumi Yamaoka <yamaoka@jpl.org>.
+
+ * nnrss.el (nnrss-group-alist): More items.
+
+2001-06-09 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-node-text): Use cddr instead xml-node-children.
+
+2001-06-03 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Dale Hagglund <rdh@best.com>
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Fix generation of split
+ restrict clauses.
+
+2001-06-07 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ From Benjamin Rutt <brutt+news@bloomington.in.us>
+
+ * message.el (message-wide-reply-confirm-recipients): New variable.
+
+2001-06-06 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Mark Thomas <mthomas@edrc.cmu.edu>
+
+ * nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To
+ fix so it works with XEmacs.
+
+2001-06-07 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-retrieve-headers): Support description as extra
+ headers.
+
+2001-06-07 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el: Fix a few bugs.
+
+2001-06-05 Simon Josefsson <jas@extundo.com>
+
+ * mm-decode.el (mm-handle-set-external-undisplayer): Don't
+ generate compiler warnings. From Alex Schroeder <alex@gnu.org>.
+
+2001-06-04 Hrvoje Niksic <hniksic@arsdigita.com>
+
+ * mm-decode.el (mm-pipe-part): Bind coding-system-for-write to
+ binary so that we don't transmit ISO 2022 garbage to the process.
+ This is needed under XEmacs.
+
+2001-06-03 Simon Josefsson <simon@josefsson.org>
+
+ * imap.el (imap-ssl-open): Require ssl. (Otherwise ssl.el is
+ autoloaded incorrectly below because ssl-program-* is bound.)
+ Thanks to Amos Gouaux for report.
+
+2001-06-02 Simon Josefsson <simon@josefsson.org>
+
+ * imap.el (imap-kerberos4-open):
+ (imap-gssapi-open):
+ (imap-ssl-open):
+ (imap-network-open):
+ (imap-shell-open):
+ (imap-starttls-open): Set buffer to workaround spurious
+ `accept-process-output' buffer changes. Thanks to Mats Lidell
+ <Mats.Lidell@contactor.se> for report and partial patch and Jake
+ Colman <colman@ppllc.com> for report.
+
+2001-05-31 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-catchup): New argument.
+ (gnus-summary-catchup-from-here): New function.
+
+2001-05-30 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * mm-view.el (mm-inline-image-xemacs): Insert newline, then move
+ back, then insert glyph. (Before, the glyph was inserted first,
+ then the newline.) This works around a behavior in XEmacs where
+ it is not possible to insert a character after a glyph which is at
+ the end of a buffer. Patch by Lloyd Zusman <ljz@asfast.com>.
+
+2001-05-28 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ From Jaap-Henk Hoepman (jhh@xs4all.nl).
+
+ * mm-decode.el (mm-keep-viewer-alive-types): New variable.
+ (mm-keep-viewer-alive-p, mm-handle-set-external-undisplayer,
+ mm-destroy-postponed-undisplay-list): New functions.
+ (mm-display-external): Use them.
+
+2001-05-27 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-salt.el (gnus-tree-highlight-node): Bind `default-high' and
+ `default-low' when evaluating `gnus-summary-highlight'.
+ From Raja R Harinath <harinath@cs.umn.edu>.
+
+2001-05-27 Simon Josefsson <simon@josefsson.org>
+
+ * message.el (message-yank-cited-prefix): New variable.
+ (message-indent-citation): Use it.
+
+ * mml2015.el (mml2015-mailcrypt-verify): Store gpg stderr output
+ as details.
+ (mml2015-mailcrypt-clear-verify): Ditto.
+
+2001-05-24 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Nevin Kapur <nevin@jhu.edu>.
+
+ * gnus-sum.el (gnus-summary-default-high-score,
+ gnus-summary-default-low-score): New variables.
+ (gnus-summary-highlight): Use them.
+
+2001-05-16 Didier Verna <didier@lrde.epita.fr>
+
+ * message.el (message-mail): pass the 'send-actions argument to
+ `message-setup'.
+
+2001-05-16 Simon Josefsson <simon@josefsson.org>
+ From Raymond Scholz <ray-2001@zonix.de>
+
+ * gnus-art.el (gnus-mime-view-part-as-charset):
+ (gnus-mime-internalize-part): Doc fixes.
+
+2001-05-11 Simon Josefsson <simon@josefsson.org>
+
+ * gnus-start.el (gnus-ignored-newsgroups): Also ignore NNTP type
+ status lines without any text ("^215$").
+
+2001-05-06 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-check-group): Reverse.
+
+2001-05-07 Simon Josefsson <simon@josefsson.org>
+
+ * message.el (message-get-reply-headers):
+ (message-followup): Fix typo, suggested by David Green
+ <dgreen@uab.edu>
+
+2001-05-05 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-request-expire-articles): Fix.
+
+ * nnrss.el (nnrss-open-server): Read server data when it is called.
+ (nnrss-request-expire-articles): Fix.
+
+2001-05-05 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-do-send-housekeeping): mail-abbrevs may
+ rename buffer behind Gnus.
+
+2001-05-04 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-check-group): Use nnheader-translate-file-chars.
+ (nnrss-group-alist): Add more resources.
+ (nnrss-check-group): Ignore errors.
+
+2001-05-04 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-request-expire-articles): Correct the return value.
+
+ * nnslashdot.el (nnslashdot-request-list): Add time.
+ (nnslashdot-request-expire-articles): New function.
+
+ * gnus-start.el (gnus-check-bogus-newsgroups): Remove bogus
+ secondary methods too.
+
+2001-05-03 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-use-followup-to): Set default value to t.
+
+2001-05-03 Florian Weimer <fw@deneb.enyo.de>
+
+ * message.el (message-dont-reply-to-names): Fix documentation.
+ (message-get-reply-headers): Use Mail-Followup-To only for wide
+ replies.
+
+2001-05-03 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-request-expire-articles): Calculate # of days
+ correctly.
+ (nnrss-check-group): Use time.
+
+2001-05-01 19:21:19 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.03 is released.
+
+2001-05-01 19:06:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-topic-article-to-article): Use the
+ group.
+
+2001-04-24 19:50:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-server-insert-server-line): Add a space.
+
+2001-04-15 14:55:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Return all
+ available headers.
+
+ * gnus-sum.el (gnus-read-all-available-headers): New variable.
+ (gnus-get-newsgroup-headers-xover): Use it.
+
+2001-04-14 15:47:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Clean up.
+
+2001-04-30 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-retrieve-groups): Use throw instead of error.
+
+2001-04-29 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el (nnrss-insert-w3): Use cache before I figure out how to
+ disable it.
+
+ * gnus.el (gnus-info-nodes): Remove a few The's.
+
+2001-04-29 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mail-source.el (mail-source-movemail): Call-process may return a
+ signal description string.
+
+ * gnus-start.el (gnus-read-newsrc-el-file):
+ gnus-newsrc-file-version may be nil.
+
+ * nnmail.el (nnmail-get-new-mail): Use the exact file only.
+ Suggested by Michael Sperber [Mr. Preprocessor]
+ <sperber@informatik.uni-tuebingen.de>.
+
+2001-04-25 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * mm-uu.el (mm-uu-configure-list): Fixed customize type.
+
+2001-04-24 Hrvoje Niksic <hniksic@arsdigita.com>
+
+ * mm-view.el (mm-display-inline-fontify): Allow XEmacs to fully
+ fontify HANDLE.
+
+2001-04-18 Simon Josefsson <simon@josefsson.org>
+
+ * smime.el (smime-ask-passphrase): Rework to return value.
+ (smime-sign-region): Rework to bind value and use it.
+ (smime-decrypt-region): Ditto.
+
+2001-04-18 Simon Josefsson <simon@josefsson.org>
+ Trivial patch from Mathias Herberts <Mathias.Herberts@iroise.net>
+
+ * smime.el (smime-ask-passphrase): New function.
+ (smime-sign-region): Use it.
+ (smime-encrypt-cipher): New variable.
+ (smime-decrypt-region): Ditto.
+
+2001-04-12 Jason Merrill <jason_merrill@redhat.com>
+ Committed by Simon Josefsson <simon@josefsson.org>
+
+ * imap.el (imap-shell-open): Erase the buffer *after* copying it into
+ the log.
+
+2001-04-14 01:14:42 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.02 is released.
+
+2001-04-14 00:48:42 Lars Magne Ingebrigtsen <larsi@quimby.gnus.org>
+
+ * gnus.el: Oort Gnus v0.01 is released.
+
+2001-04-13 22:01:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-highlight): Highlight read
+ undownloaded articles as read articles.
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): Clean up.
+ (gnus-agent-get-undownloaded-list): Mark all undownloaded
+ articles, even read ones, as such.
+
+ * gnus-sum.el (gnus-summary-find-matching): Clean up.
+ (gnus-find-matching-articles): New function.
+ (gnus-summary-limit-include-matching-articles): New command.
+ (gnus-summary-limit-include-thread): Include articles that have
+ matching subjects.
+ (gnus-offer-save-summaries): Clean up.
+
+2001-04-13 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * nnmail.el (nnmail-split-fancy-with-parent): Add docstring.
+
+2001-04-12 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Jason Merrill <jason_merrill@redhat.com>
+
+ * gnus-sum.el (gnus-summary-insert-new-articles): Reverse the articles.
+
+2001-04-10 08:01:15 Katsumi Yamaoka <yamaoka@jpl.org>
+ Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-post-news): Fill the Newsgroups header by the
+ newsgroup names when the original article is a news message.
+
+2001-04-12 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-cite-prefix-regexp): Use POSIX regexp if
+ supported. Suggest by Jim Meyering <jim@meyering.net>.
+
+2001-04-02 Nevin Kapur <nevin@jhu.edu>
+ Committed by Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>.
+
+ * nnmail.el (nnmail-split-it): Added check for .* at the end of
+ regexp in nnmail-split-fancy.
+
+2001-04-10 Simon Josefsson <simon@josefsson.org>
+
+ * message.el (message-options-set-recipient): Look at Cc and Bcc too.
+
+2001-04-10 Colin Marquardt <colin@marquardt-home.de>
+
+ * message.el (message-send-mail): Improve the interaction with the
+ user.
+
+2001-04-10 Simon Josefsson <simon@josefsson.org>
+
+ * imap.el (imap-message-copy): Work around buggy servers that
+ doesn't send TRYCREATE tags.
+
+2001-04-09 01:15:54 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-read-newsrc-el-file): Work with Semi-gnusae.
+
+2001-04-05 21:43:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-update-summary-mark-positions): Use a valid
+ date.
+
+2001-04-04 16:13:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-quit): Check that the dribble buffer
+ lives.
+
+2001-04-02 00:40:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-parse-news-url): New function.
+ (gnus-button-handle-news): New function.
+ (gnus-button-alist): Point to new functions.
+
+ * gnus-group.el (gnus-group-quit): Only mark buffer in non-empty.
+
+ * gnus-start.el (gnus-read-newsrc-el-file): Nix out
+ gnus-format-specs.
+
+ * message.el (message-check-news-header-syntax): Question even
+ when Gnus doesn't know the group names.
+ (message-send-news): Clean up.
+
+ * gnus-start.el (gnus-dribble-read-file): Say whether Gnus was
+ exited on purpose without saving.
+
+ * gnus-group.el (gnus-group-quit): Mark the dribble file as `Q'.
+
+2001-04-01 00:37:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-score.el (gnus-score-orphans): Clean up.
+
+ * gnus-win.el (gnus-remove-some-windows): Leave one Gnus window.
+
+ * gnus-sum.el (gnus-summary-exit): Kill the summary buffer a bit
+ later.
+
+ * gnus-start.el (gnus-close-all-servers): Find the right items to
+ close.
+
+ * qp.el (quoted-printable-decode-region): Just message
+ malformation; don't quit.
+
+2001-03-31 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Gerd Moellmann <gerd@gnu.org>.
+
+ * gnus.el (gnus-interactive): A typo.
+
+2001-03-26 Juanma Barranquero <lektu@uol.com.br>
+ Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-delete-alist): Declare it as an alias of
+ `assq-delete-all', if that function exists; otherwise use the old
+ definition. Documentation changed to match the one in
+ `assq-delete-all'.
+
+2001-04-01 00:37:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-close-all-servers): New function.
+
+ * gnus-srvr.el (gnus-server-close-all-servers): Clean up.
+ (gnus-server-remove-denials): Clean up.
+
+ * gnus-sum.el (gnus-summary-sort-by-original): New command and
+ keystroke.
+
+2001-03-31 02:56:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-send-news): Message where we are sending.
+ (message-send-mail): Ditto.
+
+ * gnus.el (gnus-server-string): New function.
+
+ * gnus-sum.el (gnus-summary-up-thread): Doc fix.
+
+ * mm-decode.el (mm-default-directory): Customized.
+ (mm-tmp-directory): Ditto.
+
+ * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix.
+ (gnus-get-newsgroup-headers): Return -1 for articles without Lines
+ or Chars.
+ (gnus-summary-line-format-alist): ?l is now a string.
+ (gnus-summary-prepare-threads): Output ? for unknown lines.
+ (gnus-summary-insert-line): Ditto.
+ (gnus-summary-print-article): Unbalanced parentheses.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Check group to allow it to find
+ out whether new stuff has arrived.
+
+2001-03-31 02:14:38 Alan Shutko <ats@acm.org>
+
+ * gnus-sum.el: Let printing work on ttys on Emacs.
+
+2001-03-31 01:11:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-post-news): Add an empty Newsgroups header
+ when forcing news.
+
+ * gnus-sum.el (gnus-summary-mark-article-as-replied): Make into a
+ command.
+
+2001-03-31 01:04:54 Francis Litterio <franl@world.std.com>
+
+ * message.el (message-set-auto-save-file-name): Don't use
+ asterisks under nt.
+
+2001-03-31 00:03:42 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-inews-insert-draft-meta-information): Allow
+ lists of articles.
+
+ * gnus-uu.el (gnus-uu-digest-mail-forward): Mark as forwarded.
+
+ * gnus-msg.el (gnus-put-message): Clean up.
+ (gnus-summary-reply): Mark all replied-to articles as replied to.
+ (gnus-inews-add-send-actions): Also mark as forwarded.
+ (gnus-summary-mail-forward): Mark as forwarded.
+
+ * gnus-sum.el (gnus-summary-mark-article-as-replied): Take a list
+ of articles.
+ (gnus-summary-mark-article-as-forwarded): Ditto.
+
+ * gnus-msg.el (gnus-summary-resend-message): Mark article as
+ forwarded.
+ (gnus-summary-mail-forward): Clean up.
+
+ * gnus.el (gnus-article-mark-lists): Added forward.
+
+ * gnus-sum.el (gnus-forwarded-mark): New variable.
+ (gnus-summary-prepare-threads): Use it.
+ (gnus-summary-update-secondary-mark): Ditto.
+ (gnus-newsgroup-forwarded): New variable.
+
+2001-03-30 23:13:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-summary-reply): Allow very wide replies.
+ (gnus-summary-very-wide-reply): New command and keystroke.
+ (gnus-summary-very-wide-reply-with-original): Ditto.
+
+ * gnus-score.el (gnus-adaptive-word-length-limit): New variable.
+ (gnus-score-adaptive): Use it.
+
+ * gnus-start.el (gnus-get-unread-articles): Clean up.
+
+2001-03-21 20:00:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Work for other
+ boards.
+
+2001-03-21 Didier Verna <didier@lrde.epita.fr>
+
+ * gnus-start.el (gnus-subscribe-newsgroup-hooks): New.
+ * gnus-start.el (gnus-subscribe-newsgroup): use it.
+
+2001-03-15 09:47:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-retrieve-headers): Understand
+ long-form month names.
+
+2001-03-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-show-all-headers):
+ gnus-article-show-all-headers is broken. Use
+ gnus-summary-toggle-header instead.
+
+ * mml2015.el (mml2015-gpg-extract-from): No error.
+
+2001-03-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Bj,Ax(Brn Mork <bmork@dod.no>.
+
+ * mml2015.el (mml2015-gpg-extract-from): New function.
+ (mml2015-gpg-verify): Use it.
+ (mml2015-gpg-clear-verify): Use it.
+
+2001-03-17 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-setup-fill-variables): Use
+ fill-paragraph-function.
+ (message-fill-paragraph): Take an argument.
+ (message-newline-and-reformat): Take another argument.
+
+2001-03-16 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (rmail-output): It is in rmailout.el not rmail.el.
+
+2001-03-16 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-forward): local-variable-p takes an extra
+ argument in XEmacs.
+
+2001-03-16 Simon Josefsson <simon@josefsson.org>
+
+ * nnimap.el (nnimap-dont-use-nov-p): Renamed from
+ `nnimap-use-nov-p' (it really tested the negative).
+ (nnimap-retrieve-headers): Use it.
+
+2001-03-11 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-generate-headers-first): Update doc.
+
+2001-03-10 Matthias Wiehl <mwiehl@gmx.de>
+ Trivial patch.
+
+ * gnus.el (gnus-summary-line-format): Typo.
+
+2001-03-11 Simon Josefsson <simon@josefsson.org>
+
+ * mailcap.el (mailcap-mime-data): Add application/sieve.
+ (mailcap-mime-extensions): Add .siv, .xls.
+
+2001-03-14 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Christoph Conrad <christoph.conrad@gmx.de>
+
+ * gnus-score.el (gnus-summary-lower-thread): Typo.
+
+2001-03-14 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-forward-decoded-p): New variable.
+ (message-forward-subject-author-subject): Use it.
+ (message-make-forward-subject): Use it.
+ (message-forward): Use it.
+
+ * gnus-uu.el (gnus-uu-digest-mail-forward): Use it.
+
+ * mm-util.el, message.el, rfc2047.el, gnus-sum.el, gnus-score.el:
+ Sync with Emacs 21 (tag EMACS_PRETEST_21_0_100).
+
+;;Has been fixed -- zsh.
+;;2001-03-05 Dave Love <fx@gnu.org>
+;;
+;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case.
+;; Move it after definition of mm-coding-system-p.
+;;
+2001-03-01 Dave Love <fx@gnu.org>
+
+ * mm-util.el (mm-inhibit-file-name-handlers): Add
+ image-file-handler.
+
+2001-02-11 Dave Love <fx@gnu.org>
+
+ * message.el (message-signature-file): Fix doc, :type.
+
+2001-02-08 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (rfc2047-fold-region): Don't forward-char at EOB.
+ (message-posting-charset): Defvar when compiling again.
+ (rfc2047-encodable-p): Require message.
+
+ * gnus-sum.el (gnus-alter-articles-to-read-function):
+ * gnus-score.el (gnus-score-after-write-file-function): Fix :type.
+
+2001-03-08 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnrss.el: New file.
+
+2001-03-08 02:41:36 Katsumi Yamaoka <yamaoka@jpl.org>
+ Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2047.el (rfc2047-unfold-region): Fix arg of
+ `skip-chars-forward'.
+
+2001-03-07 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndraft.el (nndraft-request-group): Restore auto save files if
+ the original files do not exist.
+
+2001-03-07 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-score.el (gnus-score-find-bnews): Print messages on illegal
+ SCORE paths.
+
+ * mm-decode.el (mm-dissect-buffer): Call
+ mail-extract-address-components only if necessary.
+
+2001-03-06 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-score.el (gnus-score-find-bnews): Maybe there is no
+ directory part.
+ (gnus-score-search-global-directories): Use file-directory-p.
+
+ * gnus-score.el (gnus-score-score-files-1): Use
+ gnus-kill-files-directory.
+ From Adrian Aichner <adrian@xemacs.org>.
+
+2001-03-05 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (charset): Move here from gnus-sum.el.
+
+2001-03-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-preview): Disable local map.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Make
+ gnus-article-post-menu here.
+
+ * gnus-art.el (gnus-article-make-menu-bar): Make summary-menu bar
+ if it has not been made.
+
+2001-03-02 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-describe-key): Map key to event.
+ (gnus-article-describe-key-briefly): Ditto
+
+2001-03-01 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-limit-include-expunged): Fix.
+
+2001-03-01 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Katsumi Yamaoka <yamaoka@jpl.org>.
+
+ * dgnushack.el (coerce, merge, subseq): defmacro.
+
+2001-03-01 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * lpath.el (nndraft-request-group): Move it here from nndraft.el.
+ A fake defalias in nndraft.el results a not-activated bug in
+ uncompiled versions.
+
+2001-02-26 11:27:27 Paul Jarc <prj@po.cwru.edu>
+ Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-split-references): Handle malformed References:.
+
+2001-02-26 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-mime-part-status): 1 part.
+
+2001-02-25 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From NAGY Andras <nagya@inf.elte.hu>.
+
+ * gnus.el (gnus-parameters): Typo.
+
+2001-02-24 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-read-method): Remove redundancy.
+
+2001-02-23 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnslashdot.el (nnslashdot-backslash-url): New variable.
+ (nnslashdot-request-list): Use it.
+
+2001-02-23 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnml.el (nnml-generate-active-info): Fix the case when there is
+ no file.
+
+ * gnus-sum.el (gnus-summary-import-article): Display it. Enable edit.
+ (gnus-summary-create-article): New function.
+
+ * gnus-group.el (gnus-group-mark-article-read): New function.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Use it.
+
+ * gnus-art.el (gnus-article-edit-article): Set modified-p nil.
+
+2001-02-23 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-edit-done): Don't use
+ gnus-article-edit-exit.
+ (gnus-article-edit-exit): Confirm and insert original-article-buffer.
+
+ * gnus.el (gnus-parameters): New variable.
+ Suggested by NAGY Andras <nagya@inf.elte.hu>.
+ (gnus-parameters-get-parameter): New function.
+ (gnus-group-find-parameter): Use it.
+
+2001-02-23 Simon Josefsson <simon@josefsson.org>
+
+ * gnus-msg.el (gnus-post-method): Fix documentation to reflect
+ change of default value to `current'.
+
+2001-02-23 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nneething.el (nneething-get-head): Insert unreadable file too.
+
+2001-02-22 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-insert-articles): Remove fetched headers.
+
+ * webmail.el (webmail-type-definition): Deja is bought by google.
+
+2001-02-22 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-fetch-headers): New function.
+ (gnus-select-newsgroup): Use it.
+ (gnus-summary-insert-articles): New function.
+ (gnus-summary-insert-old-articles): New function.
+ (gnus-summary-insert-new-articles): New function.
+
+ * gnus-group.el (gnus-group-prepare-flat-list-dead): Use decoded-name.
+ (gnus-group-list-active): Ditto.
+ * gnus-sum.el (gnus-set-mode-line): Ditto.
+ (gnus-summary-read-group-1): Ditto.
+
+2001-02-21 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-topic.el (gnus-topic-get-new-news-this-topic): Redraw the
+ current topic.
+
+2001-02-21 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * smiley.el (gnus-smiley-display): Don't do widening.
+
+ * smiley-ems.el (gnus-smiley-display): Don't do widening. Smiley
+ within body.
+
+ * gnus-msg.el (gnus-inews-do-gcc): Activate group anyway.
+
+ * gnus-art.el (gnus-mime-display-multipart-alternative-as-mixed):
+ New variable.
+ (gnus-mime-display-multipart-related-as-mixed): New variable.
+ (gnus-mime-display-part): Use them.
+
+2001-02-20 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-setup-news): Allow gnus-group-line-format to be
+ something special.
+
+2001-02-20 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnweb.el (nnweb-request-group): Set nnweb-group anyway.
+ (nnweb-request-article): Call reference if exists.
+ (nnweb-type-definition): Dejanews is bought by google.com.
+ Beta!
+
+2001-02-19 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-draft.el (gnus-draft-reminder): "Confirm to exit?"
+
+2001-02-19 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-thread-sort-functions): Doc fix. Refer to
+ gnus-article-sort-functions.
+ (gnus-article-sort-functions): Doc fix. Refer to
+ gnus-thread-sort-functions.
+
+2001-02-18 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+ From Paul Jarc <prj@po.cwru.edu>.
+
+ * message.el (message-get-reply-headers): More fixes.
+
+2001-02-17 Paul Jarc <prj@po.cwru.edu>
+ Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-get-reply-headers): Fix bug with
+ Mail-Followup-To/to-address interaction.
+
+2001-02-17 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-configure-posting-styles): Match header in
+ gnus-article-copy.
+
+2001-02-16 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-do-send-housekeeping): Rename to a better
+ name.
+
+2001-02-16 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-cancel-news): Check article first, then ask
+ yes or no.
+
+2001-02-16 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-type-alist): Add emacs-sources.
+
+2001-02-16 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-range.el (gnus-range-normalize): New function.
+
+2001-02-15 NAGY Andras <nagya@inf.elte.hu>
+
+ * imap.el (imap-gssapi-open): Set imap-c-l-s-first.
+
+2001-02-14 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-server-regenerate-server): Use gnus-get-function.
+
+ * nnagent.el (nnagent-request-regenerate): New function.
+
+ * nnfolder.el (nnfolder-request-regenerate): New deffoo.
+
+ * nnml.el (nnml-generate-nov-databases): Accept argument
+ server. Don't open server if it is opened.
+ (nnml-request-regenerate): Use it. Change to deffoo.
+
+2001-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
+ Committed by ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-define-group-parameter): Fix.
+
+2001-02-14 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-define-group-parameter): Improved.
+
+ * gnus-sum.el (charset): Define parameter.
+ (ignored-charsets): Ditto.
+ (gnus-summary-setup-default-charset): Use them.
+
+ * gnus-start.el (gnus-read-descriptions-file): Use them.
+
+ * gnus-cus.el (gnus-group-parameters): Remove them.
+
+2001-02-14 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-print-article): Redo highlight.
+
+2001-02-13 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-read-group-1): Remove
+ gnus-summary-set-local-parameters.
+ (gnus-summary-setup-buffer): Put it here.
+
+2001-02-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (to-address): Define parameter.
+ (to-list): Ditto.
+ * gnus-art.el (article-hide-boring-headers): Use them.
+ * gnus-msg.el (gnus-post-news): Ditto.
+ * gnus-cus.el (gnus-group-parameters): Remove them.
+
+2001-02-13 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-draft.el (gnus-draft-reminder): New function.
+
+ * gnus-art.el (gnus-sender-save-name): New function.
+
+2001-02-13 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-mime-charset): Error message.
+
+2001-02-13 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-check-news-body-syntax): Don't check mml lines.
+
+2001-02-12 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-topic.el (gnus-subscribe-topics): Return nil if not
+ subscribe.
+
+ * gnus-start.el (gnus-call-subscribe-functions): New function.
+ (gnus-find-new-newsgroups): Use it.
+ (gnus-ask-server-for-new-groups): Use it.
+ (gnus-check-first-time-used): Use it.
+ (gnus-subscribe-newsgroup-method): Grok a list of functions.
+ (gnus-subscribe-options-newsgroup-method): Ditto.
+ (gnus-subscribe-hierarchically): Return gnus-subscribe-newsgroup's
+ return .
+
+2001-02-12 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-cus.el (gnus-score-customize): Doc fix.
+
+2001-02-11 Jesper Harder <harder@ifa.au.dk>
+
+ * dgnushack.el (my-getenv): Typo.
+
+2001-02-11 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (dgnushack-make-load): Don't autoload smiley functions.
+
+2001-02-11 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-suspend): Offer save summaries.
+
+ * gnus-art.el (gnus-treat-leading-whitespace): New variable.
+ (gnus-treatment-function-alist): Use it.
+ (article-remove-leading-whitespace): New function.
+ (gnus-article-make-menu-bar): Use it.
+
+ * gnus-sum.el (gnus-summary-wash-empty-map): Add
+ remove-leading-whitespace.
+ (gnus-summary-wash-map): Bind strip-headers-in-body to `W a',
+ because of conflict.
+
+2001-02-09 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * Makefile.in: Hack generating gnus-load.el.
+ * dgnushack.el: Ditto.
+ * gnus-load.el: Remove it.
+
+2001-02-09 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el : Add URLDIR.
+
+ * Makefile.in (EMACS_COMP): Ditto.
+
+2001-02-09 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-cus.el (gnus-score-customize): Error on no score file.
+
+2001-02-09 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-merge-handles): New function.
+
+ * mm-view.el (mm-inline-message): Use it.
+ (mm-view-message): Ditto.
+
+ * mm-partial.el (mm-inline-partial): Ditto.
+
+ * mm-extern.el (mm-inline-external-body): Ditto.
+
+ * gnus-art.el (gnus-mime-view-part): Ditto.
+ (gnus-mime-view-part-as-type): Ditto.
+ (gnus-mime-save-part-and-strip): Prevent users to strip in some
+ cases.
+
+2001-02-08 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-cancel-news): Allow to shoot foot.
+ (message-supersede): Ditto.
+
+2001-02-08 Tommi Vainikainen <thv@iki.fi>
+ Trivial patch.
+
+ * gnus-sum.el (gnus-simplify-subject-re): Use
+ message-subject-re-regexp.
+
+2001-02-08 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-expiry-target-group): Bind
+ nnmail-cache-accepted-message-ids to nil.
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Use binary
+ coding system.
+
+2001-02-07 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * qp.el (quoted-printable-encode-region): Make sure characters are
+ between 00 and FF. Don't check charset.
+
+ * mm-encode.el (mm-encode-content-transfer-encoding): Use unibyte
+ in Emacs 20.
+ * rfc2047.el (rfc2047-q-encode-region): Ditto.
+
+2001-02-07 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-make-forward-subject): Argument decoded.
+ (message-forward): Use it when digest.
+
+ * gnus-uu.el (gnus-uu-grab-articles): Shoot down original article
+ buffer.
+
+2001-02-07 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * message.el (message-generate-headers-first): Doc fix.
+
+2001-02-07 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-make-date-line): Error proof.
+
+2001-02-06 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-listing-limit): New variable.
+ (gnus-group-prepare-flat-list-dead): Use old trick to speed up.
+
+ * gnus-topic.el (gnus-group-prepare-topics): Use gnus-killed-hashtb.
+
+2001-02-06 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-newline-and-reformat): Special case for
+ breaking at BOL.
+
+2001-02-06 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-uu.el (gnus-uu-save-article): Make the topics summary a
+ message/rfc822.
+
+2001-02-06 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-encode-message-body): Don't insert
+ Content-Type if it is inside a mail.
+
+2001-02-06 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-xmas-article-menu-add): Add
+ gnus-article-commands-menu.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar
+ in Emacs.
+
+ * gnus-start.el (gnus-read-descriptions-file): Use
+ gnus-group-name-charset and gnus-group-charset-alist.
+
+2001-02-04 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-mark-as-processable): Understand
+ active region.
+
+ * gnus-start.el (gnus-group-change-level): Remove from both
+ gnus-zombie-list and gnus-killed-list.
+
+2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-subscribe-options-newsgroup-method): Add
+ gnus-subscribe-topics.
+
+ * gnus-cus.el (gnus-extra-topic-parameters): Fix doc.
+
+2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-make-menu-bar): Make
+ gnus-article-post-menu.
+
+ * gnus-xmas.el (gnus-xmas-article-menu-add): Add post menu.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Use t if XEmacs.
+
+ * gnus-group.el (gnus-group-make-menu-bar): Ditto.
+
+ * message.el (message-mode-menu): Ditto.
+
+ * gnus-art.el (defvar): eval-when-compile.
+
+2001-02-02 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agentize): Fix doc.
+
+2001-02-02 Karl Kleinpaste <karl@charcoal.com>
+
+ * mml.el (mml-preview): Bind `q'.
+
+2001-02-02 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-mime-mule-charset-alist): non-Mule case.
+
+2001-01-31 Dave Love <fx@gnu.org>
+
+ * mm-util.el (mm-mime-mule-charset-alist)
+ (mm-find-mime-charset-region): Consider mule-utf-8.
+
+2001-01-31 Dave Love <fx@gnu.org>
+
+ * gnus-art.el (gnus-article-x-face-command)
+ (gnus-treat-display-xface, gnus-treat-display-smileys): Add
+ :version.
+
+2001-01-26 Dave Love <fx@gnu.org>
+
+ * mm-util.el (mm-multibyte-string-p): New.
+
+;; * qp.el: Remove un-logged bogus changes from 2000-12-20.
+;; (quoted-printable-encode-region): Doc fix. Don't call
+;; string-as-multibyte on class. Clarify line-folding.
+ (quoted-printable-encode-string): Make temp buffer inherit
+ string's multibyteness.
+
+2001-01-23 Gerd Moellmann <gerd@gnu.org>
+
+ * nnheader.el (toplevel): Don't require `gnus-util' at
+ compile-time; this creates a circular dependency, and prevents
+ a bootstrap.
+
+2001-01-22 Andreas Schwab <schwab@suse.de>
+
+ * nnheader.el (gnus-delete-line): Autoload it as a macro.
+
+2001-01-31 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-remove-list-identifiers): Use consp.
+
+ * gnus-art.el (article-hide-list-identifiers): Ditto.
+
+ * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto.
+
+2001-01-31 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-remove-list-identifiers): Similar.
+
+ * gnus-art.el (article-hide-list-identifiers): Similar.
+
+2001-01-31 Karl Kleinpaste <karl@charcoal.com>
+
+ * nnmail.el (nnmail-remove-list-identifiers): Improved.
+
+2001-01-31 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-score.el (gnus-summary-score-entry): match may be an integer.
+
+2001-01-30 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-string-equal): New function.
+
+ * gnus-art.el (article-hide-boring-headers): Use it.
+
+2001-01-27 Karl Kleinpaste <karl@charcoal.com>
+
+ * gnus-art.el (gnus-article-banner-alist): eGroups new banner.
+
+2001-01-27 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-msg-mail): Support switch-action.
+
+2001-01-26 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-summary-save-in-pipe): Prompt for saving
+ command if there is not last-saver.
+
+2001-01-24 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-open-connection): 201 is possible.
+
+2001-01-24 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2047.el (rfc2047-encode): MIME charset is not coding system.
+ (rfc2047-charset-encoding-alist): Add big5.
+
+2001-01-24 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-add-server): Redraw the line.
+ (gnus-agent-remove-server): Ditto.
+ (autoload): gnus-server-update-server.
+
+ * gnus-srvr.el (gnus-server-line-format): Add %a.
+ (gnus-server-line-format-alist): Add gnus-tmp-agent.
+ (gnus-server-insert-server-line): Use it.
+
+2001-01-24 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-mime-mule-charset-alist): Preferred MIME names
+ GB2312 and Big5.
+
+2001-01-24 Simon Josefsson <sj@extundo.com>
+
+ * mail-source.el (mail-sources): Add :program specifier to IMAP
+ mail source.
+ (mail-source-fetch-imap): Map :program to `imap-shell-program'.
+
+2001-01-24 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-score.el (gnus-score-lower-thread): Fix a doc typo.
+
+2001-01-24 12:22:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-wait-for): Return the success code.
+ (nntp-open-connection): Use it.
+
+2001-01-11 11:49:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-int.el (gnus-check-server): Allow breaking the opening.
+
+2001-01-23 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-print-article): Remove process mark.
+
+2001-01-22 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-print-article): Take one prefix
+ argument. Allow to print several articles in one file.
+
+2001-01-21 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * webmail.el (webmail-type-definition): netaddress changes.
+
+2001-01-21 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: Fix copyright. Remove trailing spaces.
+
+ * message.el (message-forward): Use mule4.
+
+2001-01-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-string-as-unibyte): New function.
+
+ * message.el (message-forward): Use it.
+
+2001-01-19 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-cite-original-without-signature): Don't peel
+ off the blank line.
+ (message-get-reply-headers): Add Cc if it is not in follow-to.
+
+2001-01-20 Simon Josefsson <sj@extundo.com>
+
+ * mm-decode.el (mm-handle-multipart-from): Add.
+ (mm-dissect-buffer): Save From: header value.
+ (mm-security-from): Remove.
+ (mm-possibly-verify-or-decrypt): Don't set mm-security-from.
+
+ * mml-smime.el (mml-smime-verify): Use `mm-handle-multipart-from'
+ instead of `mml-security-from'. Protect null from value.
+
+2001-01-20 Simon Josefsson <sj@extundo.com>
+
+ * mailcap.el (mailcap-mime-data): Run `gnumeric' on
+ application/vnd.ms-excel attachments.
+
+2001-01-19 Simon Josefsson <sj@extundo.com>
+
+ * gnus-art.el (gnus-button-alist): Add `?=' to mailto URL regexp.
+
+2001-01-19 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-ignored-mail-headers): Ditto.
+
+2001-01-19 Simon Josefsson <sj@extundo.com>
+
+ * message.el (message-ignored-news-headers): Only search beginning
+ of line.
+
+2001-01-19 ShengHuo Zhu <zsh@cs.rochester.edu>
+ Trivial patch from Alberto Lusiani <a.lusiani@noemail.org>
+
+ * message.el (message-send-mail): Content-Type may not be there.
+
+2001-01-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ems.el (gnus-article-display-xface): Add BUFFER.
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Ditto.
+
+ * gnus-art.el (article-display-x-face): Insert X-Face if there is
+ not.
+
+2001-01-18 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-read-group-1): Don't test dead
+ non-native groups.
+
+2001-01-18 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-yank-original): Understand
+ universal-argument.
+
+2001-01-18 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-boring-article-headers): Add to-address.
+ (article-hide-boring-headers): Ditto.
+
+ * mm-view.el (mm-inline-message): Insert a newline unless bolp.
+
+2001-01-18 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2047.el (rfc2047-fold-region): Don't insert LWSP if there is
+ one.
+
+2001-01-16 Simon Josefsson <simon@josefsson.org>
+
+ * message.el (message-make-in-reply-to): Add comment to message-id
+ (old syntax, see 2000-08-02 change).
+
+2001-01-16 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-url-mailto): Use gnus-msg-mail.
+ (gnus-button-mailto): Setup message. Moved to gnus-msg.el.
+ (gnus-button-reply): Ditto.
+
+2001-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-display-x-face): Fix.
+
+2001-01-15 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-display-x-face): Use
+ gnus-original-article-buffer.
+
+2001-01-15 Jack Twilley <jmt@tbe.net>
+
+ * message.el (message-add-header): Move to point-max.
+
+2001-01-15 Simon Josefsson <simon@josefsson.org>
+
+ * smime.el (smime-CA-directory, smime-CA-file): Change default to
+ nil, improve documentation.
+ (smime-certificate-directory): Comment out false hints (until it
+ is implemented).
+
+ * mml-smime.el (mml-smime-sign): Place user in customize buffer if
+ there aren't any keys.
+ (mml-smime-verify): If smime-CA-{file,directory} set, also try to
+ verify certificate. Default is changed to only check integrity.
+ Improved security status texts. If a certificate doesn't contain
+ a email address, don't fail.
+
+ * smime.el (smime-noverify-region):
+ (smime-noverify-buffer): New functions. Verifies integrity only.
+
+2001-01-12 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-sort-by-score): Reverse order.
+
+2001-01-12 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-configure-windows): switch-to-buffer in XEmacs.
+ (gnus-remove-some-windows): Ditto.
+
+2001-01-12 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-make-date-line): 11th.
+
+2001-01-11 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-gpg-encrypt): Remove CR.
+ (mml2015-gpg-sign): Ditto.
+
+2001-01-10 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: Sync with EMACS_PRETEST_21_0_95.
+ * gnus.el (gnus-default-posting-charset): Bogus. Removed.
+
+2001-01-08 Dave Love <fx@gnu.org>
+
+ * mm-encode.el (mm-qp-or-base64): Don't base64 for the sake of a
+ single character.
+
+ * mm-util.el (mm-mime-mule-charset-alist): Add Latin-{8,9}.
+
+ * message.el: Doc and message fixes.
+ (message-send-rename-function)
+ (message-make-forward-subject-function)
+ (message-send-mail-function, message-reply-to-function)
+ (message-wide-reply-to-function, message-followup-to-function)
+ (message-distribution-function, message-auto-save-directory): Fix
+ :type.
+
+ * gnus/mml.el (mml-parse-1): Frob mml-confirmation-set when
+ proceeding after warnings. Amend multipart warning message.
+
+2001-01-04 Dave Love <fx@gnu.org>
+
+ * gnus-util.el (nnmail-pathname-coding-system): Defvar when
+ compiling.
+ (gnus-make-directory): Require nnmail.
+
+ * mm-decode.el (mm-inline-media-tests): Add
+ image/x-portable-bitmap.
+ (mm-get-image): Grok pbm.
+
+2001-01-10 Paul Stevenson <p.stevenson@surrey.ac.uk>
+
+ * nnvirtual.el (nnvirtual-request-expire-articles): delq nil.
+
+2001-01-09 Didier Verna <didier@xemacs.org>
+
+ * dgnushack.el (dgnushack-compile): give a dummy value to
+ `gnus-xmas-glyph-directory' for the time of compilation.
+ * gnus-agent.el: moved some XEmacs specific hook add-ons from
+ `gnus-xmas-[re]define' to avoid loosing user custom settings.
+ * gnus-art.el: ditto.
+ * gnus-group.el: ditto.
+ * gnus-salt.el: ditto.
+ * gnus-sum.el: ditto.
+ * gnus-topic.el: ditto.
+ * gnus-xmas.el (gnus-xmas-define): see above.
+ * gnus-xmas.el (gnus-xmas-redefine): see above.
+ * gnus-xmas.el (gnus-xmas-glyph-directory): generate a
+ non-continuable error when the directory can't be found.
+
+2001-01-09 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-interactively-view-part): Don't copy-sequence
+ handle.
+ * gnus-art.el (gnus-mime-view-part): Copy it.
+ (gnus-mime-view-part-as-type): Add into gnus-article-mime-handles.
+
+2001-01-09 Michael Downes <mjd@ams.org>
+
+ * gnus-sum.el (gnus-summary-read-group-1): More useful message.
+
+2001-01-08 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-get-new-mail): Find group only if file is not
+ orig-file. Use ',source.
+
+2001-01-08 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-xmas-modeline-glyph):
+ (gnus-xmas-group-startup-message):
+ Detect gnus-xmas-glyph-directory when it is nil.
+
+2001-01-08 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * pop3.el (pop3-get-message-count): Andrew Innes
+ <andrewi@gnu.org>'s patch of 1999-12-01 was not fully committed.
+
+2001-01-05 06:49:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-fetch-session): Say what we quit.
+
+ * time-date.el (time-to-number-of-days): New function.
+
+2001-01-04 11:06:14 Gregory Chernov <greg@visiontech-dml.com>
+ Trivial patch.
+
+ * nnslashdot.el (nnslashdot-request-list): Always get the right
+ sid.
+
+2001-01-05 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-minibuffer-local-map): New keymap.
+ (message-read-from-minibuffer): Use it.
+ * gnus-msg.el (gnus-summary-resend-message): Use it
+
+2001-01-04 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-display-time-event-handler): New function.
+ (gnus-after-getting-new-news-hook): Use it.
+
+2001-01-03 07:26:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-ignored-mail-headers): Add draft header.
+
+2001-01-02 06:28:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-expire-articles): Don't save
+ excursion.
+
+ * nnslashdot.el (nnslashdot-request-list): Get the right year.
+
+2001-01-01 00:52:44 Ed L. Cashin <ecashin@coe.uga.edu>
+ A revoked patch.
+
+ * gnus-sum.el (gnus-summary-expire-articles): Save excursion.
+
+2000-12-31 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * qp.el (quoted-printable-decode-region): Don't backward-char.
+
+2000-12-31 03:57:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-draft.el: Mark articles as replied.
+
+ * gnus-sum.el (gnus-summary-add-mark): New function.
+
+ * gnus-group.el (gnus-add-mark): New function.
+
+ * gnus-sum.el (gnus-summary-buffer-name): New function.
+ (gnus-summary-setup-buffer): Use it.
+
+ * gnus-draft.el: Set things up with the right post method and
+ stuff.
+
+ * message.el (message-ignored-news-headers): Remove X-Draft-From.
+
+ * gnus-msg.el (gnus-inews-insert-draft-meta-information): New function.
+
+ * gnus.el (gnus-draft-meta-information-header): New variable.
+
+2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treatment-function-alist): Move the date
+ functions before the header sorting functions.
+
+ * mm-uu.el (mm-uu-pgp-signed-extract-1): Unquote "- " quotes.
+
+ * dgnushack.el (dgnushack-compile): Message whether there is w3.
+ Don't (push "/usr/share/emacs/site-lisp" load-path).
+
+ * gnus-cite.el (gnus-article-fill-cited-article): Don't add space
+ to empty fill prefixes.
+
+2000-12-30 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-open-connection): Kill pbuffer if process is nil.
+ Suggested by Christoph Conrad <christoph.conrad@gmx.de>.
+
+2000-12-30 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnheader.el (autoload): Autoload gnus-sorted-intersection.
+
+ * nnml.el (autoload): Move to nnheader.el.
+
+ * nnfolder.el (nnfolder-existing-articles): Reversed, i.e. sorted.
+ (nnfolder-request-expire-articles): Use gnus-sorted-intersection.
+ (nnfolder-retrieve-headers): Use intersection. Suggested by Jonas
+ Kvarnstr,Av(Bm <jonkv@ida.liu.se>.
+
+2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-make-date-line): Get the hours right.
+ (gnus-ignored-headers): More hiding.
+
+ * nnmail.el (nnmail-expiry-wait): Not an integer.
+
+ * message.el (message-goto-body): Only expand abbrev when called
+ interactively.
+ (message-make-lines): Use it.
+
+2000-12-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-inews-yank-articles): Reparse headers.
+
+2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-limit-include-expunged): Really
+ include the expunged articles.
+
+ * gnus-group.el (gnus-group-sort-by-server): New function.
+
+ * gnus.el (gnus-method-to-server-name): New function.
+ (gnus-group-prefixed-name): Use it.
+
+ * gnus-group.el (gnus-group-sort-function): Doc fix.
+ (gnus-group-sort-groups-by-server): New command.
+
+2000-12-29 13:25:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treat-date-english): New variable.
+ (article-date-english): New command.
+ (gnus-english-month-names): New variable.
+ (article-make-date-line): Do 'english.
+
+ * gnus-cite.el (gnus-article-fill-cited-article): Add a space
+ after the fill prefix.
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter
+ score...".
+
+ * gnus-art.el (gnus-ignored-headers): Hide more headers.
+
+ * message.el (message-mode-map): Bind comment-region.
+
+ * gnus-art.el (gnus-mime-display-part): Let w3 display
+ multipart/related.
+
+ * mm-bodies.el (mm-long-lines-p): New function.
+ (mm-body-encoding): Use it.
+ (mm-body-encoding): Encode articles with lines longer than 1000
+ characters.
+
+2000-12-29 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-enable-multibyte): Use
+ default-enable-multibyte-characters.
+ (mm-enable-multibyte-mule4): Ditto.
+ (mm-disable-multibyte): Test XEmacs.
+ (mm-disable-multibyte-mule4): Ditto.
+ (mm-with-unibyte-current-buffer): Simplified.
+ (mm-with-unibyte-current-buffer-mule4): Ditto.
+
+2000-12-28 19:44:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnheaderxm.el (nnheader-string-as-multibyte): New alias.
+
+ * nnheader.el (nnheader-string-as-multibyte): New alias.
+
+ * mm-view.el (mm-inline-text): Warn when bugging out in w3.
+
+ * gnus-uu.el (gnus-message-process-mark): New function.
+ (gnus-uu-mark-by-regexp): Use it.
+ (gnus-new-processable): New function.
+
+2000-12-28 19:21:57 Inge Frick <inge@nada.kth.se>
+ Trivial patch.
+
+ * gnus-sum.el (gnus-no-mark): New variable.
+
+2000-11-01 01:12:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnwfm.el (nnwfm-create-mapping): Remove quote marks and
+ backslashes.
+
+2000-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-banner-alist): Remove duplicate
+ definition.
+
+2000-12-25 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (dgnushack-compile): elc is in the current directory.
+
+ * qp.el (quoted-printable-encode-region): Don't check multibyte in
+ XEmacs.
+
+2000-12-25 Lloyd Zusman <ljz@asfast.com>
+ Trivial patch.
+
+ * mml.el (mml-read-tag): Save tag location.
+
+2000-12-25 Simon Josefsson <simon@josefsson.org>
+
+ * starttls.el: Sync with Emacs 21.
+
+2000-12-24 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-mail): Support yank-action.
+
+ * message.el (message-setup): Revoke the last change.
+
+2000-12-24 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-setup): Use cons. Suggested by Johan Vromans
+ <jvromans@squirrel.nl>.
+
+2000-12-24 Simon Josefsson <sj@extundo.com>
+
+ * mm-bodies.el (mm-decode-content-transfer-encoding): Preserve
+ mailing list junk at end of part.
+
+2000-12-23 Simon Josefsson <sj@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): New function.
+ (nnimap-request-expire-articles): Use it.
+
+2000-12-22 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-group-parameters-more): New variable.
+ * gnus-cus.el (gnus-group-customize): Use it.
+
+ * gnus.el (gnus-define-group-parameter): New macro.
+ (auto-expire): Use it
+ (total-expire): Use it.
+ * gnus-art.el (banner): Use it.
+
+ * mml.el (mml-parse): save-excursion. Suggested by Lloyd Zusman
+ <ljz@asfast.com>.
+
+2000-12-22 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-topic.el (gnus-topic-create-topic): Use list.
+
+ * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art
+ before binding gnus-default-article-saver.
+
+ * gnus-sum.el (gnus-summary-save-article):
+ (gnus-summary-pipe-output):
+ (gnus-summary-save-article-mail):
+ (gnus-summary-save-article-rmail):
+ (gnus-summary-save-article-file):
+ (gnus-summary-write-article-file):
+ (gnus-summary-save-article-body-file): Ditto.
+
+ * gnus-mh.el (gnus-summary-save-article-folder): Ditto.
+
+2000-12-22 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-security-button-map):
+ (gnus-mime-button-map): Add parent.
+
+2000-12-22 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * messagexmas.el (message-xmas-redefine): New function.
+
+ * message.el: Use it.
+
+ * gnus-art.el (gnus-article-check-hidden-text): Return t.
+
+ * gnus-util.el (gnus-remove-text-properties-when): Return t.
+
+2000-12-22 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-dissect-multipart): Avoid errors owing to
+ malformatted messages.
+
+2000-12-22 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-image-load-path): New function.
+
+ * gnus-group.el (gnus-group-make-tool-bar): Use it.
+
+ * gnus-sum.el (gnus-summary-make-tool-bar): Use it.
+
+ * message.el (message-tool-bar-map): Use it.
+
+ * Makefile.in (install-el): New rule.
+
+2000-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-treat-dumbquotes): Quote \.
+
+2000-12-21 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-treat-emphasize): Don't treat emphasis if
+ Emacs 20 runs on a terminal.
+
+2000-12-21 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-bug): Revert to save-excursion.
+
+ * mml.el (gnus-add-minor-mode): Autoload.
+
+ * message.el (message-forward): Save-restriction.
+
+2000-12-21 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-art.el (article-treat-dumbquotes): More doc, provided by
+ Paul Stevenson <p.stevenson@surrey.ac.uk>
+
+2000-12-21 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ml.el (gnus-mailing-list-mode-map): Use C-c C-n prefix.
+
+ * mml.el (gnus-ems): Don't require.
+
+ * gnus.el (gnus-decode-rfc1522): Removed.
+ (gnus-set-text-properties): Define.
+
+2000-12-21 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-*): handle may be nil.
+
+ * gnus-sum.el (gnus-summary-mode): Turn on gnus-mailing-list-mode.
+
+ * gnus.el (gnus-group-remove-excess-properties): Not defined
+ in gnus-xmas.
+
+2000-12-20 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-mail-user-agent): Add :version.
+
+2000-12-21 Miles Bader <miles@gnu.org>
+
+ * message.el (message-mode): Set `comment-start' to the yank prefix.
+
+2000-12-20 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-mail-user-agent): New variable.
+ (message-setup): Renamed to message-setup-1. Support
+ mail-user-agent.
+ (message-mail-user-agent): New function.
+ (message-mail): Use it.
+ (message-reply): Use it.
+ (message-resend): Use it.
+ (message-mail-other-window): Use it.
+ (message-mail-other-frame): Use it.
+
+ * gnus-msg.el (gnus-bug): Support mail-user-agent.
+
+2000-12-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-tool-bar-map): Simplify.
+ (message-narrow-to-head-1): New function.
+ (message-narrow-to-head): Use it.
+ (message-reply): Ditto.
+ (message-cancel-news): Ditto.
+ (message-supersede): Ditto.
+ (message-make-forward-subject): Ditto.
+ (message-bounce): Ditto.
+
+2000-12-20 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * uudecode.el (uudecode-decode-region-external): make-temp-file
+ may not be defined.
+
+ * binhex.el (defalias): eval-and-compile.
+
+ * message.el (message-tool-bar-map): New function.
+ (message-mode): Use it.
+
+2000-12-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-find-connection): Remove the entry.
+ (nntp-retrieve-groups): (gnus-buffer-live-p buf).
+
+2000-12-20 05:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-summary-mail-forward): Use original buffer.
+
+ * message.el (message-forward): Copy buffer in unibyte mode.
+
+2000-12-20 04:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-make-forward-subject): Don't widen. Decode.
+ (message-forward): Don't decode subject.
+
+2000-12-20 Christoph Conrad <C.Conrad@cli.de>
+
+ * qp.el (quoted-printable-encode-region): Upcase QP.
+
+2000-12-20 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Use
+ mail-extract-a-c instead. Don't depend on Gnus.
+
+ * mml.el (gnus-ems): Require it.
+
+ * gnus-msg.el (gnus-summary-mail-forward):
+
+ * message.el (message-forward): Move mime-to-mml here.
+
+2000-12-20 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el, gnus-sum.el, message.el: Add :help unless Emacs.
+ * gnus-art.el (gnus-insert-mime-button): Simplify.
+ (gnus-mime-display-alternative): Ditto.
+ (gnus-insert-mime-security-button): Ditto.
+
+2000-12-20 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-add-text-properties-when): In XEmacs,
+ text-property-not-all doesn't return nil when start=mark(end).
+ (gnus-remove-text-properties-when): Ditto.
+
+2000-12-20 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-group-change-level): Remove group from
+ gnus-active-hashtb if real killed.
+
+2000-12-19 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-insert-mime-button): Emacs20 needs local-map.
+ (gnus-mime-display-alternative): Ditto.
+ (gnus-insert-mime-security-button): Ditto.
+
+2000-12-19 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-start.el (gnus-group-change-level): Don't add it into
+ killed-list if it was killed.
+
+2000-12-19 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmbox.el (nnmbox-file-coding-system): Use binary.
+ (nnmbox-active-file-coding-system): Ditto.
+
+ * gnus-cus.el (gnus-group-parameters): Add posting-style.
+
+2000-12-19 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-version):
+ (gnus-version-number): Set to Oort Gnus 0.01.
+
+ * gnus-art.el (gnus-mime-security-button-map):
+ (gnus-insert-mime-security-button): Fix for Emacs21.
+
+2000-12-19 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el, gnus-sum.el, message.el: Comment out :help in
+ easymenu, because XEmacs doesn't understand :help.
+
+ * mm-uu.el: Require binhex.
+
+2000-12-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: Merged. Emacs21 CVS tag is zsh-merge-ognus-1.
+
+2000-12-19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-charset-synonym-alist): Fix a typo.
+
+2000-12-18 Gerd Moellmann <gerd@gnu.org>
+
+ * *.xpm, *.pbm: Convert icons icons to size 24x24.
+
+2000-12-18 Dave Love <fx@gnu.org>
+
+ * gnus-msg.el (news-setup, news-reply-mode): Don't autoload
+ (unused).
+
+2000-12-13 Miles Bader <miles@gnu.org>
+
+ * smiley-ems.el (smiley-region): Bind `inhibit-point-motion-hooks'
+ to t, so that we don't get stuck while trying to smilefy
+ intangible text.
+
+2000-12-12 Gerd Moellmann <gerd@gnu.org>
+
+ * smiley-ems.el (smiley-regexp-alist): Make regexps match
+ at the end of the buffer.
+ (smiley-region): In the loop, move to the end of the submatch
+ matching the smiley instead of using the end of the match
+ of the whole regexp.
+
+2000-12-12 Eli Zaretskii <eliz@is.elta.co.il>
+
+ * message.el (message-mode): Doc fix.
+
+2000-12-12 Gerd Moellmann <gerd@gnu.org>
+
+ * smiley-ems.el (smiley-region): Doc fix.
+
+2000-12-11 Miles Bader <miles@gnu.org>
+
+ * gnus-sum.el (gnus-summary-recenter): When trying to keep the
+ bottom line visible, check to see if it's partially obscured, and
+ if so, either scroll one more line to make it fully visible, or
+ revert to showing the second line from the top.
+
+2000-12-07 Dave Love <fx@gnu.org>
+
+ * mailcap.el (mailcap-download-directory)
+ * gnus-audio.el (gnus-audio-directory)
+ * smiley-ems.el (smiley-data-directory): Fix :type.
+
+2000-11-30 Dave Love <fx@gnu.org>
+
+ * message.el (message-auto-save-directory): Use
+ file-name-as-directory.
+ (message-set-auto-save-file-name): Create
+ message-auto-save-directory if necessary.
+ (message-replace-chars-in-string): Removed -- unused.
+ (message-mail-alias-type): Customize.
+ (message-headers): Remove duplicate defgroup.
+
+2000-11-29 Dave Love <fx@gnu.org>
+
+ * qp.el (quoted-printable-decode-region): Use error, not message
+ to report malformed text (like base64). Amend message.
+
+2000-11-29 Miles Bader <miles@gnu.org>
+
+ * message.el (message-header-lines): Fontify tag.
+
+2000-11-27 Dave Love <fx@gnu.org>
+
+ * nnlistserv.el: Ignore errors when requiring nnweb and avoid a
+ compiler warning.
+
+;2000-11-26 Dave Love <fx@gnu.org>
+;
+; * mm-uu.el (mm-uu-configure-list): Fix typo in :type.
+;
+2000-11-23 Dave Love <fx@gnu.org>
+
+ * uu-post.pbm, uu-decode.pbm: new files from XPMs.
+
+ * mm-uu.el (uudecode): Require.
+ (uudecode-decode-region, uudecode-decode-region-external): Don't
+ autoload.
+ (mm-uu-copy-to-buffer): Doc fix.
+ (mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom
+ type fix.
+
+ * mailcap.el: Doc fixes.
+ (mailcap-mime-data): Various adjustments.
+ (mailcap): New group.
+ (mailcap-download-directory): Customize.
+ (mailcap-generate-unique-filename, mailcap-binary-suffixes)
+ (mailcap-temporary-directory): Deleted (unused).
+ (mailcap-unescape-mime-test): Simplify slightly.
+ (mailcap-viewer-passes-test): Use functionp.
+ (mailcap-command-p): Aliased to executable-find.
+
+ * rfc2047.el (rfc2047-encode-message-header): Don't encode if
+ default-enable-multibyte-characters is nil.
+
+2000-11-22 Gerd Moellmann <gerd@gnu.org>
+
+ * gnus-group.el (gnus-group-make-tool-bar): Fix a paren typo.
+
+2000-11-21 Dave Love <fx@gnu.org>
+
+ * gnus-art.el (gnus-mime-button-map): Don't inherit from
+ gnus-article-mode-map.
+; (gnus-mime-button-menu): Use mouse-set-point.
+ (gnus-insert-mime-button, gnus-mime-display-alternative)
+ (gnus-mime-display-alternative): Don't use local-map property.
+
+2000-11-17 Dave Love <fx@gnu.org>
+
+ * uudecode.el (uudecode-insert-char): Fix bogus feature test.
+ (uudecode-decode-region-external): Doc fix. Use with-temp-buffer
+ and make-temp-file.
+ (uudecode-decode-region): Doc fix.
+
+2000-11-14 Dave Love <fx@gnu.org>
+
+ * cu-exit.pbm, exit-summ.pbm, followup.pbm, fuwo.pbm:
+ * mail-reply.pbm, next-ur.pbm, post.pbm, prev-ur.pbm:
+ * reply-wo.pbm, reply.pbm, rot13.pbm, save-aif.pbm, save-art.pbm:
+ New files, derived from the XPMs.
+
+2000-11-10 Dave Love <fx@gnu.org>
+
+ * gnus-agent.el (gnus-agent-confirmation-function): Add :version.
+ (gnus-agent-lib-file, gnus-agent-load-alist)
+ (gnus-agent-save-alist, gnus-agent-article-name): Use
+ expand-file-name.
+
+ * gnus-group.el (gnus-group-name-charset-method-alist): Add
+ :version.
+ (nnkiboze-score-file): Defvar when compiling.
+
+ * gnus-start.el (gnus-read-newsrc-file): Add :version.
+
+ * gnus-art.el (gnus-article-banner-alist)
+ (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types)
+ (gnus-article-date-lapsed-new-header)
+ (gnus-article-mime-match-handle-function, gnus-mime-action-alist)
+ (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601)
+ (gnus-treat-strip-headers-in-body)
+ (gnus-treat-capitalize-sentences, gnus-treat-play-sounds)
+ (gnus-treat-translate): Add :version.
+ (gnus-article-mime-part-function): Fix defcustom.
+
+ * nnmail.el (nnmail-expiry-target)
+ (nnmail-scan-directory-mail-source-once, nnmail-extra-headers)
+ (nnmail-split-header-length-limit): Add :version.
+
+ * gnus-sum.el (gnus-auto-expirable-marks)
+ (gnus-inhibit-user-auto-expire, gnus-list-identifiers)
+ (gnus-extra-headers, gnus-ignored-from-addresses)
+ (gnus-newsgroup-ignored-charsets)
+ (gnus-group-highlight-words-alist)
+ (gnus-summary-show-article-charset-alist): Add :version.
+
+ * catchup.pbm, describe-group.pbm, exit-gnus.pbm, get-news.pbm:
+ gnntg.pbm, kill-group.pbm, subscribe.pbm, unsubscribe.pbm: New
+ files, converted from the XPMs.
+
+ * gnus-cache.el (gnus-cache-active-file): Don't use
+ file-name-as-directory on directory.
+ (gnus-cache-file-name): Use expand-file-name, not concat. Don't
+ use file-name-as-directory on directory.
+
+ * time-date.el (timezone-make-date-arpa-standard): Autoload.
+ (date-to-time): Use it.
+
+; * message.el (message-mode) <adaptive-fill-regexp>:
+; <adaptive-fill-first-line-regexp>: Use [:alnum:] in regexp range.
+; (message-newline-and-reformat): Likewise.
+ (message-forward-as-mime, message-forward-ignored-headers)
+ (message-buffer-naming-style, message-default-charset)
+ (message-dont-reply-to-names, message-send-mail-partially-limit):
+ Add :version.
+
+ * mm-util.el: Doc fixes.
+ (mm-mime-charset): Don't use the raw result of
+ mm-preferred-coding-system.
+ (mm-with-unibyte-buffer, mm-with-unibyte-current-buffer)
+ (mm-with-unibyte): Simplify.
+
+ * gnus-int.el (gnus-start-news-server): Use expand-file-name, not
+ concat.
+
+ * pop3.el (pop3-version): Deleted.
+ (pop3-make-date): New function, avoiding message-make-date.
+ (pop3-munge-message-separator): Use it.
+
+2000-11-09 Dave Love <fx@gnu.org>
+
+ * gnus-group.el (gnus-group-make-directory-group)
+ (gnus-group-fetch-faq): Use expand-file-name.
+ (gnus-group-fetch-faq): Simplify completing-read form.
+
+ * mm-bodies.el (mm-encode-body): Use mm-multibyte-p, don't just
+ test for Mule.
+
+ * message.el (tool-bar-map): Defvar when compiling.
+
+ * gnus-setup.el (running-xemacs, gnus-use-installed-tm)
+ (gnus-tm-lisp-directory): Deleted.
+ (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use
+ (featurep 'xemacs).
+ (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory)
+ (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove
+ version numbers from file names.
+
+2000-11-08 Dave Love <fx@gnu.org>
+
+ * mm-view.el: Use featurep for XEmacs test.
+ (mm-inline-message): Test for `remove-specifier'; don't use
+ condition-case.
+
+ * mm-bodies.el (mm-encode-body): Use mm-multibyte-p.
+
+ * gnus-score.el (gnus-score-load-file): Use expand-file-name.
+ (gnus-score-find-bnews): Don't concat "".
+
+ * cu-exit.xpm, prev-ur.xpm, next-ur.xpm, post.xpm, fuwo.xpm:
+ * followup.xpm, uu-post.xpm, uu-decode.xpm, mail-reply.xpm:
+ * reply.xpm, reply-wo.xpm, rot13.xpm, save-aif.xpm, save-art.xpm:
+ * exit-summ.xpm: New files, renamed from icons by Luis Fernandes.
+
+ * gnus-sum.el: Put some defvars in eval-when-compile.
+ (gnus-summary-mode-hook): Add :options.
+ (gnus-summary-make-menu-bar): Add some :help, used by tool bar.
+ (gnus-summary-tool-bar-map): New variable.
+ (gnus-summary-make-tool-bar): New function.
+ (gnus-summary-mode): Put kill-all-local-variables first.
+
+ * gnus-group.el (gnus-group-toolbar-map): New variable.
+ (gnus-group-make-tool-bar): Rewritten.
+ (gnus-group-mode): Put kill-all-local-variables first.
+
+ * rfc2047.el: Require gnus-util.
+
+ * nnml.el (gnus-sorted-intersection): Autoload.
+
+ * nnheader.el: Wrap subst-char-in-string def in eval-and-compile.
+ Put some defvars in eval-when-compile.
+ (gnus-intersection, gnus-sorted-complement): Autoload.
+
+ * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol.
+
+ * mm-encode.el (mm-body-7-or-8): Autoload.
+
+ * mm-decode.el (mm-insert-inline): Autoload.
+
+ * mml.el:
+ * message.el: Put some defvars in eval-when-compile.
+
+ * gnus-msg.el: Put some defvars in eval-when-compile.
+ (gnus-msg-mail): Move after gnus-setup-message.
+
+ * smiley-ems.el (smiley-data-directory, smiley-regexp-alist): Doc fix.
+
+2000-11-07 Dave Love <fx@gnu.org>
+
+ * gnus-util.el (nnheader): Don't require message (recursive
+ autoload).
+
+ * uudecode.el: Avoid compiler warnings.
+
+ * rfc2047.el: (rfc2047-fold-region): Use gnus-point-at-bol.
+ (rfc2047-charset-encoding-alist): Add iso-8859-1[45].
+
+2000-11-06 Dave Love <fx@gnu.org>
+
+ * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode.
+
+ * uudecode.el: Use (featurep 'xemacs). Require cl when compiling.
+ (uudecode-char-int): New alias, replacing char-int.
+ (uudecode-decode-region): Don't call buffer-disable-undo.
+
+; * mm-uu.el (mm-uu-configure): Unquote lambda.
+; (mm-uu-configure-list): Doc fix.
+;
+; * earcon.el (running-xemacs): Don't define.
+;
+;2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
+;
+; * message.el (message-font-lock-keywords): Match a final newline
+; to help font-lock's multiline support.
+;
+2000-11-03 Dave Love <fx@gnu.org>
+
+ * gnus-nocem.el (gnus-nocem-check-article-limit): Default to 500.
+
+ * mm-partial.el (mm-inline-partial): Space-prefix temp buffer
+ name.
+
+ * gnus-cus.el (gnus-group-parameters) <gcc-self>: Fix custom type.
+ <banner>: Fix custom type, doc.
+
+ * mm-decode.el (mm-display-external): Space-prefix temp buffer
+ name. Don't disable undo explicitly.
+
+;2000-11-02 Dave Love <fx@gnu.org>
+;
+; * message.el (message-font-lock-keywords): Use [:alpha:] for
+; cite-prefix.
+
+2000-11-01 Dave Love <fx@gnu.org>
+
+ * rfc2047.el (base64): Require unconditionally.
+ (message-posting-charset): Defvar when compiling.
+ (rfc2047-encode-message-header, rfc2047-encodable-p): Require
+ message.
+
+ * gnus-sum.el (nnoo): Require.
+ (mm-uu-dissect): Autoload.
+
+ * mml.el (mml-parse-1): Clarify message.
+ (mml-minibuffer-read-type): Use mailcap-mime-types.
+
+2000-11-01 Stefan Monnier <monnier@cs.yale.edu>
+
+ * mml.el: Fix a typo in the requiring of CL.
+
+2000-11-01 Dave Love <fx@gnu.org>
+
+ * utf7.el: Require cl when compiling.
+
+ * binhex.el: Use (featurep 'xemacs).
+ (binhex-char-int): New alias, replacing char-int. Change callers.
+ (binhex-decode-region): Simplify work buffer code.
+ (binhex-decode-region-external): Use expand-file-name, not concat.
+
+2000-10-30 Dave Love <fx@gnu.org>
+
+ * gnus-art.el: Fix 2000-10-27 change properly.
+
+2000-10-28 Miles Bader <miles@gnu.org>
+
+ * gnus-art.el (gnus-read-save-file-name): Remove extraneous paren.
+
+2000-10-27 Dave Love <fx@gnu.org>
+
+ * gnus-group.el (gnus-group-make-menu-bar): Add some :help
+ strings.
+ (gnus-group-make-tool-bar): New function.
+ (gnus-group-mode): Use it.
+
+ * message.el (message-mode-menu): Add some :help strings.
+ (message-mode) [message-tool-bar-map]: Define tool-bar-map.
+ (featurep): Use (featurep 'xemacs). Install tool bar for Emacs.
+
+ * catchup.xpm, exit-gnus.xpm, gnntg.xpm, subscribe.xpm:
+ * describe-group.xpm, get-news.xpm, kill-group.xpm:
+ * unsubscribe.xpm: New files. Renamed icons from Luis Fernandes.
+
+ * mm-decode.el (mm-valid-and-fit-image-p): Don't test
+ display-graphic-p here.
+
+2000-10-27 Miles Bader <miles@lsi.nec.co.jp>
+
+ * gnus-ems.el (gnus-ems-redefine): Use (featurep 'xemacs) instead
+ of the `gnus-xemacs' variable, as the latter has been removed.
+ * gnus-start.el (gnus-1, gnus-read-descriptions-file): Likewise.
+ * gnus-art.el (gnus-treat-display-xface)
+ (gnus-treat-display-smileys, gnus-treat-display-picons)
+ (gnus-article-read-summary-keys): Likewise.
+
+2000-10-26 Dave Love <fx@gnu.org>
+
+ (defvar): Use rmail-spool-directory unconditionally.
+
+2000-10-18 Dave Love <fx@gnu.org>
+
+ * mm-bodies.el (mm-uu-decode-function)
+ (mm-uu-binhex-decode-function): Defvar when compiling.
+
+ * gnus-nocem.el (gnus-nocem-issuers): Update.
+ (gnus-nocem-check-from): New option.
+ (gnus-nocem-scan-groups): Use it.
+ (gnus-nocem-check-article): Bind gnus-newsgroup-name.
+ (gnus-nocem-check-article-limit): Add :version.
+
+2000-10-16 Stefan Monnier <monnier@cs.yale.edu>
+
+ * ietf-drums.el (mm-util): Require CL when compiling.
+
+2000-10-15 Dave Love <fx@gnu.org>
+
+ * qp.el: Require mm-util.
+
+2000-10-13 Dave Love <fx@gnu.org>
+
+ * qp.el (quoted-printable-decode-region): Avoid invalid
+ coding-systems.
+
+2000-10-12 Gerd Moellmann <gerd@gnu.org>
+
+ * mm-bodies.el: Don't require `mm-uu' at compile-time; it leads
+ to a recursive load.
+
+2000-10-12 Dave Love <fx@gnu.org>
+
+ * mm-util.el (mm-charset-synonym-alist): Add windows-1252.
+
+ * gnus.el (gnus-group-startup-message): Check for PBM image.
+
+2000-10-09 Dave Love <fx@gnu.org>
+
+ * mail-source.el (mail-source-fetch-imap): Bind
+ default-enable-multibyte-characters rather than using
+ mm-disable-multibyte.
+
+2000-10-05 Dave Love <fx@gnu.org>
+
+ * qp.el (mm-decode-coding-region, mm-encode-coding-region):
+ Autoload.
+ (quoted-printable-decode-region): Rename arg which confused
+ charset with coding-system. Don't use nonascii-insert-offset.
+ Coding-system encode the region initially. Don't recognize `=='
+ as valid QP. Coding-system decode the region finally.
+ (quoted-printable-decode-string): Rename arg which confused
+ charset with coding-system.
+
+ * mm-bodies.el: Require mm-uu, Don't require qp, uudecode.
+ (mm-encode-body): Apply mm-charset-to-coding-system to arg of
+ mm-encode-coding-region.
+ (mm-decode-body, mm-decode-string): Rename variables which
+ confused charset with coding-system.
+ (binhex-decode-region): Don't autoload.
+ (mm-body-encoding): Require message.
+ (mm-decode-content-transfer-encoding): Require mm-uu in relevant
+ cond branches.
+
+ * gnus-art.el (article-de-quoted-unreadable)
+ (article-de-base64-unreadable): Fold search case
+ rather than downcasing string. Apply mm-charset-to-coding-system
+ to arg of quoted-printable-decode-region.
+
+2000-10-04 Dave Love <fx@gnu.org>
+
+ * gnus-ems.el: Don't turn off compiler warnings in local vars.
+ Require ring when compiling.
+ (gnus-article-compface-xbm): New variable.
+
+2000-10-04 Dave Love <fx@gnu.org>
+
+ * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use
+ pbm images.
+
+ * frown.pbm, smile.pbm, wry.pbm: New files.
+
+ * frown.xbm, smile.xbm, wry.xbm: Deleted.
+
+2000-10-03 Dave Love <fx@gnu.org>
+
+ * mail-source.el (mail-sources): Revert to nil.
+
+ * nnmail.el (nnmail-spool-file): Revert to `((file))'.
+
+ * qp.el: Don't require mm-util.
+ (quoted-printable-decode-region): Rewritten.
+ (quoted-printable-decode-string, quoted-printable-encode-region):
+ Doc fix.
+ (quoted-printable-encode-region): Barf on multibyte characters.
+ Maybe make the class multibyte. Upcase chars, not formatted
+ strings. Allow mm-use-ultra-safe-encoding to be unbound.
+ (quoted-printable-encode-string): Don't use
+ mm-with-unibyte-buffer.
+
+2000-09-29 Gerd Moellmann <gerd@gnu.org>
+
+ * smiley-ems.el (smiley-update-cache): Use `:ascent center'.
+
+2000-09-21 Dave Love <fx@gnu.org>
+
+ * smiley-ems.el (smiley-region): Test if display-graphic-p bound
+ (for Emacs 20). Tidy somewhat.
+
+2000-09-21 Dave Love <fx@gnu.org>
+
+ * gnus-ems.el (gnus-article-display-xface): Use unibyte for the
+ image processing. Rationalize logic somewhat.
+
+2000-09-20 Dave Love <fx@gnu.org>
+
+ * gnus-start.el (gnus-1) <gnus-simple-splash>: Don't test for X
+ specifically.
+
+ * gnus.el (gnus-version-number): Avoid some redundant
+ autoloads.
+
+2000-09-20 Gerd Moellmann <gerd@gnu.org>
+
+ * gnus-ems.el (gnus-article-display-xface): Don't convert PBM
+ to XBM; we always have PBM support.
+
+2000-09-14 Dave Love <fx@gnu.org>
+
+ * gnus.el (gnus-charset):
+ * mm-decode.el (mime-display):
+ * imap.el (imap) <defgroup>: Add :version.
+
+2000-09-13 Gerd Moellmann <gerd@gnu.org>
+
+ * parse-time.el: Fix author's mail address.
+
+ * earcon.el, flow-fill.el, gnus-cite.el, gnus-gl.el, gnus-ml.el:
+ * gnus-mlspl.el, gnus-nocem.el, gnus-range.el, gnus-salt.el:
+ * gnus-setup.el, gnus-soup.el, gnus-undo.el, gnus-vm.el:
+ * messcompat.el, nnbabyl.el, nndir.el, nneething.el:
+ * nngateway.el, nnheaderxm.el, nnkiboze.el, nnlistserv.el:
+ * nnmbox.el, nnmh.el, nnoo.el, nnsoup.el, nnspool.el, rfc2045.el:
+ * rfc2231.el, uudecode.el: Fix copyright notice.
+
+ * nnweb.el (toplevel): To make the file bootstrap in Emacs,
+ require `w3' at load-time only if not running in batch mode.
+
+2000-12-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el: Before merge with Emacs21.
+
+2000-12-19 Raymond Scholz <ray-2000@zonix.de>
+
+ * gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol.
+
+2000-12-19 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * mml.el (mml-mode-map): Change mml prefix from `M-m' to `C-c C-m'
+ to avoid conflict with the standard `back-to-indentation'
+ binding.
+
+2000-12-17 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-extern.el (mm-inline-external-body): g-a-m-h may be a handle.
+
+ * mm-util.el (mm-enable-multibyte-mule4): Test charsetp.
+ (mm-disable-multibyte-mule4): Ditto.
+ (mm-with-unibyte-current-buffer-mule4): Ditto.
+
+2000-12-15 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * pop3.el (pop3-movemail): Use binary.
+ (pop3-movemail-file-coding-system): Removed.
+
+2000-12-14 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-charset-synonym-alist): Add cn-gb.
+
+2000-12-13 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnspool.el (nnspool-lib-dir): Check whether /usr/lib/news/active
+ exists.
+
+2000-12-13 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-post-method): Use backend name when the
+ address is "".
+
+2000-12-08 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-verify-x-pgp-sig): Don't test
+ mm-verify-option.
+ (gnus-treat-x-pgp-sig): Default value.
+ (gnus-ignored-headers): Redundant.
+
+2000-12-04 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-configure-frame): Save selected window.
+
+2000-02-15 Andrew Innes <andrewi@gnu.org>
+
+ * nnmbox.el: Require gnus-range.
+ (nnmbox-group-building-active-articles): New variable.
+ (nnmbox-group-active-articles): New variable; this is a cache of
+ all active articles by group and number.
+ (nnmbox-in-header-p): New function.
+ (nnmbox-find-article): New function.
+ (nnmbox-record-active-article): New function.
+ (nnmbox-record-deleted-article): New function.
+ (nnmbox-is-article-active-p): New function.
+ (nnmbox-retrieve-headers): Use nnmbox-find-article.
+ (nnmbox-request-article): Ditto. Also supply extra arg to
+ nnmbox-article-group-number.
+ (nnmbox-request-expire-articles): Ditto.
+ (nnmbox-request-move-article): Ditto.
+ (nnmbox-request-replace-article): Ditto.
+ (nnmbox-request-rename-group): Rename group entry in active
+ article cache.
+ (nnmbox-delete-mail): Update active article cache, unless article
+ is being replaced.
+ (nnmbox-possibly-change-newsgroup): Call nnmbox-read-mbox, rather
+ than partially duplicating it.
+ (nnmbox-article-group-number): Add extra `this-line' arg, to
+ handle articles belonging to multiple groups.
+ (nnmbox-save-mail): Update active article cache.
+ (nnmbox-read-mbox): Build active article cache when loading mbox.
+ Also do some repair work, if we find articles that are missing the
+ appropriate X-Gnus-Newsgroup lines in the header. We can usually
+ reconstruct these from Xref info.
+
+2000-12-04 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mail-source.el (mail-source-report-new-mail): Use
+ nnheader-run-at-time.
+
+2000-02-15 Andrew Innes <andrewi@gnu.org>
+
+ * mail-source.el (mail-source-fetch-pop): Clear pop password when
+ an error is thrown, and then rethrow the error.
+ (mail-source-check-pop): Ditto.
+ (mail-source-start-idle-timer): Prevent multiple pop checks
+ running if the check takes a long time.
+
+2000-12-04 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if
+ succeed.
+
+2000-12-04 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-win.el (gnus-configure-windows): Make sure
+ nntp-server-buffer is live.
+ (gnus-remove-some-windows): switch-to-buffer -> set-buffer.
+
+2000-11-21 Stefan Monnier <monnier@cs.yale.edu>
+
+ * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer.
+
+2000-12-04 Andreas Jaeger <aj@suse.de>
+
+ * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description.
+
+2000-12-03 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-fix-micalg): Alg might be nil.
+
+2000-12-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+ Trivial patch from Christopher Splinter <chris@splinter.inka.de>
+
+ * gnus-sum.el (gnus-summary-limit-to-age): Fix typo.
+
+2000-12-01 Simon Josefsson <sj@extundo.com>
+
+ * mml-smime.el (mml-smime-verify): Fix address parsing.
+
+2000-12-01 Simon Josefsson <sj@extundo.com>
+
+ * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle
+ more than one certificate inside PKCS#7 blob. Better security
+ information (clamed / actual sender, openssl output, certificates
+ inside message).
+
+ * smime.el (smime-verify-region): Output to /dev/null.
+ (smime-buffer-as-string-region): Don't parse empty lines.
+
+2000-11-30 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-security-button-line-format-alist): Add
+ ?d and ?D.
+ (gnus-mime-security-show-details-inline): New variable.
+ (gnus-mime-security-show-details): Use them.
+ (gnus-insert-mime-security-button): Ditto.
+
+ * mml2015.el (mml2015-gpg-verify): Set details when succeed.
+ Suggest by Michael Duggan (md5i@cs.cmu.edu).
+ (mml2015-gpg-clear-verify): Ditto.
+ (mml2015-gpg-decrypt-1): Ditto.
+ (mml2015-use): Prefer 'gpg.
+
+2000-11-30 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-add-text-properties-when): New function.
+ (gnus-remove-text-properties-when): Ditto.
+
+ * gnus-cite.el (gnus-article-hide-citation): Use them.
+ (gnus-article-toggle-cited-text): Use them.
+
+ * gnus-art.el (gnus-signature-toggle): Use them.
+ (gnus-article-show-hidden-text): Ditto.
+ (gnus-article-hide-text): Ditto.
+
+2000-11-30 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-find-charset-region): Remove eight-bit-*.
+
+2000-11-30 Simon Josefsson <sj@extundo.com>
+
+ * smime.el (smime-point-at-eol): New alias.
+ (smime-buffer-as-string-region): Use it.
+
+2000-11-29 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nndraft.el (nndraft-request-restore-buffer): Remove Date field.
+
+2000-11-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-expire-articles): expiry-target.
+
+ * nnbabyl.el (nnbabyl-request-expire-articles): Ditto.
+
+ * nnmbox.el (nnmbox-request-expire-articles): Ditto.
+
+2000-11-22 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * nnmh.el (nnmh-request-expire-articles): Implemented
+ expiry-target for nnmh backend.
+
+2000-11-30 Simon Josefsson <sj@extundo.com>
+
+ * mm-decode.el (mm-security-from): New variable.
+ (mm-possibly-verify-or-decrypt): Use it rather than `from'.
+
+ * mml-smime.el (mml-smime-verify): Use `mm-security-from' rather
+ than `from'.
+
+2000-11-30 Simon Josefsson <sj@extundo.com>
+
+ * mml-smime.el (mml-smime-verify): Verify that certificate mail
+ address match sender address.
+
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address.
+
+ * smime.el (smime-verify-region): Don't copy buffer.
+ (smime-decrypt-buffer): Use expand-file-name on keyfile.
+ (smime-pkcs7-region): New function.
+ (smime-pkcs7-certificates-region): Ditto.
+ (smime-pkcs7-email-region): Ditto.
+ (smime-buffer-as-string-region): Ditto.
+
+ * gnus-art.el (gnus-mime-security-show-details): Goto beginning of
+ buffer.
+
+2000-11-23 Jens Krinke <j.krinke@gmx.de>
+
+ * smime.el (smime-decrypt-region): Fix keyfile argument.
+
+2000-11-29 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnmail.el (nnmail-cache-accepted-message-ids): Add doc.
+
+2000-11-28 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-shoot-gnksa-feet): New variable.
+ (message-gnksa-enable-p): New function.
+ (message-send): Use it.
+ (message-check-news-body-syntax): Ditto.
+
+2000-11-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-make-message-id): Remove the redundancy.
+
+2000-11-22 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-setup): Discourage using mc-install-*-mode.
+
+ * gnus-setup.el (gnus-use-mailcrypt): Don't hook mail-crypt.
+
+2000-11-22 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-cite.el (gnus-cite-parse): Guess citation length.
+
+2000-11-22 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ml.el (gnus-mailing-list-insinuate): New function.
+
+2000-11-22 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ml.el (gnus-mailing-list-archive): Find the real url.
+
+2000-11-22 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Use
+ insert-buffer-substring.
+
+ * message.el (message-send-mail): Use buffer-substring-no-properties.
+ (message-send-news): Ditto.
+
+2000-11-22 David Edmondson <dme@dme.org>
+
+ * imap.el (imap-wait-for-tag): Message read info.
+
+2000-11-21 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-encrypt): Ensure the part is encrypted.
+ (mml2015-mailcrypt-encrypt): Use unibyte-buffer.
+ (mml2015-gpg-encrypt): Ditto.
+
+2000-11-21 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-verify-option): Default value.
+
+ * mml-sec.el (mml-secure-part): Error message.
+
+2000-11-20 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-ml.el (gnus-mailing-list-archive): Use browse-url.
+
+2000-11-20 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-make-menu-bar): Use easy-menu-add.
+
+2000-11-20 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-describe-key): Use prompt.
+ (gnus-article-describe-key-briefly): Ditto.
+
+2000-11-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-expire): Ignore corrupted history.
+
+2000-11-20 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-describe-key): New function.
+ (gnus-article-describe-key-briefly): New function.
+
+2000-11-19 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-decrypt-option): Doc typo.
+
+ * gnus-art.el (gnus-article-read-summary-keys): lookup-key may
+ return a number.
+
+2000-11-19 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-newline-and-reformat): Typo.
+
+2000-11-19 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (article-verify-x-pgp-sig): Check whether
+ original-article-buffer exists.
+
+ * rfc2047.el (rfc2047-q-encoding-alist): Match Resent-.
+ (rfc2047-header-encoding-alist): Addresses are different from text.
+ (rfc2047-encode-message-header): Ditto.
+ (rfc2047-dissect-region): Extra parameter.
+ (rfc2047-encode-region): Ditto.
+ (rfc2047-encode-string): Ditto.
+
+2000-11-19 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-pgp-encrypted-extract-1): New function.
+ (mm-uu-pgp-encrypted-extract): Use it.
+ (mm-uu-pgp-signed-extract-1): New function.
+ (mm-uu-pgp-signed-extract): Use it.
+
+ * gnus-art.el (gnus-mime-display-security): New function.
+ (gnus-mime-display-part): Use it.
+ (gnus-mime-security-verify-or-decrypt): New function.
+ (gnus-mime-security-press-button): New function.
+ (gnus-insert-mime-security-button): Use it.
+
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Use mm-h-m-c-p.
+ (mm-find-raw-part-by-type): Ditto.
+ (mm-verify-function-alist): Add x-gnus-pgp-signature handle.
+ (mm-decrypt-function-alist): Add x-gnus-pgp-encrypted handle.
+ (mm-destroy-parts): Kill nested multibyte buffer.
+
+ * mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p.
+ (mml2015-gpg-verify): Ditto.
+
+2000-11-18 Simon Josefsson <sj@extundo.com>
+
+ * mml2015.el (mml2015-mailcrypt-clear-verify): New function.
+ (mml2015-function-alist): Use it.
+
+ * mml-sec.el (mml-sign-alist): Update names.
+ (mml-encrypt-alist): Ditto.
+ (mml-secure-part-smime-sign): Moved to mml-smime.el
+ as `mml-smime-sign-query'.
+ (mml-secure-part-smime-encrypt-by-file): Moved to mml-smime.el as
+ `mml-smime-get-file-cert'.
+ (mml-secure-part-smime-encrypt-by-dns): Moved to mml-smime.el as
+ `mml-smime-get-dns-cert'.
+ (mml-secure-part-smime-encrypt): Moved to mml-smime.el as
+ `mml-smime-encrypt-query'.
+ (mml-smime-sign-buffer): Use mml-smime-sign.
+ (mml-smime-encrypt-buffer): Use mml-smime-encrypt.
+
+ * mml-smime.el (mml-smime-sign): New function.
+ (mml-smime-encrypt):
+ (mml-smime-sign-query):
+ (mml-smime-get-file-cert):
+ (mml-smime-get-dns-cert):
+ (mml-smime-encrypt-query): Moved from mml-sec.el.
+
+2000-11-16 Simon Josefsson <sj@extundo.com>
+
+ * mml2015.el (mml2015-gpg-clear-verify): New function.
+ (mml2015-function-alist): Add it.
+
+2000-11-17 14:21 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-setup-fill-variables): Use
+ message-cite-prefix-regexp.
+ (message-newline-and-reformat): Check the end of citation, leading
+ WSP, break in the cite prefix.
+ (message-fill-paragraph): New function.
+
+2000-11-17 13:44 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * lpath.el: Shut up.
+
+2000-11-17 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow
+ raw 8-bit in headers in dk.* newsgroups.
+
+2000-11-17 08:02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-newline-and-reformat): Match extra WSPs.
+
+2000-11-16 23:31 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-generate-mime-1): Ignore ascii.
+
+2000-11-16 Justin Sheehy <justin@iago.org>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items.
+
+2000-11-16 17:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-cite-prefix-regexp): Prefix should not end
+ at space.
+
+2000-11-15 18:09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-mode-syntax-table): Add - as a word
+ constituent as in articles.
+ (message-setup-fill-variables): Add -_. as supercite-style prefix.
+ * gnus-art.el (gnus-article-mode-syntax-table): Remove ?-.
+ * gnus-cite.el (gnus-cite-parse): Match from the beginning of line.
+
+2000-11-15 13:21 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Expire the article.
+
+2000-11-12 David Edmondson <dme@dme.org>
+
+ * message.el (message-font-lock-keywords): use
+ message-cite-prefix-regexp.
+
+2000-11-15 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by
+ Stein Arild Str,Ax(Bmme.
+ (gnus-group-jump-to-group): Use it.
+ (gnus-group-jump-to-group-prompt): Customize.
+
+2000-11-14 10:32:42 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mailcap.el (mailcap-possible-viewers): Match the entire string.
+
+2000-11-14 10:20:56 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-verify): replace-match is
+ incompatible.
+ (mml2015-mailcrypt-sign): Ditto.
+
+2000-11-14 10:12:05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Update summary data when the
+ group is open.
+
+2000-11-14 00:48:52 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-bcklg.el (gnus-backlog-enter-article): Don't enter
+ nnvirtual articles.
+ (gnus-backlog-request-article): Don't request nnvirtual articles.
+
+2000-11-13 22:08:09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-sign): Remove "-" escape.
+ * mml.el (mml-generate-mime-1): Save cont. skip multipart attributes.
+
+2000-11-13 20:43:37 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-get-part): Don't call mm-insert-part.
+ * mml.el (mml-generate-mime-1): Use charset attribute.
+ * mm-bodies.el (mm-encode-body): Add parameter charset.
+ * mm-util.el (mm-mime-charset): Show error when find 8-bit characters.
+
+2000-11-13 16:09:09 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-decrypt): Handle quit.
+ (mml2015-mailcrypt-clear-decrypt): Ditto.
+ (mml2015-mailcrypt-verify): Ditto.
+ (mml2015-mailcrypt-clear-verify): Ditto.
+ (mml2015-gpg-verify): Ditto.
+
+2000-11-13 15:29:58 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * smime.el (smime-openssl-program): Test the existence of openssl.
+ * mml-smime.el: Require mm-decode.
+ (mml-smime-verify-test): New function.
+ * mm-decode.el (mm-verify-function-alist): Use it.
+
+2000-11-13 09:50:29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-repair-multipart): Fix Mime-Version
+ anyway.
+
+2000-11-13 Simon Josefsson <sj@extundo.com>
+
+ * mm-uu.el (mm-uu-pgp-signed-extract): Explain why clear
+ verification doesn't work.
+
+2000-11-12 23:36:45 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-inews-mark-gcc-as-read): New variable.
+ (gnus-inews-do-gcc): Use it.
+
+2000-11-12 21:35:04 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2231.el (rfc2231-encode-string): Insert semi-colon and
+ leading space.
+ * mm-extern.el (mm-inline-external-body): Report error when no
+ access-type.
+
+2000-11-12 19:48:30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-select-newsgroup): Change the error message.
+
+2000-11-12 11:53:18 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-button-menu): Use select-window.
+
+2000-11-12 09:47:54 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-part): Display multipart/related
+ as multipart/mixed.
+
+2000-11-12 David Edmondson <dme@dme.org>
+
+ * message.el (message-cite-prefix-regexp): moved from gnus-cite.el
+ and replace `.' with `\w' to allow for different syntax tables
+ (from Vladimir Volovich).
+ * message.el (message-newline-and-reformat): use
+ `message-cite-prefix-regexp'.
+ * gnus-cite.el (gnus-supercite-regexp): use
+ `message-cite-prefix-regexp'.
+ * gnus-cite.el (gnus-cite-parse): use
+ `message-cite-prefix-regexp'.
+
+2000-11-12 08:52:46 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-verify): Replace armors with
+ PGP SIGNATURE. Escape leading "-"'s.
+ (mml2015-mailcrypt-sign): Replace armors with PGP MESSAGE.
+
+2000-11-11 15:55:35 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-type-alist): Stricter shar regexp.
+
+2000-11-11 Simon Josefsson <sj@extundo.com>
+
+ * mml2015.el (mml2015-gpg-verify): Set "OK" security status.
+
+ * smime.el (smime-details-buffer): New variable.
+ (smime-sign-region):
+ (smime-encrypt-region):
+ (smime-verify-region):
+ (smime-decrypt-region): Copy OpenSSL output to the buffer.
+
+ * mml-smime.el (mml-smime-verify): Support security info.
+
+2000-11-10 17:11:22 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-verify-option): Set default to nil.
+ (mm-decrypt-option): Ditto.
+ * gnus-art.el (article-verify-x-pgp-sig): New function.
+
+2000-11-10 09:01:25 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-alternative): Show button if no
+ preferred part.
+
+2000-11-07 Kai Gro,b_(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+
+ * gnus-sum.el (gnus-move-split-methods): Say that
+ `gnus-split-methods' uses file names, whereas this uses group
+ names. (Report from Nevin Kapur)
+
+2000-11-10 01:23:20 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-partial.el (mm-inline-partial): Insert MIME-Version.
+
+2000-11-09 17:02:50 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnheader.el (nnheader-directory-files-is-safe): New variable.
+ (nnheader-directory-articles): Use it.
+ (nnheader-article-to-file-alist): Ditto.
+
+2000-11-09 16:20:37 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2047.el (rfc2047-pad-base64): New function.
+ (rfc2047-decode): Use it.
+
+2000-11-09 08:53:04 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Bind the original
+ select method.
+
+2000-11-08 19:58:58 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-gpg-decrypt-1):
+ (mml2015-gpg-verify): buffer-string has no argument in Emacs.
+
+2000-11-08 16:37:02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-cache.el (gnus-cache-generate-nov-databases): Reopen cache.
+
+2000-11-08 08:38:30 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * pop3.el (pop3-munge-message-separator): A message may have an
+ empty body.
+
+2000-11-07 18:02:26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-type-alist): Don't test pgp stuff.
+ (mm-uu-pgp-encrypted-extract): Clean mml2015 buffer.
+ (mm-uu-pgp-signed-extract): Use coding-system.
+
+2000-11-07 14:33:19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-part): Show MIME security button.
+ (gnus-insert-mime-security-button): New function.
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Add security info.
+ * mml2015.el: Add security info when verify or decrypt.
+ * mm-uu.el (mm-uu-pgp-signed-extract): Use multipart.
+ (mm-uu-pgp-encrypted-extract): Ditto.
+
+2000-11-07 08:49:36 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-display-parts): New function.
+ * gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first.
+
+2000-02-02 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
+
+ * gnus-mlspl.el: Documentation tweaks.
+
+2000-11-06 22:06:44 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Fix.
+ * gnus-art.el (gnus-article-encrypt-body): Rename and support prefix
+ argument.
+
+2000-11-06 19:10:14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2231.el (rfc2231-encode-string): Use us-ascii if charset is nil.
+
+2000-11-06 18:17:53 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-encrypt): New function.
+ (gnus-article-encrypt-protocol-alist): New variable.
+ (gnus-article-encrypt-protocol): New variable.
+ * mml2015.el (mml2015-self-encrypt): New function.
+ (mml2015-mailcrypt-encrypt): Set mc-pgp-always-sign.
+
+2000-11-06 16:02:52 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-gpg-key-skip-to-last): New function.
+ (mm-uu-pgp-key-extract): Use application/pgp-keys, don't snarf,
+ let mailcap do it.
+ * mml2015.el: Remove snarf code.
+ * mm-decode.el: Remove snarf code.
+
+2000-11-06 14:03:10 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-insert-mml-markup): Ignore internal stuff.
+ (mml-insert-mime): Understand gnus-decoded.
+ (mime-to-mml): New parameter handles.
+ * gnus-art.el (gnus-mime-save-part-and-strip): Use it.
+ * gnus-sum.el (gnus-summary-edit-article): Add argument `3'.
+
+2000-11-06 13:51:37 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mime-security): New group.
+ (mm-verify-function-alist): Add test function.
+ (mm-decrypt-function-alist): Ditto.
+ (mm-snarf-option): Set default value as nil.
+ (mm-find-part-by-type): Recursive parameter.
+ (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig.
+ * mml2015.el: Support draft-ietf-openpgp-multsig.
+
+2000-11-06 13:01:27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-view-part-as-charset): New function.
+ (gnus-article-view-part-as-charset): New function.
+
+2000-11-05 22:34:07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-verify-option): Default value.
+ (mm-possibly-verify-or-decrypt): Dealing with broken messages.
+
+2000-11-05 15:06:05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnvirtual.el (nnvirtual-request-expire-articles): Uncompress range.
+
+2000-11-05 Simon Josefsson <sj@extundo.com>
+
+ * mml-smime.el (mml-smime-verify): Work in original multipart
+ buffert.
+
+ * mm-decode.el (mm-handle-multipart-original-buffer): New macro.
+ (mm-handle-multipart-ctl-parameter): Ditto.
+ (mm-alist-to-plist): New function.
+ (mm-dissect-buffer): Store CTL parameters and copy original buffer
+ for multiparts.
+ (mm-destroy-parts): Destroy multipart buffert.
+ (mm-remove-part): Ditto.
+
+ * mml-smime.el (mml-smime-sign): Not used.
+ (mml-smime-encrypt): Ditto.
+
+ * mm-decode.el (mml-smime-verify): Autoload mml-smime.
+
+ Verify S/MIME signature support.
+
+ * mm-decode.el (mm-inline-media-tests): Add
+ application/{x-,}pkcs7-signature.
+ (mm-inlined-types): Ditto.
+ (mm-automatic-display): Ditto.
+ (mm-verify-function-alist): Ditto. Add name of method.
+ (mm-decrypt-function-alist): Add name of method.
+ (mm-find-part-by-type): Add documentation.
+ (mm-possibly-verify-or-decrypt): Use new format of
+ mm-{verify,decrypt}-function-alist. Use method names.
+
+ * mml-smime.el (mml-smime-verify): New function.
+
+2000-11-04 20:38:50 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-text): Move point to the end of inserted text.
+
+2000-11-04 19:07:08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-function-alist): Clear verify and decrypt.
+ * mm-uu.el: Reorganized. Add gnatsweb, pgp-signed, pgp-encrypted.
+ * mm-decode.el (mm-snarf-option): New variable.
+
+2000-11-04 13:08:02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-util.el (mm-subst-char-in-string): New function.
+ (mm-replace-chars-in-string): Use it.
+ * message.el (message-replace-chars-in-string): Use it.
+ * nnheader.el (nnheader-replace-chars-in-string): Use it.
+ * gnus-mh.el (mh-lib-progs): Shut up.
+
+2000-11-04 ShengHuo Zhu <zsh@cs.rochester.edu>
+
+ * base64.el, md5.el: Moved to contrib directory.
+
+2000-11-04 11:13:56 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-search-article-forward): Don't move
+ the last article when search.
+
+2000-11-04 10:34:29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnheader.el (nnheader-pathname-coding-system): Default iso-8859-1.
+ * nnmail.el (nnmail-pathname-coding-system): Ditto.
+
+2000-09-29 David Edmondson <dme@thus.net>
+
+ * message.el (message-newline-and-reformat): Typo.
+
+2000-11-04 10:11:05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2231.el (rfc2231-decode-encoded-string): Test mm-multibyte-p.
+
+2000-11-04 09:53:42 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-decode-text): Delete bogus status lines.
+
+2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
+
+ * message.el (message-font-lock-keywords): Match a final newline
+ to help font-lock's multiline support.
+
+2000-11-04 09:11:44 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnoo.el (nnoo-set): New function.
+
+2000-11-04 ShengHuo Zhu <zsh@cs.rochester.edu>
+
+ * gpg.el, gpg-ring.el: Moved to contrib directory.
+
+2000-11-04 Simon Josefsson <sj@extundo.com>
+
+ * nnimap.el (nnimap-split-inbox): Typo.
+
+2000-11-03 10:46:44 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-msg-mail): Move it backwards.
+
+2000-11-03 Simon Josefsson <sj@extundo.com>
+
+ * rfc2231.el (rfc2231-parse-qp-string): New function.
+ (require): rfc2047.
+
+ * mail-parse.el (mail-header-parse-content-type):
+ (mail-header-parse-content-disposition): Support invalid QP
+ encoded strings, by using `rfc2231-parse-qp-string'.
+
+2000-11-03 08:58:08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2231.el (rfc2231-parse-string): Decode when there is no number.
+ (rfc2231-decode-encoded-string): Typo "> X 1".
+ (rfc2231-encode-string): Insert the name of charset.
+ * mail-parse.el (mail-header-encode-parameter): Use RFC2231.
+
+2000-11-02 23:35:50 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-save-part): Return the filename.
+ * gnus-sum.el (gnus-summary-edit-article): Remove a hack.
+ * gnus-art.el (gnus-mime-save-part-and-strip): New function.
+ (gnus-mime-action-alist): Use it.
+ (gnus-mime-button-commands): Use it.
+ * mm-extern.el (mm-extern-local-file): Error when the file is gone.
+ (mm-inline-external-body): unwind-protect.
+
+2000-11-02 21:08:49 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-insert-mime-button): Show url.
+
+2000-11-02 19:51:19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-generate-mime-1): Support external url.
+ * nnwarchive.el (nnwarchive-mail-archive-article): Use external url.
+
+2000-11-02 16:53:32 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-partial.el (mm-inline-partial): Buffer name with a leading space.
+ * mm-decode.el (mm-display-external): Ditto.
+ * mm-extern.el: New file.
+ * mm-decode.el (mm-inline-media-tests): Hook it up.
+ (mm-inlined-types): Inline message/external-body.
+
+2000-11-02 Simon Josefsson <sj@extundo.com>
+
+ * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To.
+
+ * message.el (message-get-reply-headers): Better handling when
+ Mail-Followup-To is very large.
+
+2000-11-02 13:27:56 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy.
+ * gnus-art.el (gnus-article-edit-done):
+ * gnus-sum.el (gnus-summary-edit-article-done): Move line
+ counting code here.
+ * gnus-msg.el (gnus-setup-message): Remove a hack.
+
+2000-11-02 09:33:01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-newsgroup-variables): New variable.
+ (gnus-summary-mode): Make them local variables.
+ (gnus-set-global-variables): Globalize them.
+ (gnus-summary-exit): Kill them.
+
+2000-11-02 Hrvoje Niksic <hniksic@arsdigita.com>
+
+ * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded
+ word.
+
+2000-11-01 10:07:13 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-part): Add to signed or encrypted.
+ gnus-article-wash-types.
+ * gnus-art.el (gnus-article-wash-status): Use them.
+
+2000-11-01 08:54:11 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-read-tag): Remove spaces and LF.
+
+2000-11-01 08:01:03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-encrypt): Use from and sign parameters.
+ * mml.el (mml-generate-mime-1): Add sender and recipients attributes.
+
+2000-11-01 07:39:24 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-force-verify-and-decrypt): New function.
+
+2000-10-31 22:06:13 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-article-charset): New variable.
+ (gnus-summary-display-article): Set it.
+ * gnus-msg.el (gnus-copy-article-buffer): Use it.
+ * gnus-art.el (gnus-article-mode): Make it local variable.
+
+2000-11-01 01:12:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-create-mapping): Use nreverse.
+
+2000-10-31 23:45:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnwfm.el: New file.
+
+ * nnweb.el (nnweb-replace-in-string): New function.
+
+2000-10-31 17:32:02 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el: Wrap gpg.el.
+ * gpg.el (gpg-verify): The last argument of apply is a list.
+ (gpg-encrypt): Add passphrase as a parameter.
+
+2000-10-31 17:28:45 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gpg.el: New file.
+ * gpg-ring.el: New file.
+
+2000-10-31 11:44:29 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-show-article): Fix the summary line.
+
+2000-10-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-insert-line): Work with quoted
+ double-quote characters.
+ (gnus-summary-prepare-threads): Ditto.
+
+2000-10-31 08:36:03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-single): Forward line -1.
+ * mml.el (mml-read-tag): Don't skip the leading space.
+ * lpath.el (font-lock-set-defaults): Shut up.
+
+2000-10-31 00:04:35 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el: Fix doc. Remove bogus mml2015-setup.
+
+2000-10-30 23:37:07 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * qp.el (quoted-printable-encode-region): Replace leading - when
+ ultra safe.
+ * mml.el (mml-generate-mime-postprocess-function): Removed.
+ (mml-postprocess-alist): Removed.
+ (mml-generate-mime-1): Use ultra-safe when sign.
+ * mml2015.el (mml2015-fix-micalg): Uppercase.
+ (mml2015-verify): Insert LF.
+ (mml2015-mailcrypt-sign): Downcase; search backward.
+
+2000-10-16 11:36:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-forum-table-p): Be a bit more
+ restrictive.
+ (nnultimate-table-regexp): New variable.
+ (nnultimate-forum-table-p): Use it.
+
+2000-10-30 Ed L Cashin <ecashin@coe.uga.edu>
+ Trivial patch.
+
+ * gnus-sum.el (gnus-summary-expire-articles): Save point.
+
+2000-10-30 08:52:50 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml-sec.el (mml-pgpmime-sign-buffer): Use mml2015-sign.
+ (mml-pgpmime-encrypt-buffer): Use mml2015-encrypt.
+
+2000-10-30 08:38:12 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el: Shut up.
+
+2000-10-30 08:17:46 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.el (gnus-server-browse-hashtb): Removed.
+ * gnus-group.el (gnus-group-prepare-flat-list-dead): Use gnus-active.
+ (gnus-group-insert-group-line-info): Use simplified method.
+ * gnus-srvr.el (gnus-browse-foreign-server): Use gnus-set-active.
+
+2000-10-30 01:52:40 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and
+ moved here.
+ * gnus-agent.el (gnus-agent-fetch-headers): Use it.
+ * gnus-group.el (gnus-group-prepare-flat): Use it.
+ * gnus-topic.el (gnus-group-prepare-topics): Use it.
+
+2000-10-30 01:23:49 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-mode): Show menu in XEmacs.
+
+2000-10-30 00:49:33 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-server-browse-in-group-buffer): New variable.
+ (gnus-server-read-server-in-server-buffer): New function.
+ (gnus-browse-foreign-server): Browse in group buffer.
+ * gnus-group.el (gnus-group-prepare-flat): List group not in list.
+ (gnus-group-prepare-flat-list-dead): Use gnus-group-insert-group-line.
+ * gnus-topic.el (gnus-group-prepare-topics): Ditto.
+ * gnus.el (gnus-server-browse-hashtb): New variable.
+
+2000-10-29 22:31:40 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-open-nov): Use group.
+
+2000-10-29 17:23:15 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el: Add NOV. Set version to 2.0.
+ (nnfolder-nov-is-evil): If non-nil, nnfolder acts like 1.0.
+
+2000-10-29 10:35:08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el (mml2015-mailcrypt-sign): Use mc-sign-generic.
+
+2000-10-29 09:42:05 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Show level mark.
+ (gnus-browse-unsubscribe-group): Unsubscribed is not killed.
+
+2000-10-29 08:28:58 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-read-folder): Don't goto point-min.
+
+2000-10-28 19:11:01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-verify-function-alist): New variable.
+ (mm-verify-option): New variable.
+ (mm-decrypt-function-alist): Ditto.
+ (mm-decrypt-option): Ditto.
+ (mm-find-raw-part-by-type): New function.
+ (mm-possibly-verify-or-decrypt): New function.
+ (mm-dissect-multipart): Use it.
+ * mml2015.el (mml2015-fix-micalg): New function.
+ (mml2015-decrypt): Use new interface.
+ (mml2015-verify): Use new interface.
+ (mml2015-setup): Make it bogus.
+
+2000-10-28 16:54:45 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-generate-mime-postprocess-function): Set to
+ mml-postprocess.
+ (autoload): Autoload mml2015 and mml-smime.
+ (mml-postprocess-alist): Use mml2015-sign and mml2015-encrypt.
+ * mml2015.el (mml2015-encrypt): New function.
+ (mml2015-sign): New function.
+ (mml2015-encrypt-function): New variable.
+ (mml2015-sign-function): New variable.
+ (mml2015-mailcrypt-encrypt): Use message-recipients.
+ (mml2015-setup): Don't set mml-generate-mime-postprocess-function.
+ * mml-smime.el (mml-smime-setup): Ditto.
+
+2000-10-28 Simon Josefsson <sj@extundo.com>
+
+ * imap.el (imap-parse-resp-text-code): Workaround bug in Stalker
+ Communigate Pro 3.3.1 server.
+
+ * mml-sec.el (mml-smime-encrypt-buffer): Support certfiles stored
+ in buffers.
+ (mml-secure-dns-server): Removed.
+ (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. Don't
+ write certificates to files.
+
+ * smime.el (smime-dns-server): New variable.
+ (smime-mail-to-domain):
+ (smime-cert-by-dns): New functions.
+
+ * dig.el: New file.
+
+2000-10-28 10:09:41 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * message.el (message-options): New variable.
+ (message-options-set-recipient): New function.
+ (message-send): Use them.
+ * gnus-int.el (gnus-request-replace-article): Use them.
+ (gnus-request-accept-article): Ditto.
+ * mml.el (mml-preview): Use them.
+ * gnus-sum.el (gnus-summary-edit-article): Use them.
+
+ * message.el (message-options-get): New function.
+ (message-options-get): New function.
+ * rfc2047.el (rfc2047-encode-message-header): Use them.
+ * mm-bodies.el (mm-encode-body): Use them.
+
+2000-10-28 Simon Josefsson <sj@extundo.com>
+
+ * nnimap.el (nnimap-retrieve-which-headers):
+ (nnimap-request-article-part): Quote message-id.
+
+ * smime.el (smime-CA-directory): Rename from `smime-CAs'.
+ (smime-CA-file): New variable.
+ (smime-call-openssl-region): Don't error.
+ (smime-sign-region): Return result value.
+ (smime-encrypt-region): Ditto.
+ (smime-verify-region): New function.
+ (smime-decrypt-region): Ditto.
+ (smime-verify-buffer): Ditto.
+ (smime-decrypt-buffer): Ditto.
+
+ * mml.el: Require mml-sec.
+ (mml-generate-mime-1): Support "sign" and "encrypt" MML tags.
+ (mml-mode-map): Add "sign" and "encrypt" maps.
+ (mml-menu): Add security menu.
+ (mml-preview): Use generate-new-buffer.
+
+ * mml-sec.el: New file.
+
+2000-10-28 03:43:03 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-find-part-by-type): Move it here.
+ * mml.el (mml-postprocess): Move it here.
+ (mml-postprocess-alist): Move it here. Merge them.
+
+2000-10-28 03:38:39 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2047.el (rfc2047-encode-message-header): Make sure no
+ unencoded stuff in the header.
+
+2000-10-28 02:40:46 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-listed-groups): New variable.
+ (gnus-group-list-option): New variable.
+ (gnus-group-list-limit-map): New keymap.
+ (gnus-group-list-flush-map): New keymap.
+ (gnus-group-list-plus-map): New keymap.
+ (gnus-group-prepare-logic): New function.
+ (gnus-group-prepare-flat): Merge with
+ gnus-group-prepare-flat-predicate. Use gnus-group-listed-groups.
+ (gnus-group-prepare-flat-list-dead): Ditto.
+ (gnus-group-list-matching): Use gnus-group-prepare-function.
+ (gnus-group-list-dormant): Ditto.
+ (gnus-group-list-cached): Ditto.
+ (gnus-group-listed-groups): New function.
+ (gnus-group-list-limit): New function.
+ (gnus-group-list-flush): New function.
+ (gnus-group-list-plus): New function.
+ * gnus-topic.el (gnus-group-prepare-topics): Accept predicate.
+ (gnus-topic-prepare-topic): Ditto.
+
+2000-10-27 Paul Jarc <prj@po.cwru.edu>
+
+ * message.el (message-insert-to, message-get-reply-headers):
+ (message-reply, message-followup): Mail-{Followup,Reply}-To.
+
+2000-10-27 19:45:58 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml2015.el: New file.
+ * smime.el: New file.
+ * mml-smime.el: New file.
+
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
+
+ Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+ Copying and distribution of this file, with or without modification,
+ are permitted provided the copyright notice and this notice are preserved.
+
+;; arch-tag: 13460c90-d3bc-4be2-9e15-c7c271d0c1eb
diff --git a/lisp/gnus/TODO b/lisp/gnus/TODO
new file mode 100644
index 00000000000..02afb6dca05
--- /dev/null
+++ b/lisp/gnus/TODO
@@ -0,0 +1,193 @@
+2004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * Disclaimer: This is *temporary* file to keep track of the changes
+ in the trunk, that have or have not made it into the Gnus branch.
+
+
+
+2004--08-22 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * Add `:version "21.4"' to all new defcustoms. Grep ChangeLog and
+ ChangeLog.1 for "new variable". Also check if the `:version
+ "21.1"' and `:version "21.3"' entries are correct.
+
+
+
+2002-10-02 Karl Berry <karl@gnu.org>
+
+ * In directory ./man:
+
+ * emacs-mime.texi, gnus-faq.texi, gnus.texi, message.texi,
+ pgg.texi, sieve.texi: Per rms, update all manuals to use @copying
+ instead of @ifinfo. Also use @ifnottex instead of @ifinfo around
+ the top node, where needed for the sake of the HTML output.
+ (The Gnus manual is not fixed since it's not clear to me how it
+ works; and the Tramp manual already uses @copying, although in an
+ unusual way. All others were changed.)
+
+==> Done. Not yet in Gnus repository.
+
+
+
+2004-06-29 Kim F. Storm <storm@cua.dk>
+
+ * nntp.el (nntp-authinfo-file): Add :group 'nntp.
+
+ * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache):
+ Add :group 'nnimap.
+
+==> applied, here and in Gnus repository.
+
+2004-05-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mm-view.el (mm-insert-inline): Make it work in read-only buffer.
+
+ * gnus-win.el (gnus-all-windows-visible-p): Don't consider
+ non-visible windows.
+
+2004-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rfc2047.el (rfc2047-encode-message-header): Don't encode non-address
+ headers as address headers (which breaks if subject has a single ").
+
+==> already in Gnus
+
+2004-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * nnimap.el (nnimap-demule): Avoid string-as-multibyte.
+
+==> applied, here and in Gnus repository.
+
+2004-04-21 Richard M. Stallman <rms@gnu.org>
+
+ * mailcap.el (mailcap-mime-data): Mark as risky.
+
+==> applied, here and in Gnus repository.
+
+2004-03-27 Juanma Barranquero <lektu@terra.es>
+
+ * gnus-srvr.el (gnus-server-prepare): Remove spurious call to `cdr'.
+
+==> already in Gnus
+
+2004-03-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-art.el: Use inhibit-read-only instead of buffer-read-only.
+ (gnus-narrow-to-page): Don't assume point-min == 1.
+ (gnus-article-edit-mode): Derive from message-mode.
+ (gnus-button-alist): Add buttons to (info "(emacs)Keymaps").
+
+ * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume
+ point-min == 1.
+
+ * imap.el (imap-parse-address-list, imap-parse-body-ext):
+ Disable incorrect use of `assert'.
+
+==> applied / modified
+
+2004-03-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * message.el (message-mode): Fix last change.
+
+==> applied
+
+2004-03-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * message.el (message-mode): Set comment-start-skip.
+
+==> applied
+
+2004-02-08 Andreas Schwab <schwab@suse.de>
+
+ * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting.
+
+ * gnus-score.el (gnus-summary-increase-score): Fix format string.
+
+==> applied; here and in Gnus v5-10. Already fixed in No Gnus.
+
+2003-06-25 Sam Steingold <sds@gnu.org>
+
+ * gnus-group.el (gnus-group-suspend): Avoid some consing.
+
+==> hunk FAILED / not very important / skip
+
+2003-06-11 Sam Steingold <sds@gnu.org>
+
+ * pop3.el (pop3-leave-mail-on-server): New user variable.
+ (pop3-movemail): Delete mail only when it is nil.
+
+==> applied / Was not documented in the Gnus manual, added it.
+
+2003-05-10 Juanma Barranquero <lektu@terra.es>
+
+ * message.el (message-buffer-naming-style): Fix typo.
+
+==> variable has been removed.
+
+2003-05-07 Dave Love <fx@gnu.org>
+
+ [Partial sync with Gnus.]
+
+ * rfc2047.el (rfc2047-header-encoding-alist): Add Followup-To.
+ (rfc2047-encode-message-header): Fold when encoding not necessary.
+ (rfc2047-encode-region): Skip \n as whitespace.
+ (rfc2047-fold-region): Fix whitespace regexps. Don't break just
+ after the header name.
+ (rfc2047-unfold-region): Fix regexp and whitespace-skipping.
+
+2003-05-06 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-cus.el (gnus-group-customize, gnus-score-parameters):
+ Don't quote nil and t in docstrings.
+
+ * gnus-score.el (gnus-score-lower-thread): Likewise.
+
+ * gnus-art.el (gnus-article-mime-match-handle-function): Likewise.
+
+==> already in Gnus
+
+2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-accept-article): Don't use
+ mail-header-unfold-field.
+
+ * imap.el (imap-ssl-open): Don't depend on ssl.el.
+ * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el.
+
+2003-02-18 Juanma Barranquero <lektu@terra.es>
+
+ * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant.
+
+2003-02-14 Juanma Barranquero <lektu@terra.es>
+
+ * mm-uu.el (mm-uu-dissect): Fix use of character constant.
+
+==> already done. [2003-02-14 ShengHuo ZHU synced stuff to Gnus]
+
+2003-02-11 Stefan Monnier <monnier@cs.yale.edu>
+
+ * nntp.el (nntp-accept-process-output): Don't use point-max to get
+ the buffer's size.
+
+==> already done. [2003-02-14 ShengHuo ZHU synced stuff to Gnus]
+
+2003-01-31 Joe Buehler <jhpb@draco.hekimian.com>
+
+ * nnheader.el: Added cygwin to system-type comparisons.
+
+==> already done.
+
+
+
+2004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * It seems that the last few changes and all older changes have
+ already been applied in Gnus repository, e.g. by ShengHuo ZHU
+ <zsh@cs.rochester.edu>.
+
+# Local Variables:
+# coding: iso-2022-7bit
+# mode: change-log
+# End:
+
+# arch-tag: e6e5d695-4d00-46b1-a49d-508a2418a483
diff --git a/lisp/gnus/bar.xbm b/lisp/gnus/bar.xbm
new file mode 100644
index 00000000000..e61300adb20
--- /dev/null
+++ b/lisp/gnus/bar.xbm
@@ -0,0 +1,7 @@
+#define noname_width 6
+#define noname_height 48
+static char noname_bits[] = {
+ 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,
+ 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,
+ 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,
+ 0x0c,0x0c,0x0c};
diff --git a/lisp/gnus/bar.xpm b/lisp/gnus/bar.xpm
new file mode 100644
index 00000000000..2985065a5c6
--- /dev/null
+++ b/lisp/gnus/bar.xpm
@@ -0,0 +1,54 @@
+/* XPM */
+static char * picon-bar_xpm[] = {
+"6 48 2 1",
+" c white s background",
+". c black",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. "};
diff --git a/lisp/gnus/binhex.el b/lisp/gnus/binhex.el
index e73903de77f..248e1c8d8e5 100644
--- a/lisp/gnus/binhex.el
+++ b/lisp/gnus/binhex.el
@@ -1,8 +1,7 @@
;;; binhex.el --- elisp native binhex decode
-;; Copyright (c) 1998 Free Software Foundation, Inc.
+;; Copyright (c) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Create Date: Oct 1, 1998
;; Keywords: binhex news
;; This file is part of GNU Emacs.
@@ -26,20 +25,33 @@
;;; Code:
+(autoload 'executable-find "executable")
+
(eval-when-compile (require 'cl))
-(defalias 'binhex-char-int
- (if (fboundp 'char-int)
- 'char-int
- 'identity))
+(eval-and-compile
+ (defalias 'binhex-char-int
+ (if (fboundp 'char-int)
+ 'char-int
+ 'identity)))
-(defvar binhex-decoder-program "hexbin"
- "*Non-nil value should be a string that names a uu decoder.
+(defcustom binhex-decoder-program "hexbin"
+ "*Non-nil value should be a string that names a binhex decoder.
The program should expect to read binhex data on its standard
-input and write the converted data to its standard output.")
+input and write the converted data to its standard output."
+ :type 'string
+ :group 'gnus-extract)
+
+(defcustom binhex-decoder-switches '("-d")
+ "*List of command line flags passed to the command `binhex-decoder-program'."
+ :group 'gnus-extract
+ :type '(repeat string))
-(defvar binhex-decoder-switches '("-d")
- "*List of command line flags passed to the command `binhex-decoder-program'.")
+(defcustom binhex-use-external
+ (executable-find binhex-decoder-program)
+ "*Use external binhex program."
+ :group 'gnus-extract
+ :type 'boolean)
(defconst binhex-alphabet-decoding-alist
'(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5)
@@ -69,13 +81,16 @@ input and write the converted data to its standard output.")
((boundp 'temporary-file-directory) temporary-file-directory)
("/tmp/")))
-(if (featurep 'xemacs)
- (defalias 'binhex-insert-char 'insert-char)
- (defun binhex-insert-char (char &optional count ignored buffer)
- (if (or (null buffer) (eq buffer (current-buffer)))
- (insert-char char count)
- (with-current-buffer buffer
- (insert-char char count)))))
+(eval-and-compile
+ (defalias 'binhex-insert-char
+ (if (featurep 'xemacs)
+ 'insert-char
+ (lambda (char &optional count ignored buffer)
+ "Insert COUNT copies of CHARACTER into BUFFER."
+ (if (or (null buffer) (eq buffer (current-buffer)))
+ (insert-char char count)
+ (with-current-buffer buffer
+ (insert-char char count)))))))
(defvar binhex-crc-table
[0 4129 8258 12387 16516 20645 24774 28903
@@ -184,8 +199,9 @@ input and write the converted data to its standard output.")
(t
(binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))
-(defun binhex-decode-region (start end &optional header-only)
- "Binhex decode region between START and END.
+;;;###autoload
+(defun binhex-decode-region-internal (start end &optional header-only)
+ "Binhex decode region between START and END without using an external program.
If HEADER-ONLY is non-nil only decode header and return filename."
(interactive "r")
(let ((work-buffer nil)
@@ -258,12 +274,14 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(and work-buffer (kill-buffer work-buffer)))
(if header (aref header 1))))
+;;;###autoload
(defun binhex-decode-region-external (start end)
"Binhex decode region between START and END using external decoder."
(interactive "r")
(let ((cbuf (current-buffer)) firstline work-buffer status
(file-name (expand-file-name
- (concat (binhex-decode-region start end t) ".data")
+ (concat (binhex-decode-region-internal start end t)
+ ".data")
binhex-temporary-file-directory)))
(save-excursion
(goto-char start)
@@ -296,6 +314,14 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(ignore-errors
(if file-name (delete-file file-name))))))
+;;;###autoload
+(defun binhex-decode-region (start end)
+ "Binhex decode region between START and END."
+ (interactive "r")
+ (if binhex-use-external
+ (binhex-decode-region-external start end)
+ (binhex-decode-region-internal start end)))
+
(provide 'binhex)
;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8
diff --git a/lisp/gnus/blink.pbm b/lisp/gnus/blink.pbm
new file mode 100644
index 00000000000..6c7531b92c6
--- /dev/null
+++ b/lisp/gnus/blink.pbm
Binary files differ
diff --git a/lisp/gnus/blink.xpm b/lisp/gnus/blink.xpm
new file mode 100644
index 00000000000..5035122119f
--- /dev/null
+++ b/lisp/gnus/blink.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * blink_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".+++++++..++.",
+".+++++++..++.",
+".++...++++++.",
+".+++++++++++.",
+".++++++++.++.",
+".++.+++++.++.",
+".+++.....+++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/braindamaged.xpm b/lisp/gnus/braindamaged.xpm
new file mode 100644
index 00000000000..25bd3e7bbee
--- /dev/null
+++ b/lisp/gnus/braindamaged.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * mad_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".++...++++++.",
+".++.+.+...++.",
+".++...+.+.++.",
+".++++++...++.",
+".+.+++++++.+.",
+".+.+++++++.+.",
+".++.+++++.++.",
+".+++.....+++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
new file mode 100644
index 00000000000..99d6500001a
--- /dev/null
+++ b/lisp/gnus/canlock.el
@@ -0,0 +1,251 @@
+;;; canlock.el --- functions for Cancel-Lock feature
+
+;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
+
+;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
+;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Canlock is a library for generating and verifying Cancel-Lock and/or
+;; Cancel-Key header in news articles. This is used to protect articles
+;; from rogue cancel, supersede or replace attacks. The method is based
+;; on draft-ietf-usefor-cancel-lock-01.txt which was released on November
+;; 3rd 1998. For instance, you can add Cancel-Lock (and possibly Cancel-
+;; Key) header in a news article by using a hook which will be evaluated
+;; just before sending an article as follows:
+;;
+;; (add-hook '*e**a*e-header-hook 'canlock-insert-header t)
+;;
+;; Verifying Cancel-Lock is mainly a function of news servers, however,
+;; you can verify your own article using the command `canlock-verify' in
+;; the (raw) article buffer. You will be prompted for the password for
+;; each time if the option `canlock-password' or `canlock-password-for-
+;; verify' is nil. Note that setting these options is a bit unsafe.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'sha1)
+
+(defvar mail-header-separator)
+
+(defgroup canlock nil
+ "The Cancel-Lock feature."
+ :group 'applications)
+
+(defcustom canlock-password nil
+ "Password to use when signing a Cancel-Lock or a Cancel-Key header."
+ :type '(radio (const :format "Not specified " nil)
+ (string :tag "Password" :size 0))
+ :group 'canlock)
+
+(defcustom canlock-password-for-verify canlock-password
+ "Password to use when verifying a Cancel-Lock or a Cancel-Key header."
+ :type '(radio (const :format "Not specified " nil)
+ (string :tag "Password" :size 0))
+ :group 'canlock)
+
+(defcustom canlock-force-insert-header nil
+ "If non-nil, insert a Cancel-Lock or a Cancel-Key header even if the
+buffer does not look like a news message."
+ :type 'boolean
+ :group 'canlock)
+
+(eval-when-compile
+ (defmacro canlock-string-as-unibyte (string)
+ "Return a unibyte string with the same individual bytes as STRING."
+ (if (fboundp 'string-as-unibyte)
+ (list 'string-as-unibyte string)
+ string)))
+
+(defun canlock-sha1 (message)
+ "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes."
+ (let (sha1-maximum-internal-length)
+ (sha1 message nil nil 'binary)))
+
+(defun canlock-make-cancel-key (message-id password)
+ "Make a Cancel-Key header."
+ (when (> (length password) 20)
+ (setq password (canlock-sha1 password)))
+ (setq password (concat password (make-string (- 64 (length password)) 0)))
+ (let ((ipad (mapconcat (lambda (byte)
+ (char-to-string (logxor 54 byte)))
+ password ""))
+ (opad (mapconcat (lambda (byte)
+ (char-to-string (logxor 92 byte)))
+ password "")))
+ (base64-encode-string
+ (canlock-sha1
+ (concat opad
+ (canlock-sha1
+ (concat ipad (canlock-string-as-unibyte message-id))))))))
+
+(defun canlock-narrow-to-header ()
+ "Narrow the buffer to the head of the message."
+ (let (case-fold-search)
+ (narrow-to-region
+ (goto-char (point-min))
+ (goto-char (if (re-search-forward
+ (format "^$\\|^%s$"
+ (regexp-quote mail-header-separator))
+ nil t)
+ (match-beginning 0)
+ (point-max))))))
+
+(defun canlock-delete-headers ()
+ "Delete Cancel-Key or Cancel-Lock headers in the narrowed buffer."
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (while (re-search-forward "^Cancel-\\(Key\\|Lock\\):" nil t)
+ (delete-region (match-beginning 0)
+ (if (re-search-forward "^[^\t ]" nil t)
+ (goto-char (match-beginning 0))
+ (point-max))))))
+
+(defun canlock-fetch-fields (&optional key)
+ "Return a list of the values of Cancel-Lock header.
+If KEY is non-nil, look for a Cancel-Key header instead. The buffer
+is expected to be narrowed to just the headers of the message."
+ (let ((field (mail-fetch-field (if key "Cancel-Key" "Cancel-Lock")))
+ fields rest
+ (case-fold-search t))
+ (when field
+ (setq fields (split-string field "[\t\n\r ,]+"))
+ (while fields
+ (when (string-match "^sha1:" (setq field (pop fields)))
+ (push (substring field 5) rest)))
+ (nreverse rest))))
+
+(defun canlock-fetch-id-for-key ()
+ "Return a Message-ID in Cancel, Supersedes or Replaces header.
+The buffer is expected to be narrowed to just the headers of the
+message."
+ (or (let ((cancel (mail-fetch-field "Control")))
+ (and cancel
+ (string-match "^cancel[\t ]+\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+ cancel)
+ (match-string 1 cancel)))
+ (mail-fetch-field "Supersedes")
+ (mail-fetch-field "Replaces")))
+
+;;;###autoload
+(defun canlock-insert-header (&optional id-for-key id-for-lock password)
+ "Insert a Cancel-Key and/or a Cancel-Lock header if possible."
+ (let (news control key-for-key key-for-lock)
+ (save-excursion
+ (save-restriction
+ (canlock-narrow-to-header)
+ (when (setq news (or canlock-force-insert-header
+ (mail-fetch-field "Newsgroups")))
+ (unless id-for-key
+ (setq id-for-key (canlock-fetch-id-for-key)))
+ (if (and (setq control (mail-fetch-field "Control"))
+ (string-match "^cancel[\t ]+<[^\t\n @<>]+@[^\t\n @<>]+>"
+ control))
+ (setq id-for-lock nil)
+ (unless id-for-lock
+ (setq id-for-lock (mail-fetch-field "Message-ID"))))
+ (canlock-delete-headers)
+ (goto-char (point-max))))
+ (when news
+ (if (not (or id-for-key id-for-lock))
+ (message "There are no Message-ID(s)")
+ (unless password
+ (setq password (or canlock-password
+ (read-passwd
+ "Password for Canlock: "))))
+ (if (or (not (stringp password)) (zerop (length password)))
+ (message "Password for Canlock is bad")
+ (setq key-for-key (when id-for-key
+ (canlock-make-cancel-key
+ id-for-key password))
+ key-for-lock (when id-for-lock
+ (canlock-make-cancel-key
+ id-for-lock password)))
+ (if (not (or key-for-key key-for-lock))
+ (message "Couldn't insert Canlock header")
+ (when key-for-key
+ (insert "Cancel-Key: sha1:" key-for-key "\n"))
+ (when key-for-lock
+ (insert "Cancel-Lock: sha1:"
+ (base64-encode-string (canlock-sha1 key-for-lock))
+ "\n")))))))))
+
+;;;###autoload
+(defun canlock-verify (&optional buffer)
+ "Verify Cancel-Lock or Cancel-Key in BUFFER.
+If BUFFER is nil, the current buffer is assumed. Signal an error if
+it fails."
+ (interactive)
+ (let (keys locks errmsg id-for-key id-for-lock password
+ key-for-key key-for-lock match)
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (save-restriction
+ (widen)
+ (canlock-narrow-to-header)
+ (setq keys (canlock-fetch-fields 'key)
+ locks (canlock-fetch-fields))
+ (if (not (or keys locks))
+ (setq errmsg
+ "There are neither Cancel-Lock nor Cancel-Key headers")
+ (setq id-for-key (canlock-fetch-id-for-key)
+ id-for-lock (mail-fetch-field "Message-ID"))
+ (or id-for-key id-for-lock
+ (setq errmsg "There are no Message-ID(s)")))))
+ (if errmsg
+ (error "%s" errmsg)
+ (setq password (or canlock-password-for-verify
+ (read-passwd "Password for Canlock: ")))
+ (if (or (not (stringp password)) (zerop (length password)))
+ (error "Password for Canlock is bad")
+ (when keys
+ (when id-for-key
+ (setq key-for-key (canlock-make-cancel-key id-for-key password))
+ (while (and keys (not match))
+ (setq match (string-equal key-for-key (pop keys)))))
+ (setq keys (if match "good" "bad")))
+ (setq match nil)
+ (when locks
+ (when id-for-lock
+ (setq key-for-lock
+ (base64-encode-string
+ (canlock-sha1 (canlock-make-cancel-key id-for-lock
+ password))))
+ (when (and locks (not match))
+ (setq match (string-equal key-for-lock (pop locks)))))
+ (setq locks (if match "good" "bad")))
+ (prog1
+ (when (member "bad" (list keys locks))
+ "bad")
+ (cond ((and keys locks)
+ (message "Cancel-Key is %s, Cancel-Lock is %s" keys locks))
+ (locks
+ (message "Cancel-Lock is %s" locks))
+ (keys
+ (message "Cancel-Key is %s" keys))))))))
+
+(provide 'canlock)
+
+;;; arch-tag: 033c4f09-b9f1-459d-bd0d-254430283f78
+;;; canlock.el ends here
diff --git a/lisp/gnus/catchup.xpm b/lisp/gnus/catchup.xpm
index 832c4eb1859..cba849712df 100644
--- a/lisp/gnus/catchup.xpm
+++ b/lisp/gnus/catchup.xpm
@@ -1,73 +1,33 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 43 1",
-" c Gray0",
-". c #099909990999",
-"X c Gray6",
-"o c #133313331333",
-"O c Gray9",
-"+ c Gray11",
-"@ c Gray12",
-"# c #23f323f323f3",
-"$ c Gray15",
-"% c #2ff12ff12ff1",
-"& c #3fff3fff3fff",
-"* c Gray25",
-"= c #4ccc4ccc4ccc",
-"- c #519151915191",
-"; c #53ed53ed53ed",
-": c #565b565b565b",
-"> c Gray35",
-", c #5b1a5b1a5b1a",
-"< c #5fe95fe95fe9",
-"1 c #626262626262",
-"2 c Gray40",
-"3 c #67e767e767e7",
-"4 c Gray42",
-"5 c #6fff6fff6fff",
-"6 c Gray45",
-"7 c Gray46",
-"8 c #77e977e977e9",
-"9 c #7bdb7bdb7bdb",
-"0 c #7ccc7ccc7ccc",
-"q c Gray50",
-"w c #866586658665",
-"e c Gray56",
-"r c Gray60",
-"t c #9bcb9bcb9bcb",
-"y c #9fff9fff9fff",
-"u c #a7c7a7c7a7c7",
-"i c #af0eaf0eaf0e",
-"p c Gray70",
-"a c Gray75",
-"s c Gray81",
-"d c #dfffdfffdfff",
-"f c #efffefffefff",
-"g c Gray100",
-/* pixels */
-"aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaa7$$*uaaaaaaaaareep",
-"aaaaaa$rr6<aaaaaaaae;==>",
-"aaaaaa7<r6<aaaaaaaa<6rr$",
-"9&&&&&&>6;aaaareeeee#rw*",
-"&aqqagga@<<<7e7qqqqqq=:u",
-"33e4qgggsaa%1Oa&&&ggge<a",
-"17a9ygf7%%%%#=$aa%ggga<a",
-"7aa&gga<aaaae$>ae7ggya<a",
-"aa;sgg;uaaaapepa<agg&a<a",
-"au;&&&%aaaaaaaae<aaa;a6.",
-"a<aggg%aaaaaaaa3qqq&e<:o",
-"r7<5gg%aaaaaaaaXyggqeaue",
-"6gs$6fa=re6666=s@egy3rrr",
-"ga>r=aa=r6 <qqdd3=yg&rrr",
-"&>er=aa=r6 aggg=wr&g&rrr",
-"rrrrr$a<:6 @$$$rri=d5qrr",
-"rrrrr<===6$wrrrrrr6&qo6r",
-"rrrrrrrrrewrrrrrrr6 oq",
-"rrrrrrrrrrrrrrrrrrrrrrrr",
-"rrrrrrrrrrrrrrrrrrrrrrrr",
-"rrrrrrrrrrrrrrrrrrrrrrrr"
-};
+static char * catchup_xpm[] = {
+"24 24 6 1",
+" c None",
+". c #FFFFFFFFFFFF",
+"X c #E1E1E0E0E0E0",
+"o c #A5A5A5A59595",
+"O c #999999999999",
+"+ c #000000000000",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" . ",
+" . .X ",
+" ... .oX . ",
+" ..oooX.oXo .X ",
+" .oooXXXX..oXXoXX ",
+" .oXXXX.XoX.oXooX ",
+" X...X.X.XX.XoXX ",
+" Xo..X.XXX.XXXX ",
+" . Xo.oXX..XXXXXX ",
+"OOOOXoXXXXXo.XXXXX++OOOO",
+"OOOOOX..X.XXXXXXXX++OOOO",
+"OOOOOX..XXXXXXXXX++OOOOO",
+"OOOOOOXXXXXXXXX+++OOOOOO",
+"OOOOOOOOOXXXX++++OOOOOOO",
+"OOOOOOOOO+++++OOOOOOOOOO",
+"OOOOOOOOOO+OOOOOOOOOOOOO",
+"OOOOOOOOOOOOOOOOOOOOOOOO"};
diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el
new file mode 100644
index 00000000000..fc2ac46c581
--- /dev/null
+++ b/lisp/gnus/compface.el
@@ -0,0 +1,58 @@
+;;; compface.el --- functions for converting X-Face headers
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###
+(defun uncompface (face)
+ "Convert FACE to pbm.
+Requires the external programs `uncompface', and `icontopbm'. On a
+GNU/Linux system these might be in packages with names like `compface'
+or `faces-xface' and `netpbm' or `libgr-progs', for instance."
+ (with-temp-buffer
+ (insert face)
+ (and (eq 0 (apply 'call-process-region (point-min) (point-max)
+ "uncompface"
+ 'delete '(t nil) nil))
+ (progn
+ (goto-char (point-min))
+ (insert "/* Width=48, Height=48 */\n")
+ ;; I just can't get "icontopbm" to work correctly on its
+ ;; own in XEmacs. And Emacs doesn't understand un-raw pbm
+ ;; files.
+ (if (not (featurep 'xemacs))
+ (eq 0 (call-process-region (point-min) (point-max)
+ "icontopbm"
+ 'delete '(t nil)))
+ (shell-command-on-region (point-min) (point-max)
+ "icontopbm | pnmnoraw"
+ (current-buffer) t)
+ t))
+ (buffer-string))))
+
+(provide 'compface)
+
+;;; arch-tag: f9c78e84-98c0-4142-9682-8ba4cf4c3441
+;;; compface.el ends here
diff --git a/lisp/gnus/cry.xpm b/lisp/gnus/cry.xpm
new file mode 100644
index 00000000000..8d8558dbc5b
--- /dev/null
+++ b/lisp/gnus/cry.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * cry_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++..+++..++.",
+".++++++++.++.",
+".+++++++.+.+.",
+".+++++++.+.+.",
+".++++++++..+.",
+".+++.....+++.",
+".++.+++++.++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/cu-exit.xpm b/lisp/gnus/cu-exit.xpm
index bc051f8e049..17236223fed 100644
--- a/lisp/gnus/cu-exit.xpm
+++ b/lisp/gnus/cu-exit.xpm
@@ -1,64 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 34 1",
-" c Gray0",
-". c #0bfb0bfb0bfb",
-"X c Gray6",
-"o c Gray9",
-"O c Gray11",
-"+ c Gray12",
-"@ c #23f323f323f3",
-"# c Gray15",
-"$ c #2ff52ff52ff5",
-"% c #3fff3fff3fff",
-"& c Gray25",
-"* c Gray28",
-"= c #4ccc4ccc4ccc",
-"- c #53e853e853e8",
-"; c #5b1a5b1a5b1a",
-": c #5fef5fef5fef",
-"> c #67e767e767e7",
-", c Gray42",
-"< c #6ff76ff76ff7",
-"1 c #77dc77dc77dc",
-"2 c Gray50",
-"3 c #866586658665",
-"4 c #88a888a888a8",
-"5 c Gray56",
-"6 c Gray60",
-"7 c #9bcb9bcb9bcb",
-"8 c #9fff9fff9fff",
-"9 c #a7d7a7d7a7d7",
-"0 c Gray70",
-"q c #b635b635b635",
-"w c Gray75",
-"e c Gray78",
-"r c #dfffdfffdfff",
-"t c Gray100",
-/* pixels */
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwww-$$$-wwwwwwww",
-"wwwwwww9-$w$ttt$wwwwwwww",
-"wwwwww:<ro:1ttto::wwwwww",
-"wwww1$wrt5 wttt$w$$1wwww",
-"wwww1.ttt5 5ww$ttt.1wwww",
-"wwwww$8tt+222% 222$wwwww",
-"wwwww$%tt%ttt2 ww$6wwwww",
-"wwwww$52t%ttt2wtt%wwwwww",
-"wwwww1 %r%ttt2w22>wwwwww",
-"wwwwww,::X%%%+$w:5wwwwww",
-"qqqqqq4*5%t%t255;qqqqqqq",
-"6666663#*+2+2%**=6666666",
-"6666666=0$w$0*0&36666666",
-"6666666=,$9@5*,#66666666",
-"6666666= +% 2% #66666666",
-"6666666= %e@<2 #66666666",
-"6666666:# +666666666",
-"666666666=====3666666666",
-"666666666666666666666666"
-};
+static char * cu_exit_xpm[] = {
+"24 24 4 1",
+" c None",
+". c #000000000000",
+"X c #FFFFFFFFFFFF",
+"o c #999999999999",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ..... ",
+" .. .XXX. ",
+" ..X..XXXX... ",
+" .XXXX.XXXX.X... ",
+" ..XXXX.XXX.XXX.. ",
+" .XXX.......... ",
+" .XXX.XXX.XXX.. ",
+" .XX.XXX.XXX. ",
+" .XX.XXX.XX.. ",
+" ............ ",
+" .X.X.X.X.. ",
+"ooooooo..........ooooooo",
+"ooooooo.X.X.X.X.oooooooo",
+"ooooooo.........oooooooo",
+"ooooooo..X...X..oooooooo",
+"ooooooo...X.X...oooooooo",
+"ooooooo........ooooooooo",
+"ooooooooo.....oooooooooo",
+"oooooooooooooooooooooooo"};
diff --git a/lisp/gnus/dead.xpm b/lisp/gnus/dead.xpm
new file mode 100644
index 00000000000..56463a72951
--- /dev/null
+++ b/lisp/gnus/dead.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * dead_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++.+.+.+.++.",
+".+++.+++.+++.",
+".++.+.+.+.++.",
+".+++++++++++.",
+".+++++++++++.",
+".+.+++++++.+.",
+".++.......++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/describe-group.xpm b/lisp/gnus/describe-group.xpm
index e191277c55d..b4a6f42a94b 100644
--- a/lisp/gnus/describe-group.xpm
+++ b/lisp/gnus/describe-group.xpm
@@ -1,72 +1,32 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 42 1",
-" c Gray0",
-". c #099909990999",
-"X c #0bfb0bfb0bfb",
-"o c #133313331333",
-"O c Gray9",
-"+ c Gray11",
-"@ c #23f323f323f3",
-"# c Gray15",
-"$ c #2d8d2d8d2d8d",
-"% c #399939993999",
-"& c #433243324332",
-"* c #4ccc4ccc4ccc",
-"= c #519151915191",
-"- c #53e353e353e3",
-"; c #565656565656",
-": c Gray36",
-"> c #5fdf5fdf5fdf",
-", c Gray42",
-"< c #6fff6fff6fff",
-"1 c Gray45",
-"2 c #77f777f777f7",
-"3 c #7ccc7ccc7ccc",
-"4 c Gray50",
-"5 c #865a865a865a",
-"6 c Gray58",
-"7 c Gray60",
-"8 c #9bfb9bfb9bfb",
-"9 c Gray62",
-"0 c #9fff9fff9fff",
-"q c #a0c0a0c0a0c0",
-"w c Gray64",
-"e c Gray65",
-"r c Gray70",
-"t c #b635b635b635",
-"y c Gray73",
-"u c Gray75",
-"i c #d332d332d332",
-"p c Gray85",
-"a c #e665e665e665",
-"s c #eccbeccbeccb",
-"d c #f998f998f998",
-"f c Gray100",
-/* pixels */
-"&77&77&77&77&77&77&77&77",
-"777777777777777777777777",
-"77777777777777777iaaa777",
-"&77&77&77&77&77<ff<fffp0",
-"77777777777777uffffffffp",
-"7777777777777udfffffffff",
-"&77&77&77&77<ff<ff<ff<ff",
-"777777777777ffffffffffff",
-"777777777777ffffffffffff",
-"&77&77&77&77<ff<ff<ff<ff",
-"777777777777ffffffffffff",
-"777777777777ffffffffffff",
-"&77&77&77&77:ff<ff<ff<ff",
-"777777777777rfffffffffff",
-"77777&##37770pffffffffff",
-"&77%-6ty-#77&7i<ff<ff<fs",
-"777*5w7wy*17777pffffffae",
-"777$13&7w+*77770rsfffre7",
-"&73X:@3*1 *7&77&77&77&77",
-"71o2;o***o17777777777777",
-"3o,**X%*X377777777777777",
-"XO, +##3&77&77&77&77&77",
-":;o #50w7777777777777777",
-"@oX+57707777777777777777"
-};
+static char * describe_group_xpm[] = {
+"24 24 5 1",
+". c None",
+" c #000000000000",
+"o c #FFFFF5F5ACAC",
+"+ c #E1E1E0E0E0E0",
+"@ c #C7C7C6C6C6C6",
+"........................",
+"........................",
+".................oooo...",
+" .. .. .. .. .. oo oo o.",
+"..............oooooooooo",
+".............ooooooooooo",
+" .. .. .. .. oo oo oo oo",
+"............oooooooooooo",
+"............oooooooooooo",
+" .. .. .. .. oo oo oo oo",
+"............oooooooooooo",
+"............oooooooooooo",
+" .. .. .. .. oo oo oo oo",
+"............oooooooooooo",
+"..... ...oooooooooooo",
+" .. ++ .. .o oo oo oo",
+"... @@@+ ....ooooooooo",
+"... @ ....oooooooo.",
+" . . .. .. .. ..",
+". ..............",
+" ................",
+" .. .. .. .. .. ..",
+" ..................",
+" ...................."};
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
new file mode 100644
index 00000000000..85d45cd3513
--- /dev/null
+++ b/lisp/gnus/deuglify.el
@@ -0,0 +1,472 @@
+;;; deuglify.el --- deuglify broken Outlook (Express) articles
+
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002 Raymond Scholz
+
+;; Author: Raymond Scholz <rscholz@zonix.de>
+;; Thomas Steffen (unwrapping algorithm,
+;; based on an idea of Stefan Monnier)
+;; Keywords: mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file enables Gnus to repair broken citations produced by
+;; common user agents like MS Outlook (Express). It may repair
+;; articles of other user agents too.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; Outlook sometimes wraps cited lines before sending a message as
+;; seen in this example:
+;;
+;; Example #1
+;; ----------
+;;
+;; John Doe wrote:
+;;
+;; > This sentence no verb. This sentence no verb. This sentence
+;; no
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;;
+;; The function `gnus-article-outlook-unwrap-lines' tries to recognize those
+;; erroneously wrapped lines and will unwrap them. I.e. putting the
+;; wrapped parts ("no" in this example) back where they belong (at the
+;; end of the cited line above).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Note that some people not only use broken user agents but also
+;; practice a bad citation style by omitting blank lines between the
+;; cited text and their own text.
+;:
+;; Example #2
+;; ----------
+;;
+;; John Doe wrote:
+;;
+;; > This sentence no verb. This sentence no verb. This sentence no
+;; You forgot in all your sentences.
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;;
+;; Unwrapping "You forgot in all your sentences." would be illegal as
+;; this part wasn't intended to be cited text.
+;; `gnus-article-outlook-unwrap-lines' will only unwrap lines if the resulting
+;; citation line will be of a certain maximum length. You can control
+;; this by adjusting `gnus-outlook-deuglify-unwrap-max'. Also
+;; unwrapping will only be done if the line above the (possibly)
+;; wrapped line has a minimum length of `gnus-outlook-deuglify-unwrap-min'.
+;;
+;; Furthermore no unwrapping will be undertaken if the last character
+;; is one of the chars specified in
+;; `gnus-outlook-deuglify-unwrap-stop-chars'. Setting this to ".?!"
+;; inhibits unwrapping if the cited line ends with a full stop,
+;; question mark or exclamation mark. Note that this variable
+;; defaults to `nil', triggering a few false positives but generally
+;; giving you better results.
+;;
+;; Unwrapping works on every level of citation. Thus you will be able
+;; repair broken citations of broken user agents citing broken
+;; citations of broken user agents citing broken citations...
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Citations are commonly introduced with an attribution line
+;; indicating who wrote the cited text. Outlook adds superfluous
+;; information that can be found in the header of the message to this
+;; line and often wraps it.
+;;
+;; If that weren't enough, lots of people write their own text above
+;; the cited text and cite the complete original article below.
+;;
+;; Example #3
+;; ----------
+;;
+;; Hey, John. There's no in all your sentences!
+;;
+;; John Doe <john.doe@some.domain> wrote in message
+;; news:a87usw8$dklsssa$2@some.news.server...
+;; > This sentence no verb. This sentence no verb. This sentence
+;; no
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;; >
+;; > Bye, John
+;;
+;; Repairing the attribution line will be done by function
+;; `gnus-article-outlook-repair-attribution which calls other function that
+;; try to recognize and repair broken attribution lines. See variable
+;; `gnus-outlook-deuglify-attrib-cut-regexp' for stuff that should be
+;; cut off from the beginning of an attribution line and variable
+;; `gnus-outlook-deuglify-attrib-verb-regexp' for the verbs that are
+;; required to be found in an attribution line. These function return
+;; the point where the repaired attribution line starts.
+;;
+;; Rearranging the article so that the cited text appears above the
+;; new text will be done by function
+;; `gnus-article-outlook-rearrange-citation'. This function calls
+;; `gnus-article-outlook-repair-attribution to find and repair an attribution
+;; line.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Well, and that's what the message will look like after applying
+;; deuglification:
+;;
+;; Example #3 (deuglified)
+;; -----------------------
+;;
+;; John Doe <john.doe@some.domain> wrote:
+;;
+;; > This sentence no verb. This sentence no verb. This sentence no
+;; > verb. This sentence no verb. This sentence no verb. This
+;; > sentence no verb.
+;; >
+;; > Bye, John
+;;
+;; Hey, John. There's no in all your sentences!
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Usage
+;; -----
+;;
+;; Press `W k' in the Summary Buffer.
+;;
+;; Non recommended usage :-)
+;; ---------------------
+;;
+;; To automatically invoke deuglification on every article you read,
+;; put something like that in your .gnus:
+;;
+;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-unwrap-lines)
+;;
+;; or _one_ of the following lines:
+;;
+;; ;; repair broken attribution lines
+;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-repair-attribution)
+;;
+;; ;; repair broken attribution lines and citations
+;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-rearrange-citation)
+;;
+;; Note that there always may be some false positives, so I suggest
+;; using the manual invocation. After deuglification you may want to
+;; refill the whole article using `W w'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Limitations
+;; -----------
+;;
+;; As I said before there may (or will) be a few false positives on
+;; unwrapping cited lines with `gnus-article-outlook-unwrap-lines'.
+;;
+;; `gnus-article-outlook-repair-attribution will only fix the first
+;; attribution line found in the article. Furthermore it fixed to
+;; certain kinds of attributions. And there may be horribly many
+;; false positives, vanishing lines and so on -- so don't trust your
+;; eyes. Again I recommend manual invocation.
+;;
+;; `gnus-article-outlook-rearrange-citation' carries all the limitations of
+;; `gnus-article-outlook-repair-attribution.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; See ChangeLog for other changes.
+;;
+;; Revision 1.5 2002/01/27 14:39:17 rscholz
+;; * New variable `gnus-outlook-deuglify-no-wrap-chars' to inhibit
+;; unwrapping if one these chars is first in the possibly wrapped line.
+;; * Improved rearranging of the article.
+;; * New function `gnus-outlook-repair-attribution-block' for repairing
+;; those big "Original Message (following some headers)" attributions.
+;;
+;; Revision 1.4 2002/01/03 14:05:00 rscholz
+;; Renamed `gnus-outlook-deuglify-article' to
+;; `gnus-article-outlook-deuglify-article'.
+;; Made it easier to deuglify the article while being in Gnus' Article
+;; Edit Mode. (suggested by Phil Nitschke)
+;;
+;;
+;; Revision 1.3 2002/01/02 23:35:54 rscholz
+;; Fix a bug that caused succeeding long attribution lines to be
+;; unwrapped. Minor doc fixes and regular expression tuning.
+;;
+;; Revision 1.2 2001/12/30 20:14:34 rscholz
+;; Clean up source.
+;;
+;; Revision 1.1 2001/12/30 20:13:32 rscholz
+;; Initial revision
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; Code:
+
+(require 'gnus-art)
+(require 'gnus-sum)
+
+(defconst gnus-outlook-deuglify-version "1.5 Gnus version"
+ "Version of gnus-outlook-deuglify.")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-outlook-deuglify nil
+ "Deuglify articles generated by broken user agents like MS Outlook (Express).")
+
+;;;###autoload
+(defcustom gnus-outlook-deuglify-unwrap-min 45
+ "Minimum length of the cited line above the (possibly) wrapped line."
+ :type 'integer
+ :group 'gnus-outlook-deuglify)
+
+;;;###autoload
+(defcustom gnus-outlook-deuglify-unwrap-max 95
+ "Maximum length of the cited line after unwrapping."
+ :type 'integer
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-cite-marks ">|#%"
+ "Characters that indicate cited lines."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
+ "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line."
+ :type '(radio (const :format "None " nil)
+ (string :size 0 :value ".?!"))
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
+ "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-cut-regexp
+ "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
+ "Regular expression matching the beginning of an attribution line that should be cut off."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-verb-regexp
+ "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió"
+ "Regular expression matching the verb used in an attribution line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+(defcustom gnus-outlook-deuglify-attrib-end-regexp
+ ": *\\|\\.\\.\\."
+ "Regular expression matching the end of an attribution line."
+ :type 'string
+ :group 'gnus-outlook-deuglify)
+
+;;;###autoload
+(defcustom gnus-outlook-display-hook nil
+ "A hook called after an deuglified article has been prepared.
+It is run after `gnus-article-prepare-hook'."
+ :type 'hook
+ :group 'gnus-outlook-deuglify)
+
+;; Functions
+
+(defun gnus-outlook-display-article-buffer ()
+ "Redisplay current buffer or article buffer."
+ (with-current-buffer (or gnus-article-buffer (current-buffer))
+ ;; "Emulate" `gnus-article-prepare-display' without calling
+ ;; it. Calling `gnus-article-prepare-display' on an already
+ ;; prepared article removes all MIME parts. I'm unsure whether
+ ;; this is a bug or not.
+ (gnus-article-highlight t)
+ (gnus-treat-article nil)
+ (gnus-run-hooks 'gnus-article-prepare-hook
+ 'gnus-outlook-display-hook)))
+
+;;;###autoload
+(defun gnus-article-outlook-unwrap-lines (&optional nodisplay)
+ "Unwrap lines that appear to be wrapped citation lines.
+You can control what lines will be unwrapped by frobbing
+`gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max',
+indicating the minimum and maximum length of an unwrapped citation line. If
+NODISPLAY is non-nil, don't redisplay the article buffer."
+ (interactive "P")
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks)
+ (no-wrap gnus-outlook-deuglify-no-wrap-chars)
+ (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (while (re-search-forward
+ (concat
+ "^\\([ \t" cite-marks "]*\\)"
+ "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
+ "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
+ nil t)
+ (let ((len12 (- (match-end 2) (match-beginning 1)))
+ (len3 (- (match-end 3) (match-beginning 3))))
+ (if (and (> len12 gnus-outlook-deuglify-unwrap-min)
+ (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
+ (progn
+ (replace-match "\\1\\2 \\3")
+ (goto-char (match-beginning 0)))))))))
+ (unless nodisplay (gnus-outlook-display-article-buffer)))
+
+(defun gnus-outlook-rearrange-article (attr-start)
+ "Put the text from ATTR-START to the end of buffer at the top of the article buffer."
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ ;; article does not start with attribution
+ (unless (= (point) attr-start)
+ (gnus-kill-all-overlays)
+ (let ((cur (point))
+ ;; before signature or end of buffer
+ (to (if (gnus-article-search-signature)
+ (point)
+ (point-max))))
+ ;; handle the case where the full quote is below the
+ ;; signature
+ (if (< to attr-start)
+ (setq to (point-max)))
+ (transpose-regions cur attr-start attr-start to)))))))
+
+;; John Doe <john.doe@some.domain> wrote in message
+;; news:a87usw8$dklsssa$2@some.news.server...
+
+(defun gnus-outlook-repair-attribution-outlook ()
+ "Repair a broken attribution line (Outlook)."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (re-search-forward
+ (concat "^\\([^" cite-marks "].+\\)"
+ "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
+ "\\(.*\n?[^\n" cite-marks "].*\\)?"
+ "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
+ nil t)
+ (progn
+ (gnus-kill-all-overlays)
+ (replace-match "\\1\\2\\4")
+ (match-beginning 0)))))))
+
+
+;; ----- Original Message -----
+;; From: "John Doe" <john.doe@some.domain>
+;; To: "Doe Foundation" <info@doefnd.org>
+;; Sent: Monday, November 19, 2001 12:13 PM
+;; Subject: More Doenuts
+
+(defun gnus-outlook-repair-attribution-block ()
+ "Repair a big broken attribution block."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (re-search-forward
+ (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
+ "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
+ "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
+ nil t)
+ (progn
+ (gnus-kill-all-overlays)
+ (replace-match "\\1 wrote:\n")
+ (match-beginning 0)))))))
+
+;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
+
+(defun gnus-outlook-repair-attribution-other ()
+ "Repair a broken attribution line (other user agents than Outlook)."
+ (save-excursion
+ (let ((case-fold-search nil)
+ (inhibit-read-only t)
+ (cite-marks gnus-outlook-deuglify-cite-marks))
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (re-search-forward
+ (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
+ "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
+ "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
+ "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
+ nil t)
+ (progn
+ (gnus-kill-all-overlays)
+ (replace-match "\\4 \\5\\6\\7")
+ (match-beginning 0)))))))
+
+;;;###autoload
+(defun gnus-article-outlook-repair-attribution (&optional nodisplay)
+ "Repair a broken attribution line.
+If NODISPLAY is non-nil, don't redisplay the article buffer."
+ (interactive "P")
+ (let ((attrib-start
+ (or
+ (gnus-outlook-repair-attribution-other)
+ (gnus-outlook-repair-attribution-block)
+ (gnus-outlook-repair-attribution-outlook))))
+ (unless nodisplay (gnus-outlook-display-article-buffer))
+ attrib-start))
+
+(defun gnus-article-outlook-rearrange-citation (&optional nodisplay)
+ "Repair broken citations.
+If NODISPLAY is non-nil, don't redisplay the article buffer."
+ (interactive "P")
+ (let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay)))
+ ;; rearrange citations if an attribution line has been recognized
+ (if attrib-start
+ (gnus-outlook-rearrange-article attrib-start)))
+ (unless nodisplay (gnus-outlook-display-article-buffer)))
+
+;;;###autoload
+(defun gnus-outlook-deuglify-article (&optional nodisplay)
+ "Full deuglify of broken Outlook (Express) articles.
+Treat dumbquotes, unwrap lines, repair attribution and rearrange citation. If
+NODISPLAY is non-nil, don't redisplay the article buffer."
+ (interactive "P")
+ ;; apply treatment of dumb quotes
+ (gnus-article-treat-dumbquotes)
+ ;; repair wrapped cited lines
+ (gnus-article-outlook-unwrap-lines 'nodisplay)
+ ;; repair attribution line and rearrange citation.
+ (gnus-article-outlook-rearrange-citation 'nodisplay)
+ (unless nodisplay (gnus-outlook-display-article-buffer)))
+
+;;;###autoload
+(defun gnus-article-outlook-deuglify-article ()
+ "Deuglify broken Outlook (Express) articles and redisplay."
+ (interactive)
+ (gnus-outlook-deuglify-article nil))
+
+(provide 'deuglify)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; arch-tag: 5f895cc9-51a9-487c-b42e-28844d79eb73
+;;; deuglify.el ends here
diff --git a/lisp/gnus/dig.el b/lisp/gnus/dig.el
new file mode 100644
index 00000000000..08070e985f8
--- /dev/null
+++ b/lisp/gnus/dig.el
@@ -0,0 +1,189 @@
+;;; dig.el --- Domain Name System dig interface
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: DNS BIND dig
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This provide an interface for "dig".
+;;
+;; For interactive use, try M-x dig and type a hostname. Use `q' to quit
+;; dig buffer.
+;;
+;; For use in elisp programs, call `dig-invoke' and use
+;; `dig-extract-rr' to extract resource records.
+
+;;; Release history:
+
+;; 2000-10-28 posted on gnu.emacs.sources
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defgroup dig nil
+ "Dig configuration.")
+
+(defcustom dig-program "dig"
+ "Name of dig (domain information groper) binary."
+ :type 'file
+ :group 'dig)
+
+(defcustom dig-dns-server nil
+ "DNS server to query.
+If nil, use system defaults."
+ :type '(choice (const :tag "System defaults")
+ string)
+ :group 'dig)
+
+(defcustom dig-font-lock-keywords
+ '(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face)
+ ("^;;.*" 0 font-lock-comment-face)
+ ("^; <<>>.*" 0 font-lock-type-face)
+ ("^;.*" 0 font-lock-function-name-face))
+ "Default expressions to highlight in dig mode."
+ :type 'sexp
+ :group 'dig)
+
+(defun dig-invoke (domain &optional
+ query-type query-class query-option
+ dig-option server)
+ "Call dig with given arguments and return buffer containing output.
+DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string
+with a DNS type. QUERY-CLASS is an optional string with a DNS class.
+QUERY-OPTION is an optional string with dig \"query options\".
+DIG-OPTIONS is an optional string with parameters for the dig program.
+SERVER is an optional string with a domain name server to query.
+
+Dig is an external program found in the BIND name server distribution,
+and is a commonly available debugging tool."
+ (let (buf cmdline)
+ (setq buf (generate-new-buffer "*dig output*"))
+ (if dig-option (push dig-option cmdline))
+ (if query-option (push query-option cmdline))
+ (if query-class (push query-class cmdline))
+ (if query-type (push query-type cmdline))
+ (push domain cmdline)
+ (if server (push (concat "@" server) cmdline)
+ (if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
+ (apply 'call-process dig-program nil buf nil cmdline)
+ buf))
+
+(defun dig-extract-rr (domain &optional type class)
+ "Extract resource records for DOMAIN, TYPE and CLASS from buffer.
+Buffer should contain output generated by `dig-invoke'."
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
+ (upcase (or class "IN")) "[\t ]+" (upcase (or type "A")))
+ nil t)
+ (let (b e)
+ (end-of-line)
+ (setq e (point))
+ (beginning-of-line)
+ (setq b (point))
+ (when (search-forward " (" e t)
+ (search-forward " )"))
+ (end-of-line)
+ (setq e (point))
+ (buffer-substring b e))
+ (and (re-search-forward (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
+ (upcase (or class "IN"))
+ "[\t ]+CNAME[\t ]+\\(.*\\)$") nil t)
+ (dig-extract-rr (match-string 1) type class)))))
+
+(defun dig-rr-get-pkix-cert (rr)
+ (let (b e str)
+ (string-match "[^\t ]+[\t ]+[0-9wWdDhHmMsS]+[\t ]+IN[\t ]+CERT[\t ]+\\(1\\|PKIX\\)[\t ]+[0-9]+[\t ]+[0-9]+[\t ]+(?" rr)
+ (setq b (match-end 0))
+ (string-match ")" rr)
+ (setq e (match-beginning 0))
+ (setq str (substring rr b e))
+ (while (string-match "[\t \n\r]" str)
+ (setq str (replace-match "" nil nil str)))
+ str))
+
+;; XEmacs does it like this. For Emacs, we have to set the
+;; `font-lock-defaults' buffer-local variable.
+(put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t))
+
+(put 'dig-mode 'mode-class 'special)
+
+(defvar dig-mode-map nil)
+(unless dig-mode-map
+ (setq dig-mode-map (make-sparse-keymap))
+ (suppress-keymap dig-mode-map)
+
+ (define-key dig-mode-map "q" 'dig-exit))
+
+(defun dig-mode ()
+ "Major mode for displaying dig output."
+ (interactive)
+ (kill-all-local-variables)
+ (setq mode-name "dig")
+ (setq major-mode 'dig-mode)
+ (use-local-map dig-mode-map)
+ (buffer-disable-undo)
+ (unless (featurep 'xemacs)
+ (set (make-local-variable 'font-lock-defaults)
+ '(dig-font-lock-keywords t)))
+ (when (featurep 'font-lock)
+ (font-lock-set-defaults)))
+
+(defun dig-exit ()
+ "Quit dig output buffer."
+ (interactive)
+ (kill-buffer (current-buffer)))
+
+(defun dig (domain &optional
+ query-type query-class query-option dig-option server)
+ "Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
+Optional arguments are passed to `dig-invoke'."
+ (interactive "sHost: ")
+ (switch-to-buffer
+ (dig-invoke domain query-type query-class query-option dig-option server))
+ (goto-char (point-min))
+ (and (search-forward ";; ANSWER SECTION:" nil t)
+ (forward-line))
+ (dig-mode)
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil))
+
+;; named for consistency with query-dns in dns.el
+(defun query-dig (domain &optional
+ query-type query-class query-option dig-option server)
+ "Query addresses of a DOMAIN using dig.
+It works by calling `dig-invoke' and `dig-extract-rr'. Optional
+arguments are passed to `dig-invoke' and `dig-extract-rr'. Returns
+nil for domain/class/type queries that results in no data."
+(let ((buffer (dig-invoke domain query-type query-class
+ query-option dig-option server)))
+ (when buffer
+ (switch-to-buffer buffer)
+ (let ((digger (dig-extract-rr domain query-type query-class)))
+ (kill-buffer buffer)
+ digger))))
+
+(provide 'dig)
+
+;;; arch-tag: 1d61726e-9400-4013-9ae7-4035e0c7f7d6
+;;; dig.el ends here
diff --git a/lisp/gnus/dns.el b/lisp/gnus/dns.el
new file mode 100644
index 00000000000..b11d2ca03d0
--- /dev/null
+++ b/lisp/gnus/dns.el
@@ -0,0 +1,359 @@
+;;; dns.el --- Domain Name Service lookups
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: network
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mm-util)
+
+(defvar dns-timeout 5
+ "How many seconds to wait when doing DNS queries.")
+
+(defvar dns-servers nil
+ "Which DNS servers to query.
+If nil, /etc/resolv.conf will be consulted.")
+
+;;; Internal code:
+
+(defvar dns-query-types
+ '((A 1)
+ (NS 2)
+ (MD 3)
+ (MF 4)
+ (CNAME 5)
+ (SOA 6)
+ (MB 7)
+ (MG 8)
+ (MR 9)
+ (NULL 10)
+ (WKS 11)
+ (PRT 12)
+ (HINFO 13)
+ (MINFO 14)
+ (MX 15)
+ (TXT 16)
+ (AXFR 252)
+ (MAILB 253)
+ (MAILA 254)
+ (* 255))
+ "Names of query types and their values.")
+
+(defvar dns-classes
+ '((IN 1)
+ (CS 2)
+ (CH 3)
+ (HS 4))
+ "Classes of queries.")
+
+(defun dns-write-bytes (value &optional length)
+ (let (bytes)
+ (dotimes (i (or length 1))
+ (push (% value 256) bytes)
+ (setq value (/ value 256)))
+ (dolist (byte bytes)
+ (insert byte))))
+
+(defun dns-read-bytes (length)
+ (let ((value 0))
+ (dotimes (i length)
+ (setq value (logior (* value 256) (following-char)))
+ (forward-char 1))
+ value))
+
+(defun dns-get (type spec)
+ (cadr (assq type spec)))
+
+(defun dns-inverse-get (value spec)
+ (let ((found nil))
+ (while (and (not found)
+ spec)
+ (if (eq value (cadr (car spec)))
+ (setq found (caar spec))
+ (pop spec)))
+ found))
+
+(defun dns-write-name (name)
+ (dolist (part (split-string name "\\."))
+ (dns-write-bytes (length part))
+ (insert part))
+ (dns-write-bytes 0))
+
+(defun dns-read-string-name (string buffer)
+ (mm-with-unibyte-buffer
+ (insert string)
+ (goto-char (point-min))
+ (dns-read-name buffer)))
+
+(defun dns-read-name (&optional buffer)
+ (let ((ended nil)
+ (name nil)
+ length)
+ (while (not ended)
+ (setq length (dns-read-bytes 1))
+ (if (= 192 (logand length (lsh 3 6)))
+ (let ((offset (+ (* (logand 63 length) 256)
+ (dns-read-bytes 1))))
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (goto-char (1+ offset))
+ (setq ended (dns-read-name buffer))))
+ (if (zerop length)
+ (setq ended t)
+ (push (buffer-substring (point)
+ (progn (forward-char length) (point)))
+ name))))
+ (if (stringp ended)
+ (if (null name)
+ ended
+ (concat (mapconcat 'identity (nreverse name) ".") "." ended))
+ (mapconcat 'identity (nreverse name) "."))))
+
+(defun dns-write (spec &optional tcp-p)
+ "Write a DNS packet according to SPEC.
+If TCP-P, the first two bytes of the package with be the length field."
+ (with-temp-buffer
+ (dns-write-bytes (dns-get 'id spec) 2)
+ (dns-write-bytes
+ (logior
+ (lsh (if (dns-get 'response-p spec) 1 0) -7)
+ (lsh
+ (cond
+ ((eq (dns-get 'opcode spec) 'query) 0)
+ ((eq (dns-get 'opcode spec) 'inverse-query) 1)
+ ((eq (dns-get 'opcode spec) 'status) 2)
+ (t (error "No such opcode: %s" (dns-get 'opcode spec))))
+ -3)
+ (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
+ (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
+ (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
+ (dns-write-bytes
+ (cond
+ ((eq (dns-get 'response-code spec) 'no-error) 0)
+ ((eq (dns-get 'response-code spec) 'format-error) 1)
+ ((eq (dns-get 'response-code spec) 'server-failure) 2)
+ ((eq (dns-get 'response-code spec) 'name-error) 3)
+ ((eq (dns-get 'response-code spec) 'not-implemented) 4)
+ ((eq (dns-get 'response-code spec) 'refused) 5)
+ (t 0)))
+ (dns-write-bytes (length (dns-get 'queries spec)) 2)
+ (dns-write-bytes (length (dns-get 'answers spec)) 2)
+ (dns-write-bytes (length (dns-get 'authorities spec)) 2)
+ (dns-write-bytes (length (dns-get 'additionals spec)) 2)
+ (dolist (query (dns-get 'queries spec))
+ (dns-write-name (car query))
+ (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
+ dns-query-types)) 2)
+ (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
+ dns-classes)) 2))
+ (dolist (slot '(answers authorities additionals))
+ (dolist (resource (dns-get slot spec))
+ (dns-write-name (car resource))
+ (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
+ 2)
+ (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
+ 2)
+ (dns-write-bytes (dns-get 'ttl resource) 4)
+ (dns-write-bytes (length (dns-get 'data resource)) 2)
+ (insert (dns-get 'data resource))))
+ (when tcp-p
+ (goto-char (point-min))
+ (dns-write-bytes (buffer-size) 2))
+ (buffer-string)))
+
+(defun dns-read (packet)
+ (mm-with-unibyte-buffer
+ (let ((spec nil)
+ queries answers authorities additionals)
+ (insert packet)
+ (goto-char (point-min))
+ (push (list 'id (dns-read-bytes 2)) spec)
+ (let ((byte (dns-read-bytes 1)))
+ (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
+ spec)
+ (let ((opcode (logand byte (lsh 7 3))))
+ (push (list 'opcode
+ (cond ((eq opcode 0) 'query)
+ ((eq opcode 1) 'inverse-query)
+ ((eq opcode 2) 'status)))
+ spec))
+ (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
+ nil t)) spec)
+ (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
+ spec)
+ (push (list 'recursion-desired-p
+ (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
+ (let ((rc (logand (dns-read-bytes 1) 15)))
+ (push (list 'response-code
+ (cond
+ ((eq rc 0) 'no-error)
+ ((eq rc 1) 'format-error)
+ ((eq rc 2) 'server-failure)
+ ((eq rc 3) 'name-error)
+ ((eq rc 4) 'not-implemented)
+ ((eq rc 5) 'refused)))
+ spec))
+ (setq queries (dns-read-bytes 2))
+ (setq answers (dns-read-bytes 2))
+ (setq authorities (dns-read-bytes 2))
+ (setq additionals (dns-read-bytes 2))
+ (let ((qs nil))
+ (dotimes (i queries)
+ (push (list (dns-read-name)
+ (list 'type (dns-inverse-get (dns-read-bytes 2)
+ dns-query-types))
+ (list 'class (dns-inverse-get (dns-read-bytes 2)
+ dns-classes)))
+ qs))
+ (push (list 'queries qs) spec))
+ (dolist (slot '(answers authorities additionals))
+ (let ((qs nil)
+ type)
+ (dotimes (i (symbol-value slot))
+ (push (list (dns-read-name)
+ (list 'type
+ (setq type (dns-inverse-get (dns-read-bytes 2)
+ dns-query-types)))
+ (list 'class (dns-inverse-get (dns-read-bytes 2)
+ dns-classes))
+ (list 'ttl (dns-read-bytes 4))
+ (let ((length (dns-read-bytes 2)))
+ (list 'data
+ (dns-read-type
+ (buffer-substring
+ (point)
+ (progn (forward-char length) (point)))
+ type))))
+ qs))
+ (push (list slot qs) spec)))
+ (nreverse spec))))
+
+(defun dns-read-type (string type)
+ (let ((buffer (current-buffer))
+ (point (point)))
+ (prog1
+ (mm-with-unibyte-buffer
+ (insert string)
+ (goto-char (point-min))
+ (cond
+ ((eq type 'A)
+ (let ((bytes nil))
+ (dotimes (i 4)
+ (push (dns-read-bytes 1) bytes))
+ (mapconcat 'number-to-string (nreverse bytes) ".")))
+ ((eq type 'NS)
+ (dns-read-string-name string buffer))
+ ((eq type 'CNAME)
+ (dns-read-string-name string buffer))
+ (t string)))
+ (goto-char point))))
+
+(defun dns-parse-resolv-conf ()
+ (when (file-exists-p "/etc/resolv.conf")
+ (with-temp-buffer
+ (insert-file-contents "/etc/resolv.conf")
+ (goto-char (point-min))
+ (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
+ (push (match-string 1) dns-servers))
+ (setq dns-servers (nreverse dns-servers)))))
+
+;;; Interface functions.
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'gnus-xmas)))
+
+(defmacro dns-make-network-process (server)
+ (if (featurep 'xemacs)
+ `(let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (gnus-xmas-open-network-stream "dns" (current-buffer)
+ ,server "domain" 'udp))
+ `(let ((server ,server)
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (if (fboundp 'make-network-process)
+ (make-network-process
+ :name "dns"
+ :coding 'binary
+ :buffer (current-buffer)
+ :host server
+ :service "domain"
+ :type 'datagram)
+ ;; Older versions of Emacs doesn't have
+ ;; `make-network-process', so we fall back on opening a TCP
+ ;; connection to the DNS server.
+ (open-network-stream "dns" (current-buffer) server "domain")))))
+
+(defun query-dns (name &optional type fullp)
+ "Query a DNS server for NAME of TYPE.
+If FULLP, return the entire record returned."
+ (setq type (or type 'A))
+ (unless dns-servers
+ (dns-parse-resolv-conf))
+
+ (if (not dns-servers)
+ (message "No DNS server configuration found")
+ (mm-with-unibyte-buffer
+ (let ((process (condition-case ()
+ (dns-make-network-process (car dns-servers))
+ (error
+ (message "dns: Got an error while trying to talk to %s"
+ (car dns-servers))
+ nil)))
+ (tcp-p (and (not (fboundp 'make-network-process))
+ (not (featurep 'xemacs))))
+ (step 100)
+ (times (* dns-timeout 1000))
+ (id (random 65000)))
+ (when process
+ (process-send-string
+ process
+ (dns-write `((id ,id)
+ (opcode query)
+ (queries ((,name (type ,type))))
+ (recursion-desired-p t))
+ tcp-p))
+ (while (and (zerop (buffer-size))
+ (> times 0))
+ (accept-process-output process 0 step)
+ (decf times step))
+ (ignore-errors
+ (delete-process process))
+ (when tcp-p
+ (goto-char (point-min))
+ (delete-region (point) (+ (point) 2)))
+ (unless (zerop (buffer-size))
+ (let ((result (dns-read (buffer-string))))
+ (if fullp
+ result
+ (let ((answer (car (dns-get 'answers result))))
+ (when (eq type (dns-get 'type answer))
+ (dns-get 'data answer)))))))))))
+
+(provide 'dns)
+
+;;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
+;;; dns.el ends here
diff --git a/lisp/gnus/earcon.el b/lisp/gnus/earcon.el
index 41aa66238c6..c595de0775e 100644
--- a/lisp/gnus/earcon.el
+++ b/lisp/gnus/earcon.el
@@ -1,6 +1,6 @@
-;;; earcon.el --- sound effects for messages
+;;; earcon.el --- Sound effects for messages
-;; Copyright (C) 1996, 2000, 2001 Free Software Foundation
+;; Copyright (C) 1996, 2000, 2001, 2003 Free Software Foundation
;; Author: Steven L. Baur <steve@miranova.com>
@@ -20,10 +20,8 @@
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;; This file is part of GNU Emacs.
;;; Commentary:
-
;; This file provides access to sound effects in Gnus.
;;; Code:
@@ -52,7 +50,7 @@
("evil[ \t]+laugh" 1 "Evil_Laugh.au")
("gag\\|puke" 1 "Puke.au")
("snicker" 1 "Snicker.au")
- ("meow" 1 "catmeow.au")
+ ("meow" 1 "catmeow.wav")
("sob\\|boohoo" 1 "cry.wav")
("drum[ \t]*roll" 1 "drumroll.au")
("blast" 1 "explosion.au")
@@ -80,7 +78,7 @@ call it with the value of the `earcon-data' text property."
(interactive "e")
(set-buffer (window-buffer (posn-window (event-start event))))
(let* ((pos (posn-point (event-start event)))
- (data (get-text-property pos 'earcon-data))
+ (data (get-text-property pos 'earcon-data))
(fun (get-text-property pos 'earcon-callback)))
(if fun (funcall fun data))))
diff --git a/lisp/gnus/evil.xpm b/lisp/gnus/evil.xpm
new file mode 100644
index 00000000000..c364ac34ae1
--- /dev/null
+++ b/lisp/gnus/evil.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * diabolic_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".++.+++++.++.",
+".++..+++..++.",
+".++...+...++.",
+".+++++++++++.",
+".+.+++++++.+.",
+".++.+++++.++.",
+".+++.+++.+++.",
+".++++...++++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/exit-gnus.xpm b/lisp/gnus/exit-gnus.xpm
index d910b5578c2..534f3c2fafb 100644
--- a/lisp/gnus/exit-gnus.xpm
+++ b/lisp/gnus/exit-gnus.xpm
@@ -1,76 +1,33 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 46 1",
-" c Gray0",
-". c Gray6",
-"X c #133313331333",
-"o c Gray11",
-"O c Gray12",
-"+ c Gray15",
-"@ c #2ff82ff82ff8",
-"# c Gray20",
-"$ c #399939993999",
-"% c #3fff3fff3fff",
-"& c Gray25",
-"* c Gray28",
-"= c #4ccc4ccc4ccc",
-"- c #53e353e353e3",
-"; c #565e565e565e",
-": c #5b1a5b1a5b1a",
-"> c #5ff55ff55ff5",
-", c #626262626262",
-"< c Gray40",
-"1 c #67e767e767e7",
-"2 c Gray42",
-"3 c #6ff96ff96ff9",
-"4 c Gray45",
-"5 c #77d777d777d7",
-"6 c #7ccc7ccc7ccc",
-"7 c Gray50",
-"8 c Gray56",
-"9 c #97f797f797f7",
-"0 c Gray60",
-"q c #9bd19bd19bd1",
-"w c #9ff29ff29ff2",
-"e c #a7cba7cba7cb",
-"r c Gray67",
-"t c #afd5afd5afd5",
-"y c Gray70",
-"u c Gray75",
-"i c #c3c3c3c3c3c3",
-"p c Gray78",
-"a c #cbcbcbcbcbcb",
-"s c Gray81",
-"d c #d7d8d7d8d7d8",
-"f c #dff2dff2dff2",
-"g c Gray89",
-"h c #e7e7e7e7e7e7",
-"j c #eff8eff8eff8",
-"k c Gray100",
-/* pixels */
-"kkkkkkkkkufkkkku7skkkkkk",
-"kkkkkkkkw>%fkkw 7kkkkkkk",
-"kk3%wkkksu ukk%u7skkkkkk",
-"kww>>@@uu3f@8 @@7.@Owskk",
-"kkwf777%>77O> >>%7777wkk",
-"kkkkkss7j8O.@ 8jujsfjkkk",
-"kkkjuuwO @> @>@@ujkkkkkk",
-"kkk>%O77O$ > %f >kkkkkk",
-"kkk87sj7<=u>@7s8>@%wkkkk",
-"kkkkkkq==u>>u ukk3u7kkkk",
-"7uwfuw+=>u u> >fuw7uwwuf",
-"8twut#>:8q q8* uprwswwtu",
-"ipuge&,5uq5uau-@uuuuuadu",
-"psuu>4@uuuuuduu5uuduuuuu",
-"uugu>4@uuguuuuuuuuauuuuu",
-"uuuy:>-uuuuuuugguaaugguu",
-"psu8=+uuuuspuuuuudduuuuu",
-"ipu8=+uuujfhguuuuuudauuu",
-"ue82=+8euuuuishspujdgguu",
-"e@$$+X=;>uu5ttp9sduuuuuu",
-"&4$8$ 7=4@@5y>qejdjduuuu",
-";$4O4444444O@eye5@uuusfd",
-">>>>3<>@*<3>@wp9f7uuufsd",
-"uuujfhgedhfjqpswsiuuuuuu"
-};
+static char * exit_gnus_xpm[] = {
+"24 24 6 1",
+" c None",
+". c #8686ADAD7D7D",
+"X c #919187876969",
+"o c #C2C2B9B99C9C",
+"O c #A8A8F0F0ECEC",
+"+ c #EFEFEFEFEFEF",
+" ",
+" .... . ",
+" .. .. . ",
+" ............. ",
+" . . . .... ",
+" ............. ",
+" .............. .. ",
+" . . .......... . ",
+" .XXXX... .. ",
+" o.XXX. . .. ",
+" oo.X. .. ... ",
+" ooX. . ... ",
+" oXo. .. ",
+" ooX . . ",
+" ooX ",
+"OOOOoXXOOOOOOOOOOOOOOOOO",
+"OOOoXoXOOOOOOOOOOOOOOOOO",
+"OOOooXXOOOO+OOOOOOOOOOOO",
+"O+OoooXOO+OOO+OO+OOO+OOO",
+"OXXoXoXoXOO++O++OO++OO+O",
+"XXXXXXXXXXXX+OOOOOOOOOOO",
+"XXXXXXXXXXXXXX+O++OO++OO",
+"XXXXXXXXXXXXXXXXOOOOOOOO",
+"O++O++++O+OO++OOOO++OOO+"};
diff --git a/lisp/gnus/exit-summ.xpm b/lisp/gnus/exit-summ.xpm
index 00caf5331bd..5234ccb11ec 100644
--- a/lisp/gnus/exit-summ.xpm
+++ b/lisp/gnus/exit-summ.xpm
@@ -1,45 +1,30 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 15 1",
-" c Gray0",
-". c #0bfb0bfb0bfb",
-"X c Gray9",
-"o c #23f323f323f3",
-"O c #2fef2fef2fef",
-"+ c Gray28",
-"@ c #53e353e353e3",
-"# c #5fdf5fdf5fdf",
-"$ c Gray42",
-"% c #77d777d777d7",
-"& c Gray56",
-"* c #9bcb9bcb9bcb",
-"= c #a7c7a7c7a7c7",
-"- c Gray70",
-"; c Gray75",
-/* pixels */
-"@;;@;;@;;@;;@;;@;;@;;@;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-"@;;@;;&=@OOOo O;;@;;",
-";;;;;;X&;;;;=## O;;;;;",
-";;;;;;.%;;;;;;; O;;;;;",
-"@;;@;;@;;@;;*;; O;;@;;",
-";;;;;;;;;;;;%;; O;;;;;",
-";;;;;;O%;;;;;;; O;;;;;",
-"@;;@;;o=;@;;-&- O;;@;;",
-";;;;;;X&;;;;+ & O;;;;;",
-";;;;;;.%;;;;$ & O;;;;;",
-"@;;@;;o=;@;;;;; O;;@;;",
-";;;;;;X&;;;;;;; O;;;;;",
-";;;;;;*;;;;;@;; O;;;;;",
-"@;;@;;&=;@;;;;; O;;@;;",
-";;;;;; #;;;;;&#XO+O;;;;;",
-";;;;;;o=;*OO*#o%#+*;;;;;",
-"@;;@;@;%OOOO@%*@%*@;;@;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-"@;;@;;@;;@;;@;;@;;@;;@;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;"
-};
+static char * exit_summ_xpm[] = {
+"24 24 3 1",
+". c None",
+" c #000000000000",
+"X c #E1E1E0E0E0E0",
+" .. .. .. .. .. .. .. ..",
+"........................",
+"........................",
+" .. .. .. ..",
+"...... XXXX .....",
+"...... XXXXXXX .....",
+" .. .. XX XX XX .. ..",
+"...... XXXXXXXX .....",
+"...... XXXXXXX .....",
+" .. .. X XX .. ..",
+"...... XXXX .....",
+"...... XXXX .....",
+" .. .. X XXXXX .. ..",
+"...... XXXXXXX .....",
+"...... XXXXX XX .....",
+" .. .. X XXXXX .. ..",
+"...... XXXXX .....",
+"...... X .....",
+" .. . . .. ..",
+"........................",
+"........................",
+" .. .. .. .. .. .. .. ..",
+"........................",
+"........................"};
diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el
index 2d2e3e1c44d..c3602cc9b44 100644
--- a/lisp/gnus/flow-fill.el
+++ b/lisp/gnus/flow-fill.el
@@ -1,6 +1,6 @@
;;; flow-fill.el --- interprete RFC2646 "flowed" text
-;; Copyright (C) 2000, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
@@ -35,10 +35,10 @@
;; paragraph and we let `fill-region' fill the long line into several
;; lines with the quote prefix as `fill-prefix'.
-;; Todo: encoding, implement basic `fill-region' (Emacs and XEmacs
+;; Todo: implement basic `fill-region' (Emacs and XEmacs
;; implementations differ..)
-;; History:
+;;; History:
;; 2000-02-17 posted on ding mailing list
;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs
@@ -46,11 +46,30 @@
;; 2000-03-26 committed to gnus cvs
;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule
;; work when first line is at level 0.
+;; 2002-01-12 probably incomplete encoding support
+;; 2003-12-08 started working on test harness.
;;; Code:
(eval-when-compile (require 'cl))
+(defcustom fill-flowed-display-column 'fill-column
+ "Column beyond which format=flowed lines are wrapped, when displayed.
+This can be a Lisp expression or an integer."
+ :type '(choice (const :tag "Standard `fill-column'" fill-column)
+ (const :tag "Fit Window" (- (window-width) 5))
+ (sexp)
+ (integer)))
+
+(defcustom fill-flowed-encode-column 66
+ "Column beyond which format=flowed lines are wrapped, in outgoing messages.
+This can be a Lisp expression or an integer.
+RFC 2646 suggests 66 characters for readability."
+ :type '(choice (const :tag "Standard fill-column" fill-column)
+ (const :tag "RFC 2646 default (66)" 66)
+ (sexp)
+ (integer)))
+
(eval-and-compile
(defalias 'fill-flowed-point-at-bol
(if (fboundp 'point-at-bol)
@@ -62,6 +81,29 @@
'point-at-eol
'line-end-position)))
+;;;###autoload
+(defun fill-flowed-encode (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ ;; No point in doing this unless hard newlines is used.
+ (when use-hard-newlines
+ (let ((start (point-min)) end)
+ ;; Go through each paragraph, filling it and adding SPC
+ ;; as the last character on each line.
+ (while (setq end (text-property-any start (point-max) 'hard 't))
+ (let ((fill-column (eval fill-flowed-encode-column)))
+ (fill-region start end t 'nosqueeze 'to-eop))
+ (goto-char start)
+ ;; `fill-region' probably distorted end.
+ (setq end (text-property-any start (point-max) 'hard 't))
+ (while (and (< (point) end)
+ (re-search-forward "$" (1- end) t))
+ (insert " ")
+ (setq end (1+ end))
+ (forward-char))
+ (goto-char (setq start (1+ end)))))
+ t)))
+
+;;;###autoload
(defun fill-flowed (&optional buffer)
(save-excursion
(set-buffer (or (current-buffer) buffer))
@@ -70,7 +112,8 @@
(when (save-excursion
(beginning-of-line)
(looking-at "^\\(>*\\)\\( ?\\)"))
- (let ((quote (match-string 1)) sig)
+ (let ((quote (match-string 1))
+ sig)
(if (string= quote "")
(setq quote nil))
(when (and quote (string= (match-string 2) ""))
@@ -79,6 +122,7 @@
(beginning-of-line)
(when (> (skip-chars-forward ">") 0)
(insert " "))))
+ ;; XXX slightly buggy handling of "-- "
(while (and (save-excursion
(ignore-errors (backward-char 3))
(setq sig (looking-at "-- "))
@@ -86,17 +130,90 @@
(save-excursion
(unless (eobp)
(forward-char 1)
- (looking-at (format "^\\(%s\\)\\([^>]\\)" (or quote " ?"))))))
+ (looking-at (format "^\\(%s\\)\\([^>\n\r]\\)"
+ (or quote " ?"))))))
(save-excursion
(replace-match (if (string= (match-string 2) " ")
"" "\\2")))
(backward-delete-char -1)
(end-of-line))
(unless sig
- (let ((fill-prefix (when quote (concat quote " "))))
- (fill-region (fill-flowed-point-at-bol)
- (fill-flowed-point-at-eol)
- 'left 'nosqueeze))))))))
+ (condition-case nil
+ (let ((fill-prefix (when quote (concat quote " ")))
+ (fill-column (eval fill-flowed-display-column))
+ filladapt-mode)
+ (fill-region (fill-flowed-point-at-bol)
+ (min (1+ (fill-flowed-point-at-eol))
+ (point-max))
+ 'left 'nosqueeze))
+ (error
+ (forward-line 1)
+ nil))))))))
+
+;; Test vectors.
+
+(eval-when-compile
+ (defvar show-trailing-whitespace))
+
+(defvar fill-flowed-encode-tests
+ '(
+ ;; The syntax of each list element is:
+ ;; (INPUT . EXPECTED-OUTPUT)
+ ("> Thou villainous ill-breeding spongy dizzy-eyed
+> reeky elf-skinned pigeon-egg!
+>> Thou artless swag-bellied milk-livered
+>> dismal-dreaming idle-headed scut!
+>>> Thou errant folly-fallen spleeny reeling-ripe
+>>> unmuzzled ratsbane!
+>>>> Henceforth, the coding style is to be strictly
+>>>> enforced, including the use of only upper case.
+>>>>> I've noticed a lack of adherence to the coding
+>>>>> styles, of late.
+>>>>>> Any complaints?
+" . "> Thou villainous ill-breeding spongy dizzy-eyed reeky elf-skinned
+> pigeon-egg!
+>> Thou artless swag-bellied milk-livered dismal-dreaming idle-headed
+>> scut!
+>>> Thou errant folly-fallen spleeny reeling-ripe unmuzzled ratsbane!
+>>>> Henceforth, the coding style is to be strictly enforced,
+>>>> including the use of only upper case.
+>>>>> I've noticed a lack of adherence to the coding styles, of late.
+>>>>>> Any complaints?
+")
+; ("
+;> foo
+;>
+;>
+;> bar
+;" . "
+;> foo bar
+;")
+ ))
+
+(defun fill-flowed-test ()
+ (interactive "")
+ (switch-to-buffer (get-buffer-create "*Format=Flowed test output*"))
+ (erase-buffer)
+ (setq show-trailing-whitespace t)
+ (dolist (test fill-flowed-encode-tests)
+ (let (start output)
+ (insert "***** BEGIN TEST INPUT *****\n")
+ (insert (car test))
+ (insert "***** END TEST INPUT *****\n\n")
+ (insert "***** BEGIN TEST OUTPUT *****\n")
+ (setq start (point))
+ (insert (car test))
+ (save-restriction
+ (narrow-to-region start (point))
+ (fill-flowed))
+ (setq output (buffer-substring start (point-max)))
+ (insert "***** END TEST OUTPUT *****\n")
+ (unless (string= output (cdr test))
+ (insert "\n***** BEGIN TEST EXPECTED OUTPUT *****\n")
+ (insert (cdr test))
+ (insert "***** END TEST EXPECTED OUTPUT *****\n"))
+ (insert "\n\n")))
+ (goto-char (point-max)))
(provide 'flow-fill)
diff --git a/lisp/gnus/followup.xpm b/lisp/gnus/followup.xpm
index c7cd85a0f74..444895a4399 100644
--- a/lisp/gnus/followup.xpm
+++ b/lisp/gnus/followup.xpm
@@ -1,54 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 24 1",
-" c Gray0",
-". c Gray6",
-"X c Gray9",
-"o c Gray12",
-"O c #2ff22ff22ff2",
-"+ c #3fff3fff3fff",
-"@ c Gray28",
-"# c #53ed53ed53ed",
-"$ c #5fee5fee5fee",
-"% c #67e767e767e7",
-"& c #6fff6fff6fff",
-"* c #77f077f077f0",
-"= c #7bdb7bdb7bdb",
-"- c Gray50",
-"; c Gray56",
-": c #9bd79bd79bd7",
-"> c #9fff9fff9fff",
-", c #a7c7a7c7a7c7",
-"< c Gray70",
-"1 c Gray75",
-"2 c Gray81",
-"3 c #dfffdfffdfff",
-"4 c #efffefffefff",
-"5 c Gray100",
-/* pixels */
-"<,1<,1<,1<,1<,1<,1<,1<,1",
-",;1,;1,;1,;1,;1,;1,;1,;1",
-"111111111111111111111111",
-"<,1<,1<,1<,:=+.<,1<,1<,1",
-",;1,;1,;1;O*>5+$;1,;1,;1",
-"11111111##142+>O11111111",
-"<,1<,:=+2555 o2#,1<,1<,1",
-",;1;O*>5555>-151$1,;1,;1",
-"111<@15555525554*:111111",
-"<,1<$:5555555555>=<,1<,1",
-",;1,;*>553--55555+,;1,;1",
-"111111=>&$1O555552#11111",
-"<,111:=+241$+55555#,1<,1",
-",;1,$*>55$ 1+555551$1,;1",
-"11##14555 $4>>55554*:111",
-"<@155555&5551-55555>=<,1",
-",O15555555553-355551o,;1",
-"1,#55555555553$555+%;111",
-"<,#25555555555&1*O<,1<,1",
-",;1+55555555555X;1,;1,;1",
-"111=>5555555555:*1111111",
-"<,1:*45555555552%<<,1<,1",
-",;11$15555555555-;,;1,;1",
-"1111,#55555555553#111111"
-};
+static char * followup_xpm[] = {
+"24 24 4 1",
+" c None",
+". c #A5A5A5A59595",
+"X c #C7C7C6C6C6C6",
+"o c #E1E1E0E0E0E0",
+" ",
+" . ",
+" ..X. ",
+" ..XXX. ",
+" ..XXXXXo. ",
+" ...XXXXXXooo. . ",
+" .o.XXXXXooooo..X. ",
+" .oo.XXXoooo..XXX. ",
+" .oo..Xooo..XXXXXo. ",
+" .oo.XX...XXXXXXooo. ",
+" .o.Xoo.o.XXXXXoooo. ",
+" .XXoo.oo.XXXoooooo. ",
+" .Xooo.oo..XXooooooo. ",
+" .ooo.oo.XXooooooooo. ",
+" .ooo.o.XoooooooooooX.",
+" .ooo.XXoooooooooooo.",
+" .ooo.Xoooooooooooo. ",
+" .ooo.ooooooooooo. ",
+" .oo..oooooooooo. ",
+" .. .ooooooo.. ",
+" .oooooo. ",
+" .ooo.. ",
+" .oo. ",
+" .. "};
diff --git a/lisp/gnus/forced.xpm b/lisp/gnus/forced.xpm
new file mode 100644
index 00000000000..43ba8d2b502
--- /dev/null
+++ b/lisp/gnus/forced.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * forced_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++..+++..++.",
+".++..+++..++.",
+".+++++++++++.",
+".+++++++++++.",
+".+.+++++++.+.",
+".+.+++++++.+.",
+".+.........+.",
+".+++++++++++.",
+" ...+++++... ",
+" ....... "};
diff --git a/lisp/gnus/frown.xpm b/lisp/gnus/frown.xpm
new file mode 100644
index 00000000000..25ca99d11a2
--- /dev/null
+++ b/lisp/gnus/frown.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * frown_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".++..+++..++.",
+".++++.+.++++.",
+".+...+++...+.",
+".+...+++...+.",
+".+++++++++++.",
+".+++.....+++.",
+".++.+++++.++.",
+".++.+++++.++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/fuwo.xpm b/lisp/gnus/fuwo.xpm
index e860d9511bf..362cbc5725a 100644
--- a/lisp/gnus/fuwo.xpm
+++ b/lisp/gnus/fuwo.xpm
@@ -1,53 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 23 1",
-" c Gray0",
-". c Gray6",
-"X c Gray9",
-"o c Gray12",
-"O c #2fef2fef2fef",
-"+ c #3fff3fff3fff",
-"@ c #53ee53ee53ee",
-"# c #5fe85fe85fe8",
-"$ c #67e767e767e7",
-"% c #6fff6fff6fff",
-"& c #77ea77ea77ea",
-"* c #7bdb7bdb7bdb",
-"= c Gray50",
-"- c Gray56",
-"; c #9bd69bd69bd6",
-": c #9fff9fff9fff",
-"> c #a7c7a7c7a7c7",
-", c Gray70",
-"< c Gray75",
-"1 c Gray81",
-"2 c #dfffdfffdfff",
-"3 c #efffefffefff",
-"4 c Gray100",
-/* pixels */
-",><,><,><,><,><,><,><,><",
-">-<>-<>-<>-<>-<>-<>-<>-<",
-"<<<<<<<<<<<<<<<<<<<<<<<<",
-",><,><,><,><,><,><,><,><",
-">-<>-<>-<>-<>-<>-<>-<>-<",
-"<<<<<<<<<<<<;O;<<<<<<<<<",
-",><,><,><,>< X;,><,><,><",
-">-<>-<>-<>-&#-<>-<>-<>-<",
-"<<<<<<<<<<<;<<<<<<<<<<<<",
-",><,><,><,><,><,><,><,><",
-">-<>-<>-<-O>>-<>-<>-<>-<",
-"<<<<<<<<@@<@<<<<<<<<<<<<",
-",><<<;*+1<<#;<<,><,><,><",
-">-<>#&:<==+#&-<>-<>-<>-<",
-"<<@@<3+=<1o <#<<<<<<<<<<",
-",>O<=+444:+.4=-,><,><,><",
-">-O=<4444:4::<$>-<>-<>-<",
-"<&;444444444+4+<<<<<<<<<",
-",#;444444444<=4O<<,><,><",
-">-O4444444442=2&-<>-<>-<",
-"<<;%444444444=<<#<<<<<<<",
-",><@2444444444+4=-,><,><",
-">-<-=444444444::<$>-<>-<",
-"<<<,$1444444444+4+<<<<<<"
-};
+static char * fuwo_xpm[] = {
+"24 24 4 1",
+" c None",
+". c #A5A5A5A59595",
+"X c #C7C7C6C6C6C6",
+"o c #E1E1E0E0E0E0",
+" ",
+" . ",
+" .. . ",
+" .. . ",
+" .. . ",
+" ... . . ",
+" . . ..X. ",
+" . . ..XXX. ",
+" . .. ..XXXXXo. ",
+" . . ...XXXXXXooo. ",
+" . .X .o.XXXXXoooo. ",
+" .XX .oo.XXXoooooo. ",
+" .X .oo..XXooooooo. ",
+" . .oo.XXooooooooo. ",
+" . .o.XoooooooooooX.",
+" . .XXoooooooooooo.",
+" . .Xoooooooooooo. ",
+" . .ooooooooooo. ",
+" . ..oooooooooo. ",
+" .. .ooooooo.. ",
+" .oooooo. ",
+" .ooo.. ",
+" .oo. ",
+" .. "};
diff --git a/lisp/gnus/get-news.xpm b/lisp/gnus/get-news.xpm
index b9ad760d5de..d7e7b4a3553 100644
--- a/lisp/gnus/get-news.xpm
+++ b/lisp/gnus/get-news.xpm
@@ -1,68 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 38 1",
-" c Gray0",
-". c #0bfb0bfb0bfb",
-"X c Gray6",
-"o c #133313331333",
-"O c Gray9",
-"+ c Gray11",
-"@ c Gray12",
-"# c #23f323f323f3",
-"$ c Gray15",
-"% c #2ff32ff32ff3",
-"& c #399939993999",
-"* c #3fff3fff3fff",
-"= c Gray25",
-"- c #433243324332",
-"; c Gray28",
-": c #4ccc4ccc4ccc",
-"> c #519151915191",
-", c #53e753e753e7",
-"< c #565a565a565a",
-"1 c Gray35",
-"2 c #5b1a5b1a5b1a",
-"3 c #5fe55fe55fe5",
-"4 c Gray45",
-"5 c Gray46",
-"6 c #77d777d777d7",
-"7 c #7ccc7ccc7ccc",
-"8 c Gray50",
-"9 c #866586658665",
-"0 c Gray56",
-"q c Gray60",
-"w c #9bcb9bcb9bcb",
-"e c #9fff9fff9fff",
-"r c #a7c7a7c7a7c7",
-"t c Gray70",
-"y c Gray75",
-"u c Gray81",
-"i c #dfffdfffdfff",
-"p c Gray100",
-/* pixels */
-"0000000ryyyyyyyyyyyyyyyy",
-"@8888833yyyyyyyyyyyyyyyy",
-"*pppppy3yyyyyyyyyyyyyyyy",
-"*pppppy3yyyyyr=$$6yyyyyy",
-"*ppppp3%3yyyr<9qq36yyyyy",
-"*ppppp ;0>yy0:qqqq%yyyyy",
-"*pppppy @82tq>0qq8>yyyyy",
-"*pppppy%>q42y0>q42yyyyyy",
-"*pppppy3q=q8%%.=:#%6yyyy",
-"%yyyyy03y0:qqqqqqqq:0yyy",
-"33333330yr<9qqqqqqq42yyy",
-"yyyyyyyyyyr=qqqqqqqq$yyy",
-"yyyyyyyyyyyy$:%***$q$**X",
-"yyyyyyyyyyyy$:yppe3q$pp*",
-"yyyyyyyyyyyy$:ypp*q3qpp*",
-"yyyyyyyyyyyy$:yp8402upp*",
-"yyyyyyyyyyyyo$yi*&48ppp*",
-"yyyyyyyyyyy>4&u>00:ippp*",
-"yyyyyyyyyyy%q:00Oq%yyyy%",
-"yyyyyyyyyyy%q4:o<3&%3333",
-"yyyyyyyyyyy%qqq$9443yyyy",
-"yyyyyyyyyyy%44@0&4<3yyyy",
-"yyyyyyyyyyy6o$;r%&O0yyyy",
-"yyyyyyyyyyyy$:0y34%yyyyy"
-};
+static char * get_news_xpm[] = {
+"24 24 4 1",
+". c None",
+"X c #A5A5A5A59595",
+"o c #E1E1E0E0E0E0",
+"O c #C7C7C6C6C6C6",
+"........................",
+"........................",
+"........................",
+".....XXX................",
+"...XXoooXXXXX...........",
+"XXXoooooXXoooX.XXX......",
+"XoXooXXXooooXXXoooX.....",
+"XooXoXoXooXXXoooooX.....",
+"XooXXXooXoXoXooooooX....",
+"XooXOXooXXXooXooooooX...",
+"XoXOOXooXOXooXXooooooX..",
+"OXOOOXoXOOXooXoooooooX..",
+"OXOooOXOOOXoXOooooooooX.",
+".OXooOXOooOXOOooooooooX.",
+".OXoooOXooOXOooooooooooX",
+"..OXooOXoooOXooooooooooX",
+"..OXooOOXooOXooooooooooX",
+"...OXooOXoooOXoooooooXXX",
+"...OXooXOXooOXooooooXOO.",
+"....OXXOOXooXOXoooXXO...",
+".....OO..OXXOOXooXOO....",
+"..........OO..OXXO......",
+"...............OO.......",
+"........................"};
diff --git a/lisp/gnus/gnntg.xpm b/lisp/gnus/gnntg.xpm
index ea2a72336cf..21bc5f16eb2 100644
--- a/lisp/gnus/gnntg.xpm
+++ b/lisp/gnus/gnntg.xpm
@@ -1,64 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 34 1",
-" c Gray0",
-". c #099909990999",
-"X c #0bfb0bfb0bfb",
-"o c #133313331333",
-"O c Gray9",
-"+ c Gray11",
-"@ c #23f323f323f3",
-"# c Gray15",
-"$ c #2fef2fef2fef",
-"% c #399939993999",
-"& c #3fff3fff3fff",
-"* c Gray25",
-"= c #433243324332",
-"- c Gray28",
-"; c #4ccc4ccc4ccc",
-": c #519151915191",
-"> c #566656665666",
-", c #5fed5fed5fed",
-"< c #626262626262",
-"1 c Gray42",
-"2 c Gray45",
-"3 c Gray46",
-"4 c #77d777d777d7",
-"5 c #7ccc7ccc7ccc",
-"6 c Gray50",
-"7 c #866586658665",
-"8 c Gray56",
-"9 c Gray60",
-"0 c #9bcb9bcb9bcb",
-"q c #a7c7a7c7a7c7",
-"w c Gray70",
-"e c Gray75",
-"r c #dfffdfffdfff",
-"t c Gray100",
-/* pixels */
-"w8888888weeeeeeeeeeeeeee",
-"8&66666&8eeeeeeeeeeeeeee",
-"86ttttt68eeeeeeeeeeeeeee",
-"86ttttt68eeeee0###0eeeee",
-"86ttttr&-4eee8:000:8eeee",
-"86tttte 144ee,20002,eeee",
-"86ttttt6 =,4e4<000<4eeee",
-"86ttttt6-,0,4e4,0,4eeeee",
-"86ttttt684,0<$$.,#$$0eee",
-"8,eeeee,8e,200000000#eee",
-"q,,,,,,,qe8:00000000,4ee",
-"eeeeeeeeeee0=000006,0$ee",
-"eeeeeeeeeeee8;00002;0$ee",
-"eeeeeeeeeeee8;00002;0$ee",
-"eeeeeeeeeeee8;00002;0$ee",
-"eeeeeeeeeeee8;00002;0$ee",
-"eeeeeeeeeeee8#;;;;%#;$ee",
-"eeeeeeeeeeee=2222+88@0ee",
-"eeeeeeeeeeee#00000.4$eee",
-"eeeeeeeeeeee#00720O,,eee",
-"eeeeeeeeeeee#002;02%8eee",
-"eeeeeeeeeeee+22$,>2%8eee",
-"eeeeeeeeeeee-#o48O%$qeee",
-"eeeeeeeeeeee8;#ee$2,eeee"
-};
+static char * gnntg_xpm[] = {
+"24 24 4 1",
+" c None",
+". c #000000000000",
+"X c #FFFFFFFFFFFF",
+"o c #C7C7C6C6C6C6",
+" ",
+" ....... ",
+" .XXXXX. ",
+" .XXXXX. ... ",
+" .XXXXX... .ooo. ",
+" .XXXXX.... ..ooo.. ",
+" .XXXXX..o.. ..ooo.. ",
+" .XXXXX...o.. ..o.. ",
+" .XXXXX. ..o........ ",
+" .XXXXX. ..oooooooo. ",
+" ....... .oooooooo.. ",
+" .ooooo..o. ",
+" .oooo..o. ",
+" .oooo..o. ",
+" .oooo..o. ",
+" .oooo..o. ",
+" ......... ",
+" ......oo. ",
+" .ooooo... ",
+" .oo..o... ",
+" .oo..o.. ",
+" ........ ",
+" .... ... ",
+" ... ... "};
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 1ecade30b5f..2ab1fb0421d 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1,5 +1,6 @@
;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -25,15 +26,23 @@
(require 'gnus)
(require 'gnus-cache)
+(require 'nnmail)
(require 'nnvirtual)
(require 'gnus-sum)
(require 'gnus-score)
+(require 'gnus-srvr)
+(require 'gnus-util)
(eval-when-compile
(if (featurep 'xemacs)
(require 'itimer)
(require 'timer))
(require 'cl))
+(eval-and-compile
+ (autoload 'gnus-server-update-server "gnus-srvr")
+ (autoload 'gnus-agent-customize-category "gnus-cus")
+)
+
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
:group 'gnus-agent
@@ -49,15 +58,21 @@
:group 'gnus-agent
:type 'hook)
+(defcustom gnus-agent-fetched-hook nil
+ "Hook run when finished fetching articles."
+ :group 'gnus-agent
+ :type 'hook)
+
(defcustom gnus-agent-handle-level gnus-level-subscribed
"Groups on levels higher than this variable will be ignored by the Agent."
:group 'gnus-agent
:type 'integer)
(defcustom gnus-agent-expire-days 7
- "Read articles older than this will be expired."
+ "Read articles older than this will be expired.
+If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
:group 'gnus-agent
- :type 'integer)
+ :type '(number :tag "days"))
(defcustom gnus-agent-expire-all nil
"If non-nil, also expire unread, ticked and dormant articles.
@@ -70,16 +85,28 @@ If nil, only read articles will be expired."
:group 'gnus-agent
:type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+ (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
+
(defcustom gnus-agent-summary-mode-hook nil
"Hook run in Agent summary minor modes."
:group 'gnus-agent
:type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+ (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
+
(defcustom gnus-agent-server-mode-hook nil
"Hook run in Agent summary minor modes."
:group 'gnus-agent
:type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+ (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
+
(defcustom gnus-agent-confirmation-function 'y-or-n-p
"Function to confirm when error happens."
:version "21.1"
@@ -95,13 +122,103 @@ If this is `ask' the hook will query the user."
(const :tag "Ask" ask))
:group 'gnus-agent)
+(defcustom gnus-agent-go-online 'ask
+ "Indicate if offline servers go online when you plug in.
+If this is `ask' the hook will query the user."
+ :version "21.1"
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-mark-unread-after-downloaded t
+ "Indicate whether to mark articles unread after downloaded."
+ :version "21.1"
+ :type 'boolean
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-download-marks '(download)
+ "Marks for downloading."
+ :version "21.1"
+ :type '(repeat (symbol :tag "Mark"))
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-consider-all-articles nil
+ "When non-nil, the agent will let the agent predicate decide
+whether articles need to be downloaded or not, for all articles. When
+nil, the default, the agent will only let the predicate decide
+whether unread articles are downloaded or not. If you enable this,
+groups with large active ranges may open slower and you may also want
+to look into the agent expiry settings to block the expiration of
+read articles as they would just be downloaded again."
+ :version "21.4"
+ :type 'boolean
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
+ "Chunk size for `gnus-agent-fetch-session'.
+The function will split its article fetches into chunks smaller than
+this limit."
+ :group 'gnus-agent
+ :type 'integer)
+
+(defcustom gnus-agent-enable-expiration 'ENABLE
+ "The default expiration state for each group.
+When set to ENABLE, the default, `gnus-agent-expire' will expire old
+contents from a group's local storage. This value may be overridden
+to disable expiration in specific categories, topics, and groups. Of
+course, you could change gnus-agent-enable-expiration to DISABLE then
+enable expiration per categories, topics, and groups."
+ :group 'gnus-agent
+ :type '(radio (const :format "Enable " ENABLE)
+ (const :format "Disable " DISABLE)))
+
+(defcustom gnus-agent-expire-unagentized-dirs t
+ "*Whether expiration should expire in unagentized directories.
+Have gnus-agent-expire scan the directories under
+\(gnus-agent-directory) for groups that are no longer agentized.
+When found, offer to remove them."
+ :type 'boolean
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
+ "Initially, all servers from these methods are agentized.
+The user may remove or add servers using the Server buffer.
+See Info node `(gnus)Server Buffer'."
+ :type '(repeat symbol)
+ :group 'gnus-agent)
+
+(defcustom gnus-agent-queue-mail t
+ "Whether and when outgoing mail should be queued by the agent.
+When `always', always queue outgoing mail. When nil, never
+queue. Otherwise, queue if and only if unplugged."
+ :group 'gnus-agent
+ :type '(radio (const :format "Always" always)
+ (const :format "Never" nil)
+ (const :format "When plugged" t)))
+
+(defcustom gnus-agent-prompt-send-queue nil
+ "If non-nil, `gnus-group-send-queue' will prompt if called when
+unplugged."
+ :group 'gnus-agent
+ :type 'boolean)
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
(defvar gnus-agent-buffer-alist nil)
-(defvar gnus-agent-article-alist nil)
+(defvar gnus-agent-article-alist nil
+ "An assoc list identifying the articles whose headers have been fetched.
+If successfully fetched, these headers will be stored in the group's overview
+file. The key of each assoc pair is the article ID, the value of each assoc
+pair is a flag indicating whether the identified article has been downloaded
+\(gnus-agent-fetch-articles sets the value to the day of the download).
+NOTES:
+1) The last element of this list can not be expired as some
+ routines (for example, get-agent-fetch-headers) use the last
+ value to track which articles have had their headers retrieved.
+2) The function `gnus-agent-regenerate' may destructively modify the value.")
(defvar gnus-agent-group-alist nil)
-(defvar gnus-agent-covered-methods nil)
(defvar gnus-category-alist nil)
(defvar gnus-agent-current-history nil)
(defvar gnus-agent-overview-buffer nil)
@@ -111,6 +228,7 @@ If this is `ask' the hook will query the user."
(defvar gnus-agent-file-name nil)
(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
+(defvar gnus-agent-file-loading-cache nil)
;; Dynamic variables
(defvar gnus-headers)
@@ -141,8 +259,7 @@ If this is `ask' the hook will query the user."
(gnus-add-shutdown 'gnus-close-agent 'gnus)
(defun gnus-close-agent ()
- (setq gnus-agent-covered-methods nil
- gnus-category-predicate-cache nil
+ (setq gnus-category-predicate-cache nil
gnus-category-group-cache nil
gnus-agent-spam-hashtb nil)
(gnus-kill-buffer gnus-agent-overview-buffer))
@@ -176,18 +293,120 @@ If this is `ask' the hook will query the user."
(file-name-as-directory
(expand-file-name "agent.lib" (gnus-agent-directory)))))
+(defun gnus-agent-cat-set-property (category property value)
+ (if value
+ (setcdr (or (assq property category)
+ (let ((cell (cons property nil)))
+ (setcdr category (cons cell (cdr category)))
+ cell)) value)
+ (let ((category category))
+ (while (cond ((eq property (caadr category))
+ (setcdr category (cddr category))
+ nil)
+ (t
+ (setq category (cdr category)))))))
+ category)
+
+(eval-when-compile
+ (defmacro gnus-agent-cat-defaccessor (name prop-name)
+ "Define accessor and setter methods for manipulating a list of the form
+\(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
+Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
+manipulated as follows:
+ (func LIST): Returns VALUE1
+ (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
+ `(progn (defmacro ,name (category)
+ (list (quote cdr) (list (quote assq)
+ (quote (quote ,prop-name)) category)))
+
+ (define-setf-method ,name (category)
+ (let* ((--category--temp-- (make-symbol "--category--"))
+ (--value--temp-- (make-symbol "--value--")))
+ (list (list --category--temp--) ; temporary-variables
+ (list category) ; value-forms
+ (list --value--temp--) ; store-variables
+ (let* ((category --category--temp--) ; store-form
+ (value --value--temp--))
+ (list (quote gnus-agent-cat-set-property)
+ category
+ (quote (quote ,prop-name))
+ value))
+ (list (quote ,name) --category--temp--) ; access-form
+ )))))
+ )
+
+(defmacro gnus-agent-cat-name (category)
+ `(car ,category))
+
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-days-until-old agent-days-until-old)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-enable-expiration agent-enable-expiration)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-groups agent-groups)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-high-score agent-high-score)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-length-when-long agent-length-when-long)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-length-when-short agent-length-when-short)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-low-score agent-low-score)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-predicate agent-predicate)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-score-file agent-score-file)
+(gnus-agent-cat-defaccessor
+ gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
+
+(eval-and-compile
+ (defsetf gnus-agent-cat-groups (category) (groups)
+ (list 'gnus-agent-set-cat-groups category groups)))
+
+(defun gnus-agent-set-cat-groups (category groups)
+ (unless (eq groups 'ignore)
+ (let ((new-g groups)
+ (old-g (gnus-agent-cat-groups category)))
+ (cond ((eq new-g old-g)
+ ;; gnus-agent-add-group is fiddling with the group
+ ;; list. Still, Im done.
+ nil
+ )
+ ((eq new-g (cdr old-g))
+ ;; gnus-agent-add-group is fiddling with the group list
+ (setcdr (or (assq 'agent-groups category)
+ (let ((cell (cons 'agent-groups nil)))
+ (setcdr category (cons cell (cdr category)))
+ cell)) new-g))
+ (t
+ (let ((groups groups))
+ (while groups
+ (let* ((group (pop groups))
+ (old-category (gnus-group-category group)))
+ (if (eq category old-category)
+ nil
+ (setf (gnus-agent-cat-groups old-category)
+ (delete group (gnus-agent-cat-groups
+ old-category))))))
+ ;; Purge cache as preceeding loop invalidated it.
+ (setq gnus-category-group-cache nil))
+
+ (setcdr (or (assq 'agent-groups category)
+ (let ((cell (cons 'agent-groups nil)))
+ (setcdr category (cons cell (cdr category)))
+ cell)) groups))))))
+
+(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
+ (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
+
;;; Fetching setup functions.
(defun gnus-agent-start-fetch ()
"Initialize data structures for efficient fetching."
- (gnus-agent-open-history)
- (setq gnus-agent-current-history (gnus-agent-history-buffer))
(gnus-agent-create-buffer))
(defun gnus-agent-stop-fetch ()
"Save all data structures and clean up."
- (gnus-agent-save-history)
- (gnus-agent-close-history)
(setq gnus-agent-spam-hashtb nil)
(save-excursion
(set-buffer nntp-server-buffer)
@@ -204,6 +423,13 @@ If this is `ask' the hook will query the user."
(put 'gnus-agent-with-fetch 'lisp-indent-function 0)
(put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
+(defmacro gnus-agent-append-to-list (tail value)
+ `(setq ,tail (setcdr ,tail (cons ,value nil))))
+
+(defmacro gnus-agent-message (level &rest args)
+ `(if (<= ,level gnus-verbose)
+ (message ,@args)))
+
;;;
;;; Mode infestation
;;;
@@ -233,7 +459,13 @@ If this is `ask' the hook will query the user."
buffer))))
minor-mode-map-alist))
(when (eq major-mode 'gnus-group-mode)
- (gnus-agent-toggle-plugged gnus-plugged))
+ (let ((init-plugged gnus-plugged)
+ (gnus-agent-go-online nil))
+ ;; g-a-t-p does nothing when gnus-plugged isn't changed.
+ ;; Therefore, make certain that the current value does not
+ ;; match the desired initial value.
+ (setq gnus-plugged :unknown)
+ (gnus-agent-toggle-plugged init-plugged)))
(gnus-run-hooks 'gnus-agent-mode-hook
(intern (format "gnus-agent-%s-mode-hook" buffer)))))
@@ -244,9 +476,10 @@ If this is `ask' the hook will query the user."
"Jj" gnus-agent-toggle-plugged
"Js" gnus-agent-fetch-session
"JY" gnus-agent-synchronize-flags
- "JS" gnus-group-send-drafts
+ "JS" gnus-group-send-queue
"Ja" gnus-agent-add-group
- "Jr" gnus-agent-remove-group)
+ "Jr" gnus-agent-remove-group
+ "Jo" gnus-agent-toggle-group-plugged)
(defun gnus-agent-group-make-menu-bar ()
(unless (boundp 'gnus-agent-group-menu)
@@ -254,15 +487,23 @@ If this is `ask' the hook will query the user."
gnus-agent-group-menu gnus-agent-group-mode-map ""
'("Agent"
["Toggle plugged" gnus-agent-toggle-plugged t]
+ ["Toggle group plugged" gnus-agent-toggle-group-plugged t]
["List categories" gnus-enter-category-buffer t]
- ["Send drafts" gnus-group-send-drafts gnus-plugged]
+ ["Add (current) group to category" gnus-agent-add-group t]
+ ["Remove (current) group from category" gnus-agent-remove-group t]
+ ["Send queue" gnus-group-send-queue gnus-plugged]
("Fetch"
["All" gnus-agent-fetch-session gnus-plugged]
- ["Group" gnus-agent-fetch-group gnus-plugged])))))
+ ["Group" gnus-agent-fetch-group gnus-plugged])
+ ["Synchronize flags" gnus-agent-synchronize-flags t]
+ ))))
(defvar gnus-agent-summary-mode-map (make-sparse-keymap))
(gnus-define-keys gnus-agent-summary-mode-map
"Jj" gnus-agent-toggle-plugged
+ "Ju" gnus-agent-summary-fetch-group
+ "JS" gnus-agent-fetch-group
+ "Js" gnus-agent-summary-fetch-series
"J#" gnus-agent-mark-article
"J\M-#" gnus-agent-unmark-article
"@" gnus-agent-toggle-mark
@@ -277,6 +518,7 @@ If this is `ask' the hook will query the user."
["Mark as downloadable" gnus-agent-mark-article t]
["Unmark as downloadable" gnus-agent-unmark-article t]
["Toggle mark" gnus-agent-toggle-mark t]
+ ["Fetch downloadable" gnus-agent-summary-fetch-group t]
["Catchup undownloaded" gnus-agent-catchup t]))))
(defvar gnus-agent-server-mode-map (make-sparse-keymap))
@@ -294,24 +536,50 @@ If this is `ask' the hook will query the user."
["Add" gnus-agent-add-server t]
["Remove" gnus-agent-remove-server t]))))
-(defun gnus-agent-toggle-plugged (plugged)
+(defun gnus-agent-make-mode-line-string (string mouse-button mouse-func)
+ (if (and (fboundp 'propertize)
+ (fboundp 'make-mode-line-mouse-map))
+ (propertize string 'local-map
+ (make-mode-line-mouse-map mouse-button mouse-func))
+ string))
+
+(defun gnus-agent-toggle-plugged (set-to)
"Toggle whether Gnus is unplugged or not."
(interactive (list (not gnus-plugged)))
- (if plugged
- (progn
- (setq gnus-plugged plugged)
- (gnus-agent-possibly-synchronize-flags)
- (gnus-run-hooks 'gnus-agent-plugged-hook)
- (setcar (cdr gnus-agent-mode-status) " Plugged"))
- (gnus-agent-close-connections)
- (setq gnus-plugged plugged)
- (gnus-run-hooks 'gnus-agent-unplugged-hook)
- (setcar (cdr gnus-agent-mode-status) " Unplugged"))
+ (cond ((eq set-to gnus-plugged)
+ nil)
+ (set-to
+ (setq gnus-plugged set-to)
+ (gnus-run-hooks 'gnus-agent-plugged-hook)
+ (setcar (cdr gnus-agent-mode-status)
+ (gnus-agent-make-mode-line-string " Plugged"
+ 'mouse-2
+ 'gnus-agent-toggle-plugged))
+ (gnus-agent-go-online gnus-agent-go-online)
+ (gnus-agent-possibly-synchronize-flags))
+ (t
+ (gnus-agent-close-connections)
+ (setq gnus-plugged set-to)
+ (gnus-run-hooks 'gnus-agent-unplugged-hook)
+ (setcar (cdr gnus-agent-mode-status)
+ (gnus-agent-make-mode-line-string " Unplugged"
+ 'mouse-2
+ 'gnus-agent-toggle-plugged))))
(set-buffer-modified-p t))
+(defmacro gnus-agent-while-plugged (&rest body)
+ `(let ((original-gnus-plugged gnus-plugged))
+ (unwind-protect
+ (progn (gnus-agent-toggle-plugged t)
+ ,@body)
+ (gnus-agent-toggle-plugged original-gnus-plugged))))
+
+(put 'gnus-agent-while-plugged 'lisp-indent-function 0)
+(put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
+
(defun gnus-agent-close-connections ()
"Close all methods covered by the Gnus agent."
- (let ((methods gnus-agent-covered-methods))
+ (let ((methods (gnus-agent-covered-methods)))
(while methods
(gnus-close-server (pop methods)))))
@@ -330,36 +598,64 @@ If this is `ask' the hook will query the user."
(gnus))
;;;###autoload
+(defun gnus-slave-unplugged (&optional arg)
+ "Read news as a slave unplugged."
+ (interactive "P")
+ (setq gnus-plugged nil)
+ (gnus arg nil 'slave))
+
+;;;###autoload
(defun gnus-agentize ()
"Allow Gnus to be an offline newsreader.
-The normal usage of this command is to put the following as the
-last form in your `.gnus.el' file:
-\(gnus-agentize)
+The gnus-agentize function is now called internally by gnus when
+gnus-agent is set. If you wish to avoid calling gnus-agentize,
+customize gnus-agent to nil.
-This will modify the `gnus-before-startup-hook', `gnus-post-method',
-and `message-send-mail-function' variables, and install the Gnus
-agent minor mode in all Gnus buffers."
+This will modify the `gnus-setup-news-hook', and
+`message-send-mail-real-function' variables, and install the Gnus agent
+minor mode in all Gnus buffers."
(interactive)
(gnus-open-agent)
(add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
(unless gnus-agent-send-mail-function
- (setq gnus-agent-send-mail-function message-send-mail-function
- message-send-mail-function 'gnus-agent-send-mail))
- (unless gnus-agent-covered-methods
- (setq gnus-agent-covered-methods (list gnus-select-method))))
-
-(defun gnus-agent-queue-setup ()
- "Make sure the queue group exists."
- (unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb)
- (gnus-request-create-group "queue" '(nndraft ""))
+ (setq gnus-agent-send-mail-function
+ (or message-send-mail-real-function
+ message-send-mail-function)
+ message-send-mail-real-function 'gnus-agent-send-mail))
+
+ ;; If the servers file doesn't exist, auto-agentize some servers and
+ ;; save the servers file so this auto-agentizing isn't invoked
+ ;; again.
+ (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers"))
+ (gnus-message 3 "First time agent user, agentizing remote groups...")
+ (mapc
+ (lambda (server-or-method)
+ (let ((method (gnus-server-to-method server-or-method)))
+ (when (memq (car method)
+ gnus-agent-auto-agentize-methods)
+ (push (gnus-method-to-server method)
+ gnus-agent-covered-methods)
+ (setq gnus-agent-method-p-cache nil))))
+ (cons gnus-select-method gnus-secondary-select-methods))
+ (gnus-agent-write-servers)))
+
+(defun gnus-agent-queue-setup (&optional group-name)
+ "Make sure the queue group exists.
+Optional arg GROUP-NAME allows to specify another group."
+ (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
+ gnus-newsrc-hashtb)
+ (gnus-request-create-group (or group-name "queue") '(nndraft ""))
(let ((gnus-level-default-subscribed 1))
- (gnus-subscribe-group "nndraft:queue" nil '(nndraft "")))
+ (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
+ nil '(nndraft "")))
(gnus-group-set-parameter
- "nndraft:queue" 'gnus-dummy '((gnus-draft-mode)))))
+ (format "nndraft:%s" (or group-name "queue"))
+ 'gnus-dummy '((gnus-draft-mode)))))
(defun gnus-agent-send-mail ()
- (if gnus-plugged
+ (if (or (not gnus-agent-queue-mail)
+ (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
(funcall gnus-agent-send-mail-function)
(goto-char (point-min))
(re-search-forward
@@ -370,7 +666,7 @@ agent minor mode in all Gnus buffers."
(defun gnus-agent-insert-meta-information (type &optional method)
"Insert meta-information into the message that says how it's to be posted.
-TYPE can be either `mail' or `news'. If the latter METHOD can
+TYPE can be either `mail' or `news'. If the latter, then METHOD can
be a select method."
(save-excursion
(message-remove-header gnus-agent-meta-information-header)
@@ -386,7 +682,8 @@ be a select method."
"Restore GCC field from saved header."
(save-excursion
(goto-char (point-min))
- (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t)
+ (while (re-search-forward
+ (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
(replace-match "Gcc:" 'fixedcase))))
(defun gnus-agent-any-covered-gcc ()
@@ -400,11 +697,11 @@ be a select method."
gcc " ,")))))
covered)
(while (and (not covered) methods)
- (setq covered
- (member (car methods) gnus-agent-covered-methods)
+ (setq covered (gnus-agent-method-p (car methods))
methods (cdr methods)))
covered)))
+;;;###autoload
(defun gnus-agent-possibly-save-gcc ()
"Save GCC if Gnus is unplugged."
(when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
@@ -430,17 +727,18 @@ be a select method."
(error "Groups can't be fetched when Gnus is unplugged"))
(gnus-group-iterate n 'gnus-agent-fetch-group))
-(defun gnus-agent-fetch-group (group)
+(defun gnus-agent-fetch-group (&optional group)
"Put all new articles in GROUP into the Agent."
(interactive (list (gnus-group-group-name)))
- (unless gnus-plugged
- (error "Groups can't be fetched when Gnus is unplugged"))
+ (setq group (or group gnus-newsgroup-name))
(unless group
(error "No group on the current line"))
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (gnus-agent-with-fetch
- (gnus-agent-fetch-group-1 group gnus-command-method)
- (gnus-message 5 "Fetching %s...done" group))))
+
+ (gnus-agent-while-plugged
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (gnus-agent-with-fetch
+ (gnus-agent-fetch-group-1 group gnus-command-method)
+ (gnus-message 5 "Fetching %s...done" group)))))
(defun gnus-agent-add-group (category arg)
"Add the current group to an agent category."
@@ -457,10 +755,12 @@ be a select method."
c groups)
(gnus-group-iterate arg
(lambda (group)
- (when (cadddr (setq c (gnus-group-category group)))
- (setf (cadddr c) (delete group (cadddr c))))
+ (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
+ (setf (gnus-agent-cat-groups c)
+ (delete group (gnus-agent-cat-groups c))))
(push group groups)))
- (setf (cadddr cat) (nconc (cadddr cat) groups))
+ (setf (gnus-agent-cat-groups cat)
+ (nconc (gnus-agent-cat-groups cat) groups))
(gnus-category-write)))
(defun gnus-agent-remove-group (arg)
@@ -469,15 +769,16 @@ be a select method."
(let (c)
(gnus-group-iterate arg
(lambda (group)
- (when (cadddr (setq c (gnus-group-category group)))
- (setf (cadddr c) (delete group (cadddr c))))))
+ (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
+ (setf (gnus-agent-cat-groups c)
+ (delete group (gnus-agent-cat-groups c))))))
(gnus-category-write)))
(defun gnus-agent-synchronize-flags ()
"Synchronize unplugged flags with servers."
(interactive)
(save-excursion
- (dolist (gnus-command-method gnus-agent-covered-methods)
+ (dolist (gnus-command-method (gnus-agent-covered-methods))
(when (file-exists-p (gnus-agent-lib-file "flags"))
(gnus-agent-synchronize-flags-server gnus-command-method)))))
@@ -485,7 +786,7 @@ be a select method."
"Synchronize flags according to `gnus-agent-synchronize-flags'."
(interactive)
(save-excursion
- (dolist (gnus-command-method gnus-agent-covered-methods)
+ (dolist (gnus-command-method (gnus-agent-covered-methods))
(when (file-exists-p (gnus-agent-lib-file "flags"))
(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
@@ -497,11 +798,10 @@ be a select method."
(erase-buffer)
(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
(if (null (gnus-check-server gnus-command-method))
- (message "Couldn't open server %s" (nth 1 gnus-command-method))
+ (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method))
(while (not (eobp))
(if (null (eval (read (current-buffer))))
- (progn (forward-line)
- (kill-line -1))
+ (gnus-delete-line)
(write-file (gnus-agent-lib-file "flags"))
(error "Couldn't set flags from file %s"
(gnus-agent-lib-file "flags"))))
@@ -521,36 +821,80 @@ be a select method."
;;; Server mode commands
;;;
-(defun gnus-agent-add-server (server)
+(defun gnus-agent-add-server ()
"Enroll SERVER in the agent program."
- (interactive (list (gnus-server-server-name)))
- (unless server
- (error "No server on the current line"))
- (let ((method (gnus-server-get-method nil (gnus-server-server-name))))
- (when (member method gnus-agent-covered-methods)
+ (interactive)
+ (let* ((server (gnus-server-server-name))
+ (named-server (gnus-server-named-server))
+ (method (and server
+ (gnus-server-get-method nil server))))
+ (unless server
+ (error "No server on the current line"))
+
+ (when (gnus-agent-method-p method)
(error "Server already in the agent program"))
- (push method gnus-agent-covered-methods)
+
+ (push named-server gnus-agent-covered-methods)
+
+ (setq gnus-agent-method-p-cache nil)
+ (gnus-server-update-server server)
(gnus-agent-write-servers)
- (message "Entered %s into the Agent" server)))
+ (gnus-message 1 "Entered %s into the Agent" server)))
-(defun gnus-agent-remove-server (server)
+(defun gnus-agent-remove-server ()
"Remove SERVER from the agent program."
- (interactive (list (gnus-server-server-name)))
- (unless server
- (error "No server on the current line"))
- (let ((method (gnus-server-get-method nil (gnus-server-server-name))))
- (unless (member method gnus-agent-covered-methods)
+ (interactive)
+ (let* ((server (gnus-server-server-name))
+ (named-server (gnus-server-named-server)))
+ (unless server
+ (error "No server on the current line"))
+
+ (unless (member named-server gnus-agent-covered-methods)
(error "Server not in the agent program"))
- (setq gnus-agent-covered-methods
- (delete method gnus-agent-covered-methods))
+
+ (setq gnus-agent-covered-methods
+ (delete named-server gnus-agent-covered-methods)
+ gnus-agent-method-p-cache nil)
+
+ (gnus-server-update-server server)
(gnus-agent-write-servers)
- (message "Removed %s from the agent" server)))
+ (gnus-message 1 "Removed %s from the agent" server)))
(defun gnus-agent-read-servers ()
"Read the alist of covered servers."
+ (setq gnus-agent-covered-methods
+ (gnus-agent-read-file
+ (nnheader-concat gnus-agent-directory "lib/servers"))
+ gnus-agent-method-p-cache nil)
+
+ ;; I am called so early in start-up that I can not validate server
+ ;; names. When that is the case, I skip the validation. That is
+ ;; alright as the gnus startup code calls the validate methods
+ ;; directly.
+ (if gnus-server-alist
+ (gnus-agent-read-servers-validate)))
+
+(defun gnus-agent-read-servers-validate ()
+ (mapcar (lambda (server-or-method)
+ (let* ((server (if (stringp server-or-method)
+ server-or-method
+ (gnus-method-to-server server-or-method)))
+ (method (gnus-server-to-method server)))
+ (if method
+ (unless (member server gnus-agent-covered-methods)
+ (push server gnus-agent-covered-methods)
+ (setq gnus-agent-method-p-cache nil))
+ (gnus-message 1 "Ignoring disappeared server `%s'" server))))
+ (prog1 gnus-agent-covered-methods
+ (setq gnus-agent-covered-methods nil))))
+
+(defun gnus-agent-read-servers-validate-native (native-method)
(setq gnus-agent-covered-methods
- (gnus-agent-read-file
- (nnheader-concat gnus-agent-directory "lib/servers"))))
+ (mapcar (lambda (method)
+ (if (or (not method)
+ (equal method native-method))
+ "native"
+ method)) gnus-agent-covered-methods)))
(defun gnus-agent-write-servers ()
"Write the alist of covered servers."
@@ -558,7 +902,8 @@ be a select method."
(let ((coding-system-for-write nnheader-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
- (prin1 gnus-agent-covered-methods (current-buffer)))))
+ (prin1 gnus-agent-covered-methods
+ (current-buffer)))))
;;;
;;; Summary commands
@@ -600,155 +945,306 @@ the actual number of articles toggled is returned."
(gnus-agent-mark-article n 'toggle))
(defun gnus-summary-set-agent-mark (article &optional unmark)
- "Mark ARTICLE as downloadable."
- (let ((unmark (if (and (not (null unmark)) (not (eq t unmark)))
- (memq article gnus-newsgroup-downloadable)
- unmark)))
- (if unmark
- (progn
- (setq gnus-newsgroup-downloadable
- (delq article gnus-newsgroup-downloadable))
- (push article gnus-newsgroup-undownloaded))
- (setq gnus-newsgroup-undownloaded
- (delq article gnus-newsgroup-undownloaded))
- (push article gnus-newsgroup-downloadable))
- (gnus-summary-update-mark
- (if unmark gnus-undownloaded-mark gnus-downloadable-mark)
- 'unread)))
+ "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked.
+When UNMARK is t, the article is unmarked. For any other value, the
+article's mark is toggled."
+ (let ((unmark (cond ((eq nil unmark)
+ nil)
+ ((eq t unmark)
+ t)
+ (t
+ (memq article gnus-newsgroup-downloadable)))))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-mark
+ (if unmark
+ (progn
+ (setq gnus-newsgroup-downloadable
+ (delq article gnus-newsgroup-downloadable))
+ (gnus-article-mark article))
+ (setq gnus-newsgroup-downloadable
+ (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
+ gnus-downloadable-mark)
+ 'unread))))
(defun gnus-agent-get-undownloaded-list ()
- "Mark all unfetched articles as read."
+ "Construct list of articles that have not been downloaded."
(let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (and (not gnus-plugged)
- (gnus-agent-method-p gnus-command-method))
- (gnus-agent-load-alist gnus-newsgroup-name)
- ;; First mark all undownloaded articles as undownloaded.
- (let ((articles (append gnus-newsgroup-unreads
- gnus-newsgroup-marked
- gnus-newsgroup-dormant))
- article)
- (while (setq article (pop articles))
- (unless (or (cdr (assq article gnus-agent-article-alist))
- (memq article gnus-newsgroup-downloadable)
- (memq article gnus-newsgroup-cached))
- (push article gnus-newsgroup-undownloaded))))
- ;; Then mark downloaded downloadable as not-downloadable,
- ;; if you get my drift.
- (let ((articles gnus-newsgroup-downloadable)
- article)
- (while (setq article (pop articles))
- (when (cdr (assq article gnus-agent-article-alist))
- (setq gnus-newsgroup-downloadable
- (delq article gnus-newsgroup-downloadable))))))))
+ (when (set (make-local-variable 'gnus-newsgroup-agentized)
+ (gnus-agent-method-p gnus-command-method))
+ (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
+ (headers (sort (mapcar (lambda (h)
+ (mail-header-number h))
+ gnus-newsgroup-headers) '<))
+ (cached (and gnus-use-cache gnus-newsgroup-cached))
+ (undownloaded (list nil))
+ (tail-undownloaded undownloaded)
+ (unfetched (list nil))
+ (tail-unfetched unfetched))
+ (while (and alist headers)
+ (let ((a (caar alist))
+ (h (car headers)))
+ (cond ((< a h)
+ ;; Ignore IDs in the alist that are not being
+ ;; displayed in the summary.
+ (setq alist (cdr alist)))
+ ((> a h)
+ ;; Headers that are not in the alist should be
+ ;; fictious (see nnagent-retrieve-headers); they
+ ;; imply that this article isn't in the agent.
+ (gnus-agent-append-to-list tail-undownloaded h)
+ (gnus-agent-append-to-list tail-unfetched h)
+ (setq headers (cdr headers)))
+ ((cdar alist)
+ (setq alist (cdr alist))
+ (setq headers (cdr headers))
+ nil ; ignore already downloaded
+ )
+ (t
+ (setq alist (cdr alist))
+ (setq headers (cdr headers))
+
+ ;; This article isn't in the agent. Check to see
+ ;; if it is in the cache. If it is, it's been
+ ;; downloaded.
+ (while (and cached (< (car cached) a))
+ (setq cached (cdr cached)))
+ (unless (equal a (car cached))
+ (gnus-agent-append-to-list tail-undownloaded a))))))
+
+ (while headers
+ (let ((num (pop headers)))
+ (gnus-agent-append-to-list tail-undownloaded num)
+ (gnus-agent-append-to-list tail-unfetched num)))
+
+ (setq gnus-newsgroup-undownloaded (cdr undownloaded)
+ gnus-newsgroup-unfetched (cdr unfetched))))))
(defun gnus-agent-catchup ()
- "Mark all undownloaded articles as read."
+ "Mark as read all unhandled articles.
+An article is unhandled if it is neither cached, nor downloaded, nor
+downloadable."
(interactive)
(save-excursion
- (while gnus-newsgroup-undownloaded
- (gnus-summary-mark-article
- (pop gnus-newsgroup-undownloaded) gnus-catchup-mark)))
- (gnus-summary-position-point))
+ (let ((articles gnus-newsgroup-undownloaded))
+ (when (or gnus-newsgroup-downloadable
+ gnus-newsgroup-cached)
+ (setq articles (gnus-sorted-ndifference
+ (gnus-sorted-ndifference
+ (gnus-copy-sequence articles)
+ gnus-newsgroup-downloadable)
+ gnus-newsgroup-cached)))
+
+ (while articles
+ (gnus-summary-mark-article
+ (pop articles) gnus-catchup-mark)))
+ (gnus-summary-position-point)))
+
+(defun gnus-agent-summary-fetch-series ()
+ (interactive)
+ (when gnus-newsgroup-processable
+ (setq gnus-newsgroup-downloadable
+ (let* ((dl gnus-newsgroup-downloadable)
+ (gnus-newsgroup-downloadable
+ (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
+ (fetched-articles (gnus-agent-summary-fetch-group)))
+ ;; The preceeding call to (gnus-agent-summary-fetch-group)
+ ;; updated gnus-newsgroup-downloadable to remove each
+ ;; article successfully fetched.
+
+ ;; For each article that I processed, remove its
+ ;; processable mark IF the article is no longer
+ ;; downloadable (i.e. it's already downloaded)
+ (dolist (article gnus-newsgroup-processable)
+ (unless (memq article gnus-newsgroup-downloadable)
+ (gnus-summary-remove-process-mark article)))
+ (gnus-sorted-ndifference dl fetched-articles)))))
+
+(defun gnus-agent-summary-fetch-group (&optional all)
+ "Fetch the downloadable articles in the group.
+Optional arg ALL, if non-nil, means to fetch all articles."
+ (interactive "P")
+ (let ((articles
+ (if all gnus-newsgroup-articles
+ gnus-newsgroup-downloadable))
+ (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
+ fetched-articles)
+ (gnus-agent-while-plugged
+ (unless articles
+ (error "No articles to download"))
+ (gnus-agent-with-fetch
+ (setq gnus-newsgroup-undownloaded
+ (gnus-sorted-ndifference
+ gnus-newsgroup-undownloaded
+ (setq fetched-articles
+ (gnus-agent-fetch-articles
+ gnus-newsgroup-name articles)))))
+ (save-excursion
+ (dolist (article articles)
+ (let ((was-marked-downloadable
+ (memq article gnus-newsgroup-downloadable)))
+ (cond (gnus-agent-mark-unread-after-downloaded
+ (setq gnus-newsgroup-downloadable
+ (delq article gnus-newsgroup-downloadable))
+
+ (gnus-summary-mark-article article gnus-unread-mark))
+ (was-marked-downloadable
+ (gnus-summary-set-agent-mark article t)))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-download-mark article))))))
+ fetched-articles))
+
+(defun gnus-agent-fetch-selected-article ()
+ "Fetch the current article as it is selected.
+This can be added to `gnus-select-article-hook' or
+`gnus-mark-article-hook'."
+ (let ((gnus-command-method gnus-current-select-method))
+ (when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
+ (when (gnus-agent-fetch-articles
+ gnus-newsgroup-name
+ (list gnus-current-article))
+ (setq gnus-newsgroup-undownloaded
+ (delq gnus-current-article gnus-newsgroup-undownloaded))
+ (gnus-summary-update-download-mark gnus-current-article)))))
;;;
;;; Internal functions
;;;
(defun gnus-agent-save-active (method)
- (gnus-agent-save-active-1 method 'gnus-active-to-gnus-format))
-
-(defun gnus-agent-save-active-1 (method function)
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
(new (gnus-make-hashtable (count-lines (point-min) (point-max))))
(file (gnus-agent-lib-file "active")))
- (funcall function nil new)
+ (gnus-active-to-gnus-format nil new)
(gnus-agent-write-active file new)
(erase-buffer)
(nnheader-insert-file-contents file))))
(defun gnus-agent-write-active (file new)
- (let ((orig (gnus-make-hashtable (count-lines (point-min) (point-max))))
- (file (gnus-agent-lib-file "active"))
- elem osym)
- (when (file-exists-p file)
- (with-temp-buffer
- (nnheader-insert-file-contents file)
- (gnus-active-to-gnus-format nil orig))
- (mapatoms
- (lambda (sym)
- (when (and sym (boundp sym))
- (if (and (boundp (setq osym (intern (symbol-name sym) orig)))
- (setq elem (symbol-value osym)))
- (setcdr elem (cdr (symbol-value sym)))
- (set (intern (symbol-name sym) orig) (symbol-value sym)))))
- new))
(gnus-make-directory (file-name-directory file))
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- ;; The hashtable contains real names of groups, no more prefix
- ;; removing, so set `full' to `t'.
- (gnus-write-active-file file orig t))))
-
-(defun gnus-agent-save-groups (method)
- (gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format))
+ (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
+ ;; The hashtable contains real names of groups. However, do NOT
+ ;; add the foreign server prefix as gnus-active-to-gnus-format
+ ;; will add it while reading the file.
+ (gnus-write-active-file file new nil)))
+
+(defun gnus-agent-possibly-alter-active (group active &optional info)
+ "Possibly expand a group's active range to include articles
+downloaded into the agent."
+ (let* ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group))))
+ (when (gnus-agent-method-p gnus-command-method)
+ (let* ((local (gnus-agent-get-local group))
+ (active-min (or (car active) 0))
+ (active-max (or (cdr active) 0))
+ (agent-min (or (car local) active-min))
+ (agent-max (or (cdr local) active-max)))
+
+ (when (< agent-min active-min)
+ (setcar active agent-min))
+
+ (when (> agent-max active-max)
+ (setcdr active agent-max))
+
+ (when (and info (< agent-max (- active-min 100)))
+ ;; I'm expanding the active range by such a large amount
+ ;; that there is a gap of more than 100 articles between the
+ ;; last article known to the agent and the first article
+ ;; currently available on the server. This gap contains
+ ;; articles that have been lost, mark them as read so that
+ ;; gnus doesn't waste resources trying to fetch them.
+
+ ;; NOTE: I don't do this for smaller gaps (< 100) as I don't
+ ;; want to modify the local file everytime someone restarts
+ ;; gnus. The small gap will cause a tiny performance hit
+ ;; when gnus tries, and fails, to retrieve the articles.
+ ;; Still that should be smaller than opening a buffer,
+ ;; printing this list to the buffer, and then writing it to a
+ ;; file.
+
+ (let ((read (gnus-info-read info)))
+ (gnus-info-set-read
+ info
+ (gnus-range-add
+ read
+ (list (cons (1+ agent-max)
+ (1- active-min))))))
+
+ ;; Lie about the agent's local range for this group to
+ ;; disable the set read each time this server is opened.
+ ;; NOTE: Opening this group will restore the valid local
+ ;; range but it will also expand the local range to
+ ;; incompass the new active range.
+ (gnus-agent-set-local group agent-min (1- active-min)))))))
(defun gnus-agent-save-group-info (method group active)
+ "Update a single group's active range in the agent's copy of the server's active file."
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
(coding-system-for-write nnheader-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system)
(file (gnus-agent-lib-file "active"))
- oactive)
+ oactive-min oactive-max)
(gnus-make-directory (file-name-directory file))
(with-temp-file file
;; Emacs got problem to match non-ASCII group in multibyte buffer.
(mm-disable-multibyte)
(when (file-exists-p file)
- (nnheader-insert-file-contents file))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote group) " ") nil t)
- (save-excursion
- (save-restriction
- (narrow-to-region (match-beginning 0)
- (progn
- (forward-line 1)
- (point)))
- (setq oactive (car (nnmail-parse-active)))))
- (gnus-delete-line))
+ (nnheader-insert-file-contents file)
+
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote group) " ") nil t)
+ (save-excursion
+ (setq oactive-max (read (current-buffer)) ;; max
+ oactive-min (read (current-buffer)))) ;; min
+ (gnus-delete-line)))
(insert (format "%S %d %d y\n" (intern group)
- (cdr active)
- (or (car oactive) (car active))))
+ (max (or oactive-max (cdr active)) (cdr active))
+ (min (or oactive-min (car active)) (car active))))
(goto-char (point-max))
(while (search-backward "\\." nil t)
(delete-char 1))))))
(defun gnus-agent-group-path (group)
"Translate GROUP into a file name."
- (if nnmail-use-long-file-names
- (gnus-group-real-name group)
- (nnheader-translate-file-chars
- (nnheader-replace-chars-in-string
- (nnheader-replace-duplicate-chars-in-string
- (nnheader-replace-chars-in-string
- (gnus-group-real-name group)
- ?/ ?_)
- ?. ?_)
- ?. ?/))))
-
-
-
-(defun gnus-agent-method-p (method)
- "Say whether METHOD is covered by the agent."
- (member method gnus-agent-covered-methods))
+
+ ;; NOTE: This is what nnmail-group-pathname does as of Apr 2003.
+ ;; The two methods must be kept synchronized, which is why
+ ;; gnus-agent-group-pathname was added.
+
+ (setq group
+ (nnheader-translate-file-chars
+ (nnheader-replace-duplicate-chars-in-string
+ (nnheader-replace-chars-in-string
+ (gnus-group-real-name group)
+ ?/ ?_)
+ ?. ?_)))
+ (if (or nnmail-use-long-file-names
+ (file-directory-p (expand-file-name group (gnus-agent-directory))))
+ group
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string group ?. ?/)
+ nnmail-pathname-coding-system)))
+
+(defun gnus-agent-group-pathname (group)
+ "Translate GROUP into a file name."
+ ;; nnagent uses nnmail-group-pathname to read articles while
+ ;; unplugged. The agent must, therefore, use the same directory
+ ;; while plugged.
+ (let ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group))))
+ (nnmail-group-pathname (gnus-group-real-name group) (gnus-agent-directory))))
(defun gnus-agent-get-function (method)
- (if (and (not gnus-plugged)
- (gnus-agent-method-p method))
- (progn
- (require 'nnagent)
- 'nnagent)
- (car method)))
+ (if (gnus-online method)
+ (car method)
+ (require 'nnagent)
+ 'nnagent))
+
+(defun gnus-agent-covered-methods ()
+ "Return the subset of methods that are covered by the agent."
+ (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods)))
;;; History functions
@@ -770,14 +1266,6 @@ the actual number of articles toggled is returned."
(nnheader-insert-file-contents file))
(set (make-local-variable 'gnus-agent-file-name) file))))
-(defun gnus-agent-save-history ()
- (save-excursion
- (set-buffer gnus-agent-current-history)
- (gnus-make-directory (file-name-directory gnus-agent-file-name))
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- (write-region (1+ (point-min)) (point-max)
- gnus-agent-file-name nil 'silent))))
-
(defun gnus-agent-close-history ()
(when (gnus-buffer-live-p gnus-agent-current-history)
(kill-buffer gnus-agent-current-history)
@@ -785,37 +1273,6 @@ the actual number of articles toggled is returned."
(delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
gnus-agent-history-buffers))))
-(defun gnus-agent-enter-history (id group-arts date)
- (save-excursion
- (set-buffer gnus-agent-current-history)
- (goto-char (point-max))
- (let ((p (point)))
- (insert id "\t" (number-to-string date) "\t")
- (while group-arts
- (insert (format "%S" (intern (caar group-arts)))
- " " (number-to-string (cdr (pop group-arts)))
- " "))
- (insert "\n")
- (while (search-backward "\\." p t)
- (delete-char 1)))))
-
-(defun gnus-agent-article-in-history-p (id)
- (save-excursion
- (set-buffer (gnus-agent-history-buffer))
- (goto-char (point-min))
- (search-forward (concat "\n" id "\t") nil t)))
-
-(defun gnus-agent-history-path (id)
- (save-excursion
- (set-buffer (gnus-agent-history-buffer))
- (goto-char (point-min))
- (when (search-forward (concat "\n" id "\t") nil t)
- (let ((method (gnus-agent-method)))
- (let (paths group)
- (while (not (numberp (setq group (read (current-buffer)))))
- (push (concat method "/" group) paths))
- (nreverse paths))))))
-
;;;
;;; Fetching
;;;
@@ -823,77 +1280,139 @@ the actual number of articles toggled is returned."
(defun gnus-agent-fetch-articles (group articles)
"Fetch ARTICLES from GROUP and put them into the Agent."
(when articles
- ;; Prune off articles that we have already fetched.
- (while (and articles
- (cdr (assq (car articles) gnus-agent-article-alist)))
- (pop articles))
- (let ((arts articles))
- (while (cdr arts)
- (if (cdr (assq (cadr arts) gnus-agent-article-alist))
- (setcdr arts (cddr arts))
- (setq arts (cdr arts)))))
- (when articles
- (let ((dir (concat
- (gnus-agent-directory)
- (gnus-agent-group-path group) "/"))
- (date (time-to-days (current-time)))
- (case-fold-search t)
- pos crosses id elem)
- (gnus-make-directory dir)
- (gnus-message 7 "Fetching articles for %s..." group)
- ;; Fetch the articles from the backend.
- (if (gnus-check-backend-function 'retrieve-articles group)
- (setq pos (gnus-retrieve-articles articles group))
- (with-temp-buffer
- (let (article)
- (while (setq article (pop articles))
- (when (or
- (gnus-backlog-request-article group article
- nntp-server-buffer)
- (gnus-request-article article group))
- (goto-char (point-max))
- (push (cons article (point)) pos)
- (insert-buffer-substring nntp-server-buffer)))
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- (setq pos (nreverse pos)))))
- ;; Then save these articles into the Agent.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (while pos
- (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (when (search-backward "\nXrefs: " nil t)
- ;; Handle crossposting.
- (skip-chars-forward "^ ")
- (skip-chars-forward " ")
- (setq crosses nil)
- (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +")
- (push (cons (buffer-substring (match-beginning 1)
- (match-end 1))
- (buffer-substring (match-beginning 2)
- (match-end 2)))
- crosses)
- (goto-char (match-end 0)))
- (gnus-agent-crosspost crosses (caar pos))))
- (goto-char (point-min))
- (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t))
- (setq id "No-Message-ID-in-article")
- (setq id (buffer-substring (match-beginning 1) (match-end 1))))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max)
- (concat dir (number-to-string (caar pos)))
- nil 'silent))
- (when (setq elem (assq (caar pos) gnus-agent-article-alist))
- (setcdr elem t))
- (gnus-agent-enter-history
- id (or crosses (list (cons group (caar pos)))) date)
- (widen)
- (pop pos)))
- (gnus-agent-save-alist group)))))
-
-(defun gnus-agent-crosspost (crosses article)
+ (gnus-agent-load-alist group)
+ (let* ((alist gnus-agent-article-alist)
+ (headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
+ (selected-sets (list nil))
+ (current-set-size 0)
+ article
+ header-number)
+ ;; Check each article
+ (while (setq article (pop articles))
+ ;; Skip alist entries preceeding this article
+ (while (> article (or (caar alist) (1+ article)))
+ (setq alist (cdr alist)))
+
+ ;; Prune off articles that we have already fetched.
+ (unless (and (eq article (caar alist))
+ (cdar alist))
+ ;; Skip headers preceeding this article
+ (while (> article
+ (setq header-number
+ (let* ((header (car headers)))
+ (if header
+ (mail-header-number header)
+ (1+ article)))))
+ (setq headers (cdr headers)))
+
+ ;; Add this article to the current set
+ (setcar selected-sets (cons article (car selected-sets)))
+
+ ;; Update the set size, when the set is too large start a
+ ;; new one. I do this after adding the article as I want at
+ ;; least one article in each set.
+ (when (< gnus-agent-max-fetch-size
+ (setq current-set-size
+ (+ current-set-size
+ (if (= header-number article)
+ (let ((char-size (mail-header-chars
+ (car headers))))
+ (if (<= char-size 0)
+ ;; The char size was missing/invalid,
+ ;; assume a worst-case situation of
+ ;; 65 char/line. If the line count
+ ;; is missing, arbitrarily assume a
+ ;; size of 1000 characters.
+ (max (* 65 (mail-header-lines
+ (car headers)))
+ 1000)
+ char-size))
+ 0))))
+ (setcar selected-sets (nreverse (car selected-sets)))
+ (setq selected-sets (cons nil selected-sets)
+ current-set-size 0))))
+
+ (when (or (cdr selected-sets) (car selected-sets))
+ (let* ((fetched-articles (list nil))
+ (tail-fetched-articles fetched-articles)
+ (dir (gnus-agent-group-pathname group))
+ (date (time-to-days (current-time)))
+ (case-fold-search t)
+ pos crosses id)
+
+ (setcar selected-sets (nreverse (car selected-sets)))
+ (setq selected-sets (nreverse selected-sets))
+
+ (gnus-make-directory dir)
+ (gnus-message 7 "Fetching articles for %s..." group)
+
+ (unwind-protect
+ (while (setq articles (pop selected-sets))
+ ;; Fetch the articles from the backend.
+ (if (gnus-check-backend-function 'retrieve-articles group)
+ (setq pos (gnus-retrieve-articles articles group))
+ (with-temp-buffer
+ (let (article)
+ (while (setq article (pop articles))
+ (gnus-message 10 "Fetching article %s for %s..."
+ article group)
+ (when (or
+ (gnus-backlog-request-article group article
+ nntp-server-buffer)
+ (gnus-request-article article group))
+ (goto-char (point-max))
+ (push (cons article (point)) pos)
+ (insert-buffer-substring nntp-server-buffer)))
+ (copy-to-buffer
+ nntp-server-buffer (point-min) (point-max))
+ (setq pos (nreverse pos)))))
+ ;; Then save these articles into the Agent.
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (while pos
+ (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
+ (goto-char (point-min))
+ (unless (eobp) ;; Don't save empty articles.
+ (when (search-forward "\n\n" nil t)
+ (when (search-backward "\nXrefs: " nil t)
+ ;; Handle cross posting.
+ (goto-char (match-end 0)) ; move to end of header name
+ (skip-chars-forward "^ ") ; skip server name
+ (skip-chars-forward " ")
+ (setq crosses nil)
+ (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *")
+ (push (cons (buffer-substring (match-beginning 1)
+ (match-end 1))
+ (string-to-int
+ (buffer-substring (match-beginning 2)
+ (match-end 2))))
+ crosses)
+ (goto-char (match-end 0)))
+ (gnus-agent-crosspost crosses (caar pos) date)))
+ (goto-char (point-min))
+ (if (not (re-search-forward
+ "^Message-ID: *<\\([^>\n]+\\)>" nil t))
+ (setq id "No-Message-ID-in-article")
+ (setq id (buffer-substring
+ (match-beginning 1) (match-end 1))))
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max)
+ (concat dir (number-to-string (caar pos)))
+ nil 'silent))
+
+ (gnus-agent-append-to-list
+ tail-fetched-articles (caar pos)))
+ (widen)
+ (setq pos (cdr pos)))))
+
+ (gnus-agent-save-alist group (cdr fetched-articles) date)
+ (gnus-message 7 ""))
+ (cdr fetched-articles))))))
+
+(defun gnus-agent-crosspost (crosses article &optional date)
+ (setq date (or date t))
+
(let (gnus-agent-article-alist group alist beg end)
(save-excursion
(set-buffer gnus-agent-overview-buffer)
@@ -906,7 +1425,7 @@ the actual number of articles toggled is returned."
(unless (setq alist (assoc group gnus-agent-group-alist))
(push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
gnus-agent-group-alist))
- (setcdr alist (cons (cons (cdar crosses) t) (cdr alist)))
+ (setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
(save-excursion
(set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
group)))
@@ -917,8 +1436,65 @@ the actual number of articles toggled is returned."
(gnus-agent-article-name ".overview" group))))
(nnheader-find-nov-line (string-to-number (cdar crosses)))
(insert (string-to-number (cdar crosses)))
- (insert-buffer-substring gnus-agent-overview-buffer beg end))
- (pop crosses))))
+ (insert-buffer-substring gnus-agent-overview-buffer beg end)
+ (gnus-agent-check-overview-buffer))
+ (setq crosses (cdr crosses)))))
+
+(defun gnus-agent-backup-overview-buffer ()
+ (when gnus-newsgroup-name
+ (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
+ (cnt 0)
+ name)
+ (while (file-exists-p
+ (setq name (concat root "~"
+ (int-to-string (setq cnt (1+ cnt))) "~"))))
+ (write-region (point-min) (point-max) name nil 'no-msg)
+ (gnus-message 1 "Created backup copy of overview in %s." name)))
+ t)
+
+(defun gnus-agent-check-overview-buffer (&optional buffer)
+ "Check the overview file given for sanity.
+In particular, checks that the file is sorted by article number
+and that there are no duplicates."
+ (let ((prev-num -1)
+ (backed-up nil))
+ (save-excursion
+ (when buffer
+ (set-buffer buffer))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+
+ (while (< (point) (point-max))
+ (let ((p (point))
+ (cur (condition-case nil
+ (read (current-buffer))
+ (error nil))))
+ (cond
+ ((or (not (integerp cur))
+ (not (eq (char-after) ?\t)))
+ (or backed-up
+ (setq backed-up (gnus-agent-backup-overview-buffer)))
+ (gnus-message 1
+ "Overview buffer contains garbage '%s'."
+ (buffer-substring
+ p (gnus-point-at-eol))))
+ ((= cur prev-num)
+ (or backed-up
+ (setq backed-up (gnus-agent-backup-overview-buffer)))
+ (gnus-message 1
+ "Duplicate overview line for %d" cur)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((< cur prev-num)
+ (or backed-up
+ (setq backed-up (gnus-agent-backup-overview-buffer)))
+ (gnus-message 1 "Overview buffer not sorted!")
+ (sort-numeric-fields 1 (point-min) (point-max))
+ (goto-char (point-min))
+ (setq prev-num -1))
+ (t
+ (setq prev-num cur)))
+ (forward-line 1)))))))
(defun gnus-agent-flush-cache ()
(save-excursion
@@ -930,143 +1506,466 @@ the actual number of articles toggled is returned."
(gnus-agent-article-name ".overview"
(caar gnus-agent-buffer-alist))
nil 'silent))
- (pop gnus-agent-buffer-alist))
+ (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
(while gnus-agent-group-alist
- (with-temp-file (caar gnus-agent-group-alist)
+ (with-temp-file (gnus-agent-article-name
+ ".agentview" (caar gnus-agent-group-alist))
(princ (cdar gnus-agent-group-alist))
+ (insert "\n")
+ (princ 1 (current-buffer))
(insert "\n"))
- (pop gnus-agent-group-alist))))
-
-(if (fboundp 'union)
- (defalias 'gnus-agent-union 'union)
- (defun gnus-agent-union (l1 l2)
- "Set union of lists L1 and L2."
- (cond ((null l1) l2)
- ((null l2) l1)
- ((equal l1 l2) l1)
- (t
- (or (>= (length l1) (length l2))
- (setq l1 (prog1 l2 (setq l2 l1))))
- (while l2
- (or (memq (car l2) l1)
- (push (car l2) l1))
- (pop l2))
- l1))))
+ (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
+
+(defun gnus-agent-find-parameter (group symbol)
+ "Search for GROUPs SYMBOL in the group's parameters, the group's
+topic parameters, the group's category, or the customizable
+variables. Returns the first non-nil value found."
+ (or (gnus-group-find-parameter group symbol t)
+ (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t)
+ (symbol-value
+ (cdr
+ (assq symbol
+ '((agent-short-article . gnus-agent-short-article)
+ (agent-long-article . gnus-agent-long-article)
+ (agent-low-score . gnus-agent-low-score)
+ (agent-high-score . gnus-agent-high-score)
+ (agent-days-until-old . gnus-agent-expire-days)
+ (agent-enable-expiration
+ . gnus-agent-enable-expiration)
+ (agent-predicate . gnus-agent-predicate)))))))
(defun gnus-agent-fetch-headers (group &optional force)
- (let ((articles (gnus-list-of-unread-articles group))
- (gnus-decode-encoded-word-function 'identity)
- (file (gnus-agent-article-name ".overview" group)))
- ;; Add article with marks to list of article headers we want to fetch.
- (dolist (arts (gnus-info-marks (gnus-get-info group)))
- (setq articles (gnus-agent-union (gnus-uncompress-sequence (cdr arts))
- articles)))
- (setq articles (sort articles '<))
- ;; Remove known articles.
- (when (gnus-agent-load-alist group)
- (setq articles (gnus-sorted-intersection
- articles
- (gnus-uncompress-range
- (cons (1+ (caar (last gnus-agent-article-alist)))
- (cdr (gnus-active group)))))))
- ;; Fetch them.
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t))
- (when articles
- (gnus-message 7 "Fetching headers for %s..." group)
+ "Fetch interesting headers into the agent. The group's overview
+file will be updated to include the headers while a list of available
+article numbers will be returned."
+ (let* ((fetch-all (and gnus-agent-consider-all-articles
+ ;; Do not fetch all headers if the predicate
+ ;; implies that we only consider unread articles.
+ (not (gnus-predicate-implies-unread
+ (gnus-agent-find-parameter group
+ 'agent-predicate)))))
+ (articles (if fetch-all
+ (gnus-uncompress-range (gnus-active group))
+ (gnus-list-of-unread-articles group)))
+ (gnus-decode-encoded-word-function 'identity)
+ (file (gnus-agent-article-name ".overview" group)))
+
+ (unless fetch-all
+ ;; Add articles with marks to the list of article headers we want to
+ ;; fetch. Don't fetch articles solely on the basis of a recent or seen
+ ;; mark, but do fetch recent or seen articles if they have other, more
+ ;; interesting marks. (We have to fetch articles with boring marks
+ ;; because otherwise the agent will remove their marks.)
+ (dolist (arts (gnus-info-marks (gnus-get-info group)))
+ (unless (memq (car arts) '(seen recent killed cache))
+ (setq articles (gnus-range-add articles (cdr arts)))))
+ (setq articles (sort (gnus-uncompress-sequence articles) '<)))
+
+ ;; At this point, I have the list of articles to consider for
+ ;; fetching. This is the list that I'll return to my caller. Some
+ ;; of these articles may have already been fetched. That's OK as
+ ;; the fetch article code will filter those out. Internally, I'll
+ ;; filter this list to just those articles whose headers need to
+ ;; be fetched.
+ (let ((articles articles))
+ ;; Remove known articles.
+ (when (and (or gnus-agent-cache
+ (not gnus-plugged))
+ (gnus-agent-load-alist group))
+ ;; Remove articles marked as downloaded.
+ (if fetch-all
+ ;; I want to fetch all headers in the active range.
+ ;; Therefore, exclude only those headers that are in the
+ ;; article alist.
+ ;; NOTE: This is probably NOT what I want to do after
+ ;; agent expiration in this group.
+ (setq articles (gnus-agent-uncached-articles articles group))
+
+ ;; I want to only fetch those headers that have never been
+ ;; fetched. Therefore, exclude all headers that are, or
+ ;; WERE, in the article alist.
+ (let ((low (1+ (caar (last gnus-agent-article-alist))))
+ (high (cdr (gnus-active group))))
+ ;; Low can be greater than High when the same group is
+ ;; fetched twice in the same session {The first fetch will
+ ;; fill the article alist such that (last
+ ;; gnus-agent-article-alist) equals (cdr (gnus-active
+ ;; group))}. The addition of one(the 1+ above) then
+ ;; forces Low to be greater than High. When this happens,
+ ;; gnus-list-range-intersection returns nil which
+ ;; indicates that no headers need to be fetched. -- Kevin
+ (setq articles (gnus-list-range-intersection
+ articles (list (cons low high)))))))
+
+ (gnus-message
+ 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
+ (gnus-compress-sequence articles t))
+
(save-excursion
- (set-buffer nntp-server-buffer)
- (unless (eq 'nov (gnus-retrieve-headers articles group))
- (nnvirtual-convert-headers))
- ;; Save these headers for later processing.
- (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
- (when (file-exists-p file)
- (gnus-agent-braid-nov group articles file))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) file nil 'silent))
- (gnus-agent-save-alist group articles nil)
- (gnus-agent-enter-history
- "last-header-fetched-for-session"
- (list (cons group (nth (- (length articles) 1) articles)))
- (time-to-days (current-time)))
- articles))))
+ (set-buffer nntp-server-buffer)
+
+ (if articles
+ (progn
+ (gnus-message 7 "Fetching headers for %s..." group)
+
+ ;; Fetch them.
+ (gnus-make-directory (nnheader-translate-file-chars
+ (file-name-directory file) t))
+
+ (unless (eq 'nov (gnus-retrieve-headers articles group))
+ (nnvirtual-convert-headers))
+ (gnus-agent-check-overview-buffer)
+ ;; Move these headers to the overview buffer so that
+ ;; gnus-agent-braid-nov can merge them with the contents
+ ;; of FILE.
+ (copy-to-buffer
+ gnus-agent-overview-buffer (point-min) (point-max))
+ (when (file-exists-p file)
+ (gnus-agent-braid-nov group articles file))
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-save-alist group articles nil)
+ articles)
+ (ignore-errors
+ (erase-buffer)
+ (nnheader-insert-file-contents file)))))
+ articles))
(defsubst gnus-agent-copy-nov-line (article)
- (let (b e)
+ (let (art b e)
(set-buffer gnus-agent-overview-buffer)
- (setq b (point))
- (if (eq article (read (current-buffer)))
- (setq e (progn (forward-line 1) (point)))
- (progn
- (beginning-of-line)
- (setq e b)))
- (set-buffer nntp-server-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer b e)))
+ (while (and (not (eobp))
+ (< (setq art (read (current-buffer))) article))
+ (forward-line 1))
+ (beginning-of-line)
+ (if (or (eobp)
+ (not (eq article art)))
+ (set-buffer nntp-server-buffer)
+ (setq b (point))
+ (setq e (progn (forward-line 1) (point)))
+ (set-buffer nntp-server-buffer)
+ (insert-buffer-substring gnus-agent-overview-buffer b e))))
(defun gnus-agent-braid-nov (group articles file)
- (set-buffer gnus-agent-overview-buffer)
- (goto-char (point-min))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (goto-char (point-max))
- (if (or (= (point-min) (point-max))
- (progn
- (forward-line -1)
- (< (read (current-buffer)) (car articles))))
- ;; We have only headers that are after the older headers,
- ;; so we just append them.
- (progn
- (goto-char (point-max))
- (insert-buffer-substring gnus-agent-overview-buffer))
- ;; We do it the hard way.
- (nnheader-find-nov-line (car articles))
- (gnus-agent-copy-nov-line (car articles))
- (pop articles)
- (while (and articles
- (not (eobp)))
- (while (and (not (eobp))
- (< (read (current-buffer)) (car articles)))
- (forward-line 1))
- (beginning-of-line)
- (unless (eobp)
- (gnus-agent-copy-nov-line (car articles))
- (setq articles (cdr articles))))
+ "Merge agent overview data with given file.
+Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given
+FILE and places the combined headers into `nntp-server-buffer'."
+ (let (start last)
+ (set-buffer gnus-agent-overview-buffer)
+ (goto-char (point-min))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (nnheader-insert-file-contents file)
+ (goto-char (point-max))
+ (forward-line -1)
+ (unless (looking-at "[0-9]+\t")
+ ;; Remove corrupted lines
+ (gnus-message
+ 1 "Overview %s is corrupted. Removing corrupted lines..." file)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at "[0-9]+\t")
+ (forward-line 1)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (forward-line -1))
+ (unless (or (= (point-min) (point-max))
+ (< (setq last (read (current-buffer))) (car articles)))
+ ;; We do it the hard way.
+ (when (nnheader-find-nov-line (car articles))
+ ;; Replacing existing NOV entry
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (gnus-agent-copy-nov-line (pop articles))
+
+ (ignore-errors
+ (while articles
+ (while (let ((art (read (current-buffer))))
+ (cond ((< art (car articles))
+ (forward-line 1)
+ t)
+ ((= art (car articles))
+ (beginning-of-line)
+ (delete-region
+ (point) (progn (forward-line 1) (point)))
+ nil)
+ (t
+ (beginning-of-line)
+ nil))))
+
+ (gnus-agent-copy-nov-line (pop articles)))))
+
+ ;; Copy the rest lines
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-max))
(when articles
- (let (b e)
+ (when last
(set-buffer gnus-agent-overview-buffer)
- (setq b (point)
- e (point-max))
- (set-buffer nntp-server-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer b e)))))
+ (ignore-errors
+ (while (<= (read (current-buffer)) last)
+ (forward-line 1)))
+ (beginning-of-line)
+ (setq start (point))
+ (set-buffer nntp-server-buffer))
+ (insert-buffer-substring gnus-agent-overview-buffer start))))
-(defun gnus-agent-load-alist (group &optional dir)
- "Load the article-state alist for GROUP."
- (setq gnus-agent-article-alist
- (gnus-agent-read-file
- (if dir
- (expand-file-name ".agentview" dir)
- (gnus-agent-article-name ".agentview" group)))))
+;; Keeps the compiler from warning about the free variable in
+;; gnus-agent-read-agentview.
+(eval-when-compile
+ (defvar gnus-agent-read-agentview))
-(defun gnus-agent-save-alist (group &optional articles state dir)
+(defun gnus-agent-load-alist (group)
+ "Load the article-state alist for GROUP."
+ ;; Bind free variable that's used in `gnus-agent-read-agentview'.
+ (let ((gnus-agent-read-agentview group))
+ (setq gnus-agent-article-alist
+ (gnus-cache-file-contents
+ (gnus-agent-article-name ".agentview" group)
+ 'gnus-agent-file-loading-cache
+ 'gnus-agent-read-agentview))))
+
+;; Save format may be either 1 or 2. Two is the new, compressed
+;; format that is still being tested. Format 1 is uncompressed but
+;; known to be reliable.
+(defconst gnus-agent-article-alist-save-format 2)
+
+(defun gnus-agent-read-agentview (file)
+ "Load FILE and do a `read' there."
+ (with-temp-buffer
+ (ignore-errors
+ (nnheader-insert-file-contents file)
+ (goto-char (point-min))
+ (let ((alist (read (current-buffer)))
+ (version (condition-case nil (read (current-buffer))
+ (end-of-file 0)))
+ changed-version)
+
+ (cond
+ ((= version 0)
+ (let ((inhibit-quit t)
+ entry)
+ (gnus-agent-open-history)
+ (set-buffer (gnus-agent-history-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (and (looking-at
+ "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
+ (string= (match-string 2)
+ gnus-agent-read-agentview)
+ (setq entry (assoc (string-to-number (match-string 3)) alist)))
+ (setcdr entry (string-to-number (match-string 1))))
+ (forward-line 1))
+ (gnus-agent-close-history)
+ (setq changed-version t)))
+ ((= version 1)
+ (setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
+ ((= version 2)
+ (let (uncomp)
+ (mapcar
+ (lambda (comp-list)
+ (let ((state (car comp-list))
+ (sequence (gnus-uncompress-sequence
+ (cdr comp-list))))
+ (mapcar (lambda (article-id)
+ (setq uncomp (cons (cons article-id state) uncomp)))
+ sequence)))
+ alist)
+ (setq alist (sort uncomp 'car-less-than-car)))))
+ (when changed-version
+ (let ((gnus-agent-article-alist alist))
+ (gnus-agent-save-alist gnus-agent-read-agentview)))
+ alist))))
+
+(defun gnus-agent-save-alist (group &optional articles state)
"Save the article-state alist for GROUP."
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (with-temp-file (if dir
- (expand-file-name ".agentview" dir)
- (gnus-agent-article-name ".agentview" group))
- (princ (setq gnus-agent-article-alist
- (nconc gnus-agent-article-alist
- (mapcar (lambda (article) (cons article state))
- articles)))
- (current-buffer))
- (insert "\n"))))
+ (let* ((file-name-coding-system nnmail-pathname-coding-system)
+ (prev (cons nil gnus-agent-article-alist))
+ (all prev)
+ print-level print-length item article)
+ (while (setq article (pop articles))
+ (while (and (cdr prev)
+ (< (caadr prev) article))
+ (setq prev (cdr prev)))
+ (cond
+ ((not (cdr prev))
+ (setcdr prev (list (cons article state))))
+ ((> (caadr prev) article)
+ (setcdr prev (cons (cons article state) (cdr prev))))
+ ((= (caadr prev) article)
+ (setcdr (cadr prev) state)))
+ (setq prev (cdr prev)))
+ (setq gnus-agent-article-alist (cdr all))
+
+ (gnus-agent-set-local group
+ (caar gnus-agent-article-alist)
+ (caar (last gnus-agent-article-alist)))
+
+ (gnus-make-directory (gnus-agent-article-name "" group))
+ (with-temp-file (gnus-agent-article-name ".agentview" group)
+ (cond ((eq gnus-agent-article-alist-save-format 1)
+ (princ gnus-agent-article-alist (current-buffer)))
+ ((eq gnus-agent-article-alist-save-format 2)
+ (let ((compressed nil))
+ (mapcar (lambda (pair)
+ (let* ((article-id (car pair))
+ (day-of-download (cdr pair))
+ (comp-list (assq day-of-download compressed)))
+ (if comp-list
+ (setcdr comp-list
+ (cons article-id (cdr comp-list)))
+ (setq compressed
+ (cons (list day-of-download article-id)
+ compressed)))
+ nil)) gnus-agent-article-alist)
+ (mapcar (lambda (comp-list)
+ (setcdr comp-list
+ (gnus-compress-sequence
+ (nreverse (cdr comp-list)))))
+ compressed)
+ (princ compressed (current-buffer)))))
+ (insert "\n")
+ (princ gnus-agent-article-alist-save-format (current-buffer))
+ (insert "\n"))))
+
+(defvar gnus-agent-article-local nil)
+(defvar gnus-agent-file-loading-local nil)
+
+(defun gnus-agent-load-local (&optional method)
+ "Load the METHOD'S local file. The local file contains min/max
+article counts for each of the method's subscribed groups."
+ (let ((gnus-command-method (or method gnus-command-method)))
+ (setq gnus-agent-article-local
+ (gnus-cache-file-contents
+ (gnus-agent-lib-file "local")
+ 'gnus-agent-file-loading-local
+ 'gnus-agent-read-and-cache-local))))
+
+(defun gnus-agent-read-and-cache-local (file)
+ "Load and read FILE then bind its contents to
+gnus-agent-article-local. If that variable had `dirty' (also known as
+modified) original contents, they are first saved to their own file."
+
+ (if (and gnus-agent-article-local
+ (symbol-value (intern "+dirty" gnus-agent-article-local)))
+ (gnus-agent-save-local))
+ (gnus-agent-read-local file))
+
+(defun gnus-agent-read-local (file)
+ "Load FILE and do a `read' there."
+ (let ((my-obarray (gnus-make-hashtable (count-lines (point-min)
+ (point-max))))
+ (line 1))
+ (with-temp-buffer
+ (condition-case nil
+ (nnheader-insert-file-contents file)
+ (file-error))
+
+ (goto-char (point-min))
+ ;; Skip any comments at the beginning of the file (the only place where they may appear)
+ (while (= (following-char) ?\;)
+ (forward-line 1)
+ (setq line (1+ line)))
+
+ (while (not (eobp))
+ (condition-case err
+ (let (group
+ min
+ max
+ (cur (current-buffer)))
+ (setq group (read cur)
+ min (read cur)
+ max (read cur))
+
+ (when (stringp group)
+ (setq group (intern group my-obarray)))
+
+ ;; NOTE: The '+ 0' ensure that min and max are both numerics.
+ (set group (cons (+ 0 min) (+ 0 max))))
+ (error
+ (gnus-message 3 "Warning - invalid agent local: %s on line %d: "
+ file line (error-message-string err))))
+ (forward-line 1)
+ (setq line (1+ line))))
+
+ (set (intern "+dirty" my-obarray) nil)
+ (set (intern "+method" my-obarray) gnus-command-method)
+ my-obarray))
+
+(defun gnus-agent-save-local (&optional force)
+ "Save gnus-agent-article-local under it method's agent.lib directory."
+ (let ((my-obarray gnus-agent-article-local))
+ (when (and my-obarray
+ (or force (symbol-value (intern "+dirty" my-obarray))))
+ (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
+ ;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
+ (dest (gnus-agent-lib-file "local")))
+ (gnus-make-directory (gnus-agent-lib-file ""))
+ (with-temp-file dest
+ (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (coding-system-for-write
+ gnus-agent-file-coding-system)
+ print-level print-length item article
+ (standard-output (current-buffer)))
+ (mapatoms (lambda (symbol)
+ (cond ((not (boundp symbol))
+ nil)
+ ((member (symbol-name symbol) '("+dirty" "+method"))
+ nil)
+ (t
+ (prin1 symbol)
+ (let ((range (symbol-value symbol)))
+ (princ " ")
+ (princ (car range))
+ (princ " ")
+ (princ (cdr range))
+ (princ "\n")))))
+ my-obarray)))))))
+
+(defun gnus-agent-get-local (group)
+ (let* ((gmane (gnus-group-real-name group))
+ (gnus-command-method (gnus-find-method-for-group group))
+ (local (gnus-agent-load-local))
+ (symb (intern gmane local))
+ (minmax (and (boundp symb) (symbol-value symb))))
+ (unless minmax
+ ;; Bind these so that gnus-agent-load-alist doesn't change the
+ ;; current alist (i.e. gnus-agent-article-alist)
+ (let* ((gnus-agent-article-alist gnus-agent-article-alist)
+ (gnus-agent-file-loading-cache gnus-agent-file-loading-cache)
+ (alist (gnus-agent-load-alist group)))
+ (when alist
+ (setq minmax
+ (cons (caar alist)
+ (caar (last alist))))
+ (gnus-agent-set-local group (car minmax) (cdr minmax)
+ gmane gnus-command-method local))))
+ minmax))
+
+(defun gnus-agent-set-local (group min max &optional gmane method local)
+ (let* ((gmane (or gmane (gnus-group-real-name group)))
+ (gnus-command-method (or method (gnus-find-method-for-group group)))
+ (local (or local (gnus-agent-load-local)))
+ (symb (intern gmane local))
+ (minmax (and (boundp symb) (symbol-value symb))))
+
+ (if (cond ((and minmax
+ (or (not (eq min (car minmax)))
+ (not (eq max (cdr minmax)))))
+ (setcar minmax min)
+ (setcdr minmax max)
+ t)
+ (minmax
+ nil)
+ ((and min max)
+ (set symb (cons min max))
+ t))
+ (set (intern "+dirty" local) t))))
(defun gnus-agent-article-name (article group)
- (expand-file-name (if (stringp article) article (string-to-number article))
+ (expand-file-name article
(file-name-as-directory
- (expand-file-name (gnus-agent-group-path group)
- (gnus-agent-directory)))))
+ (gnus-agent-group-pathname group))))
(defun gnus-agent-batch-confirmation (msg)
"Show error message and return t."
@@ -1089,106 +1988,226 @@ the actual number of articles toggled is returned."
(error "No servers are covered by the Gnus agent"))
(unless gnus-plugged
(error "Can't fetch articles while Gnus is unplugged"))
- (let ((methods gnus-agent-covered-methods)
+ (let ((methods (gnus-agent-covered-methods))
groups group gnus-command-method)
(save-excursion
(while methods
- (condition-case err
- (progn
- (setq gnus-command-method (car methods))
- (when (or (gnus-server-opened gnus-command-method)
- (gnus-open-server gnus-command-method))
- (setq groups (gnus-groups-from-server (car methods)))
- (gnus-agent-with-fetch
- (while (setq group (pop groups))
- (when (<= (gnus-group-level group) gnus-agent-handle-level)
- (gnus-agent-fetch-group-1 group gnus-command-method))))))
- (error
- (unless (funcall gnus-agent-confirmation-function
- (format "Error (%s). Continue? " err))
- (error "Cannot fetch articles into the Gnus agent")))
- (quit
- (unless (funcall gnus-agent-confirmation-function
- (format "Quit (%s). Continue? " err))
- (signal 'quit "Cannot fetch articles into the Gnus agent."))))
- (pop methods))
+ (setq gnus-command-method (car methods))
+ (when (and (or (gnus-server-opened gnus-command-method)
+ (gnus-open-server gnus-command-method))
+ (gnus-online gnus-command-method))
+ (setq groups (gnus-groups-from-server (car methods)))
+ (gnus-agent-with-fetch
+ (while (setq group (pop groups))
+ (when (<= (gnus-group-level group)
+ gnus-agent-handle-level)
+ (if (or debug-on-error debug-on-quit)
+ (gnus-agent-fetch-group-1
+ group gnus-command-method)
+ (condition-case err
+ (gnus-agent-fetch-group-1
+ group gnus-command-method)
+ (error
+ (unless (funcall gnus-agent-confirmation-function
+ (format "Error %s. Continue? "
+ (error-message-string err)))
+ (error "Cannot fetch articles into the Gnus agent")))
+ (quit
+ (unless (funcall gnus-agent-confirmation-function
+ (format
+ "Quit fetching session %s. Continue? "
+ (error-message-string err)))
+ (signal 'quit
+ "Cannot fetch articles into the Gnus agent")))))))))
+ (setq methods (cdr methods)))
+ (gnus-run-hooks 'gnus-agent-fetched-hook)
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
(defun gnus-agent-fetch-group-1 (group method)
"Fetch GROUP."
(let ((gnus-command-method method)
(gnus-newsgroup-name group)
- gnus-newsgroup-dependencies gnus-newsgroup-headers
- gnus-newsgroup-scored gnus-headers gnus-score
- gnus-use-cache articles arts
- category predicate info marks score-param
+ (gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
+ (gnus-newsgroup-headers gnus-newsgroup-headers)
+ (gnus-newsgroup-scored gnus-newsgroup-scored)
+ (gnus-use-cache gnus-use-cache)
(gnus-summary-expunge-below gnus-summary-expunge-below)
(gnus-summary-mark-below gnus-summary-mark-below)
(gnus-orphan-score gnus-orphan-score)
;; Maybe some other gnus-summary local variables should also
;; be put here.
+
+ gnus-headers
+ gnus-score
+ articles arts
+ category predicate info marks score-param
)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
+
;; Fetch headers.
- (when (and (or (gnus-active group) (gnus-activate-group group))
- (setq articles (gnus-agent-fetch-headers group))
- (let ((nntp-server-buffer gnus-agent-overview-buffer))
- ;; Parse them and see which articles we want to fetch.
- (setq gnus-newsgroup-dependencies
- (make-vector (length articles) 0))
- (setq gnus-newsgroup-headers
- (gnus-get-newsgroup-headers-xover articles nil nil
- group))
- ;; `gnus-agent-overview-buffer' may be killed for
- ;; timeout reason. If so, recreate it.
- (gnus-agent-create-buffer)))
- (setq category (gnus-group-category group))
- (setq predicate
- (gnus-get-predicate
- (or (gnus-group-find-parameter group 'agent-predicate t)
- (cadr category))))
- (if (memq (caaddr predicate) '(gnus-agent-true gnus-agent-false))
- ;; Simple implementation
- (setq arts
- (and (eq (caaddr predicate) 'gnus-agent-true) articles))
- (setq arts nil)
- (setq score-param
- (or (gnus-group-get-parameter group 'agent-score t)
- (caddr category)))
- ;; Translate score-param into real one
- (cond
- ((not score-param))
- ((eq score-param 'file)
- (setq score-param (gnus-all-score-files group)))
- ((stringp (car score-param)))
- (t
- (setq score-param (list (list score-param)))))
- (when score-param
- (gnus-score-headers score-param))
- (while (setq gnus-headers (pop gnus-newsgroup-headers))
- (setq gnus-score
- (or (cdr (assq (mail-header-number gnus-headers)
- gnus-newsgroup-scored))
- gnus-summary-default-score))
- (when (funcall predicate)
- (push (mail-header-number gnus-headers)
- arts))))
- ;; Fetch the articles.
- (when arts
- (gnus-agent-fetch-articles group arts)))
- ;; Perhaps we have some additional articles to fetch.
- (setq arts (assq 'download (gnus-info-marks
- (setq info (gnus-get-info group)))))
- (when (cdr arts)
- (gnus-agent-fetch-articles
- group (gnus-uncompress-range (cdr arts)))
- (setq marks (delq arts (gnus-info-marks info)))
- (gnus-info-set-marks info marks)
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string info)
- ")")))))
+ (when (or gnus-newsgroup-active
+ (gnus-active group)
+ (gnus-activate-group group))
+ (let ((marked-articles gnus-newsgroup-downloadable))
+ ;; Identify the articles marked for download
+ (unless gnus-newsgroup-active
+ ;; The variable gnus-newsgroup-active was selected as I need
+ ;; a gnus-summary local variable that is NOT bound to any
+ ;; value (its global value should default to nil).
+ (dolist (mark gnus-agent-download-marks)
+ (let ((arts (cdr (assq mark (gnus-info-marks
+ (setq info (gnus-get-info group)))))))
+ (when arts
+ (setq marked-articles (nconc (gnus-uncompress-range arts)
+ marked-articles))
+ ))))
+ (setq marked-articles (sort marked-articles '<))
+
+ ;; Fetch any new articles from the server
+ (setq articles (gnus-agent-fetch-headers group))
+
+ ;; Merge new articles with marked
+ (setq articles (sort (append marked-articles articles) '<))
+
+ (when articles
+ ;; Parse them and see which articles we want to fetch.
+ (setq gnus-newsgroup-dependencies
+ (or gnus-newsgroup-dependencies
+ (make-vector (length articles) 0)))
+ (setq gnus-newsgroup-headers
+ (or gnus-newsgroup-headers
+ (gnus-get-newsgroup-headers-xover articles nil nil
+ group)))
+ ;; `gnus-agent-overview-buffer' may be killed for
+ ;; timeout reason. If so, recreate it.
+ (gnus-agent-create-buffer)
+
+ ;; Figure out how to select articles in this group
+ (setq category (gnus-group-category group))
+
+ (setq predicate
+ (gnus-get-predicate
+ (gnus-agent-find-parameter group 'agent-predicate)))
+
+ ;; If the selection predicate requires scoring, score each header
+ (unless (memq predicate '(gnus-agent-true gnus-agent-false))
+ (let ((score-param
+ (gnus-agent-find-parameter group 'agent-score-file)))
+ ;; Translate score-param into real one
+ (cond
+ ((not score-param))
+ ((eq score-param 'file)
+ (setq score-param (gnus-all-score-files group)))
+ ((stringp (car score-param)))
+ (t
+ (setq score-param (list (list score-param)))))
+ (when score-param
+ (gnus-score-headers score-param))))
+
+ (unless (and (eq predicate 'gnus-agent-false)
+ (not marked-articles))
+ (let ((arts (list nil)))
+ (let ((arts-tail arts)
+ (alist (gnus-agent-load-alist group))
+ (marked-articles marked-articles)
+ (gnus-newsgroup-headers gnus-newsgroup-headers))
+ (while (setq gnus-headers (pop gnus-newsgroup-headers))
+ (let ((num (mail-header-number gnus-headers)))
+ ;; Determine if this article is already in the cache
+ (while (and alist
+ (> num (caar alist)))
+ (setq alist (cdr alist)))
+
+ (unless (and (eq num (caar alist))
+ (cdar alist))
+
+ ;; Determine if this article was marked for download.
+ (while (and marked-articles
+ (> num (car marked-articles)))
+ (setq marked-articles
+ (cdr marked-articles)))
+
+ ;; When this article is marked, or selected by the
+ ;; predicate, add it to the download list
+ (when (or (eq num (car marked-articles))
+ (let ((gnus-score
+ (or (cdr
+ (assq num gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ (gnus-agent-long-article
+ (gnus-agent-find-parameter
+ group 'agent-long-article))
+ (gnus-agent-short-article
+ (gnus-agent-find-parameter
+ group 'agent-short-article))
+ (gnus-agent-low-score
+ (gnus-agent-find-parameter
+ group 'agent-low-score))
+ (gnus-agent-high-score
+ (gnus-agent-find-parameter
+ group 'agent-high-score))
+ (gnus-agent-expire-days
+ (gnus-agent-find-parameter
+ group 'agent-days-until-old)))
+ (funcall predicate)))
+ (gnus-agent-append-to-list arts-tail num))))))
+
+ (let (fetched-articles)
+ ;; Fetch all selected articles
+ (setq gnus-newsgroup-undownloaded
+ (gnus-sorted-ndifference
+ gnus-newsgroup-undownloaded
+ (setq fetched-articles
+ (if (cdr arts)
+ (gnus-agent-fetch-articles group (cdr arts))
+ nil))))
+
+ (let ((unfetched-articles
+ (gnus-sorted-ndifference (cdr arts) fetched-articles)))
+ (if gnus-newsgroup-active
+ ;; Update the summary buffer
+ (progn
+ (dolist (article marked-articles)
+ (gnus-summary-set-agent-mark article t))
+ (dolist (article fetched-articles)
+ (if gnus-agent-mark-unread-after-downloaded
+ (gnus-summary-mark-article
+ article gnus-unread-mark))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-download-mark article)))
+ (dolist (article unfetched-articles)
+ (gnus-summary-mark-article
+ article gnus-canceled-mark)))
+
+ ;; Update the group buffer.
+
+ ;; When some, or all, of the marked articles came
+ ;; from the download mark. Remove that mark. I
+ ;; didn't do this earlier as I only want to remove
+ ;; the marks after the fetch is completed.
+
+ (dolist (mark gnus-agent-download-marks)
+ (when (eq mark 'download)
+ (let ((marked-arts
+ (assq mark (gnus-info-marks
+ (setq info (gnus-get-info group))))))
+ (when (cdr marked-arts)
+ (setq marks
+ (delq marked-arts (gnus-info-marks info)))
+ (gnus-info-set-marks info marks)))))
+ (let ((read (gnus-info-read
+ (or info (setq info (gnus-get-info group))))))
+ (gnus-info-set-read
+ info (gnus-add-to-range read unfetched-articles)))
+
+ (gnus-group-update-group group t)
+ (sit-for 0)
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string info)
+ ")"))))))))))))
;;;
;;; Agent Category Mode
@@ -1198,11 +2217,21 @@ the actual number of articles toggled is returned."
"Hook run in `gnus-category-mode' buffers.")
(defvar gnus-category-line-format " %(%20c%): %g\n"
- "Format of category lines.")
+ "Format of category lines.
+
+Valid specifiers include:
+%c Topic name (string)
+%g The number of groups in the topic (integer)
+
+General format specifiers can also be used. See Info node
+`(gnus)Formatting Variables'.")
(defvar gnus-category-mode-line-format "Gnus: %%b"
"The format specification for the category mode line.")
+(defvar gnus-agent-predicate 'false
+ "The selection predicate used when no other source is available.")
+
(defvar gnus-agent-short-article 100
"Articles that have fewer lines than this are short.")
@@ -1242,6 +2271,7 @@ the actual number of articles toggled is returned."
"k" gnus-category-kill
"c" gnus-category-copy
"a" gnus-category-add
+ "e" gnus-agent-customize-category
"p" gnus-category-edit-predicate
"g" gnus-category-edit-groups
"s" gnus-category-edit-score
@@ -1262,6 +2292,7 @@ the actual number of articles toggled is returned."
["Add" gnus-category-add t]
["Kill" gnus-category-kill t]
["Copy" gnus-category-copy t]
+ ["Edit category" gnus-agent-customize-category t]
["Edit predicate" gnus-category-edit-predicate t]
["Edit score" gnus-category-edit-score t]
["Edit groups" gnus-category-edit-groups t]
@@ -1275,7 +2306,7 @@ the actual number of articles toggled is returned."
All normal editing commands are switched off.
\\<gnus-category-mode-map>
For more in-depth information on this mode, read the manual
-(`\\[gnus-info-find-node]').
+\(`\\[gnus-info-find-node]').
The following commands are available:
@@ -1298,8 +2329,8 @@ The following commands are available:
(defalias 'gnus-category-position-point 'gnus-goto-colon)
(defun gnus-category-insert-line (category)
- (let* ((gnus-tmp-name (car category))
- (gnus-tmp-groups (length (cadddr category))))
+ (let* ((gnus-tmp-name (format "%s" (car category)))
+ (gnus-tmp-groups (length (gnus-agent-cat-groups category))))
(beginning-of-line)
(gnus-add-text-properties
(point)
@@ -1333,15 +2364,41 @@ The following commands are available:
(gnus-category-position-point)))
(defun gnus-category-name ()
- (or (get-text-property (gnus-point-at-bol) 'gnus-category)
+ (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
(error "No category on the current line")))
(defun gnus-category-read ()
"Read the category alist."
(setq gnus-category-alist
- (or (gnus-agent-read-file
- (nnheader-concat gnus-agent-directory "lib/categories"))
- (list (list 'default 'short nil nil)))))
+ (or
+ (with-temp-buffer
+ (ignore-errors
+ (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
+ (goto-char (point-min))
+ ;; This code isn't temp, it will be needed so long as
+ ;; anyone may be migrating from an older version.
+
+ ;; Once we're certain that people will not revert to an
+ ;; earlier version, we can take out the old-list code in
+ ;; gnus-category-write.
+ (let* ((old-list (read (current-buffer)))
+ (new-list (ignore-errors (read (current-buffer)))))
+ (if new-list
+ new-list
+ ;; Convert from a positional list to an alist.
+ (mapcar
+ (lambda (c)
+ (setcdr c
+ (delq nil
+ (gnus-mapcar
+ (lambda (valu symb)
+ (if valu
+ (cons symb valu)))
+ (cdr c)
+ '(agent-predicate agent-score-file agent-groups))))
+ c)
+ old-list)))))
+ (list (gnus-agent-cat-make 'default 'short)))))
(defun gnus-category-write ()
"Write the category alist."
@@ -1349,6 +2406,16 @@ The following commands are available:
gnus-category-group-cache nil)
(gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
(with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
+ ;; This prin1 is temporary. It exists so that people can revert
+ ;; to an earlier version of gnus-agent.
+ (prin1 (mapcar (lambda (c)
+ (list (car c)
+ (cdr (assoc 'agent-predicate c))
+ (cdr (assoc 'agent-score-file c))
+ (cdr (assoc 'agent-groups c))))
+ gnus-category-alist)
+ (current-buffer))
+ (newline)
(prin1 gnus-category-alist (current-buffer))))
(defun gnus-category-edit-predicate (category)
@@ -1356,9 +2423,16 @@ The following commands are available:
(interactive (list (gnus-category-name)))
(let ((info (assq category gnus-category-alist)))
(gnus-edit-form
- (cadr info) (format "Editing the predicate for category %s" category)
+ (gnus-agent-cat-predicate info)
+ (format "Editing the select predicate for category %s" category)
`(lambda (predicate)
- (setcar (cdr (assq ',category gnus-category-alist)) predicate)
+ ;; Avoid run-time execution of setf form
+ ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
+ ;; predicate)
+ ;; use its expansion instead:
+ (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
+ 'agent-predicate predicate)
+
(gnus-category-write)
(gnus-category-list)))))
@@ -1367,10 +2441,16 @@ The following commands are available:
(interactive (list (gnus-category-name)))
(let ((info (assq category gnus-category-alist)))
(gnus-edit-form
- (caddr info)
+ (gnus-agent-cat-score-file info)
(format "Editing the score expression for category %s" category)
- `(lambda (groups)
- (setcar (cddr (assq ',category gnus-category-alist)) groups)
+ `(lambda (score-file)
+ ;; Avoid run-time execution of setf form
+ ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
+ ;; score-file)
+ ;; use its expansion instead:
+ (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
+ 'agent-score-file score-file)
+
(gnus-category-write)
(gnus-category-list)))))
@@ -1379,9 +2459,16 @@ The following commands are available:
(interactive (list (gnus-category-name)))
(let ((info (assq category gnus-category-alist)))
(gnus-edit-form
- (cadddr info) (format "Editing the group list for category %s" category)
+ (gnus-agent-cat-groups info)
+ (format "Editing the group list for category %s" category)
`(lambda (groups)
- (setcar (nthcdr 3 (assq ',category gnus-category-alist)) groups)
+ ;; Avoid run-time execution of setf form
+ ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
+ ;; groups)
+ ;; use its expansion instead:
+ (gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
+ groups)
+
(gnus-category-write)
(gnus-category-list)))))
@@ -1398,8 +2485,10 @@ The following commands are available:
"Copy the current category."
(interactive (list (gnus-category-name) (intern (read-string "New name: "))))
(let ((info (assq category gnus-category-alist)))
- (push (list to (gnus-copy-sequence (cadr info))
- (gnus-copy-sequence (caddr info)) nil)
+ (push (let ((newcat (gnus-copy-sequence info)))
+ (setf (gnus-agent-cat-name newcat) to)
+ (setf (gnus-agent-cat-groups newcat) nil)
+ newcat)
gnus-category-alist)
(gnus-category-write)
(gnus-category-list)))
@@ -1409,7 +2498,7 @@ The following commands are available:
(interactive "SCategory name: ")
(when (assq category gnus-category-alist)
(error "Category %s already exists" category))
- (push (list category 'false nil nil)
+ (push (gnus-agent-cat-make category)
gnus-category-alist)
(gnus-category-write)
(gnus-category-list))
@@ -1434,6 +2523,7 @@ The following commands are available:
(long . gnus-agent-long-p)
(low . gnus-agent-low-scored-p)
(high . gnus-agent-high-scored-p)
+ (read . gnus-agent-read-p)
(true . gnus-agent-true)
(false . gnus-agent-false))
"Mapping from short score predicate symbols to predicate functions.")
@@ -1465,9 +2555,18 @@ The following commands are available:
"Say whether an article has a high score or not."
(> gnus-score gnus-agent-high-score))
-(defun gnus-category-make-function (cat)
- "Make a function from category CAT."
- `(lambda () ,(gnus-category-make-function-1 cat)))
+(defun gnus-agent-read-p ()
+ "Say whether an article is read or not."
+ (gnus-member-of-range (mail-header-number gnus-headers)
+ (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
+
+(defun gnus-category-make-function (predicate)
+ "Make a function from PREDICATE."
+ (let ((func (gnus-category-make-function-1 predicate)))
+ (if (and (= (length func) 1)
+ (symbolp (car func)))
+ (car func)
+ (gnus-byte-compile `(lambda () ,func)))))
(defun gnus-agent-true ()
"Return t."
@@ -1477,33 +2576,91 @@ The following commands are available:
"Return nil."
nil)
-(defun gnus-category-make-function-1 (cat)
- "Make a function from category CAT."
+(defun gnus-category-make-function-1 (predicate)
+ "Make a function from PREDICATE."
(cond
;; Functions are just returned as is.
- ((or (symbolp cat)
- (gnus-functionp cat))
- `(,(or (cdr (assq cat gnus-category-predicate-alist))
- cat)))
- ;; More complex category.
- ((consp cat)
+ ((or (symbolp predicate)
+ (functionp predicate))
+ `(,(or (cdr (assq predicate gnus-category-predicate-alist))
+ predicate)))
+ ;; More complex predicate.
+ ((consp predicate)
`(,(cond
- ((memq (car cat) '(& and))
+ ((memq (car predicate) '(& and))
'and)
- ((memq (car cat) '(| or))
+ ((memq (car predicate) '(| or))
'or)
- ((memq (car cat) gnus-category-not)
+ ((memq (car predicate) gnus-category-not)
'not))
- ,@(mapcar 'gnus-category-make-function-1 (cdr cat))))
+ ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
(t
- (error "Unknown category type: %s" cat))))
+ (error "Unknown predicate type: %s" predicate))))
(defun gnus-get-predicate (predicate)
- "Return the predicate for CATEGORY."
+ "Return the function implementing PREDICATE."
(or (cdr (assoc predicate gnus-category-predicate-cache))
- (cdar (push (cons predicate
- (gnus-category-make-function predicate))
- gnus-category-predicate-cache))))
+ (let ((func (gnus-category-make-function predicate)))
+ (setq gnus-category-predicate-cache
+ (nconc gnus-category-predicate-cache
+ (list (cons predicate func))))
+ func)))
+
+(defun gnus-predicate-implies-unread (predicate)
+ "Say whether PREDICATE implies unread articles only.
+It is okay to miss some cases, but there must be no false positives.
+That is, if this predicate returns true, then indeed the predicate must
+return only unread articles."
+ (eq t (gnus-function-implies-unread-1
+ (gnus-category-make-function-1 predicate))))
+
+(defun gnus-function-implies-unread-1 (function)
+ "Recursively evaluate a predicate function to determine whether it can select
+any read articles. Returns t if the function is known to never
+return read articles, nil when it is known to always return read
+articles, and t_nil when the function may return both read and unread
+articles."
+ (let ((func (car function))
+ (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
+ (cond ((eq func 'and)
+ (cond ((memq t args) ; if any argument returns only unread articles
+ ;; then that argument constrains the result to only unread articles.
+ t)
+ ((memq 't_nil args) ; if any argument is indeterminate
+ ;; then the result is indeterminate
+ 't_nil)))
+ ((eq func 'or)
+ (cond ((memq nil args) ; if any argument returns read articles
+ ;; then that argument ensures that the results includes read articles.
+ nil)
+ ((memq 't_nil args) ; if any argument is indeterminate
+ ;; then that argument ensures that the results are indeterminate
+ 't_nil)
+ (t ; if all arguments return only unread articles
+ ;; then the result returns only unread articles
+ t)))
+ ((eq func 'not)
+ (cond ((eq (car args) 't_nil) ; if the argument is indeterminate
+ ; then the result is indeterminate
+ (car args))
+ (t ; otherwise
+ ; toggle the result to be the opposite of the argument
+ (not (car args)))))
+ ((eq func 'gnus-agent-read-p)
+ nil) ; The read predicate NEVER returns unread articles
+ ((eq func 'gnus-agent-false)
+ t) ; The false predicate returns t as the empty set excludes all read articles
+ ((eq func 'gnus-agent-true)
+ nil) ; The true predicate ALWAYS returns read articles
+ ((catch 'found-match
+ (let ((alist gnus-category-predicate-alist))
+ (while alist
+ (if (eq func (cdar alist))
+ (throw 'found-match t)
+ (setq alist (cdr alist))))))
+ 't_nil) ; All other predicates return read and unread articles
+ (t
+ (error "Unknown predicate function: %s" function)))))
(defun gnus-group-category (group)
"Return the category GROUP belongs to."
@@ -1512,188 +2669,1076 @@ The following commands are available:
(let ((cs gnus-category-alist)
groups cat)
(while (setq cat (pop cs))
- (setq groups (cadddr cat))
+ (setq groups (gnus-agent-cat-groups cat))
(while groups
(gnus-sethash (pop groups) cat gnus-category-group-cache)))))
(or (gnus-gethash group gnus-category-group-cache)
(assq 'default gnus-category-alist)))
-(defun gnus-agent-expire ()
- "Expire all old articles."
+(defun gnus-agent-expire-group (group &optional articles force)
+ "Expire all old articles in GROUP.
+If you want to force expiring of certain articles, this function can
+take ARTICLES, and FORCE parameters as well.
+
+The articles on which the expiration process runs are selected as follows:
+ if ARTICLES is null, all read and unmarked articles.
+ if ARTICLES is t, all articles.
+ if ARTICLES is a list, just those articles.
+FORCE is equivalent to setting the expiration predicates to true."
+ (interactive
+ (list (let ((def (or (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (let ((select (read-string (if def
+ (concat "Group Name ("
+ def "): ")
+ "Group Name: "))))
+ (if (and (equal "" select)
+ def)
+ def
+ select)))))
+
+ (if (not group)
+ (gnus-agent-expire articles group force)
+ (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
+ ;; expiration statistics of this single group
+ (gnus-agent-expire-stats (list 0 0 0.0)))
+ (if (or (not (eq articles t))
+ (yes-or-no-p
+ (concat "Are you sure that you want to "
+ "expire all articles in " group ".")))
+ (let ((gnus-command-method (gnus-find-method-for-group group))
+ (overview (gnus-get-buffer-create " *expire overview*"))
+ orig)
+ (unwind-protect
+ (let ((active-file (gnus-agent-lib-file "active")))
+ (when (file-exists-p active-file)
+ (with-temp-buffer
+ (nnheader-insert-file-contents active-file)
+ (gnus-active-to-gnus-format
+ gnus-command-method
+ (setq orig (gnus-make-hashtable
+ (count-lines (point-min) (point-max))))))
+ (save-excursion
+ (gnus-agent-expire-group-1
+ group overview (gnus-gethash-safe group orig)
+ articles force))))
+ (kill-buffer overview))))
+ (gnus-message 4 (gnus-agent-expire-done-message)))))
+
+(defun gnus-agent-expire-group-1 (group overview active articles force)
+ ;; Internal function - requires caller to have set
+ ;; gnus-command-method, initialized overview buffer, and to have
+ ;; provided a non-nil active
+
+ (let ((dir (gnus-agent-group-pathname group)))
+ (when (boundp 'gnus-agent-expire-current-dirs)
+ (set 'gnus-agent-expire-current-dirs
+ (cons dir
+ (symbol-value 'gnus-agent-expire-current-dirs))))
+
+ (if (and (not force)
+ (eq 'DISABLE (gnus-agent-find-parameter group
+ 'agent-enable-expiration)))
+ (gnus-message 5 "Expiry skipping over %s" group)
+ (gnus-message 5 "Expiring articles in %s" group)
+ (gnus-agent-load-alist group)
+ (let* ((stats (if (boundp 'gnus-agent-expire-stats)
+ ;; Use the list provided by my caller
+ (symbol-value 'gnus-agent-expire-stats)
+ ;; otherwise use my own temporary list
+ (list 0 0 0.0)))
+ (info (gnus-get-info group))
+ (alist gnus-agent-article-alist)
+ (day (- (time-to-days (current-time))
+ (gnus-agent-find-parameter group 'agent-days-until-old)))
+ (specials (if (and alist
+ (not force))
+ ;; This could be a bit of a problem. I need to
+ ;; keep the last article to avoid refetching
+ ;; headers when using nntp in the backend. At
+ ;; the same time, if someone uses a backend
+ ;; that supports article moving then I may have
+ ;; to remove the last article to complete the
+ ;; move. Right now, I'm going to assume that
+ ;; FORCE overrides specials.
+ (list (caar (last alist)))))
+ (unreads ;; Articles that are excluded from the
+ ;; expiration process
+ (cond (gnus-agent-expire-all
+ ;; All articles are marked read by global decree
+ nil)
+ ((eq articles t)
+ ;; All articles are marked read by function
+ ;; parameter
+ nil)
+ ((not articles)
+ ;; Unread articles are marked protected from
+ ;; expiration Don't call
+ ;; gnus-list-of-unread-articles as it returns
+ ;; articles that have not been fetched into the
+ ;; agent.
+ (ignore-errors
+ (gnus-agent-unread-articles group)))
+ (t
+ ;; All articles EXCEPT those named by the caller
+ ;; are protected from expiration
+ (gnus-sorted-difference
+ (gnus-uncompress-range
+ (cons (caar alist)
+ (caar (last alist))))
+ (sort articles '<)))))
+ (marked ;; More articles that are excluded from the
+ ;; expiration process
+ (cond (gnus-agent-expire-all
+ ;; All articles are unmarked by global decree
+ nil)
+ ((eq articles t)
+ ;; All articles are unmarked by function
+ ;; parameter
+ nil)
+ (articles
+ ;; All articles may as well be unmarked as the
+ ;; unreads list already names the articles we are
+ ;; going to keep
+ nil)
+ (t
+ ;; Ticked and/or dormant articles are excluded
+ ;; from expiration
+ (nconc
+ (gnus-uncompress-range
+ (cdr (assq 'tick (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'dormant
+ (gnus-info-marks info))))))))
+ (nov-file (concat dir ".overview"))
+ (cnt 0)
+ (completed -1)
+ dlist
+ type)
+
+ ;; The normal article alist contains elements that look like
+ ;; (article# . fetch_date) I need to combine other
+ ;; information with this list. For example, a flag indicating
+ ;; that a particular article MUST BE KEPT. To do this, I'm
+ ;; going to transform the elements to look like (article#
+ ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
+ ;; the process to generate the expired article alist.
+
+ ;; Convert the alist elements to (article# fetch_date nil
+ ;; nil).
+ (setq dlist (mapcar (lambda (e)
+ (list (car e) (cdr e) nil nil)) alist))
+
+ ;; Convert the keep lists to elements that look like (article#
+ ;; nil keep_flag nil) then append it to the expanded dlist
+ ;; These statements are sorted by ascending precidence of the
+ ;; keep_flag.
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e)
+ (list e nil 'unread nil))
+ unreads)))
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e)
+ (list e nil 'marked nil))
+ marked)))
+ (setq dlist (nconc dlist
+ (mapcar (lambda (e)
+ (list e nil 'special nil))
+ specials)))
+
+ (set-buffer overview)
+ (erase-buffer)
+ (buffer-disable-undo)
+ (when (file-exists-p nov-file)
+ (gnus-message 7 "gnus-agent-expire: Loading overview...")
+ (nnheader-insert-file-contents nov-file)
+ (goto-char (point-min))
+
+ (let (p)
+ (while (< (setq p (point)) (point-max))
+ (condition-case nil
+ ;; If I successfully read an integer (the plus zero
+ ;; ensures a numeric type), prepend a marker entry
+ ;; to the list
+ (push (list (+ 0 (read (current-buffer))) nil nil
+ (set-marker (make-marker) p))
+ dlist)
+ (error
+ (gnus-message 1 "gnus-agent-expire: read error \
+occurred when reading expression at %s in %s. Skipping to next \
+line." (point) nov-file)))
+ ;; Whether I succeeded, or failed, it doesn't matter.
+ ;; Move to the next line then try again.
+ (forward-line 1)))
+
+ (gnus-message
+ 7 "gnus-agent-expire: Loading overview... Done"))
+ (set-buffer-modified-p nil)
+
+ ;; At this point, all of the information is in dlist. The
+ ;; only problem is that much of it is spread across multiple
+ ;; entries. Sort then MERGE!!
+ (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
+ ;; If two entries have the same article-number then sort by
+ ;; ascending keep_flag.
+ (let ((special 0)
+ (marked 1)
+ (unread 2))
+ (setq dlist
+ (sort dlist
+ (lambda (a b)
+ (cond ((< (nth 0 a) (nth 0 b))
+ t)
+ ((> (nth 0 a) (nth 0 b))
+ nil)
+ (t
+ (let ((a (or (symbol-value (nth 2 a))
+ 3))
+ (b (or (symbol-value (nth 2 b))
+ 3)))
+ (<= a b))))))))
+ (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
+ (gnus-message 7 "gnus-agent-expire: Merging entries... ")
+ (let ((dlist dlist))
+ (while (cdr dlist) ; I'm not at the end-of-list
+ (if (eq (caar dlist) (caadr dlist))
+ (let ((first (cdr (car dlist)))
+ (secnd (cdr (cadr dlist))))
+ (setcar first (or (car first)
+ (car secnd))) ; fetch_date
+ (setq first (cdr first)
+ secnd (cdr secnd))
+ (setcar first (or (car first)
+ (car secnd))) ; Keep_flag
+ (setq first (cdr first)
+ secnd (cdr secnd))
+ (setcar first (or (car first)
+ (car secnd))) ; NOV_entry_marker
+
+ (setcdr dlist (cddr dlist)))
+ (setq dlist (cdr dlist)))))
+ (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
+
+ (let* ((len (float (length dlist)))
+ (alist (list nil))
+ (tail-alist alist))
+ (while dlist
+ (let ((new-completed (truncate (* 100.0
+ (/ (setq cnt (1+ cnt))
+ len))))
+ message-log-max)
+ (when (> new-completed completed)
+ (setq completed new-completed)
+ (gnus-message 7 "%3d%% completed..." completed)))
+ (let* ((entry (car dlist))
+ (article-number (nth 0 entry))
+ (fetch-date (nth 1 entry))
+ (keep (nth 2 entry))
+ (marker (nth 3 entry)))
+
+ (cond
+ ;; Kept articles are unread, marked, or special.
+ (keep
+ (gnus-agent-message 10
+ "gnus-agent-expire: %s:%d: Kept %s article%s."
+ group article-number keep (if fetch-date " and file" ""))
+ (when fetch-date
+ (unless (file-exists-p
+ (concat dir (number-to-string
+ article-number)))
+ (setf (nth 1 entry) nil)
+ (gnus-agent-message 3 "gnus-agent-expire cleared \
+download flag on %s:%d as the cached article file is missing."
+ group (caar dlist)))
+ (unless marker
+ (gnus-message 1 "gnus-agent-expire detected a \
+missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
+ (gnus-agent-append-to-list
+ tail-alist
+ (cons article-number fetch-date)))
+
+ ;; The following articles are READ, UNMARKED, and
+ ;; ORDINARY. See if they can be EXPIRED!!!
+ ((setq type
+ (cond
+ ((not (integerp fetch-date))
+ 'read) ;; never fetched article (may expire
+ ;; right now)
+ ((not (file-exists-p
+ (concat dir (number-to-string
+ article-number))))
+ (setf (nth 1 entry) nil)
+ 'externally-expired) ;; Can't find the cached
+ ;; article. Handle case
+ ;; as though this article
+ ;; was never fetched.
+
+ ;; We now have the arrival day, so we see
+ ;; whether it's old enough to be expired.
+ ((< fetch-date day)
+ 'expired)
+ (force
+ 'forced)))
+
+ ;; I found some reason to expire this entry.
+
+ (let ((actions nil))
+ (when (memq type '(forced expired))
+ (ignore-errors ; Just being paranoid.
+ (let ((file-name (concat dir (number-to-string
+ article-number))))
+ (incf (nth 2 stats) (nth 7 (file-attributes file-name)))
+ (incf (nth 1 stats))
+ (delete-file file-name))
+ (push "expired cached article" actions))
+ (setf (nth 1 entry) nil)
+ )
+
+ (when marker
+ (push "NOV entry removed" actions)
+ (goto-char marker)
+
+ (incf (nth 0 stats))
+
+ (let ((from (gnus-point-at-bol))
+ (to (progn (forward-line 1) (point))))
+ (incf (nth 2 stats) (- to from))
+ (delete-region from to)))
+
+ ;; If considering all articles is set, I can only
+ ;; expire article IDs that are no longer in the
+ ;; active range (That is, articles that preceed the
+ ;; first article in the new alist).
+ (if (and gnus-agent-consider-all-articles
+ (>= article-number (car active)))
+ ;; I have to keep this ID in the alist
+ (gnus-agent-append-to-list
+ tail-alist (cons article-number fetch-date))
+ (push (format "Removed %s article number from \
+article alist" type) actions))
+
+ (when actions
+ (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
+ group article-number
+ (mapconcat 'identity actions ", ")))))
+ (t
+ (gnus-agent-message
+ 10 "gnus-agent-expire: %s:%d: Article kept as \
+expiration tests failed." group article-number)
+ (gnus-agent-append-to-list
+ tail-alist (cons article-number fetch-date)))
+ )
+
+ ;; Clean up markers as I want to recycle this buffer
+ ;; over several groups.
+ (when marker
+ (set-marker marker nil))
+
+ (setq dlist (cdr dlist))))
+
+ (setq alist (cdr alist))
+
+ (let ((inhibit-quit t))
+ (unless (equal alist gnus-agent-article-alist)
+ (setq gnus-agent-article-alist alist)
+ (gnus-agent-save-alist group))
+
+ (when (buffer-modified-p)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-make-directory dir)
+ (write-region (point-min) (point-max) nov-file nil
+ 'silent)
+ ;; clear the modified flag as that I'm not confused by
+ ;; its status on the next pass through this routine.
+ (set-buffer-modified-p nil)))
+
+ (when (eq articles t)
+ (gnus-summary-update-info))))))))
+
+(defun gnus-agent-expire (&optional articles group force)
+ "Expire all old articles.
+If you want to force expiring of certain articles, this function can
+take ARTICLES, GROUP and FORCE parameters as well.
+
+The articles on which the expiration process runs are selected as follows:
+ if ARTICLES is null, all read and unmarked articles.
+ if ARTICLES is t, all articles.
+ if ARTICLES is a list, just those articles.
+Setting GROUP will limit expiration to that group.
+FORCE is equivalent to setting the expiration predicates to true."
(interactive)
- (let ((methods gnus-agent-covered-methods)
- (day (- (time-to-days (current-time)) gnus-agent-expire-days))
- gnus-command-method sym group articles
- history overview file histories elem art nov-file low info
- unreads marked article orig lowest highest)
- (save-excursion
- (setq overview (gnus-get-buffer-create " *expire overview*"))
- (while (setq gnus-command-method (pop methods))
- (when (file-exists-p (gnus-agent-lib-file "active"))
- (with-temp-buffer
- (nnheader-insert-file-contents (gnus-agent-lib-file "active"))
- (gnus-active-to-gnus-format
- gnus-command-method
- (setq orig (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))
- (let ((expiry-hashtb (gnus-make-hashtable 1023)))
- (gnus-agent-open-history)
- (set-buffer
- (setq gnus-agent-current-history
- (setq history (gnus-agent-history-buffer))))
- (goto-char (point-min))
- (when (> (buffer-size) 1)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^\t")
- (if (> (read (current-buffer)) day)
- ;; New article; we don't expire it.
- (forward-line 1)
- ;; Old article. Schedule it for possible nuking.
- (while (not (eolp))
- (setq sym (let ((obarray expiry-hashtb) s)
- (setq s (read (current-buffer)))
- (if (stringp s) (intern s) s)))
- (if (boundp sym)
- (set sym (cons (cons (read (current-buffer)) (point))
- (symbol-value sym)))
- (set sym (list (cons (read (current-buffer)) (point)))))
- (skip-chars-forward " "))
- (forward-line 1)))
- ;; We now have all articles that can possibly be expired.
- (mapatoms
- (lambda (sym)
- (setq group (symbol-name sym)
- articles (sort (symbol-value sym) 'car-less-than-car)
- low (car (gnus-active group))
- info (gnus-get-info group)
- unreads (ignore-errors
- (gnus-list-of-unread-articles group))
- marked (nconc
- (gnus-uncompress-range
- (cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
- (cdr (assq 'dormant
- (gnus-info-marks info)))))
- nov-file (gnus-agent-article-name ".overview" group)
- lowest nil
- highest nil)
- (gnus-agent-load-alist group)
- (gnus-message 5 "Expiring articles in %s" group)
- (set-buffer overview)
- (erase-buffer)
- (when (file-exists-p nov-file)
- (nnheader-insert-file-contents nov-file))
- (goto-char (point-min))
- (setq article 0)
- (while (setq elem (pop articles))
- (setq article (car elem))
- (when (or (null low)
- (< article low)
- gnus-agent-expire-all
- (and (not (memq article unreads))
- (not (memq article marked))))
- ;; Find and nuke the NOV line.
- (while (and (not (eobp))
- (or (not (numberp
- (setq art (read (current-buffer)))))
- (< art article)))
- (if (and (numberp art)
- (file-exists-p
- (gnus-agent-article-name
- (number-to-string art) group)))
- (progn
- (unless lowest
- (setq lowest art))
- (setq highest art)
- (forward-line 1))
- ;; Remove old NOV lines that have no articles.
- (gnus-delete-line)))
- (if (or (eobp)
- (/= art article))
- (beginning-of-line)
- (gnus-delete-line))
- ;; Nuke the article.
- (when (file-exists-p
- (setq file (gnus-agent-article-name
- (number-to-string article)
- group)))
- (delete-file file))
- ;; Schedule the history line for nuking.
- (push (cdr elem) histories)))
- (gnus-make-directory (file-name-directory nov-file))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) nov-file nil 'silent))
- ;; Delete the unwanted entries in the alist.
- (setq gnus-agent-article-alist
- (sort gnus-agent-article-alist 'car-less-than-car))
- (let* ((alist gnus-agent-article-alist)
- (prev (cons nil alist))
- (first prev)
- expired)
- (while (and alist
- (<= (caar alist) article))
- (if (or (not (cdar alist))
- (not (file-exists-p
- (gnus-agent-article-name
- (number-to-string
- (caar alist))
- group))))
- (progn
- (push (caar alist) expired)
- (setcdr prev (setq alist (cdr alist))))
- (setq prev alist
- alist (cdr alist))))
- (setq gnus-agent-article-alist (cdr first))
- (gnus-agent-save-alist group)
- ;; Mark all articles up to the first article
- ;; in `gnus-article-alist' as read.
- (when (and info (caar gnus-agent-article-alist))
- (setcar (nthcdr 2 info)
- (gnus-range-add
- (nth 2 info)
- (cons 1 (- (caar gnus-agent-article-alist) 1)))))
- ;; Maybe everything has been expired from `gnus-article-alist'
- ;; and so the above marking as read could not be conducted,
- ;; or there are expired article within the range of the alist.
- (when (and info
- expired
- (or (not (caar gnus-agent-article-alist))
- (> (car expired)
- (caar gnus-agent-article-alist))))
- (setcar (nthcdr 2 info)
- (gnus-add-to-range
- (nth 2 info)
- (nreverse expired))))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string info)
- ")")))
- (when lowest
- (if (gnus-gethash group orig)
- (setcar (gnus-gethash group orig) lowest)
- (gnus-sethash group (cons lowest highest) orig))))
- expiry-hashtb)
- (set-buffer history)
- (setq histories (nreverse (sort histories '<)))
- (while histories
- (goto-char (pop histories))
- (gnus-delete-line))
- (gnus-agent-save-history)
- (gnus-agent-close-history)
- (gnus-write-active-file
- (gnus-agent-lib-file "active") orig))
- (gnus-message 4 "Expiry...done")))))))
+
+ (if group
+ (gnus-agent-expire-group group articles force)
+ (if (or (not (eq articles t))
+ (yes-or-no-p "Are you sure that you want to expire all \
+articles in every agentized group."))
+ (let ((methods (gnus-agent-covered-methods))
+ ;; Bind gnus-agent-expire-current-dirs to enable tracking
+ ;; of agent directories.
+ (gnus-agent-expire-current-dirs nil)
+ ;; Bind gnus-agent-expire-stats to enable tracking of
+ ;; expiration statistics across all groups
+ (gnus-agent-expire-stats (list 0 0 0.0))
+ gnus-command-method overview orig)
+ (setq overview (gnus-get-buffer-create " *expire overview*"))
+ (unwind-protect
+ (while (setq gnus-command-method (pop methods))
+ (let ((active-file (gnus-agent-lib-file "active")))
+ (when (file-exists-p active-file)
+ (with-temp-buffer
+ (nnheader-insert-file-contents active-file)
+ (gnus-active-to-gnus-format
+ gnus-command-method
+ (setq orig (gnus-make-hashtable
+ (count-lines (point-min) (point-max))))))
+ (dolist (expiring-group (gnus-groups-from-server
+ gnus-command-method))
+ (let* ((active
+ (gnus-gethash-safe expiring-group orig)))
+
+ (when active
+ (save-excursion
+ (gnus-agent-expire-group-1
+ expiring-group overview active articles force))))))))
+ (kill-buffer overview))
+ (gnus-agent-expire-unagentized-dirs)
+ (gnus-message 4 (gnus-agent-expire-done-message))))))
+
+(defun gnus-agent-expire-done-message ()
+ (if (and (> gnus-verbose 4)
+ (boundp 'gnus-agent-expire-stats))
+ (let* ((stats (symbol-value 'gnus-agent-expire-stats))
+ (size (nth 2 stats))
+ (units '(B KB MB GB)))
+ (while (and (> size 1024.0)
+ (cdr units))
+ (setq size (/ size 1024.0)
+ units (cdr units)))
+
+ (format "Expiry recovered %d NOV entries, deleted %d files,\
+ and freed %f %s."
+ (nth 0 stats)
+ (nth 1 stats)
+ size (car units)))
+ "Expiry...done"))
+
+(defun gnus-agent-expire-unagentized-dirs ()
+ (when (and gnus-agent-expire-unagentized-dirs
+ (boundp 'gnus-agent-expire-current-dirs))
+ (let* ((keep (gnus-make-hashtable))
+ ;; Formally bind gnus-agent-expire-current-dirs so that the
+ ;; compiler will not complain about free references.
+ (gnus-agent-expire-current-dirs
+ (symbol-value 'gnus-agent-expire-current-dirs))
+ dir)
+
+ (gnus-sethash gnus-agent-directory t keep)
+ (while gnus-agent-expire-current-dirs
+ (setq dir (pop gnus-agent-expire-current-dirs))
+ (when (and (stringp dir)
+ (file-directory-p dir))
+ (while (not (gnus-gethash dir keep))
+ (gnus-sethash dir t keep)
+ (setq dir (file-name-directory (directory-file-name dir))))))
+
+ (let* (to-remove
+ checker
+ (checker
+ (function
+ (lambda (d)
+ "Given a directory, check it and its subdirectories for
+ membership in the keep hash. If it isn't found, add
+ it to to-remove."
+ (let ((files (directory-files d))
+ file)
+ (while (setq file (pop files))
+ (cond ((equal file ".") ; Ignore self
+ nil)
+ ((equal file "..") ; Ignore parent
+ nil)
+ ((equal file ".overview")
+ ;; Directory must contain .overview to be
+ ;; agent's cache of a group.
+ (let ((d (file-name-as-directory d))
+ r)
+ ;; Search ancestor's for last directory NOT
+ ;; found in keep hash.
+ (while (not (gnus-gethash
+ (setq d (file-name-directory d)) keep))
+ (setq r d
+ d (directory-file-name d)))
+ ;; if ANY ancestor was NOT in keep hash and
+ ;; it it's already in to-remove, add it to
+ ;; to-remove.
+ (if (and r
+ (not (member r to-remove)))
+ (push r to-remove))))
+ ((file-directory-p (setq file (nnheader-concat d file)))
+ (funcall checker file)))))))))
+ (funcall checker (expand-file-name gnus-agent-directory))
+
+ (when (and to-remove
+ (or gnus-expert-user
+ (gnus-y-or-n-p
+ "gnus-agent-expire has identified local directories that are\
+ not currently required by any agentized group. Do you wish to consider\
+ deleting them?")))
+ (while to-remove
+ (let ((dir (pop to-remove)))
+ (if (gnus-y-or-n-p (format "Delete %s? " dir))
+ (let* (delete-recursive
+ (delete-recursive
+ (function
+ (lambda (f-or-d)
+ (ignore-errors
+ (if (file-directory-p f-or-d)
+ (condition-case nil
+ (delete-directory f-or-d)
+ (file-error
+ (mapcar (lambda (f)
+ (or (member f '("." ".."))
+ (funcall delete-recursive
+ (nnheader-concat
+ f-or-d f))))
+ (directory-files f-or-d))
+ (delete-directory f-or-d)))
+ (delete-file f-or-d)))))))
+ (funcall delete-recursive dir))))))))))
;;;###autoload
(defun gnus-agent-batch ()
+ "Start Gnus, send queue and fetch session."
(interactive)
(let ((init-file-user "")
(gnus-always-read-dribble-file t))
(gnus))
- (gnus-group-send-drafts)
- (gnus-agent-fetch-session))
+ (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
+ (gnus-group-send-queue)
+ (gnus-agent-fetch-session)))
+
+(defun gnus-agent-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (known (gnus-agent-load-alist group))
+ (unread (list nil))
+ (tail-unread unread))
+ (while (and known read)
+ (let ((candidate (car (pop known))))
+ (while (let* ((range (car read))
+ (min (if (numberp range) range (car range)))
+ (max (if (numberp range) range (cdr range))))
+ (cond ((or (not min)
+ (< candidate min))
+ (gnus-agent-append-to-list tail-unread candidate)
+ nil)
+ ((> candidate max)
+ (setq read (cdr read))
+ ;; return t so that I always loop one more
+ ;; time. If I just iterated off the end of
+ ;; read, min will become nil and the current
+ ;; candidate will be added to the unread list.
+ t))))))
+ (while known
+ (gnus-agent-append-to-list tail-unread (car (pop known))))
+ (cdr unread)))
+
+(defun gnus-agent-uncached-articles (articles group &optional cached-header)
+ "Restrict ARTICLES to numbers already fetched.
+Returns a sublist of ARTICLES that excludes thos article ids in GROUP
+that have already been fetched.
+If CACHED-HEADER is nil, articles are only excluded if the article itself
+has been fetched."
+
+ ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
+ ;; 'car gnus-agent-article-alist))
+
+ ;; Functionally, I don't need to construct a temp list using mapcar.
+
+ (if (and (or gnus-agent-cache (not gnus-plugged))
+ (gnus-agent-load-alist group))
+ (let* ((ref gnus-agent-article-alist)
+ (arts articles)
+ (uncached (list nil))
+ (tail-uncached uncached))
+ (while (and ref arts)
+ (let ((v1 (car arts))
+ (v2 (caar ref)))
+ (cond ((< v1 v2) ; v1 does not appear in the reference list
+ (gnus-agent-append-to-list tail-uncached v1)
+ (setq arts (cdr arts)))
+ ((= v1 v2)
+ (unless (or cached-header (cdar ref)) ; v1 is already cached
+ (gnus-agent-append-to-list tail-uncached v1))
+ (setq arts (cdr arts))
+ (setq ref (cdr ref)))
+ (t ; reference article (v2) preceeds the list being filtered
+ (setq ref (cdr ref))))))
+ (while arts
+ (gnus-agent-append-to-list tail-uncached (pop arts)))
+ (cdr uncached))
+ ;; if gnus-agent-load-alist fails, no articles are cached.
+ articles))
+
+(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
+ (save-excursion
+ (gnus-agent-create-buffer)
+ (let ((gnus-decode-encoded-word-function 'identity)
+ (file (gnus-agent-article-name ".overview" group))
+ cached-articles uncached-articles)
+ (gnus-make-directory (nnheader-translate-file-chars
+ (file-name-directory file) t))
+
+ ;; Populate temp buffer with known headers
+ (when (file-exists-p file)
+ (with-current-buffer gnus-agent-overview-buffer
+ (erase-buffer)
+ (let ((nnheader-file-coding-system
+ gnus-agent-file-coding-system))
+ (nnheader-insert-nov-file file (car articles)))))
+
+ (if (setq uncached-articles (gnus-agent-uncached-articles articles group
+ t))
+ (progn
+ ;; Populate nntp-server-buffer with uncached headers
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
+ (gnus-retrieve-headers
+ uncached-articles group fetch-old))))
+ (nnvirtual-convert-headers))
+ ((eq 'nntp (car gnus-current-select-method))
+ ;; The author of gnus-get-newsgroup-headers-xover
+ ;; reports that the XOVER command is commonly
+ ;; unreliable. The problem is that recently
+ ;; posted articles may not be entered into the
+ ;; NOV database in time to respond to my XOVER
+ ;; query.
+ ;;
+ ;; I'm going to use his assumption that the NOV
+ ;; database is updated in order of ascending
+ ;; article ID. Therefore, a response containing
+ ;; article ID N implies that all articles from 1
+ ;; to N-1 are up-to-date. Therefore, missing
+ ;; articles in that range have expired.
+
+ (set-buffer nntp-server-buffer)
+ (let* ((fetched-articles (list nil))
+ (tail-fetched-articles fetched-articles)
+ (min (cond ((numberp fetch-old)
+ (max 1 (- (car articles) fetch-old)))
+ (fetch-old
+ 1)
+ (t
+ (car articles))))
+ (max (car (last articles))))
+
+ ;; Get the list of articles that were fetched
+ (goto-char (point-min))
+ (let ((pm (point-max)))
+ (while (< (point) pm)
+ (when (looking-at "[0-9]+\t")
+ (gnus-agent-append-to-list
+ tail-fetched-articles
+ (read (current-buffer))))
+ (forward-line 1)))
+
+ ;; Clip this list to the headers that will
+ ;; actually be returned
+ (setq fetched-articles (gnus-list-range-intersection
+ (cdr fetched-articles)
+ (cons min max)))
+
+ ;; Clip the uncached articles list to exclude
+ ;; IDs after the last FETCHED header. The
+ ;; excluded IDs may be fetchable using HEAD.
+ (if (car tail-fetched-articles)
+ (setq uncached-articles
+ (gnus-list-range-intersection
+ uncached-articles
+ (cons (car uncached-articles)
+ (car tail-fetched-articles)))))
+
+ ;; Create the list of articles that were
+ ;; "successfully" fetched. Success, in this
+ ;; case, means that the ID should not be
+ ;; fetched again. In the case of an expired
+ ;; article, the header will not be fetched.
+ (setq uncached-articles
+ (gnus-sorted-nunion fetched-articles
+ uncached-articles))
+ )))
+
+ ;; Erase the temp buffer
+ (set-buffer gnus-agent-overview-buffer)
+ (erase-buffer)
+
+ ;; Copy the nntp-server-buffer to the temp buffer
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+
+ ;; Merge the temp buffer with the known headers (found on
+ ;; disk in FILE) into the nntp-server-buffer
+ (when (and uncached-articles (file-exists-p file))
+ (gnus-agent-braid-nov group uncached-articles file))
+
+ ;; Save the new set of known headers to FILE
+ (set-buffer nntp-server-buffer)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+
+ ;; Update the group's article alist to include the newly
+ ;; fetched articles.
+ (gnus-agent-load-alist group)
+ (gnus-agent-save-alist group uncached-articles nil)
+ )
+
+ ;; Copy the temp buffer to the nntp-server-buffer
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring gnus-agent-overview-buffer)))
+
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles))
+ (car (last articles)))
+ t)
+
+ 'nov))
+
+(defun gnus-agent-request-article (article group)
+ "Retrieve ARTICLE in GROUP from the agent cache."
+ (when (and gnus-agent
+ (or gnus-agent-cache
+ (not gnus-plugged))
+ (numberp article))
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (file (gnus-agent-article-name (number-to-string article) group))
+ (buffer-read-only nil))
+ (when (and (file-exists-p file)
+ (> (nth 7 (file-attributes file)) 0))
+ (erase-buffer)
+ (gnus-kill-all-overlays)
+ (let ((coding-system-for-read gnus-cache-coding-system))
+ (insert-file-contents file))
+ t))))
+
+(defun gnus-agent-regenerate-group (group &optional reread)
+ "Regenerate GROUP.
+If REREAD is t, all articles in the .overview are marked as unread.
+If REREAD is a list, the specified articles will be marked as unread.
+In addition, their NOV entries in .overview will be refreshed using
+the articles' current headers.
+If REREAD is not nil, downloaded articles are marked as unread."
+ (interactive
+ (list (let ((def (or (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (let ((select (read-string (if def
+ (concat "Group Name ("
+ def "): ")
+ "Group Name: "))))
+ (if (and (equal "" select)
+ def)
+ def
+ select)))
+ (catch 'mark
+ (while (let (c
+ (cursor-in-echo-area t)
+ (echo-keystrokes 0))
+ (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
+ (setq c (read-char-exclusive))
+
+ (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
+ (throw 'mark nil))
+ ((or (eq c ?a) (eq c ?A))
+ (throw 'mark t))
+ ((or (eq c ?d) (eq c ?D))
+ (throw 'mark 'some)))
+ (gnus-message 3 "Ignoring unexpected input")
+ (sit-for 1)
+ t)))))
+
+ (when group
+ (gnus-message 5 "Regenerating in %s" group)
+ (let* ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group)))
+ (file (gnus-agent-article-name ".overview" group))
+ (dir (file-name-directory file))
+ point
+ (downloaded (if (file-exists-p dir)
+ (sort (mapcar (lambda (name) (string-to-int name))
+ (directory-files dir nil "^[0-9]+$" t))
+ '>)
+ (progn (gnus-make-directory dir) nil)))
+ dl nov-arts
+ alist header
+ regenerated)
+
+ (mm-with-unibyte-buffer
+ (if (file-exists-p file)
+ (let ((nnheader-file-coding-system
+ gnus-agent-file-coding-system))
+ (nnheader-insert-file-contents file)))
+ (set-buffer-modified-p nil)
+
+ ;; Load the article IDs found in the overview file. As a
+ ;; side-effect, validate the file contents.
+ (let ((load t))
+ (while load
+ (setq load nil)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (cond ((and (looking-at "[0-9]+\t")
+ (<= (- (match-end 0) (match-beginning 0)) 9))
+ (push (read (current-buffer)) nov-arts)
+ (forward-line 1)
+ (let ((l1 (car nov-arts))
+ (l2 (cadr nov-arts)))
+ (cond ((and (listp reread) (memq l1 reread))
+ (gnus-delete-line)
+ (setq nov-arts (cdr nov-arts))
+ (gnus-message 4 "gnus-agent-regenerate-group: NOV\
+entry of article %s deleted." l1))
+ ((not l2)
+ nil)
+ ((< l1 l2)
+ (gnus-message 3 "gnus-agent-regenerate-group: NOV\
+ entries are NOT in ascending order.")
+ ;; Don't sort now as I haven't verified
+ ;; that every line begins with a number
+ (setq load t))
+ ((= l1 l2)
+ (forward-line -1)
+ (gnus-message 4 "gnus-agent-regenerate-group: NOV\
+ entries contained duplicate of article %s. Duplicate deleted." l1)
+ (gnus-delete-line)
+ (setq nov-arts (cdr nov-arts))))))
+ (t
+ (gnus-message 1 "gnus-agent-regenerate-group: NOV\
+ entries contained line that did not begin with an article number. Deleted\
+ line.")
+ (gnus-delete-line))))
+ (when load
+ (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
+ entries into ascending order.")
+ (sort-numeric-fields 1 (point-min) (point-max))
+ (setq nov-arts nil))))
+ (gnus-agent-check-overview-buffer)
+
+ ;; Construct a new article alist whose nodes match every header
+ ;; in the .overview file. As a side-effect, missing headers are
+ ;; reconstructed from the downloaded article file.
+ (while (or downloaded nov-arts)
+ (cond ((and downloaded
+ (or (not nov-arts)
+ (> (car downloaded) (car nov-arts))))
+ ;; This entry is missing from the overview file
+ (gnus-message 3 "Regenerating NOV %s %d..." group
+ (car downloaded))
+ (let ((file (concat dir (number-to-string (car downloaded)))))
+ (mm-with-unibyte-buffer
+ (nnheader-insert-file-contents file)
+ (nnheader-remove-body)
+ (setq header (nnheader-parse-naked-head)))
+ (mail-header-set-number header (car downloaded))
+ (if nov-arts
+ (let ((key (concat "^" (int-to-string (car nov-arts))
+ "\t")))
+ (or (re-search-backward key nil t)
+ (re-search-forward key))
+ (forward-line 1))
+ (goto-char (point-min)))
+ (nnheader-insert-nov header))
+ (setq nov-arts (cons (car downloaded) nov-arts)))
+ ((eq (car downloaded) (car nov-arts))
+ ;; This entry in the overview has been downloaded
+ (push (cons (car downloaded)
+ (time-to-days
+ (nth 5 (file-attributes
+ (concat dir (number-to-string
+ (car downloaded))))))) alist)
+ (setq downloaded (cdr downloaded))
+ (setq nov-arts (cdr nov-arts)))
+ (t
+ ;; This entry in the overview has not been downloaded
+ (push (cons (car nov-arts) nil) alist)
+ (setq nov-arts (cdr nov-arts)))))
+
+ ;; When gnus-agent-consider-all-articles is set,
+ ;; gnus-agent-regenerate-group should NOT remove article IDs from
+ ;; the alist. Those IDs serve as markers to indicate that an
+ ;; attempt has been made to fetch that article's header.
+
+ ;; When gnus-agent-consider-all-articles is NOT set,
+ ;; gnus-agent-regenerate-group can remove the article ID of every
+ ;; article (with the exception of the last ID in the list - it's
+ ;; special) that no longer appears in the overview. In this
+ ;; situtation, the last article ID in the list implies that it,
+ ;; and every article ID preceeding it, have been fetched from the
+ ;; server.
+
+ (if gnus-agent-consider-all-articles
+ ;; Restore all article IDs that were not found in the overview file.
+ (let* ((n (cons nil alist))
+ (merged n)
+ (o (gnus-agent-load-alist group)))
+ (while o
+ (let ((nID (caadr n))
+ (oID (caar o)))
+ (cond ((not nID)
+ (setq n (setcdr n (list (list oID))))
+ (setq o (cdr o)))
+ ((< oID nID)
+ (setcdr n (cons (list oID) (cdr n)))
+ (setq o (cdr o)))
+ ((= oID nID)
+ (setq o (cdr o))
+ (setq n (cdr n)))
+ (t
+ (setq n (cdr n))))))
+ (setq alist (cdr merged)))
+ ;; Restore the last article ID if it is not already in the new alist
+ (let ((n (last alist))
+ (o (last (gnus-agent-load-alist group))))
+ (cond ((not o)
+ nil)
+ ((not n)
+ (push (cons (caar o) nil) alist))
+ ((< (caar n) (caar o))
+ (setcdr n (list (car o)))))))
+
+ (let ((inhibit-quit t))
+ (if (setq regenerated (buffer-modified-p))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max) file nil 'silent)))
+
+ (setq regenerated (or regenerated
+ (and reread gnus-agent-article-alist)
+ (not (equal alist gnus-agent-article-alist))))
+
+ (setq gnus-agent-article-alist alist)
+
+ (when regenerated
+ (gnus-agent-save-alist group)
+
+ ;; I have to alter the group's active range NOW as
+ ;; gnus-make-ascending-articles-unread will use it to
+ ;; recalculate the number of unread articles in the group
+
+ (let ((group (gnus-group-real-name group))
+ (group-active (or (gnus-active group)
+ (gnus-activate-group group))))
+ (gnus-agent-possibly-alter-active group group-active)))))
+
+ (when (and reread gnus-agent-article-alist)
+ (gnus-make-ascending-articles-unread
+ group
+ (if (listp reread)
+ reread
+ (delq nil (mapcar (function (lambda (c)
+ (cond ((eq reread t)
+ (car c))
+ ((cdr c)
+ (car c)))))
+ gnus-agent-article-alist))))
+
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-group-update-group group t)
+ (sit-for 0)))
+
+ (gnus-message 5 nil)
+ regenerated)))
+
+;;;###autoload
+(defun gnus-agent-regenerate (&optional clean reread)
+ "Regenerate all agent covered files.
+If CLEAN, obsolete (ignore)."
+ (interactive "P")
+ (let (regenerated)
+ (gnus-message 4 "Regenerating Gnus agent files...")
+ (dolist (gnus-command-method (gnus-agent-covered-methods))
+ (dolist (group (gnus-groups-from-server gnus-command-method))
+ (setq regenerated (or (gnus-agent-regenerate-group group reread)
+ regenerated))))
+ (gnus-message 4 "Regenerating Gnus agent files...done")
+
+ regenerated))
+
+(defun gnus-agent-go-online (&optional force)
+ "Switch servers into online status."
+ (interactive (list t))
+ (dolist (server gnus-opened-servers)
+ (when (eq (nth 1 server) 'offline)
+ (if (if (eq force 'ask)
+ (gnus-y-or-n-p
+ (format "Switch %s:%s into online status? "
+ (caar server) (cadar server)))
+ force)
+ (setcar (nthcdr 1 server) 'close)))))
+
+(defun gnus-agent-toggle-group-plugged (group)
+ "Toggle the status of the server of the current group."
+ (interactive (list (gnus-group-group-name)))
+ (let* ((method (gnus-find-method-for-group group))
+ (status (cadr (assoc method gnus-opened-servers))))
+ (if (eq status 'offline)
+ (gnus-server-set-status method 'closed)
+ (gnus-close-server method)
+ (gnus-server-set-status method 'offline))
+ (message "Turn %s:%s from %s to %s." (car method) (cadr method)
+ (if (eq status 'offline) 'offline 'online)
+ (if (eq status 'offline) 'online 'offline))))
+
+(defun gnus-agent-group-covered-p (group)
+ (gnus-agent-method-p (gnus-group-method group)))
+
+(add-hook 'gnus-group-prepare-hook
+ (lambda ()
+ 'gnus-agent-do-once
+
+ (when (listp gnus-agent-expire-days)
+ (beep)
+ (beep)
+ (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\
+ supports being set to a list.")(sleep-for 3)
+ (gnus-message 1 "Change your configuration to set it to an\
+ integer.")(sleep-for 3)
+ (gnus-message 1 "I am now setting group parameters on each\
+ group to match the configuration that the list offered.")
+
+ (save-excursion
+ (let ((groups (gnus-group-listed-groups)))
+ (while groups
+ (let* ((group (pop groups))
+ (days gnus-agent-expire-days)
+ (day (catch 'found
+ (while days
+ (when (eq 0 (string-match
+ (caar days)
+ group))
+ (throw 'found (cadar days)))
+ (setq days (cdr days)))
+ nil)))
+ (when day
+ (gnus-group-set-parameter group 'agent-days-until-old
+ day))))))
+
+ (let ((h gnus-group-prepare-hook))
+ (while h
+ (let ((func (pop h)))
+ (when (and (listp func)
+ (eq (cadr (caddr func)) 'gnus-agent-do-once))
+ (remove-hook 'gnus-group-prepare-hook func)
+ (setq h nil)))))
+
+ (gnus-message 1 "I have finished setting group parameters on\
+ each group. You may now customize your groups and/or topics to control the\
+ agent."))))
(provide 'gnus-agent)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 5f0487968f6..33833a8657b 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1,7 +1,6 @@
;;; gnus-art.el --- article mode commands for Gnus
-
-;; Copyright (C) 1996, 97, 98, 1999, 2000, 01, 02, 2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -27,22 +26,30 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-spec)
(require 'gnus-int)
+(require 'gnus-win)
(require 'mm-bodies)
(require 'mail-parse)
(require 'mm-decode)
(require 'mm-view)
(require 'wid-edit)
(require 'mm-uu)
+(require 'message)
+
+(autoload 'gnus-msg-mail "gnus-msg" nil t)
+(autoload 'gnus-button-mailto "gnus-msg")
+(autoload 'gnus-button-reply "gnus-msg" nil t)
(defgroup gnus-article nil
"Article display."
- :link '(custom-manual "(gnus)The Article Buffer")
+ :link '(custom-manual "(gnus)Article Buffer")
:group 'gnus)
(defgroup gnus-article-treat nil
@@ -102,33 +109,47 @@
:group 'gnus-article)
(defcustom gnus-ignored-headers
- '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
- "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
- "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
- "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
- "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
- "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
- "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
- "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
- "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
- "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:"
- "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:"
- "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:"
- "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:"
- "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:"
- "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:"
- "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
- "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
- "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:"
- "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:"
- "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:"
- "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:"
- "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:"
- "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:"
- "^List-[A-Za-z]+:" "^X-Listprocessor-Version:"
- "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:"
- "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:"
- "^X-Received:" "^Content-length:" "X-precedence:")
+ (mapcar
+ (lambda (header)
+ (concat "^" header ":"))
+ '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
+ "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
+ "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
+ "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
+ "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
+ "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
+ "X-Attribution" "X-Originating-IP" "Delivered-To"
+ "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
+ "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
+ "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
+ "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
+ "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
+ "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
+ "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
+ "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
+ "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
+ "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
+ "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
+ "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
+ "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
+ "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
+ "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
+ "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
+ "List-[A-Za-z]+" "X-Listprocessor-Version"
+ "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
+ "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
+ "X-Received" "Content-length" "X-precedence"
+ "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
+ "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
+ "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
+ "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
+ "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
+ "X-Content-length" "X-Posting-Agent" "Original-Received"
+ "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
+ "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
+ "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
+ "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
+ "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
@@ -138,7 +159,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored."
:group 'gnus-article-hiding)
(defcustom gnus-visible-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
"*All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
@@ -162,17 +183,39 @@ this list."
(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
"Headers that are only to be displayed if they have interesting data.
-Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', `date', `long-to', and `many-to'."
+Possible values in this list are:
+
+ 'empty Headers with no content.
+ 'newsgroups Newsgroup identical to Gnus group.
+ 'to-address To identical to To-address.
+ 'to-list To identical to To-list.
+ 'cc-list CC identical to To-list.
+ 'followup-to Followup-to identical to Newsgroups.
+ 'reply-to Reply-to identical to From.
+ 'date Date less than four days old.
+ 'long-to To and/or Cc longer than 1024 characters.
+ 'many-to Multiple To and/or Cc."
:type '(set (const :tag "Headers with no content." empty)
- (const :tag "Newsgroups with only one group." newsgroups)
- (const :tag "Followup-to identical to newsgroups." followup-to)
- (const :tag "Reply-to identical to from." reply-to)
+ (const :tag "Newsgroups identical to Gnus group." newsgroups)
+ (const :tag "To identical to To-address." to-address)
+ (const :tag "To identical to To-list." to-list)
+ (const :tag "CC identical to To-list." cc-list)
+ (const :tag "Followup-to identical to Newsgroups." followup-to)
+ (const :tag "Reply-to identical to From." reply-to)
(const :tag "Date less than four days old." date)
- (const :tag "Very long To and/or Cc header." long-to)
+ (const :tag "To and/or Cc longer than 1024 characters." long-to)
(const :tag "Multiple To and/or Cc headers." many-to))
:group 'gnus-article-hiding)
+(defcustom gnus-article-skip-boring nil
+ "Skip over text that is not worth reading.
+By default, if you set this t, then Gnus will display citations and
+signatures, but will never scroll down to show you a page consisting
+only of boring text. Boring text is controlled by
+`gnus-article-boring-faces'."
+ :type 'boolean
+ :group 'gnus-article-hiding)
+
(defcustom gnus-signature-separator '("^-- $" "^-- *$")
"Regexp matching signature separator.
This can also be a list of regexps. In that case, it will be checked
@@ -200,27 +243,26 @@ regexp. If it matches, the text in question is not a signature."
:type 'sexp
:group 'gnus-article-hiding)
-;; Fixme: This isn't the right thing for mixed graphical and and
-;; non-graphical frames in a session.
-;; gnus-xmas.el overrides this for XEmacs.
+;; Fixme: This isn't the right thing for mixed graphical and non-graphical
+;; frames in a session.
(defcustom gnus-article-x-face-command
- (if (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xbm))
- 'gnus-article-display-xface
- (if (or (and (boundp 'gnus-article-compface-xbm)
- gnus-article-compface-xbm)
- (eq 0 (string-match "#define"
- (shell-command-to-string "uncompface -X"))))
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
+ (if (featurep 'xemacs)
+ (if (or (gnus-image-type-available-p 'xface)
+ (gnus-image-type-available-p 'pbm))
+ 'gnus-display-x-face-in-from
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
+ (if (gnus-image-type-available-p 'pbm)
+ 'gnus-display-x-face-in-from
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
display -"))
"*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
- :type '(choice string
- (function-item gnus-article-display-xface)
+ :type `(choice string
+ (function-item gnus-display-x-face-in-from)
function)
:version "21.1"
+ :group 'gnus-picon
:group 'gnus-article-washing)
(defcustom gnus-article-x-face-too-ugly nil
@@ -231,30 +273,73 @@ asynchronously. The compressed face will be piped to this command."
(defcustom gnus-article-banner-alist nil
"Banner alist for stripping.
For example,
- ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+ ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
:version "21.1"
:type '(repeat (cons symbol regexp))
:group 'gnus-article-washing)
+(gnus-define-group-parameter
+ banner
+ :variable-document
+ "Alist of regexps (to match group names) and banner."
+ :variable-group gnus-article-washing
+ :parameter-type
+ '(choice :tag "Banner"
+ :value nil
+ (const :tag "Remove signature" signature)
+ (symbol :tag "Item in `gnus-article-banner-alist'" none)
+ regexp
+ (const :tag "None" nil))
+ :parameter-document
+ "If non-nil, specify how to remove `banners' from articles.
+
+Symbol `signature' means to remove signatures delimited by
+`gnus-signature-separator'. Any other symbol is used to look up a
+regular expression to match the banner in `gnus-article-banner-alist'.
+A string is used as a regular expression to match the banner
+directly.")
+
+(defcustom gnus-article-address-banner-alist nil
+ "Alist of mail addresses and banners.
+Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
+to match a mail address in the From: header, BANNER is one of a symbol
+`signature', an item in `gnus-article-banner-alist', a regexp and nil.
+If ADDRESS matches author's mail address, it will remove things like
+advertisements. For example:
+
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+"
+ :type '(repeat
+ (cons
+ (regexp :tag "Address")
+ (choice :tag "Banner" :value nil
+ (const :tag "Remove signature" signature)
+ (symbol :tag "Item in `gnus-article-banner-alist'" none)
+ regexp
+ (const :tag "None" nil))))
+ :group 'gnus-article-washing)
+
(defcustom gnus-emphasis-alist
(let ((format
- "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
+ "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
(types
- '(("_" "_" underline)
+ '(("\\*" "\\*" bold)
+ ("_" "_" underline)
("/" "/" italic)
- ("\\*" "\\*" bold)
("_/" "/_" underline-italic)
("_\\*" "\\*_" underline-bold)
("\\*/" "/\\*" bold-italic)
("_\\*/" "/\\*_" underline-bold-italic))))
- `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
- 2 3 gnus-emphasis-underline)
- ,@(mapcar
+ `(,@(mapcar
(lambda (spec)
(list
(format format (car spec) (cadr spec))
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
- types)))
+ types)
+ ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-strikethru)
+ ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-underline)))
"*Alist that says how to fontify certain phrases.
Each item looks like this:
@@ -281,11 +366,11 @@ and the latter avoids underlining any whitespace at all."
:group 'gnus-article-emphasis
:type 'regexp)
-(defface gnus-emphasis-bold '((t (:weight bold)))
+(defface gnus-emphasis-bold '((t (:bold t)))
"Face used for displaying strong emphasized text (*word*)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-italic '((t (:slant italic)))
+(defface gnus-emphasis-italic '((t (:italic t)))
"Face used for displaying italic emphasized text (/word/)."
:group 'gnus-article-emphasis)
@@ -293,24 +378,30 @@ and the latter avoids underlining any whitespace at all."
"Face used for displaying underlined emphasized text (_word_)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-underline-bold '((t (:weight bold :underline t)))
+(defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
"Face used for displaying underlined bold emphasized text (_*word*_)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-underline-italic '((t (:slant italic :underline t)))
+(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
"Face used for displaying underlined italic emphasized text (_/word/_)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-bold-italic '((t (:weight bold :slant italic)))
+(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
"Face used for displaying bold italic emphasized text (/*word*/)."
:group 'gnus-article-emphasis)
(defface gnus-emphasis-underline-bold-italic
- '((t (:weight bold :slant italic :underline t)))
+ '((t (:bold t :italic t :underline t)))
"Face used for displaying underlined bold italic emphasized text.
Example: (_/*word*/_)."
:group 'gnus-article-emphasis)
+(defface gnus-emphasis-strikethru (if (featurep 'xemacs)
+ '((t (:strikethru t)))
+ '((t (:strike-through t))))
+ "Face used for displaying strike-through text (-word-)."
+ :group 'gnus-article-emphasis)
+
(defface gnus-emphasis-highlight-words
'((t (:background "black" :foreground "yellow")))
"Face used for displaying highlighted words."
@@ -367,6 +458,7 @@ Gnus provides the following functions:
* gnus-summary-save-in-mail (Unix mail format)
* gnus-summary-save-in-folder (MH folder)
* gnus-summary-save-in-file (article format)
+* gnus-summary-save-body-in-file (article body)
* gnus-summary-save-in-vm (use VM's folder format)
* gnus-summary-write-to-file (article format -- overwrite)."
:group 'gnus-article-saving
@@ -374,6 +466,7 @@ Gnus provides the following functions:
(function-item gnus-summary-save-in-mail)
(function-item gnus-summary-save-in-folder)
(function-item gnus-summary-save-in-file)
+ (function-item gnus-summary-save-body-in-file)
(function-item gnus-summary-save-in-vm)
(function-item gnus-summary-write-to-file)))
@@ -452,6 +545,13 @@ The following additional specs are available:
:type 'hook
:group 'gnus-article-various)
+(when (featurep 'xemacs)
+ ;; Extracted from gnus-xmas-define in order to preserve user settings
+ (when (fboundp 'turn-off-scroll-in-place)
+ (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
+ ;; Extracted from gnus-xmas-redefine in order to preserve user settings
+ (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
+
(defcustom gnus-article-menu-hook nil
"*Hook run after the creation of the article mode menu."
:type 'hook
@@ -462,10 +562,8 @@ The following additional specs are available:
:type 'hook
:group 'gnus-article-various)
-(defcustom gnus-article-hide-pgp-hook nil
- "*A hook called after successfully hiding a PGP signature."
- :type 'hook
- :group 'gnus-article-various)
+(make-obsolete-variable 'gnus-article-hide-pgp-hook
+ "This variable is obsolete in Gnus 5.10.")
(defcustom gnus-article-button-face 'bold
"Face used for highlighting buttons in the article buffer.
@@ -492,7 +590,7 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
(defface gnus-signature-face
'((t
- (:slant italic)))
+ (:italic t)))
"Face used for highlighting a signature in the article buffer."
:group 'gnus-article-highlight
:group 'gnus-article-signature)
@@ -505,7 +603,7 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
(background light))
(:foreground "red3"))
(t
- (:slant italic)))
+ (:italic t)))
"Face used for displaying from headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -518,7 +616,7 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
(background light))
(:foreground "red4"))
(t
- (:weight bold :slant italic)))
+ (:bold t :italic t)))
"Face used for displaying subject headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -526,13 +624,15 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
(defface gnus-header-newsgroups-face
'((((class color)
(background dark))
- (:foreground "yellow" :slant italic))
+ (:foreground "yellow" :italic t))
(((class color)
(background light))
- (:foreground "MidnightBlue" :slant italic))
+ (:foreground "MidnightBlue" :italic t))
(t
- (:slant italic)))
- "Face used for displaying newsgroups headers."
+ (:italic t)))
+ "Face used for displaying newsgroups headers.
+In the default setup this face is only used for crossposted
+articles."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -544,7 +644,7 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
(background light))
(:foreground "maroon"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying header names."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -552,12 +652,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
(defface gnus-header-content-face
'((((class color)
(background dark))
- (:foreground "forest green" :slant italic))
+ (:foreground "forest green" :italic t))
(((class color)
(background light))
- (:foreground "indianred4" :slant italic))
+ (:foreground "indianred4" :italic t))
(t
- (:slant italic))) "Face used for displaying header content."
+ (:italic t))) "Face used for displaying header content."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
@@ -566,17 +666,17 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
("Subject" nil gnus-header-subject-face)
("Newsgroups:.*," nil gnus-header-newsgroups-face)
("" gnus-header-name-face gnus-header-content-face))
- "*Controls highlighting of article header.
+ "*Controls highlighting of article headers.
An alist of the form (HEADER NAME CONTENT).
-HEADER is a regular expression which should match the name of an
-header header and NAME and CONTENT are either face names or nil.
+HEADER is a regular expression which should match the name of a
+header and NAME and CONTENT are either face names or nil.
The name of each header field will be displayed using the face
-specified by the first element in the list where HEADER match the
-header name and NAME is non-nil. Similarly, the content will be
-displayed by the first non-nil matching CONTENT face."
+specified by the first element in the list where HEADER matches
+the header name and NAME is non-nil. Similarly, the content will
+be displayed by the first non-nil matching CONTENT face."
:group 'gnus-article-headers
:group 'gnus-article-highlight
:type '(repeat (list (regexp :tag "Header")
@@ -588,7 +688,8 @@ displayed by the first non-nil matching CONTENT face."
(face :value default)))))
(defcustom gnus-article-decode-hook
- '(article-decode-charset article-decode-encoded-words)
+ '(article-decode-charset article-decode-encoded-words
+ article-decode-group-name article-decode-idna-rhs)
"*Hook run to decode charsets in articles."
:group 'gnus-article-headers
:type 'hook)
@@ -602,7 +703,8 @@ displayed by the first non-nil matching CONTENT face."
"Function used to decode headers.")
(defvar gnus-article-dumbquotes-map
- '(("\202" ",")
+ '(("\200" "EUR")
+ ("\202" ",")
("\203" "f")
("\204" ",,")
("\205" "...")
@@ -615,6 +717,7 @@ displayed by the first non-nil matching CONTENT face."
("\225" "*")
("\226" "-")
("\227" "--")
+ ("\230" "~")
("\231" "(TM)")
("\233" ">")
("\234" "oe")
@@ -628,11 +731,57 @@ displayed by the first non-nil matching CONTENT face."
:type '(repeat regexp))
(defcustom gnus-unbuttonized-mime-types '(".*/.*")
- "List of MIME types that should not be given buttons when rendered inline."
+ "List of MIME types that should not be given buttons when rendered inline.
+See also `gnus-buttonized-mime-types' which may override this variable.
+This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
+ :version "21.1"
+ :group 'gnus-article-mime
+ :type '(repeat regexp))
+
+(defcustom gnus-buttonized-mime-types nil
+ "List of MIME types that should be given buttons when rendered inline.
+If set, this variable overrides `gnus-unbuttonized-mime-types'.
+To see e.g. security buttons you could set this to
+`(\"multipart/signed\")'.
+This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
:version "21.1"
:group 'gnus-article-mime
:type '(repeat regexp))
+(defcustom gnus-inhibit-mime-unbuttonizing nil
+ "If non-nil, all MIME parts get buttons.
+When nil (the default value), then some MIME parts do not get buttons,
+as described by the variables `gnus-buttonized-mime-types' and
+`gnus-unbuttonized-mime-types'."
+ :version "21.3"
+ :type 'boolean)
+
+(defcustom gnus-body-boundary-delimiter "_"
+ "String used to delimit header and body.
+This variable is used by `gnus-article-treat-body-boundary' which can
+be controlled by `gnus-treat-body-boundary'."
+ :group 'gnus-article-various
+ :type '(choice (item :tag "None" :value nil)
+ string))
+
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+ "Defines the location of the faces database.
+For information on obtaining this database of pretty pictures, please
+see http://www.cs.indiana.edu/picons/ftp/index.html"
+ :type '(repeat directory)
+ :link '(url-link :tag "download"
+ "http://www.cs.indiana.edu/picons/ftp/index.html")
+ :link '(custom-manual "(gnus)Picons")
+ :group 'gnus-picon)
+
+(defun gnus-picons-installed-p ()
+ "Say whether picons are installed on your machine."
+ (let ((installed nil))
+ (dolist (database gnus-picon-databases)
+ (when (file-exists-p database)
+ (setq installed t)))
+ installed))
+
(defcustom gnus-article-mime-part-function nil
"Function called with a MIME handle as the argument.
This is meant for people who want to do something automatic based
@@ -674,15 +823,17 @@ used."
(defcustom gnus-mime-action-alist
'(("save to file" . gnus-mime-save-part)
+ ("save and strip" . gnus-mime-save-part-and-strip)
+ ("delete part" . gnus-mime-delete-part)
("display as text" . gnus-mime-inline-part)
("view the part" . gnus-mime-view-part)
("pipe to command" . gnus-mime-pipe-part)
("toggle display" . gnus-article-press-button)
+ ("toggle display" . gnus-article-view-part-as-charset)
("view as type" . gnus-mime-view-part-as-type)
- ("internalize type" . gnus-mime-internalize-part)
- ("externalize type" . gnus-mime-externalize-part))
+ ("view internally" . gnus-mime-view-part-internally)
+ ("view externally" . gnus-mime-view-part-externally))
"An alist of actions that run on the MIME attachment."
- :version "21.1"
:group 'gnus-article-mime
:type '(repeat (cons (string :tag "name")
(function))))
@@ -713,27 +864,30 @@ used."
(defvar gnus-inhibit-treatment nil
"Whether to inhibit treatment.")
-(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
+(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
"Highlight the signature.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
(defcustom gnus-treat-buttonize 100000
"Add buttons.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-buttonize 'highlight t)
(defcustom gnus-treat-buttonize-head 'head
"Add buttons to the head.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-buttonize-head 'highlight t)
@@ -744,200 +898,312 @@ See the manual for details."
50000)
"Emphasize text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-emphasize 'highlight t)
(defcustom gnus-treat-strip-cr nil
"Remove carriage returns.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-unsplit-urls nil
+ "Remove newlines from within URLs.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-leading-whitespace nil
+ "Remove leading whitespace in headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-headers 'head
"Hide headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-hide-boring-headers nil
"Hide boring headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-hide-signature nil
"Hide the signature.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fill-article nil
"Fill the article.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-citation nil
"Hide cited text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-citation-maybe nil
"Hide cited text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-list-identifiers 'head
"Strip list identifiers from `gnus-list-identifiers`.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
-(defcustom gnus-treat-strip-pgp t
- "Strip PGP signatures.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
- :group 'gnus-article-treat
- :type gnus-article-treat-custom)
+(make-obsolete-variable 'gnus-treat-strip-pgp
+ "This option is obsolete in Gnus 5.10.")
(defcustom gnus-treat-strip-pem nil
"Strip PEM signatures.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-banner t
"Strip banners from articles.
The banner to be stripped is specified in the `banner' group parameter.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-highlight-headers 'head
"Highlight the headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-highlight-headers 'highlight t)
(defcustom gnus-treat-highlight-citation t
"Highlight cited text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-citation 'highlight t)
(defcustom gnus-treat-date-ut nil
"Display the Date in UT (GMT).
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-local nil
"Display the Date in the local timezone.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-date-english nil
+ "Display the Date in a format that can be read aloud in English.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-lapsed nil
"Display the Date header in a way that says how much time has elapsed.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-original nil
"Display the date in the original timezone.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-iso8601 nil
"Display the date in the ISO8601 format.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-user-defined nil
"Display the date in a user-defined format.
The format is defined by the `gnus-article-time-format' variable.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-strip-headers-in-body t
"Strip the X-No-Archive header line from the beginning of the body.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-trailing-blank-lines nil
"Strip trailing blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-leading-blank-lines nil
"Strip leading blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-multiple-blank-lines nil
"Strip multiple blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-unfold-headers 'head
+ "Unfold folded header lines.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-fold-headers nil
+ "Fold headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-fold-newsgroups 'head
+ "Fold the Newsgroups and Followup-To headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-overstrike t
"Treat overstrike highlighting.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(put 'gnus-treat-overstrike 'highlight t)
-(defcustom gnus-treat-display-xface
- (and (or (and (fboundp 'image-type-available-p)
+(make-obsolete-variable 'gnus-treat-display-xface
+ 'gnus-treat-display-x-face)
+
+(defcustom gnus-treat-display-x-face
+ (and (not noninteractive)
+ (or (and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm)
- (string-match "^0x" (shell-command-to-string "uncompface")))
- (and (featurep 'xemacs) (featurep 'xface)))
+ (string-match "^0x" (shell-command-to-string "uncompface"))
+ (executable-find "icontopbm"))
+ (and (featurep 'xemacs)
+ (featurep 'xface)))
'head)
"Display X-Face headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)X-Face' for details."
+ :group 'gnus-article-treat
+ :version "21.1"
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)X-Face")
+ :type gnus-article-treat-head-custom
+ :set (lambda (symbol value)
+ (set-default
+ symbol
+ (cond ((or (boundp symbol) (get symbol 'saved-value))
+ value)
+ ((boundp 'gnus-treat-display-xface)
+ (message "\
+** gnus-treat-display-xface is an obsolete variable;\
+ use gnus-treat-display-x-face instead")
+ (default-value 'gnus-treat-display-xface))
+ ((get 'gnus-treat-display-xface 'saved-value)
+ (message "\
+** gnus-treat-display-xface is an obsolete variable;\
+ use gnus-treat-display-x-face instead")
+ (eval (car (get 'gnus-treat-display-xface 'saved-value))))
+ (t
+ value)))))
+(put 'gnus-treat-display-x-face 'highlight t)
+
+(defcustom gnus-treat-display-face
+ (and (not noninteractive)
+ (or (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'png))
+ (and (featurep 'xemacs)
+ (featurep 'png)))
+ 'head)
+ "Display Face headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)X-Face' for details."
:group 'gnus-article-treat
:version "21.1"
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)X-Face")
:type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-xface 'highlight t)
+(put 'gnus-treat-display-face 'highlight t)
(defcustom gnus-treat-display-smileys
(if (or (and (featurep 'xemacs)
@@ -947,85 +1213,195 @@ See the manual for details."
t nil)
"Display smileys.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Smileys' for details."
:group 'gnus-article-treat
:version "21.1"
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Smileys")
:type gnus-article-treat-custom)
(put 'gnus-treat-display-smileys 'highlight t)
-(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil)
- "Display picons.
+(defcustom gnus-treat-from-picon
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
+ 'head nil)
+ "Display picons in the From header.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Picons")
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-from-picon 'highlight t)
+
+(defcustom gnus-treat-mail-picon
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
+ 'head nil)
+ "Display picons in To and Cc headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Picons' for details."
+ :group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Picons")
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-mail-picon 'highlight t)
+
+(defcustom gnus-treat-newsgroups-picon
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
+ 'head nil)
+ "Display picons in the Newsgroups and Followup-To headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Picons' for details."
+ :group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :link '(custom-manual "(gnus)Picons")
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-newsgroups-picon 'highlight t)
+
+(defcustom gnus-treat-body-boundary
+ (if (or gnus-treat-newsgroups-picon
+ gnus-treat-mail-picon
+ gnus-treat-from-picon)
+ 'head nil)
+ "Draw a boundary at the end of the headers.
+Valid values are nil and `head'.
+See Info node `(gnus)Customizing Articles' for details."
+ :version "21.1"
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-picons 'highlight t)
(defcustom gnus-treat-capitalize-sentences nil
"Capitalize sentence-starting words.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-wash-html nil
+ "Format as HTML.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fill-long-lines nil
"Fill long lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-play-sounds nil
"Play sounds.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-translate nil
"Translate articles from one language to another.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
+(defcustom gnus-treat-x-pgp-sig nil
+ "Verify X-PGP-Sig.
+To automatically treat X-PGP-Sig, set it to head.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :group 'mime-security
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
+(defvar gnus-article-encrypt-protocol-alist
+ '(("PGP" . mml2015-self-encrypt)))
+
+;; Set to nil if more than one protocol added to
+;; gnus-article-encrypt-protocol-alist.
+(defcustom gnus-article-encrypt-protocol "PGP"
+ "The protocol used for encrypt articles.
+It is a string, such as \"PGP\". If nil, ask user."
+ :type 'string
+ :group 'mime-security)
+
+(defvar gnus-article-wash-function nil
+ "Function used for converting HTML into text.")
+
+(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
+ (mm-coding-system-p 'utf-8)
+ (executable-find idna-program))
+ "Whether IDNA decoding of headers is used when viewing messages.
+This requires GNU Libidn, and by default only enabled if it is found."
+ :group 'gnus-article-headers
+ :type 'boolean)
+
+(defcustom gnus-article-over-scroll nil
+ "If non-nil, allow scrolling the article buffer even when there no more text."
+ :group 'gnus-article
+ :type 'boolean)
+
;;; Internal variables
+(defvar gnus-english-month-names
+ '("January" "February" "March" "April" "May" "June" "July" "August"
+ "September" "October" "November" "December"))
+
(defvar article-goto-body-goes-to-point-min-p nil)
(defvar gnus-article-wash-types nil)
(defvar gnus-article-emphasis-alist nil)
+(defvar gnus-article-image-alist nil)
(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
- '((gnus-treat-strip-banner gnus-article-strip-banner)
+ '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
+ (gnus-treat-strip-banner gnus-article-strip-banner)
(gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
(gnus-treat-buttonize gnus-article-add-buttons)
(gnus-treat-fill-article gnus-article-fill-cited-article)
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
- (gnus-treat-emphasize gnus-article-emphasize)
- (gnus-treat-display-xface gnus-article-display-x-face)
+ (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
+ (gnus-treat-date-ut gnus-article-date-ut)
+ (gnus-treat-date-local gnus-article-date-local)
+ (gnus-treat-date-english gnus-article-date-english)
+ (gnus-treat-date-lapsed gnus-article-date-lapsed)
+ (gnus-treat-date-original gnus-article-date-original)
+ (gnus-treat-date-user-defined gnus-article-date-user)
+ (gnus-treat-date-iso8601 gnus-article-date-iso8601)
+ (gnus-treat-display-x-face gnus-article-display-x-face)
+ (gnus-treat-display-face gnus-article-display-face)
(gnus-treat-hide-headers gnus-article-maybe-hide-headers)
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
(gnus-treat-hide-signature gnus-article-hide-signature)
- (gnus-treat-hide-citation gnus-article-hide-citation)
- (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
(gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
- (gnus-treat-strip-pgp gnus-article-hide-pgp)
+ (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
(gnus-treat-strip-pem gnus-article-hide-pem)
+ (gnus-treat-from-picon gnus-treat-from-picon)
+ (gnus-treat-mail-picon gnus-treat-mail-picon)
+ (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
- (gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
- (gnus-treat-date-ut gnus-article-date-ut)
- (gnus-treat-date-local gnus-article-date-local)
- (gnus-treat-date-lapsed gnus-article-date-lapsed)
- (gnus-treat-date-original gnus-article-date-original)
- (gnus-treat-date-user-defined gnus-article-date-user)
- (gnus-treat-date-iso8601 gnus-article-date-iso8601)
(gnus-treat-strip-trailing-blank-lines
gnus-article-remove-trailing-blank-lines)
(gnus-treat-strip-leading-blank-lines
@@ -1033,10 +1409,18 @@ See the manual for details."
(gnus-treat-strip-multiple-blank-lines
gnus-article-strip-multiple-blank-lines)
(gnus-treat-overstrike gnus-article-treat-overstrike)
+ (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
+ (gnus-treat-fold-headers gnus-article-treat-fold-headers)
+ (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
- (gnus-treat-display-smileys gnus-smiley-display)
+ (gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
- (gnus-treat-display-picons gnus-article-display-picons)
+ (gnus-treat-wash-html gnus-article-wash-html)
+ (gnus-treat-emphasize gnus-article-emphasize)
+ (gnus-treat-hide-citation gnus-article-hide-citation)
+ (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
+ (gnus-treat-highlight-citation gnus-article-highlight-citation)
+ (gnus-treat-body-boundary gnus-article-treat-body-boundary)
(gnus-treat-play-sounds gnus-earcon-display)))
(defvar gnus-article-mime-handle-alist nil)
@@ -1045,9 +1429,13 @@ See the manual for details."
(defvar gnus-article-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
- (modify-syntax-entry ?- "w" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?< "(" table)
+ ;; This causes the citation match run O(2^n).
+ ;; (modify-syntax-entry ?- "w" table)
+ (modify-syntax-entry ?> ")<" table)
+ (modify-syntax-entry ?< "(>" table)
+ ;; make M-. in article buffers work for `foo' strings
+ (modify-syntax-entry ?' " " table)
+ (modify-syntax-entry ?` " " table)
table)
"Syntax table used in article mode buffers.
Initialized from `text-mode-syntax-table.")
@@ -1063,6 +1451,34 @@ Initialized from `text-mode-syntax-table.")
(defvar gnus-inhibit-hiding nil)
+;;; Macros for dealing with the article buffer.
+
+(defmacro gnus-with-article-headers (&rest forms)
+ `(save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t))
+ (article-narrow-to-head)
+ ,@forms))))
+
+(put 'gnus-with-article-headers 'lisp-indent-function 0)
+(put 'gnus-with-article-headers 'edebug-form-spec '(body))
+
+(defmacro gnus-with-article-buffer (&rest forms)
+ `(save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((inhibit-read-only t))
+ ,@forms)))
+
+(put 'gnus-with-article-buffer 'lisp-indent-function 0)
+(put 'gnus-with-article-buffer 'edebug-form-spec '(body))
+
+(defun gnus-article-goto-header (header)
+ "Go to HEADER, which is a regular expression."
+ (re-search-forward (concat "^\\(" header "\\):") nil t))
+
(defsubst gnus-article-hide-text (b e props)
"Set text PROPS on the B to E region, extending `intangible' 1 past B."
(gnus-add-text-properties-when 'article-type nil b e props)
@@ -1080,14 +1496,13 @@ Initialized from `text-mode-syntax-table.")
(defun gnus-article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
- (push type gnus-article-wash-types)
+ (gnus-add-wash-type type)
(gnus-article-hide-text
b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun gnus-article-unhide-text-type (b e type)
"Unhide text of TYPE between B and E."
- (setq gnus-article-wash-types
- (delq type gnus-article-wash-types))
+ (gnus-delete-wash-type type)
(remove-text-properties
b e (cons 'article-type (cons type gnus-hidden-properties)))
(when (memq 'intangible gnus-hidden-properties)
@@ -1127,38 +1542,48 @@ Initialized from `text-mode-syntax-table.")
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
- (i 0))
+ (i 1))
(while list
- (when (looking-at (car list))
- (setq list nil))
- (setq list (cdr list))
- (incf i))
- i))
+ (if (looking-at (car list))
+ (setq list nil)
+ (setq list (cdr list))
+ (incf i)))
+ i))
(defun article-hide-headers (&optional arg delete)
"Hide unwanted headers and possibly sort them as well."
(interactive)
;; This function might be inhibited.
(unless gnus-inhibit-hiding
- (save-excursion
- (save-restriction
- (let ((inhibit-read-only t)
- (case-fold-search t)
- (max (1+ (length gnus-sorted-header-list)))
- (ignored (when (not gnus-visible-headers)
- (cond ((stringp gnus-ignored-headers)
- gnus-ignored-headers)
- ((listp gnus-ignored-headers)
- (mapconcat 'identity gnus-ignored-headers
- "\\|")))))
- (visible
- (cond ((stringp gnus-visible-headers)
- gnus-visible-headers)
- ((and gnus-visible-headers
- (listp gnus-visible-headers))
- (mapconcat 'identity gnus-visible-headers "\\|"))))
- (inhibit-point-motion-hooks t)
- beg)
+ (let ((inhibit-read-only nil)
+ (case-fold-search t)
+ (max (1+ (length gnus-sorted-header-list)))
+ (inhibit-point-motion-hooks t)
+ (cur (current-buffer))
+ ignored visible beg)
+ (save-excursion
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
+ ;; group parameters, so we should go to the summary buffer.
+ (when (prog1
+ (condition-case nil
+ (progn (set-buffer gnus-summary-buffer) t)
+ (error nil))
+ (setq ignored (when (not gnus-visible-headers)
+ (cond ((stringp gnus-ignored-headers)
+ gnus-ignored-headers)
+ ((listp gnus-ignored-headers)
+ (mapconcat 'identity
+ gnus-ignored-headers
+ "\\|"))))
+ visible (cond ((stringp gnus-visible-headers)
+ gnus-visible-headers)
+ ((and gnus-visible-headers
+ (listp gnus-visible-headers))
+ (mapconcat 'identity
+ gnus-visible-headers
+ "\\|")))))
+ (set-buffer cur))
+ (save-restriction
;; First we narrow to just the headers.
(article-narrow-to-head)
;; Hide any "From " lines at the beginning of (mail) articles.
@@ -1171,7 +1596,7 @@ Initialized from `text-mode-syntax-table.")
;; `gnus-ignored-headers' and `gnus-visible-headers' to
;; select which header lines is to remain visible in the
;; article buffer.
- (while (re-search-forward "^[^ \t]*:" nil t)
+ (while (re-search-forward "^[^ \t:]*:" nil t)
(beginning-of-line)
;; Mark the rank of the header.
(put-text-property
@@ -1186,7 +1611,7 @@ Initialized from `text-mode-syntax-table.")
(when (setq beg (text-property-any
(point-min) (point-max) 'message-rank (+ 2 max)))
;; We delete the unwanted headers.
- (push 'headers gnus-article-wash-types)
+ (gnus-add-wash-type 'headers)
(add-text-properties (point-min) (+ 5 (point-min))
'(article-type headers dummy-invisible t))
(delete-region beg (point-max))))))))
@@ -1214,7 +1639,7 @@ always hide."
(while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
(forward-line -1)
(gnus-article-hide-text-type
- (progn (beginning-of-line) (point))
+ (gnus-point-at-bol)
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
@@ -1223,26 +1648,77 @@ always hide."
'boring-headers)))
;; Hide boring Newsgroups header.
((eq elem 'newsgroups)
- (when (equal (gnus-fetch-field "newsgroups")
- (gnus-group-real-name
- (if (boundp 'gnus-newsgroup-name)
- gnus-newsgroup-name
- "")))
+ (when (gnus-string-equal
+ (gnus-fetch-field "newsgroups")
+ (gnus-group-real-name
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name
+ "")))
(gnus-article-hide-header "newsgroups")))
+ ((eq elem 'to-address)
+ (let ((to (message-fetch-field "to"))
+ (to-address
+ (gnus-parameter-to-address
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name ""))))
+ (when (and to to-address
+ (ignore-errors
+ (gnus-string-equal
+ ;; only one address in To
+ (nth 1 (mail-extract-address-components to))
+ to-address)))
+ (gnus-article-hide-header "to"))))
+ ((eq elem 'to-list)
+ (let ((to (message-fetch-field "to"))
+ (to-list
+ (gnus-parameter-to-list
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name ""))))
+ (when (and to to-list
+ (ignore-errors
+ (gnus-string-equal
+ ;; only one address in To
+ (nth 1 (mail-extract-address-components to))
+ to-list)))
+ (gnus-article-hide-header "to"))))
+ ((eq elem 'cc-list)
+ (let ((cc (message-fetch-field "cc"))
+ (to-list
+ (gnus-parameter-to-list
+ (if (boundp 'gnus-newsgroup-name)
+ gnus-newsgroup-name ""))))
+ (when (and cc to-list
+ (ignore-errors
+ (gnus-string-equal
+ ;; only one address in CC
+ (nth 1 (mail-extract-address-components cc))
+ to-list)))
+ (gnus-article-hide-header "cc"))))
((eq elem 'followup-to)
- (when (equal (message-fetch-field "followup-to")
- (message-fetch-field "newsgroups"))
+ (when (gnus-string-equal
+ (message-fetch-field "followup-to")
+ (message-fetch-field "newsgroups"))
(gnus-article-hide-header "followup-to")))
((eq elem 'reply-to)
- (let ((from (message-fetch-field "from"))
- (reply-to (message-fetch-field "reply-to")))
- (when (and
+ (if (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to)
+ (gnus-article-hide-header "reply-to")
+ (let ((from (message-fetch-field "from"))
+ (reply-to (message-fetch-field "reply-to")))
+ (when
+ (and
from reply-to
(ignore-errors
(equal
- (nth 1 (mail-extract-address-components from))
- (nth 1 (mail-extract-address-components reply-to)))))
- (gnus-article-hide-header "reply-to"))))
+ (sort (mapcar
+ (lambda (x) (downcase (cadr x)))
+ (mail-extract-address-components from t))
+ 'string<)
+ (sort (mapcar
+ (lambda (x) (downcase (cadr x)))
+ (mail-extract-address-components reply-to t))
+ 'string<))))
+ (gnus-article-hide-header "reply-to")))))
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(when (and date
@@ -1289,7 +1765,7 @@ always hide."
(goto-char (point-min))
(when (re-search-forward (concat "^" header ":") nil t)
(gnus-article-hide-text-type
- (progn (beginning-of-line) (point))
+ (gnus-point-at-bol)
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
@@ -1329,14 +1805,15 @@ always hide."
(forward-line 1))))))
(defun article-treat-dumbquotes ()
- "Translate M****s*** sm*rtq**t*s into proper text.
+ "Translate M****s*** sm*rtq**t*s and other symbols into proper text.
Note that this function guesses whether a character is a sm*rtq**t* or
not, so it should only be used interactively.
-Sm*rtq**t*s are M****s***'s unilateral extension to the character map
-in an attempt to provide more quoting characters. If you see
-something like \\222 or \\264 where you're expecting some kind of
-apostrophe or quotation mark, then try this wash."
+Sm*rtq**t*s are M****s***'s unilateral extension to the
+iso-8859-1 character map in an attempt to provide more quoting
+characters. If you see something like \\222 or \\264 where
+you're expecting some kind of apostrophe or quotation mark, then
+try this wash."
(interactive)
(article-translate-strings gnus-article-dumbquotes-map))
@@ -1395,6 +1872,89 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(put-text-property
(point) (1+ (point)) 'face 'underline)))))))))
+(defun gnus-article-treat-unfold-headers ()
+ "Unfold folded message headers.
+Only the headers that fit into the current window width will be
+unfolded."
+ (interactive)
+ (gnus-with-article-headers
+ (let (length)
+ (while (not (eobp))
+ (save-restriction
+ (mail-header-narrow-to-field)
+ (let ((header (buffer-string)))
+ (with-temp-buffer
+ (insert header)
+ (goto-char (point-min))
+ (while (re-search-forward "\n[\t ]" nil t)
+ (replace-match " " t t)))
+ (setq length (- (point-max) (point-min) 1)))
+ (when (< length (window-width))
+ (while (re-search-forward "\n[\t ]" nil t)
+ (replace-match " " t t)))
+ (goto-char (point-max)))))))
+
+(defun gnus-article-treat-fold-headers ()
+ "Fold message headers."
+ (interactive)
+ (gnus-with-article-headers
+ (while (not (eobp))
+ (save-restriction
+ (mail-header-narrow-to-field)
+ (mail-header-fold-field)
+ (goto-char (point-max))))))
+
+(defun gnus-treat-smiley ()
+ "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
+ (interactive)
+ (gnus-with-article-buffer
+ (if (memq 'smiley gnus-article-wash-types)
+ (gnus-delete-images 'smiley)
+ (article-goto-body)
+ (let ((images (smiley-region (point) (point-max))))
+ (when images
+ (gnus-add-wash-type 'smiley)
+ (dolist (image images)
+ (gnus-add-image 'smiley image)))))))
+
+(defun gnus-article-remove-images ()
+ "Remove all images from the article buffer."
+ (interactive)
+ (gnus-with-article-buffer
+ (dolist (elem gnus-article-image-alist)
+ (gnus-delete-images (car elem)))))
+
+(defun gnus-article-treat-fold-newsgroups ()
+ "Unfold folded message headers.
+Only the headers that fit into the current window width will be
+unfolded."
+ (interactive)
+ (gnus-with-article-headers
+ (while (gnus-article-goto-header "newsgroups\\|followup-to")
+ (save-restriction
+ (mail-header-narrow-to-field)
+ (while (re-search-forward ", *" nil t)
+ (replace-match ", " t t))
+ (mail-header-fold-field)
+ (goto-char (point-max))))))
+
+(defun gnus-article-treat-body-boundary ()
+ "Place a boundary line at the end of the headers."
+ (interactive)
+ (when (and gnus-body-boundary-delimiter
+ (> (length gnus-body-boundary-delimiter) 0))
+ (gnus-with-article-headers
+ (goto-char (point-max))
+ (let ((start (point)))
+ (insert "X-Boundary: ")
+ (gnus-add-text-properties start (point) '(invisible t intangible t))
+ (insert (let (str)
+ (while (>= (1- (window-width)) (length str))
+ (setq str (concat str gnus-body-boundary-delimiter)))
+ (substring str 0 (1- (window-width))))
+ "\n")
+ (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
+
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
(interactive)
@@ -1407,9 +1967,11 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(while (not (eobp))
(end-of-line)
(when (>= (current-column) (min fill-column width))
- (narrow-to-region (point) (gnus-point-at-bol))
- (fill-paragraph nil)
- (goto-char (point-max))
+ (narrow-to-region (min (1+ (point)) (point-max))
+ (gnus-point-at-bol))
+ (let ((goback (point-marker)))
+ (fill-paragraph nil)
+ (goto-char (marker-position goback)))
(widen))
(forward-line 1)))))))
@@ -1453,56 +2015,107 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(forward-line 1)
(point))))))
+(defun article-display-face ()
+ "Display any Face headers in the header."
+ (interactive)
+ (let ((wash-face-p buffer-read-only))
+ (gnus-with-article-headers
+ ;; When displaying parts, this function can be called several times on
+ ;; the same article, without any intended toggle semantic (as typing `W
+ ;; D d' would have). So face deletion must occur only when we come from
+ ;; an interactive command, that is when the *Article* buffer is
+ ;; read-only.
+ (if (and wash-face-p (memq 'face gnus-article-wash-types))
+ (gnus-delete-images 'face)
+ (let (face faces)
+ (save-excursion
+ (when (and wash-face-p
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "^Face:[\t ]*" nil t)))
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ (set-buffer gnus-original-article-buffer))
+ (save-restriction
+ (mail-narrow-to-head)
+ (while (gnus-article-goto-header "Face")
+ (push (mail-header-field-value) faces))))
+ (while (setq face (pop faces))
+ (let ((png (gnus-convert-face-to-png face))
+ image)
+ (when png
+ (setq image (gnus-create-image png 'png t))
+ (gnus-article-goto-header "from")
+ (when (bobp)
+ (insert "From: [no `from' set]\n")
+ (forward-char -17))
+ (gnus-add-wash-type 'face)
+ (gnus-add-image 'face image)
+ (gnus-put-image image nil 'face))))))
+ )))
+
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
(interactive (list 'force))
- (save-excursion
- ;; Delete the old process, if any.
- (when (process-status "article-x-face")
- (delete-process "article-x-face"))
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t)
- from last)
- (save-restriction
- (article-narrow-to-head)
- (goto-char (point-min))
- (setq from (message-fetch-field "from"))
- (goto-char (point-min))
- (while (and gnus-article-x-face-command
- (not last)
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and gnus-article-x-face-too-ugly from
- (not (string-match gnus-article-x-face-too-ugly
- from))))
- ;; Has to be present.
- (re-search-forward "^X-Face: " nil t))
- ;; This used to try to do multiple faces (`while' instead of
- ;; `when' above), but (a) sending multiple EOFs to xv doesn't
- ;; work (b) it can crash some versions of Emacs (c) are
- ;; multiple faces really something to encourage?
- (when (stringp gnus-article-x-face-command)
- (setq last t))
- ;; We now have the area of the buffer where the X-Face is stored.
+ (let ((wash-face-p buffer-read-only)) ;; When type `W f'
+ (gnus-with-article-headers
+ ;; Delete the old process, if any.
+ (when (process-status "article-x-face")
+ (delete-process "article-x-face"))
+ ;; See the comment in `article-display-face'.
+ (if (and wash-face-p (memq 'xface gnus-article-wash-types))
+ ;; We have already displayed X-Faces, so we remove them
+ ;; instead.
+ (gnus-delete-images 'xface)
+ ;; Display X-Faces.
+ (let (x-faces from face)
(save-excursion
- (let ((beg (point))
- (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
- ;; We display the face.
- (if (symbolp gnus-article-x-face-command)
- ;; The command is a lisp function, so we call it.
- (if (gnus-functionp gnus-article-x-face-command)
- (funcall gnus-article-x-face-command beg end)
- (error "%s is not a function" gnus-article-x-face-command))
- ;; The command is a string, so we interpret the command
- ;; as a, well, command, and fork it off.
- (let ((process-connection-type nil))
- (process-kill-without-query
- (start-process
- "article-x-face" nil shell-file-name shell-command-switch
- gnus-article-x-face-command))
- (process-send-region "article-x-face" beg end)
- (process-send-eof "article-x-face"))))))))))
+ (when (and wash-face-p
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward
+ "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ ;; If type `W f', use gnus-original-article-buffer,
+ ;; otherwise use the current buffer because displaying
+ ;; RFC822 parts calls this function too.
+ (set-buffer gnus-original-article-buffer))
+ (save-restriction
+ (mail-narrow-to-head)
+ (while (gnus-article-goto-header "X-Face")
+ (push (mail-header-field-value) x-faces))
+ (setq from (message-fetch-field "from"))))
+ ;; Sending multiple EOFs to xv doesn't work, so we only do a
+ ;; single external face.
+ (when (stringp gnus-article-x-face-command)
+ (setq x-faces (list (car x-faces))))
+ (while (and (setq face (pop x-faces))
+ gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
+ from)))))
+ ;; We display the face.
+ (cond ((stringp gnus-article-x-face-command)
+ ;; The command is a string, so we interpret the command
+ ;; as a, well, command, and fork it off.
+ (let ((process-connection-type nil))
+ (process-kill-without-query
+ (start-process
+ "article-x-face" nil shell-file-name
+ shell-command-switch gnus-article-x-face-command))
+ (with-temp-buffer
+ (insert face)
+ (process-send-region "article-x-face"
+ (point-min) (point-max)))
+ (process-send-eof "article-x-face")))
+ ((functionp gnus-article-x-face-command)
+ ;; The command is a lisp function, so we call it.
+ (funcall gnus-article-x-face-command face))
+ (t
+ (error "%s is not a function"
+ gnus-article-x-face-command)))))))))
(defun article-decode-mime-words ()
"Decode all MIME-encoded words in the article."
@@ -1510,7 +2123,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(save-excursion
(set-buffer gnus-article-buffer)
(let ((inhibit-point-motion-hooks t)
- buffer-read-only
+ (inhibit-read-only t)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
@@ -1522,7 +2135,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
If PROMPT (the prefix), prompt for a coding system to use."
(interactive "P")
(let ((inhibit-point-motion-hooks t) (case-fold-search t)
- buffer-read-only
+ (inhibit-read-only t)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (condition-case nil
@@ -1572,16 +2185,78 @@ If PROMPT (the prefix), prompt for a coding system to use."
(set-buffer gnus-summary-buffer)
(error))
gnus-newsgroup-ignored-charsets))
- buffer-read-only)
+ (inhibit-read-only t))
(save-restriction
(article-narrow-to-head)
(funcall gnus-decode-header-function (point-min) (point-max)))))
-(defun article-de-quoted-unreadable (&optional force)
+(defun article-decode-group-name ()
+ "Decode group names in `Newsgroups:'."
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-read-only t)
+ (method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (when (and (or gnus-group-name-charset-method-alist
+ gnus-group-name-charset-group-alist)
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ (save-restriction
+ (article-narrow-to-head)
+ (with-current-buffer gnus-original-article-buffer
+ (goto-char (point-min)))
+ (while (re-search-forward
+ "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
+ (replace-match (save-match-data
+ (gnus-decode-newsgroups
+ ;; XXX how to use data in article buffer?
+ (with-current-buffer gnus-original-article-buffer
+ (re-search-forward
+ "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
+ nil t)
+ (match-string 1))
+ gnus-newsgroup-name method))
+ t t nil 1))
+ (goto-char (point-min))
+ (with-current-buffer gnus-original-article-buffer
+ (goto-char (point-min)))
+ (while (re-search-forward
+ "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
+ (replace-match (save-match-data
+ (gnus-decode-newsgroups
+ ;; XXX how to use data in article buffer?
+ (with-current-buffer gnus-original-article-buffer
+ (re-search-forward
+ "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
+ nil t)
+ (match-string 1))
+ gnus-newsgroup-name method))
+ t t nil 1))))))
+
+(autoload 'idna-to-unicode "idna")
+
+(defun article-decode-idna-rhs ()
+ "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer."
+ (when gnus-use-idna
+ (save-restriction
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-read-only t))
+ (article-narrow-to-head)
+ (goto-char (point-min))
+ (while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
+ (let (ace unicode)
+ (when (save-match-data
+ (and (setq ace (match-string 1))
+ (save-excursion
+ (and (re-search-backward "^[^ \t]" nil t)
+ (looking-at "From\\|To\\|Cc")))
+ (setq unicode (idna-to-unicode ace))))
+ (unless (string= ace unicode)
+ (replace-match unicode nil nil nil 1)))))))))
+
+(defun article-de-quoted-unreadable (&optional force read-charset)
"Translate a quoted-printable-encoded article.
If FORCE, decode the article whether it is marked as quoted-printable
-or not."
- (interactive (list 'force))
+or not.
+If READ-CHARSET, ask for a coding system."
+ (interactive (list 'force current-prefix-arg))
(save-excursion
(let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
@@ -1596,6 +2271,8 @@ or not."
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
+ (if read-charset
+ (setq charset (mm-read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
@@ -1605,10 +2282,11 @@ or not."
(quoted-printable-decode-region
(point) (point-max) (mm-charset-to-coding-system charset))))))
-(defun article-de-base64-unreadable (&optional force)
+(defun article-de-base64-unreadable (&optional force read-charset)
"Translate a base64 article.
-If FORCE, decode the article whether it is marked as base64 not."
- (interactive (list 'force))
+If FORCE, decode the article whether it is marked as base64 not.
+If READ-CHARSET, ask for a coding system."
+ (interactive (list 'force current-prefix-arg))
(save-excursion
(let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
@@ -1623,6 +2301,8 @@ If FORCE, decode the article whether it is marked as base64 not."
(mail-content-type-get ctl 'charset)))
(if (stringp charset)
(setq charset (intern (downcase charset)))))))
+ (if read-charset
+ (setq charset (mm-read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(when (or force
@@ -1646,94 +2326,104 @@ If FORCE, decode the article whether it is marked as base64 not."
(let ((inhibit-read-only t))
(rfc1843-decode-region (point-min) (point-max)))))
-(defun article-wash-html ()
- "Format an html article."
+(defun article-unsplit-urls ()
+ "Remove the newlines that some other mailers insert into URLs."
(interactive)
(save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+ (replace-match "\\1\\3" t)))
+ (when (interactive-p)
+ (gnus-treat-article nil))))
+
+
+(defun article-wash-html (&optional read-charset)
+ "Format an HTML article.
+If READ-CHARSET, ask for a coding system."
+ (interactive "P")
+ (save-excursion
(let ((inhibit-read-only t)
charset)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
- (ignore-errors
- (mail-header-parse-content-type ct)))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (if (stringp charset)
- (setq charset (intern (downcase charset)))))))
+ (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
+ (let* ((ct (gnus-fetch-field "content-type"))
+ (ctl (and ct
+ (ignore-errors
+ (mail-header-parse-content-type ct)))))
+ (setq charset (and ctl
+ (mail-content-type-get ctl 'charset)))
+ (when (stringp charset)
+ (setq charset (intern (downcase charset)))))))
+ (when read-charset
+ (setq charset (mm-read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(article-goto-body)
(save-window-excursion
(save-restriction
(narrow-to-region (point) (point-max))
- (mm-setup-w3)
- (let ((w3-strict-width (window-width))
- (url-gateway-unplugged t)
- (url-standalone-mode t))
- (condition-case var
- (w3-region (point-min) (point-max))
- (error))))))))
+ (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
+ (entry (assq func mm-text-html-washer-alist)))
+ (when entry
+ (setq func (cdr entry)))
+ (cond
+ ((functionp func)
+ (funcall func))
+ (t
+ (apply (car func) (cdr func))))))))))
+
+(defun gnus-article-wash-html-with-w3 ()
+ "Wash the current buffer with w3."
+ (mm-setup-w3)
+ (let ((w3-strict-width (window-width))
+ (url-standalone-mode t)
+ (url-gateway-unplugged t)
+ (w3-honor-stylesheets nil))
+ (condition-case ()
+ (w3-region (point-min) (point-max))
+ (error))))
+
+(defun gnus-article-wash-html-with-w3m ()
+ "Wash the current buffer with emacs-w3m."
+ (mm-setup-w3m)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
+ w3m-force-redisplay)
+ (w3m-region (point-min) (point-max)))
+ (when (and mm-inline-text-html-with-w3m-keymap
+ (boundp 'w3m-minor-mode-map)
+ w3m-minor-mode-map)
+ (add-text-properties
+ (point-min) (point-max)
+ (list 'keymap w3m-minor-mode-map
+ ;; Put the mark meaning this part was rendered by emacs-w3m.
+ 'mm-inline-text-html-with-w3m t)))))
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(interactive)
- (save-excursion
- (save-restriction
- (let ((inhibit-point-motion-hooks t)
- buffer-read-only)
- (article-narrow-to-head)
- (let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers
- (mapconcat 'identity gnus-list-identifiers " *\\|"))))
- (when regexp
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp
- " *\\)\\)+\\(Re: +\\)?\\)")
- nil t)
- (let ((s (or (match-string 3) (match-string 5))))
- (delete-region (match-beginning 1) (match-end 1))
- (when s
- (goto-char (match-beginning 1))
- (insert s))))))))))
-
-(defun article-hide-pgp ()
- "Remove any PGP headers and signatures in the current article."
- (interactive)
- (save-excursion
- (save-restriction
- (let ((inhibit-point-motion-hooks t)
- buffer-read-only beg end)
- (article-goto-body)
- ;; Hide the "header".
- (when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (push 'pgp gnus-article-wash-types)
- (delete-region (match-beginning 0) (match-end 0))
- ;; Remove armor headers (rfc2440 6.2)
- (delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t)
- (point)))
- (setq beg (point))
- ;; Hide the actual signature.
- (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
- (setq end (1+ (match-beginning 0)))
- (delete-region
- end
- (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
- (match-end 0)
- ;; Perhaps we shouldn't hide to the end of the buffer
- ;; if there is no end to the signature?
- (point-max))))
- ;; Hide "- " PGP quotation markers.
- (when (and beg end)
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (re-search-forward "^- " nil t)
- (delete-region
- (match-beginning 0) (match-end 0)))
- (widen))
- (gnus-run-hooks 'gnus-article-hide-pgp-hook))))))
+ (let ((inhibit-point-motion-hooks t)
+ (regexp (if (consp gnus-list-identifiers)
+ (mapconcat 'identity gnus-list-identifiers " *\\|")
+ gnus-list-identifiers))
+ (inhibit-read-only t))
+ (when regexp
+ (save-excursion
+ (save-restriction
+ (article-narrow-to-head)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
+ nil t)
+ (delete-region (match-beginning 2) (match-end 0))
+ (beginning-of-line))
+ (when (re-search-forward
+ "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t)
+ (delete-region (match-beginning 1) (match-end 1))))))))
(defun article-hide-pem (&optional arg)
"Toggle hiding of any PEM headers and signatures in the current article.
@@ -1742,14 +2432,14 @@ always hide."
(interactive (gnus-article-hidden-arg))
(unless (gnus-article-check-hidden-text 'pem arg)
(save-excursion
- (let (buffer-read-only end)
+ (let ((inhibit-read-only t) end)
(goto-char (point-min))
;; Hide the horrendously ugly "header".
(when (and (search-forward
"\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
nil t)
(setq end (1+ (match-beginning 0))))
- (push 'pem gnus-article-wash-types)
+ (gnus-add-wash-type 'pem)
(gnus-article-hide-text-type
end
(if (search-forward "\n\n" nil t)
@@ -1763,29 +2453,50 @@ always hide."
(match-beginning 0) (match-end 0) 'pem)))))))
(defun article-strip-banner ()
- "Strip the banner specified by the `banner' group parameter."
+ "Strip the banners specified by the `banner' group parameter and by
+`gnus-article-address-banner-alist'."
(interactive)
(save-excursion
(save-restriction
+ (let ((inhibit-point-motion-hooks t))
+ (when (gnus-parameter-banner gnus-newsgroup-name)
+ (article-really-strip-banner
+ (gnus-parameter-banner gnus-newsgroup-name)))
+ (when gnus-article-address-banner-alist
+ (article-really-strip-banner
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (mail-fetch-field "from"))))
+ (when (and from
+ (setq from
+ (caar (mail-header-parse-addresses from))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found (cdr pair)))))))))))))
+
+(defun article-really-strip-banner (banner)
+ "Strip the banner specified by the argument."
+ (save-excursion
+ (save-restriction
(let ((inhibit-point-motion-hooks t)
- (banner (gnus-group-find-parameter gnus-newsgroup-name 'banner))
(gnus-signature-limit nil)
- buffer-read-only beg end)
- (when banner
- (article-goto-body)
- (cond
- ((eq banner 'signature)
- (when (gnus-article-narrow-to-signature)
- (widen)
- (forward-line -1)
- (delete-region (point) (point-max))))
- ((symbolp banner)
- (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
- (while (re-search-forward banner nil t)
- (delete-region (match-beginning 0) (match-end 0)))))
- ((stringp banner)
- (while (re-search-forward banner nil t)
- (delete-region (match-beginning 0) (match-end 0))))))))))
+ (inhibit-read-only t))
+ (article-goto-body)
+ (cond
+ ((eq banner 'signature)
+ (when (gnus-article-narrow-to-signature)
+ (widen)
+ (forward-line -1)
+ (delete-region (point) (point-max))))
+ ((symbolp banner)
+ (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
+ (while (re-search-forward banner nil t)
+ (delete-region (match-beginning 0) (match-end 0)))))
+ ((stringp banner)
+ (while (re-search-forward banner nil t)
+ (delete-region (match-beginning 0) (match-end 0)))))))))
(defun article-babel ()
"Translate article using an online translation service."
@@ -1798,11 +2509,11 @@ always hide."
(start (point))
(end (point-max))
(orig (buffer-substring start end))
- (trans (babel-as-string orig)))
+ (trans (babel-as-string orig)))
(save-restriction
(narrow-to-region start end)
(delete-region start end)
- (insert trans))))))
+ (insert trans))))))
(defun article-hide-signature (&optional arg)
"Hide the signature in the current article.
@@ -1815,7 +2526,8 @@ always hide."
(let ((inhibit-read-only t))
(when (gnus-article-narrow-to-signature)
(gnus-article-hide-text-type
- (point-min) (point-max) 'signature)))))))
+ (point-min) (point-max) 'signature))))))
+ (gnus-set-mode-line 'article))
(defun article-strip-headers-in-body ()
"Strip offensive headers from bodies."
@@ -1831,7 +2543,7 @@ always hide."
(interactive)
(save-excursion
(let ((inhibit-point-motion-hooks t)
- buffer-read-only)
+ (inhibit-read-only t))
(when (article-goto-body)
(while (and (not (eobp))
(looking-at "[ \t]*$"))
@@ -1866,7 +2578,7 @@ Point is left at the beginning of the narrowed-to region."
(interactive)
(save-excursion
(let ((inhibit-point-motion-hooks t)
- buffer-read-only)
+ (inhibit-read-only t))
;; First make all blank lines empty.
(article-goto-body)
(while (re-search-forward "^[ \t]+$" nil t)
@@ -1875,17 +2587,17 @@ Point is left at the beginning of the narrowed-to region."
(replace-match "" nil t)))
;; Then replace multiple empty lines with a single empty line.
(article-goto-body)
- (while (re-search-forward "\n\n\n+" nil t)
+ (while (re-search-forward "\n\n\\(\n+\\)" nil t)
(unless (gnus-annotation-in-region-p
(match-beginning 0) (match-end 0))
- (replace-match "\n\n" t t))))))
+ (delete-region (match-beginning 1) (match-end 1)))))))
(defun article-strip-leading-space ()
"Remove all white space from the beginning of the lines in the article."
(interactive)
(save-excursion
(let ((inhibit-point-motion-hooks t)
- buffer-read-only)
+ (inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "" t t)))))
@@ -1895,7 +2607,7 @@ Point is left at the beginning of the narrowed-to region."
(interactive)
(save-excursion
(let ((inhibit-point-motion-hooks t)
- buffer-read-only)
+ (inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "[ \t]+$" nil t)
(replace-match "" t t)))))
@@ -1912,7 +2624,7 @@ Point is left at the beginning of the narrowed-to region."
(interactive)
(save-excursion
(let ((inhibit-point-motion-hooks t)
- buffer-read-only)
+ (inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "^[ \t]*\n" nil t)
(replace-match "" t t)))))
@@ -1932,7 +2644,7 @@ Point is left at the beginning of the narrowed-to region."
(< (- (point-max) (point)) limit))
(and (floatp limit)
(< (count-lines (point) (point-max)) limit))
- (and (gnus-functionp limit)
+ (and (functionp limit)
(funcall limit))
(and (stringp limit)
(not (re-search-forward limit nil t))))
@@ -2007,7 +2719,8 @@ Originally it is hide instead of DUMMY."
'article-type type
(point-min) (point-max)
(cons 'article-type (cons type
- gnus-hidden-properties)))))
+ gnus-hidden-properties)))
+ (gnus-delete-wash-type type)))
(defconst article-time-units
`((year . ,(* 365.25 24 60 60))
@@ -2018,6 +2731,17 @@ Originally it is hide instead of DUMMY."
(second . 1))
"Mapping from time units to seconds.")
+(defun gnus-article-forward-header ()
+ "Move point to the start of the next header.
+If the current header is a continuation header, this can be several
+lines forward."
+ (let ((ended nil))
+ (while (not ended)
+ (forward-line 1)
+ (if (looking-at "[ \t]+[^ \t]")
+ (forward-line 1)
+ (setq ended t)))))
+
(defun article-date-ut (&optional type highlight header)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
@@ -2029,7 +2753,7 @@ should replace the \"Date:\" one, or should be added below it."
(message-fetch-field "date")
""))
(tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
- (date-regexp
+ (date-regexp
(cond
((not gnus-article-date-lapsed-new-header)
tdate-regexp)
@@ -2055,19 +2779,24 @@ should replace the \"Date:\" one, or should be added below it."
(when (and date (not (string= date "")))
(goto-char (point-min))
(let ((inhibit-read-only t))
- ;; Delete any old Date headers.
- (while (re-search-forward date-regexp nil t)
+ ;; Delete any old Date headers.
+ (while (re-search-forward date-regexp nil t)
(if pos
(delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))
+ (progn (gnus-article-forward-header)
+ (point)))
(delete-region (progn (beginning-of-line) (point))
- (progn (end-of-line) (point)))
+ (progn (gnus-article-forward-header)
+ (forward-char -1)
+ (point)))
(setq pos (point))))
- (when (and (not pos) (re-search-forward tdate-regexp nil t))
+ (when (and (not pos)
+ (re-search-forward tdate-regexp nil t))
(forward-line 1))
- (if pos (goto-char pos))
+ (when pos
+ (goto-char pos))
(insert (article-make-date-line date (or type 'ut)))
- (when (not pos)
+ (unless pos
(insert "\n")
(forward-line -1))
;; Do highlighting.
@@ -2082,103 +2811,130 @@ should replace the \"Date:\" one, or should be added below it."
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
- (let ((time (condition-case ()
- (date-to-time date)
- (error '(0 0)))))
- (cond
- ;; Convert to the local timezone. We have to slap a
- ;; `condition-case' round the calls to the timezone
- ;; functions since they aren't particularly resistant to
- ;; buggy dates.
- ((eq type 'local)
- (let ((tz (car (current-time-zone time))))
- (format "Date: %s %s%02d%02d" (current-time-string time)
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
- (/ (% (abs tz) 3600) 60))))
- ;; Convert to Universal Time.
- ((eq type 'ut)
- (concat "Date: "
- (current-time-string
- (let* ((e (parse-time-string date))
- (tm (apply 'encode-time e))
- (ms (car tm))
- (ls (- (cadr tm) (car (current-time-zone time)))))
- (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
- ((> ls 65535) (list (1+ ms) (- ls 65536)))
- (t (list ms ls)))))
- " UT"))
- ;; Get the original date from the article.
- ((eq type 'original)
- (concat "Date: " (if (string-match "\n+$" date)
- (substring date 0 (match-beginning 0))
- date)))
- ;; Let the user define the format.
- ((eq type 'user)
- (if (gnus-functionp gnus-article-time-format)
- (funcall gnus-article-time-format time)
- (concat
- "Date: "
- (format-time-string gnus-article-time-format time))))
- ;; ISO 8601.
- ((eq type 'iso8601)
- (let ((tz (car (current-time-zone time))))
- (concat
- "Date: "
- (format-time-string "%Y%m%dT%H%M%S" time)
- (format "%s%02d%02d"
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
- (/ (% (abs tz) 3600) 60)))))
- ;; Do an X-Sent lapsed format.
- ((eq type 'lapsed)
- ;; If the date is seriously mangled, the timezone functions are
- ;; liable to bug out, so we ignore all errors.
- (let* ((now (current-time))
- (real-time (subtract-time now time))
- (real-sec (and real-time
- (+ (* (float (car real-time)) 65536)
- (cadr real-time))))
- (sec (and real-time (abs real-sec)))
- num prev)
+ (unless (memq type '(local ut original user iso8601 lapsed english))
+ (error "Unknown conversion type: %s" type))
+ (condition-case ()
+ (let ((time (date-to-time date)))
(cond
- ((null real-time)
- "X-Sent: Unknown")
- ((zerop sec)
- "X-Sent: Now")
- (t
- (concat
- "X-Sent: "
- ;; This is a bit convoluted, but basically we go
- ;; through the time units for years, weeks, etc,
- ;; and divide things to see whether that results
- ;; in positive answers.
- (mapconcat
- (lambda (unit)
- (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
- ;; The (remaining) seconds are too few to
- ;; be divided into this time unit.
- ""
- ;; It's big enough, so we output it.
- (setq sec (- sec (* num (cdr unit))))
- (prog1
- (concat (if prev ", " "") (int-to-string
- (floor num))
- " " (symbol-name (car unit))
- (if (> num 1) "s" ""))
- (setq prev t))))
- article-time-units "")
- ;; If dates are odd, then it might appear like the
- ;; article was sent in the future.
- (if (> real-sec 0)
- " ago"
- " in the future"))))))
- (t
- (error "Unknown conversion type: %s" type)))))
+ ;; Convert to the local timezone.
+ ((eq type 'local)
+ (let ((tz (car (current-time-zone time))))
+ (format "Date: %s %s%02d%02d" (current-time-string time)
+ (if (> tz 0) "+" "-") (/ (abs tz) 3600)
+ (/ (% (abs tz) 3600) 60))))
+ ;; Convert to Universal Time.
+ ((eq type 'ut)
+ (concat "Date: "
+ (current-time-string
+ (let* ((e (parse-time-string date))
+ (tm (apply 'encode-time e))
+ (ms (car tm))
+ (ls (- (cadr tm) (car (current-time-zone time)))))
+ (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+ ((> ls 65535) (list (1+ ms) (- ls 65536)))
+ (t (list ms ls)))))
+ " UT"))
+ ;; Get the original date from the article.
+ ((eq type 'original)
+ (concat "Date: " (if (string-match "\n+$" date)
+ (substring date 0 (match-beginning 0))
+ date)))
+ ;; Let the user define the format.
+ ((eq type 'user)
+ (let ((format (or (condition-case nil
+ (with-current-buffer gnus-summary-buffer
+ gnus-article-time-format)
+ (error nil))
+ gnus-article-time-format)))
+ (if (functionp format)
+ (funcall format time)
+ (concat "Date: " (format-time-string format time)))))
+ ;; ISO 8601.
+ ((eq type 'iso8601)
+ (let ((tz (car (current-time-zone time))))
+ (concat
+ "Date: "
+ (format-time-string "%Y%m%dT%H%M%S" time)
+ (format "%s%02d%02d"
+ (if (> tz 0) "+" "-") (/ (abs tz) 3600)
+ (/ (% (abs tz) 3600) 60)))))
+ ;; Do an X-Sent lapsed format.
+ ((eq type 'lapsed)
+ ;; If the date is seriously mangled, the timezone functions are
+ ;; liable to bug out, so we ignore all errors.
+ (let* ((now (current-time))
+ (real-time (subtract-time now time))
+ (real-sec (and real-time
+ (+ (* (float (car real-time)) 65536)
+ (cadr real-time))))
+ (sec (and real-time (abs real-sec)))
+ num prev)
+ (cond
+ ((null real-time)
+ "X-Sent: Unknown")
+ ((zerop sec)
+ "X-Sent: Now")
+ (t
+ (concat
+ "X-Sent: "
+ ;; This is a bit convoluted, but basically we go
+ ;; through the time units for years, weeks, etc,
+ ;; and divide things to see whether that results
+ ;; in positive answers.
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ;; The (remaining) seconds are too few to
+ ;; be divided into this time unit.
+ ""
+ ;; It's big enough, so we output it.
+ (setq sec (- sec (* num (cdr unit))))
+ (prog1
+ (concat (if prev ", " "") (int-to-string
+ (floor num))
+ " " (symbol-name (car unit))
+ (if (> num 1) "s" ""))
+ (setq prev t))))
+ article-time-units "")
+ ;; If dates are odd, then it might appear like the
+ ;; article was sent in the future.
+ (if (> real-sec 0)
+ " ago"
+ " in the future"))))))
+ ;; Display the date in proper English
+ ((eq type 'english)
+ (let ((dtime (decode-time time)))
+ (concat
+ "Date: the "
+ (number-to-string (nth 3 dtime))
+ (let ((digit (% (nth 3 dtime) 10)))
+ (cond
+ ((memq (nth 3 dtime) '(11 12 13)) "th")
+ ((= digit 1) "st")
+ ((= digit 2) "nd")
+ ((= digit 3) "rd")
+ (t "th")))
+ " of "
+ (nth (1- (nth 4 dtime)) gnus-english-month-names)
+ " "
+ (number-to-string (nth 5 dtime))
+ " at "
+ (format "%02d" (nth 2 dtime))
+ ":"
+ (format "%02d" (nth 1 dtime)))))))
+ (error
+ (format "Date: %s (from Gnus)" date))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(interactive (list t))
(article-date-ut 'local highlight))
+(defun article-date-english (&optional highlight)
+ "Convert the current article date to something that is proper English."
+ (interactive (list t))
+ (article-date-ut 'english highlight))
+
(defun article-date-original (&optional highlight)
"Convert the current article date to what it was originally.
This is only useful if you have used some other date conversion
@@ -2200,9 +2956,12 @@ function and want to see what the date was before converting."
(lambda (w)
(set-buffer (window-buffer w))
(when (eq major-mode 'gnus-article-mode)
- (goto-char (point-min))
- (when (re-search-forward "^X-Sent:" nil t)
- (article-date-lapsed t))))
+ (let ((mark (point-marker)))
+ (goto-char (point-min))
+ (when (re-search-forward "^X-Sent:" nil t)
+ (article-date-lapsed t))
+ (goto-char (marker-position mark))
+ (move-marker mark nil))))
nil 'visible)))))
(defun gnus-start-date-timer (&optional n)
@@ -2234,12 +2993,23 @@ This format is defined by the `gnus-article-time-format' variable."
(interactive (list t))
(article-date-ut 'iso8601 highlight))
-(defun article-show-all ()
- "Show all hidden text in the article buffer."
+;; (defun article-show-all ()
+;; "Show all hidden text in the article buffer."
+;; (interactive)
+;; (save-excursion
+;; (let ((inhibit-read-only t))
+;; (gnus-article-unhide-text (point-min) (point-max)))))
+
+(defun article-remove-leading-whitespace ()
+ "Remove excessive whitespace from all headers."
(interactive)
(save-excursion
- (let ((inhibit-read-only t))
- (gnus-article-unhide-text (point-min) (point-max)))))
+ (save-restriction
+ (let ((inhibit-read-only t))
+ (article-narrow-to-head)
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t)
+ (delete-region (match-beginning 1) (match-end 1)))))))
(defun article-emphasize (&optional arg)
"Emphasize text according to `gnus-emphasis-alist'."
@@ -2265,15 +3035,15 @@ This format is defined by the `gnus-article-time-format' variable."
visible (nth 2 elem)
face (nth 3 elem))
(while (re-search-forward regexp nil t)
- (when (and (match-beginning visible) (match-beginning invisible))
- (push 'emphasis gnus-article-wash-types)
- (gnus-article-hide-text
- (match-beginning invisible) (match-end invisible) props)
- (gnus-article-unhide-text-type
- (match-beginning visible) (match-end visible) 'emphasis)
- (gnus-put-text-property-excluding-newlines
- (match-beginning visible) (match-end visible) 'face face)
- (goto-char (match-end invisible)))))))))
+ (when (and (match-beginning visible) (match-beginning invisible))
+ (gnus-article-hide-text
+ (match-beginning invisible) (match-end invisible) props)
+ (gnus-article-unhide-text-type
+ (match-beginning visible) (match-end visible) 'emphasis)
+ (gnus-put-overlay-excluding-newlines
+ (match-beginning visible) (match-end visible) 'face face)
+ (gnus-add-wash-type 'emphasis)
+ (goto-char (match-end invisible)))))))))
(defun gnus-article-setup-highlight-words (&optional highlight-words)
"Setup newsgroup emphasis alist."
@@ -2375,7 +3145,8 @@ This format is defined by the `gnus-article-time-format' variable."
;; A single split name was found
((= 1 (length split-name))
(let* ((name (expand-file-name
- (car split-name) gnus-article-save-directory))
+ (car split-name)
+ gnus-article-save-directory))
(dir (cond ((file-directory-p name)
(file-name-as-directory name))
((file-exists-p name) name)
@@ -2399,9 +3170,10 @@ This format is defined by the `gnus-article-time-format' variable."
(car (push result file-name-history)))))))
;; Create the directory.
(gnus-make-directory (file-name-directory file))
- ;; If we have read a directory, we append the default file name.
+ ;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
- (setq file (expand-file-name (file-name-nondirectory default-name)
+ (setq file (expand-file-name (file-name-nondirectory
+ default-name)
(file-name-as-directory file))))
;; Possibly translate some characters.
(nnheader-translate-file-chars file))))))
@@ -2448,6 +3220,7 @@ Directory to save to is default to `gnus-article-save-directory'."
(save-restriction
(widen)
(if (and (file-readable-p filename)
+ (file-regular-p filename)
(mail-file-babyl-p filename))
(rmail-output-to-rmail-file filename t)
(gnus-output-to-mail filename)))))
@@ -2472,7 +3245,7 @@ Directory to save to is default to `gnus-article-save-directory'."
filename)
(defun gnus-summary-write-to-file (&optional filename)
- "Write this article to a file.
+ "Write this article to a file, overwriting it if the file exists.
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
(gnus-summary-save-in-file nil t))
@@ -2521,6 +3294,21 @@ The directory to save in defaults to `gnus-article-save-directory'."
(shell-command-on-region (point-min) (point-max) command nil)))
(setq gnus-last-shell-command command))
+(defmacro gnus-read-string (prompt &optional initial-contents history
+ default-value)
+ "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
+ (if (and (featurep 'xemacs)
+ (< emacs-minor-version 2))
+ `(read-string ,prompt ,initial-contents ,history)
+ `(read-string ,prompt ,initial-contents ,history ,default-value)))
+
+(defun gnus-summary-pipe-to-muttprint (&optional command)
+ "Pipe this article to muttprint."
+ (setq command (gnus-read-string
+ "Print using command: " gnus-summary-muttprint-program
+ nil gnus-summary-muttprint-program))
+ (gnus-summary-save-in-pipe command))
+
;;; Article file names when saving.
(defun gnus-capitalize-newsgroup (newsgroup)
@@ -2573,9 +3361,100 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(expand-file-name
(if (gnus-use-long-file-name 'not-save)
newsgroup
- (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)))
+ (file-relative-name
+ (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))
+ default-directory))
gnus-article-save-directory)))
+(defun gnus-sender-save-name (newsgroup headers &optional last-file)
+ "Generate file name from sender."
+ (let ((from (mail-header-from headers)))
+ (expand-file-name
+ (if (and from (string-match "\\([^ <]+\\)@" from))
+ (match-string 1 from)
+ "nobody")
+ gnus-article-save-directory)))
+
+(defun article-verify-x-pgp-sig ()
+ "Verify X-PGP-Sig."
+ (interactive)
+ (if (gnus-buffer-live-p gnus-original-article-buffer)
+ (let ((sig (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "X-PGP-Sig")))
+ items info headers)
+ (when (and sig
+ mml2015-use
+ (mml2015-clear-verify-function))
+ (with-temp-buffer
+ (insert-buffer-substring gnus-original-article-buffer)
+ (setq items (split-string sig))
+ (message-narrow-to-head)
+ (let ((inhibit-point-motion-hooks t)
+ (case-fold-search t))
+ ;; Don't verify multiple headers.
+ (setq headers (mapconcat (lambda (header)
+ (concat header ": "
+ (mail-fetch-field header)
+ "\n"))
+ (split-string (nth 1 items) ",") "")))
+ (delete-region (point-min) (point-max))
+ (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n")
+ (insert "X-Signed-Headers: " (nth 1 items) "\n")
+ (insert headers)
+ (widen)
+ (forward-line)
+ (while (not (eobp))
+ (if (looking-at "^-")
+ (insert "- "))
+ (forward-line))
+ (insert "\n-----BEGIN PGP SIGNATURE-----\n")
+ (insert "Version: " (car items) "\n\n")
+ (insert (mapconcat 'identity (cddr items) "\n"))
+ (insert "\n-----END PGP SIGNATURE-----\n")
+ (let ((mm-security-handle (list (format "multipart/signed"))))
+ (mml2015-clean-buffer)
+ (let ((coding-system-for-write (or gnus-newsgroup-charset
+ 'iso-8859-1)))
+ (funcall (mml2015-clear-verify-function)))
+ (setq info
+ (or (mm-handle-multipart-ctl-parameter
+ mm-security-handle 'gnus-details)
+ (mm-handle-multipart-ctl-parameter
+ mm-security-handle 'gnus-info)))))
+ (when info
+ (let ((inhibit-read-only t) bface eface)
+ (save-restriction
+ (message-narrow-to-head)
+ (goto-char (point-max))
+ (forward-line -1)
+ (setq bface (get-text-property (gnus-point-at-bol) 'face)
+ eface (get-text-property (1- (gnus-point-at-eol)) 'face))
+ (message-remove-header "X-Gnus-PGP-Verify")
+ (if (re-search-forward "^X-PGP-Sig:" nil t)
+ (forward-line)
+ (goto-char (point-max)))
+ (narrow-to-region (point) (point))
+ (insert "X-Gnus-PGP-Verify: " info "\n")
+ (goto-char (point-min))
+ (forward-line)
+ (while (not (eobp))
+ (if (not (looking-at "^[ \t]"))
+ (insert " "))
+ (forward-line))
+ ;; Do highlighting.
+ (goto-char (point-min))
+ (when (looking-at "\\([^:]+\\): *")
+ (put-text-property (match-beginning 1) (1+ (match-end 1))
+ 'face bface)
+ (put-text-property (match-end 0) (point-max)
+ 'face eface)))))))))
+
+(defun article-verify-cancel-lock ()
+ "Verify Cancel-Lock header."
+ (interactive)
+ (if (gnus-buffer-live-p gnus-original-article-buffer)
+ (canlock-verify gnus-original-article-buffer)))
+
(eval-and-compile
(mapcar
(lambda (func)
@@ -2586,7 +3465,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(setq afunc func
gfunc (intern (format "gnus-%s" func))))
(defalias gfunc
- (if (fboundp afunc)
+ (when (fboundp afunc)
`(lambda (&optional interactive &rest args)
,(documentation afunc t)
(interactive (list t))
@@ -2596,18 +3475,22 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(call-interactively ',afunc)
(apply ',afunc args))))))))
'(article-hide-headers
+ article-verify-x-pgp-sig
+ article-verify-cancel-lock
article-hide-boring-headers
article-treat-overstrike
article-fill-long-lines
article-capitalize-sentences
article-remove-cr
+ article-remove-leading-whitespace
article-display-x-face
+ article-display-face
article-de-quoted-unreadable
article-de-base64-unreadable
article-decode-HZ
article-wash-html
+ article-unsplit-urls
article-hide-list-identifiers
- article-hide-pgp
article-strip-banner
article-babel
article-hide-pem
@@ -2621,6 +3504,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
article-strip-blank-lines
article-strip-all-blank-lines
article-date-local
+ article-date-english
article-date-iso8601
article-date-original
article-date-ut
@@ -2632,7 +3516,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
article-emphasize
article-treat-dumbquotes
article-normalize-headers
- (article-show-all . gnus-article-show-all-headers))))
+;; (article-show-all . gnus-article-show-all-headers)
+ )))
;;;
;;; Gnus article mode
@@ -2657,6 +3542,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
">" end-of-buffer
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug
+ "R" gnus-article-reply-with-original
+ "F" gnus-article-followup-with-original
"\C-hk" gnus-article-describe-key
"\C-hc" gnus-article-describe-key-briefly
@@ -2669,9 +3556,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(substitute-key-definition
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
-(defvar gnus-article-post-menu nil)
-
(defun gnus-article-make-menu-bar ()
+ (unless (boundp 'gnus-article-commands-menu)
+ (gnus-summary-make-menu-bar))
(gnus-turn-off-edit-menu 'article)
(unless (boundp 'gnus-article-article-menu)
(easy-menu-define
@@ -2693,29 +3580,19 @@ If variable `gnus-use-long-file-name' is non-nil, it is
["Hide citation" gnus-article-hide-citation t]
["Treat overstrike" gnus-article-treat-overstrike t]
["Remove carriage return" gnus-article-remove-cr t]
+ ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
["Remove base64" gnus-article-de-base64-unreadable t]
["Treat html" gnus-article-wash-html t]
+ ["Remove newlines from within URLs" gnus-article-unsplit-urls t]
["Decode HZ" gnus-article-decode-HZ t]))
;; Note "Commands" menu is defined in gnus-sum.el for consistency
- (when (boundp 'gnus-summary-post-menu)
- (cond
- ((not (keymapp gnus-summary-post-menu))
- (setq gnus-article-post-menu gnus-summary-post-menu))
- ((not gnus-article-post-menu)
- ;; Don't share post menu.
- (setq gnus-article-post-menu
- (copy-keymap gnus-summary-post-menu))))
- (define-key gnus-article-mode-map [menu-bar post]
- (cons "Post" gnus-article-post-menu)))
+ ;; Note "Post" menu is defined in gnus-sum.el for consistency
(gnus-run-hooks 'gnus-article-menu-hook)))
-;; Fixme: do something for the Emacs tool bar in Article mode a la
-;; Summary.
-
(defun gnus-article-mode ()
"Major mode for displaying an article.
@@ -2738,16 +3615,21 @@ commands:
(make-local-variable 'minor-mode-alist)
(use-local-map gnus-article-mode-map)
(when (gnus-visual-p 'article-menu 'menu)
- (gnus-article-make-menu-bar))
+ (gnus-article-make-menu-bar)
+ (when gnus-summary-tool-bar-map
+ (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
(gnus-update-format-specifications nil 'article-mode)
(set (make-local-variable 'page-delimiter) gnus-page-delimiter)
- (make-local-variable 'gnus-page-broken)
+ (set (make-local-variable 'gnus-page-broken) nil)
(make-local-variable 'gnus-button-marker-list)
(make-local-variable 'gnus-article-current-summary)
(make-local-variable 'gnus-article-mime-handles)
(make-local-variable 'gnus-article-decoded-p)
(make-local-variable 'gnus-article-mime-handle-alist)
(make-local-variable 'gnus-article-wash-types)
+ (make-local-variable 'gnus-article-image-alist)
+ (make-local-variable 'gnus-article-charset)
+ (make-local-variable 'gnus-article-ignored-charsets)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t)
@@ -2783,6 +3665,12 @@ commands:
(if (get-buffer name)
(save-excursion
(set-buffer name)
+ (when (and gnus-article-edit-mode
+ (buffer-modified-p)
+ (not
+ (y-or-n-p "Article mode edit in progress; discard? ")))
+ (error "Action aborted"))
+ (set (make-local-variable 'gnus-article-edit-mode) nil)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handles nil))
@@ -2790,6 +3678,8 @@ commands:
(setq gnus-article-mime-handle-alist nil)
(buffer-disable-undo)
(setq buffer-read-only t)
+ ;; This list just keeps growing if we don't reset it.
+ (setq gnus-button-marker-list nil)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(current-buffer))
@@ -2804,7 +3694,7 @@ commands:
;; from the head of the article.
(defun gnus-article-set-window-start (&optional line)
(set-window-start
- (get-buffer-window gnus-article-buffer t)
+ (gnus-get-buffer-window gnus-article-buffer t)
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-min))
@@ -2848,7 +3738,9 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(cons gnus-newsgroup-name article))
(set-buffer gnus-summary-buffer)
(setq gnus-current-article article)
- (if (eq (gnus-article-mark article) gnus-undownloaded-mark)
+ (if (and (memq article gnus-newsgroup-undownloaded)
+ (not (gnus-online (gnus-find-method-for-group
+ gnus-newsgroup-name))))
(progn
(gnus-summary-set-agent-mark article)
(message "Message marked for downloading"))
@@ -2912,14 +3804,14 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(gnus-article-prepare-display)
;; Do page break.
(goto-char (point-min))
- (setq gnus-page-broken
- (when gnus-break-pages
- (gnus-narrow-to-page)
- t)))
+ (when gnus-break-pages
+ (gnus-narrow-to-page)))
(let ((gnus-article-mime-handle-alist-1
gnus-article-mime-handle-alist))
(gnus-set-mode-line 'article))
(article-goto-body)
+ (unless (bobp)
+ (forward-line -1))
(set-window-point (get-buffer-window (current-buffer)) (point))
(gnus-configure-windows 'article)
t))))))
@@ -2930,11 +3822,13 @@ If ALL-HEADERS is non-nil, no headers are hidden."
;; Hooks for getting information from the article.
;; This hook must be called before being narrowed.
(let ((gnus-article-buffer (current-buffer))
- buffer-read-only)
+ buffer-read-only
+ (inhibit-read-only t))
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(setq buffer-read-only nil
- gnus-article-wash-types nil)
+ gnus-article-wash-types nil
+ gnus-article-image-alist nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(when gnus-display-mime-function
(funcall gnus-display-mime-function))
@@ -2945,14 +3839,19 @@ If ALL-HEADERS is non-nil, no headers are hidden."
;;;
(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
- "The following specs can be used:
+ "Format of the MIME buttons.
+
+Valid specifiers include:
%t The MIME type
%T MIME type, along with additional info
%n The `name' parameter
%d The description, if any
%l The length of the encoded part
%p The part identifier number
-%e Dots if the part isn't displayed")
+%e Dots if the part isn't displayed
+
+General format specifiers can also be used. See Info node
+`(gnus)Formatting Variables'.")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
@@ -2967,42 +3866,68 @@ If ALL-HEADERS is non-nil, no headers are hidden."
'((gnus-article-press-button "\r" "Toggle Display")
(gnus-mime-view-part "v" "View Interactively...")
(gnus-mime-view-part-as-type "t" "View As Type...")
+ (gnus-mime-view-part-as-charset "C" "View As charset...")
(gnus-mime-save-part "o" "Save...")
+ (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
+ (gnus-mime-delete-part "d" "Delete part")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(gnus-mime-inline-part "i" "View As Text, In This Buffer")
- (gnus-mime-internalize-part "E" "View Internally")
- (gnus-mime-externalize-part "e" "View Externally")
+ (gnus-mime-view-part-internally "E" "View Internally")
+ (gnus-mime-view-part-externally "e" "View Externally")
+ (gnus-mime-print-part "p" "Print")
(gnus-mime-pipe-part "|" "Pipe To Command...")
- (gnus-mime-action-on-part "." "Take action on the part")))
+ (gnus-mime-action-on-part "." "Take action on the part...")))
(defun gnus-article-mime-part-status ()
(if gnus-article-mime-handle-alist-1
- (format " (%d parts)" (length gnus-article-mime-handle-alist-1))
+ (if (eq 1 (length gnus-article-mime-handle-alist-1))
+ " (1 part)"
+ (format " (%d parts)" (length gnus-article-mime-handle-alist-1)))
""))
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
- ;; Not for Emacs 21: fixme better.
- ;; (set-keymap-parent map gnus-article-mode-map)
+ (unless (>= (string-to-number emacs-version) 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
(define-key map gnus-mouse-2 'gnus-article-push-button)
(define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
-(defun gnus-mime-button-menu (event)
- "Construct a context-sensitive menu of MIME commands."
- (interactive "e")
- (save-excursion
- (mouse-set-point event)
- (gnus-article-check-buffer)
- (let ((response (x-popup-menu
- t `("MIME Part"
- ("" ,@(mapcar (lambda (c)
- (cons (caddr c) (car c)))
- gnus-mime-button-commands))))))
- (if response
- (call-interactively response)))))
+(easy-menu-define
+ gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
+ `("MIME Part"
+ ,@(mapcar (lambda (c)
+ (vector (caddr c) (car c) :enable t))
+ gnus-mime-button-commands)))
+
+(eval-when-compile
+ (define-compiler-macro popup-menu (&whole form
+ menu &optional position prefix)
+ (if (and (fboundp 'popup-menu)
+ (not (memq 'popup-menu (assoc "lmenu" load-history))))
+ form
+ ;; Gnus is probably running under Emacs 20.
+ `(let* ((menu (cdr ,menu))
+ (response (x-popup-menu
+ t (list (car menu)
+ (cons "" (mapcar (lambda (c)
+ (cons (caddr c) (car c)))
+ (cdr menu)))))))
+ (if response
+ (call-interactively (nth 3 (assq response menu))))))))
+
+(defun gnus-mime-button-menu (event prefix)
+ "Construct a context-sensitive menu of MIME commands."
+ (interactive "e\nP")
+ (save-window-excursion
+ (let ((pos (event-start event)))
+ (select-window (posn-window pos))
+ (goto-char (posn-point pos))
+ (gnus-article-check-buffer)
+ (popup-menu gnus-mime-button-menu nil prefix))))
(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
@@ -3012,33 +3937,195 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(let ((handles (or handles gnus-article-mime-handles))
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
- (if (stringp (car handles))
- (gnus-mime-view-all-parts (cdr handles))
- (mapcar 'mm-display-part handles)))))
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets)))
+ (when handles
+ (mm-remove-parts handles)
+ (goto-char (point-min))
+ (or (search-forward "\n\n") (goto-char (point-max)))
+ (let ((inhibit-read-only t))
+ (delete-region (point) (point-max))
+ (mm-display-parts handles))))))
+
+(defun gnus-mime-save-part-and-strip ()
+ "Save the MIME part under point then replace it with an external body."
+ (interactive)
+ (gnus-article-check-buffer)
+ (when (gnus-group-read-only-p)
+ (error "The current group does not support deleting of parts"))
+ (when (mm-complicated-handles gnus-article-mime-handles)
+ (error "\
+The current article has a complicated MIME structure, giving up..."))
+ (when (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? ")
+ (let* ((data (get-text-property (point) 'gnus-data))
+ file param
+ (handles gnus-article-mime-handles))
+ (setq file (and data (mm-save-part data)))
+ (when file
+ (with-current-buffer (mm-handle-buffer data)
+ (erase-buffer)
+ (insert "Content-Type: " (mm-handle-media-type data))
+ (mml-insert-parameter-string (cdr (mm-handle-type data))
+ '(charset))
+ (insert "\n")
+ (insert "Content-ID: " (message-make-message-id) "\n")
+ (insert "Content-Transfer-Encoding: binary\n")
+ (insert "\n"))
+ (setcdr data
+ (cdr (mm-make-handle nil
+ `("message/external-body"
+ (access-type . "LOCAL-FILE")
+ (name . ,file)))))
+ (set-buffer gnus-summary-buffer)
+ (gnus-article-edit-article
+ `(lambda ()
+ (erase-buffer)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ (mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (insert-buffer gnus-original-article-buffer)
+ (mime-to-mml ',handles)
+ (setq gnus-article-mime-handles nil)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets)))
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ 'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list))
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p)
+ ,gnus-summary-buffer no-highlight)))))))
+
+(defun gnus-mime-delete-part ()
+ "Delete the MIME part under point.
+Replace it with some information about the removed part."
+ (interactive)
+ (gnus-article-check-buffer)
+ (when (gnus-group-read-only-p)
+ (error "The current group does not support deleting of parts"))
+ (when (mm-complicated-handles gnus-article-mime-handles)
+ (error "\
+The current article has a complicated MIME structure, giving up..."))
+ (when (gnus-yes-or-no-p "\
+Deleting parts may malfunction or destroy the article; continue? ")
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (handles gnus-article-mime-handles)
+ (none "(none)")
+ (description
+ (or
+ (mail-decode-encoded-word-string (or (mm-handle-description data)
+ none))))
+ (filename
+ (or (mail-content-type-get (mm-handle-disposition data) 'filename)
+ none))
+ (type (mm-handle-media-type data)))
+ (unless data
+ (error "No MIME part under point"))
+ (with-current-buffer (mm-handle-buffer data)
+ (let ((bsize (format "%s" (buffer-size))))
+ (erase-buffer)
+ (insert
+ (concat
+ ",----\n"
+ "| The following attachment has been deleted:\n"
+ "|\n"
+ "| Type: " type "\n"
+ "| Filename: " filename "\n"
+ "| Size (encoded): " bsize " Byte\n"
+ "| Description: " description "\n"
+ "`----\n"))
+ (setcdr data
+ (cdr (mm-make-handle
+ nil `("text/plain") nil nil
+ (list "attachment")
+ (format "Deleted attachment (%s bytes)" bsize))))))
+ (set-buffer gnus-summary-buffer)
+ ;; FIXME: maybe some of the following code (borrowed from
+ ;; `gnus-mime-save-part-and-strip') isn't necessary?
+ (gnus-article-edit-article
+ `(lambda ()
+ (erase-buffer)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ (mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (insert-buffer gnus-original-article-buffer)
+ (mime-to-mml ',handles)
+ (setq gnus-article-mime-handles nil)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets)))
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ 'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list))
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p)
+ ,gnus-summary-buffer no-highlight)))))
+ ;; Not in `gnus-mime-save-part-and-strip':
+ (gnus-article-edit-done)
+ (gnus-summary-expand-window)
+ (gnus-summary-show-article))
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (mm-save-part data)))
+ (when data
+ (mm-save-part data))))
(defun gnus-mime-pipe-part ()
"Pipe the MIME part under point to a process."
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (mm-pipe-part data)))
+ (when data
+ (mm-pipe-part data))))
(defun gnus-mime-view-part ()
"Interactively choose a viewing method for the MIME part under point."
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (push (setq data (copy-sequence data)) gnus-article-mime-handles)
- (mm-interactively-view-part data)))
+ (when data
+ (setq gnus-article-mime-handles
+ (mm-merge-handles
+ gnus-article-mime-handles (setq data (copy-sequence data))))
+ (mm-interactively-view-part data))))
(defun gnus-mime-view-part-as-type-internal ()
(gnus-article-check-buffer)
@@ -3048,48 +4135,113 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(def-type (and name (mm-default-file-encoding name))))
(and def-type (cons def-type 0))))
-(defun gnus-mime-view-part-as-type (mime-type)
+(defun gnus-mime-view-part-as-type (&optional mime-type)
"Choose a MIME media type, and view the part as such."
- (interactive
- (list (completing-read
- "View as MIME type: "
- (mapcar #'list (mailcap-mime-types))
- nil nil
- (gnus-mime-view-part-as-type-internal))))
+ (interactive)
+ (unless mime-type
+ (setq mime-type (completing-read
+ "View as MIME type: "
+ (mapcar #'list (mailcap-mime-types))
+ nil nil
+ (gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
(let ((handle (get-text-property (point) 'gnus-data)))
- (gnus-mm-display-part
- (mm-make-handle (mm-handle-buffer handle)
- (cons mime-type (cdr (mm-handle-type handle)))
- (mm-handle-encoding handle)
- (mm-handle-undisplayer handle)
- (mm-handle-disposition handle)
- (mm-handle-description handle)
- (mm-handle-cache handle)
- (mm-handle-id handle)))))
+ (when handle
+ (setq handle
+ (mm-make-handle (mm-handle-buffer handle)
+ (cons mime-type (cdr (mm-handle-type handle)))
+ (mm-handle-encoding handle)
+ (mm-handle-undisplayer handle)
+ (mm-handle-disposition handle)
+ (mm-handle-description handle)
+ nil
+ (mm-handle-id handle)))
+ (setq gnus-article-mime-handles
+ (mm-merge-handles gnus-article-mime-handles handle))
+ (gnus-mm-display-part handle))))
+
+(eval-when-compile
+ (require 'jka-compr))
+
+;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
+;; emacs can do that itself.
+;;
+(defun gnus-mime-jka-compr-maybe-uncompress ()
+ "Uncompress the current buffer if `auto-compression-mode' is enabled.
+The uncompress method used is derived from `buffer-file-name'."
+ (when (and (fboundp 'jka-compr-installed-p)
+ (jka-compr-installed-p))
+ (let ((info (jka-compr-get-compression-info buffer-file-name)))
+ (when info
+ (let ((basename (file-name-nondirectory buffer-file-name))
+ (args (jka-compr-info-uncompress-args info))
+ (prog (jka-compr-info-uncompress-program info))
+ (message (jka-compr-info-uncompress-message info))
+ (err-file (jka-compr-make-temp-name)))
+ (if message
+ (message "%s %s..." message basename))
+ (unwind-protect
+ (unless (memq (apply 'call-process-region
+ (point-min) (point-max)
+ prog
+ t (list t err-file) nil
+ args)
+ jka-compr-acceptable-retval-list)
+ (jka-compr-error prog args basename message err-file))
+ (jka-compr-delete-temp-file err-file)))))))
(defun gnus-mime-copy-part (&optional handle)
- "Put the MIME part under point into a new buffer."
+ "Put the MIME part under point into a new buffer.
+If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
+are decompressed."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (contents (mm-get-part handle))
- (base (file-name-nondirectory
- (or
- (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-type handle)
- 'filename)
- "*decoded*")))
- (buffer (generate-new-buffer base)))
- (switch-to-buffer buffer)
- (insert contents)
- ;; We do it this way to make `normal-mode' set the appropriate mode.
- (unwind-protect
- (progn
- (setq buffer-file-name (expand-file-name base))
- (normal-mode))
- (setq buffer-file-name nil))
- (goto-char (point-min))))
+ (contents (and handle (mm-get-part handle)))
+ (base (and handle
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)
+ "*decoded*"))))
+ (buffer (and base (generate-new-buffer base))))
+ (when contents
+ (switch-to-buffer buffer)
+ (insert contents)
+ ;; We do it this way to make `normal-mode' set the appropriate mode.
+ (unwind-protect
+ (progn
+ (setq buffer-file-name (expand-file-name base))
+ (gnus-mime-jka-compr-maybe-uncompress)
+ (normal-mode))
+ (setq buffer-file-name nil))
+ (goto-char (point-min)))))
+
+(defun gnus-mime-print-part (&optional handle filename)
+ "Print the MIME part under point."
+ (interactive (list nil (ps-print-preprint current-prefix-arg)))
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (contents (and handle (mm-get-part handle)))
+ (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
+ (printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
+ (when contents
+ (if printer
+ (unwind-protect
+ (progn
+ (mm-save-part-to-file handle file)
+ (call-process shell-file-name nil
+ (generate-new-buffer " *mm*")
+ nil
+ shell-command-switch
+ (mm-mailcap-command
+ printer file (mm-handle-type handle))))
+ (delete-file file))
+ (with-temp-buffer
+ (insert contents)
+ (gnus-print-buffer))
+ (ps-despool filename)))))
(defun gnus-mime-inline-part (&optional handle arg)
"Insert the MIME part under point into the current buffer."
@@ -3098,31 +4250,53 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
contents charset
(b (point))
- buffer-read-only)
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (setq contents (mm-get-part handle))
- (cond
- ((not arg)
- (setq charset (or (mail-content-type-get
- (mm-handle-type handle) 'charset)
- gnus-newsgroup-charset)))
- ((numberp arg)
- (setq charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: ")))))
- (forward-line 2)
- (mm-insert-inline handle
- (if (and charset
- (setq charset (mm-charset-to-coding-system
- charset))
- (not (eq charset 'ascii)))
- (mm-decode-coding-string contents charset)
- contents))
- (goto-char b))))
-
-(defun gnus-mime-externalize-part (&optional handle)
+ (inhibit-read-only t))
+ (when handle
+ (if (and (not arg) (mm-handle-undisplayer handle))
+ (mm-remove-part handle)
+ (setq contents (mm-get-part handle))
+ (cond
+ ((not arg)
+ (setq charset (or (mail-content-type-get
+ (mm-handle-type handle) 'charset)
+ gnus-newsgroup-charset)))
+ ((numberp arg)
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (setq charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (mm-read-coding-system "Charset: ")))))
+ (forward-line 2)
+ (mm-insert-inline handle
+ (if (and charset
+ (setq charset (mm-charset-to-coding-system
+ charset))
+ (not (eq charset 'ascii)))
+ (mm-decode-coding-string contents charset)
+ contents))
+ (goto-char b)))))
+
+(defun gnus-mime-view-part-as-charset (&optional handle arg)
+ "Insert the MIME part under point into the current buffer using the
+specified charset."
+ (interactive (list nil current-prefix-arg))
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ contents charset
+ (b (point))
+ (inhibit-read-only t))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (mm-read-coding-system "Charset: ")))
+ (gnus-newsgroup-ignored-charsets 'gnus-all))
+ (gnus-article-press-button)))))
+
+(defun gnus-mime-view-part-externally (&optional handle)
"View the MIME part under point with an external viewer."
(interactive)
(gnus-article-check-buffer)
@@ -3133,13 +4307,14 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (mm-display-part handle))))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle)))))
-(defun gnus-mime-internalize-part (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle)
"View the MIME part under point with an internal viewer.
-In no internal viewer is available, use an external viewer."
+If no internal viewer is available, use an external viewer."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
@@ -3148,21 +4323,22 @@ In no internal viewer is available, use an external viewer."
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (mm-display-part handle))))
+ gnus-newsgroup-ignored-charsets))
+ (inhibit-read-only t))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle)))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
(interactive
- (list (completing-read "Action: " gnus-mime-action-alist)))
+ (list (completing-read "Action: " gnus-mime-action-alist nil t)))
(gnus-article-check-buffer)
(let ((action-pair (assoc action gnus-mime-action-alist)))
(if action-pair
(funcall (cdr action-pair)))))
-
(defun gnus-article-part-wrapper (n function)
(save-current-buffer
(set-buffer gnus-article-buffer)
@@ -3192,10 +4368,16 @@ In no internal viewer is available, use an external viewer."
(interactive "p")
(gnus-article-part-wrapper n 'gnus-mime-copy-part))
-(defun gnus-article-externalize-part (n)
+(defun gnus-article-view-part-as-charset (n)
+ "View MIME part N using a specified charset.
+N is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
+
+(defun gnus-article-view-part-externally (n)
"View MIME part N externally, which is the numerical prefix."
(interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-externalize-part))
+ (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
(defun gnus-article-inline-part (n)
"Inline MIME part N, which is the numerical prefix."
@@ -3247,17 +4429,20 @@ In no internal viewer is available, use an external viewer."
"Display HANDLE and fix MIME button."
(let ((id (get-text-property (point) 'gnus-part))
(point (point))
- buffer-read-only)
+ (inhibit-read-only t))
(forward-line 1)
(prog1
(let ((window (selected-window))
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
+ (if (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)
+ nil)))
(save-excursion
(unwind-protect
- (let ((win (get-buffer-window (current-buffer) t))
+ (let ((win (gnus-get-buffer-window (current-buffer) t))
(beg (point)))
(when win
(select-window win))
@@ -3267,7 +4452,8 @@ In no internal viewer is available, use an external viewer."
;; This will remove the part.
(mm-display-part handle)
(save-restriction
- (narrow-to-region (point) (1+ (point)))
+ (narrow-to-region (point)
+ (if (eobp) (point) (1+ (point))))
(mm-display-part handle)
;; We narrow to the part itself and
;; then call the treatment functions.
@@ -3278,25 +4464,23 @@ In no internal viewer is available, use an external viewer."
nil id
(gnus-article-mime-total-parts)
(mm-handle-media-type handle)))))
- (select-window window))))
+ (if (window-live-p window)
+ (select-window window)))))
(goto-char point)
- (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point)))
+ (gnus-delete-line)
(gnus-insert-mime-button
handle id (list (mm-handle-displayed-p handle)))
(goto-char point))))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
- (let ((point (text-property-any (point-min) (point-max) 'gnus-part n)))
- (when point
- (goto-char point))))
+ (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
(let ((gnus-tmp-name
- (or (mail-content-type-get (mm-handle-type handle)
- 'name)
- (mail-content-type-get (mm-handle-disposition handle)
- 'filename)
+ (or (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get (mm-handle-type handle) 'url)
""))
(gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description
@@ -3314,21 +4498,22 @@ In no internal viewer is available, use an external viewer."
(setq gnus-tmp-type-long (concat gnus-tmp-type
(and (not (equal gnus-tmp-name ""))
(concat "; " gnus-tmp-name))))
- (or (equal gnus-tmp-description "")
- (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
+ (unless (equal gnus-tmp-description "")
+ (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
(unless (bolp)
(insert "\n"))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
- `(keymap ,gnus-mime-button-map
- ;; Not for Emacs 21: fixme better.
- ;; local-map ,gnus-mime-button-map
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle))
- (setq e (point))
+ `(,@(gnus-local-map-property gnus-mime-button-map)
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ article-type annotation
+ gnus-data ,handle))
+ (setq e (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point)))
(widget-convert-button
'link b e
:mime-handle handle
@@ -3371,8 +4556,11 @@ In no internal viewer is available, use an external viewer."
;; We have to do this since selecting the window
;; may change the point. So we set the window point.
(set-window-point window point)))
- (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
- buffer-read-only handle name type b e display)
+ (let* ((handles (or ihandles
+ (mm-dissect-buffer nil gnus-article-loose-mime)
+ (and gnus-article-emulate-mime
+ (mm-uu-dissect))))
+ (inhibit-read-only t) handle name type b e display)
(when (and (not ihandles)
(not gnus-displaying-mime))
;; Top-level call; we clean up.
@@ -3407,7 +4595,28 @@ In no internal viewer is available, use an external viewer."
(narrow-to-region (point-min) (point))
(gnus-treat-article 'head))))))))
-(defvar gnus-mime-display-multipart-as-mixed nil)
+(defcustom gnus-mime-display-multipart-as-mixed nil
+ "Display \"multipart\" parts as \"multipart/mixed\".
+
+If t, it overrides nil values of
+`gnus-mime-display-multipart-alternative-as-mixed' and
+`gnus-mime-display-multipart-related-as-mixed'."
+ :group 'gnus-article-mime
+ :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-alternative-as-mixed nil
+ "Display \"multipart/alternative\" parts as \"multipart/mixed\"."
+ :group 'gnus-article-mime
+ :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-related-as-mixed nil
+ "Display \"multipart/related\" parts as \"multipart/mixed\".
+
+If displaying \"text/html\" is discouraged \(see
+`mm-discouraged-alternatives'\) images or other material inside a
+\"multipart/related\" part might be overlooked when this variable is nil."
+ :group 'gnus-article-mime
+ :type 'boolean)
(defun gnus-mime-display-part (handle)
(cond
@@ -3420,16 +4629,30 @@ In no internal viewer is available, use an external viewer."
handle))
;; multipart/alternative
((and (equal (car handle) "multipart/alternative")
- (not gnus-mime-display-multipart-as-mixed))
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-alternative-as-mixed)))
(let ((id (1+ (length gnus-article-mime-handle-alist))))
(push (cons id handle) gnus-article-mime-handle-alist)
(gnus-mime-display-alternative (cdr handle) nil nil id)))
;; multipart/related
((and (equal (car handle) "multipart/related")
- (not gnus-mime-display-multipart-as-mixed))
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-related-as-mixed)))
;;;!!!We should find the start part, but we just default
;;;!!!to the first part.
+ ;;(gnus-mime-display-part (cadr handle))
+ ;;;!!! Most multipart/related is an HTML message plus images.
+ ;;;!!! Unfortunately we are unable to let W3 display those
+ ;;;!!! included images, so we just display it as a mixed multipart.
+ ;;(gnus-mime-display-mixed (cdr handle))
+ ;;;!!! No, w3 can display everything just fine.
(gnus-mime-display-part (cadr handle)))
+ ((equal (car handle) "multipart/signed")
+ (gnus-add-wash-type 'signed)
+ (gnus-mime-display-security handle))
+ ((equal (car handle) "multipart/encrypted")
+ (gnus-add-wash-type 'encrypted)
+ (gnus-mime-display-security handle))
;; Other multiparts are handled like multipart/mixed.
(t
(gnus-mime-display-mixed (cdr handle)))))
@@ -3460,7 +4683,9 @@ In no internal viewer is available, use an external viewer."
"inline")
(mm-attachment-override-p handle))))
(mm-automatic-display-p handle)
- (or (mm-inlined-p handle)
+ (or (and
+ (mm-inlinable-p handle)
+ (mm-inlined-p handle))
(mm-automatic-external-display-p type)))
(setq display t)
(when (equal (mm-handle-media-supertype handle) "text")
@@ -3475,12 +4700,13 @@ In no internal viewer is available, use an external viewer."
handle id (list (or display (and not-attachment text))))
(gnus-article-insert-newline)
;(gnus-article-insert-newline)
+ ;; Remember modify the number of forward lines.
(setq move t))
(setq beg (point))
(cond
(display
(when move
- (forward-line -2)
+ (forward-line -1)
(setq beg (point)))
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
@@ -3492,7 +4718,7 @@ In no internal viewer is available, use an external viewer."
(goto-char (point-max)))
((and text not-attachment)
(when move
- (forward-line -2)
+ (forward-line -1)
(setq beg (point)))
(gnus-article-insert-newline)
(mm-insert-inline handle (mm-get-part handle))
@@ -3509,11 +4735,16 @@ In no internal viewer is available, use an external viewer."
(defun gnus-unbuttonized-mime-type-p (type)
"Say whether TYPE is to be unbuttonized."
(unless gnus-inhibit-mime-unbuttonizing
- (catch 'found
- (let ((types gnus-unbuttonized-mime-types))
- (while types
- (when (string-match (pop types) type)
- (throw 'found t)))))))
+ (when (catch 'found
+ (let ((types gnus-unbuttonized-mime-types))
+ (while types
+ (when (string-match (pop types) type)
+ (throw 'found t)))))
+ (not (catch 'found
+ (let ((types gnus-buttonized-mime-types))
+ (while types
+ (when (string-match (pop types) type)
+ (throw 'found t)))))))))
(defun gnus-article-insert-newline ()
"Insert a newline, but mark it as undeletable."
@@ -3524,7 +4755,7 @@ In no internal viewer is available, use an external viewer."
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
- handle buffer-read-only from props begend not-pref)
+ handle (inhibit-read-only t) from props begend not-pref)
(save-window-excursion
(save-restriction
(when ibegend
@@ -3541,6 +4772,7 @@ In no internal viewer is available, use an external viewer."
(unless (setq not-pref (cadr (member preferred ihandles)))
(setq not-pref (car ihandles)))
(when (or ibegend
+ (not preferred)
(not (gnus-unbuttonized-mime-type-p
"multipart/alternative")))
(gnus-add-text-properties
@@ -3555,11 +4787,9 @@ In no internal viewer is available, use an external viewer."
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',not-pref ',begend ,id))
- ;; Not for Emacs 21: fixme better.
- ;; local-map ,gnus-mime-button-map
+ ,@(gnus-local-map-property gnus-mime-button-map)
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
- keymap ,gnus-mime-button-map
gnus-part ,id
gnus-data ,handle))
(widget-convert-button 'link from (point)
@@ -3581,11 +4811,9 @@ In no internal viewer is available, use an external viewer."
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',handle ',begend ,id))
- ;; Not for Emacs 21: fixme better.
- ;; local-map ,gnus-mime-button-map
+ ,@(gnus-local-map-property gnus-mime-button-map)
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
- keymap ,gnus-mime-button-map
gnus-part ,id
gnus-data ,handle))
(widget-convert-button 'link from (point)
@@ -3614,6 +4842,39 @@ In no internal viewer is available, use an external viewer."
(when ibegend
(goto-char point))))
+(defconst gnus-article-wash-status-strings
+ (let ((alist '((cite "c" "Possible hidden citation text"
+ " " "All citation text visible")
+ (headers "h" "Hidden headers"
+ " " "All headers visible.")
+ (pgp "p" "Encrypted or signed message status hidden"
+ " " "No hidden encryption nor digital signature status")
+ (signature "s" "Signature has been hidden"
+ " " "Signature is visible")
+ (overstrike "o" "Overstrike (^H) characters applied"
+ " " "No overstrike characters applied")
+ (emphasis "e" "/*_Emphasis_*/ characters applied"
+ " " "No /*_emphasis_*/ characters applied")))
+ result)
+ (dolist (entry alist result)
+ (let ((key (nth 0 entry))
+ (on (copy-sequence (nth 1 entry)))
+ (on-help (nth 2 entry))
+ (off (copy-sequence (nth 3 entry)))
+ (off-help (nth 4 entry)))
+ (put-text-property 0 1 'help-echo on-help on)
+ (put-text-property 0 1 'help-echo off-help off)
+ (push (list key on off) result))))
+ "Alist of strings describing wash status in the mode line.
+Each entry has the form (KEY ON OF), where the KEY is a symbol
+representing the particular washing function, ON is the string to use
+in the article mode line when the washing function is active, and OFF
+is the string to use when it is inactive.")
+
+(defun gnus-article-wash-status-entry (key value)
+ (let ((entry (assoc key gnus-article-wash-status-strings)))
+ (if value (nth 1 entry) (nth 2 entry))))
+
(defun gnus-article-wash-status ()
"Return a string which display status of article washing."
(save-excursion
@@ -3623,16 +4884,42 @@ In no internal viewer is available, use an external viewer."
(boring (memq 'boring-headers gnus-article-wash-types))
(pgp (memq 'pgp gnus-article-wash-types))
(pem (memq 'pem gnus-article-wash-types))
+ (signed (memq 'signed gnus-article-wash-types))
+ (encrypted (memq 'encrypted gnus-article-wash-types))
(signature (memq 'signature gnus-article-wash-types))
(overstrike (memq 'overstrike gnus-article-wash-types))
(emphasis (memq 'emphasis gnus-article-wash-types)))
- (format "%c%c%c%c%c%c"
- (if cite ?c ? )
- (if (or headers boring) ?h ? )
- (if (or pgp pem) ?p ? )
- (if signature ?s ? )
- (if overstrike ?o ? )
- (if emphasis ?e ? )))))
+ (concat
+ (gnus-article-wash-status-entry 'cite cite)
+ (gnus-article-wash-status-entry 'headers (or headers boring))
+ (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted))
+ (gnus-article-wash-status-entry 'signature signature)
+ (gnus-article-wash-status-entry 'overstrike overstrike)
+ (gnus-article-wash-status-entry 'emphasis emphasis)))))
+
+(defun gnus-add-wash-type (type)
+ "Add a washing of TYPE to the current status."
+ (add-to-list 'gnus-article-wash-types type))
+
+(defun gnus-delete-wash-type (type)
+ "Add a washing of TYPE to the current status."
+ (setq gnus-article-wash-types (delq type gnus-article-wash-types)))
+
+(defun gnus-add-image (category image)
+ "Add IMAGE of CATEGORY to the list of displayed images."
+ (let ((entry (assq category gnus-article-image-alist)))
+ (unless entry
+ (setq entry (list category))
+ (push entry gnus-article-image-alist))
+ (nconc entry (list image))))
+
+(defun gnus-delete-images (category)
+ "Delete all images in CATEGORY."
+ (let ((entry (assq category gnus-article-image-alist)))
+ (dolist (image (cdr entry))
+ (gnus-remove-image image category))
+ (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
+ (gnus-delete-wash-type category)))
(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
@@ -3674,27 +4961,32 @@ If given a numerical ARG, move forward ARG pages."
(let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next)))
- (when
+ (if
(cond ((< arg 0)
(re-search-backward page-delimiter nil 'move (1+ (abs arg))))
((> arg 0)
(re-search-forward page-delimiter nil 'move arg)))
- (goto-char (match-end 0)))
- (narrow-to-region
- (point)
- (if (re-search-forward page-delimiter nil 'move)
- (match-beginning 0)
- (point)))
- (when (and (gnus-visual-p 'page-marker)
- (> (point-min) (save-restriction (widen) (point-min))))
+ (goto-char (match-end 0))
(save-excursion
(goto-char (point-min))
- (gnus-insert-prev-page-button)))
- (when (and (gnus-visual-p 'page-marker)
- (< (point-max) (save-restriction (widen) (point-max))))
- (save-excursion
- (goto-char (point-max))
- (gnus-insert-next-page-button)))))
+ (setq gnus-page-broken
+ (and (re-search-forward page-delimiter nil t) t))))
+ (when gnus-page-broken
+ (narrow-to-region
+ (point)
+ (if (re-search-forward page-delimiter nil 'move)
+ (match-beginning 0)
+ (point)))
+ (when (and (gnus-visual-p 'page-marker)
+ (> (point-min) (save-restriction (widen) (point-min))))
+ (save-excursion
+ (goto-char (point-min))
+ (gnus-insert-prev-page-button)))
+ (when (and (gnus-visual-p 'page-marker)
+ (< (+ (point-max) 2) (buffer-size)))
+ (save-excursion
+ (goto-char (point-max))
+ (gnus-insert-next-page-button))))))
;; Article mode commands
@@ -3705,12 +4997,28 @@ If given a numerical ARG, move forward ARG pages."
(goto-char (point-min))
(gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+
(defun gnus-article-goto-prev-page ()
- "Show the next page of the article."
+ "Show the previous page of the article."
(interactive)
- (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+ (if (bobp)
+ (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
(gnus-article-prev-page nil)))
+;; This is cleaner but currently breaks `gnus-pick-mode':
+;;
+;; (defun gnus-article-goto-next-page ()
+;; "Show the next page of the article."
+;; (interactive)
+;; (gnus-eval-in-buffer-window gnus-summary-buffer
+;; (gnus-summary-next-page)))
+;;
+;; (defun gnus-article-goto-prev-page ()
+;; "Show the next page of the article."
+;; (interactive)
+;; (gnus-eval-in-buffer-window gnus-summary-buffer
+;; (gnus-summary-prev-page)))
+
(defun gnus-article-next-page (&optional lines)
"Show the next page of the current article.
If end of article, return non-nil. Otherwise return nil.
@@ -3720,25 +5028,33 @@ Argument LINES specifies lines to be scrolled up."
(if (save-excursion
(end-of-line)
(and (pos-visible-in-window-p) ;Not continuation line.
- (eobp)))
+ (>= (1+ (point)) (point-max)))) ;Allow for trailing newline.
;; Nothing in this page.
(if (or (not gnus-page-broken)
(save-excursion
(save-restriction
- (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
- t ;Nothing more.
+ (widen)
+ (forward-line)
+ (eobp)))) ;Real end-of-buffer?
+ (progn
+ (when gnus-article-over-scroll
+ (gnus-article-next-page-1 lines))
+ t) ;Nothing more.
(gnus-narrow-to-page 1) ;Go to next page.
nil)
;; More in this page.
- (let ((scroll-in-place nil))
- (condition-case ()
- (scroll-up lines)
- (end-of-buffer
- ;; Long lines may cause an end-of-buffer error.
- (goto-char (point-max)))))
- (move-to-window-line 0)
+ (gnus-article-next-page-1 lines)
nil))
+(defun gnus-article-next-page-1 (lines)
+ (let ((scroll-in-place nil))
+ (condition-case ()
+ (scroll-up lines)
+ (end-of-buffer
+ ;; Long lines may cause an end-of-buffer error.
+ (goto-char (point-max)))))
+ (move-to-window-line 0))
+
(defun gnus-article-prev-page (&optional lines)
"Show previous page of current article.
Argument LINES specifies lines to be scrolled down."
@@ -3759,17 +5075,33 @@ Argument LINES specifies lines to be scrolled down."
(goto-char (point-min))))
(move-to-window-line 0)))))
+(defun gnus-article-only-boring-p ()
+ "Decide whether there is only boring text remaining in the article.
+Something \"interesting\" is a word of at least two letters that does
+not have a face in `gnus-article-boring-faces'."
+ (when (and gnus-article-skip-boring
+ (boundp 'gnus-article-boring-faces)
+ (symbol-value 'gnus-article-boring-faces))
+ (save-excursion
+ (catch 'only-boring
+ (while (re-search-forward "\\b\\w\\w" nil t)
+ (forward-char -1)
+ (when (not (gnus-intersection
+ (gnus-faces-at (point))
+ (symbol-value 'gnus-article-boring-faces)))
+ (throw 'only-boring nil)))
+ (throw 'only-boring t)))))
+
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
(interactive)
- (let ((point (point)))
- (search-forward ">" nil t) ;Move point to end of "<....>".
- (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
- (let ((message-id (match-string 1)))
- (goto-char point)
+ (save-excursion
+ (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
+ (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
+ (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+ (let ((msg-id (concat "<" (match-string 0) ">")))
(set-buffer gnus-summary-buffer)
- (gnus-summary-refer-article message-id))
- (goto-char (point))
+ (gnus-summary-refer-article msg-id))
(error "No references around point"))))
(defun gnus-article-show-summary ()
@@ -3818,61 +5150,66 @@ Argument LINES specifies lines to be scrolled down."
(interactive "P")
(gnus-article-check-buffer)
(let ((nosaves
- '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
- "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
- "=" "^" "\M-^" "|"))
- (nosave-but-article
- '("A\r"))
- (nosave-in-article
- '("\C-d"))
- (up-to-top
- '("n" "Gn" "p" "Gp"))
- keys new-sum-point)
+ '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f"
+ "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
+ "=" "^" "\M-^" "|"))
+ (nosave-but-article
+ '("A\r"))
+ (nosave-in-article
+ '("\C-d"))
+ (up-to-top
+ '("n" "Gn" "p" "Gp"))
+ keys new-sum-point)
(save-excursion
(set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
- (push (or key last-command-event) unread-command-events)
- (setq keys (if (featurep 'xemacs)
+ (push (or key last-command-event) unread-command-events)
+ (setq keys (if (featurep 'xemacs)
(events-to-keys (read-key-sequence nil))
(read-key-sequence nil)))))
(message "")
(if (or (member keys nosaves)
- (member keys nosave-but-article)
- (member keys nosave-in-article))
- (let (func)
- (save-window-excursion
- (pop-to-buffer gnus-article-current-summary 'norecord)
- ;; We disable the pick minor mode commands.
- (let (gnus-pick-mode)
- (setq func (lookup-key (current-local-map) keys))))
- (if (or (not func)
+ (member keys nosave-but-article)
+ (member keys nosave-in-article))
+ (let (func)
+ (save-window-excursion
+ (pop-to-buffer gnus-article-current-summary 'norecord)
+ ;; We disable the pick minor mode commands.
+ (let (gnus-pick-mode)
+ (setq func (lookup-key (current-local-map) keys))))
+ (if (or (not func)
(numberp func))
- (ding)
- (unless (member keys nosave-in-article)
- (set-buffer gnus-article-current-summary))
- (call-interactively func)
- (setq new-sum-point (point)))
- (when (member keys nosave-but-article)
- (pop-to-buffer gnus-article-buffer 'norecord)))
+ (ding)
+ (unless (member keys nosave-in-article)
+ (set-buffer gnus-article-current-summary))
+ (call-interactively func)
+ (setq new-sum-point (point)))
+ (when (member keys nosave-but-article)
+ (pop-to-buffer gnus-article-buffer 'norecord)))
;; These commands should restore window configuration.
(let ((obuf (current-buffer))
- (owin (current-window-configuration))
- (opoint (point))
- (summary gnus-article-current-summary)
- func in-buffer selected)
- (if not-restore-window
- (pop-to-buffer summary 'norecord)
- (switch-to-buffer summary 'norecord))
- (setq in-buffer (current-buffer))
- ;; We disable the pick minor mode commands.
- (if (and (setq func (let (gnus-pick-mode)
+ (owin (current-window-configuration))
+ (opoint (point))
+ win func in-buffer selected new-sum-start new-sum-hscroll)
+ (cond (not-restore-window
+ (pop-to-buffer gnus-article-current-summary 'norecord))
+ ((setq win (get-buffer-window gnus-article-current-summary))
+ (select-window win))
+ (t
+ (switch-to-buffer gnus-article-current-summary 'norecord)))
+ (setq in-buffer (current-buffer))
+ ;; We disable the pick minor mode commands.
+ (if (and (setq func (let (gnus-pick-mode)
(lookup-key (current-local-map) keys)))
(functionp func))
- (progn
- (call-interactively func)
- (setq new-sum-point (point))
+ (progn
+ (call-interactively func)
+ (when (eq win (selected-window))
+ (setq new-sum-point (point)
+ new-sum-start (window-start win)
+ new-sum-hscroll (window-hscroll win))
(when (eq in-buffer (current-buffer))
(setq selected (gnus-summary-select-article))
(set-buffer obuf)
@@ -3884,11 +5221,13 @@ Argument LINES specifies lines to be scrolled down."
1)
(set-window-point (get-buffer-window (current-buffer))
(point)))
- (let ((win (get-buffer-window gnus-article-current-summary)))
- (when win
- (set-window-point win new-sum-point)))) )
- (switch-to-buffer gnus-article-buffer)
- (ding))))))
+ (when (and (not not-restore-window)
+ new-sum-point)
+ (set-window-point win new-sum-point)
+ (set-window-start win new-sum-start)
+ (set-window-hscroll win new-sum-hscroll)))))
+ (set-window-configuration owin)
+ (ding))))))
(defun gnus-article-describe-key (key)
"Display documentation of the function invoked by KEY. KEY is a string."
@@ -3898,10 +5237,16 @@ Argument LINES specifies lines to be scrolled down."
(save-excursion
(set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
- (push (elt key 0) unread-command-events)
- (setq key (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence "Describe key: "))
- (read-key-sequence "Describe key: "))))
+ (if (featurep 'xemacs)
+ (progn
+ (push (elt key 0) unread-command-events)
+ (setq key (events-to-keys
+ (read-key-sequence "Describe key: "))))
+ (setq unread-command-events
+ (mapcar
+ (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
+ (string-to-list key)))
+ (setq key (read-key-sequence "Describe key: "))))
(describe-key key))
(describe-key key)))
@@ -3913,22 +5258,65 @@ Argument LINES specifies lines to be scrolled down."
(save-excursion
(set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
- (push (elt key 0) unread-command-events)
- (setq key (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence "Describe key: "))
- (read-key-sequence "Describe key: "))))
+ (if (featurep 'xemacs)
+ (progn
+ (push (elt key 0) unread-command-events)
+ (setq key (events-to-keys
+ (read-key-sequence "Describe key: "))))
+ (setq unread-command-events
+ (mapcar
+ (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
+ (string-to-list key)))
+ (setq key (read-key-sequence "Describe key: "))))
(describe-key-briefly key insert))
(describe-key-briefly key insert)))
+(defun gnus-article-reply-with-original (&optional wide)
+ "Start composing a reply mail to the current message.
+The text in the region will be yanked. If the region isn't active,
+the entire article will be yanked."
+ (interactive "P")
+ (let ((article (cdr gnus-article-current))
+ contents)
+ (if (not (gnus-mark-active-p))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-reply (list (list article)) wide))
+ (setq contents (buffer-substring (point) (mark t)))
+ ;; Deactivate active regions.
+ (when (and (boundp 'transient-mark-mode)
+ transient-mark-mode)
+ (setq mark-active nil))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-reply
+ (list (list article contents)) wide)))))
+
+(defun gnus-article-followup-with-original ()
+ "Compose a followup to the current article.
+The text in the region will be yanked. If the region isn't active,
+the entire article will be yanked."
+ (interactive)
+ (let ((article (cdr gnus-article-current))
+ contents)
+ (if (not (gnus-mark-active-p))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-followup (list (list article))))
+ (setq contents (buffer-substring (point) (mark t)))
+ ;; Deactivate active regions.
+ (when (and (boundp 'transient-mark-mode)
+ transient-mark-mode)
+ (setq mark-active nil))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-followup
+ (list (list article contents)))))))
+
(defun gnus-article-hide (&optional arg force)
"Hide all the gruft in the current article.
-This means that PGP stuff, signatures, cited text and (some)
-headers will be hidden.
+This means that signatures, cited text and (some) headers will be
+hidden.
If given a prefix, show the hidden text instead."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
(gnus-article-hide-headers arg)
(gnus-article-hide-list-identifiers arg)
- (gnus-article-hide-pgp arg)
(gnus-article-hide-citation-maybe arg force)
(gnus-article-hide-signature arg))
@@ -3944,6 +5332,9 @@ If given a prefix, show the hidden text instead."
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
+(eval-when-compile
+ (autoload 'nneething-get-file-name "nneething"))
+
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
(let (do-update-line sparse-header)
@@ -3993,12 +5384,10 @@ If given a prefix, show the hidden text instead."
gnus-newsgroup-name)))
(when (and (eq (car method) 'nneething)
(vectorp header))
- (let ((dir (expand-file-name
- (mail-header-subject header)
- (file-name-as-directory
- (or (cadr (assq 'nneething-address method))
- (nth 1 method))))))
- (when (file-directory-p dir)
+ (let ((dir (nneething-get-file-name
+ (mail-header-id header))))
+ (when (and (stringp dir)
+ (file-directory-p dir))
(setq article 'nneething)
(gnus-group-enter-directory dir))))))))
@@ -4037,12 +5426,17 @@ If given a prefix, show the hidden text instead."
(numberp article)
(gnus-cache-request-article article group))
'article)
+ ;; Check the agent cache.
+ ((gnus-agent-request-article article group)
+ 'article)
;; Get the article and put into the article buffer.
((or (stringp article)
(numberp article))
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
gnus-refer-article-method))
+ (backend (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
result
(inhibit-read-only t))
(if (or (not (listp methods))
@@ -4061,7 +5455,8 @@ If given a prefix, show the hidden text instead."
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
(gnus-check-group-server))
- (when (gnus-request-article article group (current-buffer))
+ (cond
+ ((gnus-request-article article group (current-buffer))
(when (numberp article)
(gnus-async-prefetch-next group article
gnus-summary-buffer)
@@ -4069,10 +5464,13 @@ If given a prefix, show the hidden text instead."
(gnus-backlog-enter-article
group article (current-buffer))))
(setq result 'article))
- (if (not result)
- (if methods
- (setq gnus-override-method (pop methods))
- (setq result 'done))))
+ (methods
+ (setq gnus-override-method (pop methods)))
+ ((not (string-match "^400 "
+ (nnheader-get-report backend)))
+ ;; If we get 400 server disconnect, reconnect and
+ ;; retry; otherwise, assume the article has expired.
+ (setq result 'done))))
(and (eq result 'article) 'article)))
;; It was a pseudo.
(t article)))
@@ -4092,7 +5490,7 @@ If given a prefix, show the hidden text instead."
(buffer-disable-undo)
(setq major-mode 'gnus-original-article-mode)
(setq buffer-read-only t))
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))
(setq gnus-original-article (cons group article)))
@@ -4110,7 +5508,7 @@ If given a prefix, show the hidden text instead."
(set-buffer gnus-summary-buffer)
(gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
- (set-window-point (get-buffer-window (current-buffer) t)
+ (set-window-point (gnus-get-buffer-window (current-buffer) t)
(point))
(set-buffer buf))))))
@@ -4126,20 +5524,71 @@ If given a prefix, show the hidden text instead."
(defvar gnus-article-edit-done-function nil)
(defvar gnus-article-edit-mode-map nil)
+(defvar gnus-article-edit-mode nil)
;; Should we be using derived.el for this?
(unless gnus-article-edit-mode-map
- (setq gnus-article-edit-mode-map (make-sparse-keymap))
+ (setq gnus-article-edit-mode-map (make-keymap))
(set-keymap-parent gnus-article-edit-mode-map text-mode-map)
(gnus-define-keys gnus-article-edit-mode-map
+ "\C-c?" describe-mode
"\C-c\C-c" gnus-article-edit-done
- "\C-c\C-k" gnus-article-edit-exit)
+ "\C-c\C-k" gnus-article-edit-exit
+ "\C-c\C-f\C-t" message-goto-to
+ "\C-c\C-f\C-o" message-goto-from
+ "\C-c\C-f\C-b" message-goto-bcc
+ ;;"\C-c\C-f\C-w" message-goto-fcc
+ "\C-c\C-f\C-c" message-goto-cc
+ "\C-c\C-f\C-s" message-goto-subject
+ "\C-c\C-f\C-r" message-goto-reply-to
+ "\C-c\C-f\C-n" message-goto-newsgroups
+ "\C-c\C-f\C-d" message-goto-distribution
+ "\C-c\C-f\C-f" message-goto-followup-to
+ "\C-c\C-f\C-m" message-goto-mail-followup-to
+ "\C-c\C-f\C-k" message-goto-keywords
+ "\C-c\C-f\C-u" message-goto-summary
+ "\C-c\C-f\C-i" message-insert-or-toggle-importance
+ "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to
+ "\C-c\C-b" message-goto-body
+ "\C-c\C-i" message-goto-signature
+
+ "\C-c\C-t" message-insert-to
+ "\C-c\C-n" message-insert-newsgroups
+ "\C-c\C-o" message-sort-headers
+ "\C-c\C-e" message-elide-region
+ "\C-c\C-v" message-delete-not-region
+ "\C-c\C-z" message-kill-to-signature
+ "\M-\r" message-newline-and-reformat
+ "\C-c\C-a" mml-attach-file
+ "\C-a" message-beginning-of-line
+ "\t" message-tab
+ "\M-;" comment-region)
(gnus-define-keys (gnus-article-edit-wash-map
"\C-c\C-w" gnus-article-edit-mode-map)
"f" gnus-article-edit-full-stops))
+(easy-menu-define
+ gnus-article-edit-mode-field-menu gnus-article-edit-mode-map ""
+ '("Field"
+ ["Fetch To" message-insert-to t]
+ ["Fetch Newsgroups" message-insert-newsgroups t]
+ "----"
+ ["To" message-goto-to t]
+ ["From" message-goto-from t]
+ ["Subject" message-goto-subject t]
+ ["Cc" message-goto-cc t]
+ ["Reply-To" message-goto-reply-to t]
+ ["Summary" message-goto-summary t]
+ ["Keywords" message-goto-keywords t]
+ ["Newsgroups" message-goto-newsgroups t]
+ ["Followup-To" message-goto-followup-to t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Distribution" message-goto-distribution t]
+ ["Body" message-goto-body t]
+ ["Signature" message-goto-signature t]))
+
(define-derived-mode gnus-article-edit-mode message-mode "Article Edit"
"Major mode for editing articles.
This is an extended text-mode.
@@ -4149,6 +5598,10 @@ This is an extended text-mode.
(make-local-variable 'gnus-prev-winconf)
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
+ (set (make-local-variable 'mail-header-separator) "")
+ (set (make-local-variable 'gnus-article-edit-mode) t)
+ (easy-menu-add message-mode-field-menu message-mode-map)
+ (mml-mode)
(setq buffer-read-only nil)
(buffer-enable-undo)
(widen))
@@ -4177,6 +5630,7 @@ groups."
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
(funcall start-func)
+ (set-buffer-modified-p nil)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(setq gnus-prev-winconf winconf)
@@ -4185,69 +5639,57 @@ groups."
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
(interactive "P")
- (widen)
- (save-excursion
- (save-restriction
- (when (article-goto-body)
- (let ((lines (count-lines (point) (point-max)))
- (length (- (point-max) (point)))
- (case-fold-search t)
- (body (copy-marker (point))))
- (goto-char (point-min))
- (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string length)))
- (goto-char (point-min))
- (when (re-search-forward
- "^x-content-length:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string length)))
- (goto-char (point-min))
- (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string lines)))))))
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
- (start (window-start)))
- (gnus-article-edit-exit)
+ (start (window-start))
+ (p (point))
+ (winconf gnus-prev-winconf))
+ (widen) ;; Widen it in case that users narrowed the buffer.
+ (funcall func arg)
+ (set-buffer buf)
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
(save-excursion
- (set-buffer buf)
- (let ((inhibit-read-only t))
- (funcall func arg))
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- ;; Flush original article as well.
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current))))
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; We remove all text props from the article buffer.
+ (kill-all-local-variables)
+ (gnus-set-text-properties (point-min) (point-max) nil)
+ (gnus-article-mode)
+ (set-window-configuration winconf)
(set-buffer buf)
(set-window-start (get-buffer-window buf) start)
- (set-window-point (get-buffer-window buf) (point))))
+ (set-window-point (get-buffer-window buf) (point)))
+ (gnus-summary-show-article))
(defun gnus-article-edit-exit ()
"Exit the article editing without updating."
(interactive)
- ;; We remove all text props from the article buffer.
- (let ((buf (buffer-substring-no-properties (point-min) (point-max)))
- (curbuf (current-buffer))
- (p (point))
- (window-start (window-start)))
- (erase-buffer)
- (insert buf)
- (let ((winconf gnus-prev-winconf))
- (gnus-article-mode)
- (set-window-configuration winconf)
- ;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer curbuf)
- (set-window-start (get-buffer-window (current-buffer)) window-start)
- (goto-char p)))))
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p "Article modified; kill anyway? "))
+ (let ((curbuf (current-buffer))
+ (p (point))
+ (window-start (window-start)))
+ (erase-buffer)
+ (if (gnus-buffer-live-p gnus-original-article-buffer)
+ (insert-buffer gnus-original-article-buffer))
+ (let ((winconf gnus-prev-winconf))
+ (kill-all-local-variables)
+ (gnus-article-mode)
+ (set-window-configuration winconf)
+ ;; Tippy-toe some to make sure that point remains where it was.
+ (save-current-buffer
+ (set-buffer curbuf)
+ (set-window-start (get-buffer-window (current-buffer)) window-start)
+ (goto-char p))))
+ (gnus-summary-show-article)))
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
@@ -4268,36 +5710,492 @@ groups."
(defcustom gnus-button-url-regexp
(if (string-match "[[:digit:]]" "1") ;; support POSIX?
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,[:word:]]+[-a-zA-Z0-9_=#$@~`%&*+|\\/[:word:]]\\)"
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)")
+ "\\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:]]\\)"
+ "\\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\\)\\)")
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)
+(defcustom gnus-button-valid-fqdn-regexp
+ message-valid-fqdn-regexp
+ "Regular expression that matches a valid FQDN."
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defcustom gnus-button-man-handler 'manual-entry
+ "Function to use for displaying man pages.
+The function must take at least one argument with a string naming the
+man page."
+ :type '(choice (function-item :tag "Man" manual-entry)
+ (function-item :tag "Woman" woman)
+ (function :tag "Other"))
+ :group 'gnus-article-buttons)
+
+(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
+ "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive.
+If the default site is too slow, try to find a CTAN mirror, see
+<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also
+the variable `gnus-button-handle-ctan'."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
+ (const "http://tug.ctan.org/tex-archive/")
+ (const "http://www.dante.de/CTAN/")
+ (string :tag "Other")))
+
+(defcustom gnus-button-ctan-handler 'browse-url
+ "Function to use for displaying CTAN links.
+The function must take one argument, the string naming the URL."
+ :type '(choice (function-item :tag "Browse Url" browse-url)
+ (function :tag "Other"))
+ :group 'gnus-article-buttons)
+
+(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
+ "Bogus strings removed from CTAN URLs."
+ :group 'gnus-article-buttons
+ :type '(choice (const "^/?tex-archive/\\|/")
+ (regexp :tag "Other")))
+
+(defcustom gnus-button-ctan-directory-regexp
+ (concat
+ "\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20).
+ "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|"
+ "indexing\\|info\\|language\\|macros\\|support\\|systems\\|"
+ "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete"
+ "\\)")
+ "Regular expression for ctan directories.
+It should match all directories in the top level of `gnus-ctan-url'."
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defcustom gnus-button-mid-or-mail-regexp
+ (concat "\\b\\(<?[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*@"
+ ;; Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de>
+ gnus-button-valid-fqdn-regexp
+ ">?\\)\\b")
+ "Regular expression that matches a message ID or a mail address."
+ :group 'gnus-article-buttons
+ :type 'regexp)
+
+(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic
+ "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
+Strings like this can be either a message ID or a mail address. If it is one
+of the symbols `mid' or `mail', Gnus will always assume that the string is a
+message ID or a mail address, respectively. If this variable is set to the
+symbol `ask', always query the user what do do. If it is a function, this
+function will be called with the string as it's only argument. The function
+must return `mid', `mail', `invalid' or `ask'."
+ :group 'gnus-article-buttons
+ :type '(choice (function-item :tag "Heuristic function"
+ gnus-button-mid-or-mail-heuristic)
+ (const ask)
+ (const mid)
+ (const mail)))
+
+(defcustom gnus-button-mid-or-mail-heuristic-alist
+ '((-10.0 . ".+\\$.+@")
+ (-10.0 . "#")
+ (-10.0 . "\\*")
+ (-5.0 . "\\+[^+]*\\+.*@") ;; # two plus signs
+ (-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i
+ (-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i;
+ (-1.0 . "^[^a-z]+@")
+ ;;
+ (-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@"
+ (-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@"
+ (-3.0 . "[A-Z][A-Z][a-z][a-z].*@")
+ (-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@")
+ ;;
+ (-2.0 . "^[0-9]")
+ (-1.0 . "^[0-9][0-9]")
+ ;;
+ ;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/;
+ (-3.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]")
+ ;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/;
+ (-5.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]")
+ ;;
+ (-3.0 . "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@"
+ (-3.0 . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@")
+ ;; "[0-9]{8,}.*\@"
+ (-3.0
+ . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@")
+ ;; "[0-9]{12,}.*\@"
+ ;; compensation for TDMA dated mail addresses:
+ (25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@")
+ ;;
+ (-20.0 . "\\.fsf@") ;; Gnus
+ (-20.0 . "^slrn")
+ (-20.0 . "^Pine")
+ (-20.0 . "_-_") ;; Subject change in thread
+ ;;
+ (-20.0 . "\\.ln@") ;; leafnode
+ (-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de")
+ (-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent
+ ;;
+ ;; (5.0 . "") ;; $local_part_len <= 7
+ (10.0 . "^[^0-9]+@")
+ (3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@")
+ ;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part
+ (3.0 . "\@stud")
+ ;;
+ (2.0 . "[a-z][a-z][._-][A-Z][a-z].*@")
+ ;;
+ (0.5 . "^[A-Z][a-z]")
+ (0.5 . "^[A-Z][a-z][a-z]")
+ (1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3}
+ (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4}
+ "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
+
+A negative RATE indicates a message IDs, whereas a positive indicates a mail
+address. The REGEXP is processed with `case-fold-search' set to nil."
+ :group 'gnus-article-buttons
+ :type '(repeat (cons (number :tag "Rate")
+ (regexp :tag "Regexp"))))
+
+(defun gnus-button-mid-or-mail-heuristic (mid-or-mail)
+ "Guess whether MID-OR-MAIL is a message ID or a mail address.
+Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail
+address, `ask' if unsure and `invalid' if the string is invalid."
+ (let ((case-fold-search nil)
+ (list gnus-button-mid-or-mail-heuristic-alist)
+ (result 0) rate regexp lpartlen elem)
+ (setq lpartlen
+ (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1")))
+ (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen)
+ ;; Certain special cases...
+ (when (string-match
+ (concat
+ "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$\\|"
+ "^[0-9]+\\.[0-9]+@compuserve\\|"
+ "@public\\.gmane\\.org")
+ mid-or-mail)
+ (gnus-message 8 "`%s' is a known mail address." mid-or-mail)
+ (setq result 'mail))
+ (when (string-match "@.*@\\| " mid-or-mail)
+ (gnus-message 8 "`%s' is invalid." mid-or-mail)
+ (setq result 'invalid))
+ ;; Nothing more to do, if result is not a number here...
+ (when (numberp result)
+ (while list
+ (setq elem (car list)
+ rate (car elem)
+ regexp (cdr elem)
+ list (cdr list))
+ (when (string-match regexp mid-or-mail)
+ (setq result (+ result rate))
+ (gnus-message
+ 9 "`%s' matched `%s', rate `%s', result `%s'."
+ mid-or-mail regexp rate result)))
+ (when (<= lpartlen 7)
+ (setq result (+ result 5.0))
+ (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'."
+ mid-or-mail result))
+ (when (>= lpartlen 12)
+ (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail)
+ (cond
+ ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail)
+ ;; Long local part should contain realname if e-mail address,
+ ;; too many digits: message-id.
+ ;; $score -= 5.0 + 0.1 * $local_part_len;
+ (setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen))))
+ (setq result (+ result rate))
+ (gnus-message
+ 9 "Many digits in `%s', rate `%s', result `%s'."
+ mid-or-mail rate result))
+ ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@"
+ mid-or-mail)
+ ;; Too few vowels [^aeiouy]{4,}.*\@
+ (setq result (+ result -5.0))
+ (gnus-message
+ 9 "Few vowels in `%s', rate `%s', result `%s'."
+ mid-or-mail -5.0 result))
+ (t
+ (setq result (+ result 5.0))
+ (gnus-message
+ 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result)))))
+ (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result)
+ ;; Maybe we should make this a customizable alist: (condition . 'result)
+ (cond
+ ((symbolp result) result)
+ ;; Now convert number into proper results:
+ ((< result -10.0) 'mid)
+ ((> result 10.0) 'mail)
+ (t 'ask))))
+
+(defun gnus-button-handle-mid-or-mail (mid-or-mail)
+ (let* ((pref gnus-button-prefer-mid-or-mail) guessed
+ (url-mid (concat "news" ":" mid-or-mail))
+ (url-mailto (concat "mailto" ":" mid-or-mail)))
+ (gnus-message 9 "mid-or-mail=%s" mid-or-mail)
+ (when (fboundp pref)
+ (setq guessed
+ ;; get rid of surrounding angles...
+ (funcall pref
+ (gnus-replace-in-string mid-or-mail "^<\\|>$" "")))
+ (if (or (eq 'mid guessed) (eq 'mail guessed))
+ (setq pref guessed)
+ (setq pref 'ask)))
+ (if (eq pref 'ask)
+ (save-window-excursion
+ (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? "))
+ (setq pref 'mail)
+ (setq pref 'mid))))
+ (cond ((eq pref 'mid)
+ (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid)
+ (gnus-button-handle-news url-mid))
+ ((eq pref 'mail)
+ (gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto)
+ (gnus-url-mailto url-mailto))
+ (t (gnus-message 3 "Invalid string.")))))
+
+(defun gnus-button-handle-custom (url)
+ "Follow a Custom URL."
+ (customize-apropos (gnus-url-unhex-string url)))
+
+(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
+
+;; FIXME: Maybe we should merge some of the functions that do quite similar
+;; stuff?
+
+(defun gnus-button-handle-describe-function (url)
+ "Call `describe-function' when pushing the corresponding URL button."
+ (describe-function
+ (intern
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
+
+(defun gnus-button-handle-describe-variable (url)
+ "Call `describe-variable' when pushing the corresponding URL button."
+ (describe-variable
+ (intern
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
+
+(defun gnus-button-handle-symbol (url)
+"Display help on variable or function.
+Calls `describe-variable' or `describe-function'."
+ (let ((sym (intern url)))
+ (cond
+ ((fboundp sym) (describe-function sym))
+ ((boundp sym) (describe-variable sym))
+ (t (gnus-message 3 "`%s' is not a known function of variable." url)))))
+
+(defun gnus-button-handle-describe-key (url)
+ "Call `describe-key' when pushing the corresponding URL button."
+ (let* ((key-string
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))
+ (keys (ignore-errors (eval `(kbd ,key-string)))))
+ (if keys
+ (describe-key keys)
+ (gnus-message 3 "Invalid key sequence in button: %s" key-string))))
+
+(defun gnus-button-handle-apropos (url)
+ "Call `apropos' when pushing the corresponding URL button."
+ (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-apropos-command (url)
+ "Call `apropos' when pushing the corresponding URL button."
+ (apropos-command
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-apropos-variable (url)
+ "Call `apropos' when pushing the corresponding URL button."
+ (funcall
+ (if (fboundp 'apropos-variable) 'apropos-variable 'apropos)
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-apropos-documentation (url)
+ "Call `apropos' when pushing the corresponding URL button."
+ (funcall
+ (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos)
+ (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
+
+(defun gnus-button-handle-library (url)
+ "Call `locate-library' when pushing the corresponding URL button."
+ (gnus-message 9 "url=`%s'" url)
+ (let* ((lib (locate-library url))
+ (file (gnus-replace-in-string (or lib "") "\.elc" ".el")))
+ (if (not lib)
+ (gnus-message 1 "Cannot locale library `%s'." url)
+ (find-file-read-only file))))
+
+(defun gnus-button-handle-ctan (url)
+ "Call `browse-url' when pushing a CTAN URL button."
+ (funcall
+ gnus-button-ctan-handler
+ (concat
+ gnus-ctan-url
+ (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
+
+(defcustom gnus-button-tex-level 5
+ "*Integer that says how many TeX-related buttons Gnus will show.
+The higher the number, the more buttons will appear and the more false
+positives are possible. Note that you can set this variable local to
+specific groups. Setting it higher in TeX groups is probably a good idea.
+See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
+how to set variables in specific groups."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type 'integer)
+
+(defcustom gnus-button-man-level 5
+ "*Integer that says how many man-related buttons Gnus will show.
+The higher the number, the more buttons will appear and the more false
+positives are possible. Note that you can set this variable local to
+specific groups. Setting it higher in Unix groups is probably a good idea.
+See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
+how to set variables in specific groups."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type 'integer)
+
+(defcustom gnus-button-emacs-level 5
+ "*Integer that says how many emacs-related buttons Gnus will show.
+The higher the number, the more buttons will appear and the more false
+positives are possible. Note that you can set this variable local to
+specific groups. Setting it higher in Emacs or Gnus related groups is
+probably a good idea. See Info node `(gnus)Group Parameters' and the variable
+`gnus-parameters' on how to set variables in specific groups."
+ :group 'gnus-article-buttons
+ :link '(custom-manual "(gnus)Group Parameters")
+ :type 'integer)
+
+(defcustom gnus-button-message-level 5
+ "*Integer that says how many buttons for news or mail messages will appear.
+The higher the number, the more buttons will appear and the more false
+positives are possible."
+ ;; mail addresses, MIDs, URLs for news, ...
+ :group 'gnus-article-buttons
+ :type 'integer)
+
+(defcustom gnus-button-browse-level 5
+ "*Integer that says how many buttons for browsing will appear.
+The higher the number, the more buttons will appear and the more false
+positives are possible."
+ ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
+ :group 'gnus-article-buttons
+ :type 'integer)
+
(defcustom gnus-button-alist
- `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
- 0 t gnus-button-message-id 2)
- ("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1)
- ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
- 1 t
- gnus-button-fetch-group 4)
- ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
- ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
- t gnus-button-message-id 3)
- ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
- ("mailto:\\([-a-zA-Z.@_+0-9%]+\\)" 0 t gnus-url-mailto 1)
- ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
- ;; This is how URLs _should_ be embedded in text...
- ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
- ;; Info manual references.
- ("(\\(info\\|Info-goto-node\\)[ \n\t]+\"\\(([^)\"\n]+)[^\"\n]+\\)\")"
- 0 t Info-goto-node 2)
+ '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
+ 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
+ ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
+ gnus-button-handle-news 2)
+ ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
+ 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
+ ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
+ 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
+ ;; RFC 2392 (Don't allow `/' in domain part --> CID)
+ ("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)"
+ 0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
+ ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
+ 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
+ ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
+ 0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
+ ;; RFC 2368 (The mailto URL scheme)
+ ("mailto:\\([-a-z.@_+0-9%=?&]+\\)"
+ 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
+ ("\\bmailto:\\([^ \n\t]+\\)"
+ 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
+ ;; CTAN
+ ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
+ gnus-button-ctan-directory-regexp
+ "[^][>)!;:,'\n\t ]+\\)")
+ 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
+ ((concat "\\btex-archive/\\("
+ gnus-button-ctan-directory-regexp
+ "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)")
+ 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
+ ((concat
+ "\\b\\("
+ gnus-button-ctan-directory-regexp
+ "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
+ 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
+ ;; This is info (home-grown style) <info://foo/bar+baz>
+ ("\\binfo://\\([^'\">\n\t ]+\\)"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
+ ;; Info GNOME style <info:foo#bar_baz>
+ ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1)
+ ;; Info KDE style <info:(foo)bar baz>
+ ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>"
+ 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
+ ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0
+ (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
+ ;; Info links like `C-h i d m CC Mode RET'
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
+ ;; This is custom
+ ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)"
+ 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2)
+ ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
+ (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
+ ;; Emacs help commands
+ ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ;; regexp doesn't match arguments containing ` '.
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
+ ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1)
+ ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
+ ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
+ ;; The following entries may lead to many false positives so don't enable
+ ;; them by default (use a high button level):
+ ("/\\([a-z][-a-z0-9]+\\.el\\)\\>"
+ 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
+ ("`\\([a-z][-a-z0-9]+\\.el\\)'"
+ 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
+ ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+ 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
+ ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
+ 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
+ ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
+ 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
+ ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
+ ("`\\(\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
+ ;; Unlike the other regexps we really have to require quoting
+ ;; here to determine where it ends.
+ 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
+ ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
+ ("<URL: *\\([^<>]*\\)>"
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; RFC 2396 (2.4.3., delims) ...
+ ("\"URL: *\\([^\"]*\\)\""
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; RFC 2396 (2.4.3., delims) ...
+ ("\"URL: *\\([^\"]*\\)\""
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
;; Raw URLs.
- (,gnus-button-url-regexp 0 t browse-url 0))
+ (gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url 0)
+ ;; man pages
+ ("\\b\\([a-z][a-z]+\\)([1-9])\\W"
+ 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
+ gnus-button-handle-man 1)
+ ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
+ ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W"
+ 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
+ gnus-button-handle-man 1)
+ ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
+ ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
+ ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
+ 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
+ ;; MID or mail: To avoid too many false positives we don't try to catch
+ ;; all kind of allowed MIDs or mail addresses. Domain part must contain
+ ;; at least one dot. TLD must contain two or three chars or be a know TLD
+ ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist'
+ ;; so that non-ambiguous entries (see above) match first.
+ (gnus-button-mid-or-mail-regexp
+ 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1))
"*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string matching text around the button,
+REGEXP: is the string (case insensitive) matching text around the button (can
+also be Lisp expression evaluating to a string),
BUTTON: is the number of the regexp grouping actually matching the button,
FORM: is a Lisp expression which must eval to true for the button to
be added,
@@ -4307,7 +6205,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
CALLBACK can also be a variable, in that case the value of that
variable it the real callback function."
:group 'gnus-article-buttons
- :type '(repeat (list regexp
+ :type '(repeat (list (choice regexp variable sexp)
(integer :tag "Button")
(sexp :tag "Form")
(function :tag "Callback")
@@ -4316,16 +6214,22 @@ variable it the real callback function."
(integer :tag "Regexp group")))))
(defcustom gnus-header-button-alist
- `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
- 0 t gnus-button-message-id 0)
- ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
+ '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
+ 0 (>= gnus-button-message-level 0) gnus-button-message-id 0)
+ ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$"
+ 1 (>= gnus-button-message-level 0) gnus-button-reply 1)
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
- 0 t gnus-button-mailto 0)
- ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0)
- ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0)
- ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0)
- ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
- gnus-button-message-id 3))
+ 0 (>= gnus-button-message-level 0) gnus-button-mailto 0)
+ ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url 0)
+ ("^Subject:" gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url 0)
+ ("^[^:]+:" gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url 0)
+ ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)"
+ 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
+ ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
+ 1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
"*Alist of headers and regexps to match buttons in article heads.
This alist is very similar to `gnus-button-alist', except that each
@@ -4338,7 +6242,7 @@ HEADER is a regexp to match a header. For a fuller explanation, see
:group 'gnus-article-buttons
:group 'gnus-article-headers
:type '(repeat (list (regexp :tag "Header")
- regexp
+ (choice regexp variable)
(integer :tag "Button")
(sexp :tag "Form")
(function :tag "Callback")
@@ -4362,7 +6266,7 @@ call it with the value of the `gnus-data' text property."
(interactive "e")
(set-buffer (window-buffer (posn-window (event-start event))))
(let* ((pos (posn-point (event-start event)))
- (data (get-text-property pos 'gnus-data))
+ (data (get-text-property pos 'gnus-data))
(fun (get-text-property pos 'gnus-callback)))
(goto-char pos)
(when fun
@@ -4373,8 +6277,8 @@ call it with the value of the `gnus-data' text property."
If the text at point has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
(interactive)
- (let* ((data (get-text-property (point) 'gnus-data))
- (fun (get-text-property (point) 'gnus-callback)))
+ (let ((data (get-text-property (point) 'gnus-data))
+ (fun (get-text-property (point) 'gnus-callback)))
(when fun
(funcall fun data))))
@@ -4493,7 +6397,7 @@ specified by `gnus-button-alist'."
(article-goto-body)
(setq beg (point))
(while (setq entry (pop alist))
- (setq regexp (car entry))
+ (setq regexp (eval (car entry)))
(goto-char beg)
(while (re-search-forward regexp nil t)
(let* ((start (and entry (match-beginning (nth 1 entry))))
@@ -4535,7 +6439,7 @@ specified by `gnus-button-alist'."
(match-beginning 0))
(point-max)))
(goto-char beg)
- (while (re-search-forward (nth 1 entry) end t)
+ (while (re-search-forward (eval (nth 1 entry)) end t)
;; Each match within a header.
(let* ((entry (cdr entry))
(start (match-beginning (nth 1 entry)))
@@ -4578,14 +6482,19 @@ specified by `gnus-button-alist'."
(let ((inhibit-read-only t)
(inhibit-point-motion-hooks t))
(if (text-property-any end (point-max) 'article-type 'signature)
- (gnus-remove-text-properties-when
- 'article-type 'signature end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties)))
+ (progn
+ (gnus-delete-wash-type 'signature)
+ (gnus-remove-text-properties-when
+ 'article-type 'signature end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties))))
+ (gnus-add-wash-type 'signature)
(gnus-add-text-properties-when
'article-type nil end (point-max)
(cons 'article-type (cons 'signature
- gnus-hidden-properties)))))))
+ gnus-hidden-properties)))))
+ (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
+ (gnus-set-mode-line 'article))))
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
@@ -4593,7 +6502,7 @@ specified by `gnus-button-alist'."
(entry nil))
(while alist
(setq entry (pop alist))
- (if (looking-at (car entry))
+ (if (looking-at (eval (car entry)))
(setq alist nil)
(setq entry nil)))
entry))
@@ -4621,6 +6530,90 @@ specified by `gnus-button-alist'."
(gnus-message 1 "You must define `%S' to use this button"
(cons fun args)))))))
+(defun gnus-parse-news-url (url)
+ (let (scheme server group message-id articles)
+ (with-temp-buffer
+ (insert url)
+ (goto-char (point-min))
+ (when (looking-at "\\([A-Za-z]+\\):")
+ (setq scheme (match-string 1))
+ (goto-char (match-end 0)))
+ (when (looking-at "//\\([^/]+\\)/")
+ (setq server (match-string 1))
+ (goto-char (match-end 0)))
+
+ (cond
+ ((looking-at "\\(.*@.*\\)")
+ (setq message-id (match-string 1)))
+ ((looking-at "\\([^/]+\\)/\\([-0-9]+\\)")
+ (setq group (match-string 1)
+ articles (split-string (match-string 2) "-")))
+ ((looking-at "\\([^/]+\\)/?")
+ (setq group (match-string 1)))
+ (t
+ (error "Unknown news URL syntax"))))
+ (list scheme server group message-id articles)))
+
+(defun gnus-button-handle-news (url)
+ "Fetch a news URL."
+ (destructuring-bind (scheme server group message-id articles)
+ (gnus-parse-news-url url)
+ (cond
+ (message-id
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if server
+ (let ((gnus-refer-article-method (list (list 'nntp server))))
+ (gnus-summary-refer-article message-id))
+ (gnus-summary-refer-article message-id))))
+ (group
+ (gnus-button-fetch-group url)))))
+
+(defun gnus-button-handle-man (url)
+ "Fetch a man page."
+ (funcall gnus-button-man-handler url))
+
+(defun gnus-button-handle-info-url (url)
+ "Fetch an info URL."
+ (setq url (mm-subst-char-in-string ?+ ?\ url))
+ (cond
+ ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url)
+ (gnus-info-find-node
+ (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
+ "Gnus")
+ ")" (gnus-url-unhex-string (match-string 2 url)))))
+ ((string-match "([^)\"]+)[^\"]+" url)
+ (setq url
+ (gnus-replace-in-string
+ (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
+ (gnus-info-find-node url))
+ (t (error "Can't parse %s" url))))
+
+(defun gnus-button-handle-info-url-gnome (url)
+ "Fetch GNOME style info URL."
+ (setq url (mm-subst-char-in-string ?_ ?\ url))
+ (if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
+ (gnus-info-find-node
+ (concat "("
+ (gnus-url-unhex-string
+ (match-string 1 url))
+ ")"
+ (or (gnus-url-unhex-string
+ (match-string 2 url))
+ "Top")))
+ (error "Can't parse %s" url)))
+
+(defun gnus-button-handle-info-url-kde (url)
+ "Fetch KDE style info URL."
+ (gnus-info-find-node (gnus-url-unhex-string url)))
+
+(defun gnus-button-handle-info-keystrokes (url)
+ "Call `info' when pushing the corresponding URL button."
+ ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
+ (info)
+ (Info-directory)
+ (Info-menu url))
+
(defun gnus-button-message-id (message-id)
"Fetch MESSAGE-ID."
(save-excursion
@@ -4632,8 +6625,10 @@ specified by `gnus-button-alist'."
(if (not (string-match "[:/]" address))
;; This is just a simple group url.
(gnus-group-read-ephemeral-group address gnus-select-method)
- (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$"
- address))
+ (if (not
+ (string-match
+ "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?"
+ address))
(error "Can't parse %s" address)
(gnus-group-read-ephemeral-group
(match-string 4 address)
@@ -4641,89 +6636,56 @@ specified by `gnus-button-alist'."
(nntp-address ,(match-string 1 address))
(nntp-port-number ,(if (match-end 3)
(match-string 3 address)
- "nntp")))))))
+ "nntp")))
+ nil nil nil
+ (and (match-end 6) (list (string-to-int (match-string 6 address))))))))
(defun gnus-url-parse-query-string (query &optional downcase)
(let (retval pairs cur key val)
(setq pairs (split-string query "&"))
(while pairs
(setq cur (car pairs)
- pairs (cdr pairs))
+ pairs (cdr pairs))
(if (not (string-match "=" cur))
- nil ; Grace
- (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
- val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
- (if downcase
- (setq key (downcase key)))
- (setq cur (assoc key retval))
- (if cur
- (setcdr cur (cons val (cdr cur)))
- (setq retval (cons (list key val) retval)))))
+ nil ; Grace
+ (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
+ val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
+ (if downcase
+ (setq key (downcase key)))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
retval))
-(defun gnus-url-unhex (x)
- (if (> x ?9)
- (if (>= x ?a)
- (+ 10 (- x ?a))
- (+ 10 (- x ?A)))
- (- x ?0)))
-
-(defun gnus-url-unhex-string (str &optional allow-newlines)
- "Remove %XXX embedded spaces, etc in a url.
-If optional second argument ALLOW-NEWLINES is non-nil, then allow the
-decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
- (setq str (or str ""))
- (let ((tmp "")
- (case-fold-search t))
- (while (string-match "%[0-9a-f][0-9a-f]" str)
- (let* ((start (match-beginning 0))
- (ch1 (gnus-url-unhex (elt str (+ start 1))))
- (code (+ (* 16 ch1)
- (gnus-url-unhex (elt str (+ start 2))))))
- (setq tmp (concat
- tmp (substring str 0 start)
- (cond
- (allow-newlines
- (char-to-string code))
- ((or (= code ?\n) (= code ?\r))
- " ")
- (t (char-to-string code))))
- str (substring str (match-end 0)))))
- (setq tmp (concat tmp str))
- tmp))
-
(defun gnus-url-mailto (url)
;; Send mail to someone
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
(let (to args subject func)
- (if (string-match (regexp-quote "?") url)
- (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
- args (gnus-url-parse-query-string
- (substring url (match-end 0) nil) t))
- (setq to (gnus-url-unhex-string url)))
- (setq args (cons (list "to" to) args)
- subject (cdr-safe (assoc "subject" args)))
- (message-mail)
+ (setq args (gnus-url-parse-query-string
+ (if (string-match "^\\?" url)
+ (substring url 1)
+ (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
+ (concat "to=" (match-string 1 url) "&"
+ (match-string 2 url))
+ (concat "to=" url)))
+ t)
+ subject (cdr-safe (assoc "subject" args)))
+ (gnus-msg-mail)
(while args
(setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
(if (fboundp func)
- (funcall func)
- (message-position-on-field (caar args)))
- (insert (mapconcat 'identity (cdar args) ", "))
+ (funcall func)
+ (message-position-on-field (caar args)))
+ (insert (gnus-replace-in-string
+ (mapconcat 'identity (reverse (cdar args)) ", ")
+ "\r\n" "\n" t))
(setq args (cdr args)))
(if subject
- (message-goto-body)
+ (message-goto-body)
(message-goto-subject))))
-(defun gnus-button-mailto (address)
- "Mail to ADDRESS."
- (set-buffer (gnus-copy-article-buffer))
- (message-reply address))
-
-(defalias 'gnus-button-reply 'message-reply)
-
(defun gnus-button-embedded-url (address)
"Activate ADDRESS with `browse-url'."
(browse-url (gnus-strip-whitespace address)))
@@ -4733,56 +6695,78 @@ forbidden in URL encoding."
(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
-(defvar gnus-prev-page-map nil)
-(unless gnus-prev-page-map
- (setq gnus-prev-page-map (make-sparse-keymap))
- (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
- (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
+(defvar gnus-prev-page-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= emacs-major-version 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
+ (define-key map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key map "\r" 'gnus-button-prev-page)
+ map))
+
+(defvar gnus-next-page-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= emacs-major-version 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
+ (define-key map gnus-mouse-2 'gnus-button-next-page)
+ (define-key map "\r" 'gnus-button-next-page)
+ map))
(defun gnus-insert-prev-page-button ()
- (let ((inhibit-read-only t))
+ (let ((b (point))
+ (inhibit-read-only t))
(gnus-eval-format
gnus-prev-page-line-format nil
- `(gnus-prev t local-map ,gnus-prev-page-map
- gnus-callback gnus-article-button-prev-page
- article-type annotation))))
-
-(defvar gnus-next-page-map nil)
-(unless gnus-next-page-map
- (setq gnus-next-page-map (make-keymap))
- (suppress-keymap gnus-prev-page-map)
- (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
- (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
-
-(defun gnus-button-next-page ()
+ `(,@(gnus-local-map-property gnus-prev-page-map)
+ gnus-prev t
+ gnus-callback gnus-article-button-prev-page
+ article-type annotation))
+ (widget-convert-button
+ 'link b (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point))
+ :action 'gnus-button-prev-page
+ :button-keymap gnus-prev-page-map)))
+
+(defun gnus-button-next-page (&optional args more-args)
"Go to the next page."
(interactive)
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
(select-window win)))
-(defun gnus-button-prev-page ()
+(defun gnus-button-prev-page (&optional args more-args)
"Go to the prev page."
(interactive)
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
(select-window win)))
(defun gnus-insert-next-page-button ()
- (let ((inhibit-read-only t))
+ (let ((b (point))
+ (inhibit-read-only t))
(gnus-eval-format gnus-next-page-line-format nil
- `(gnus-next
- t local-map ,gnus-next-page-map
- gnus-callback gnus-article-button-next-page
- article-type annotation))))
+ `(,@(gnus-local-map-property gnus-next-page-map)
+ gnus-next t
+ gnus-callback gnus-article-button-next-page
+ article-type annotation))
+ (widget-convert-button
+ 'link b (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point))
+ :action 'gnus-button-next-page
+ :button-keymap gnus-next-page-map)))
(defun gnus-article-button-next-page (arg)
"Go to the next page."
(interactive "P")
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
(select-window win)))
@@ -4790,7 +6774,7 @@ forbidden in URL encoding."
"Go to the prev page."
(interactive "P")
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
(select-window win)))
@@ -4800,7 +6784,7 @@ forbidden in URL encoding."
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only applied to these newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
whose names match REGEXP.
For example:
@@ -4850,11 +6834,11 @@ For example:
(highlightp (gnus-visual-p 'article-highlight 'highlight))
val elem)
(gnus-run-hooks 'gnus-part-display-hook)
- (while (setq elem (pop alist))
+ (dolist (elem alist)
(setq val
(save-excursion
- (if (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-summary-buffer))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-summary-buffer))
(symbol-value (car elem))))
(when (and (or (consp val)
treated-type)
@@ -4876,6 +6860,8 @@ For example:
(cond
((null val)
nil)
+ (condition
+ (eq condition val))
((and (listp val)
(stringp (car val)))
(apply 'gnus-or (mapcar `(lambda (s)
@@ -4894,8 +6880,6 @@ For example:
(equal (car val) type))
(t
(error "%S is not a valid predicate" pred)))))
- (condition
- (eq condition val))
((eq val t)
t)
((eq val 'head)
@@ -4907,6 +6891,251 @@ For example:
(t
(error "%S is not a valid value" val))))
+(defun gnus-article-encrypt-body (protocol &optional n)
+ "Encrypt the article body."
+ (interactive
+ (list
+ (or gnus-article-encrypt-protocol
+ (completing-read "Encrypt protocol: "
+ gnus-article-encrypt-protocol-alist
+ nil t))
+ current-prefix-arg))
+ (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
+ (unless func
+ (error (format "Can't find the encrypt protocol %s" protocol)))
+ (if (member gnus-newsgroup-name '("nndraft:delayed"
+ "nndraft:drafts"
+ "nndraft:queue"))
+ (error "Can't encrypt the article in group %s"
+ gnus-newsgroup-name))
+ (gnus-summary-iterate n
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
+ (summary-buffer gnus-summary-buffer)
+ references point)
+ (gnus-set-global-variables)
+ (when (gnus-group-read-only-p)
+ (error "The current newsgroup does not support article encrypt"))
+ (gnus-summary-show-article t)
+ (setq references
+ (or (mail-header-references gnus-current-headers) ""))
+ (set-buffer gnus-article-buffer)
+ (let* ((inhibit-read-only t)
+ (headers
+ (mapcar (lambda (field)
+ (and (save-restriction
+ (message-narrow-to-head)
+ (goto-char (point-min))
+ (search-forward field nil t))
+ (prog2
+ (message-narrow-to-field)
+ (buffer-string)
+ (delete-region (point-min) (point-max))
+ (widen))))
+ '("Content-Type:" "Content-Transfer-Encoding:"
+ "Content-Disposition:"))))
+ (message-narrow-to-head)
+ (message-remove-header "MIME-Version")
+ (goto-char (point-max))
+ (setq point (point))
+ (insert (apply 'concat headers))
+ (widen)
+ (narrow-to-region point (point-max))
+ (let ((message-options message-options))
+ (message-options-set 'message-sender user-mail-address)
+ (message-options-set 'message-recipients user-mail-address)
+ (message-options-set 'message-sign-encrypt 'not)
+ (funcall func))
+ (goto-char (point-min))
+ (insert "MIME-Version: 1.0\n")
+ (widen)
+ (gnus-summary-edit-article-done
+ references nil summary-buffer t))
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current))))))))
+
+(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n"
+ "The following specs can be used:
+%t The security MIME type
+%i Additional info
+%d Details
+%D Details if button is pressed")
+
+(defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n"
+ "The following specs can be used:
+%t The security MIME type
+%i Additional info
+%d Details
+%D Details if button is pressed")
+
+(defvar gnus-mime-security-button-line-format-alist
+ '((?t gnus-tmp-type ?s)
+ (?i gnus-tmp-info ?s)
+ (?d gnus-tmp-details ?s)
+ (?D gnus-tmp-pressed-details ?s)))
+
+(defvar gnus-mime-security-button-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= (string-to-number emacs-version) 21)
+ (set-keymap-parent map gnus-article-mode-map))
+ (define-key map gnus-mouse-2 'gnus-article-push-button)
+ (define-key map "\r" 'gnus-article-press-button)
+ map))
+
+(defvar gnus-mime-security-details-buffer nil)
+
+(defvar gnus-mime-security-button-pressed nil)
+
+(defvar gnus-mime-security-show-details-inline t
+ "If non-nil, show details in the article buffer.")
+
+(defun gnus-mime-security-verify-or-decrypt (handle)
+ (mm-remove-parts (cdr handle))
+ (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
+ point (inhibit-read-only t))
+ (if region
+ (goto-char (car region)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (with-current-buffer (mm-handle-multipart-original-buffer handle)
+ (let* ((mm-verify-option 'known)
+ (mm-decrypt-option 'known)
+ (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+ (unless (eq nparts (cdr handle))
+ (mm-destroy-parts (cdr handle))
+ (setcdr handle nparts))))
+ (setq point (point))
+ (gnus-mime-display-security handle)
+ (goto-char (point-max)))
+ (when region
+ (delete-region (point) (cdr region))
+ (set-marker (car region) nil)
+ (set-marker (cdr region) nil))
+ (goto-char point)))
+
+(defun gnus-mime-security-show-details (handle)
+ (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
+ (if (not details)
+ (gnus-message 5 "No details.")
+ (if gnus-mime-security-show-details-inline
+ (let ((gnus-mime-security-button-pressed
+ (not (get-text-property (point) 'gnus-mime-details)))
+ (gnus-mime-security-button-line-format
+ (get-text-property (point) 'gnus-line-format))
+ (inhibit-read-only t))
+ (forward-char -1)
+ (while (eq (get-text-property (point) 'gnus-line-format)
+ gnus-mime-security-button-line-format)
+ (forward-char -1))
+ (forward-char)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (gnus-insert-mime-security-button handle))
+ (delete-region (point)
+ (or (text-property-not-all
+ (point) (point-max)
+ 'gnus-line-format
+ gnus-mime-security-button-line-format)
+ (point-max))))
+ ;; Not inlined.
+ (if (gnus-buffer-live-p gnus-mime-security-details-buffer)
+ (with-current-buffer gnus-mime-security-details-buffer
+ (erase-buffer)
+ t)
+ (setq gnus-mime-security-details-buffer
+ (gnus-get-buffer-create "*MIME Security Details*")))
+ (with-current-buffer gnus-mime-security-details-buffer
+ (insert details)
+ (goto-char (point-min)))
+ (pop-to-buffer gnus-mime-security-details-buffer)))))
+
+(defun gnus-mime-security-press-button (handle)
+ (save-excursion
+ (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ (gnus-mime-security-show-details handle)
+ (gnus-mime-security-verify-or-decrypt handle))))
+
+(defun gnus-insert-mime-security-button (handle &optional displayed)
+ (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
+ (gnus-tmp-type
+ (concat
+ (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (nth 2 (assoc protocol mm-decrypt-function-alist))
+ "Unknown")
+ (if (equal (car handle) "multipart/signed")
+ " Signed" " Encrypted")
+ " Part"))
+ (gnus-tmp-info
+ (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ "Undecided"))
+ (gnus-tmp-details
+ (mm-handle-multipart-ctl-parameter handle 'gnus-details))
+ gnus-tmp-pressed-details
+ b e)
+ (setq gnus-tmp-details
+ (if gnus-tmp-details
+ (concat "\n" gnus-tmp-details)
+ ""))
+ (setq gnus-tmp-pressed-details
+ (if gnus-mime-security-button-pressed gnus-tmp-details ""))
+ (unless (bolp)
+ (insert "\n"))
+ (setq b (point))
+ (gnus-eval-format
+ gnus-mime-security-button-line-format
+ gnus-mime-security-button-line-format-alist
+ `(,@(gnus-local-map-property gnus-mime-security-button-map)
+ gnus-callback gnus-mime-security-press-button
+ gnus-line-format ,gnus-mime-security-button-line-format
+ gnus-mime-details ,gnus-mime-security-button-pressed
+ article-type annotation
+ gnus-data ,handle))
+ (setq e (if (bolp)
+ ;; Exclude a newline.
+ (1- (point))
+ (point)))
+ (widget-convert-button
+ 'link b e
+ :mime-handle handle
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-mime-security-button-map
+ :help-echo
+ (lambda (widget/window &optional overlay pos)
+ ;; Needed to properly clear the message due to a bug in
+ ;; wid-edit (XEmacs only).
+ (when (boundp 'help-echo-owns-message)
+ (setq help-echo-owns-message t))
+ (format
+ "%S: show detail"
+ (aref gnus-mouse-2 0))))))
+
+(defun gnus-mime-display-security (handle)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (unless (gnus-unbuttonized-mime-type-p (car handle))
+ (gnus-insert-mime-security-button handle))
+ (gnus-mime-display-mixed (cdr handle))
+ (unless (bolp)
+ (insert "\n"))
+ (unless (gnus-unbuttonized-mime-type-p (car handle))
+ (let ((gnus-mime-security-button-line-format
+ gnus-mime-security-button-end-line-format))
+ (gnus-insert-mime-security-button handle)))
+ (mm-set-handle-multipart-parameter
+ handle 'gnus-region
+ (cons (set-marker (make-marker) (point-min))
+ (set-marker (make-marker) (point-max))))))
+
(gnus-ems-redefine)
(provide 'gnus-art)
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index 6c34859ee71..43ab0bc887d 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -1,5 +1,6 @@
;;; gnus-async.el --- asynchronous support for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -35,12 +36,6 @@
"Support for asynchronous operations."
:group 'gnus)
-(defcustom gnus-asynchronous nil
- "*If nil, inhibit all Gnus asynchronicity.
-If non-nil, let the other asynch variables be heeded."
- :group 'gnus-asynchronous
- :type 'boolean)
-
(defcustom gnus-use-article-prefetch 30
"*If non-nil, prefetch articles in groups that allow this.
If a number, prefetch only that many articles forward;
@@ -50,6 +45,12 @@ if t, prefetch as many articles as possible."
(const :tag "all" t)
(integer :tag "some" 0)))
+(defcustom gnus-asynchronous nil
+ "*If nil, inhibit all Gnus asynchronicity.
+If non-nil, let the other asynch variables be heeded."
+ :group 'gnus-asynchronous
+ :type 'boolean)
+
(defcustom gnus-prefetched-article-deletion-strategy '(read exit)
"List of symbols that say when to remove articles from the prefetch buffer.
Possible values in this list are `read', which means that
@@ -276,15 +277,16 @@ It should return non-nil if the article is to be prefetched."
;; needs to be done in nntp.el.
(while (eq article gnus-async-current-prefetch-article)
(incf tries)
- (when (nntp-accept-process-output proc 1)
+ (when (nntp-accept-process-output proc)
(setq tries 0))
- (when (and (not nntp-have-messaged) (eq 3 tries))
+ (when (and (not nntp-have-messaged)
+ (= tries 3))
(gnus-message 5 "Waiting for async article...")
(setq nntp-have-messaged t)))
(quit
;; if the user interrupted on a slow/hung connection,
;; do something friendly.
- (when (< 3 tries)
+ (when (> tries 3)
(setq gnus-async-current-prefetch-article nil))
(signal 'quit nil)))
(when nntp-have-messaged
diff --git a/lisp/gnus/gnus-audio.el b/lisp/gnus/gnus-audio.el
index 349e3ff7732..1171713f358 100644
--- a/lisp/gnus/gnus-audio.el
+++ b/lisp/gnus/gnus-audio.el
@@ -1,5 +1,5 @@
-;;; gnus-audio.el --- sound effects for Gnus
-;; Copyright (C) 1996, 2000 Free Software Foundation
+;;; gnus-audio.el --- Sound effects for Gnus
+;; Copyright (C) 1996, 2000, 2003 Free Software Foundation
;; Author: Steven L. Baur <steve@miranova.com>
;; Keywords: news, mail, multimedia
@@ -47,15 +47,15 @@
:type '(choice directory (const nil))
:group 'gnus-audio)
-(defcustom gnus-audio-au-player "/usr/bin/showaudio"
+(defcustom gnus-audio-au-player (executable-find "play")
"Executable program for playing sun AU format sound files."
:group 'gnus-audio
- :type 'string)
+ :type '(choice file (const nil)))
-(defcustom gnus-audio-wav-player "/usr/local/bin/play"
+(defcustom gnus-audio-wav-player (executable-find "play")
"Executable program for playing WAV files."
:group 'gnus-audio
- :type 'string)
+ :type '(choice file (const nil)))
;;; The following isn't implemented yet. Wait for Millennium Gnus.
;;(defvar gnus-audio-effects-enabled t
@@ -93,7 +93,7 @@
;;;###autoload
(defun gnus-audio-play (file)
"Play a sound FILE through the speaker."
- (interactive)
+ (interactive "fSound file name: ")
(let ((sound-file (if (file-exists-p file)
file
(expand-file-name file gnus-audio-directory))))
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index 34a80924ed9..e6564c45b33 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -1,5 +1,6 @@
;;; gnus-bcklg.el --- backlog functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -55,36 +56,39 @@
(defun gnus-backlog-shutdown ()
"Clear all backlog variables and buffers."
+ (interactive)
(when (get-buffer gnus-backlog-buffer)
- (kill-buffer gnus-backlog-buffer))
+ (gnus-kill-buffer gnus-backlog-buffer))
(setq gnus-backlog-hashtb nil
gnus-backlog-articles nil))
(defun gnus-backlog-enter-article (group number buffer)
- (gnus-backlog-setup)
- (let ((ident (intern (concat group ":" (int-to-string number))
- gnus-backlog-hashtb))
- b)
- (if (memq ident gnus-backlog-articles)
- () ; It's already kept.
+ (when (and (numberp number)
+ (not (string-match "^nnvirtual" group)))
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
+ b)
+ (if (memq ident gnus-backlog-articles)
+ () ; It's already kept.
;; Remove the oldest article, if necessary.
- (and (numberp gnus-keep-backlog)
- (>= (length gnus-backlog-articles) gnus-keep-backlog)
+ (and (numberp gnus-keep-backlog)
+ (>= (length gnus-backlog-articles) gnus-keep-backlog)
(gnus-backlog-remove-oldest-article))
- (push ident gnus-backlog-articles)
- ;; Insert the new article.
- (save-excursion
- (set-buffer (gnus-backlog-buffer))
- (let (buffer-read-only)
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (setq b (point))
- (insert-buffer-substring buffer)
- ;; Tag the beginning of the article with the ident.
- (if (> (point-max) b)
+ (push ident gnus-backlog-articles)
+ ;; Insert the new article.
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (let (buffer-read-only)
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (setq b (point))
+ (insert-buffer-substring buffer)
+ ;; Tag the beginning of the article with the ident.
+ (if (> (point-max) b)
(gnus-put-text-property b (1+ b) 'gnus-backlog ident)
- (gnus-error 3 "Article %d is blank" number)))))))
+ (gnus-error 3 "Article %d is blank" number))))))))
(defun gnus-backlog-remove-oldest-article ()
(save-excursion
@@ -127,7 +131,8 @@
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))))))
(defun gnus-backlog-request-article (group number &optional buffer)
- (when (numberp number)
+ (when (and (numberp number)
+ (not (string-match "^nnvirtual" group)))
(gnus-backlog-setup)
(let ((ident (intern (concat group ":" (int-to-string number))
gnus-backlog-hashtb))
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 834a1788123..bc09b3a2368 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -1,5 +1,5 @@
;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -33,6 +33,8 @@
(require 'gnus-range)
(require 'gnus-start)
(eval-when-compile
+ (if (not (fboundp 'gnus-agent-load-alist))
+ (defun gnus-agent-load-alist (group)))
(require 'gnus-sum))
(defcustom gnus-cache-active-file
@@ -160,11 +162,7 @@ it's not cached."
(when (and number
(> number 0) ; Reffed article.
(or force
- (and (or (not gnus-cacheable-groups)
- (string-match gnus-cacheable-groups group))
- (or (not gnus-uncacheable-groups)
- (not (string-match
- gnus-uncacheable-groups group)))
+ (and (gnus-cache-fully-p group)
(gnus-cache-member-of-class
gnus-cache-enter-articles ticked dormant unread)))
(not (file-exists-p (setq file (gnus-cache-file-name
@@ -183,7 +181,8 @@ it's not cached."
(when (> (buffer-size) 0)
(let ((coding-system-for-write gnus-cache-coding-system))
(gnus-write-buffer file))
- (setq headers (nnheader-parse-head t))
+ (nnheader-remove-body)
+ (setq headers (nnheader-parse-naked-head))
(mail-header-set-number headers number)
(gnus-cache-change-buffer group)
(set-buffer (cdr gnus-cache-buffer))
@@ -209,8 +208,9 @@ it's not cached."
(nnheader-insert-nov headers)
;; Update the active info.
(set-buffer gnus-summary-buffer)
- (gnus-cache-update-active group number)
- (push article gnus-newsgroup-cached)
+ (gnus-cache-possibly-update-active group (cons number number))
+ (setq gnus-newsgroup-cached
+ (gnus-add-to-sorted-list gnus-newsgroup-cached article))
(gnus-summary-update-secondary-mark article))
t))))))
@@ -235,7 +235,7 @@ it's not cached."
(defun gnus-cache-possibly-remove-articles-1 ()
"Possibly remove some of the removable articles."
- (unless (eq gnus-use-cache 'passive)
+ (when (gnus-cache-fully-p gnus-newsgroup-name)
(let ((articles gnus-cache-removable-articles)
(cache-articles gnus-newsgroup-cached)
article)
@@ -283,9 +283,7 @@ it's not cached."
;; the normal way.
(let ((gnus-use-cache nil))
(gnus-retrieve-headers articles group fetch-old))
- (let ((uncached-articles (gnus-sorted-intersection
- (gnus-sorted-complement articles cached)
- articles))
+ (let ((uncached-articles (gnus-sorted-difference articles cached))
(cache-file (gnus-cache-file-name group ".overview"))
type)
;; We first retrieve all the headers that we don't have in
@@ -335,14 +333,16 @@ Returns the list of articles entered."
(when (gnus-cache-possibly-enter-article
gnus-newsgroup-name article
nil nil nil t)
+ (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded))
(push article out))
(gnus-message 2 "Can't cache article %d" article))
+ (gnus-summary-update-download-mark article)
(gnus-summary-update-secondary-mark article))
(gnus-summary-next-subject 1)
(gnus-summary-position-point)
(nreverse out)))
-(defun gnus-cache-remove-article (n)
+(defun gnus-cache-remove-article (&optional n)
"Remove the next N articles from the cache.
If not given a prefix, use the process marked articles instead.
Returns the list of articles removed."
@@ -354,7 +354,14 @@ Returns the list of articles removed."
(setq article (pop articles))
(gnus-summary-remove-process-mark article)
(when (gnus-cache-possibly-remove-article article nil nil nil t)
+ (when gnus-newsgroup-agentized
+ (let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
+ (unless (cdr (assoc article alist))
+ (setq gnus-newsgroup-undownloaded
+ (gnus-add-to-sorted-list
+ gnus-newsgroup-undownloaded article)))))
(push article out))
+ (gnus-summary-update-download-mark article)
(gnus-summary-update-secondary-mark article))
(gnus-summary-next-subject 1)
(gnus-summary-position-point)
@@ -367,15 +374,20 @@ Returns the list of articles removed."
(defun gnus-summary-insert-cached-articles ()
"Insert all the articles cached for this group into the current buffer."
(interactive)
- (let ((cached (sort (copy-sequence gnus-newsgroup-cached) '>))
- (gnus-verbose (max 6 gnus-verbose)))
- (unless cached
- (gnus-message 3 "No cached articles for this group"))
- (while cached
- (gnus-summary-goto-subject (pop cached) t))))
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if (not gnus-newsgroup-cached)
+ (gnus-message 3 "No cached articles for this group")
+ (gnus-summary-goto-subjects gnus-newsgroup-cached))))
-(defalias 'gnus-summary-limit-include-cached
- 'gnus-summary-insert-cached-articles)
+(defun gnus-summary-limit-include-cached ()
+ "Limit the summary buffer to articles that are cached."
+ (interactive)
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if gnus-newsgroup-cached
+ (progn
+ (gnus-summary-limit gnus-newsgroup-cached)
+ (gnus-summary-position-point))
+ (gnus-message 3 "No cached articles for this group"))))
;;; Internal functions.
@@ -422,7 +434,8 @@ Returns the list of articles removed."
?. ?_)))
;; Translate the first colon into a slash.
(when (string-match ":" group)
- (aset group (match-beginning 0) ?/))
+ (setq group (concat (substring group 0 (match-beginning 0))
+ "/" (substring group (match-end 0)))))
(nnheader-replace-chars-in-string group ?. ?/)))
t)
gnus-cache-directory))))
@@ -460,10 +473,11 @@ Returns the list of articles removed."
(when (or (looking-at (concat (int-to-string number) "\t"))
(search-forward (concat "\n" (int-to-string number) "\t")
(point-max) t))
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))))
- (setq gnus-newsgroup-cached
- (delq article gnus-newsgroup-cached))
+ (gnus-delete-line)))
+ (unless (setq gnus-newsgroup-cached
+ (delq article gnus-newsgroup-cached))
+ (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
+ (setq gnus-cache-active-altered t))
(gnus-summary-update-secondary-mark article)
t)))
@@ -477,9 +491,13 @@ Returns the list of articles removed."
(directory-files dir nil "^[0-9]+$" t))
'<))
;; Update the cache active file, just to synch more.
- (when articles
- (gnus-cache-update-active group (car articles) t)
- (gnus-cache-update-active group (car (last articles))))
+ (if articles
+ (progn
+ (gnus-cache-update-active group (car articles) t)
+ (gnus-cache-update-active group (car (last articles))))
+ (when (gnus-gethash group gnus-cache-active-hashtb)
+ (gnus-sethash group nil gnus-cache-active-hashtb)
+ (setq gnus-cache-active-altered t)))
articles)))
(defun gnus-cache-braid-nov (group cached &optional file)
@@ -503,13 +521,13 @@ Returns the list of articles removed."
(< (read (current-buffer)) (car cached)))
(forward-line 1))
(beginning-of-line)
- (save-excursion
- (set-buffer cache-buf)
- (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
- nil t)
- (setq beg (progn (beginning-of-line) (point))
- end (progn (end-of-line) (point)))
- (setq beg nil)))
+ (set-buffer cache-buf)
+ (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
+ nil t)
+ (setq beg (gnus-point-at-bol)
+ end (progn (end-of-line) (point)))
+ (setq beg nil))
+ (set-buffer nntp-server-buffer)
(when beg
(insert-buffer-substring cache-buf beg end)
(insert "\n"))
@@ -531,20 +549,20 @@ Returns the list of articles removed."
(car cached)))
(search-forward "\n.\n" nil 'move))
(beginning-of-line)
- (save-excursion
- (set-buffer cache-buf)
- (erase-buffer)
- (let ((coding-system-for-read
- gnus-cache-coding-system))
- (insert-file-contents (gnus-cache-file-name group (car cached))))
- (goto-char (point-min))
- (insert "220 ")
- (princ (car cached) (current-buffer))
- (insert " Article retrieved.\n")
- (search-forward "\n\n" nil 'move)
- (delete-region (point) (point-max))
- (forward-char -1)
- (insert "."))
+ (set-buffer cache-buf)
+ (erase-buffer)
+ (let ((coding-system-for-read
+ gnus-cache-coding-system))
+ (insert-file-contents (gnus-cache-file-name group (car cached))))
+ (goto-char (point-min))
+ (insert "220 ")
+ (princ (car cached) (current-buffer))
+ (insert " Article retrieved.\n")
+ (search-forward "\n\n" nil 'move)
+ (delete-region (point) (point-max))
+ (forward-char -1)
+ (insert ".")
+ (set-buffer nntp-server-buffer)
(insert-buffer-substring cache-buf)
(setq cached (cdr cached)))
(kill-buffer cache-buf)))
@@ -604,6 +622,24 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
;; Mark the active hashtb as unaltered.
(setq gnus-cache-active-altered nil)))
+(defun gnus-cache-possibly-update-active (group active)
+ "Update active info bounds of GROUP with ACTIVE if necessary.
+The update is performed if ACTIVE contains a higher or lower bound
+than the current."
+ (let ((lower t) (higher t))
+ (if gnus-cache-active-hashtb
+ (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
+ (when cache-active
+ (unless (< (car active) (car cache-active))
+ (setq lower nil))
+ (unless (> (cdr active) (cdr cache-active))
+ (setq higher nil))))
+ (gnus-cache-read-active))
+ (when lower
+ (gnus-cache-update-active group (car active) t))
+ (when higher
+ (gnus-cache-update-active group (cdr active)))))
+
(defun gnus-cache-update-active (group number &optional low)
"Update the upper bound of the active info of GROUP to NUMBER.
If LOW, update the lower bound instead."
@@ -641,7 +677,7 @@ If LOW, update the lower bound instead."
(gnus-message 5 "Generating the cache active file...")
(setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
(when (string-match "^\\(nn[^_]+\\)_" group)
- (setq group (replace-match "\\1:" t t group)))
+ (setq group (replace-match "\\1:" t nil group)))
;; Separate articles from all other files and directories.
(while files
(if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
@@ -670,13 +706,27 @@ If LOW, update the lower bound instead."
(interactive (list gnus-cache-directory))
(gnus-cache-close)
(let ((nnml-generate-active-function 'identity))
- (nnml-generate-nov-databases-1 dir)))
+ (nnml-generate-nov-databases-1 dir))
+ (gnus-cache-open))
(defun gnus-cache-move-cache (dir)
"Move the cache tree to somewhere else."
(interactive "FMove the cache tree to: ")
(rename-file gnus-cache-directory dir))
+(defun gnus-cache-fully-p (&optional group)
+ "Returns non-nil if the cache should be fully used.
+If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
+`gnus-uncacheable-groups'."
+ (and gnus-use-cache
+ (not (eq gnus-use-cache 'passive))
+ (if (null group)
+ t
+ (and (or (not gnus-cacheable-groups)
+ (string-match gnus-cacheable-groups group))
+ (or (not gnus-uncacheable-groups)
+ (not (string-match gnus-uncacheable-groups group)))))))
+
(provide 'gnus-cache)
;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 5a041d11197..51617918a4c 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1,6 +1,6 @@
-;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding: iso-latin-1 -*-
+;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Per Abhiddenware
@@ -29,8 +29,9 @@
(eval-when-compile (require 'cl))
(require 'gnus)
-(require 'gnus-art)
(require 'gnus-range)
+(require 'gnus-art)
+(require 'message) ; for message-cite-prefix-regexp
;;; Customization:
@@ -40,19 +41,6 @@
:link '(custom-manual "(gnus)Article Highlighting")
:group 'gnus-article)
-(defcustom gnus-cite-reply-regexp
- "^\\(Subject: Re\\|In-Reply-To\\|References\\):"
- "*If headers match this regexp it is reasonable to believe that
-article has citations."
- :group 'gnus-cite
- :type 'string)
-
-(defcustom gnus-cite-always-check nil
- "Check article always for citations. Set it t to check all articles."
- :group 'gnus-cite
- :type '(choice (const :tag "no" nil)
- (const :tag "yes" t)))
-
(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
"Format of opened cited text buttons."
:group 'gnus-cite
@@ -79,20 +67,13 @@ Set it to nil to parse all articles."
:type '(choice (const :tag "all" nil)
integer))
-(defcustom gnus-cite-prefix-regexp
- ;; The Latin-1 angle quote looks pretty dubious. -- fx
- "^[]>»|:}+ ]*[]>»|:}+]\\(.*>»\\)?\\|^.*>"
- "*Regexp matching the longest possible citation prefix on a line."
- :group 'gnus-cite
- :type 'regexp)
-
(defcustom gnus-cite-max-prefix 20
"Maximum possible length for a citation prefix."
:group 'gnus-cite
:type 'integer)
(defcustom gnus-supercite-regexp
- (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
+ (concat "^\\(" message-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"*Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages."
@@ -110,21 +91,51 @@ The first regexp group should match the Supercite attribution."
:group 'gnus-cite
:type 'integer)
+;; Some Microsoft products put in a citation that extends to the
+;; remainder of the message:
+;;
+;; -----Original Message-----
+;; From: ...
+;; To: ...
+;; Sent: ... [date, in non-RFC-2822 format]
+;; Subject: ...
+;;
+;; Cited message, with no prefixes
+;;
+;; The four headers are always the same. But note they are prone to
+;; folding without additional indentation.
+;;
+;; Others use "----- Original Message -----" instead, and properly quote
+;; the body using "> ". This style is handled without special cases.
+
(defcustom gnus-cite-attribution-prefix
- "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----"
+ "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
"*Regexp matching the beginning of an attribution line."
:group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-attribution-suffix
- "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$"
+ "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$"
"*Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
:group 'gnus-cite
:type 'regexp)
+(defcustom gnus-cite-unsightly-citation-regexp
+ "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
+ "Regexp matching Microsoft-type rest-of-message citations."
+ :group 'gnus-cite
+ :type 'regexp)
+
+(defcustom gnus-cite-ignore-quoted-from t
+ "Non-nil means don't regard lines beginning with \">From \" as cited text.
+Those lines may have been quoted by MTAs in order not to mix up with
+the envelope From line."
+ :group 'gnus-cite
+ :type 'boolean)
+
(defface gnus-cite-attribution-face '((t
- (:slant italic)))
+ (:italic t)))
"Face used for attribution lines.")
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
@@ -140,7 +151,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "MidnightBlue"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-2 '((((class color)
@@ -150,7 +161,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "firebrick"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-3 '((((class color)
@@ -160,7 +171,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "dark green"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-4 '((((class color)
@@ -170,7 +181,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "OrangeRed"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-5 '((((class color)
@@ -180,7 +191,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "dark khaki"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-6 '((((class color)
@@ -190,7 +201,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "dark violet"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-7 '((((class color)
@@ -200,7 +211,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "SteelBlue4"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-8 '((((class color)
@@ -210,7 +221,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "magenta"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-9 '((((class color)
@@ -220,7 +231,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "violet"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-10 '((((class color)
@@ -230,7 +241,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "medium purple"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defface gnus-cite-face-11 '((((class color)
@@ -240,7 +251,7 @@ It is merged with the face for the cited text belonging to the attribution."
(background light))
(:foreground "turquoise"))
(t
- (:slant italic)))
+ (:italic t)))
"Citation face.")
(defcustom gnus-cite-face-list
@@ -270,6 +281,17 @@ This should make it easier to see who wrote what."
:group 'gnus-cite
:type 'boolean)
+;; This has to go here because its default value depends on
+;; gnus-cite-face-list.
+(defcustom gnus-article-boring-faces (cons 'gnus-signature-face
+ gnus-cite-face-list)
+ "List of faces that are not worth reading.
+If an article has more pages below the one you are looking at, but
+nothing on those pages is a word of at least three letters that is not
+in a boring face, then the pages will be skipped."
+ :type '(repeat face)
+ :group 'gnus-article-hiding)
+
;;; Internal Variables:
(defvar gnus-cite-article nil)
@@ -317,7 +339,7 @@ Attribution lines are highlighted with the same face as the
corresponding citation merged with `gnus-cite-attribution-face'.
Text is considered cited if at least `gnus-cite-minimum-match-count'
-lines matches `gnus-cite-prefix-regexp' with the same prefix.
+lines matches `message-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
@@ -358,7 +380,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(goto-char (point-min))
(forward-line (1- number))
(when (re-search-forward gnus-cite-attribution-suffix
- (save-excursion (end-of-line 1) (point))
+ (gnus-point-at-eol)
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
'gnus-cite-toggle prefix))
@@ -450,7 +472,10 @@ If WIDTH (the numerical prefix), use that text width when filling."
(narrow-to-region (caar marks) (caadr marks))
(let ((adaptive-fill-regexp
(concat "^" (regexp-quote (cdar marks)) " *"))
- (fill-prefix (cdar marks)))
+ (fill-prefix
+ (if (string= (cdar marks) "") ""
+ (concat (cdar marks) " ")))
+ use-hard-newlines)
(fill-region (point-min) (point-max)))
(set-marker (caar marks) nil)
(setq marks (cdr marks)))
@@ -519,6 +544,7 @@ always hide."
(setq beg nil)
(setq end (point-marker))))))
(when (and beg end)
+ (gnus-add-wash-type 'cite)
;; We use markers for the end-points to facilitate later
;; wrapping and mangling of text.
(setq beg (set-marker (make-marker) beg)
@@ -558,14 +584,20 @@ means show, nil means toggle."
(and (> arg 0) (not hidden))
(and (< arg 0) hidden))
(if hidden
- (gnus-remove-text-properties-when
- 'article-type 'cite beg end
- (cons 'article-type (cons 'cite
- gnus-hidden-properties)))
+ (progn
+ ;; Can't remove 'cite from g-a-wash-types here because
+ ;; multiple citations may be hidden -jas
+ (gnus-remove-text-properties-when
+ 'article-type 'cite beg end
+ (cons 'article-type (cons 'cite
+ gnus-hidden-properties))))
+ (gnus-add-wash-type 'cite)
(gnus-add-text-properties-when
'article-type nil beg end
(cons 'article-type (cons 'cite
gnus-hidden-properties))))
+ (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
+ (gnus-set-mode-line 'article))
(save-excursion
(goto-char start)
(gnus-delete-line)
@@ -594,41 +626,44 @@ cited text with attributions. When called interactively, these two
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
(interactive (append (gnus-article-hidden-arg) '(force)))
- (unless (gnus-article-check-hidden-text 'cite arg)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe force)
- (article-goto-body)
- (let ((start (point))
- (atts gnus-cite-attribution-alist)
- (buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden 0)
- total)
- (goto-char (point-max))
- (gnus-article-search-signature)
- (setq total (count-lines start (point)))
- (while atts
- (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
- gnus-cite-prefix-alist))))
- atts (cdr atts)))
- (when (or force
- (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
- (> hidden gnus-cite-hide-absolute)))
- (setq atts gnus-cite-attribution-alist)
+ (with-current-buffer gnus-article-buffer
+ (gnus-delete-wash-type 'cite)
+ (unless (gnus-article-check-hidden-text 'cite arg)
+ (save-excursion
+ (gnus-cite-parse-maybe force)
+ (article-goto-body)
+ (let ((start (point))
+ (atts gnus-cite-attribution-alist)
+ (buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hidden 0)
+ total)
+ (goto-char (point-max))
+ (gnus-article-search-signature)
+ (setq total (count-lines start (point)))
(while atts
- (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
- atts (cdr atts))
- (while total
- (setq hidden (car total)
- total (cdr total))
- (goto-char (point-min))
- (forward-line (1- hidden))
- (unless (assq hidden gnus-cite-attribution-alist)
- (gnus-add-text-properties
- (point) (progn (forward-line 1) (point))
- (nconc (list 'article-type 'cite)
- gnus-hidden-properties))))))))))
+ (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
+ gnus-cite-prefix-alist))))
+ atts (cdr atts)))
+ (when (or force
+ (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
+ (> hidden gnus-cite-hide-absolute)))
+ (gnus-add-wash-type 'cite)
+ (setq atts gnus-cite-attribution-alist)
+ (while atts
+ (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
+ atts (cdr atts))
+ (while total
+ (setq hidden (car total)
+ total (cdr total))
+ (goto-char (point-min))
+ (forward-line (1- hidden))
+ (unless (assq hidden gnus-cite-attribution-alist)
+ (gnus-add-text-properties
+ (point) (progn (forward-line 1) (point))
+ (nconc (list 'article-type 'cite)
+ gnus-hidden-properties)))))))))
+ (gnus-set-mode-line 'article)))
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
@@ -663,11 +698,13 @@ See also the documentation for `gnus-article-highlight-citation'."
(defun gnus-cite-delete-overlays ()
(dolist (overlay gnus-cite-overlay-list)
- (when (or (not (gnus-overlay-end overlay))
- (and (>= (gnus-overlay-end overlay) (point-min))
- (<= (gnus-overlay-end overlay) (point-max))))
- (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
- (gnus-delete-overlay overlay))))
+ (ignore-errors
+ (when (or (not (gnus-overlay-end overlay))
+ (and (>= (gnus-overlay-end overlay) (point-min))
+ (<= (gnus-overlay-end overlay) (point-max))))
+ (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
+ (ignore-errors
+ (gnus-delete-overlay overlay))))))
(defun gnus-cite-parse-wrapper ()
;; Wrap chopped gnus-cite-parse.
@@ -690,23 +727,33 @@ See also the documentation for `gnus-article-highlight-citation'."
(goto-char (point-max))
(gnus-article-search-signature)
(point)))
- alist entry start begin end numbers prefix)
+ (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)"))
+ alist entry start begin end numbers prefix guess-limit)
;; Get all potential prefixes in `alist'.
(while (< (point) max)
;; Each line.
(setq begin (point)
- end (progn (beginning-of-line 2) (point))
+ guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
+ end (gnus-point-at-bol 2)
start end)
(goto-char begin)
;; Ignore standard Supercite attribution prefix.
- (when (looking-at gnus-supercite-regexp)
+ (when (and (< guess-limit (+ begin gnus-cite-max-prefix))
+ (looking-at gnus-supercite-regexp))
(if (match-end 1)
(setq end (1+ (match-end 1)))
(setq end (1+ begin))))
;; Ignore very long prefixes.
- (when (> end (+ (point) gnus-cite-max-prefix))
- (setq end (+ (point) gnus-cite-max-prefix)))
- (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
+ (when (> end (+ begin gnus-cite-max-prefix))
+ (setq end (+ begin gnus-cite-max-prefix)))
+ ;; Ignore quoted envelope From_.
+ (when (and gnus-cite-ignore-quoted-from
+ (prog2
+ (setq case-fold-search nil)
+ (looking-at ">From ")
+ (setq case-fold-search t)))
+ (setq end (1+ begin)))
+ (while (re-search-forward prefix-regexp (1- end) t)
;; Each prefix.
(setq end (match-end 0)
prefix (buffer-substring begin end))
@@ -718,9 +765,19 @@ See also the documentation for `gnus-article-highlight-citation'."
(goto-char begin))
(goto-char start)
(setq line (1+ line)))
+ ;; Horrible special case for some Microsoft mailers.
+ (goto-char (point-min))
+ (when (re-search-forward gnus-cite-unsightly-citation-regexp max t)
+ (setq begin (count-lines (point-min) (point)))
+ (setq end (count-lines (point-min) max))
+ (setq entry nil)
+ (while (< begin end)
+ (push begin entry)
+ (setq begin (1+ begin)))
+ (push (cons "" entry) alist))
;; We got all the potential prefixes. Now create
;; `gnus-cite-prefix-alist' containing the oldest prefix for each
- ;; line that appears at least gnus-cite-minimum-match-count
+ ;; line that appears at least `gnus-cite-minimum-match-count'
;; times. First sort them by length. Longer is older.
(setq alist (sort alist (lambda (a b)
(> (length (car a)) (length (car b))))))
@@ -960,14 +1017,20 @@ See also the documentation for `gnus-article-highlight-citation'."
(goto-char (point-min))
(forward-line (1- number))
(cond ((get-text-property (point) 'invisible)
+ ;; Can't remove 'cite from g-a-wash-types here because
+ ;; multiple citations may be hidden -jas
(remove-text-properties (point) (progn (forward-line 1) (point))
gnus-hidden-properties))
((assq number gnus-cite-attribution-alist))
(t
+ (gnus-add-wash-type 'cite)
(gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'article-type 'cite)
- gnus-hidden-properties))))))))
+ gnus-hidden-properties))))
+ (let ((gnus-article-mime-handle-alist-1
+ gnus-article-mime-handle-alist))
+ (gnus-set-mode-line 'article))))))
(defun gnus-cite-find-prefix (line)
;; Return citation prefix for LINE.
@@ -990,6 +1053,17 @@ See also the documentation for `gnus-article-highlight-citation'."
(while vars
(make-local-variable (pop vars)))))
+(defun gnus-cited-line-p ()
+ "Say whether the current line is a cited line."
+ (save-excursion
+ (beginning-of-line)
+ (let ((found nil))
+ (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
+ (when (string= (buffer-substring (point) (+ (length prefix) (point)))
+ prefix)
+ (setq found t)))
+ found)))
+
(gnus-ems-redefine)
(provide 'gnus-cite)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index dc5a9f39cc5..4388db5c9e5 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1,6 +1,7 @@
;;; gnus-cus.el --- customization commands for Gnus
;;
-;; Copyright (C) 1996,1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: news
@@ -27,15 +28,14 @@
;;; Code:
(require 'wid-edit)
+(require 'gnus)
+(require 'gnus-agent)
(require 'gnus-score)
(require 'gnus-topic)
+(require 'gnus-art)
;;; Widgets:
-;; There should be special validation for this.
-(define-widget 'gnus-email-address 'string
- "An email address")
-
(defun gnus-custom-mode ()
"Major mode for editing Gnus customization buffers.
@@ -72,36 +72,7 @@ if that value is non-nil."
;;; Group Customization:
(defconst gnus-group-parameters
- '((to-address (gnus-email-address :tag "To Address") "\
-This will be used when doing followups and posts.
-
-This is primarily useful in mail groups that represent closed
-mailing lists--mailing lists where it's expected that everybody that
-writes to the mailing list is subscribed to it. Since using this
-parameter ensures that the mail only goes to the mailing list itself,
-it means that members won't receive two copies of your followups.
-
-Using `to-address' will actually work whether the group is foreign or
-not. Let's say there's a group on the server that is called
-`fa.4ad-l'. This is a real newsgroup, but the server has gotten the
-articles from a mail-to-news gateway. Posting directly to this group
-is therefore impossible--you have to send mail to the mailing list
-address instead.
-
-The gnus-group-split mail splitting mechanism will behave as if this
-address was listed in gnus-group-split Addresses (see below).")
-
- (to-list (gnus-email-address :tag "To List") "\
-This address will be used when doing a `a' in the group.
-
-It is totally ignored when doing a followup--except that if it is
-present in a news group, you'll get mail group semantics when doing
-`f'.
-
-The gnus-group-split mail splitting mechanism will behave as if this
-address was listed in gnus-group-split Addresses (see below).")
-
- (extra-aliases (choice
+ '((extra-aliases (choice
:tag "Extra Aliases"
(list
:tag "List"
@@ -168,29 +139,6 @@ is present and a string, this string will be inserted literally as a
`gcc' header (this symbol takes precedence over any default `Gcc'
rules as described later).")
- (banner (choice :tag "Banner"
- :value nil
- (const :tag "Remove signature" signature)
- (symbol :tag "Item in `gnus-article-banner-alist'" none)
- regexp
- (const :tag "None" nil)) "\
-If non-nil, specify how to remove `banners' from articles.
-
-Symbol `signature' means to remove signatures delimited by
-`gnus-signature-separator'. Any other symbol is used to look up a
-regular expression to match the banner in `gnus-article-banner-alist'.
-A string is used as a regular expression to match the banner
-directly.")
-
- (auto-expire (const :tag "Automatic Expire" t) "\
-All articles that are read will be marked as expirable.")
-
- (total-expire (const :tag "Total Expire" t) "\
-All read articles will be put through the expiry process
-
-This happens even if they are not marked as expirable.
-Use with caution.")
-
(expiry-wait (choice :tag "Expire Wait"
:value never
(const never)
@@ -205,13 +153,13 @@ days (not necessarily an integer) or the symbols `never' or
`immediate'.")
(expiry-target (choice :tag "Expiry Target"
- :value delete
- (const delete)
- (function :format "%v" nnmail-)
- string) "\
+ :value delete
+ (const delete)
+ (function :format "%v" nnmail-)
+ string) "\
Where expired messages end up.
-Overrides `nnmail-expiry-target', which see.")
+Overrides `nnmail-expiry-target'.")
(score-file (file :tag "Score File") "\
Make the specified file into the current score file.
@@ -232,34 +180,31 @@ you to put the admin address somewhere convenient.")
(display (choice :tag "Display"
:value default
(const all)
- (const default)) "\
+ (integer)
+ (const default)
+ (sexp :tag "Other")) "\
Which articles to display on entering the group.
`all'
Display all articles, both read and unread.
+`integer'
+ Display the last NUMBER articles in the group. This is the same as
+ entering the group with C-u NUMBER.
+
`default'
Display the default visible articles, which normally includes
- unread and ticked articles.")
+ unread and ticked articles.
+
+`Other'
+ Display the articles that satisfy the S-expression. The S-expression
+ should be in an array form.")
(comment (string :tag "Comment") "\
An arbitrary comment on the group.")
(visible (const :tag "Permanently visible" t) "\
-Always display this group, even when there are no unread articles
-in it..")
-
- (charset (symbol :tag "Charset") "\
-The default charset to use in the group.")
-
- (ignored-charsets
- (choice :tag "Ignored charsets"
- :value nil
- (repeat (symbol))) "\
-List of charsets that should be ignored.
-
-When these charsets are used in the \"charset\" parameter, the
-default charset will be used instead.")
+Always display this group, even when there are no unread articles in it.")
(highlight-words
(choice :tag "Highlight words"
@@ -270,23 +215,23 @@ default charset will be used instead.")
(symbol :tag "Face"
gnus-emphasis-highlight-words))))
"highlight regexps.
-See gnus-emphasis-alist.")
+See `gnus-emphasis-alist'.")
(posting-style
(choice :tag "Posting style"
:value nil
(repeat (list
- (choice :tag "Type"
+ (choice :tag "Type"
:value nil
(const signature)
- (const signature-file)
- (const organization)
- (const address)
- (const name)
- (const body))
+ (const signature-file)
+ (const organization)
+ (const address)
+ (const name)
+ (const body))
(string :format "%v"))))
"post style.
-See gnus-posting-styles."))
+See `gnus-posting-styles'."))
"Alist of valid group or topic parameters.
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
@@ -295,9 +240,15 @@ DOC is a documentation string for the parameter.")
(defconst gnus-extra-topic-parameters
'((subscribe (regexp :tag "Subscribe") "\
-If `gnus-subscribe-newsgroup-method' is set to
+If `gnus-subscribe-newsgroup-method' or
+`gnus-subscribe-options-newsgroup-method' is set to
`gnus-subscribe-topics', new groups that matches this regexp will
-automatically be subscribed to this topic"))
+automatically be subscribed to this topic")
+ (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
+If this topic parameter is set, when new groups are subscribed
+automatically under this topic (via the `subscribe' topic parameter)
+assign this level to the group, rather than the default level
+set in `gnus-level-default-subscribed'"))
"Alist of topic parameters that are not also group parameters.
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
@@ -312,6 +263,72 @@ Server-assigned value attached to IMAP groups, used to maintain consistency."))
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
itself (a symbol), TYPE is the parameters type (a sexp widget), and
DOC is a documentation string for the parameter.")
+
+(eval-and-compile
+ (defconst gnus-agent-parameters
+ '((agent-predicate
+ (sexp :tag "Selection Predicate" :value false)
+ "Predicate used to automatically select articles for downloading."
+ gnus-agent-cat-predicate)
+ (agent-score
+ (choice :tag "Score File" :value nil
+ (const file :tag "Use group's score files")
+ (repeat (list (string :format "%v" :tag "File name"))))
+ "Which score files to use when using score to select articles to fetch.
+
+ `nil'
+ All articles will be scored to zero (0).
+
+ `file'
+ The group's score files will be used to score the articles.
+
+ `List'
+ A list of score file names."
+ gnus-agent-cat-score-file)
+ (agent-short-article
+ (integer :tag "Max Length of Short Article" :value "")
+ "The SHORT predicate will evaluate to true when the article is
+shorter than this length." gnus-agent-cat-length-when-short)
+ (agent-long-article
+ (integer :tag "Min Length of Long Article" :value "")
+ "The LONG predicate will evaluate to true when the article is
+longer than this length." gnus-agent-cat-length-when-long)
+ (agent-low-score
+ (integer :tag "Low Score Limit" :value "")
+ "The LOW predicate will evaluate to true when the article scores
+lower than this limit." gnus-agent-cat-low-score)
+ (agent-high-score
+ (integer :tag "High Score Limit" :value "")
+ "The HIGH predicate will evaluate to true when the article scores
+higher than this limit." gnus-agent-cat-high-score)
+ (agent-days-until-old
+ (integer :tag "Days Until Old" :value "")
+ "The OLD predicate will evaluate to true when the fetched article
+has been stored locally for at least this many days."
+ gnus-agent-cat-days-until-old)
+ (agent-enable-expiration
+ (radio :tag "Expire in this Group or Topic" :value nil
+ (const :format "Enable " ENABLE)
+ (const :format "Disable " DISABLE))
+ "\nEnable, or disable, agent expiration in this group or topic."
+ gnus-agent-cat-enable-expiration)
+ (agent-enable-undownloaded-faces
+ (boolean :tag "Enable Agent Faces")
+ "Have the summary buffer use the agent's undownloaded faces.
+These faces, when enabled, act as a warning that an article has not
+been fetched into either the agent nor the cache. This is of most use
+to users who use the agent as a cache (i.e. they only operate on
+articles that have been downloaded). Leave disabled to display normal
+article faces even when the article hasn't been downloaded."
+gnus-agent-cat-enable-undownloaded-faces))
+ "Alist of group parameters that are not also topic parameters.
+
+Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the
+parameter itself (a symbol), TYPE is the parameters type (a sexp
+widget), DOC is a documentation string for the parameter, and ACCESSOR
+is a function (symbol) that extracts the current value from the
+category."))
+
(defvar gnus-custom-params)
(defvar gnus-custom-method)
(defvar gnus-custom-group)
@@ -326,18 +343,37 @@ DOC is a documentation string for the parameter.")
:doc ,(nth 2 entry)
(const :format "" ,(nth 0 entry))
,(nth 1 entry)))
- (append gnus-group-parameters
+ (append (reverse gnus-group-parameters-more)
+ gnus-group-parameters
(if group
gnus-extra-group-parameters
- gnus-extra-topic-parameters)))))
+ gnus-extra-topic-parameters))))
+ (agent (mapcar (lambda (entry)
+ (let ((type (nth 1 entry))
+ vcons)
+ (if (listp type)
+ (setq type (copy-sequence type)))
+
+ (setq vcons (cdr (memq :value type)))
+
+ (if (symbolp (car vcons))
+ (condition-case nil
+ (setcar vcons (symbol-value (car vcons)))
+ (error)))
+ `(cons :format "%v%h\n"
+ :doc ,(nth 2 entry)
+ (const :format "" ,(nth 0 entry))
+ ,type)))
+ (if gnus-agent
+ gnus-agent-parameters))))
(unless (or group topic)
(error "No group on current line"))
(when (and group topic)
- (error "Both a group and topic on current line"))
+ (error "Both a group an topic on current line"))
(unless (or topic (setq info (gnus-get-info group)))
(error "Killed group; can't be edited"))
;; Ready.
- (kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
+ (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(gnus-custom-mode)
(make-local-variable 'gnus-custom-group)
@@ -364,24 +400,54 @@ DOC is a documentation string for the parameter.")
:action 'gnus-group-customize-done)
(widget-insert ".\n\n")
(make-local-variable 'gnus-custom-params)
- (setq gnus-custom-params
- (widget-create 'group
- :value (if group
- (gnus-info-params info)
- (gnus-topic-parameters topic))
- `(set :inline t
- :greedy t
- :tag "Parameters"
- :format "%t:\n%h%v"
- :doc "\
+
+ (let ((values (if group
+ (gnus-info-params info)
+ (gnus-topic-parameters topic))))
+
+ ;; The parameters in values may contain duplicates. This is
+ ;; normally OK as assq returns the first. However, right here
+ ;; every duplicate ends up being displayed. So, rather than
+ ;; display them, remove them from the list.
+
+ (let ((tmp (setq values (gnus-copy-sequence values)))
+ elem)
+ (while (cdr tmp)
+ (while (setq elem (assq (caar tmp) (cdr tmp)))
+ (delq elem tmp))
+ (setq tmp (cdr tmp))))
+
+ (setq gnus-custom-params
+ (apply 'widget-create 'group
+ :value values
+ (delq nil
+ (list `(set :inline t
+ :greedy t
+ :tag "Parameters"
+ :format "%t:\n%h%v"
+ :doc "\
These special parameters are recognized by Gnus.
Check the [ ] for the parameters you want to apply to this group or
to the groups in this topic, then edit the value to suit your taste."
- ,@types)
- '(repeat :inline t
- :tag "Variables"
- :format "%t:\n%h%v%i\n\n"
- :doc "\
+ ,@types)
+ (when gnus-agent
+ `(set :inline t
+ :greedy t
+ :tag "Agent Parameters"
+ :format "%t:\n%h%v"
+ :doc "\ These agent parameters are
+recognized by Gnus. They control article selection and expiration for
+use in the unplugged cache. Check the [ ] for the parameters you want
+to apply to this group or to the groups in this topic, then edit the
+value to suit your taste.
+
+For those interested, group parameters override topic parameters while
+topic parameters override agent category parameters. Underlying
+category parameters are the customizable variables." ,@agent))
+ '(repeat :inline t
+ :tag "Variables"
+ :format "%t:\n%h%v%i\n\n"
+ :doc "\
Set variables local to the group you are entering.
If you want to turn threading off in `news.answers', you could put
@@ -394,14 +460,14 @@ like. If you want to hear a beep when you enter a group, you could
put something like `(dummy-variable (ding))' in the parameters of that
group. `dummy-variable' will be set to the result of the `(ding)'
form, but who cares?"
- (list :format "%v" :value (nil nil)
- (symbol :tag "Variable")
- (sexp :tag
- "Value")))
-
- '(repeat :inline t
- :tag "Unknown entries"
- sexp)))
+ (list :format "%v" :value (nil nil)
+ (symbol :tag "Variable")
+ (sexp :tag
+ "Value")))
+
+ '(repeat :inline t
+ :tag "Unknown entries"
+ sexp))))))
(when group
(widget-insert "\n\nYou can also edit the ")
(widget-create 'info-link
@@ -701,8 +767,13 @@ eh?")))
(defvar gnus-custom-score-alist)
(defun gnus-score-customize (file)
- "Customize score file FILE."
+ "Customize score file FILE.
+When called interactively, FILE defaults to the current score file.
+This can be changed using the `\\[gnus-score-change-score-file]' command."
(interactive (list gnus-current-score-file))
+ (unless file
+ (error (format "No score file for %s"
+ (gnus-group-decoded-name gnus-newsgroup-name))))
(let ((scores (gnus-score-load file))
(types (mapcar (lambda (entry)
`(group :format "%v%h\n"
@@ -814,6 +885,175 @@ articles in the thread.
(gnus-score-set 'touched '(t) alist))
(bury-buffer))
+(eval-when-compile
+ (defvar category-fields nil)
+ (defvar gnus-agent-cat-name)
+ (defvar gnus-agent-cat-score-file)
+ (defvar gnus-agent-cat-length-when-short)
+ (defvar gnus-agent-cat-length-when-long)
+ (defvar gnus-agent-cat-low-score)
+ (defvar gnus-agent-cat-high-score)
+ (defvar gnus-agent-cat-enable-expiration)
+ (defvar gnus-agent-cat-days-until-old)
+ (defvar gnus-agent-cat-predicate)
+ (defvar gnus-agent-cat-groups)
+ (defvar gnus-agent-cat-enable-undownloaded-faces)
+)
+
+(defun gnus-trim-whitespace (s)
+ (when (string-match "\\`[ \n\t]+" s)
+ (setq s (substring s (match-end 0))))
+ (when (string-match "[ \n\t]+\\'" s)
+ (setq s (substring s 0 (match-beginning 0))))
+ s)
+
+(defmacro gnus-agent-cat-prepare-category-field (parameter)
+ (let* ((entry (assq parameter gnus-agent-parameters))
+ (field (nth 3 entry)))
+ `(let* ((type (copy-sequence
+ (nth 1 (assq ',parameter gnus-agent-parameters))))
+ (val (,field info))
+ (deflt (if (,field defaults)
+ (concat " [" (gnus-trim-whitespace
+ (gnus-pp-to-string (,field defaults)))
+ "]")))
+ symb)
+
+ (if (eq (car type) 'radio)
+ (let* ((rtype (nreverse type))
+ (rt rtype))
+ (while (listp (or (cadr rt) 'not-list))
+ (setq rt (cdr rt)))
+
+ (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt)))
+ (setq type (nreverse rtype))))
+
+ (if deflt
+ (let ((tag (cdr (memq :tag type))))
+ (when (string-match "\n" deflt)
+ (while (progn (setq deflt (replace-match "\n " t t
+ deflt))
+ (string-match "\n" deflt (match-end 0))))
+ (setq deflt (concat "\n" deflt)))
+
+ (setcar tag (concat (car tag) deflt))))
+
+ (widget-insert "\n")
+
+ (setq val (if val
+ (widget-create type :value val)
+ (widget-create type))
+ symb (set (make-local-variable ',field) val))
+
+ (widget-put symb :default val)
+ (widget-put symb :accessor ',field)
+ (push symb category-fields))))
+
+(defun gnus-agent-customize-category (category)
+ "Edit the CATEGORY."
+ (interactive (list (gnus-category-name)))
+ (let ((info (assq category gnus-category-alist))
+ (defaults (list nil '(agent-predicate . false)
+ (cons 'agent-enable-expiration
+ gnus-agent-enable-expiration)
+ '(agent-days-until-old . 7)
+ (cons 'agent-length-when-short
+ gnus-agent-short-article)
+ (cons 'agent-length-when-long gnus-agent-long-article)
+ (cons 'agent-low-score gnus-agent-low-score)
+ (cons 'agent-high-score gnus-agent-high-score))))
+
+ (let ((old (get-buffer "*Gnus Agent Category Customize*")))
+ (when old
+ (gnus-kill-buffer old)))
+ (switch-to-buffer (gnus-get-buffer-create
+ "*Gnus Agent Category Customize*"))
+
+ (let ((inhibit-read-only t))
+ (gnus-custom-mode)
+ (buffer-disable-undo)
+
+ (let* ((name (gnus-agent-cat-name info)))
+ (widget-insert "Customize the Agent Category '")
+ (widget-insert (symbol-name name))
+ (widget-insert "' and press ")
+ (widget-create
+ 'push-button
+ :notify
+ '(lambda (&rest ignore)
+ (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
+ (widgets category-fields))
+ (while widgets
+ (let* ((widget (pop widgets))
+ (value (condition-case nil (widget-value widget) (error))))
+ (eval `(setf (,(widget-get widget :accessor) ',info)
+ ',value)))))
+ (gnus-category-write)
+ (gnus-kill-buffer (current-buffer))
+ (when (get-buffer gnus-category-buffer)
+ (switch-to-buffer (get-buffer gnus-category-buffer))
+ (gnus-category-list)))
+ "Done")
+ (widget-insert
+ "\n Note: Empty fields default to the customizable global\
+ variables.\n\n")
+
+ (set (make-local-variable 'gnus-agent-cat-name)
+ name))
+
+ (set (make-local-variable 'category-fields) nil)
+ (gnus-agent-cat-prepare-category-field agent-predicate)
+
+ (gnus-agent-cat-prepare-category-field agent-score)
+ (gnus-agent-cat-prepare-category-field agent-short-article)
+ (gnus-agent-cat-prepare-category-field agent-long-article)
+ (gnus-agent-cat-prepare-category-field agent-low-score)
+ (gnus-agent-cat-prepare-category-field agent-high-score)
+
+ ;; The group list is NOT handled with
+ ;; gnus-agent-cat-prepare-category-field as I don't want the
+ ;; group list to appear when customizing a topic.
+ (widget-insert "\n")
+
+ (let ((symb
+ (set
+ (make-local-variable 'gnus-agent-cat-groups)
+ (widget-create
+ `(choice
+ :format "%[Select Member Groups%]\n%v" :value ignore
+ (const :menu-tag "do not change" :tag "" :value ignore)
+ (checklist :entry-format "%b %v"
+ :menu-tag "display group selectors"
+ :greedy t
+ :value
+ ,(delq nil
+ (mapcar
+ (lambda (newsrc)
+ (car (member
+ (gnus-info-group newsrc)
+ (gnus-agent-cat-groups info))))
+ (cdr gnus-newsrc-alist)))
+ ,@(mapcar (lambda (newsrc)
+ `(const ,(gnus-info-group newsrc)))
+ (cdr gnus-newsrc-alist))))))))
+
+ (widget-put symb :default (gnus-agent-cat-groups info))
+ (widget-put symb :accessor 'gnus-agent-cat-groups)
+ (push symb category-fields))
+
+ (widget-insert "\nExpiration Settings ")
+
+ (gnus-agent-cat-prepare-category-field agent-enable-expiration)
+ (gnus-agent-cat-prepare-category-field agent-days-until-old)
+
+ (widget-insert "\nVisual Settings ")
+
+ (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces)
+
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (buffer-enable-undo))))
+
;;; The End:
(provide 'gnus-cus)
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
new file mode 100644
index 00000000000..b6392772773
--- /dev/null
+++ b/lisp/gnus/gnus-delay.el
@@ -0,0 +1,196 @@
+;;; gnus-delay.el --- Delayed posting of articles
+
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+;; Keywords: mail, news, extensions
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Provide delayed posting of articles.
+
+;;; Todo:
+
+;; * `gnus-delay-send-queue' barfs when group does not exist.
+;; * Integrate gnus-delay.el into the rest of Gnus automatically. How
+;; should this be done? Basically, we need to do what
+;; `gnus-delay-initialize' does. But in which files?
+
+;;; Code:
+
+(require 'nndraft)
+(require 'gnus-draft)
+
+;;;###autoload
+(defgroup gnus-delay nil
+ "Arrange for sending postings later."
+ :group 'gnus)
+
+(defcustom gnus-delay-group "delayed"
+ "Group name for storing delayed articles."
+ :type 'string
+ :group 'gnus-delay)
+
+(defcustom gnus-delay-header "X-Gnus-Delayed"
+ "Header name for storing info about delayed articles."
+ :type 'string
+ :group 'gnus-delay)
+
+(defcustom gnus-delay-default-delay "3d"
+ "*Default length of delay."
+ :type 'string
+ :group 'gnus-delay)
+
+(defcustom gnus-delay-default-hour 8
+ "*If deadline is given as date, then assume this time of day."
+ :type 'integer
+ :group 'gnus-delay)
+
+;;;###autoload
+(defun gnus-delay-article (delay)
+ "Delay this article by some time.
+DELAY is a string, giving the length of the time. Possible values are:
+
+* <digits><units> for <units> in minutes (`m'), hours (`h'), days (`d'),
+ weeks (`w'), months (`M'), or years (`Y');
+
+* YYYY-MM-DD for a specific date. The time of day is given by the
+ variable `gnus-delay-default-hour', minute and second are zero.
+
+* hh:mm for a specific time. Use 24h format. If it is later than this
+ time, then the deadline is tomorrow, else today."
+ (interactive
+ (list (read-string
+ "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
+ gnus-delay-default-delay)))
+ (let (num unit days year month day hour minute deadline)
+ (cond ((string-match
+ "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
+ delay)
+ (setq year (string-to-number (match-string 1 delay))
+ month (string-to-number (match-string 2 delay))
+ day (string-to-number (match-string 3 delay)))
+ (setq deadline
+ (message-make-date
+ (encode-time 0 0 ; second and minute
+ gnus-delay-default-hour
+ day month year))))
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay)
+ (setq hour (string-to-number (match-string 1 delay))
+ minute (string-to-number (match-string 2 delay)))
+ ;; Use current time, except...
+ (setq deadline (apply 'vector (decode-time (current-time))))
+ ;; ... for minute and hour.
+ (aset deadline 1 minute)
+ (aset deadline 2 hour)
+ ;; Convert to seconds.
+ (setq deadline (time-to-seconds (apply 'encode-time
+ (append deadline nil))))
+ ;; If this time has passed already, add a day.
+ (when (< deadline (time-to-seconds (current-time)))
+ (setq deadline (+ 3600 deadline))) ;3600 secs/day
+ ;; Convert seconds to date header.
+ (setq deadline (message-make-date
+ (seconds-to-time deadline))))
+ ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay)
+ (setq num (match-string 1 delay))
+ (setq unit (match-string 2 delay))
+ ;; Start from seconds, then multiply into needed units.
+ (setq num (string-to-number num))
+ (cond ((string= unit "Y")
+ (setq delay (* num 60 60 24 365)))
+ ((string= unit "M")
+ (setq delay (* num 60 60 24 30)))
+ ((string= unit "w")
+ (setq delay (* num 60 60 24 7)))
+ ((string= unit "d")
+ (setq delay (* num 60 60 24)))
+ ((string= unit "h")
+ (setq delay (* num 60 60)))
+ (t
+ (setq delay (* num 60))))
+ (setq deadline (message-make-date
+ (seconds-to-time (+ (time-to-seconds (current-time))
+ delay)))))
+ (t (error "Malformed delay `%s'" delay)))
+ (message-add-header (format "%s: %s" gnus-delay-header deadline)))
+ (set-buffer-modified-p t)
+ ;; If group does not exist, create it.
+ (let ((group (format "nndraft:%s" gnus-delay-group)))
+ (gnus-agent-queue-setup gnus-delay-group))
+ (message-disassociate-draft)
+ (nndraft-request-associate-buffer gnus-delay-group)
+ (save-buffer 0)
+ (kill-buffer (current-buffer))
+ (message-do-actions message-postpone-actions))
+
+;;;###autoload
+(defun gnus-delay-send-queue ()
+ "Send all the delayed messages that are due now."
+ (interactive)
+ (save-excursion
+ (let* ((group (format "nndraft:%s" gnus-delay-group))
+ (message-send-hook (copy-sequence message-send-hook))
+ articles
+ article deadline)
+ (when (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-activate-group group)
+ (add-hook 'message-send-hook
+ '(lambda ()
+ (message-remove-header gnus-delay-header)))
+ (setq articles (nndraft-articles))
+ (while (setq article (pop articles))
+ (gnus-request-head article group)
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
+ nil t)
+ (progn
+ (setq deadline (nnheader-header-value))
+ (setq deadline (apply 'encode-time
+ (parse-time-string deadline)))
+ (setq deadline (time-since deadline))
+ (when (and (>= (nth 0 deadline) 0)
+ (>= (nth 1 deadline) 0))
+ (message "Sending delayed article %d" article)
+ (gnus-draft-send article group)
+ (message "Sending delayed article %d...done" article)))
+ (message "Delay header missing for article %d" article)))))))
+
+;;;###autoload
+(defun gnus-delay-initialize (&optional no-keymap no-check)
+ "Initialize the gnus-delay package.
+This sets up a key binding in `message-mode' to delay a message.
+This tells Gnus to look for delayed messages after getting new news.
+
+The optional arg NO-KEYMAP is ignored.
+Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
+ (unless no-check
+ (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue)))
+
+(provide 'gnus-delay)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d
+;;; gnus-delay.el ends here
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 600d60af6ee..8d2018a0048 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -1,5 +1,7 @@
;;; gnus-demon.el --- daemonic Gnus behaviour
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2003
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -148,32 +150,32 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
(if (not (stringp time))
time
(let* ((now (current-time))
- ;; obtain NOW as discrete components -- make a vector for speed
- (nowParts (decode-time now))
- ;; obtain THEN as discrete components
- (thenParts (parse-time-string time))
- (thenHour (elt thenParts 2))
- (thenMin (elt thenParts 1))
- ;; convert time as elements into number of seconds since EPOCH.
- (then (encode-time 0
- thenMin
- thenHour
- ;; If THEN is earlier than NOW, make it
- ;; same time tomorrow. Doc for encode-time
- ;; says that this is OK.
- (+ (elt nowParts 3)
- (if (or (< thenHour (elt nowParts 2))
- (and (= thenHour (elt nowParts 2))
- (<= thenMin (elt nowParts 1))))
- 1 0))
- (elt nowParts 4)
- (elt nowParts 5)
- (elt nowParts 6)
- (elt nowParts 7)
- (elt nowParts 8)))
- ;; calculate number of seconds between NOW and THEN
- (diff (+ (* 65536 (- (car then) (car now)))
- (- (cadr then) (cadr now)))))
+ ;; obtain NOW as discrete components -- make a vector for speed
+ (nowParts (decode-time now))
+ ;; obtain THEN as discrete components
+ (thenParts (parse-time-string time))
+ (thenHour (elt thenParts 2))
+ (thenMin (elt thenParts 1))
+ ;; convert time as elements into number of seconds since EPOCH.
+ (then (encode-time 0
+ thenMin
+ thenHour
+ ;; If THEN is earlier than NOW, make it
+ ;; same time tomorrow. Doc for encode-time
+ ;; says that this is OK.
+ (+ (elt nowParts 3)
+ (if (or (< thenHour (elt nowParts 2))
+ (and (= thenHour (elt nowParts 2))
+ (<= thenMin (elt nowParts 1))))
+ 1 0))
+ (elt nowParts 4)
+ (elt nowParts 5)
+ (elt nowParts 6)
+ (elt nowParts 7)
+ (elt nowParts 8)))
+ ;; calculate number of seconds between NOW and THEN
+ (diff (+ (* 65536 (- (car then) (car now)))
+ (- (cadr then) (cadr now)))))
;; return number of timesteps in the number of seconds
(round (/ diff gnus-demon-timestep)))))
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
new file mode 100644
index 00000000000..120b812c209
--- /dev/null
+++ b/lisp/gnus/gnus-diary.el
@@ -0,0 +1,461 @@
+;;; gnus-diary.el --- Wrapper around the NNDiary Gnus backend
+
+;; Copyright (c) 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001 Didier Verna.
+
+;; Author: Didier Verna <didier@xemacs.org>
+;; Maintainer: Didier Verna <didier@xemacs.org>
+;; Created: Tue Jul 20 10:42:55 1999
+;; Keywords: calendar mail news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2 of the License,
+;; or (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+;; Description:
+;; ===========
+
+;; Gnus-Diary is a wrapper around the NNDiary Gnus backend. It is here to
+;; make your nndiary-user life easier in different ways. So, you don't have
+;; to use it if you don't want to. But, really, you should.
+
+;; Gnus-Diary offers the following features on top of the NNDiary backend:
+
+;; - A nice summary line format:
+;; Displaying diary messages in standard summary line format (usually
+;; something like "<From Joe>: <Subject>") is pretty useless. Most of the
+;; time, you're the one who wrote the message, and you mostly want to see
+;; the event's date. Gnus-Diary offers you a nice summary line format
+;; which will do this. By default, a summary line will appear like this:
+;;
+;; <Event Date>: <Subject> <Remaining time>
+;;
+;; for example, here's how Joe's birthday is displayed in my
+;; "nndiary:birhdays" summary buffer (the message is expirable, but will
+;; never be deleted, as it specifies a regular event):
+;;
+;; E Sat, Sep 22 01, 12:00: Joe's birthday (in 6 months, 1 week)
+
+;; - More article sorting functions:
+;; Gnus-Diary adds a new sorting function called
+;; `gnus-summary-sort-by-schedule'. This function lets you organize your
+;; diary summary buffers from the closest event to the farthest one.
+
+;; - Automatic generation of diary group parameters:
+;; When you create a new diary group, or visit one, Gnus-Diary checks your
+;; group parameters, and if needed, sets the summary line format to the
+;; diary-specific value, adds the diary-specific sorting functions, and
+;; also adds the different `X-Diary-*' headers to the group's
+;; posting-style. It is then easier to send a diary message, because if
+;; you use `C-u a' or `C-u m' on a diary group to prepare a message, these
+;; headers will be inserted automatically (but not filled with proper
+;; values yet).
+
+;; - An interactive mail-to-diary convertion function:
+;; The function `gnus-diary-check-message' ensures that the current message
+;; contains all the required diary headers, and prompts you for values /
+;; correction if needed. This function is hooked in the nndiary backend so
+;; that moving an article to an nndiary group will trigger it
+;; automatically. It is also bound to `C-c D c' in message-mode and
+;; article-edit-mode in order to ease the process of converting a usual
+;; mail to a diary one. This function takes a prefix argument which will
+;; force prompting of all diary headers, regardless of their
+;; presence/validity. That way, you can very easily reschedule a diary
+;; message for instance.
+
+
+;; Usage:
+;; =====
+
+;; 0/ Don't use any `gnus-user-format-function-[d|D]'. Gnus-Diary provides
+;; both of these (sorry if you used them before).
+;; 1/ Add '(require 'gnus-diary) to your gnusrc file.
+;; 2/ Customize your gnus-diary options to suit your needs.
+
+
+
+;; Bugs / Todo:
+;; ===========
+
+
+;;; Code:
+
+(require 'nndiary)
+(require 'message)
+(require 'gnus-art)
+
+(defgroup gnus-diary nil
+ "Utilities on top of the nndiary backend for Gnus.")
+
+(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n"
+ "*Summary line format for nndiary groups."
+ :type 'string
+ :group 'gnus-diary
+ :group 'gnus-summary-format)
+
+(defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M"
+ "*Time format to display appointements in nndiary summary buffers.
+Please refer to `format-time-string' for information on possible values."
+ :type 'string
+ :group 'gnus-diary)
+
+(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english
+ "*Function called to format a diary delay string.
+It is passed two arguments. The first one is non nil if the delay is in
+the past. The second one is of the form ((NUM . UNIT) ...) where NUM is
+an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute.
+It should return strings like \"In 2 months, 3 weeks\", \"3 hours,
+1 minute ago\" and so on.
+
+There are currently two built-in format functions:
+`gnus-diary-delay-format-english' (the default)
+`gnus-diary-delay-format-french'"
+ :type '(choice (const :tag "english" gnus-diary-delay-format-english)
+ (const :tag "french" gnus-diary-delay-format-french)
+ (symbol :tag "other"))
+ :group 'gnus-diary)
+
+(defconst gnus-diary-version nndiary-version
+ "Current Diary backend version.")
+
+
+;; Compatibility functions ==================================================
+
+(eval-and-compile
+ (if (fboundp 'kill-entire-line)
+ (defalias 'gnus-diary-kill-entire-line 'kill-entire-line)
+ (defun gnus-diary-kill-entire-line ()
+ (beginning-of-line)
+ (let ((kill-whole-line t))
+ (kill-line)))))
+
+
+;; Summary line format ======================================================
+
+(defun gnus-diary-delay-format-french (past delay)
+ (if (null delay)
+ "maintenant!"
+ ;; Keep only a precision of two degrees
+ (and (> (length delay) 1) (setcdr (cdr delay) nil))
+ (concat (if past "il y a " "dans ")
+ (let ((str "")
+ del)
+ (while (setq del (pop delay))
+ (setq str (concat str
+ (int-to-string (car del)) " "
+ (cond ((eq (cdr del) 'year)
+ "an")
+ ((eq (cdr del) 'month)
+ "mois")
+ ((eq (cdr del) 'week)
+ "semaine")
+ ((eq (cdr del) 'day)
+ "jour")
+ ((eq (cdr del) 'hour)
+ "heure")
+ ((eq (cdr del) 'minute)
+ "minute"))
+ (unless (or (eq (cdr del) 'month)
+ (= (car del) 1))
+ "s")
+ (if delay ", "))))
+ str))))
+
+
+(defun gnus-diary-delay-format-english (past delay)
+ (if (null delay)
+ "now!"
+ ;; Keep only a precision of two degrees
+ (and (> (length delay) 1) (setcdr (cdr delay) nil))
+ (concat (unless past "in ")
+ (let ((str "")
+ del)
+ (while (setq del (pop delay))
+ (setq str (concat str
+ (int-to-string (car del)) " "
+ (symbol-name (cdr del))
+ (and (> (car del) 1) "s")
+ (if delay ", "))))
+ str)
+ (and past " ago"))))
+
+
+(defun gnus-diary-header-schedule (headers)
+ ;; Same as `nndiary-schedule', but given a set of headers HEADERS
+ (mapcar
+ (lambda (elt)
+ (let ((head (cdr (assoc (intern (format "X-Diary-%s" (car elt)))
+ headers))))
+ (when head
+ (nndiary-parse-schedule-value head (cadr elt) (caddr elt)))))
+ nndiary-headers))
+
+;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
+;; message, with all fields set to nil here. I don't know what it is for, and
+;; I just ignore it.
+(defun gnus-user-format-function-d (header)
+ ;; Returns an aproximative delay string for the next occurence of this
+ ;; message. The delay is given only in the first non zero unit.
+ ;; Code partly stolen from article-make-date-line
+ (let* ((extras (mail-header-extra header))
+ (sched (gnus-diary-header-schedule extras))
+ (occur (nndiary-next-occurence sched (current-time)))
+ (now (current-time))
+ (real-time (subtract-time occur now)))
+ (if (null real-time)
+ "?????"
+ (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time)))
+ (past (< sec 0))
+ delay)
+ (and past (setq sec (- sec)))
+ (unless (zerop sec)
+ ;; This is a bit convoluted, but basically we go through the time
+ ;; units for years, weeks, etc, and divide things to see whether
+ ;; that results in positive answers.
+ (let ((units `((year . ,(* 365.25 24 3600))
+ (month . ,(* 31 24 3600))
+ (week . ,(* 7 24 3600))
+ (day . ,(* 24 3600))
+ (hour . 3600)
+ (minute . 60)))
+ unit num)
+ (while (setq unit (pop units))
+ (unless (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ (setq delay (append delay `((,(floor num) . ,(car unit))))))
+ (setq sec (- sec (* num (cdr unit)))))))
+ (funcall gnus-diary-delay-format-function past delay)))
+ ))
+
+;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
+;; message, with all fields set to nil here. I don't know what it is for, and
+;; I just ignore it.
+(defun gnus-user-format-function-D (header)
+ ;; Returns a formatted time string for the next occurence of this message.
+ (let* ((extras (mail-header-extra header))
+ (sched (gnus-diary-header-schedule extras))
+ (occur (nndiary-next-occurence sched (current-time))))
+ (format-time-string gnus-diary-time-format occur)))
+
+
+;; Article sorting functions ================================================
+
+(defun gnus-article-sort-by-schedule (h1 h2)
+ (let* ((now (current-time))
+ (e1 (mail-header-extra h1))
+ (e2 (mail-header-extra h2))
+ (s1 (gnus-diary-header-schedule e1))
+ (s2 (gnus-diary-header-schedule e2))
+ (o1 (nndiary-next-occurence s1 now))
+ (o2 (nndiary-next-occurence s2 now)))
+ (if (and (= (car o1) (car o2)) (= (cadr o1) (cadr o2)))
+ (< (mail-header-number h1) (mail-header-number h2))
+ (time-less-p o1 o2))))
+
+
+(defun gnus-thread-sort-by-schedule (h1 h2)
+ (gnus-article-sort-by-schedule (gnus-thread-header h1)
+ (gnus-thread-header h2)))
+
+(defun gnus-summary-sort-by-schedule (&optional reverse)
+ "Sort nndiary summary buffers by schedule of appointements.
+Optional prefix (or REVERSE argument) means sort in reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'schedule reverse))
+
+(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
+(add-hook 'gnus-summary-menu-hook
+ (lambda ()
+ (easy-menu-add-item gnus-summary-misc-menu
+ '("Sort")
+ ["Sort by schedule"
+ gnus-summary-sort-by-schedule
+ (eq (car (gnus-find-method-for-group
+ gnus-newsgroup-name))
+ 'nndiary)]
+ "Sort by number")))
+
+
+
+;; Group parameters autosetting =============================================
+
+(defun gnus-diary-update-group-parameters (group)
+ ;; Ensure that nndiary groups have convenient group parameters:
+ ;; - a posting style containing X-Diary headers
+ ;; - a nice summary line format
+ ;; - NNDiary specific sorting by schedule functions
+ ;; In general, try not to mess with what the user might have modified.
+ (let ((posting-style (gnus-group-get-parameter group 'posting-style t)))
+ ;; Posting style:
+ (mapcar (lambda (elt)
+ (let ((header (format "X-Diary-%s" (car elt))))
+ (unless (assoc header posting-style)
+ (setq posting-style (append posting-style
+ `((,header "*")))))
+ ))
+ nndiary-headers)
+ (gnus-group-set-parameter group 'posting-style posting-style)
+ ;; Summary line format:
+ (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
+ (gnus-group-set-parameter group 'gnus-summary-line-format
+ `(,gnus-diary-summary-line-format)))
+ ;; Sorting by schedule:
+ (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
+ (gnus-group-set-parameter group 'gnus-article-sort-functions
+ '((append gnus-article-sort-functions
+ (list
+ 'gnus-article-sort-by-schedule)))))
+ (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
+ (gnus-group-set-parameter group 'gnus-thread-sort-functions
+ '((append gnus-thread-sort-functions
+ (list
+ 'gnus-thread-sort-by-schedule)))))
+ ))
+
+;; Called when a group is subscribed. This is needed because groups created
+;; because of mail splitting are *not* created with the backend function.
+;; Thus, `nndiary-request-create-group-hooks' is inoperative.
+(defun gnus-diary-maybe-update-group-parameters (group)
+ (when (eq (car (gnus-find-method-for-group group)) 'nndiary)
+ (gnus-diary-update-group-parameters group)))
+
+(add-hook 'nndiary-request-create-group-hooks
+ 'gnus-diary-update-group-parameters)
+;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed
+;; anymore. Maybe I should remove this completely.
+(add-hook 'nndiary-request-update-info-hooks
+ 'gnus-diary-update-group-parameters)
+(add-hook 'gnus-subscribe-newsgroup-hooks
+ 'gnus-diary-maybe-update-group-parameters)
+
+
+;; Diary Message Checking ===================================================
+
+(defvar gnus-diary-header-value-history nil
+ ;; History variable for header value prompting
+ )
+
+(defun gnus-diary-narrow-to-headers ()
+ "Narrow the current buffer to the header part.
+Point is left at the beginning of the region.
+The buffer is assumed to contain a message, but the format is unknown."
+ (cond ((eq major-mode 'message-mode)
+ (message-narrow-to-headers))
+ (t
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (narrow-to-region (point-min) (- (point) 1))
+ (goto-char (point-min))))
+ ))
+
+(defun gnus-diary-add-header (str)
+ "Add a header to the current buffer.
+The buffer is assumed to contain a message, but the format is unknown."
+ (cond ((eq major-mode 'message-mode)
+ (message-add-header str))
+ (t
+ (save-restriction
+ (gnus-diary-narrow-to-headers)
+ (goto-char (point-max))
+ (if (string-match "\n$" str)
+ (insert str)
+ (insert str ?\n))))
+ ))
+
+(defun gnus-diary-check-message (arg)
+ "Ensure that the current message is a valid for NNDiary.
+This function checks that all NNDiary required headers are present and
+valid, and prompts for values / correction otherwise.
+
+If ARG (or prefix) is non-nil, force prompting for all fields."
+ (interactive "P")
+ (save-excursion
+ (mapcar
+ (lambda (head)
+ (let ((header (concat "X-Diary-" (car head)))
+ (ask arg)
+ value invalid)
+ ;; First, try to find the header, and checks for validity:
+ (save-restriction
+ (gnus-diary-narrow-to-headers)
+ (when (re-search-forward (concat "^" header ":") nil t)
+ (unless (eq (char-after) ? )
+ (insert " "))
+ (setq value (buffer-substring (point) (gnus-point-at-eol)))
+ (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value)
+ (setq value (match-string 1 value)))
+ (condition-case ()
+ (nndiary-parse-schedule-value value
+ (nth 1 head) (nth 2 head))
+ (t
+ (setq invalid t)))
+ ;; #### NOTE: this (along with the `gnus-diary-add-header'
+ ;; function) could be rewritten in a better way, in particular
+ ;; not to blindly remove an already present header and reinsert
+ ;; it somewhere else afterwards.
+ (when (or ask invalid)
+ (gnus-diary-kill-entire-line))
+ ))
+ ;; Now, loop until a valid value is provided:
+ (while (or ask (not value) invalid)
+ (let ((prompt (concat (and invalid
+ (prog1 "(current value invalid) "
+ (beep)))
+ header ": ")))
+ (setq value
+ (if (listp (nth 1 head))
+ (completing-read prompt (cons '("*" nil) (nth 1 head))
+ nil t value
+ gnus-diary-header-value-history)
+ (read-string prompt value
+ gnus-diary-header-value-history))))
+ (setq ask nil)
+ (setq invalid nil)
+ (condition-case ()
+ (nndiary-parse-schedule-value value
+ (nth 1 head) (nth 2 head))
+ (t
+ (setq invalid t))))
+ (gnus-diary-add-header (concat header ": " value))
+ ))
+ nndiary-headers)
+ ))
+
+(add-hook 'nndiary-request-accept-article-hooks
+ (lambda () (gnus-diary-check-message nil)))
+
+(define-key message-mode-map "\C-cDc" 'gnus-diary-check-message)
+(define-key gnus-article-edit-mode-map "\C-cDc" 'gnus-diary-check-message)
+
+
+;; The end ==================================================================
+
+(defun gnus-diary-version ()
+ "Current Diary backend version."
+ (interactive)
+ (message "NNDiary version %s" nndiary-version))
+
+(define-key message-mode-map "\C-cDv" 'gnus-diary-version)
+(define-key gnus-article-edit-mode-map "\C-cDv" 'gnus-diary-version)
+
+
+(provide 'gnus-diary)
+
+;;; arch-tag: 98467e70-337e-4ddc-b92d-45d403ff1b4b
+;;; gnus-diary.el ends here
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
new file mode 100644
index 00000000000..b029ab5d114
--- /dev/null
+++ b/lisp/gnus/gnus-dired.el
@@ -0,0 +1,207 @@
+;;; gnus-dired.el --- utility functions where gnus and dired meet
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
+
+;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
+;; Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: mail, news, extensions
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides utility functions for intersections of gnus
+;; and dired. To enable the gnus-dired-mode minor mode which will
+;; have the effect of installing keybindings in dired-mode, place the
+;; following in your ~/.gnus:
+
+;; (require 'gnus-dired) ;, isn't needed due to autoload cookies
+;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
+
+;; Note that if you visit dired buffers before your ~/.gnus file has
+;; been read, those dired buffers won't have the keybindings in
+;; effect. To get around that problem, you may want to add the above
+;; statements to your ~/.emacs instead.
+
+;;; Code:
+
+(require 'dired)
+(require 'gnus-ems)
+(require 'gnus-msg)
+(require 'gnus-util)
+(require 'message)
+(require 'mm-encode)
+(require 'mml)
+
+(defvar gnus-dired-mode nil
+ "Minor mode for intersections of gnus and dired.")
+
+(defvar gnus-dired-mode-map nil)
+
+(unless gnus-dired-mode-map
+ (setq gnus-dired-mode-map (make-sparse-keymap))
+
+ (gnus-define-keys gnus-dired-mode-map
+ "\C-c\C-m\C-a" gnus-dired-attach
+ "\C-c\C-m\C-l" gnus-dired-find-file-mailcap
+ "\C-c\C-m\C-p" gnus-dired-print))
+
+(defun gnus-dired-mode (&optional arg)
+ "Minor mode for intersections of gnus and dired.
+
+\\{gnus-dired-mode-map}"
+ (interactive "P")
+ (when (eq major-mode 'dired-mode)
+ (set (make-local-variable 'gnus-dired-mode)
+ (if (null arg) (not gnus-dired-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-dired-mode
+ (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
+ (gnus-run-hooks 'gnus-dired-mode-hook))))
+
+;;;###autoload
+(defun turn-on-gnus-dired-mode ()
+ "Convenience method to turn on gnus-dired-mode."
+ (gnus-dired-mode 1))
+
+;; Method to attach files to a gnus composition.
+(defun gnus-dired-attach (files-to-attach)
+ "Attach dired's marked files to a gnus message composition.
+If called non-interactively, FILES-TO-ATTACH should be a list of
+filenames."
+ (interactive
+ (list
+ (delq nil
+ (mapcar
+ ;; don't attach directories
+ (lambda (f) (if (file-directory-p f) nil f))
+ (nreverse (dired-map-over-marks (dired-get-filename) nil))))))
+ (let ((destination nil)
+ (files-str nil)
+ (bufs nil))
+ ;; warn if user tries to attach without any files marked
+ (if (null files-to-attach)
+ (error "No files to attach")
+ (setq files-str
+ (mapconcat
+ (lambda (f) (file-name-nondirectory f))
+ files-to-attach ", "))
+ (setq bufs (message-buffers))
+
+ ;; set up destination message buffer
+ (if (and bufs
+ (y-or-n-p "Attach files to existing message buffer? "))
+ (setq destination
+ (if (= (length bufs) 1)
+ (get-buffer (car bufs))
+ (completing-read "Attach to which message buffer: "
+ (mapcar
+ (lambda (b)
+ (cons b (get-buffer b)))
+ bufs)
+ nil t)))
+ ;; setup a new gnus message buffer
+ (gnus-setup-message 'message (message-mail))
+ (setq destination (current-buffer)))
+
+ ;; set buffer to destination buffer, and attach files
+ (set-buffer destination)
+ (goto-char (point-max)) ;attach at end of buffer
+ (while files-to-attach
+ (mml-attach-file (car files-to-attach)
+ (or (mm-default-file-encoding (car files-to-attach))
+ "application/octet-stream") nil)
+ (setq files-to-attach (cdr files-to-attach)))
+ (message "Attached file(s) %s" files-str))))
+
+(autoload 'mailcap-parse-mailcaps "mailcap" "" t)
+
+(defun gnus-dired-find-file-mailcap (&optional file-name arg)
+ "In dired, visit FILE-NAME according to the mailcap file.
+If ARG is non-nil, open it in a new buffer."
+ (interactive (list
+ (file-name-sans-versions (dired-get-filename) t)
+ current-prefix-arg))
+ (mailcap-parse-mailcaps)
+ (if (file-exists-p file-name)
+ (let (mime-type method)
+ (if (and (not arg)
+ (not (file-directory-p file-name))
+ (string-match "\\.[^\\.]+$" file-name)
+ (setq mime-type
+ (mailcap-extension-to-mime
+ (match-string 0 file-name)))
+ (stringp
+ (setq method
+ (cdr (assoc 'viewer
+ (car (mailcap-mime-info mime-type
+ 'all)))))))
+ (let ((view-command (mm-mailcap-command method file-name nil)))
+ (message "viewing via %s" view-command)
+ (start-process "*display*"
+ nil
+ shell-file-name
+ shell-command-switch
+ view-command))
+ (find-file file-name)))
+ (if (file-symlink-p file-name)
+ (error "File is a symlink to a nonexistent target")
+ (error "File no longer exists; type `g' to update Dired buffer"))))
+
+(defun gnus-dired-print (&optional file-name print-to)
+ "In dired, print FILE-NAME according to the mailcap file.
+
+If there is no print command, print in a PostScript image. If the
+optional argument PRINT-TO is nil, send the image to the printer. If
+PRINT-TO is a string, save the PostScript image in a file with that
+name. If PRINT-TO is a number, prompt the user for the name of the
+file to save in."
+ (interactive (list
+ (file-name-sans-versions (dired-get-filename) t)
+ (ps-print-preprint current-prefix-arg)))
+ (mailcap-parse-mailcaps)
+ (cond
+ ((file-directory-p file-name)
+ (error "Can't print a directory"))
+ ((file-exists-p file-name)
+ (let (mime-type method)
+ (if (and (string-match "\\.[^\\.]+$" file-name)
+ (setq mime-type
+ (mailcap-extension-to-mime
+ (match-string 0 file-name)))
+ (stringp
+ (setq method (mailcap-mime-info mime-type "print"))))
+ (call-process shell-file-name nil
+ (generate-new-buffer " *mm*")
+ nil
+ shell-command-switch
+ (mm-mailcap-command method file-name mime-type))
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (gnus-print-buffer))
+ (ps-despool print-to))))
+ ((file-symlink-p file-name)
+ (error "File is a symlink to a nonexistent target"))
+ (t
+ (error "File no longer exists; type `g' to update Dired buffer"))))
+
+(provide 'gnus-dired)
+
+;;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76
+;;; gnus-dired.el ends here
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 8ce449b72f3..62deeb4b894 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -1,5 +1,5 @@
;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -46,6 +46,7 @@
(gnus-define-keys gnus-draft-mode-map
"Dt" gnus-draft-toggle-sending
+ "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article'
"De" gnus-draft-edit-message
"Ds" gnus-draft-send-message
"DS" gnus-draft-send-all-messages))
@@ -94,13 +95,18 @@
(defun gnus-draft-edit-message ()
"Enter a mail/post buffer to edit and send the draft."
(interactive)
- (let ((article (gnus-summary-article-number)))
+ (let ((article (gnus-summary-article-number))
+ (group gnus-newsgroup-name))
(gnus-summary-mark-as-read article gnus-canceled-mark)
- (gnus-draft-setup article gnus-newsgroup-name t)
+ (gnus-draft-setup article group t)
(set-buffer-modified-p t)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "date")))
(save-buffer)
(let ((gnus-verbose-backends nil))
- (gnus-request-expire-articles (list article) gnus-newsgroup-name t))
+ (gnus-request-expire-articles (list article) group t))
(push
`((lambda ()
(when (gnus-buffer-exists-p ,gnus-summary-buffer)
@@ -126,8 +132,9 @@
(defun gnus-draft-send (article &optional group interactive)
"Send message ARTICLE."
- (let ((message-syntax-checks (if interactive nil
+ (let ((message-syntax-checks (if interactive message-syntax-checks
'dont-check-for-anything-just-trust-me))
+ (message-hidden-headers nil)
(message-inhibit-body-encoding (or (not group)
(equal group "nndraft:queue")
message-inhibit-body-encoding))
@@ -135,13 +142,20 @@
message-send-hook))
(message-setup-hook (and group (not (equal group "nndraft:queue"))
message-setup-hook))
- type method)
+ type method move-to)
(gnus-draft-setup article (or group "nndraft:queue"))
;; We read the meta-information that says how and where
;; this message is to be sent.
(save-restriction
(message-narrow-to-head)
(when (re-search-forward
+ (concat "^" (regexp-quote gnus-agent-target-move-group-header)
+ ":") nil t)
+ (skip-syntax-forward "-")
+ (setq move-to (buffer-substring (point) (gnus-point-at-eol)))
+ (message-remove-header gnus-agent-target-move-group-header))
+ (goto-char (point-min))
+ (when (re-search-forward
(concat "^" (regexp-quote gnus-agent-meta-information-header) ":")
nil t)
(setq type (ignore-errors (read (current-buffer)))
@@ -159,8 +173,12 @@
(message-this-is-mail (eq type 'mail))
(gnus-post-method method)
(message-post-method method))
- (message-send-and-exit))
- (message-send-and-exit)))
+ (if move-to
+ (gnus-inews-do-gcc move-to)
+ (message-send-and-exit)))
+ (if move-to
+ (gnus-inews-do-gcc move-to)
+ (message-send-and-exit))))
(let ((gnus-verbose-backends nil))
(gnus-request-expire-articles
(list article) (or group "nndraft:queue") t)))))
@@ -168,10 +186,14 @@
(defun gnus-draft-send-all-messages ()
"Send all the sendable drafts."
(interactive)
- (gnus-uu-mark-buffer)
- (gnus-draft-send-message))
+ (when (or
+ gnus-expert-user
+ (gnus-y-or-n-p
+ "Send all drafts? "))
+ (gnus-uu-mark-buffer)
+ (gnus-draft-send-message)))
-(defun gnus-group-send-drafts ()
+(defun gnus-group-send-queue ()
"Send all sendable articles from the queue group."
(interactive)
(gnus-activate-group "nndraft:queue")
@@ -181,6 +203,7 @@
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
+ (gnus-posting-styles nil)
(total (length articles))
article)
(while (setq article (pop articles))
@@ -190,6 +213,20 @@
(- total (length articles)) total)))
(gnus-draft-send article)))))))
+;;;###autoload
+(defun gnus-draft-reminder ()
+ "Reminder user if there are unsent drafts."
+ (interactive)
+ (if (gnus-alive-p)
+ (let (active)
+ (catch 'continue
+ (dolist (group '("nndraft:drafts" "nndraft:queue"))
+ (setq active (gnus-activate-group group))
+ (if (and active (>= (cdr active) (car active)))
+ (if (y-or-n-p "There are unsent drafts. Confirm to exit? ")
+ (throw 'continue t)
+ (error "Stop!"))))))))
+
;;; Utility functions
;;;!!!If this is byte-compiled, it fails miserably.
@@ -199,21 +236,41 @@
(progn
(defun gnus-draft-setup (narticle group &optional restore)
- (gnus-setup-message 'forward
- (let ((article narticle))
- (message-mail)
- (erase-buffer)
- (if (not (gnus-request-restore-buffer article group))
- (error "Couldn't restore the article")
- (if (and restore (equal group "nndraft:queue"))
+ (let (ga)
+ (gnus-setup-message 'forward
+ (let ((article narticle))
+ (message-mail)
+ (erase-buffer)
+ (if (not (gnus-request-restore-buffer article group))
+ (error "Couldn't restore the article")
+ (when (and restore
+ (equal group "nndraft:queue"))
(mime-to-mml))
- ;; Insert the separator.
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (insert mail-header-separator)
- (forward-line 1)
- (message-set-auto-save-file-name))))))
+ ;; Insert the separator.
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ (forward-line 1)
+ (setq ga (message-fetch-field gnus-draft-meta-information-header))
+ (message-set-auto-save-file-name))))
+ (gnus-backlog-remove-article group narticle)
+ (when (and ga
+ (ignore-errors (setq ga (car (read-from-string ga)))))
+ (setq gnus-newsgroup-name
+ (if (equal (car ga) "") nil (car ga)))
+ (gnus-configure-posting-styles)
+ (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
+ (setq message-post-method
+ `(lambda (arg)
+ (gnus-post-method arg ,(car ga))))
+ (unless (equal (cadr ga) "")
+ (message-add-action
+ `(progn
+ (gnus-add-mark ,(car ga) 'replied ,(cadr ga))
+ (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga))
+ 'add '(reply)))))
+ 'send))))))
(defun gnus-draft-article-sendable-p (article)
"Say whether ARTICLE is sendable."
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 97a92ed36ee..8fdd97f8847 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -113,7 +113,7 @@ seen in the same session."
(gnus-dup-open))
(setq gnus-dup-list-dirty t) ; mark list for saving
(let ((data gnus-newsgroup-data)
- datum msgid)
+ datum msgid)
;; Enter the Message-IDs of all read articles into the list
;; and hash table.
(while (setq datum (pop data))
@@ -121,11 +121,11 @@ seen in the same session."
(> (gnus-data-number datum) 0)
(not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
(not (= (gnus-data-mark datum) gnus-canceled-mark))
- (setq msgid (mail-header-id (gnus-data-header datum)))
- (not (nnheader-fake-message-id-p msgid))
- (not (intern-soft msgid gnus-dup-hashtb)))
+ (setq msgid (mail-header-id (gnus-data-header datum)))
+ (not (nnheader-fake-message-id-p msgid))
+ (not (intern-soft msgid gnus-dup-hashtb)))
(push msgid gnus-dup-list)
- (intern msgid gnus-dup-hashtb))))
+ (intern msgid gnus-dup-hashtb))))
;; Chop off excess Message-IDs from the list.
(let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
(when end
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index e4c581b3d03..ae5debaff01 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -1,5 +1,5 @@
;;; gnus-eform.el --- a mode for editing forms for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -106,7 +106,7 @@ of the buffer."
(insert ";; Type `C-c C-c' after you've finished editing.\n")
(insert "\n")
(let ((p (point)))
- (pp form (current-buffer))
+ (gnus-pp form)
(insert "\n")
(goto-char p))))
@@ -114,7 +114,9 @@ of the buffer."
"Update changes and kill the current buffer."
(interactive)
(goto-char (point-min))
- (let ((form (read (current-buffer)))
+ (let ((form (condition-case nil
+ (read (current-buffer))
+ (end-of-file nil)))
(func gnus-edit-form-done-function))
(gnus-edit-form-exit)
(funcall func form)))
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index 10fdb2dc7be..729b0013dc2 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -1,5 +1,5 @@
;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -45,12 +45,13 @@
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(autoload 'gnus-xmas-redefine "gnus-xmas")
- (autoload 'appt-select-lowest-window "appt"))
+ (autoload 'appt-select-lowest-window "appt")
+ (autoload 'gnus-get-buffer-create "gnus")
+ (autoload 'nnheader-find-etc-directory "nnheader"))
-(if (featurep 'xemacs)
- (autoload 'gnus-smiley-display "smiley")
- (autoload 'gnus-smiley-display "smiley-ems") ; override XEmacs version
-)
+(autoload 'smiley-region "smiley")
+;; Fixme: shouldn't require message
+(autoload 'message-text-with-property "message")
(defun gnus-kill-all-overlays ()
"Delete all overlays in the current buffer."
@@ -71,20 +72,30 @@
valstr)))
(eval-and-compile
+ (defalias 'gnus-char-width
+ (if (fboundp 'char-width)
+ 'char-width
+ (lambda (ch) 1)))) ;; A simple hack.
+
+(eval-and-compile
(if (featurep 'xemacs)
(gnus-xmas-define)
(defvar gnus-mouse-face-prop 'mouse-face
"Property used for highlighting mouse regions.")))
-(defvar gnus-tmp-unread)
-(defvar gnus-tmp-replied)
-(defvar gnus-tmp-score-char)
-(defvar gnus-tmp-indentation)
-(defvar gnus-tmp-opening-bracket)
-(defvar gnus-tmp-lines)
-(defvar gnus-tmp-name)
-(defvar gnus-tmp-closing-bracket)
-(defvar gnus-tmp-subject-or-nil)
+(eval-when-compile
+ (defvar gnus-tmp-unread)
+ (defvar gnus-tmp-replied)
+ (defvar gnus-tmp-score-char)
+ (defvar gnus-tmp-indentation)
+ (defvar gnus-tmp-opening-bracket)
+ (defvar gnus-tmp-lines)
+ (defvar gnus-tmp-name)
+ (defvar gnus-tmp-closing-bracket)
+ (defvar gnus-tmp-subject-or-nil)
+ (defvar gnus-check-before-posting)
+ (defvar gnus-mouse-face)
+ (defvar gnus-group-buffer))
(defun gnus-ems-redefine ()
(cond
@@ -96,18 +107,18 @@
;; [Note] Now there are three kinds of mule implementations,
;; original MULE, XEmacs/mule and Emacs 20+ including
- ;; MULE features. Unfortunately these API are different. In
- ;; particular, Emacs (including original MULE) and XEmacs are
+ ;; MULE features. Unfortunately these APIs are different. In
+ ;; particular, Emacs (including original Mule) and XEmacs are
;; quite different. However, this version of Gnus doesn't support
;; anything other than XEmacs 20+ and Emacs 20.3+.
;; Predicates to check are following:
- ;; (boundp 'MULE) is t only if MULE (original; anything older than
+ ;; (boundp 'MULE) is t only if Mule (original; anything older than
;; Mule 2.3) is running.
- ;; (featurep 'mule) is t when every mule variants are running.
+ ;; (featurep 'mule) is t when other mule variants are running.
;; It is possible to detect XEmacs/mule by (featurep 'mule) and
- ;; checking `emacs-version'. In this case, the implementation for
+ ;; (featurep 'xemacs). In this case, the implementation for
;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule.
(defvar gnus-summary-display-table nil
@@ -144,6 +155,10 @@
(boundp 'mark-active)
mark-active))
+(defun gnus-mark-active-p ()
+ "Non-nil means the mark and region are currently active in this buffer."
+ mark-active) ; aliased to region-exists-p in XEmacs.
+
(if (fboundp 'add-minor-mode)
(defalias 'gnus-add-minor-mode 'add-minor-mode)
(defun gnus-add-minor-mode (mode name map &rest rest)
@@ -166,11 +181,13 @@
(when (and dir
(file-exists-p (setq file
(expand-file-name "x-splash" dir))))
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (ignore-errors
- (setq pixmap (read (current-buffer))))))
+ (let ((coding-system-for-read 'raw-text)
+ default-enable-multibyte-characters)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (ignore-errors
+ (setq pixmap (read (current-buffer)))))))
(when pixmap
(make-face 'gnus-splash)
(setq height (/ (car pixmap) (frame-char-height))
@@ -189,81 +206,36 @@
(goto-char (point-min))
(sit-for 0))))))
-(defvar gnus-article-xface-ring-internal nil
- "Cache for face data.")
-
-;; Worth customizing?
-(defvar gnus-article-xface-ring-size 6
- "Length of the ring used for `gnus-article-xface-ring-internal'.")
-
-(defvar gnus-article-compface-xbm
- (eq 0 (string-match "#define" (shell-command-to-string "uncompface -X")))
- "Non-nil means the compface program supports the -X option.
-That produces XBM output.")
-
-(defun gnus-article-display-xface (beg end)
- "Display an XFace header from between BEG and END in the current article.
-Requires support for images in your Emacs and the external programs
-`uncompface', and `icontopbm'. On a GNU/Linux system these
-might be in packages with names like `compface' or `faces-xface' and
-`netpbm' or `libgr-progs', for instance. See also
-`gnus-article-compface-xbm'.
-
-This function is for Emacs 21+. See `gnus-xmas-article-display-xface'
-for XEmacs."
- ;; It might be worth converting uncompface's output in Lisp.
-
- (when (if (fboundp 'display-graphic-p)
- (display-graphic-p))
- (unless gnus-article-xface-ring-internal ; Only load ring when needed.
- (setq gnus-article-xface-ring-internal
- (make-ring gnus-article-xface-ring-size)))
- (save-excursion
- (let* ((cur (current-buffer))
- (data (buffer-substring beg end))
- (image (cdr-safe (assoc data (ring-elements
- gnus-article-xface-ring-internal))))
- default-enable-multibyte-characters)
- (unless image
- (with-temp-buffer
- (insert data)
- (and (eq 0 (apply #'call-process-region (point-min) (point-max)
- "uncompface"
- 'delete '(t nil) nil
- (if gnus-article-compface-xbm
- '("-X"))))
- (if gnus-article-compface-xbm
- t
- (goto-char (point-min))
- (progn (insert "/* Width=48, Height=48 */\n") t)
- (eq 0 (call-process-region (point-min) (point-max)
- "icontopbm"
- 'delete '(t nil))))
- ;; Miles Bader says that faces don't look right as
- ;; light on dark.
- (if (eq 'dark (cdr-safe (assq 'background-mode
- (frame-parameters))))
- (setq image (create-image (buffer-string)
- (if gnus-article-compface-xbm
- 'xbm
- 'pbm)
- t
- :ascent 'center
- :foreground "black"
- :background "white"))
- (setq image (create-image (buffer-string)
- (if gnus-article-compface-xbm
- 'xbm
- 'pbm)
- t
- :ascent 'center)))))
- (ring-insert gnus-article-xface-ring-internal (cons data image)))
- (when image
- (goto-char (point-min))
- (re-search-forward "^From:" nil 'move)
- (while (get-text-property (point) 'display)
- (goto-char (next-single-property-change (point) 'display)))
- (insert-image image))))))
+;;; Image functions.
+
+(defun gnus-image-type-available-p (type)
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p type)))
+
+(defun gnus-create-image (file &optional type data-p &rest props)
+ (let ((face (plist-get props :face)))
+ (when face
+ (setq props (plist-put props :foreground (face-foreground face)))
+ (setq props (plist-put props :background (face-background face))))
+ (apply 'create-image file type data-p props)))
+
+(defun gnus-put-image (glyph &optional string category)
+ (let ((point (point)))
+ (insert-image glyph (or string " "))
+ (put-text-property point (point) 'gnus-image-category category)
+ (unless string
+ (put-text-property (1- (point)) (point)
+ 'gnus-image-text-deletable t))
+ glyph))
+
+(defun gnus-remove-image (image &optional category)
+ (dolist (position (message-text-with-property 'display))
+ (when (and (equal (get-text-property position 'display) image)
+ (equal (get-text-property position 'gnus-image-category)
+ category))
+ (put-text-property position (1+ position) 'display nil)
+ (when (get-text-property position 'gnus-image-text-deletable)
+ (delete-region position (1+ position))))))
(provide 'gnus-ems)
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
new file mode 100644
index 00000000000..21a5b1c55b4
--- /dev/null
+++ b/lisp/gnus/gnus-fun.el
@@ -0,0 +1,252 @@
+;;; gnus-fun.el --- various frivolous extension functions to Gnus
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl)
+ (require 'mm-util))
+
+(defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory)
+ "*Directory where X-Face PBM files are stored."
+ :group 'gnus-fun
+ :type 'directory)
+
+(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
+ "Command for converting a PBM to an X-Face."
+ :group 'gnus-fun
+ :type 'string)
+
+(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
+ "Command for converting an image to an X-Face.
+By default it takes a GIF filename and output the X-Face header data
+on stdout."
+ :group 'gnus-fun
+ :type 'string)
+
+(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng"
+ "Command for converting an image to an Face.
+By default it takes a JPEG filename and output the Face header data
+on stdout."
+ :group 'gnus-fun
+ :type 'string)
+
+(defun gnus-shell-command-to-string (command)
+ "Like `shell-command-to-string' except not mingling ERROR."
+ (with-output-to-string
+ (call-process shell-file-name nil (list standard-output nil)
+ nil shell-command-switch command)))
+
+(defun gnus-shell-command-on-region (start end command)
+ "A simplified `shell-command-on-region'.
+Output to the current buffer, replace text, and don't mingle error."
+ (call-process-region start end shell-file-name t
+ (list (current-buffer) nil)
+ nil shell-command-switch command))
+
+;;;###autoload
+(defun gnus-random-x-face ()
+ "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
+ (interactive)
+ (when (file-exists-p gnus-x-face-directory)
+ (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
+ (file (nth (random (length files)) files)))
+ (when file
+ (gnus-shell-command-to-string
+ (format gnus-convert-pbm-to-x-face-command
+ (shell-quote-argument file)))))))
+
+;;;###autoload
+(defun gnus-insert-random-x-face-header ()
+ "Insert a random X-Face header from `gnus-x-face-directory'."
+ (interactive)
+ (let ((data (gnus-random-x-face)))
+ (save-excursion
+ (message-goto-eoh)
+ (if data
+ (insert "X-Face: " data)
+ (message
+ "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
+ gnus-x-face-directory)))))
+
+;;;###autoload
+(defun gnus-x-face-from-file (file)
+ "Insert an X-Face header based on an image file."
+ (interactive "fImage file name (by default GIF): ")
+ (when (file-exists-p file)
+ (gnus-shell-command-to-string
+ (format gnus-convert-image-to-x-face-command
+ (shell-quote-argument (expand-file-name file))))))
+
+;;;###autoload
+(defun gnus-face-from-file (file)
+ "Return an Face header based on an image file."
+ (interactive "fImage file name (by default JPEG): ")
+ (when (file-exists-p file)
+ (let ((done nil)
+ (attempt "")
+ (quant 16))
+ (while (and (not done)
+ (> quant 1))
+ (setq attempt
+ (let ((coding-system-for-read 'binary))
+ (gnus-shell-command-to-string
+ (format gnus-convert-image-to-face-command
+ (shell-quote-argument (expand-file-name file))
+ quant))))
+ (if (> (length attempt) 726)
+ (progn
+ (setq quant (- quant 2))
+ (gnus-message 9 "Length %d; trying quant %d"
+ (length attempt) quant))
+ (setq done t)))
+ (if done
+ (mm-with-unibyte-buffer
+ (insert attempt)
+ (gnus-face-encode))
+ nil))))
+
+(defun gnus-face-encode ()
+ (let ((step 72))
+ (base64-encode-region (point-min) (point-max))
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (> (- (point-max) (point))
+ step)
+ (forward-char step)
+ (insert "\n ")
+ (setq step 76))
+ (buffer-string)))
+
+;;;###autoload
+(defun gnus-convert-face-to-png (face)
+ "Convert FACE (which is base64-encoded) to a PNG.
+The PNG is returned as a string."
+ (mm-with-unibyte-buffer
+ (insert face)
+ (ignore-errors
+ (base64-decode-region (point-min) (point-max)))
+ (buffer-string)))
+
+;;;###autoload
+(defun gnus-convert-png-to-face (file)
+ "Convert FILE to a Face.
+FILE should be a PNG file that's 48x48 and smaller than or equal to
+726 bytes."
+ (mm-with-unibyte-buffer
+ (insert-file-contents file)
+ (when (> (buffer-size) 726)
+ (error "The file is %d bytes long, which is too long"
+ (buffer-size)))
+ (gnus-face-encode)))
+
+(defface gnus-x-face '((t (:foreground "black" :background "white")))
+ "Face to show X-Face.
+The colors from this face are used as the foreground and background
+colors of the displayed X-Faces."
+ :group 'gnus-article-headers)
+
+(defun gnus-display-x-face-in-from (data)
+ "Display the X-Face DATA in the From header."
+ (let ((default-enable-multibyte-characters nil)
+ pbm)
+ (when (or (gnus-image-type-available-p 'xface)
+ (and (gnus-image-type-available-p 'pbm)
+ (setq pbm (uncompface data))))
+ (save-excursion
+ (save-restriction
+ (article-narrow-to-head)
+ (gnus-article-goto-header "from")
+ (when (bobp)
+ (insert "From: [no `from' set]\n")
+ (forward-char -17))
+ (gnus-add-image
+ 'xface
+ (gnus-put-image
+ (if (gnus-image-type-available-p 'xface)
+ (gnus-create-image
+ (concat "X-Face: " data)
+ 'xface t :face 'gnus-x-face)
+ (gnus-create-image
+ pbm 'pbm t :face 'gnus-x-face)) nil 'xface))
+ (gnus-add-wash-type 'xface))))))
+
+(defun gnus-grab-cam-x-face ()
+ "Grab a picture off the camera and make it into an X-Face."
+ (interactive)
+ (shell-command "xawtv-remote snap ppm")
+ (let ((file nil))
+ (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
+ t "snap.*ppm")))
+ (sleep-for 1))
+ (setq file (car file))
+ (with-temp-buffer
+ (shell-command
+ (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
+ file)
+ (current-buffer))
+ ;;(sleep-for 3)
+ (delete-file file)
+ (buffer-string))))
+
+(defun gnus-grab-cam-face ()
+ "Grab a picture off the camera and make it into an X-Face."
+ (interactive)
+ (shell-command "xawtv-remote snap ppm")
+ (let ((file nil)
+ result)
+ (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
+ t "snap.*ppm")))
+ (sleep-for 1))
+ (setq file (car file))
+ (shell-command
+ (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > /tmp/gnus.face.ppm"
+ file))
+ (let ((gnus-convert-image-to-face-command
+ (format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng"
+ (gnus-fun-ppm-change-string))))
+ (setq result (gnus-face-from-file "/tmp/gnus.face.ppm")))
+ (delete-file file)
+ ;;(delete-file "/tmp/gnus.face.ppm")
+ result))
+
+(defun gnus-fun-ppm-change-string ()
+ (let* ((possibilites '("%02x0000" "00%02x00" "0000%02x"
+ "%02x%02x00" "00%02x%02x" "%02x00%02x"))
+ (format (concat "'#%02x%02x%02x' '#"
+ (nth (random 6) possibilites)
+ "'"))
+ (values nil))
+ (dotimes (i 255)
+ (push (format format i i i i i i)
+ values))
+ (mapconcat 'identity values " ")))
+
+(provide 'gnus-fun)
+
+;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1
+;;; gnus-fun.el ends here
diff --git a/lisp/gnus/gnus-gl.el b/lisp/gnus/gnus-gl.el
index 4b6fb257a25..12c36209b5d 100644
--- a/lisp/gnus/gnus-gl.el
+++ b/lisp/gnus/gnus-gl.el
@@ -1,6 +1,6 @@
;;; gnus-gl.el --- an interface to GroupLens for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Brad Miller <bmiller@cs.umn.edu>
@@ -131,7 +131,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar gnus-summary-grouplens-line-format
- "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "%U\%R\%z%l%I\%(%[%4L: %-23,23n%]%) %s\n"
"*The line format spec in summary GroupLens mode buffers.")
(defvar grouplens-pseudonym ""
@@ -342,7 +342,7 @@ If this times out we give up and assume that something has died..." )
(defun bbb-build-mid-scores-alist (groupname)
"this function can be called as part of the function to return the list of score files to use.
-See the gnus variable gnus-score-find-score-files-function.
+See the gnus variable `gnus-score-find-score-files-function'.
*Note:* If you want to use grouplens scores along with calculated scores,
you should see the offset and scale variables. At this point, I don't
@@ -510,11 +510,11 @@ recommend using both scores and grouplens predictions together."
;; Return an empty string
""
(let* ((rate-string (make-string 12 ?\ ))
- (mid (mail-header-id header))
- (hashent (gnus-gethash mid grouplens-current-hashtable))
- (pred (or (nth 0 hashent) 0))
- (low (nth 1 hashent))
- (high (nth 2 hashent)))
+ (mid (mail-header-id header))
+ (hashent (gnus-gethash mid grouplens-current-hashtable))
+ (pred (or (nth 0 hashent) 0))
+ (low (nth 1 hashent))
+ (high (nth 2 hashent)))
;; Init rate-string
(aset rate-string 0 ?|)
(aset rate-string 11 ?|)
@@ -632,10 +632,10 @@ recommend using both scores and grouplens predictions together."
(defun bbb-build-rate-command (rate-alist)
(concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n"
- (mapconcat '(lambda (this) ; form (mid . (score . time))
- (concat (car this)
- " :rating=" (cadr this) ".00"
- " :time=" (cddr this)))
+ (mapconcat (lambda (this) ; form (mid . (score . time))
+ (concat (car this)
+ " :rating=" (cadr this) ".00"
+ " :time=" (cddr this)))
rate-alist "\r\n")
"\r\n.\r\n"))
@@ -810,9 +810,9 @@ If prefix argument ALL is non-nil, all articles are marked as read."
(if (null arg) (not gnus-grouplens-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-grouplens-mode
- (make-local-hook 'gnus-select-article-hook)
+ (gnus-make-local-hook 'gnus-select-article-hook)
(add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)
- (make-local-hook 'gnus-exit-group-hook)
+ (gnus-make-local-hook 'gnus-exit-group-hook)
(add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local)
(make-local-variable 'gnus-score-find-score-files-function)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index bf31115a1cf..96d1a864f13 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1,5 +1,5 @@
;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -26,7 +26,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-start)
@@ -37,6 +39,9 @@
(require 'gnus-win)
(require 'gnus-undo)
(require 'time-date)
+(require 'gnus-ems)
+
+(eval-when-compile (require 'mm-url))
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
@@ -117,24 +122,30 @@ This function will be called with group info entries as the arguments
for the groups to be sorted. Pre-made functions include
`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
-`gnus-group-sort-by-score', `gnus-group-sort-by-method', and
-`gnus-group-sort-by-rank'.
+`gnus-group-sort-by-score', `gnus-group-sort-by-method',
+`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
This variable can also be a list of sorting functions. In that case,
the most significant sort function should be the last function in the
list."
:group 'gnus-group-listing
:link '(custom-manual "(gnus)Sorting Groups")
- :type '(radio (function-item gnus-group-sort-by-alphabet)
- (function-item gnus-group-sort-by-real-name)
- (function-item gnus-group-sort-by-unread)
- (function-item gnus-group-sort-by-level)
- (function-item gnus-group-sort-by-score)
- (function-item gnus-group-sort-by-method)
- (function-item gnus-group-sort-by-rank)
- (function :tag "other" nil)))
-
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (if (listp value) value (list value)))
+ :match (lambda (widget value)
+ (or (symbolp value)
+ (widget-editable-list-match widget value)))
+ (choice (function-item gnus-group-sort-by-alphabet)
+ (function-item gnus-group-sort-by-real-name)
+ (function-item gnus-group-sort-by-unread)
+ (function-item gnus-group-sort-by-level)
+ (function-item gnus-group-sort-by-score)
+ (function-item gnus-group-sort-by-method)
+ (function-item gnus-group-sort-by-server)
+ (function-item gnus-group-sort-by-rank)
+ (function :tag "other" nil))))
+
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
@@ -147,14 +158,18 @@ with some simple extensions.
%i Number of ticked and dormant (integer)
%T Number of ticked articles (integer)
%R Number of read articles (integer)
+%U Number of unseen articles (integer)
%t Estimated total number of articles (integer)
%y Number of unread, unticked articles (integer)
%G Group name (string)
%g Qualified group name (string)
+%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
+%C Group comment (string)
%D Group description (string)
%s Select method (string)
%o Moderated group (char, \"m\")
%p Process mark (char)
+%B Whether a summary buffer for the group is open (char, \"*\")
%O Moderated group (string, \"(m)\" or \"\")
%P Topic indentation (string)
%m Whether there is new(ish) mail in the group (char, \"%\")
@@ -165,13 +180,10 @@ with some simple extensions.
%E Icon as defined by `gnus-group-icon-list'.
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the buffer just like information from any other
- group specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face' when
-the mouse point move inside the area. There can only be one such area.
+ where X is the letter following %u. The function will be passed a
+ single dummy parameter as argument. The function should return a
+ string, which will be inserted into the buffer just like information
+ from any other group specifier.
Note that this format specification is not always respected. For
reasons of efficiency, when listing killed groups, this specification
@@ -183,7 +195,11 @@ If you use %o or %O, reading the active file will be slower and quite
a bit of extra memory will be used. %D will also worsen performance.
Also note that if you change the format specification to include any
of these specs, you must probably re-start Gnus to see them go into
-effect."
+effect.
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-group-visual
:type 'string)
@@ -198,11 +214,10 @@ with some simple extensions:
:group 'gnus-group-visual
:type 'string)
-(defcustom gnus-group-mode-hook nil
- "Hook for Gnus group mode."
- :group 'gnus-group-various
- :options '(gnus-topic-mode)
- :type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+ (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
+ (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
(defcustom gnus-group-menu-hook nil
"Hook run after the creation of the group mode menu."
@@ -288,52 +303,52 @@ variable."
(sexp :tag "Method"))))
(defcustom gnus-group-highlight
- '(;; News.
- ((and (= unread 0) (not mailp) (eq level 1)) .
+ '(;; Mail.
+ ((and mailp (= unread 0) (eq level 1)) .
+ gnus-group-mail-1-empty-face)
+ ((and mailp (eq level 1)) .
+ gnus-group-mail-1-face)
+ ((and mailp (= unread 0) (eq level 2)) .
+ gnus-group-mail-2-empty-face)
+ ((and mailp (eq level 2)) .
+ gnus-group-mail-2-face)
+ ((and mailp (= unread 0) (eq level 3)) .
+ gnus-group-mail-3-empty-face)
+ ((and mailp (eq level 3)) .
+ gnus-group-mail-3-face)
+ ((and mailp (= unread 0)) .
+ gnus-group-mail-low-empty-face)
+ ((and mailp) .
+ gnus-group-mail-low-face)
+ ;; News.
+ ((and (= unread 0) (eq level 1)) .
gnus-group-news-1-empty-face)
- ((and (not mailp) (eq level 1)) .
+ ((and (eq level 1)) .
gnus-group-news-1-face)
- ((and (= unread 0) (not mailp) (eq level 2)) .
+ ((and (= unread 0) (eq level 2)) .
gnus-group-news-2-empty-face)
- ((and (not mailp) (eq level 2)) .
+ ((and (eq level 2)) .
gnus-group-news-2-face)
- ((and (= unread 0) (not mailp) (eq level 3)) .
+ ((and (= unread 0) (eq level 3)) .
gnus-group-news-3-empty-face)
- ((and (not mailp) (eq level 3)) .
+ ((and (eq level 3)) .
gnus-group-news-3-face)
- ((and (= unread 0) (not mailp) (eq level 4)) .
+ ((and (= unread 0) (eq level 4)) .
gnus-group-news-4-empty-face)
- ((and (not mailp) (eq level 4)) .
+ ((and (eq level 4)) .
gnus-group-news-4-face)
- ((and (= unread 0) (not mailp) (eq level 5)) .
+ ((and (= unread 0) (eq level 5)) .
gnus-group-news-5-empty-face)
- ((and (not mailp) (eq level 5)) .
+ ((and (eq level 5)) .
gnus-group-news-5-face)
- ((and (= unread 0) (not mailp) (eq level 6)) .
+ ((and (= unread 0) (eq level 6)) .
gnus-group-news-6-empty-face)
- ((and (not mailp) (eq level 6)) .
+ ((and (eq level 6)) .
gnus-group-news-6-face)
- ((and (= unread 0) (not mailp)) .
+ ((and (= unread 0)) .
gnus-group-news-low-empty-face)
- ((and (not mailp)) .
- gnus-group-news-low-face)
- ;; Mail.
- ((and (= unread 0) (eq level 1)) .
- gnus-group-mail-1-empty-face)
- ((eq level 1) .
- gnus-group-mail-1-face)
- ((and (= unread 0) (eq level 2)) .
- gnus-group-mail-2-empty-face)
- ((eq level 2) .
- gnus-group-mail-2-face)
- ((and (= unread 0) (eq level 3)) .
- gnus-group-mail-3-empty-face)
- ((eq level 3) .
- gnus-group-mail-3-face)
- ((= unread 0) .
- gnus-group-mail-low-empty-face)
(t .
- gnus-group-mail-low-face))
+ gnus-group-news-low-face))
"*Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
@@ -395,26 +410,44 @@ ticked: The number of ticked articles."
:type '(repeat (cons (sexp :tag "Form") file)))
(defcustom gnus-group-name-charset-method-alist nil
- "*Alist of method and the charset for group names.
+ "Alist of method and the charset for group names.
For example:
- (((nntp \"news.com.cn\") . cn-gb-2312))
-"
+ (((nntp \"news.com.cn\") . cn-gb-2312))"
:version "21.1"
:group 'gnus-charset
:type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
-(defcustom gnus-group-name-charset-group-alist nil
- "*Alist of group regexp and the charset for group names.
+(defcustom gnus-group-name-charset-group-alist
+ (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
+ (mm-coding-system-p 'utf-8))
+ '((".*" . utf-8))
+ nil)
+ "Alist of group regexp and the charset for group names.
For example:
- ((\"\\.com\\.cn:\" . cn-gb-2312))
-"
+ ((\"\\.com\\.cn:\" . cn-gb-2312))"
:group 'gnus-charset
:type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
+(defcustom gnus-group-jump-to-group-prompt nil
+ "Default prompt for `gnus-group-jump-to-group'.
+If non-nil, the value should be a string, e.g. \"nnml:\",
+in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
+in the minibuffer prompt."
+ :group 'gnus-group-various
+ :type '(choice (string :tag "Prompt string")
+ (const :tag "Empty" nil)))
+
+(defvar gnus-group-listing-limit 1000
+ "*A limit of the number of groups when listing.
+If the number of groups is larger than the limit, list them in a
+simple manner.")
+
;;; Internal variables
+(defvar gnus-group-is-exiting-p nil)
+(defvar gnus-group-is-exiting-without-update-p nil)
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
"Function for sorting the group buffer.")
@@ -441,6 +474,7 @@ For example:
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number)) ?s)
(?R gnus-tmp-number-of-read ?s)
+ (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
@@ -450,6 +484,7 @@ For example:
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
(?c (gnus-short-group-name gnus-tmp-group) ?s)
+ (?C gnus-tmp-comment ?s)
(?D gnus-tmp-newsgroup-description ?s)
(?o gnus-tmp-moderated ?c)
(?O gnus-tmp-moderated-string ?s)
@@ -458,6 +493,7 @@ For example:
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
+ (?B gnus-tmp-summary-live ?c)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
@@ -483,167 +519,221 @@ For example:
(defvar gnus-group-icon-cache nil)
+(defvar gnus-group-listed-groups nil)
+(defvar gnus-group-list-option nil)
+
;;;
;;; Gnus group mode
;;;
(put 'gnus-group-mode 'mode-class 'special)
-(when t
- (gnus-define-keys gnus-group-mode-map
- " " gnus-group-read-group
- "=" gnus-group-select-group
- "\r" gnus-group-select-group
- "\M-\r" gnus-group-quick-select-group
- "\M- " gnus-group-visible-select-group
- [(meta control return)] gnus-group-select-group-ephemerally
- "j" gnus-group-jump-to-group
- "n" gnus-group-next-unread-group
- "p" gnus-group-prev-unread-group
- "\177" gnus-group-prev-unread-group
- [delete] gnus-group-prev-unread-group
- [backspace] gnus-group-prev-unread-group
- "N" gnus-group-next-group
- "P" gnus-group-prev-group
- "\M-n" gnus-group-next-unread-group-same-level
- "\M-p" gnus-group-prev-unread-group-same-level
- "," gnus-group-best-unread-group
- "." gnus-group-first-unread-group
- "u" gnus-group-unsubscribe-current-group
- "U" gnus-group-unsubscribe-group
- "c" gnus-group-catchup-current
- "C" gnus-group-catchup-current-all
- "\M-c" gnus-group-clear-data
- "l" gnus-group-list-groups
- "L" gnus-group-list-all-groups
- "m" gnus-group-mail
- "g" gnus-group-get-new-news
- "\M-g" gnus-group-get-new-news-this-group
- "R" gnus-group-restart
- "r" gnus-group-read-init-file
- "B" gnus-group-browse-foreign-server
- "b" gnus-group-check-bogus-groups
- "F" gnus-group-find-new-groups
- "\C-c\C-d" gnus-group-describe-group
- "\M-d" gnus-group-describe-all-groups
- "\C-c\C-a" gnus-group-apropos
- "\C-c\M-\C-a" gnus-group-description-apropos
- "a" gnus-group-post-news
- "\ek" gnus-group-edit-local-kill
- "\eK" gnus-group-edit-global-kill
- "\C-k" gnus-group-kill-group
- "\C-y" gnus-group-yank-group
- "\C-w" gnus-group-kill-region
- "\C-x\C-t" gnus-group-transpose-groups
- "\C-c\C-l" gnus-group-list-killed
- "\C-c\C-x" gnus-group-expire-articles
- "\C-c\M-\C-x" gnus-group-expire-all-groups
- "V" gnus-version
- "s" gnus-group-save-newsrc
- "z" gnus-group-suspend
- "q" gnus-group-exit
- "Q" gnus-group-quit
- "?" gnus-group-describe-briefly
- "\C-c\C-i" gnus-info-find-node
- "\M-e" gnus-group-edit-group-method
- "^" gnus-group-enter-server-mode
- gnus-mouse-2 gnus-mouse-pick-group
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-b" gnus-bug
- "\C-c\C-s" gnus-group-sort-groups
- "t" gnus-topic-mode
- "\C-c\M-g" gnus-activate-all-groups
- "\M-&" gnus-group-universal-argument
- "#" gnus-group-mark-group
- "\M-#" gnus-group-unmark-group)
-
- (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
- "m" gnus-group-mark-group
- "u" gnus-group-unmark-group
- "w" gnus-group-mark-region
- "b" gnus-group-mark-buffer
- "r" gnus-group-mark-regexp
- "U" gnus-group-unmark-all-groups)
-
- (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
- "d" gnus-group-make-directory-group
- "h" gnus-group-make-help-group
- "u" gnus-group-make-useful-group
- "a" gnus-group-make-archive-group
- "k" gnus-group-make-kiboze-group
- "l" gnus-group-nnimap-edit-acl
- "m" gnus-group-make-group
- "E" gnus-group-edit-group
- "e" gnus-group-edit-group-method
- "p" gnus-group-edit-group-parameters
- "v" gnus-group-add-to-virtual
- "V" gnus-group-make-empty-virtual
- "D" gnus-group-enter-directory
- "f" gnus-group-make-doc-group
- "w" gnus-group-make-web-group
- "r" gnus-group-rename-group
- "c" gnus-group-customize
- "x" gnus-group-nnimap-expunge
- "\177" gnus-group-delete-group
- [delete] gnus-group-delete-group)
-
- (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
- "b" gnus-group-brew-soup
- "w" gnus-soup-save-areas
- "s" gnus-soup-send-replies
- "p" gnus-soup-pack-packet
- "r" nnsoup-pack-replies)
-
- (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
- "s" gnus-group-sort-groups
- "a" gnus-group-sort-groups-by-alphabet
- "u" gnus-group-sort-groups-by-unread
- "l" gnus-group-sort-groups-by-level
- "v" gnus-group-sort-groups-by-score
- "r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
-
- (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
- "s" gnus-group-sort-selected-groups
- "a" gnus-group-sort-selected-groups-by-alphabet
- "u" gnus-group-sort-selected-groups-by-unread
- "l" gnus-group-sort-selected-groups-by-level
- "v" gnus-group-sort-selected-groups-by-score
- "r" gnus-group-sort-selected-groups-by-rank
- "m" gnus-group-sort-selected-groups-by-method)
-
- (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
- "k" gnus-group-list-killed
- "z" gnus-group-list-zombies
- "s" gnus-group-list-groups
- "u" gnus-group-list-all-groups
- "A" gnus-group-list-active
- "a" gnus-group-apropos
- "d" gnus-group-description-apropos
- "m" gnus-group-list-matching
- "M" gnus-group-list-all-matching
- "l" gnus-group-list-level
- "c" gnus-group-list-cached
- "?" gnus-group-list-dormant)
-
- (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
- "f" gnus-score-flush-cache)
-
- (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
- "d" gnus-group-describe-group
- "f" gnus-group-fetch-faq
- "v" gnus-version)
-
- (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
- "l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
- "k" gnus-group-kill-group
- "y" gnus-group-yank-group
- "w" gnus-group-kill-region
- "\C-k" gnus-group-kill-level
- "z" gnus-group-kill-all-zombies))
+(gnus-define-keys gnus-group-mode-map
+ " " gnus-group-read-group
+ "=" gnus-group-select-group
+ "\r" gnus-group-select-group
+ "\M-\r" gnus-group-quick-select-group
+ "\M- " gnus-group-visible-select-group
+ [(meta control return)] gnus-group-select-group-ephemerally
+ "j" gnus-group-jump-to-group
+ "n" gnus-group-next-unread-group
+ "p" gnus-group-prev-unread-group
+ "\177" gnus-group-prev-unread-group
+ [delete] gnus-group-prev-unread-group
+ [backspace] gnus-group-prev-unread-group
+ "N" gnus-group-next-group
+ "P" gnus-group-prev-group
+ "\M-n" gnus-group-next-unread-group-same-level
+ "\M-p" gnus-group-prev-unread-group-same-level
+ "," gnus-group-best-unread-group
+ "." gnus-group-first-unread-group
+ "u" gnus-group-unsubscribe-current-group
+ "U" gnus-group-unsubscribe-group
+ "c" gnus-group-catchup-current
+ "C" gnus-group-catchup-current-all
+ "\M-c" gnus-group-clear-data
+ "l" gnus-group-list-groups
+ "L" gnus-group-list-all-groups
+ "m" gnus-group-mail
+ "i" gnus-group-news
+ "g" gnus-group-get-new-news
+ "\M-g" gnus-group-get-new-news-this-group
+ "R" gnus-group-restart
+ "r" gnus-group-read-init-file
+ "B" gnus-group-browse-foreign-server
+ "b" gnus-group-check-bogus-groups
+ "F" gnus-group-find-new-groups
+ "\C-c\C-d" gnus-group-describe-group
+ "\M-d" gnus-group-describe-all-groups
+ "\C-c\C-a" gnus-group-apropos
+ "\C-c\M-\C-a" gnus-group-description-apropos
+ "a" gnus-group-post-news
+ "\ek" gnus-group-edit-local-kill
+ "\eK" gnus-group-edit-global-kill
+ "\C-k" gnus-group-kill-group
+ "\C-y" gnus-group-yank-group
+ "\C-w" gnus-group-kill-region
+ "\C-x\C-t" gnus-group-transpose-groups
+ "\C-c\C-l" gnus-group-list-killed
+ "\C-c\C-x" gnus-group-expire-articles
+ "\C-c\M-\C-x" gnus-group-expire-all-groups
+ "V" gnus-version
+ "s" gnus-group-save-newsrc
+ "z" gnus-group-suspend
+ "q" gnus-group-exit
+ "Q" gnus-group-quit
+ "?" gnus-group-describe-briefly
+ "\C-c\C-i" gnus-info-find-node
+ "\M-e" gnus-group-edit-group-method
+ "^" gnus-group-enter-server-mode
+ gnus-mouse-2 gnus-mouse-pick-group
+ "<" beginning-of-buffer
+ ">" end-of-buffer
+ "\C-c\C-b" gnus-bug
+ "\C-c\C-s" gnus-group-sort-groups
+ "t" gnus-topic-mode
+ "\C-c\M-g" gnus-activate-all-groups
+ "\M-&" gnus-group-universal-argument
+ "#" gnus-group-mark-group
+ "\M-#" gnus-group-unmark-group)
+
+(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
+ "m" gnus-group-mark-group
+ "u" gnus-group-unmark-group
+ "w" gnus-group-mark-region
+ "b" gnus-group-mark-buffer
+ "r" gnus-group-mark-regexp
+ "U" gnus-group-unmark-all-groups)
+
+(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
+ "u" gnus-sieve-update
+ "g" gnus-sieve-generate)
+
+(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
+ "d" gnus-group-make-directory-group
+ "h" gnus-group-make-help-group
+ "u" gnus-group-make-useful-group
+ "a" gnus-group-make-archive-group
+ "k" gnus-group-make-kiboze-group
+ "l" gnus-group-nnimap-edit-acl
+ "m" gnus-group-make-group
+ "E" gnus-group-edit-group
+ "e" gnus-group-edit-group-method
+ "p" gnus-group-edit-group-parameters
+ "v" gnus-group-add-to-virtual
+ "V" gnus-group-make-empty-virtual
+ "D" gnus-group-enter-directory
+ "f" gnus-group-make-doc-group
+ "w" gnus-group-make-web-group
+ "M" gnus-group-read-ephemeral-group
+ "r" gnus-group-rename-group
+ "R" gnus-group-make-rss-group
+ "c" gnus-group-customize
+ "x" gnus-group-nnimap-expunge
+ "\177" gnus-group-delete-group
+ [delete] gnus-group-delete-group)
+
+(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
+ "b" gnus-group-brew-soup
+ "w" gnus-soup-save-areas
+ "s" gnus-soup-send-replies
+ "p" gnus-soup-pack-packet
+ "r" nnsoup-pack-replies)
+
+(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
+ "s" gnus-group-sort-groups
+ "a" gnus-group-sort-groups-by-alphabet
+ "u" gnus-group-sort-groups-by-unread
+ "l" gnus-group-sort-groups-by-level
+ "v" gnus-group-sort-groups-by-score
+ "r" gnus-group-sort-groups-by-rank
+ "m" gnus-group-sort-groups-by-method
+ "n" gnus-group-sort-groups-by-real-name)
+
+(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
+ "s" gnus-group-sort-selected-groups
+ "a" gnus-group-sort-selected-groups-by-alphabet
+ "u" gnus-group-sort-selected-groups-by-unread
+ "l" gnus-group-sort-selected-groups-by-level
+ "v" gnus-group-sort-selected-groups-by-score
+ "r" gnus-group-sort-selected-groups-by-rank
+ "m" gnus-group-sort-selected-groups-by-method
+ "n" gnus-group-sort-selected-groups-by-real-name)
+
+(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
+ "k" gnus-group-list-killed
+ "z" gnus-group-list-zombies
+ "s" gnus-group-list-groups
+ "u" gnus-group-list-all-groups
+ "A" gnus-group-list-active
+ "a" gnus-group-apropos
+ "d" gnus-group-description-apropos
+ "m" gnus-group-list-matching
+ "M" gnus-group-list-all-matching
+ "l" gnus-group-list-level
+ "c" gnus-group-list-cached
+ "?" gnus-group-list-dormant)
+
+(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
+ "k" gnus-group-list-limit
+ "z" gnus-group-list-limit
+ "s" gnus-group-list-limit
+ "u" gnus-group-list-limit
+ "A" gnus-group-list-limit
+ "m" gnus-group-list-limit
+ "M" gnus-group-list-limit
+ "l" gnus-group-list-limit
+ "c" gnus-group-list-limit
+ "?" gnus-group-list-limit)
+
+(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
+ "k" gnus-group-list-flush
+ "z" gnus-group-list-flush
+ "s" gnus-group-list-flush
+ "u" gnus-group-list-flush
+ "A" gnus-group-list-flush
+ "m" gnus-group-list-flush
+ "M" gnus-group-list-flush
+ "l" gnus-group-list-flush
+ "c" gnus-group-list-flush
+ "?" gnus-group-list-flush)
+
+(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
+ "k" gnus-group-list-plus
+ "z" gnus-group-list-plus
+ "s" gnus-group-list-plus
+ "u" gnus-group-list-plus
+ "A" gnus-group-list-plus
+ "m" gnus-group-list-plus
+ "M" gnus-group-list-plus
+ "l" gnus-group-list-plus
+ "c" gnus-group-list-plus
+ "?" gnus-group-list-plus)
+
+(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
+ "f" gnus-score-flush-cache)
+
+(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "c" gnus-group-fetch-charter
+ "C" gnus-group-fetch-control
+ "d" gnus-group-describe-group
+ "f" gnus-group-fetch-faq
+ "v" gnus-version)
+
+(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
+ "l" gnus-group-set-current-level
+ "t" gnus-group-unsubscribe-current-group
+ "s" gnus-group-unsubscribe-group
+ "k" gnus-group-kill-group
+ "y" gnus-group-yank-group
+ "w" gnus-group-kill-region
+ "\C-k" gnus-group-kill-level
+ "z" gnus-group-kill-all-zombies)
+
+(defun gnus-topic-mode-p ()
+ "Return non-nil in `gnus-topic-mode'."
+ (and (boundp 'gnus-topic-mode)
+ (symbol-value 'gnus-topic-mode)))
(defun gnus-group-make-menu-bar ()
(gnus-turn-off-edit-menu 'group)
@@ -651,40 +741,77 @@ For example:
(easy-menu-define
gnus-group-reading-menu gnus-group-mode-map ""
- '("Group"
- ["Read" gnus-group-read-group (gnus-group-group-name)]
- ["Select" gnus-group-select-group (gnus-group-group-name)]
+ `("Group"
+ ["Read" gnus-group-read-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Read " gnus-topic-read-group
+ :included (gnus-topic-mode-p)]
+ ["Select" gnus-group-select-group
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Select " gnus-topic-select-group
+ :included (gnus-topic-mode-p)]
["See old articles" (gnus-group-select-group 'all)
:keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name)
- :help "Mark unread articles in the current group as read"]
+ ["Catch up" gnus-group-catchup-current
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group as read"))]
+ ["Catch up " gnus-topic-catchup-articles
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in the current group or topic as read"))]
["Catch up all articles" gnus-group-catchup-current-all
(gnus-group-group-name)]
["Check for new articles" gnus-group-get-new-news-this-group
+ :included (not (gnus-topic-mode-p))
:active (gnus-group-group-name)
- :help "Check for new messages in current group"]
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group"))]
+ ["Check for new articles " gnus-topic-get-new-news-this-topic
+ :included (gnus-topic-mode-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Check for new messages in current group or topic"))]
["Toggle subscription" gnus-group-unsubscribe-current-group
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
- :help "Kill (remove) current group"]
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Kill (remove) current group"))]
["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
["Describe" gnus-group-describe-group :active (gnus-group-group-name)
- :help "Display description of the current group"]
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display description of the current group"))]
["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
+ ["Fetch charter" gnus-group-fetch-charter
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the charter of the current group"))]
+ ["Fetch control message" gnus-group-fetch-control
+ :active (gnus-group-group-name)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the archived control message for the current group"))]
;; Actually one should check, if any of the marked groups gives t for
;; (gnus-check-backend-function 'request-expire-articles ...)
["Expire articles" gnus-group-expire-articles
- (or (and (gnus-group-group-name)
- (gnus-check-backend-function
- 'request-expire-articles
- (gnus-group-group-name))) gnus-group-marked)]
- ["Set group level" gnus-group-set-current-level
+ :included (not (gnus-topic-mode-p))
+ :active (or (and (gnus-group-group-name)
+ (gnus-check-backend-function
+ 'request-expire-articles
+ (gnus-group-group-name))) gnus-group-marked)]
+ ["Expire articles " gnus-topic-expire-articles
+ :included (gnus-topic-mode-p)]
+ ["Set group level..." gnus-group-set-current-level
(gnus-group-group-name)]
["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
["Customize" gnus-group-customize (gnus-group-group-name)]
("Edit"
["Parameters" gnus-group-edit-group-parameters
- (gnus-group-group-name)]
+ :included (not (gnus-topic-mode-p))
+ :active (gnus-group-group-name)]
+ ["Parameters " gnus-topic-edit-parameters
+ :included (gnus-topic-mode-p)]
["Select method" gnus-group-edit-group-method
(gnus-group-group-name)]
["Info" gnus-group-edit-group (gnus-group-group-name)]
@@ -715,22 +842,25 @@ For example:
["Sort by score" gnus-group-sort-groups-by-score t]
["Sort by level" gnus-group-sort-groups-by-level t]
["Sort by unread" gnus-group-sort-groups-by-unread t]
- ["Sort by name" gnus-group-sort-groups-by-alphabet t])
+ ["Sort by name" gnus-group-sort-groups-by-alphabet t]
+ ["Sort by real name" gnus-group-sort-groups-by-real-name t])
("Sort process/prefixed"
["Default sort" gnus-group-sort-selected-groups
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by method" gnus-group-sort-selected-groups-by-method
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by rank" gnus-group-sort-selected-groups-by-rank
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by score" gnus-group-sort-selected-groups-by-score
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by level" gnus-group-sort-selected-groups-by-level
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by unread" gnus-group-sort-selected-groups-by-unread
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ (not (gnus-topic-mode-p))]
["Sort by name" gnus-group-sort-selected-groups-by-alphabet
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ (not (gnus-topic-mode-p))]
+ ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
+ (not (gnus-topic-mode-p))])
("Mark"
["Mark group" gnus-group-mark-group
(and (gnus-group-group-name)
@@ -740,27 +870,30 @@ For example:
(memq (gnus-group-group-name) gnus-group-marked))]
["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
["Mark regexp..." gnus-group-mark-regexp t]
- ["Mark region" gnus-group-mark-region t]
+ ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group" gnus-group-unsubscribe-group t]
- ["Kill all newsgroups in region" gnus-group-kill-region t]
+ ["Subscribe to a group..." gnus-group-unsubscribe-group t]
+ ["Kill all newsgroups in region" gnus-group-kill-region
+ :active (gnus-mark-active-p)]
["Kill all zombie groups" gnus-group-kill-all-zombies
gnus-zombie-list]
["Kill all groups on level..." gnus-group-kill-level t])
("Foreign groups"
- ["Make a foreign group" gnus-group-make-group t]
- ["Add a directory group" gnus-group-make-directory-group t]
+ ["Make a foreign group..." gnus-group-make-group t]
+ ["Add a directory group..." gnus-group-make-directory-group t]
["Add the help group" gnus-group-make-help-group t]
["Add the archive group" gnus-group-make-archive-group t]
- ["Make a doc group" gnus-group-make-doc-group t]
- ["Make a web group" gnus-group-make-web-group t]
- ["Make a kiboze group" gnus-group-make-kiboze-group t]
- ["Make a virtual group" gnus-group-make-empty-virtual t]
- ["Add a group to a virtual" gnus-group-add-to-virtual t]
- ["Rename group" gnus-group-rename-group
+ ["Make a doc group..." gnus-group-make-doc-group t]
+ ["Make a web group..." gnus-group-make-web-group t]
+ ["Make a kiboze group..." gnus-group-make-kiboze-group t]
+ ["Make a virtual group..." gnus-group-make-empty-virtual t]
+ ["Add a group to a virtual..." gnus-group-add-to-virtual t]
+ ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
+ ["Make an RSS group..." gnus-group-make-rss-group t]
+ ["Rename group..." gnus-group-rename-group
(gnus-check-backend-function
'request-rename-group (gnus-group-group-name))]
["Delete group" gnus-group-delete-group
@@ -774,9 +907,12 @@ For example:
["Next unread same level" gnus-group-next-unread-group-same-level t]
["Previous unread same level"
gnus-group-prev-unread-group-same-level t]
- ["Jump to group" gnus-group-jump-to-group t]
+ ["Jump to group..." gnus-group-jump-to-group t]
["First unread group" gnus-group-first-unread-group t]
["Best unread group" gnus-group-best-unread-group t])
+ ("Sieve"
+ ["Generate" gnus-sieve-generate t]
+ ["Generate and update" gnus-sieve-update t])
["Delete bogus groups" gnus-group-check-bogus-groups t]
["Find new newsgroups" gnus-group-find-new-groups t]
["Transpose" gnus-group-transpose-groups
@@ -785,7 +921,7 @@ For example:
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
- '("Misc"
+ `("Gnus"
("SOUP"
["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
["Send replies" gnus-soup-send-replies
@@ -794,13 +930,20 @@ For example:
["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
["Send a mail" gnus-group-mail t]
- ["Post an article..." gnus-group-post-news t]
+ ["Send a message (mail or news)" gnus-group-post-news t]
+ ["Create a local message" gnus-group-news t]
["Check for new news" gnus-group-get-new-news
- :help "Get newly arrived articles"]
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Get newly arrived articles"))
+ ]
+ ["Send queued messages" gnus-delay-send-queue
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Send all messages that are scheduled to be sent now"))
+ ]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
- ["Browse foreign server" gnus-group-browse-foreign-server t]
+ ["Browse foreign server..." gnus-group-browse-foreign-server t]
["Enter server buffer" gnus-group-enter-server-mode t]
["Expire all expirable articles" gnus-group-expire-all-groups t]
["Generate any kiboze groups" nnkiboze-generate-groups t]
@@ -813,7 +956,8 @@ For example:
["Toggle topics" gnus-topic-mode t]
["Send a bug report" gnus-bug t]
["Exit from Gnus" gnus-group-exit
- :help "Quit reading news"]
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Quit reading news"))]
["Exit without saving" gnus-group-quit t]))
(gnus-run-hooks 'gnus-group-menu-hook)))
@@ -828,7 +972,8 @@ For example:
(default-value 'tool-bar-mode)
(not gnus-group-toolbar-map))
(setq gnus-group-toolbar-map
- (let ((tool-bar-map (make-sparse-keymap)))
+ (let ((tool-bar-map (make-sparse-keymap))
+ (load-path (mm-image-load-path)))
(tool-bar-add-item-from-menu
'gnus-group-get-new-news "get-news" gnus-group-mode-map)
(tool-bar-add-item-from-menu
@@ -891,6 +1036,7 @@ The following commands are available:
(defun gnus-update-group-mark-positions ()
(save-excursion
(let ((gnus-process-mark ?\200)
+ (gnus-group-update-hook nil)
(gnus-group-marked '("dummy.group"))
(gnus-active-hashtb (make-vector 10 0))
(topic ""))
@@ -932,7 +1078,7 @@ The following commands are available:
(when gnus-carpal
(gnus-carpal-setup-buffer 'group))))
-(defsubst gnus-group-name-charset (method group)
+(defun gnus-group-name-charset (method group)
(if (null method)
(setq method (gnus-find-method-for-group group)))
(let ((item (assoc method gnus-group-name-charset-method-alist))
@@ -946,7 +1092,8 @@ The following commands are available:
result (cdr item))))
result)))
-(defsubst gnus-group-name-decode (string charset)
+(defun gnus-group-name-decode (string charset)
+ ;; Fixme: Don't decode in unibyte mode.
(if (and string charset (featurep 'mule))
(mm-decode-coding-string string charset)
string))
@@ -1028,18 +1175,35 @@ If ALL (the prefix), also list groups that have no unread articles."
(interactive "nList groups on level: \nP")
(gnus-group-list-groups level all level))
-(defun gnus-group-prepare-flat (level &optional all lowest regexp)
+(defun gnus-group-prepare-logic (group test)
+ (or (and gnus-group-listed-groups
+ (null gnus-group-list-option)
+ (member group gnus-group-listed-groups))
+ (cond
+ ((null gnus-group-listed-groups) test)
+ ((null gnus-group-list-option) test)
+ (t (and (member group gnus-group-listed-groups)
+ (if (eq gnus-group-list-option 'flush)
+ (not test)
+ test))))))
+
+(defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
"List all newsgroups with unread articles of level LEVEL or lower.
-If ALL is non-nil, list groups that have no unread articles.
+If PREDICATE is a function, list groups that the function returns non-nil;
+if it is t, list groups that have no unread articles.
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If REGEXP, only list groups matching REGEXP."
+If REGEXP is a function, list dead groups that the function returns non-nil;
+if it is a string, only list groups matching REGEXP."
(set-buffer gnus-group-buffer)
(let ((buffer-read-only nil)
(newsrc (cdr gnus-newsrc-alist))
(lowest (or lowest 1))
+ (not-in-list (and gnus-group-listed-groups
+ (copy-sequence gnus-group-listed-groups)))
info clevel unread group params)
(erase-buffer)
- (when (< lowest gnus-level-zombie)
+ (when (or (< lowest gnus-level-zombie)
+ gnus-group-listed-groups)
;; List living groups.
(while newsrc
(setq info (car newsrc)
@@ -1047,41 +1211,60 @@ If REGEXP, only list groups matching REGEXP."
params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be unchecked
- (or (not regexp)
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (or all ; We list all groups?
- (if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups ; We list unactivated
- (> unread 0)) ; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
+ (when not-in-list
+ (setq not-in-list (delete group not-in-list)))
+ (when (gnus-group-prepare-logic
+ group
+ (and unread ; This group might be unchecked
+ (or (not (stringp regexp))
+ (string-match regexp group))
+ (<= (setq clevel (gnus-info-level info)) level)
+ (>= clevel lowest)
+ (cond
+ ((functionp predicate)
+ (funcall predicate info))
+ (predicate t) ; We list all groups?
+ (t
+ (or
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups
+ ; We list unactivated
+ (> unread 0))
+ ; We list groups with unread articles
+ (and gnus-list-groups-with-ticked-articles
+ (cdr (assq 'tick (gnus-info-marks info))))
; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups
- group))
- (memq 'visible params)
- (cdr (assq 'visible params)))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups
+ group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))))))
+ (gnus-group-insert-group-line
+ group (gnus-info-level info)
+ (gnus-info-marks info) unread (gnus-info-method info)))))
;; List dead groups.
- (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K regexp))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie)))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
+ (when not-in-list
+ (dolist (group gnus-zombie-list)
+ (setq not-in-list (delete group not-in-list))))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
+ (gnus-group-prepare-flat-list-dead
+ (gnus-union
+ not-in-list
+ (setq gnus-killed-list (sort gnus-killed-list 'string<)))
+ gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level all))
+ (setq gnus-group-list-mode (cons level predicate))
(gnus-run-hooks 'gnus-group-prepare-hook)
t))
@@ -1090,35 +1273,38 @@ If REGEXP, only list groups matching REGEXP."
;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
;; this by ignoring the group format specification altogether.
(let (group)
- (if regexp
- ;; This loop is used when listing groups that match some
- ;; regexp.
+ (if (> (length groups) gnus-group-listing-limit)
(while groups
(setq group (pop groups))
- (when (string-match regexp group)
+ (when (gnus-group-prepare-logic
+ group
+ (or (not regexp)
+ (and (stringp regexp) (string-match regexp group))
+ (and (functionp regexp) (funcall regexp group))))
(gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
+ (gnus-group-decoded-name group)
"\n"))
(list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-unread t
'gnus-level level))))
- ;; This loop is used when listing all groups.
(while groups
(setq group (pop groups))
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))))
+ (when (gnus-group-prepare-logic
+ group
+ (or (not regexp)
+ (and (stringp regexp) (string-match regexp group))
+ (and (functionp regexp) (funcall regexp group))))
+ (gnus-group-insert-group-line
+ group level nil
+ (let ((active (gnus-active group)))
+ (if active
+ (if (zerop (cdr active))
+ 0
+ (- (1+ (cdr active)) (car active)))
+ nil))
+ (gnus-method-simplify (gnus-find-method-for-group group))))))))
(defun gnus-group-update-group-line ()
"Update the current line in the group buffer."
@@ -1161,7 +1347,19 @@ If REGEXP, only list groups matching REGEXP."
0
(- (1+ (cdr active)) (car active)))
nil)
- nil))))
+ (gnus-method-simplify (gnus-find-method-for-group group))))))
+
+(defun gnus-number-of-unseen-articles-in-group (group)
+ (let* ((info (nth 2 (gnus-group-entry group)))
+ (marked (gnus-info-marks info))
+ (seen (cdr (assq 'seen marked)))
+ (active (gnus-active group)))
+ (if (not active)
+ 0
+ (length (gnus-uncompress-range
+ (gnus-range-difference
+ (gnus-range-difference (list active) (gnus-info-read info))
+ seen))))))
(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
@@ -1191,6 +1389,9 @@ If REGEXP, only list groups matching REGEXP."
(gnus-tmp-qualified-group
(gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
group-name-charset))
+ (gnus-tmp-comment
+ (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
+ gnus-tmp-group))
(gnus-tmp-newsgroup-description
(if gnus-description-hashtb
(or (gnus-group-name-decode
@@ -1215,6 +1416,11 @@ If REGEXP, only list groups matching REGEXP."
(zerop number)
(cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
+ (gnus-tmp-summary-live
+ (if (and (not gnus-group-is-exiting-p)
+ (gnus-buffer-live-p (gnus-summary-buffer-name
+ gnus-tmp-group)))
+ ?* ? ))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
@@ -1229,7 +1435,9 @@ If REGEXP, only list groups matching REGEXP."
(point)
(prog1 (1+ (point))
;; Insert the text.
- (eval gnus-group-line-format-spec))
+ (let ((gnus-tmp-group (gnus-group-name-decode
+ gnus-tmp-group group-name-charset)))
+ (eval gnus-group-line-format-spec)))
`(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
gnus-unread ,(if (numberp number)
(string-to-int gnus-tmp-number-of-unread)
@@ -1248,7 +1456,7 @@ If REGEXP, only list groups matching REGEXP."
"Highlight the current line according to `gnus-group-highlight'."
(let* ((list gnus-group-highlight)
(p (point))
- (end (progn (end-of-line) (point)))
+ (end (gnus-point-at-eol))
;; now find out where the line starts and leave point there.
(beg (progn (beginning-of-line) (point)))
(group (gnus-group-group-name))
@@ -1257,11 +1465,15 @@ If REGEXP, only list groups matching REGEXP."
(active (gnus-active group))
(total (if active (1+ (- (cdr active) (car active))) 0))
(info (nth 2 entry))
- (method (gnus-server-get-method group (gnus-info-method info)))
+ (method (inline (gnus-server-get-method group (gnus-info-method info))))
(marked (gnus-info-marks info))
- (mailp (memq 'mail (assoc (symbol-name
- (car (or method gnus-select-method)))
- gnus-valid-select-methods)))
+ (mailp (apply 'append
+ (mapcar
+ (lambda (x)
+ (memq x (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ '(mail post-mail))))
(level (or (gnus-info-level info) gnus-level-killed))
(score (or (gnus-info-score info) 0))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
@@ -1526,9 +1738,11 @@ If UNMARK, remove the mark instead."
(interactive "sMark (regexp): ")
(let ((alist (cdr gnus-newsrc-alist))
group)
- (while alist
- (when (string-match regexp (setq group (gnus-info-group (pop alist))))
- (gnus-group-set-mark group))))
+ (save-excursion
+ (while alist
+ (when (string-match regexp (setq group (gnus-info-group (pop alist))))
+ (gnus-group-jump-to-group group)
+ (gnus-group-set-mark group)))))
(gnus-group-position-point))
(defun gnus-group-remove-mark (group &optional test-marked)
@@ -1582,7 +1796,7 @@ Take into consideration N (the prefix) and the list of marked groups."
(setq n (1- n))
(gnus-group-next-group way)))
(nreverse groups)))
- ((gnus-region-active-p)
+ ((and (gnus-region-active-p) (mark))
;; Work on the region between point and mark.
(let ((max (max (point) (mark)))
groups)
@@ -1667,9 +1881,12 @@ group."
(defun gnus-group-select-group (&optional all)
"Select this newsgroup.
No article is selected automatically.
+If the group is opened, just switch the summary buffer.
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles."
(interactive "P")
+ (when (and (eobp) (not (gnus-group-group-name)))
+ (forward-line -1))
(gnus-group-read-group all t))
(defun gnus-group-quick-select-group (&optional all)
@@ -1712,13 +1929,13 @@ be permanent."
(gnus-group-prefixed-name group method) method)))
;;;###autoload
-(defun gnus-fetch-group (group)
+(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
Returns whether the fetching was successful or not."
(interactive (list (completing-read "Group name: " gnus-active-hashtb)))
(unless (get-buffer gnus-group-buffer)
(gnus-no-server))
- (gnus-group-read-group nil nil group))
+ (gnus-group-read-group articles nil group))
;;;###autoload
(defun gnus-fetch-group-other-frame (group)
@@ -1735,19 +1952,48 @@ Returns whether the fetching was successful or not."
(defvar gnus-ephemeral-group-server 0)
+(defcustom gnus-large-ephemeral-newsgroup 200
+ "The number of articles which indicates a large ephemeral newsgroup.
+Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
+
+If the number of articles in a newsgroup is greater than this value,
+confirmation is required for selecting the newsgroup. If it is nil, no
+confirmation is required."
+ :group 'gnus-group-select
+ :type '(choice (const :tag "No limit" nil)
+ integer))
+
+(defcustom gnus-fetch-old-ephemeral-headers nil
+ "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const some)
+ number
+ (sexp :menu-tag "other" t)))
+
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
(defun gnus-group-read-ephemeral-group (group method &optional activate
quit-config request-only
- select-articles)
+ select-articles
+ parameters)
"Read GROUP from METHOD as an ephemeral group.
If ACTIVATE, request the group first.
If QUIT-CONFIG, use that window configuration when exiting from the
ephemeral group.
If REQUEST-ONLY, don't actually read the group; just request it.
If SELECT-ARTICLES, only select those articles.
+If PARAMETERS, use those as the group parameters.
Return the name of the group if selection was successful."
+ (interactive
+ (list
+ ;; (gnus-read-group "Group name: ")
+ (completing-read
+ "Group: " gnus-active-hashtb
+ nil nil nil
+ 'gnus-group-history)
+ (gnus-read-method "From method: ")))
;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
@@ -1756,15 +2002,19 @@ Return the name of the group if selection was successful."
(,(intern (format "%s-address" (car method))) ,(cadr method))
,@(cddr method)))
(let ((group (if (gnus-group-foreign-p group) group
- (gnus-group-prefixed-name group method))))
+ (gnus-group-prefixed-name (gnus-group-real-name group)
+ method))))
(gnus-sethash
group
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
- ((quit-config .
- ,(if quit-config quit-config
- (cons gnus-summary-buffer
- gnus-current-window-configuration))))))
+ ,(cons
+ (if quit-config
+ (cons 'quit-config quit-config)
+ (cons 'quit-config
+ (cons gnus-summary-buffer
+ gnus-current-window-configuration)))
+ parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
(set-buffer gnus-group-buffer)
@@ -1778,7 +2028,10 @@ Return the name of the group if selection was successful."
(if request-only
group
(condition-case ()
- (when (gnus-group-read-group t t group select-articles)
+ (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
+ (gnus-fetch-old-headers
+ gnus-fetch-old-ephemeral-headers))
+ (gnus-group-read-group t t group select-articles))
group)
;;(error nil)
(quit
@@ -1788,11 +2041,12 @@ Return the name of the group if selection was successful."
(defun gnus-group-jump-to-group (group)
"Jump to newsgroup GROUP."
(interactive
- (list (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- nil
- 'gnus-group-history)))
+ (list (mm-string-make-unibyte
+ (completing-read
+ "Group: " gnus-active-hashtb nil
+ (gnus-read-active-file-p)
+ gnus-group-jump-to-group-prompt
+ 'gnus-group-history))))
(when (equal group "")
(error "Empty group name"))
@@ -1937,7 +2191,7 @@ If EXCLUDE-GROUP, do not go to that group."
(forward-line 1))
(when best-point
(goto-char best-point))
- (gnus-summary-position-point)
+ (gnus-group-position-point)
(and best-point (gnus-group-group-name))))
(defun gnus-group-first-unread-group ()
@@ -2000,7 +2254,7 @@ ADDRESS."
(forward-line -1)
(gnus-group-position-point)
- ;; Load the backend and try to make the backend create
+ ;; Load the back end and try to make the back end create
;; the group as well.
(when (assoc (symbol-name (setq backend (car (gnus-server-get-method
nil meth))))
@@ -2008,7 +2262,9 @@ ADDRESS."
(require backend))
(gnus-check-server meth)
(when (gnus-check-backend-function 'request-create-group nname)
- (gnus-request-create-group nname nil args))
+ (unless (gnus-request-create-group nname nil args)
+ (error "Could not create group on server: %s"
+ (nnheader-get-report backend))))
t))
(defun gnus-group-delete-groups (&optional arg)
@@ -2023,19 +2279,23 @@ ADDRESS."
(lambda (group)
(gnus-group-delete-group group nil t))))))
+(defvar gnus-cache-active-altered)
+
(defun gnus-group-delete-group (group &optional force no-prompt)
"Delete the current group. Only meaningful with editable groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
be deleted. This is \"deleted\" as in \"removed forever from the face
of the Earth\". There is no undo. The user will be prompted before
-doing the deletion."
+doing the deletion.
+Note that you also have to specify FORCE if you want the group to
+be removed from the server, even when it's empty."
(interactive
(list (gnus-group-group-name)
current-prefix-arg))
(unless group
- (error "No group to rename"))
+ (error "No group to delete"))
(unless (gnus-check-backend-function 'request-delete-group group)
- (error "This backend does not support group deletion"))
+ (error "This back end does not support group deletion"))
(prog1
(if (and (not no-prompt)
(not (gnus-yes-or-no-p
@@ -2050,6 +2310,10 @@ doing the deletion."
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
+ (if (boundp 'gnus-cache-active-hashtb)
+ (when gnus-cache-active-hashtb
+ (gnus-sethash group nil gnus-cache-active-hashtb)
+ (setq gnus-cache-active-altered t)))
t))
(gnus-group-position-point)))
@@ -2063,12 +2327,12 @@ and NEW-NAME will be prompted for."
(progn
(unless (gnus-check-backend-function
'request-rename-group (gnus-group-group-name))
- (error "This backend does not support renaming groups"))
+ (error "This back end does not support renaming groups"))
(gnus-read-group "Rename group to: "
(gnus-group-real-name (gnus-group-group-name))))))
(unless (gnus-check-backend-function 'request-rename-group group)
- (error "This backend does not support renaming groups"))
+ (error "This back end does not support renaming groups"))
(unless group
(error "No group to rename"))
(when (equal (gnus-group-real-name group) new-name)
@@ -2084,6 +2348,9 @@ and NEW-NAME will be prompted for."
(gnus-group-real-name new-name)
(gnus-info-method (gnus-get-info group)))))
+ (when (gnus-active new-name)
+ (error "The group %s already exists" new-name))
+
(gnus-message 6 "Renaming group %s to %s..." group new-name)
(prog1
(if (progn
@@ -2132,7 +2399,17 @@ and NEW-NAME will be prompted for."
(t "group info"))
(gnus-group-decoded-name group))
`(lambda (form)
- (gnus-group-edit-group-done ',part ,group form)))))
+ (gnus-group-edit-group-done ',part ,group form)))
+ (local-set-key
+ "\C-c\C-i"
+ (gnus-create-info-command
+ (cond
+ ((eq part 'method)
+ "(gnus)Select Methods")
+ ((eq part 'params)
+ "(gnus)Group Parameters")
+ (t
+ "(gnus)Group Info"))))))
(defun gnus-group-edit-group-method (group)
"Edit the select method of GROUP."
@@ -2193,20 +2470,33 @@ and NEW-NAME will be prompted for."
(setcar entry (eval (cadar entry)))))
(gnus-group-make-group group method))
-(defun gnus-group-make-help-group ()
- "Create the Gnus documentation group."
+(defun gnus-group-make-help-group (&optional noerror)
+ "Create the Gnus documentation group.
+Optional argument NOERROR modifies the behavior of this function when the
+group already exists:
+- if not given, and error is signaled,
+- if t, stay silent,
+- if anything else, just print a message."
(interactive)
(let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
(file (nnheader-find-etc-directory "gnus-tut.txt" t)))
- (when (gnus-gethash name gnus-newsrc-hashtb)
- (error "Documentation group already exists"))
- (if (not file)
- (gnus-message 1 "Couldn't find doc group")
- (gnus-group-make-group
- (gnus-group-real-name name)
- (list 'nndoc "gnus-help"
- (list 'nndoc-address file)
- (list 'nndoc-article-type 'mbox)))))
+ (if (gnus-gethash name gnus-newsrc-hashtb)
+ (cond ((eq noerror nil)
+ (error "Documentation group already exists"))
+ ((eq noerror t)
+ ;; stay silent
+ )
+ (t
+ (gnus-message 1 "Documentation group already exists")))
+ ;; else:
+ (if (not file)
+ (gnus-message 1 "Couldn't find doc group")
+ (gnus-group-make-group
+ (gnus-group-real-name name)
+ (list 'nndoc "gnus-help"
+ (list 'nndoc-address file)
+ (list 'nndoc-article-type 'mbox))))
+ ))
(gnus-group-position-point))
(defun gnus-group-make-doc-group (file type)
@@ -2271,12 +2561,41 @@ If SOLID (the prefix), create a solid group."
(nnweb-type ,(intern type))
(nnweb-ephemeral-p t))))
(if solid
- (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
+ (progn
+ (gnus-pull 'nnweb-ephemeral-p method)
+ (gnus-group-make-group group method))
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
(if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+(eval-when-compile
+ (defvar nnrss-group-alist)
+ (defun nnrss-discover-feed (arg))
+ (defun nnrss-save-server-data (arg)))
+(defun gnus-group-make-rss-group (&optional url)
+ "Given a URL, discover if there is an RSS feed.
+If there is, use Gnus to create an nnrss group"
+ (interactive)
+ (require 'nnrss)
+ (if (not url)
+ (setq url (read-from-minibuffer "URL to Search for RSS: ")))
+ (let ((feedinfo (nnrss-discover-feed url)))
+ (if feedinfo
+ (let ((title (read-from-minibuffer "Title: "
+ (cdr (assoc 'title
+ feedinfo))))
+ (desc (read-from-minibuffer "Description: "
+ (cdr (assoc 'description
+ feedinfo))))
+ (href (cdr (assoc 'href feedinfo))))
+ (push (list title href desc)
+ nnrss-group-alist)
+ (gnus-group-unsubscribe-group
+ (concat "nnrss:" title))
+ (nnrss-save-server-data nil))
+ (error "No feeds found for %s" url))))
+
(defvar nnwarchive-type-definition)
(defvar gnus-group-warchive-type-history nil)
(defvar gnus-group-warchive-login-history nil)
@@ -2353,7 +2672,7 @@ mail messages or news articles in files that have numeric names."
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-(eval-when-compile (defvar nnkiboze-score-file))
+(defvar nnkiboze-score-file)
(defun gnus-group-make-kiboze-group (group address scores)
"Create an nnkiboze group.
The user will be prompted for a name, a regexp to match groups, and
@@ -2384,7 +2703,7 @@ score file entries for articles to include in the group."
(make-directory score-dir))
(with-temp-file score-file
(let (emacs-lisp-mode-hook)
- (pp scores (current-buffer))))))
+ (gnus-pp scores)))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
@@ -2504,6 +2823,7 @@ If REVERSE (the prefix), reverse the sorting order."
(interactive (list gnus-group-sort-function current-prefix-arg))
(funcall gnus-group-sort-alist-function
(gnus-make-sort-function func) reverse)
+ (gnus-group-unmark-all-groups)
(gnus-group-list-groups)
(gnus-dribble-touch))
@@ -2526,6 +2846,12 @@ If REVERSE, sort in reverse order."
(interactive "P")
(gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
+(defun gnus-group-sort-groups-by-real-name (&optional reverse)
+ "Sort the group buffer alphabetically by real (unprefixed) group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
+
(defun gnus-group-sort-groups-by-unread (&optional reverse)
"Sort the group buffer by number of unread articles.
If REVERSE, sort in reverse order."
@@ -2551,11 +2877,17 @@ If REVERSE, sort in reverse order."
(gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
(defun gnus-group-sort-groups-by-method (&optional reverse)
- "Sort the group buffer alphabetically by backend name.
+ "Sort the group buffer alphabetically by back end name.
If REVERSE, sort in reverse order."
(interactive "P")
(gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
+(defun gnus-group-sort-groups-by-server (&optional reverse)
+ "Sort the group buffer alphabetically by server name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
+
;;; Selected group sorting.
(defun gnus-group-sort-selected-groups (n func &optional reverse)
@@ -2564,7 +2896,9 @@ If REVERSE, sort in reverse order."
(let ((groups (gnus-group-process-prefix n)))
(funcall gnus-group-sort-selected-function
groups (gnus-make-sort-function func) reverse)
- (gnus-group-list-groups)))
+ (gnus-group-unmark-all-groups)
+ (gnus-group-list-groups)
+ (gnus-dribble-touch)))
(defun gnus-group-sort-selected-flat (groups func reverse)
(let (entries infos)
@@ -2596,6 +2930,13 @@ sort in reverse order."
(interactive (gnus-interactive "P\ny"))
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
+(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
+ "Sort the group buffer alphabetically by real group name.
+Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
+sort in reverse order."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
+
(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
"Sort the group buffer by number of unread articles.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
@@ -2625,7 +2966,7 @@ sort in reverse order."
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
- "Sort the group buffer alphabetically by backend name.
+ "Sort the group buffer alphabetically by back end name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
(interactive (gnus-interactive "P\ny"))
@@ -2654,15 +2995,24 @@ sort in reverse order."
(< (gnus-info-level info1) (gnus-info-level info2)))
(defun gnus-group-sort-by-method (info1 info2)
- "Sort alphabetically by backend name."
- (string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1) info1)))
- (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2) info2)))))
+ "Sort alphabetically by back end name."
+ (string< (car (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (car (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
+
+(defun gnus-group-sort-by-server (info1 info2)
+ "Sort alphabetically by server name."
+ (string< (gnus-method-to-full-server-name
+ (gnus-find-method-for-group
+ (gnus-info-group info1) info1))
+ (gnus-method-to-full-server-name
+ (gnus-find-method-for-group
+ (gnus-info-group info2) info2))))
(defun gnus-group-sort-by-score (info1 info2)
"Sort by group score."
- (< (gnus-info-score info1) (gnus-info-score info2)))
+ (> (gnus-info-score info1) (gnus-info-score info2)))
(defun gnus-group-sort-by-rank (info1 info2)
"Sort by level and score."
@@ -2702,13 +3052,22 @@ sort in reverse order."
(defun gnus-info-clear-data (info)
"Clear all marks and read ranges from INFO."
- (let ((group (gnus-info-group info)))
+ (let ((group (gnus-info-group info))
+ action)
+ (dolist (el (gnus-info-marks info))
+ (push `(,(cdr el) add (,(car el))) action))
+ (push `(,(gnus-info-read info) add (read)) action)
(gnus-undo-register
`(progn
+ (gnus-request-set-mark ,group ',action)
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(gnus-info-set-read ',info ',(gnus-info-read info))
(when (gnus-group-goto-group ,group)
+ (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
(gnus-group-update-group-line))))
+ (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
+ action))
+ (gnus-request-set-mark group action)
(gnus-info-set-read info nil)
(when (gnus-info-marks info)
(gnus-info-set-marks info nil))))
@@ -2768,34 +3127,38 @@ If ALL is non-nil, all articles are marked as read.
The return value is the number of articles that were marked as read,
or nil if no action could be taken."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
- (num (car entry)))
+ (num (car entry))
+ (marks (nth 3 (nth 2 entry)))
+ (unread (gnus-list-of-unread-articles group)))
;; Remove entries for this group.
(nnmail-purge-split-history (gnus-group-real-name group))
;; Do the updating only if the newsgroup isn't killed.
(if (not (numberp (car entry)))
(gnus-message 1 "Can't catch up %s; non-active group" group)
+ (gnus-update-read-articles group nil)
+ (when all
+ ;; Nix out the lists of marks and dormants.
+ (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
+ 'del '(tick))
+ (list (cdr (assq 'dormant marks))
+ 'del '(dormant))))
+ (setq unread (gnus-uncompress-range
+ (gnus-range-add (gnus-range-add
+ unread (cdr (assq 'dormant marks)))
+ (cdr (assq 'tick marks)))))
+ (gnus-add-marked-articles group 'tick nil nil 'force)
+ (gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (gnus-group-auto-expirable-p group)
- (gnus-add-marked-articles
- group 'expire (gnus-list-of-unread-articles group))
- (when all
- (let ((marks (nth 3 (nth 2 entry))))
- (gnus-add-marked-articles
- group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
- (gnus-add-marked-articles
- group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
- (when entry
- (gnus-update-read-articles group nil)
- ;; Also nix out the lists of marks and dormants.
- (when all
- (gnus-add-marked-articles group 'tick nil nil 'force)
- (gnus-add-marked-articles group 'dormant nil nil 'force))
- (let ((gnus-newsgroup-name group))
- (gnus-run-hooks 'gnus-group-catchup-group-hook))
- num))))
+ (gnus-add-marked-articles group 'expire unread)
+ (gnus-request-set-mark group (list (list unread 'add '(expire)))))
+ (let ((gnus-newsgroup-name group))
+ (gnus-run-hooks 'gnus-group-catchup-group-hook))
+ num)))
(defun gnus-group-expire-articles (&optional n)
- "Expire all expirable articles in the current newsgroup."
+ "Expire all expirable articles in the current newsgroup.
+Uses the process/prefix convention."
(interactive "P")
(let ((groups (gnus-group-process-prefix n))
group)
@@ -2854,15 +3217,18 @@ or nil if no action could be taken."
(interactive
(list
current-prefix-arg
- (string-to-int
- (let ((s (read-string
- (format "Level (default %s): "
- (or (gnus-group-group-level)
- gnus-level-default-subscribed)))))
- (if (string-match "^\\s-*$" s)
- (int-to-string (or (gnus-group-group-level)
- gnus-level-default-subscribed))
- s)))))
+ (progn
+ (unless (gnus-group-process-prefix current-prefix-arg)
+ (error "No group on the current line"))
+ (string-to-int
+ (let ((s (read-string
+ (format "Level (default %s): "
+ (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
+ (if (string-match "^\\s-*$" s)
+ (int-to-string (or (gnus-group-group-level)
+ gnus-level-default-subscribed))
+ s))))))
(unless (and (>= level 1) (<= level gnus-level-killed))
(error "Invalid level: %d" level))
(let ((groups (gnus-group-process-prefix n))
@@ -2891,26 +3257,22 @@ or nil if no action could be taken."
"Toggle subscription of the current group.
If given numerical prefix, toggle the N next groups."
(interactive "P")
- (let ((groups (gnus-group-process-prefix n))
- group)
- (while groups
- (setq group (car groups)
- groups (cdr groups))
- (gnus-group-remove-mark group)
- (gnus-group-unsubscribe-group
- group
- (cond
- ((eq do-sub 'unsubscribe)
- gnus-level-default-unsubscribed)
- ((eq do-sub 'subscribe)
- gnus-level-default-subscribed)
- ((<= (gnus-group-group-level) gnus-level-subscribed)
- gnus-level-default-unsubscribed)
- (t
- gnus-level-default-subscribed))
- t)
- (gnus-group-update-group-line))
- (gnus-group-next-group 1)))
+ (dolist (group (gnus-group-process-prefix n))
+ (gnus-group-remove-mark group)
+ (gnus-group-unsubscribe-group
+ group
+ (cond
+ ((eq do-sub 'unsubscribe)
+ gnus-level-default-unsubscribed)
+ ((eq do-sub 'subscribe)
+ gnus-level-default-subscribed)
+ ((<= (gnus-group-group-level) gnus-level-subscribed)
+ gnus-level-default-unsubscribed)
+ (t
+ gnus-level-default-subscribed))
+ t)
+ (gnus-group-update-group-line))
+ (gnus-group-next-group 1))
(defun gnus-group-unsubscribe-group (group &optional level silent)
"Toggle subscription to GROUP.
@@ -3026,29 +3388,27 @@ of groups killed."
(message "Killed group %s" group))
;; If there are lots and lots of groups to be killed, we use
;; this thing instead.
- (let (entry)
- (setq groups (nreverse groups))
- (while groups
- (gnus-group-remove-mark (setq group (pop groups)))
- (gnus-delete-line)
- (push group gnus-killed-list)
- (setq gnus-newsrc-alist
- (delq (assoc group gnus-newsrc-alist)
- gnus-newsrc-alist))
- (when gnus-group-change-level-function
- (funcall gnus-group-change-level-function
- group gnus-level-killed 3))
- (cond
- ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
- (push (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups)
- (setcdr (cdr entry) (cdddr entry)))
- ((member group gnus-zombie-list)
- (setq gnus-zombie-list (delete group gnus-zombie-list))))
- ;; There may be more than one instance displayed.
- (while (gnus-group-goto-group group)
- (gnus-delete-line)))
- (gnus-make-hashtable-from-newsrc-alist)))
+ (dolist (group (nreverse groups))
+ (gnus-group-remove-mark group)
+ (gnus-delete-line)
+ (push group gnus-killed-list)
+ (setq gnus-newsrc-alist
+ (delq (assoc group gnus-newsrc-alist)
+ gnus-newsrc-alist))
+ (when gnus-group-change-level-function
+ (funcall gnus-group-change-level-function
+ group gnus-level-killed 3))
+ (cond
+ ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (push (cons (car entry) (nth 2 entry))
+ gnus-list-of-killed-groups)
+ (setcdr (cdr entry) (cdddr entry)))
+ ((member group gnus-zombie-list)
+ (setq gnus-zombie-list (delete group gnus-zombie-list))))
+ ;; There may be more than one instance displayed.
+ (while (gnus-group-goto-group group)
+ (gnus-delete-line)))
+ (gnus-make-hashtable-from-newsrc-alist))
(gnus-group-position-point)
(if (< (length out) 2) (car out) (nreverse out))))
@@ -3113,7 +3473,7 @@ yanked) a list of yanked groups is returned."
(defun gnus-group-list-all-groups (&optional arg)
"List all newsgroups with level ARG or lower.
-Default is gnus-level-unsubscribed, which lists all subscribed and most
+Default is `gnus-level-unsubscribed', which lists all subscribed and most
unsubscribed groups."
(interactive "P")
(gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
@@ -3175,9 +3535,7 @@ entail asking the server for the groups."
(gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
+ (gnus-group-decoded-name group)
"\n"))
(list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-unread t
@@ -3202,6 +3560,7 @@ re-scanning. If ARG is non-nil and not a number, this will force
;; Binding this variable will inhibit multiple fetchings
;; of the same mail source.
(nnmail-fetched-sources (list t)))
+ (gnus-run-hooks 'gnus-get-top-new-news-hook)
(gnus-run-hooks 'gnus-get-new-news-hook)
;; Read any slave files.
@@ -3301,6 +3660,60 @@ to use."
(find-file file)
(setq found t))))))
+(defun gnus-group-fetch-charter (group)
+ "Fetch the charter for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (require 'mm-url)
+ (condition-case nil (require 'url-http) (error nil))
+ (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
+ url hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
+ (if (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p (eval url))
+ t))
+ (browse-url (eval url))
+ (setq url (concat "http://" hierarchy
+ ".news-admin.org/charters/" name))
+ (if (and (fboundp 'url-http-file-exists-p)
+ (url-http-file-exists-p url))
+ (browse-url url)
+ (gnus-group-fetch-control group))))))
+
+(defun gnus-group-fetch-control (group)
+ "Fetch the archived control messages for the current group.
+If given a prefix argument, prompt for a group."
+ (interactive
+ (list (or (when current-prefix-arg
+ (completing-read "Group: " gnus-active-hashtb))
+ (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (unless group
+ (error "No group name given"))
+ (let ((name (gnus-group-real-name group))
+ hierarchy)
+ (when (string-match "\\(^[^\\.]+\\)\\..*" name)
+ (setq hierarchy (match-string 1 name))
+ (if gnus-group-fetch-control-use-browse-url
+ (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
+ hierarchy "/" name ".gz"))
+ (let ((enable-local-variables nil))
+ (gnus-group-read-ephemeral-group
+ group
+ `(nndoc ,group (nndoc-address
+ ,(find-file-noselect
+ (concat "/ftp@ftp.isc.org:/usenet/control/"
+ hierarchy "/" name ".gz")))
+ (nndoc-article-type mbox)) t nil nil))))))
+
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
(interactive (list current-prefix-arg (gnus-group-group-name)))
@@ -3396,7 +3809,7 @@ to use."
(pop-to-buffer obuf)))
(defun gnus-group-description-apropos (regexp)
- "List all newsgroups that have names or descriptions that match a regexp."
+ "List all newsgroups that have names or descriptions that match REGEXP."
(interactive "sGnus description apropos (regexp): ")
(when (not (or gnus-description-hashtb
(gnus-read-all-descriptions-files)))
@@ -3417,8 +3830,8 @@ This command may read the active file."
(when (and level
(> (prefix-numeric-value level) gnus-level-killed))
(gnus-get-killed-groups))
- (gnus-group-prepare-flat
- (or level gnus-level-subscribed) all (or lowest 1) regexp)
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
(goto-char (point-min))
(gnus-group-position-point))
@@ -3495,17 +3908,26 @@ If GROUP, edit that local kill file instead."
(interactive)
(gnus-save-newsrc-file))
+(defvar gnus-backlog-articles)
+
(defun gnus-group-suspend ()
"Suspend the current Gnus session.
In fact, cleanup buffers except for group mode buffer.
-The hook gnus-suspend-gnus-hook is called before actually suspending."
+The hook `gnus-suspend-gnus-hook' is called before actually suspending."
(interactive)
(gnus-run-hooks 'gnus-suspend-gnus-hook)
+ (gnus-offer-save-summaries)
;; Kill Gnus buffers except for group mode buffer.
(let ((group-buf (get-buffer gnus-group-buffer)))
- (dolist (buf (gnus-buffers))
- (unless (or (eq buf group-buf) (eq buf gnus-dribble-buffer))
- (kill-buffer buf)))
+ (mapcar (lambda (buf)
+ (unless (or (member buf (list group-buf gnus-dribble-buffer))
+ (progn
+ (save-excursion
+ (set-buffer buf)
+ (eq major-mode 'message-mode))))
+ (gnus-kill-buffer buf)))
+ (gnus-buffers))
+ (setq gnus-backlog-articles nil)
(gnus-kill-gnus-frames)
(when group-buf
(bury-buffer group-buf)
@@ -3552,6 +3974,12 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
(file-name-nondirectory gnus-current-startup-file))))
(gnus-run-hooks 'gnus-exit-gnus-hook)
(gnus-configure-windows 'group t)
+ (when (and (gnus-buffer-live-p gnus-dribble-buffer)
+ (not (zerop (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (buffer-size)))))
+ (gnus-dribble-enter
+ ";;; Gnus was exited on purpose without saving the .newsrc files."))
(gnus-dribble-save)
(gnus-close-backends)
(gnus-clear-system)
@@ -3572,10 +4000,10 @@ If not, METHOD should be a list where the first element is the method
and the second element is the address."
(interactive
(list (let ((how (completing-read
- "Which backend: "
+ "Which back end: "
(append gnus-valid-select-methods gnus-server-alist)
nil t (cons "nntp" 0) 'gnus-method-history)))
- ;; We either got a backend name or a virtual server name.
+ ;; We either got a back end name or a virtual server name.
;; If the first, we also need an address.
(if (assoc how gnus-valid-select-methods)
(list (intern how)
@@ -3641,7 +4069,8 @@ and the second element is the address."
(setcar (nthcdr 2 entry) info)
(when (and (not (eq (car entry) t))
(gnus-active (gnus-info-group info)))
- (setcar entry (length (gnus-list-of-unread-articles (car info))))))
+ (setcar entry (length
+ (gnus-list-of-unread-articles (car info))))))
(error "No such group: %s" (gnus-info-group info))))))
(defun gnus-group-set-method-info (group select-method)
@@ -3676,6 +4105,16 @@ and the second element is the address."
(sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
+(defun gnus-add-mark (group mark article)
+ "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
+ (let ((buffer (gnus-summary-buffer-name group)))
+ (if (gnus-buffer-live-p buffer)
+ (save-excursion
+ (set-buffer (get-buffer buffer))
+ (gnus-summary-add-mark article mark))
+ (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
+ (list article)))))
+
;;;
;;; Group timestamps
;;;
@@ -3697,7 +4136,7 @@ or `gnus-group-catchup-group-hook'."
"Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
(let* ((time (or (gnus-group-timestamp group)
(list 0 0)))
- (delta (subtract-time (current-time) time)))
+ (delta (subtract-time (current-time) time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))
@@ -3708,68 +4147,6 @@ or `gnus-group-catchup-group-hook'."
""
(gnus-time-iso8601 time))))
-(defun gnus-group-prepare-flat-list-dead-predicate
- (groups level mark predicate)
- (let (group)
- (if predicate
- ;; This loop is used when listing groups that match some
- ;; regexp.
- (while (setq group (pop groups))
- (when (funcall predicate group)
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-name-decode group
- (gnus-group-name-charset
- nil group))
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level)))))))
-
-(defun gnus-group-prepare-flat-predicate (level predicate &optional lowest
- dead-predicate)
- "List all newsgroups with unread articles of level LEVEL or lower.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If PREDICATE, only list groups which PREDICATE returns non-nil.
-If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil."
- (set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil)
- (newsrc (cdr gnus-newsrc-alist))
- (lowest (or lowest 1))
- info clevel unread group params)
- (erase-buffer)
- ;; List living groups.
- (while newsrc
- (setq info (car newsrc)
- group (gnus-info-group info)
- params (gnus-info-params info)
- newsrc (cdr newsrc)
- unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be unchecked
- (funcall predicate info)
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info))))
-
- ;; List dead groups.
- (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
- (gnus-group-prepare-flat-list-dead-predicate
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- dead-predicate))
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
- (gnus-group-prepare-flat-list-dead-predicate
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K dead-predicate))
-
- (gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level t))
- (gnus-run-hooks 'gnus-group-prepare-hook)
- t))
-
(defun gnus-group-list-cached (level &optional lowest)
"List all groups with cached articles.
If the prefix LEVEL is non-nil, it should be a number that says which
@@ -3782,21 +4159,22 @@ This command may read the active file."
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
- (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'cache marks)))
- lowest
- #'(lambda (group)
- (or (gnus-gethash group
- gnus-cache-active-hashtb)
- ;; Cache active file might use "."
- ;; instead of ":".
- (gnus-gethash
- (mapconcat 'identity
- (split-string group ":")
- ".")
- gnus-cache-active-hashtb))))
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed)
+ #'(lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'cache marks)))
+ lowest
+ #'(lambda (group)
+ (or (gnus-gethash group
+ gnus-cache-active-hashtb)
+ ;; Cache active file might use "."
+ ;; instead of ":".
+ (gnus-gethash
+ (mapconcat 'identity
+ (split-string group ":")
+ ".")
+ gnus-cache-active-hashtb))))
(goto-char (point-min))
(gnus-group-position-point))
@@ -3812,14 +4190,90 @@ This command may read the active file."
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
- (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'dormant marks)))
- lowest)
+ (funcall gnus-group-prepare-function
+ (or level gnus-level-subscribed)
+ #'(lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'dormant marks)))
+ lowest
+ 'ignore)
(goto-char (point-min))
(gnus-group-position-point))
+(defun gnus-group-listed-groups ()
+ "Return a list of listed groups."
+ (let (point groups)
+ (goto-char (point-min))
+ (while (setq point (text-property-not-all (point) (point-max)
+ 'gnus-group nil))
+ (goto-char point)
+ (push (symbol-name (get-text-property point 'gnus-group)) groups)
+ (forward-char 1))
+ groups))
+
+(defun gnus-group-list-plus (&optional args)
+ "List groups plus the current selection."
+ (interactive "P")
+ (let ((gnus-group-listed-groups (gnus-group-listed-groups))
+ (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
+ func)
+ (push last-command-event unread-command-events)
+ (if (featurep 'xemacs)
+ (push (make-event 'key-press '(key ?A)) unread-command-events)
+ (push ?A unread-command-events))
+ (let (gnus-pick-mode keys)
+ (setq keys (if (featurep 'xemacs)
+ (events-to-keys (read-key-sequence nil))
+ (read-key-sequence nil)))
+ (setq func (lookup-key (current-local-map) keys)))
+ (if (or (not func)
+ (numberp func))
+ (ding)
+ (call-interactively func))))
+
+(defun gnus-group-list-flush (&optional args)
+ "Flush groups from the current selection."
+ (interactive "P")
+ (let ((gnus-group-list-option 'flush))
+ (gnus-group-list-plus args)))
+
+(defun gnus-group-list-limit (&optional args)
+ "List groups limited within the current selection."
+ (interactive "P")
+ (let ((gnus-group-list-option 'limit))
+ (gnus-group-list-plus args)))
+
+(defun gnus-group-mark-article-read (group article)
+ "Mark ARTICLE read."
+ (let ((buffer (gnus-summary-buffer-name group))
+ (mark gnus-read-mark)
+ active n)
+ (if (get-buffer buffer)
+ (with-current-buffer buffer
+ (setq active gnus-newsgroup-active)
+ (gnus-activate-group group)
+ (when gnus-newsgroup-prepared
+ (when (and gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (setq mark (gnus-request-update-mark
+ group article mark))
+ (gnus-mark-article-as-read article mark)
+ (setq gnus-newsgroup-active (gnus-active group))
+ (when active
+ (setq n (1+ (cdr active)))
+ (while (<= n (cdr gnus-newsgroup-active))
+ (unless (eq n article)
+ (push n gnus-newsgroup-unselected))
+ (setq n (1+ n)))
+ (setq gnus-newsgroup-unselected
+ (nreverse gnus-newsgroup-unselected)))))
+ (gnus-activate-group group)
+ (gnus-group-make-articles-read group (list article))
+ (when (gnus-group-auto-expirable-p group)
+ (gnus-add-marked-articles
+ group 'expire (list article))))))
+
(provide 'gnus-group)
;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 89961281bbe..fc0d7f192ee 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -1,5 +1,5 @@
;;; gnus-int.el --- backend interface functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -29,12 +29,31 @@
(eval-when-compile (require 'cl))
(require 'gnus)
+(require 'message)
+(require 'gnus-range)
+
+(autoload 'gnus-agent-expire "gnus-agent")
+(autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
(defcustom gnus-open-server-hook nil
"Hook called just before opening connection to the news server."
:group 'gnus-start
:type 'hook)
+(defcustom gnus-server-unopen-status nil
+ "The default status if the server is not able to open.
+If the server is covered by Gnus agent, the possible values are
+`denied', set the server denied; `offline', set the server offline;
+nil, ask user. If the server is not covered by Gnus agent, set the
+server denied."
+ :group 'gnus-start
+ :type '(choice (const :tag "Ask" nil)
+ (const :tag "Deny server" denied)
+ (const :tag "Unplug Agent" offline)))
+
+(defvar gnus-internal-registry-spool-current-method nil
+ "The current method, for the registry.")
+
;;;
;;; Server Communication
;;;
@@ -87,6 +106,18 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
(require 'nntp)))
(setq gnus-current-select-method gnus-select-method)
(gnus-run-hooks 'gnus-open-server-hook)
+
+ ;; Partially validate agent covered methods now that the
+ ;; gnus-select-method is known.
+
+ (if gnus-agent
+ ;; NOTE: This is here for one purpose only. By validating
+ ;; the current select method, it converts the old 5.10.3,
+ ;; and earlier, format to the current format. That enables
+ ;; the agent code within gnus-open-server to function
+ ;; correctly.
+ (gnus-agent-read-servers-validate-native gnus-select-method))
+
(or
;; gnus-open-server-hook might have opened it
(gnus-server-opened gnus-select-method)
@@ -110,7 +141,8 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
"Check whether the connection to METHOD is down.
If METHOD is nil, use `gnus-select-method'.
If it is down, start it up (again)."
- (let ((method (or method gnus-select-method)))
+ (let ((method (or method gnus-select-method))
+ result)
;; Transform virtual server names into select methods.
(when (stringp method)
(setq method (gnus-server-to-method method)))
@@ -124,9 +156,15 @@ If it is down, start it up (again)."
(format " on %s" (nth 1 method)))))
(gnus-run-hooks 'gnus-open-server-hook)
(prog1
- (gnus-open-server method)
+ (condition-case ()
+ (setq result (gnus-open-server method))
+ (quit (message "Quit gnus-check-server")
+ nil))
(unless silent
- (message ""))))))
+ (gnus-message 5 "Opening %s server%s...%s" (car method)
+ (if (equal (nth 1 method) "") ""
+ (format " on %s" (nth 1 method)))
+ (if result "done" "failed")))))))
(defun gnus-get-function (method function &optional noerror)
"Return a function symbol based on METHOD and FUNCTION."
@@ -175,18 +213,66 @@ If it is down, start it up (again)."
(gnus-message 1 "Denied server")
nil)
;; Open the server.
- (let ((result
- (funcall (gnus-get-function gnus-command-method 'open-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method))))
+ (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server))
+ (result
+ (condition-case err
+ (funcall open-server-function
+ (nth 1 gnus-command-method)
+ (nthcdr 2 gnus-command-method))
+ (error
+ (gnus-message 1 (format
+ "Unable to open server due to: %s"
+ (error-message-string err)))
+ nil)
+ (quit
+ (gnus-message 1 "Quit trying to open server")
+ nil)))
+ open-offline)
;; If this hasn't been opened before, we add it to the list.
(unless elem
(setq elem (list gnus-command-method nil)
gnus-opened-servers (cons elem gnus-opened-servers)))
;; Set the status of this server.
- (setcar (cdr elem) (if result 'ok 'denied))
- ;; Return the result from the "open" call.
- result))))
+ (setcar (cdr elem)
+ (cond (result
+ (if (eq open-server-function #'nnagent-open-server)
+ ;; The agent's backend has a "special" status
+ 'offline
+ 'ok))
+ ((and gnus-agent
+ (gnus-agent-method-p gnus-command-method))
+ (cond (gnus-server-unopen-status
+ ;; Set the server's status to the unopen
+ ;; status. If that status is offline,
+ ;; recurse to open the agent's backend.
+ (setq open-offline (eq gnus-server-unopen-status 'offline))
+ gnus-server-unopen-status)
+ ((gnus-y-or-n-p
+ (format "Unable to open %s:%s, go offline? "
+ (car gnus-command-method)
+ (cadr gnus-command-method)))
+ (setq open-offline t)
+ 'offline)
+ (t
+ ;; This agentized server was still denied
+ 'denied)))
+ (t
+ ;; This unagentized server must be denied
+ 'denied)))
+
+ ;; NOTE: I MUST set the server's status to offline before this
+ ;; recursive call as this status will drive the
+ ;; gnus-get-function (called above) to return the agent's
+ ;; backend.
+ (if open-offline
+ ;; Recursively open this offline server to perform the
+ ;; open-server function of the agent's backend.
+ (let ((gnus-server-unopen-status 'denied))
+ ;; Bind gnus-server-unopen-status to avoid recursively
+ ;; prompting with "go offline?". This is only a concern
+ ;; when the agent's backend fails to open the server.
+ (gnus-open-server gnus-command-method))
+ result)))))
(defun gnus-close-server (gnus-command-method)
"Close the connection to GNUS-COMMAND-METHOD."
@@ -228,8 +314,8 @@ If it is down, start it up (again)."
(defun gnus-status-message (gnus-command-method)
"Return the status message from GNUS-COMMAND-METHOD.
-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method
-this group uses will be queried."
+If GNUS-COMMAND-METHOD is a string, it is interpreted as a group
+name. The method this group uses will be queried."
(let ((gnus-command-method
(if (stringp gnus-command-method)
(gnus-find-method-for-group gnus-command-method)
@@ -289,11 +375,16 @@ this group uses will be queried."
"Request headers for ARTICLES in GROUP.
If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
(let ((gnus-command-method (gnus-find-method-for-group group)))
- (if (and gnus-use-cache (numberp (car articles)))
- (gnus-cache-retrieve-headers articles group fetch-old)
+ (cond
+ ((and gnus-use-cache (numberp (car articles)))
+ (gnus-cache-retrieve-headers articles group fetch-old))
+ ((and gnus-agent (gnus-online gnus-command-method)
+ (gnus-agent-method-p gnus-command-method))
+ (gnus-agent-retrieve-headers articles group fetch-old))
+ (t
(funcall (gnus-get-function gnus-command-method 'retrieve-headers)
articles (gnus-group-real-name group)
- (nth 1 gnus-command-method) fetch-old))))
+ (nth 1 gnus-command-method) fetch-old)))))
(defun gnus-retrieve-articles (articles group)
"Request ARTICLES in GROUP."
@@ -319,7 +410,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
(gnus-group-real-name group) article))))
(defun gnus-request-set-mark (group action)
- "Set marks on articles in the backend."
+ "Set marks on articles in the back end."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-set-mark (car gnus-command-method)))
@@ -329,7 +420,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
(nth 1 gnus-command-method)))))
(defun gnus-request-update-mark (group article mark)
- "Allow the backend to change the mark the user tries to put on an article."
+ "Allow the back end to change the mark the user tries to put on an article."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-update-mark (car gnus-command-method)))
@@ -358,6 +449,10 @@ If BUFFER, insert the article in that group."
(gnus-cache-request-article article group))
(setq res (cons group article)
clean-up t))
+ ;; Check the agent cache.
+ ((gnus-agent-request-article article group)
+ (setq res (cons group article)
+ clean-up t))
;; Use `head' function.
((fboundp head)
(setq res (funcall head article (gnus-group-real-name group)
@@ -387,6 +482,10 @@ If BUFFER, insert the article in that group."
(gnus-cache-request-article article group))
(setq res (cons group article)
clean-up t))
+ ;; Check the agent cache.
+ ((gnus-agent-request-article article group)
+ (setq res (cons group article)
+ clean-up t))
;; Use `head' function.
((fboundp head)
(setq res (funcall head article (gnus-group-real-name group)
@@ -418,9 +517,11 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(gnus-inhibit-demon t)
(mail-source-plugged gnus-plugged))
(if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-scan)
- (and group (gnus-group-real-name group))
- (nth 1 gnus-command-method)))))
+ (progn
+ (setq gnus-internal-registry-spool-current-method gnus-command-method)
+ (funcall (gnus-get-function gnus-command-method 'request-scan)
+ (and group (gnus-group-real-name group))
+ (nth 1 gnus-command-method))))))
(defsubst gnus-request-update-info (info gnus-command-method)
"Request that GNUS-COMMAND-METHOD update INFO."
@@ -428,23 +529,49 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (gnus-check-backend-function
'request-update-info (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'request-update-info)
- (gnus-group-real-name (gnus-info-group info))
- info (nth 1 gnus-command-method))))
+ (let ((group (gnus-info-group info)))
+ (and (funcall (gnus-get-function gnus-command-method
+ 'request-update-info)
+ (gnus-group-real-name group)
+ info (nth 1 gnus-command-method))
+ ;; If the minimum article number is greater than 1, then all
+ ;; smaller article numbers are known not to exist; we'll
+ ;; artificially add those to the 'read range.
+ (let* ((active (gnus-active group))
+ (min (car active)))
+ (when (> min 1)
+ (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
+ (read (gnus-info-read info))
+ (new-read (gnus-range-add read (list range))))
+ (gnus-info-set-read info new-read)))
+ info)))))
(defun gnus-request-expire-articles (articles group &optional force)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-expire-articles)
- articles (gnus-group-real-name group) (nth 1 gnus-command-method)
- force)))
-
-(defun gnus-request-move-article
- (article group server accept-function &optional last)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-move-article)
- article (gnus-group-real-name group)
- (nth 1 gnus-command-method) accept-function last)))
-
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (not-deleted
+ (funcall
+ (gnus-get-function gnus-command-method 'request-expire-articles)
+ articles (gnus-group-real-name group) (nth 1 gnus-command-method)
+ force)))
+ (when (and gnus-agent
+ (gnus-agent-method-p gnus-command-method))
+ (let ((expired-articles (gnus-sorted-difference articles not-deleted)))
+ (when expired-articles
+ (gnus-agent-expire expired-articles group 'force))))
+ not-deleted))
+
+(defun gnus-request-move-article (article group server accept-function
+ &optional last)
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (result (funcall (gnus-get-function gnus-command-method
+ 'request-move-article)
+ article (gnus-group-real-name group)
+ (nth 1 gnus-command-method) accept-function last)))
+ (when (and result gnus-agent
+ (gnus-agent-method-p gnus-command-method))
+ (gnus-agent-expire (list article) group 'force))
+ result))
+
(defun gnus-request-accept-article (group &optional gnus-command-method last
no-encode)
;; Make sure there's a newline at the end of the article.
@@ -457,25 +584,29 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(unless (bolp)
(insert "\n"))
(unless no-encode
- (save-restriction
- (message-narrow-to-head)
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer)))
- (message-encode-message-body))
- (let ((func (car (or gnus-command-method
- (gnus-find-method-for-group group)))))
- (funcall (intern (format "%s-request-accept-article" func))
+ (let ((message-options message-options))
+ (message-options-set-recipient)
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((mail-parse-charset message-default-charset))
+ (mail-encode-encoded-word-buffer)))
+ (message-encode-message-body)))
+ (let ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group))))
+ (funcall (gnus-get-function gnus-command-method 'request-accept-article)
(if (stringp group) (gnus-group-real-name group) group)
(cadr gnus-command-method)
last)))
(defun gnus-request-replace-article (article group buffer &optional no-encode)
(unless no-encode
- (save-restriction
- (message-narrow-to-head)
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer)))
- (message-encode-message-body))
+ (let ((message-options message-options))
+ (message-options-set-recipient)
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((mail-parse-charset message-default-charset))
+ (mail-encode-encoded-word-buffer)))
+ (message-encode-message-body)))
(let ((func (car (gnus-group-name-to-method group))))
(funcall (intern (format "%s-request-replace-article" func))
article (gnus-group-real-name group) buffer)))
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 73ea066617b..7b04422b36c 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -1,5 +1,5 @@
;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -357,16 +357,16 @@ If NEWSGROUP is nil, return the global kill file instead."
(defun gnus-apply-kill-file-unless-scored ()
"Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
(cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
- ;; Ignores global KILL.
- (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
+ ;; Ignores global KILL.
+ (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
(gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
gnus-newsgroup-name))
- 0)
- ((or (file-exists-p (gnus-newsgroup-kill-file nil))
- (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
- (gnus-apply-kill-file-internal))
- (t
- 0)))
+ 0)
+ ((or (file-exists-p (gnus-newsgroup-kill-file nil))
+ (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (gnus-apply-kill-file-internal))
+ (t
+ 0)))
(defun gnus-apply-kill-file-internal ()
"Apply a kill file to the current newsgroup.
@@ -398,7 +398,7 @@ Returns the number of articles marked as read."
gnus-newsgroup-kill-headers))
(setq headers (cdr headers))))
(setq files nil))
- (setq files (cdr files)))))
+ (setq files (cdr files)))))
(if (not gnus-newsgroup-kill-headers)
()
(save-window-excursion
@@ -428,16 +428,6 @@ Returns the number of articles marked as read."
0))))
;; Parse a Gnus killfile.
-(defun gnus-score-insert-help (string alist idx)
- (save-excursion
- (pop-to-buffer "*Score Help*")
- (buffer-disable-undo)
- (erase-buffer)
- (insert string ":\n\n")
- (while alist
- (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
- (setq alist (cdr alist)))))
-
(defun gnus-kill-parse-gnus-kill-file ()
(goto-char (point-min))
(gnus-kill-file-mode)
@@ -588,7 +578,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
(insert "\n t"))
(insert ")")
(prog1
- (buffer-substring (point-min) (point-max))
+ (buffer-string)
(kill-buffer (current-buffer))))))
(defun gnus-execute-1 (function regexp form header)
@@ -608,7 +598,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
(setq did-kill (string-match regexp value)))
(cond ((stringp form) ;Keyboard macro.
(execute-kbd-macro form))
- ((gnus-functionp form)
+ ((functionp form)
(funcall form))
(t
(eval form)))))
@@ -627,7 +617,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
(setq did-kill (re-search-forward regexp nil t)))
(cond ((stringp form) ;Keyboard macro.
(execute-kbd-macro form))
- ((gnus-functionp form)
+ ((functionp form)
(funcall form))
(t
(eval form)))))))
@@ -641,18 +631,30 @@ If optional 2nd argument UNREAD is non-nil, articles which are
marked as read or ticked are ignored."
(save-excursion
(let ((killed-no 0)
- function article header)
+ function article header extras)
(cond
;; Search body.
((or (null field)
(string-equal field ""))
(setq function nil))
;; Get access function of header field.
- ((fboundp
- (setq function
- (intern-soft
- (concat "mail-header-" (downcase field)))))
- (setq function `(lambda (h) (,function h))))
+ ((cond ((fboundp
+ (setq function
+ (intern-soft
+ (concat "mail-header-" (downcase field)))))
+ (setq function `(lambda (h) (,function h))))
+ ((when (setq extras
+ (member (downcase field)
+ (mapcar (lambda (header)
+ (downcase (symbol-name header)))
+ gnus-extra-headers)))
+ (setq function
+ `(lambda (h)
+ (gnus-extra-header
+ (quote ,(nth (- (length gnus-extra-headers)
+ (length extras))
+ gnus-extra-headers))
+ h)))))))
;; Signal error.
(t
(error "Unknown header field: \"%s\"" field)))
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 28704b205e6..0baf7050598 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -1,5 +1,5 @@
;;; gnus-logic.el --- advanced scoring code for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -59,24 +59,25 @@
(defun gnus-score-advanced (rule &optional trace)
"Apply advanced scoring RULE to all the articles in the current group."
- (let ((headers gnus-newsgroup-headers)
- gnus-advanced-headers score)
- (while (setq gnus-advanced-headers (pop headers))
- (when (gnus-advanced-score-rule (car rule))
- ;; This rule was successful, so we add the score to
- ;; this article.
+ (let (new-score score multiple)
+ (dolist (gnus-advanced-headers gnus-newsgroup-headers)
+ (when (setq multiple (gnus-advanced-score-rule (car rule)))
+ (setq new-score (or (nth 1 rule)
+ gnus-score-interactive-default-score))
+ (when (numberp multiple)
+ (setq new-score (* multiple new-score)))
+ ;; This rule was successful, so we add the score to this
+ ;; article.
(if (setq score (assq (mail-header-number gnus-advanced-headers)
gnus-newsgroup-scored))
(setcdr score
- (+ (cdr score)
- (or (nth 1 rule)
- gnus-score-interactive-default-score)))
+ (+ (cdr score) new-score))
(push (cons (mail-header-number gnus-advanced-headers)
- (or (nth 1 rule)
- gnus-score-interactive-default-score))
+ new-score)
gnus-newsgroup-scored)
(when trace
(push (cons "A file" rule)
+ ;; Must be synced with `gnus-score-edit-file-at-point'.
gnus-score-trace)))))))
(defun gnus-advanced-score-rule (rule)
@@ -116,7 +117,7 @@
;; 1- type redirection.
(string-to-number
(substring (symbol-name type)
- (match-beginning 0) (match-end 0)))
+ (match-beginning 1) (match-end 1)))
;; ^^^ type redirection.
(length (symbol-name type))))))
(when gnus-advanced-headers
@@ -129,9 +130,8 @@
(error "Unknown advanced score type: %s" rule)))))
(defun gnus-advanced-score-article (rule)
- ;; `rule' is a semi-normal score rule, so we find out
- ;; what function that's supposed to do the actual
- ;; processing.
+ ;; `rule' is a semi-normal score rule, so we find out what function
+ ;; that's supposed to do the actual processing.
(let* ((header (car rule))
(func (assoc (downcase header) gnus-advanced-index)))
(if (not func)
@@ -162,7 +162,7 @@
(defun gnus-advanced-integer (index match type)
(if (not (memq type '(< > <= >= =)))
(error "No such integer score type: %s" type)
- (funcall type match (or (aref gnus-advanced-headers index) 0))))
+ (funcall type (or (aref gnus-advanced-headers index) 0) match)))
(defun gnus-advanced-date (index match type)
(let ((date (apply 'encode-time (parse-time-string
@@ -189,8 +189,8 @@
'gnus-request-body)
(t 'gnus-request-article)))
ofunc article)
- ;; Not all backends support partial fetching. In that case,
- ;; we just fetch the entire article.
+ ;; Not all backends support partial fetching. In that case, we
+ ;; just fetch the entire article.
(unless (gnus-check-backend-function
(intern (concat "request-" header))
gnus-newsgroup-name)
@@ -201,8 +201,8 @@
(when (funcall request-func article gnus-newsgroup-name)
(goto-char (point-min))
;; If just parts of the article is to be searched and the
- ;; backend didn't support partial fetching, we just narrow
- ;; to the relevant parts.
+ ;; backend didn't support partial fetching, we just narrow to
+ ;; the relevant parts.
(when ofunc
(if (eq ofunc 'gnus-request-head)
(narrow-to-region
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index 454feeb40c4..75ccab4e706 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -40,6 +40,9 @@
(require 'gnus-msg)
(require 'gnus-sum)
+(eval-when-compile
+ (defvar mh-lib-progs))
+
(defun gnus-summary-save-article-folder (&optional arg)
"Append the current article to an mh folder.
If N is a positive number, save the N next articles.
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index f99957971a8..de0923fcdf3 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -1,6 +1,6 @@
-;;; gnus-ml.el --- mailing list minor mode for Gnus
+;;; gnus-ml.el --- Mailing list minor mode for Gnus
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
;; Author: Julien Gilles <jgilles@free.fr>
;; Keywords: news
@@ -26,10 +26,6 @@
;; implement (small subset of) RFC 2369
-;;; Usage:
-
-;; (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode)
-
;;; Code:
(require 'gnus)
@@ -49,12 +45,12 @@
(setq gnus-mailing-list-mode-map (make-sparse-keymap))
(gnus-define-keys gnus-mailing-list-mode-map
- "\C-nh" gnus-mailing-list-help
- "\C-ns" gnus-mailing-list-subscribe
- "\C-nu" gnus-mailing-list-unsubscribe
- "\C-np" gnus-mailing-list-post
- "\C-no" gnus-mailing-list-owner
- "\C-na" gnus-mailing-list-archive
+ "\C-c\C-nh" gnus-mailing-list-help
+ "\C-c\C-ns" gnus-mailing-list-subscribe
+ "\C-c\C-nu" gnus-mailing-list-unsubscribe
+ "\C-c\C-np" gnus-mailing-list-post
+ "\C-c\C-no" gnus-mailing-list-owner
+ "\C-c\C-na" gnus-mailing-list-archive
))
(defun gnus-mailing-list-make-menu-bar ()
@@ -71,10 +67,29 @@
;;;###autoload
(defun turn-on-gnus-mailing-list-mode ()
- (when (gnus-group-get-parameter gnus-newsgroup-name 'to-list)
+ (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list)
(gnus-mailing-list-mode 1)))
;;;###autoload
+(defun gnus-mailing-list-insinuate (&optional force)
+ "Setup group parameters from List-Post header.
+If FORCE is non-nil, replace the old ones."
+ (interactive "P")
+ (let ((list-post
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "list-post"))))
+ (if list-post
+ (if (and (not force)
+ (gnus-group-get-parameter gnus-newsgroup-name 'to-list))
+ (gnus-message 1 "to-list is non-nil.")
+ (if (string-match "<mailto:\\([^>]*\\)>" list-post)
+ (setq list-post (match-string 1 list-post)))
+ (gnus-group-add-parameter gnus-newsgroup-name
+ (cons 'to-list list-post))
+ (gnus-mailing-list-mode 1))
+ (gnus-message 1 "no list-post in this message."))))
+
+;;;###autoload
(defun gnus-mailing-list-mode (&optional arg)
"Minor mode for providing mailing-list commands.
@@ -140,11 +155,15 @@
(defun gnus-mailing-list-archive ()
"Browse archive"
(interactive)
+ (require 'browse-url)
(let ((list-archive
(with-current-buffer gnus-original-article-buffer
(gnus-fetch-field "list-archive"))))
- (cond (list-archive (gnus-mailing-list-message list-archive))
- (t (gnus-message 1 "no list-owner in this group")))))
+ (cond (list-archive
+ (if (string-match "<\\(http:[^>]*\\)>" list-archive)
+ (browse-url (match-string 1 list-archive))
+ (browse-url list-archive)))
+ (t (gnus-message 1 "no list-archive in this group")))))
;;; Utility functions
@@ -158,7 +177,7 @@
(cond
((string-match "<mailto:\\([^>]*\\)>" address)
(let ((args (match-string 1 address)))
- (cond ; with param
+ (cond ; with param
((string-match "\\(.*\\)\\?\\(.*\\)" args)
(setq mailto (match-string 1 args))
(let ((param (match-string 2 args)))
@@ -169,7 +188,7 @@
(if (string-match "to=\\([^&]*\\)" param)
(push (match-string 1 param) to))
))
- (t (setq mailto args))))) ; without param
+ (t (setq mailto args))))) ; without param
; other case <http://... to be done.
(t nil))
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index 6b63a19707d..8ef56bbd960 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -1,5 +1,6 @@
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998, 1999, 2000
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2004
;; Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
@@ -8,18 +9,18 @@
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
@@ -62,7 +63,7 @@ unless overridden by any group marked as a catch-all group. Typical
uses are as simple as the name of a default mail group, but more
elaborate fancy splits may also be useful to split mail that doesn't
match any of the group-specified splitting rules. See
-gnus-group-split-fancy for details."
+`gnus-group-split-fancy' for details."
(interactive "P")
(setq nnmail-split-methods 'nnmail-split-fancy)
(when catch-all
@@ -73,8 +74,9 @@ gnus-group-split-fancy for details."
;;;###autoload
(defun gnus-group-split-update (&optional catch-all)
- "Computes nnmail-split-fancy from group params and CATCH-ALL, by
-calling (gnus-group-split-fancy nil nil CATCH-ALL).
+ "Computes nnmail-split-fancy from group params and CATCH-ALL.
+It does this by calling by calling (gnus-group-split-fancy nil
+nil CATCH-ALL).
If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used
instead. This variable is set by gnus-group-split-setup."
@@ -88,7 +90,7 @@ instead. This variable is set by gnus-group-split-setup."
;;;###autoload
(defun gnus-group-split ()
"Uses information from group parameters in order to split mail.
-See gnus-group-split-fancy for more information.
+See `gnus-group-split-fancy' for more information.
gnus-group-split is a valid value for nnmail-split-methods."
(let (nnmail-split-fancy)
@@ -140,12 +142,12 @@ nnml:mail.foo:
nnml:mail.others:
\((split-spec . catch-all))
-Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns:
+Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
\"mail.bar\")
(any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
- - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
+ - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
\"mail.others\")"
(let* ((newsrc (cdr gnus-newsrc-alist))
split)
@@ -202,12 +204,9 @@ Calling (gnus-group-split-fancy nil nil \"mail.misc\") returns:
(list 'any split-regexp)
;; Generate RESTRICTs for SPLIT-EXCLUDEs.
(if (listp split-exclude)
- (let ((seq split-exclude)
- res)
- (while seq
- (push (cons '- (pop seq))
- res))
- (apply #'nconc (nreverse res)))
+ (apply #'append
+ (mapcar (lambda (arg) (list '- arg))
+ split-exclude))
(list '- split-exclude))
(list group-clean))
split)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 6a77c283661..0b66c508767 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1,5 +1,5 @@
;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -33,6 +33,7 @@
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
+(require 'gnus-util)
(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
@@ -54,7 +55,7 @@ method to use when posting."
(const current)
(sexp :tag "Methods" ,gnus-select-method)))
-(defvar gnus-outgoing-message-group nil
+(defcustom gnus-outgoing-message-group nil
"*All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value. This variable
@@ -63,18 +64,26 @@ can also be a list of group names.
If you want to have greater control over what group to put each
message in, you can set this variable to a function that checks the
current newsgroup name and then returns a suitable group name (or list
-of names).")
+of names)."
+ :group 'gnus-message
+ :type '(choice (string :tag "Group")
+ (function)))
-(defvar gnus-mailing-list-groups nil
- "*Regexp matching groups that are really mailing lists.
+(defcustom gnus-mailing-list-groups nil
+ "*If non-nil a regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
gatewayed to a newsgroup, and you want to followup to an article in
-the group.")
+the group."
+ :group 'gnus-message
+ :type '(choice (regexp)
+ (const nil)))
-(defvar gnus-add-to-list nil
- "*If non-nil, add a `to-list' parameter automatically.")
+(defcustom gnus-add-to-list nil
+ "*If non-nil, add a `to-list' parameter automatically."
+ :group 'gnus-message
+ :type 'boolean)
-(defvar gnus-crosspost-complaint
+(defcustom gnus-crosspost-complaint
"Hi,
You posted the article below with the following Newsgroups header:
@@ -90,22 +99,79 @@ Thank you.
"
"Format string to be inserted when complaining about crossposts.
The first %s will be replaced by the Newsgroups header;
-the second with the current group name.")
-
-(defvar gnus-message-setup-hook nil
- "Hook run after setting up a message buffer.")
-
-(defvar gnus-bug-create-help-buffer t
- "*Should we create the *Gnus Help Bug* buffer?")
-
-(defvar gnus-posting-styles nil
- "*Alist of styles to use when posting.")
-
-(defcustom gnus-group-posting-charset-alist
+the second with the current group name."
+ :group 'gnus-message
+ :type 'string)
+
+(defcustom gnus-message-setup-hook nil
+ "Hook run after setting up a message buffer."
+ :group 'gnus-message
+ :type 'hook)
+
+(defcustom gnus-bug-create-help-buffer t
+ "*Should we create the *Gnus Help Bug* buffer?"
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-posting-styles nil
+ "*Alist of styles to use when posting.
+See Info node `(gnus)Posting Styles'."
+ :group 'gnus-message
+ :link '(custom-manual "(gnus)Posting Styles")
+ :type '(repeat (cons (choice (regexp)
+ (variable)
+ (list (const header)
+ (string :tag "Header")
+ (regexp :tag "Regexp"))
+ (function)
+ (sexp))
+ (repeat (list
+ (choice (const signature)
+ (const signature-file)
+ (const organization)
+ (const address)
+ (const x-face-file)
+ (const name)
+ (const body)
+ (symbol)
+ (string :tag "Header"))
+ (choice (string)
+ (function)
+ (variable)
+ (sexp)))))))
+
+(defcustom gnus-gcc-mark-as-read nil
+ "If non-nil, automatically mark Gcc articles as read."
+ :version "21.1"
+ :group 'gnus-message
+ :type 'boolean)
+
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
+ 'gnus-gcc-mark-as-read)
+
+(defcustom gnus-gcc-externalize-attachments nil
+ "Should local-file attachments be included as external parts in Gcc copies?
+If it is `all', attach files as external parts;
+if a regexp and matches the Gcc group name, attach files as external parts;
+if nil, attach files as normal parts."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(choice (const nil :tag "None")
+ (const all :tag "Any")
+ (string :tag "Regexp")))
+
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
(message-this-is-mail nil nil)
(message-this-is-news nil t))
+ :variable-document
"Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
@@ -118,31 +184,118 @@ nil (always encode using quoted-printable) or t (always use 8bit).
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
- :type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
- :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+ :value nil
+ (repeat (symbol)))
+ :parameter-document "\
+List of charsets that are permitted to be unencoded.")
+
+(defcustom gnus-debug-files
+ '("gnus.el" "gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el" "gnus-async.el"
+ "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
+ "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
+ "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
+ "Files whose variables will be reported in `gnus-bug'."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(repeat (string :tag "File")))
+
+(defcustom gnus-debug-exclude-variables
+ '(mm-mime-mule-charset-alist
+ nnmail-split-fancy message-minibuffer-local-map)
+ "Variables that should not be reported in `gnus-bug'."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(repeat (symbol :tag "Variable")))
+
+(defcustom gnus-discouraged-post-methods
+ '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
+ "A list of back ends that are not used in \"real\" newsgroups.
+This variable is used only when `gnus-post-method' is `current'."
+ :version "21.3"
+ :group 'gnus-group-foreign
+ :type '(repeat (symbol :tag "Back end")))
+
+(defcustom gnus-message-replysign
+ nil
+ "Automatically sign replies to signed messages.
+See also the `mml-default-sign-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+ nil
+ "Automatically encrypt replies to encrypted messages.
+See also the `mml-default-encrypt-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replysignencrypted
+ t
+ "Setting this causes automatically encrypted messages to also be signed."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-confirm-mail-reply-to-news nil
+ "If non-nil, Gnus requests confirmation when replying to news.
+This is done because new users often reply by mistake when reading
+news.
+This can also be a function receiving the group name as the only
+parameter which should return non-nil iff a confirmation is needed, or
+a regexp, in which case a confirmation is asked for iff the group name
+matches the regexp."
+ :group 'gnus-message
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (regexp :tag "Iff group matches regexp")
+ (function :tag "Iff function evaluates to non-nil")))
+
+(defcustom gnus-confirm-treat-mail-like-news
+ nil
+ "If non-nil, Gnus will treat mail like news with regard to confirmation
+when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
+for fine-tuning this.
+If nil, Gnus will never ask for confirmation if replying to mail."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-summary-resend-default-address t
+ "If non-nil, Gnus tries to suggest a default address to resend to.
+If nil, the address field will always be empty after invoking
+`gnus-summary-resend-message'."
+ :group 'gnus-message
+ :type 'boolean)
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
"Inhibit the use of posting styles.")
+(defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
+(defvar gnus-check-before-posting nil)
(defvar gnus-last-posting-server nil)
(defvar gnus-message-group-art nil)
+(defvar gnus-msg-force-broken-reply-to nil)
+
(defconst gnus-bug-message
"Sending a bug report to the Gnus Towers.
========================================
@@ -166,6 +319,8 @@ Thank you for your help in stamping out bugs.
(eval-and-compile
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
(autoload 'rmail-dont-reply-to "mail-utils")
(autoload 'rmail-output "rmailout"))
@@ -176,6 +331,7 @@ Thank you for your help in stamping out bugs.
(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
"p" gnus-summary-post-news
+ "i" gnus-summary-news-other-window
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
"c" gnus-summary-cancel-article
@@ -185,11 +341,15 @@ Thank you for your help in stamping out bugs.
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
+ "v" gnus-summary-very-wide-reply
+ "V" gnus-summary-very-wide-reply-with-original
"n" gnus-summary-followup-to-mail
"N" gnus-summary-followup-to-mail-with-original
"m" gnus-summary-mail-other-window
"u" gnus-uu-post-news
"\M-c" gnus-summary-mail-crosspost-complaint
+ "Br" gnus-summary-reply-broken-reply-to
+ "BR" gnus-summary-reply-broken-reply-to-with-original
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
"Om" gnus-uu-digest-mail-forward
@@ -198,19 +358,27 @@ Thank you for your help in stamping out bugs.
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
+ "r" gnus-summary-resend-message
+ "e" gnus-summary-resend-message-edit)
;;; Internal functions.
+(defun gnus-inews-make-draft ()
+ `(lambda ()
+ (gnus-inews-make-draft-meta-information
+ ,gnus-newsgroup-name ',gnus-article-reply)))
+
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
- (,article (and gnus-article-reply (gnus-summary-article-number)))
+ (,article gnus-article-reply)
+ (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
@@ -219,11 +387,34 @@ Thank you for your help in stamping out bugs.
(setq mml-buffer-list nil)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
- (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
+ ;; #### FIXME: for a reason that I did not manage to identify yet,
+ ;; the variable `gnus-newsgroup-name' does not honor a dynamically
+ ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
+ ;; After evaluation of @forms below, it gets the value we actually want
+ ;; to override, and the posting styles are used. For that reason, I've
+ ;; added an optional argument to `gnus-configure-posting-styles' to
+ ;; make sure that the correct value for the group name is used. -- drv
+ (add-hook 'message-mode-hook
+ (if (memq ,config '(reply-yank reply))
+ (lambda ()
+ (gnus-configure-posting-styles ,group))
+ (lambda ()
+ ;; There may be an old " *gnus article copy*" buffer.
+ (let (gnus-article-copy)
+ (gnus-configure-posting-styles ,group)))))
+ (gnus-pull ',(intern gnus-draft-meta-information-header)
+ message-required-headers)
+ (when (and ,group
+ (not (string= ,group "")))
+ (push (cons
+ (intern gnus-draft-meta-information-header)
+ (gnus-inews-make-draft))
+ message-required-headers))
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ ,yanked)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
@@ -233,29 +424,71 @@ Thank you for your help in stamping out bugs.
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (gnus-make-local-hook 'change-major-mode-hook)
(add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
(mml-destroy-buffers)
(setq mml-buffer-list mbl)))
+ (message-hide-headers)
(gnus-add-buffer)
(gnus-configure-windows ,config t)
+ (run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
+(defun gnus-inews-make-draft-meta-information (group article)
+ (concat "(\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")"))
+
;;;###autoload
-(defun gnus-msg-mail (&rest args)
+(defun gnus-msg-mail (&optional to subject other-headers continue
+ switch-action yank-action send-actions)
"Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes."
(interactive)
- (gnus-setup-message 'message
- (apply 'message-mail args))
+ (let ((buf (current-buffer))
+ mail-buf)
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions))
+ (when switch-action
+ (setq mail-buf (current-buffer))
+ (switch-to-buffer buf)
+ (apply switch-action mail-buf nil)))
;; COMPOSEFUNC should return t if succeed. Undocumented ???
t)
+(defvar save-selected-window-window)
+
+;;;###autoload
+(defun gnus-button-mailto (address)
+ "Mail to ADDRESS."
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-setup-message 'message
+ (message-reply address))
+ (and (boundp 'save-selected-window-window)
+ (not (window-live-p save-selected-window-window))
+ (setq save-selected-window-window (selected-window))))
+
+;;;###autoload
+(defun gnus-button-reply (&optional to-address wide)
+ "Like `message-reply'."
+ (interactive)
+ (gnus-setup-message 'message
+ (message-reply to-address wide))
+ (and (boundp 'save-selected-window-window)
+ (not (window-live-p save-selected-window-window))
+ (setq save-selected-window-window (selected-window))))
+
;;;###autoload
(define-mail-user-agent 'gnus-user-agent
- 'gnus-msg-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook)
+ 'gnus-msg-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
@@ -266,32 +499,43 @@ Gcc: header for archiving purposes."
(while (setq elem (pop alist))
(when (or (and (stringp (car elem))
(string-match (car elem) group))
- (and (gnus-functionp (car elem))
+ (and (functionp (car elem))
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article)
- (make-local-hook 'message-sent-hook)
+(defun gnus-inews-add-send-actions (winconf buffer article
+ &optional config yanked)
+ (gnus-make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(when gnus-agent
- (make-local-hook 'message-header-hook)
+ (gnus-make-local-hook 'message-header-hook)
(add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(setq message-newsreader (setq message-mailer (gnus-extended-version)))
(message-add-action
- `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
- (message-add-action
`(when (gnus-buffer-exists-p ,buffer)
- (save-excursion
- (set-buffer ,buffer)
- ,(when article
- `(gnus-summary-mark-article-as-replied ,article))))
- 'send))
+ (set-window-configuration ,winconf))
+ 'exit 'postpone 'kill)
+ (let ((to-be-marked (cond
+ (yanked
+ (mapcar
+ (lambda (x) (if (listp x) (car x) x)) yanked))
+ (article (if (listp article) article (list article)))
+ (t nil))))
+ (message-add-action
+ `(when (gnus-buffer-exists-p ,buffer)
+ (save-excursion
+ (set-buffer ,buffer)
+ ,(when to-be-marked
+ (if (eq config 'forward)
+ `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
+ `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
+ 'send)))
(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))
@@ -306,6 +550,8 @@ If ARG is 1, prompt for a group name to find the posting style."
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
@@ -317,15 +563,49 @@ If ARG is 1, prompt for a group name to find the posting style."
(gnus-read-active-file-p))
(gnus-group-group-name))
""))
+ ;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message (message-mail)))
(save-excursion
(set-buffer buffer)
(setq gnus-newsgroup-name group)))))
+(defun gnus-group-news (&optional arg)
+ "Start composing a news.
+If ARG, post to group under point.
+If ARG is 1, prompt for group name to post to.
+
+This function prepares a news even when using mail groups. This is useful
+for posting messages to mail groups without actually sending them over the
+network. The corresponding back end must have a 'request-post method."
+ (interactive "P")
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ ""))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message
+ (message-news (gnus-group-real-name gnus-newsgroup-name))))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
(defun gnus-group-post-news (&optional arg)
- "Start composing a news message.
-If ARG, post to the group under point.
-If ARG is 1, prompt for a group name."
+ "Start composing a message (a news by default).
+If ARG, post to group under point. If ARG is 1, prompt for group name.
+Depending on the selected group, the message might be either a mail or
+a news."
(interactive "P")
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
@@ -334,22 +614,110 @@ If ARG is 1, prompt for a group name."
(completing-read "Newsgroup: " gnus-active-hashtb nil
(gnus-read-active-file-p))
(gnus-group-group-name))
- "")))
+ ""))
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy))
+ (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
+ (string= gnus-newsgroup-name ""))))
+
+(defun gnus-summary-mail-other-window (&optional arg)
+ "Start composing a mail in another window.
+Use the posting of the current group by default.
+If ARG, don't do that. If ARG is 1, prompt for group name to find the
+posting style."
+ (interactive "P")
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message (message-mail)))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-news-other-window (&optional arg)
+ "Start composing a news in another window.
+Post to the current group by default.
+If ARG, don't do that. If ARG is 1, prompt for group name to post to.
+
+This function prepares a news even when using mail groups. This is useful
+for posting messages to mail groups without actually sending them over the
+network. The corresponding back end must have a 'request-post method."
+ (interactive "P")
+ ;; We can't `let' gnus-newsgroup-name here, since that leads
+ ;; to local variables leaking.
+ (let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Use group: "
+ gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name))
+ ;; #### see comment in gnus-setup-message -- drv
+ (gnus-setup-message 'message
+ (progn
+ (message-news (gnus-group-real-name gnus-newsgroup-name))
+ (set (make-local-variable 'gnus-discouraged-post-methods)
+ (delq
+ (car (gnus-find-method-for-group gnus-newsgroup-name))
+ (copy-sequence gnus-discouraged-post-methods))))))
+ (save-excursion
+ (set-buffer buffer)
+ (setq gnus-newsgroup-name group)))))
+
+(defun gnus-summary-post-news (&optional arg)
+ "Start composing a message. Post to the current group by default.
+If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
+Depending on the selected group, the message might be either a mail or
+a news."
+ (interactive "P")
+ ;; Bind this variable here to make message mode hooks work ok.
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Newsgroup: " gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name))
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy))
(gnus-post-news 'post gnus-newsgroup-name)))
-(defun gnus-summary-post-news ()
- "Start composing a news message."
- (interactive)
- (gnus-post-news 'post gnus-newsgroup-name))
(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
-If prefix argument YANK is non-nil, original article is yanked automatically."
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+YANK is a list of elements, where the car of each element is the
+article number, and the cdr is the string to be yanked."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(when yank
- (gnus-summary-goto-subject (car yank)))
+ (gnus-summary-goto-subject
+ (if (listp (car yank))
+ (caar yank)
+ (car yank))))
(save-window-excursion
(gnus-summary-select-article))
(let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
@@ -357,10 +725,13 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- yank nil force-news)))
+ yank nil force-news)
+ (gnus-summary-handle-replysign)))
(defun gnus-summary-followup-with-original (n &optional force-news)
- "Compose a followup to an article and include the original article."
+ "Compose a followup to an article and include the original article.
+The text in the region will be yanked. If the region isn't
+active, the entire article will be yanked."
(interactive "P")
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
@@ -377,16 +748,24 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
- (let (beg article)
+ (let (beg article yank-string)
(message-goto-body)
(while (setq article (pop articles))
+ (when (listp article)
+ (setq yank-string (nth 1 article)
+ article (nth 0 article)))
(save-window-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-select-article nil nil nil article)
(gnus-summary-remove-process-mark article))
- (gnus-copy-article-buffer)
+ (gnus-copy-article-buffer nil yank-string)
(let ((message-reply-buffer gnus-article-copy)
- (message-reply-headers gnus-current-headers))
+ (message-reply-headers
+ ;; The headers are decoded.
+ (with-current-buffer gnus-article-copy
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (nnheader-parse-naked-head)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
@@ -403,7 +782,7 @@ post using the current select method."
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
- (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
@@ -435,7 +814,7 @@ header line with the old Message-ID."
-(defun gnus-copy-article-buffer (&optional article-buffer)
+(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
;; make a copy of the article buffer with all text properties removed
;; this copy is in the buffer gnus-article-copy.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
@@ -451,40 +830,59 @@ header line with the old Message-ID."
(error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
- (save-restriction
- ;; Copy over the (displayed) article buffer, delete
- ;; hidden text and remove text properties.
- (widen)
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (insert
- (prog1
- (buffer-substring-no-properties (point-min) (point-max))
- (erase-buffer)))
- ;; Find the original headers.
- (set-buffer gnus-original-article-buffer)
- (goto-char (point-min))
- (while (looking-at message-unix-mail-delimiter)
- (forward-line 1))
- (setq beg (point))
- (setq end (or (search-forward "\n\n" nil t) (point)))
- ;; Delete the headers from the displayed articles.
- (set-buffer gnus-article-copy)
- (delete-region (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
- ;; Insert the original article headers.
- (insert-buffer-substring gnus-original-article-buffer beg end)
- (article-decode-encoded-words)))
+ (let ((gnus-newsgroup-charset (or gnus-article-charset
+ gnus-newsgroup-charset))
+ (gnus-newsgroup-ignored-charsets
+ (or gnus-article-ignored-charsets
+ gnus-newsgroup-ignored-charsets)))
+ (save-restriction
+ ;; Copy over the (displayed) article buffer, delete
+ ;; hidden text and remove text properties.
+ (widen)
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ (when yank-string
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert yank-string))
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (gnus-remove-text-with-property 'gnus-decoration)
+ (insert
+ (prog1
+ (buffer-substring-no-properties (point-min) (point-max))
+ (erase-buffer)))
+ ;; Find the original headers.
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (let ((mail-header-separator ""))
+ (setq beg (point)
+ end (or (message-goto-body)
+ ;; There may be just a header.
+ (point-max))))
+ ;; Delete the headers from the displayed articles.
+ (set-buffer gnus-article-copy)
+ (let ((mail-header-separator ""))
+ (delete-region (goto-char (point-min))
+ (or (message-goto-body) (point-max))))
+ ;; Insert the original article headers.
+ (insert-buffer-substring gnus-original-article-buffer beg end)
+ ;; Decode charsets.
+ (let ((gnus-article-decode-hook
+ (delq 'article-decode-charset
+ (copy-sequence gnus-article-decode-hook))))
+ (run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
(when article-buffer
(gnus-copy-article-buffer))
- (let ((gnus-article-reply article-buffer)
+ (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
@@ -495,9 +893,9 @@ header line with the old Message-ID."
to-address to-group mailing-list to-list
newsgroup-p)
(when group
- (setq to-address (gnus-group-find-parameter group 'to-address)
+ (setq to-address (gnus-parameter-to-address group)
to-group (gnus-group-find-parameter group 'to-group)
- to-list (gnus-group-find-parameter group 'to-list)
+ to-list (gnus-parameter-to-list group)
newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
@@ -509,8 +907,7 @@ header line with the old Message-ID."
force-news
(and (gnus-news-group-p
(or pgroup gnus-newsgroup-name)
- (if header (mail-header-number header)
- gnus-current-article))
+ (or header gnus-current-article))
(not mailing-list)
(not to-list)
(not to-address)))
@@ -519,7 +916,13 @@ header line with the old Message-ID."
(message-news (or to-group group))
(set-buffer gnus-article-copy)
(gnus-msg-treat-broken-reply-to)
- (message-followup (if (or newsgroup-p force-news) nil to-group)))
+ (message-followup (if (or newsgroup-p force-news)
+ (if (save-restriction
+ (article-narrow-to-head)
+ (message-fetch-field "newsgroups"))
+ nil
+ "")
+ to-group)))
;; The is mail.
(if post
(progn
@@ -537,10 +940,11 @@ header line with the old Message-ID."
(when yank
(gnus-inews-yank-articles yank))))))
-(defun gnus-msg-treat-broken-reply-to ()
+(defun gnus-msg-treat-broken-reply-to (&optional force)
"Remove the Reply-to header if broken-reply-to."
- (when (gnus-group-find-parameter
- gnus-newsgroup-name 'broken-reply-to)
+ (when (or force
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))
(save-restriction
(message-narrow-to-head)
(message-remove-header "reply-to"))))
@@ -548,28 +952,31 @@ header line with the old Message-ID."
(defun gnus-post-method (arg group &optional silent)
"Return the posting method based on GROUP and ARG.
If SILENT, don't prompt the user."
- (let ((group-method (gnus-find-method-for-group group)))
+ (let ((gnus-post-method (or (gnus-parameter-post-method group)
+ gnus-post-method))
+ (group-method (gnus-find-method-for-group group)))
(cond
;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
((null group-method)
- (or (and (null (eq gnus-post-method 'active)) gnus-post-method)
- gnus-select-method message-post-method))
+ (or (and (listp gnus-post-method) ;If not current/native/nil
+ (not (listp (car gnus-post-method))) ; and not a list of methods
+ gnus-post-method) ;then use it.
+ gnus-select-method
+ message-post-method))
;; We want the inverse of the default
((and arg (not (eq arg 0)))
- (if (eq gnus-post-method 'active)
+ (if (eq gnus-post-method 'current)
gnus-select-method
group-method))
;; We query the user for a post method.
((or arg
- (and gnus-post-method
- (not (eq gnus-post-method 'current))
+ (and (listp gnus-post-method)
(listp (car gnus-post-method))))
(let* ((methods
;; Collect all methods we know about.
(append
- (when (and gnus-post-method
- (not (eq gnus-post-method 'current)))
+ (when (listp gnus-post-method)
(if (listp (car gnus-post-method))
gnus-post-method
(list gnus-post-method)))
@@ -590,7 +997,9 @@ If SILENT, don't prompt the user."
(setq method-alist
(mapcar
(lambda (m)
- (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+ (if (equal (cadr m) "")
+ (list (symbol-name (car m)) m)
+ (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
post-methods))
;; Query the user.
(cadr
@@ -606,44 +1015,34 @@ If SILENT, don't prompt the user."
method-alist))))
;; Override normal method.
((and (eq gnus-post-method 'current)
- (not (eq (car group-method) 'nndraft))
- (gnus-get-function group-method 'request-post t)
- (not arg))
+ (not (memq (car group-method) gnus-discouraged-post-methods))
+ (gnus-get-function group-method 'request-post t))
+ (assert (not arg))
group-method)
- ((and gnus-post-method
- (not (eq gnus-post-method 'current)))
+ ;; Use gnus-post-method.
+ ((listp gnus-post-method) ;A method...
+ (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
gnus-post-method)
- ;; Use the normal select method.
+ ;; Use the normal select method (nil or native).
(t gnus-select-method))))
-;; Dummies to avoid byte-compile warning.
-(eval-when-compile
- (defvar nnspool-rejected-article-hook)
- (defvar xemacs-codename))
-
(defun gnus-extended-version ()
- "Stringified Gnus version and Emacs version."
+ "Stringified Gnus version and Emacs version.
+See the variable `gnus-user-agent'."
(interactive)
- (concat
- "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
- " (" gnus-version ")"
- " "
- (cond
- ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- (concat "Emacs/" (match-string 1 emacs-version)))
- ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat (match-string 1 emacs-version)
- (format "/%d.%d" emacs-major-version emacs-minor-version)
- (if (match-beginning 3)
- (match-string 3 emacs-version)
- "")
- (if (boundp 'xemacs-codename)
- (concat " (" xemacs-codename ")")
- "")))
- (t emacs-version))))
+ (let* ((float-output-format nil)
+ (gnus-v
+ (concat "Gnus/"
+ (prin1-to-string (gnus-continuum-version gnus-version) t)
+ " (" gnus-version ")"))
+ (emacs-v (gnus-emacs-version)))
+ (if (stringp gnus-user-agent)
+ gnus-user-agent
+ (concat gnus-v
+ (when emacs-v
+ (concat " " emacs-v))))))
;;;
@@ -652,28 +1051,77 @@ If SILENT, don't prompt the user."
;;; Mail reply commands of Gnus summary mode
-(defun gnus-summary-reply (&optional yank wide)
- "Start composing a reply mail to the current message.
+(defun gnus-summary-reply (&optional yank wide very-wide)
+ "Start composing a mail reply to the current message.
If prefix argument YANK is non-nil, the original article is yanked
-automatically."
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
- ;; Stripping headers should be specified with mail-yank-ignored-headers.
- (when yank
- (gnus-summary-goto-subject (car yank)))
- (let ((gnus-article-reply t))
- (gnus-setup-message (if yank 'reply-yank 'reply)
- (gnus-summary-select-article)
- (set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to)
- (save-restriction
- (message-narrow-to-head)
- (goto-char (point-max)))
- (mml-quote-region (point) (point-max))
- (message-reply nil wide)
+ ;; Allow user to require confirmation before replying by mail to the
+ ;; author of a news article (or mail message).
+ (when (or
+ (not (or (gnus-news-group-p gnus-newsgroup-name)
+ gnus-confirm-treat-mail-like-news))
+ (not (cond ((stringp gnus-confirm-mail-reply-to-news)
+ (string-match gnus-confirm-mail-reply-to-news
+ gnus-newsgroup-name))
+ ((functionp gnus-confirm-mail-reply-to-news)
+ (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
+ (t gnus-confirm-mail-reply-to-news)))
+ (y-or-n-p "Really reply by mail to article author? "))
+ (let* ((article
+ (if (listp (car yank))
+ (caar yank)
+ (car yank)))
+ (gnus-article-reply (or article (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
+ (headers ""))
+ ;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
- (gnus-inews-yank-articles yank)))))
+ (gnus-summary-goto-subject article))
+ (gnus-setup-message (if yank 'reply-yank 'reply)
+ (if (not very-wide)
+ (gnus-summary-select-article)
+ (dolist (article very-wide)
+ (gnus-summary-select-article nil nil nil article)
+ (save-excursion
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq headers (concat headers (buffer-string)))))))
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (when very-wide
+ (erase-buffer)
+ (insert headers))
+ (goto-char (point-max)))
+ (mml-quote-region (point) (point-max))
+ (message-reply nil wide)
+ (when yank
+ (gnus-inews-yank-articles yank))
+ (gnus-summary-handle-replysign)))))
+
+(defun gnus-summary-handle-replysign ()
+ "Check the various replysign variables and take action accordingly."
+ (when (or gnus-message-replysign gnus-message-replyencrypt)
+ (let (signed encrypted)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (setq signed (memq 'signed gnus-article-wash-types))
+ (setq encrypted (memq 'encrypted gnus-article-wash-types)))
+ (cond ((and gnus-message-replyencrypt encrypted)
+ (mml-secure-message mml-default-encrypt-method
+ (if gnus-message-replysignencrypted
+ 'signencrypt
+ 'encrypt)))
+ ((and gnus-message-replysign signed)
+ (mml-secure-message mml-default-sign-method 'sign))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
@@ -681,6 +1129,24 @@ The original article will be yanked."
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n) wide))
+(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+ "Like `gnus-summary-reply' except removing reply-to field.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (let ((gnus-msg-force-broken-reply-to t))
+ (gnus-summary-reply yank wide very-wide)))
+
+(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+ "Like `gnus-summary-reply-with-original' except removing reply-to field.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
@@ -692,50 +1158,126 @@ automatically."
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
-The original article will be yanked."
+The original article will be yanked.
+Uses the process/prefix convention."
(interactive "P")
(gnus-summary-reply-with-original n t))
+(defun gnus-summary-very-wide-reply (&optional yank)
+ "Start composing a very wide reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
+
+(defun gnus-summary-very-wide-reply-with-original (n)
+ "Start composing a very wide reply mail to the current message.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply
+ (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
+
(defun gnus-summary-mail-forward (&optional arg post)
- "Forward the current message to another user.
-If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
+ "Forward the current message(s) to another user.
+If process marks exist, forward all marked messages;
+if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
if ARG is 1, decode the message and forward directly inline;
if ARG is 2, forward message as an rfc822 MIME section;
if ARG is 3, decode message and forward as an rfc822 MIME section;
if ARG is 4, forward message directly inline;
otherwise, use flipped `message-forward-as-mime'.
-If POST, post instead of mail."
+If POST, post instead of mail.
+For the `inline' alternatives, also see the variable
+`message-forward-ignored-headers'."
(interactive "P")
- (let ((message-forward-as-mime message-forward-as-mime)
- (message-forward-show-mml message-forward-show-mml))
- (cond
- ((null arg))
- ((eq arg 1) (setq message-forward-as-mime nil
- message-forward-show-mml t))
- ((eq arg 2) (setq message-forward-as-mime t
- message-forward-show-mml nil))
- ((eq arg 3) (setq message-forward-as-mime t
- message-forward-show-mml t))
- ((eq arg 4) (setq message-forward-as-mime nil
- message-forward-show-mml nil))
- (t (setq message-forward-as-mime (not message-forward-as-mime))))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
- (set-buffer gnus-original-article-buffer)
- (message-forward post)))))
+ (if (cdr (gnus-summary-work-articles nil))
+ ;; Process marks are given.
+ (gnus-uu-digest-mail-forward arg post)
+ ;; No process marks.
+ (let ((message-forward-as-mime message-forward-as-mime)
+ (message-forward-show-mml message-forward-show-mml))
+ (cond
+ ((null arg))
+ ((eq arg 1)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml t))
+ ((eq arg 2)
+ (setq message-forward-as-mime t
+ message-forward-show-mml nil))
+ ((eq arg 3)
+ (setq message-forward-as-mime t
+ message-forward-show-mml t))
+ ((eq arg 4)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml nil))
+ (t
+ (setq message-forward-as-mime (not message-forward-as-mime))))
+ (let* ((gnus-article-reply (gnus-summary-article-number))
+ (gnus-article-yanked-articles (list gnus-article-reply)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((mail-parse-charset
+ (or (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ gnus-article-charset))
+ gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ gnus-newsgroup-ignored-charsets))
+ (set-buffer gnus-original-article-buffer)
+ (message-forward post)))))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
- (interactive "sResend message(s) to: \nP")
+ (interactive
+ (list (message-read-from-minibuffer
+ "Resend message(s) to: "
+ (when (and gnus-summary-resend-default-address
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ ;; If some other article is currently selected, the
+ ;; initial-contents is wrong. Whatever, it is just the
+ ;; initial-contents.
+ (with-current-buffer gnus-original-article-buffer
+ (nnmail-fetch-field "to"))))
+ current-prefix-arg))
(let ((articles (gnus-summary-work-articles n))
article)
(while (setq article (pop articles))
(gnus-summary-select-article nil nil nil article)
(save-excursion
(set-buffer gnus-original-article-buffer)
- (message-resend address)))))
+ (message-resend address))
+ (gnus-summary-mark-article-as-forwarded article))))
+
+;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
+(defun gnus-summary-resend-message-edit ()
+ "Resend an article that has already been sent.
+A new buffer will be created to allow the user to modify body and
+contents of the message, and then, everything will happen as when
+composing a new message."
+ (interactive)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (let ((cur (current-buffer))
+ (to (message-fetch-field "to")))
+ ;; Get a normal message buffer.
+ (message-pop-to-buffer (message-buffer-name "Resend" to))
+ (insert-buffer-substring cur)
+ (mime-to-mml)
+ (message-narrow-to-head-1)
+ ;; Gnus will generate a new one when sending.
+ (message-remove-header "Message-ID")
+ (message-remove-header message-ignored-resent-headers t)
+ ;; Remove unwanted headers.
+ (goto-char (point-max))
+ (insert mail-header-separator)
+ (goto-char (point-min))
+ (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+ (forward-char 1))
+ (widen)))))
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
@@ -796,12 +1338,6 @@ The current group name will be inserted at \"%s\".")
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit)))))))
-(defun gnus-summary-mail-other-window ()
- "Compose mail in other window."
- (interactive)
- (gnus-setup-message 'message
- (message-mail)))
-
(defun gnus-mail-parse-comma-list ()
(let (accumulated
beg)
@@ -836,7 +1372,7 @@ The current group name will be inserted at \"%s\".")
;; This mail group doesn't have a `to-list', so we add one
;; here. Magic!
(when (gnus-y-or-n-p
- (format "Do you want to add this as `to-list': %s " to-address))
+ (format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
(defun gnus-put-message ()
@@ -845,35 +1381,34 @@ The current group name will be inserted at \"%s\".")
(let ((reply gnus-article-reply)
(winconf gnus-prev-winconf)
(group gnus-newsgroup-name))
+ (unless (and group
+ (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
- (or (and group (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil
- (gnus-writable-groups))))
(when (gnus-gethash group gnus-newsrc-hashtb)
(error "No such group: %s" group))
-
(save-excursion
(save-restriction
(widen)
(message-narrow-to-headers)
- (let (gnus-deletable-headers)
- (if (message-news-p)
- (message-generate-headers message-required-news-headers)
- (message-generate-headers message-required-mail-headers)))
+ (let ((gnus-deletable-headers nil))
+ (message-generate-headers
+ (if (message-news-p)
+ message-required-news-headers
+ message-required-mail-headers)))
(goto-char (point-max))
- (insert "Gcc: " group "\n")
+ (if (string-match " " group)
+ (insert "Gcc: \"" group "\"\n")
+ (insert "Gcc: " group "\n"))
(widen)))
-
(gnus-inews-do-gcc)
-
- (when (get-buffer gnus-group-buffer)
- (when (gnus-buffer-exists-p (car-safe reply))
- (set-buffer (car reply))
- (and (cdr reply)
- (gnus-summary-mark-article-as-replied
- (cdr reply))))
- (when winconf
- (set-window-configuration winconf)))))
+ (when (and (get-buffer gnus-group-buffer)
+ (gnus-buffer-exists-p (car-safe reply))
+ (cdr reply))
+ (set-buffer (car reply))
+ (gnus-summary-mark-article-as-replied (cdr reply)))
+ (when winconf
+ (set-window-configuration winconf))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
@@ -884,7 +1419,7 @@ If YANK is non-nil, include the original article."
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
- (message-reply address)
+ (gnus-msg-mail address)
(when yank
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
@@ -919,9 +1454,10 @@ If YANK is non-nil, include the original article."
(let (text)
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus environment info*"))
+ (erase-buffer)
(gnus-debug)
(setq text (buffer-string)))
- (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
+ (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
@@ -936,8 +1472,7 @@ If YANK is non-nil, include the original article."
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
current-prefix-arg))
(gnus-summary-iterate n
- (let ((gnus-display-mime-function nil)
- (gnus-inhibit-treatment t))
+ (let ((gnus-inhibit-treatment t))
(gnus-summary-select-article))
(save-excursion
(set-buffer buffer)
@@ -947,10 +1482,7 @@ If YANK is non-nil, include the original article."
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
- (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
- "gnus-art.el" "gnus-start.el" "gnus-async.el"
- "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
- "nnmail.el" "message.el"))
+ (let ((files gnus-debug-files)
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
@@ -973,6 +1505,7 @@ The source file has to be in the Emacs load path."
(and (or (eq (car expr) 'defvar)
(eq (car expr) 'defcustom))
(stringp (nth 3 expr))
+ (not (memq (nth 1 expr) gnus-debug-exclude-variables))
(or (not (boundp (nth 1 expr)))
(not (equal (eval (nth 2 expr))
(symbol-value (nth 1 expr)))))
@@ -982,17 +1515,15 @@ The source file has to be in the Emacs load path."
(insert "------------------ Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
- (condition-case ()
- (pp `(setq ,(car olist)
- ,(if (or (consp (setq sym (symbol-value (car olist))))
- (and (symbolp sym)
- (not (or (eq sym nil)
- (eq sym t)))))
- (list 'quote (symbol-value (car olist)))
- (symbol-value (car olist))))
- (current-buffer))
- (error
- (format "(setq %s 'whatever)\n" (car olist))))
+ (ignore-errors
+ (gnus-pp
+ `(setq ,(car olist)
+ ,(if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ (list 'quote (symbol-value (car olist)))
+ (symbol-value (car olist))))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
@@ -1008,7 +1539,7 @@ The source file has to be in the Emacs load path."
(defun gnus-summary-resend-bounced-mail (&optional fetch)
"Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
@@ -1028,62 +1559,98 @@ this is a reply."
;;; Gcc handling.
(defun gnus-inews-group-method (group)
- (cond ((and (null (gnus-get-info group))
- (eq (car gnus-message-archive-method)
- (car
- (gnus-server-to-method
- (gnus-group-method group)))))
- ;; If the group doesn't exist, we assume
- ;; it's an archive group...
- gnus-message-archive-method)
- ;; Use the method.
- ((gnus-info-method (gnus-get-info group))
- (gnus-info-method (gnus-get-info group)))
- ;; Find the method.
- (t (gnus-group-method group))))
+ (cond
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ ((and (null (gnus-get-info group))
+ (eq (car (gnus-server-to-method gnus-message-archive-method))
+ (car (gnus-server-to-method (gnus-group-method group)))))
+ gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
+ (t (gnus-server-to-method (gnus-group-method group)))))
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
(interactive)
- (when (gnus-alive-p)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
- groups group method)
- (when gcc
- (message-remove-header "gcc")
- (widen)
- (setq groups (message-unquote-tokens
- (message-tokenize-header gcc " ,")))
- ;; Copy the article over to some group(s).
- (while (setq group (pop groups))
- (gnus-check-server
- (setq method (gnus-inews-group-method group)))
- (unless (gnus-request-group group t method)
- (gnus-request-create-group group method))
- (save-excursion
- (nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (let ((mail-parse-charset message-default-charset)
- (rfc2047-header-encoding-alist
- (cons '("Newsgroups" . default)
- rfc2047-header-encoding-alist)))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (replace-match "" t t ))
- (unless (gnus-request-accept-article group method t t)
- (gnus-message 1 "Couldn't store article in group %s: %s"
- group (gnus-status-message method))
- (sit-for 2))
- (kill-buffer (current-buffer))))))))))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (cur (current-buffer))
+ groups group method group-art
+ mml-externalize-attachments)
+ (when gcc
+ (message-remove-header "gcc")
+ (widen)
+ (setq groups (message-unquote-tokens
+ (message-tokenize-header gcc " ,")))
+ ;; Copy the article over to some group(s).
+ (while (setq group (pop groups))
+ (unless (gnus-check-server
+ (setq method (gnus-inews-group-method group)))
+ (error "Can't open server %s" (if (stringp method) method
+ (car method))))
+ (unless (gnus-request-group group nil method)
+ (gnus-request-create-group group method))
+ (setq mml-externalize-attachments
+ (if (stringp gnus-gcc-externalize-attachments)
+ (string-match gnus-gcc-externalize-attachments group)
+ gnus-gcc-externalize-attachments))
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (let* ((mail-parse-charset message-default-charset)
+ (newsgroups-field (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Newsgroups")))
+ (followup-field (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Followup-To")))
+ ;; BUG: We really need to get the charset for
+ ;; each name in the Newsgroups and Followup-To
+ ;; lines to allow crossposting between group
+ ;; namess with incompatible character sets.
+ ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
+ (group-field-charset
+ (gnus-group-name-charset
+ method (or newsgroups-field "")))
+ (followup-field-charset
+ (gnus-group-name-charset
+ method (or followup-field "")))
+ (rfc2047-header-encoding-alist
+ (append
+ (when group-field-charset
+ (list (cons "Newsgroups" group-field-charset)))
+ (when followup-field-charset
+ (list (cons "Followup-To" followup-field-charset)))
+ rfc2047-header-encoding-alist)))
+ (mail-encode-encoded-word-buffer)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
+ (unless (setq group-art
+ (gnus-request-accept-article group method t t))
+ (gnus-message 1 "Couldn't store article in group %s: %s"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (when (and group-art
+ ;; FIXME: Should gcc-mark-as-read work when
+ ;; Gnus is not running?
+ (gnus-alive-p)
+ (or gnus-gcc-mark-as-read
+ (and
+ (boundp 'gnus-inews-mark-gcc-as-read)
+ (symbol-value 'gnus-inews-mark-gcc-as-read))))
+ (gnus-group-mark-article-read group (cdr group-art)))
+ (kill-buffer (current-buffer)))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
@@ -1092,14 +1659,21 @@ this is a reply."
(message-narrow-to-headers)
(let* ((group gnus-outgoing-message-group)
(gcc (cond
- ((gnus-functionp group)
+ ((functionp group)
(funcall group))
((or (stringp group) (list group))
group))))
(when gcc
(insert "Gcc: "
- (if (stringp gcc) gcc
- (mapconcat 'identity gcc " "))
+ (if (stringp gcc)
+ (if (string-match " " gcc)
+ (concat "\"" gcc "\"")
+ gcc)
+ (mapconcat (lambda (group)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))
+ gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
@@ -1126,7 +1700,7 @@ this is a reply."
((and (listp var) (stringp (car var)))
;; A list of groups.
var)
- ((gnus-functionp var)
+ ((functionp var)
;; A function.
(funcall var group))
(t
@@ -1139,7 +1713,7 @@ this is a reply."
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
- ((gnus-functionp (car var))
+ ((functionp (car var))
;; Function.
(funcall (car var) group))
(t
@@ -1160,31 +1734,51 @@ this is a reply."
(progn
(insert
(if (stringp gcc-self-val)
- gcc-self-val
- group))
+ (if (string-match " " gcc-self-val)
+ (concat "\"" gcc-self-val "\"")
+ gcc-self-val)
+ ;; In nndoc groups, we use the parent group name
+ ;; instead of the current group.
+ (let ((group (or (gnus-group-find-parameter
+ gnus-newsgroup-name 'parent-group)
+ group)))
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))))
(if (not (eq gcc-self-val 'none))
(insert "\n")
- (progn
- (beginning-of-line)
- (kill-line))))
+ (gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
+ (let ((str (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method))))
+ (insert (if (string-match " " str)
+ (concat "\"" str "\"")
+ str)))
(when groups
(insert " ")))
(insert "\n")))))))
+(defun gnus-mailing-list-followup-to ()
+ "Look at the headers in the current buffer and return a Mail-Followup-To address."
+ (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
+ (list-post (gnus-fetch-original-field "list-post")))
+ (when (and list-post
+ (string-match "mailto:\\([^>]+\\)" list-post))
+ (setq list-post (match-string 1 list-post)))
+ (or list-post
+ x-been-there)))
+
;;; Posting styles.
-(defun gnus-configure-posting-styles ()
+(defun gnus-configure-posting-styles (&optional group-name)
"Configure posting styles according to `gnus-posting-styles'."
(unless gnus-inhibit-posting-styles
- (let ((group (or gnus-newsgroup-name ""))
+ (let ((group (or group-name gnus-newsgroup-name ""))
(styles gnus-posting-styles)
- style match variable attribute value v results
+ style match attribute value v results
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all
@@ -1202,25 +1796,36 @@ this is a reply."
;; Regexp string match on the group name.
(string-match match group))
((eq match 'header)
- (let ((header (message-fetch-field (pop style))))
- (and header
- (string-match (pop style) header))))
+ ;; Obsolete format of header match.
+ (and (gnus-buffer-live-p gnus-article-copy)
+ (with-current-buffer gnus-article-copy
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header))))))
((or (symbolp match)
- (gnus-functionp match))
+ (functionp match))
(cond
- ((gnus-functionp match)
+ ((functionp match)
;; Function to be called.
(funcall match))
((boundp match)
;; Variable to be checked.
(symbol-value match))))
((listp match)
- ;; This is a form to be evaled.
- (eval match)))
+ (cond
+ ((eq (car match) 'header)
+ ;; New format of header match.
+ (and (gnus-buffer-live-p gnus-article-copy)
+ (with-current-buffer gnus-article-copy
+ (let ((header (message-fetch-field (nth 1 match))))
+ (and header
+ (string-match (nth 2 match) header))))))
+ (t
+ ;; This is a form to be evaled.
+ (eval match)))))
;; We have a match, so we set the variables.
(dolist (attribute style)
(setq element (pop attribute)
- variable nil
filep nil)
(setq value
(cond
@@ -1237,21 +1842,28 @@ this is a reply."
((stringp value)
value)
((or (symbolp value)
- (gnus-functionp value))
- (cond ((gnus-functionp value)
+ (functionp value))
+ (cond ((functionp value)
(funcall value))
((boundp value)
(symbol-value value))))
((listp value)
(eval value))))
;; Translate obsolescent value.
- (when (eq element 'signature-file)
+ (cond
+ ((eq element 'signature-file)
(setq element 'signature
filep t))
+ ((eq element 'x-face-file)
+ (setq element 'x-face
+ filep t)))
;; Get the contents of file elems.
(when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
+ (goto-char (point-max))
+ (while (bolp)
+ (delete-char -1))
(buffer-string))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))
@@ -1259,7 +1871,9 @@ this is a reply."
(setq name (assq 'name results)
address (assq 'address results))
(setq results (delq name (delq address results)))
- (make-local-variable 'message-setup-hook)
+ (gnus-make-local-hook 'message-setup-hook)
+ (setq results (sort results (lambda (x y)
+ (string-lessp (car x) (car y)))))
(dolist (result results)
(add-hook 'message-setup-hook
(cond
@@ -1291,19 +1905,23 @@ this is a reply."
(let ((value ,(cdr result)))
(when value
(message-goto-eoh)
- (insert ,header ": " value "\n"))))))))))
+ (insert ,header ": " value)
+ (unless (bolp)
+ (insert "\n")))))))))
+ nil 'local))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
+ (set (make-local-variable 'user-mail-address)
+ ,(or (cdr address) user-mail-address))
(let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
(save-excursion
(message-remove-header "From")
(message-goto-eoh)
- (insert "From: " (message-make-from) "\n")))))))))
+ (insert "From: " (message-make-from) "\n"))))
+ nil 'local)))))
;;; Allow redefinition of functions.
diff --git a/lisp/gnus/gnus-mule.el b/lisp/gnus/gnus-mule.el
deleted file mode 100644
index 835311d0ea2..00000000000
--- a/lisp/gnus/gnus-mule.el
+++ /dev/null
@@ -1,75 +0,0 @@
-;;; gnus-mule.el --- provide backward compatibility function to GNUS
-
-;; Copyright (C) 1995, 1997, 2002 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 2000 Electrotechnical Laboratory, JAPAN.
-
-;; Maintainer: FSF
-;; Keywords: news, i18n
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file provides the function `gnus-mule-add-group' for backward
-;; compatibility with old version of Gnus included in Emacs 20.
-
-;;; Code:
-
-(require 'gnus-sum)
-
-;;;###autoload
-(defun gnus-mule-add-group (name coding-system)
- "Specify that articles of news group NAME are encoded in CODING-SYSTEM.
-All news groups deeper than NAME are also the target.
-If CODING-SYSTEM is a cons, the car part is used and the cdr
-part is ignored.
-
-This function exists for backward compatibility with Emacs 20. It is
-recommended to customize the variable `gnus-group-charset-alist'
-rather than using this function."
- (if (consp coding-system)
- ;; Ignore the cdr part because now Gnus can't use different
- ;; coding systems for encoding and decoding.
- (setq coding-system (car coding-system)))
- (let ((tail gnus-group-charset-alist)
- (prev nil)
- (pattern (concat "^" (regexp-quote name))))
- ;; Check entries of `gnus-group-charset-alist' if they match NAME.
- (while (not (string-match (car (car tail)) name))
- (setq prev tail tail (cdr tail)))
- (if tail
- ;; A matching entry was found.
- (if (string= pattern (car (car tail)))
- ;; We can modify this entry.
- (setcar (cdr (car tail)) coding-system)
- ;; We must add a new entry before this.
- (if prev
- (setcdr prev (cons (list pattern coding-system)
- (cdr prev)))
- (setq gnus-group-charset-alist
- (cons (list pattern coding-system)
- gnus-group-charset-alist))))
- ;; We must prepend a new entry.
- (setq gnus-group-charset-alist
- (cons (list pattern coding-system)
- gnus-group-charset-alist)))))
-
-(provide 'gnus-mule)
-
-;;; arch-tag: 525e6b69-85de-4dfc-9dbb-764c795d63af
-;;; gnus-mule.el ends here
diff --git a/lisp/gnus/gnus-nocem.el b/lisp/gnus/gnus-nocem.el
index 5ccb92b70e7..5a5f779b732 100644
--- a/lisp/gnus/gnus-nocem.el
+++ b/lisp/gnus/gnus-nocem.el
@@ -1,6 +1,8 @@
;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2004
+;; Free Software Foundation, Inc.
+
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -58,6 +60,7 @@ This can also be a list of `(ISSUER CONDITION ...)' elements.
See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an
issuer registry."
:group 'gnus-nocem
+ :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html")
:type '(repeat (choice string sexp)))
(defcustom gnus-nocem-directory
@@ -294,7 +297,8 @@ valid issuer, which is much faster if you are selective about the issuers."
(while (search-forward "\t" nil t)
(cond
((not (ignore-errors
- (setq group (let ((obarray gnus-active-hashtb)) (read buf)))))
+ (setq group (let ((obarray gnus-nocem-real-group-hashtb))
+ (read buf)))))
;; An error.
)
((not (symbolp group))
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
new file mode 100644
index 00000000000..dbb96333d75
--- /dev/null
+++ b/lisp/gnus/gnus-picon.el
@@ -0,0 +1,283 @@
+;;; gnus-picon.el --- displaying pretty icons in Gnus
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news xpm annotation glyph faces
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; There are three picon types relevant to Gnus:
+;;
+;; Persons: person@subdomain.dom
+;; users/dom/subdomain/person/face.gif
+;; usenix/dom/subdomain/person/face.gif
+;; misc/MISC/person/face.gif
+;; Domains: subdomain.dom
+;; domain/dom/subdomain/unknown/face.gif
+;; Groups: comp.lang.lisp
+;; news/comp/lang/lisp/unknown/face.gif
+;;
+;; Original implementation by Wes Hardaker <hardaker@ece.ucdavis.edu>.
+;;
+;;; Code:
+
+(require 'gnus)
+(require 'custom)
+(require 'gnus-art)
+
+;;; User variables:
+
+(defcustom gnus-picon-news-directories '("news")
+ "*List of directories to search for newsgroups faces."
+ :type '(repeat string)
+ :group 'gnus-picon)
+
+(defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc")
+ "*List of directories to search for user faces."
+ :type '(repeat string)
+ :group 'gnus-picon)
+
+(defcustom gnus-picon-domain-directories '("domains")
+ "*List of directories to search for domain faces.
+Some people may want to add \"unknown\" to this list."
+ :type '(repeat string)
+ :group 'gnus-picon)
+
+(defcustom gnus-picon-file-types
+ (let ((types (list "xbm")))
+ (when (gnus-image-type-available-p 'gif)
+ (push "gif" types))
+ (when (gnus-image-type-available-p 'xpm)
+ (push "xpm" types))
+ types)
+ "*List of suffixes on picon file names to try."
+ :type '(repeat string)
+ :group 'gnus-picon)
+
+(defface gnus-picon-xbm-face '((t (:foreground "black" :background "white")))
+ "Face to show xbm picon in."
+ :group 'gnus-picon)
+
+(defface gnus-picon-face '((t (:foreground "black" :background "white")))
+ "Face to show picon in."
+ :group 'gnus-picon)
+
+;;; Internal variables:
+
+(defvar gnus-picon-setup-p nil)
+(defvar gnus-picon-glyph-alist nil
+ "Picon glyphs cache.
+List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
+(defvar gnus-picon-cache nil)
+
+;;; Functions:
+
+(defsubst gnus-picon-split-address (address)
+ (setq address (split-string address "@"))
+ (if (stringp (cadr address))
+ (cons (car address) (split-string (cadr address) "\\."))
+ (if (stringp (car address))
+ (split-string (car address) "\\."))))
+
+(defun gnus-picon-find-face (address directories &optional exact)
+ (let* ((address (gnus-picon-split-address address))
+ (user (pop address))
+ (faddress address)
+ database directory result instance base)
+ (catch 'found
+ (dolist (database gnus-picon-databases)
+ (dolist (directory directories)
+ (setq address faddress
+ base (expand-file-name directory database))
+ (while address
+ (when (setq result (gnus-picon-find-image
+ (concat base "/" (mapconcat 'downcase
+ (reverse address)
+ "/")
+ "/" (downcase user) "/")))
+ (throw 'found result))
+ (if exact
+ (setq address nil)
+ (pop address)))
+ ;; Kludge to search MISC as well. But not in "news".
+ (unless (string= directory "news")
+ (when (setq result (gnus-picon-find-image
+ (concat base "/MISC/" user "/")))
+ (throw 'found result))))))))
+
+(defun gnus-picon-find-image (directory)
+ (let ((types gnus-picon-file-types)
+ found type file)
+ (while (and (not found)
+ (setq type (pop types)))
+ (setq found (file-exists-p (setq file (concat directory "face." type)))))
+ (if found
+ file
+ nil)))
+
+(defun gnus-picon-insert-glyph (glyph category)
+ "Insert GLYPH into the buffer.
+GLYPH can be either a glyph or a string."
+ (if (stringp glyph)
+ (insert glyph)
+ (gnus-add-wash-type category)
+ (gnus-add-image category (car glyph))
+ (gnus-put-image (car glyph) (cdr glyph) category)))
+
+(defun gnus-picon-create-glyph (file)
+ (or (cdr (assoc file gnus-picon-glyph-alist))
+ (cdar (push (cons file (gnus-create-image file))
+ gnus-picon-glyph-alist))))
+
+;;; Functions that does picon transformations:
+
+(defun gnus-picon-transform-address (header category)
+ (gnus-with-article-headers
+ (let ((addresses
+ (mail-header-parse-addresses
+ ;; mail-header-parse-addresses does not work (reliably) on
+ ;; decoded headers.
+ (or
+ (ignore-errors
+ (mail-encode-encoded-word-string
+ (or (mail-fetch-field header) "")))
+ (mail-fetch-field header))))
+ spec file point cache)
+ (dolist (address addresses)
+ (setq address (car address))
+ (when (and (stringp address)
+ (setq spec (gnus-picon-split-address address)))
+ (if (setq cache (cdr (assoc address gnus-picon-cache)))
+ (setq spec cache)
+ (when (setq file (or (gnus-picon-find-face
+ address gnus-picon-user-directories)
+ (gnus-picon-find-face
+ (concat "unknown@"
+ (mapconcat
+ 'identity (cdr spec) "."))
+ gnus-picon-user-directories)))
+ (setcar spec (cons (gnus-picon-create-glyph file)
+ (car spec))))
+
+ (dotimes (i (1- (length spec)))
+ (when (setq file (gnus-picon-find-face
+ (concat "unknown@"
+ (mapconcat
+ 'identity (nthcdr (1+ i) spec) "."))
+ gnus-picon-domain-directories t))
+ (setcar (nthcdr (1+ i) spec)
+ (cons (gnus-picon-create-glyph file)
+ (nth (1+ i) spec)))))
+ (setq spec (nreverse spec))
+ (push (cons address spec) gnus-picon-cache))
+
+ (gnus-article-goto-header header)
+ (mail-header-narrow-to-field)
+ (when (search-forward address nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq point (point))
+ (while spec
+ (goto-char point)
+ (if (> (length spec) 2)
+ (insert ".")
+ (if (= (length spec) 2)
+ (insert "@")))
+ (gnus-picon-insert-glyph (pop spec) category))))))))
+
+(defun gnus-picon-transform-newsgroups (header)
+ (interactive)
+ (gnus-with-article-headers
+ (gnus-article-goto-header header)
+ (mail-header-narrow-to-field)
+ (let ((groups (message-tokenize-header (mail-fetch-field header)))
+ spec file point)
+ (dolist (group groups)
+ (unless (setq spec (cdr (assoc group gnus-picon-cache)))
+ (setq spec (nreverse (split-string group "[.]")))
+ (dotimes (i (length spec))
+ (when (setq file (gnus-picon-find-face
+ (concat "unknown@"
+ (mapconcat
+ 'identity (nthcdr i spec) "."))
+ gnus-picon-news-directories t))
+ (setcar (nthcdr i spec)
+ (cons (gnus-picon-create-glyph file)
+ (nth i spec)))))
+ (push (cons group spec) gnus-picon-cache))
+ (when (search-forward group nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (while spec
+ (goto-char (point-min))
+ (if (> (length spec) 1)
+ (insert "."))
+ (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon))
+ (goto-char (point-max))))))))
+
+;;; Commands:
+
+;; #### NOTE: the test for buffer-read-only is the same as in
+;; article-display-[x-]face. See the comment up there.
+
+;;;###autoload
+(defun gnus-treat-from-picon ()
+ "Display picons in the From header.
+If picons are already displayed, remove them."
+ (interactive)
+ (let ((wash-picon-p buffer-read-only))
+ (gnus-with-article-buffer
+ (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types))
+ (gnus-delete-images 'from-picon)
+ (gnus-picon-transform-address "from" 'from-picon)))
+ ))
+
+;;;###autoload
+(defun gnus-treat-mail-picon ()
+ "Display picons in the Cc and To headers.
+If picons are already displayed, remove them."
+ (interactive)
+ (let ((wash-picon-p buffer-read-only))
+ (gnus-with-article-buffer
+ (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types))
+ (gnus-delete-images 'mail-picon)
+ (gnus-picon-transform-address "cc" 'mail-picon)
+ (gnus-picon-transform-address "to" 'mail-picon)))
+ ))
+
+;;;###autoload
+(defun gnus-treat-newsgroups-picon ()
+ "Display picons in the Newsgroups and Followup-To headers.
+If picons are already displayed, remove them."
+ (interactive)
+ (let ((wash-picon-p buffer-read-only))
+ (gnus-with-article-buffer
+ (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types))
+ (gnus-delete-images 'newsgroups-picon)
+ (gnus-picon-transform-newsgroups "newsgroups")
+ (gnus-picon-transform-newsgroups "followup-to")))
+ ))
+
+(provide 'gnus-picon)
+
+;;; arch-tag: fe9aede0-1b1b-463a-b4ab-807f98bcb31f
+;;; gnus-picon.el ends here
diff --git a/lisp/gnus/gnus-pointer.xbm b/lisp/gnus/gnus-pointer.xbm
new file mode 100644
index 00000000000..94e915428c3
--- /dev/null
+++ b/lisp/gnus/gnus-pointer.xbm
@@ -0,0 +1,6 @@
+#define noname_width 18
+#define noname_height 13
+static char noname_bits[] = {
+ 0x00,0x00,0x00,0xc0,0x0c,0x00,0xe0,0x1f,0x00,0x92,0x39,0x00,0x0e,0x71,0x02,
+ 0x46,0xe0,0x03,0x20,0xc0,0x01,0x00,0x08,0x00,0x10,0x0d,0x00,0xc4,0x08,0x00,
+ 0x78,0x08,0x00,0x18,0x89,0x00,0x00,0x08,0x00};
diff --git a/lisp/gnus/gnus-pointer.xpm b/lisp/gnus/gnus-pointer.xpm
new file mode 100644
index 00000000000..c47443dbb74
--- /dev/null
+++ b/lisp/gnus/gnus-pointer.xpm
@@ -0,0 +1,22 @@
+/* XPM */
+static char *gnus-pointer[] = {
+/* width height num_colors chars_per_pixel */
+" 18 13 2 1",
+/* colors */
+". c #0000ff",
+"# c None s None",
+/* pixels */
+"##################",
+"######..##..######",
+"#####........#####",
+"#.##.##..##...####",
+"#...####.###...##.",
+"#..###.######.....",
+"#####.########...#",
+"###########.######",
+"####.###.#..######",
+"######..###.######",
+"###....####.######",
+"###..######.######",
+"###########.######"
+}; \ No newline at end of file
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index b31fc673bb8..56a1b569418 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -1,6 +1,7 @@
;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -30,6 +31,11 @@
;;; List and range functions
+(defsubst gnus-range-normalize (range)
+ "Normalize RANGE.
+If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
+ (if (listp (cdr-safe range)) range (list range)))
+
(defun gnus-last-element (list)
"Return last element of LIST."
(while (cdr list)
@@ -55,6 +61,85 @@
(setq list2 (cdr list2)))
list1))
+(defun gnus-range-difference (range1 range2)
+ "Return the range of elements in RANGE1 that do not appear in RANGE2.
+Both ranges must be in ascending order."
+ (setq range1 (gnus-range-normalize range1))
+ (setq range2 (gnus-range-normalize range2))
+ (let* ((new-range (cons nil (copy-sequence range1)))
+ (r new-range)
+ (safe t))
+ (while (cdr r)
+ (let* ((r1 (cadr r))
+ (r2 (car range2))
+ (min1 (if (numberp r1) r1 (car r1)))
+ (max1 (if (numberp r1) r1 (cdr r1)))
+ (min2 (if (numberp r2) r2 (car r2)))
+ (max2 (if (numberp r2) r2 (cdr r2))))
+
+ (cond ((> min1 max1)
+ ;; Invalid range: may result from overlap condition (below)
+ ;; remove Invalid range
+ (setcdr r (cddr r)))
+ ((and (= min1 max1)
+ (listp r1))
+ ;; Inefficient representation: may result from overlap condition (below)
+ (setcar (cdr r) min1))
+ ((not min2)
+ ;; All done with range2
+ (setq r nil))
+ ((< max1 min2)
+ ;; No overlap: range1 preceeds range2
+ (pop r))
+ ((< max2 min1)
+ ;; No overlap: range2 preceeds range1
+ (pop range2))
+ ((and (<= min2 min1) (<= max1 max2))
+ ;; Complete overlap: range1 removed
+ (setcdr r (cddr r)))
+ (t
+ (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
+ (cdr new-range)))
+
+
+
+;;;###autoload
+(defun gnus-sorted-difference (list1 list2)
+ "Return a list of elements of LIST1 that do not appear in LIST2.
+Both lists have to be sorted over <.
+The tail of LIST1 is not copied."
+ (let (out)
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq out (cons (car list1) out))
+ (setq list1 (cdr list1)))
+ (t
+ (setq list2 (cdr list2)))))
+ (nconc (nreverse out) list1)))
+
+;;;###autoload
+(defun gnus-sorted-ndifference (list1 list2)
+ "Return a list of elements of LIST1 that do not appear in LIST2.
+Both lists have to be sorted over <.
+LIST1 is modified."
+ (let* ((top (cons nil list1))
+ (prev top))
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setcdr prev (cdr list1))
+ (setq list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq prev list1
+ list1 (cdr list1)))
+ (t
+ (setq list2 (cdr list2)))))
+ (cdr top)))
+
+;;;###autoload
(defun gnus-sorted-complement (list1 list2)
"Return a list of elements that are in LIST1 or LIST2 but not both.
Both lists have to be sorted over <."
@@ -73,6 +158,7 @@ Both lists have to be sorted over <."
(setq list2 (cdr list2)))))
(nconc (nreverse out) (or list1 list2)))))
+;;;###autoload
(defun gnus-intersection (list1 list2)
(let ((result nil))
(while list2
@@ -81,8 +167,10 @@ Both lists have to be sorted over <."
(setq list2 (cdr list2)))
result))
+;;;###autoload
(defun gnus-sorted-intersection (list1 list2)
- ;; LIST1 and LIST2 have to be sorted over <.
+ "Return intersection of LIST1 and LIST2.
+LIST1 and LIST2 have to be sorted over <."
(let (out)
(while (and list1 list2)
(cond ((= (car list1) (car list2))
@@ -95,9 +183,13 @@ Both lists have to be sorted over <."
(setq list2 (cdr list2)))))
(nreverse out)))
-(defun gnus-set-sorted-intersection (list1 list2)
- ;; LIST1 and LIST2 have to be sorted over <.
- ;; This function modifies LIST1.
+;;;###autoload
+(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
+
+;;;###autoload
+(defun gnus-sorted-nintersection (list1 list2)
+ "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1.
+LIST1 and LIST2 have to be sorted over <."
(let* ((top (cons nil list1))
(prev top))
(while (and list1 list2)
@@ -113,6 +205,55 @@ Both lists have to be sorted over <."
(setcdr prev nil)
(cdr top)))
+;;;###autoload
+(defun gnus-sorted-union (list1 list2)
+ "Return union of LIST1 and LIST2.
+LIST1 and LIST2 have to be sorted over <."
+ (let (out)
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq out (cons (car list1) out)
+ list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq out (cons (car list1) out)
+ list1 (cdr list1)))
+ (t
+ (setq out (cons (car list2) out)
+ list2 (cdr list2)))))
+ (while list1
+ (setq out (cons (car list1) out)
+ list1 (cdr list1)))
+ (while list2
+ (setq out (cons (car list2) out)
+ list2 (cdr list2)))
+ (nreverse out)))
+
+;;;###autoload
+(defun gnus-sorted-nunion (list1 list2)
+ "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1.
+LIST1 and LIST2 have to be sorted over <."
+ (let* ((top (cons nil list1))
+ (prev top))
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq prev list1
+ list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setq prev list1
+ list1 (cdr list1)))
+ (t
+ (setcdr prev (list (car list2)))
+ (setq prev (cdr prev)
+ list2 (cdr list2))
+ (setcdr prev list1))))
+ (while list2
+ (setcdr prev (list (car list2)))
+ (setq prev (cdr prev)
+ list2 (cdr list2)))
+ (cdr top)))
+
(defun gnus-compress-sequence (numbers &optional always-list)
"Convert list of numbers to a list of ranges or a single range.
If ALWAYS-LIST is non-nil, this function will always release a list of
@@ -319,9 +460,58 @@ modified."
(setq ranges (cdr ranges)))
(not not-stop))))
+(defun gnus-list-range-intersection (list ranges)
+ "Return a list of numbers in LIST that are members of RANGES.
+LIST is a sorted list."
+ (setq ranges (gnus-range-normalize ranges))
+ (let (number result)
+ (while (setq number (pop list))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (< (car ranges) number)
+ (< (cdar ranges) number)))
+ (setq ranges (cdr ranges)))
+ (when (and ranges
+ (if (numberp (car ranges))
+ (= (car ranges) number)
+ ;; (caar ranges) <= number <= (cdar ranges)
+ (>= number (caar ranges))))
+ (push number result)))
+ (nreverse result)))
+
+(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference)
+
+(defun gnus-list-range-difference (list ranges)
+ "Return a list of numbers in LIST that are not members of RANGES.
+LIST is a sorted list."
+ (setq ranges (gnus-range-normalize ranges))
+ (let (number result)
+ (while (setq number (pop list))
+ (while (and ranges
+ (if (numberp (car ranges))
+ (< (car ranges) number)
+ (< (cdar ranges) number)))
+ (setq ranges (cdr ranges)))
+ (when (or (not ranges)
+ (if (numberp (car ranges))
+ (not (= (car ranges) number))
+ ;; not ((caar ranges) <= number <= (cdar ranges))
+ (< number (caar ranges))))
+ (push number result)))
+ (nreverse result)))
+
(defun gnus-range-length (range)
"Return the length RANGE would have if uncompressed."
- (length (gnus-uncompress-range range)))
+ (cond
+ ((null range)
+ 0)
+ ((not (listp (cdr range)))
+ (- (cdr range) (car range) -1))
+ (t
+ (let ((sum 0))
+ (dolist (x range sum)
+ (setq sum
+ (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
(defun gnus-sublist-p (list sublist)
"Test whether all elements in SUBLIST are members of LIST."
@@ -387,6 +577,18 @@ modified."
(if item (push item range))
(reverse range)))
+;;;###autoload
+(defun gnus-add-to-sorted-list (list num)
+ "Add NUM into sorted LIST by side effect."
+ (let* ((top (cons nil list))
+ (prev top))
+ (while (and list (< (car list) num))
+ (setq prev list
+ list (cdr list)))
+ (unless (eq (car list) num)
+ (setcdr prev (cons num list)))
+ (cdr top)))
+
(provide 'gnus-range)
;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
new file mode 100644
index 00000000000..9a8d77d3b24
--- /dev/null
+++ b/lisp/gnus/gnus-registry.el
@@ -0,0 +1,703 @@
+;;; gnus-registry.el --- article registry for Gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This is the gnus-registry.el package, works with other backends
+;; besides nnmail. The major issue is that it doesn't go across
+;; backends, so for instance if an article is in nnml:sys and you see
+;; a reference to it in nnimap splitting, the article will end up in
+;; nnimap:sys
+
+;; gnus-registry.el intercepts article respooling, moving, deleting,
+;; and copying for all backends. If it doesn't work correctly for
+;; you, submit a bug report and I'll be glad to fix it. It needs
+;; documentation in the manual (also on my to-do list).
+
+;; Put this in your startup file (~/.gnus.el for instance)
+
+;; (setq gnus-registry-max-entries 2500
+;; gnus-registry-use-long-group-names t)
+
+;; (gnus-registry-initialize)
+
+;; Then use this in your fancy-split:
+
+;; (: gnus-registry-split-fancy-with-parent)
+
+;; TODO:
+
+;; - get the correct group on spool actions
+
+;; - articles that are spooled to a different backend should be handled
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-int)
+(require 'gnus-sum)
+(require 'nnmail)
+
+(defvar gnus-registry-dirty t
+ "Boolean set to t when the registry is modified")
+
+(defgroup gnus-registry nil
+ "The Gnus registry."
+ :group 'gnus)
+
+(defvar gnus-registry-hashtb nil
+ "*The article registry by Message ID.")
+
+(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue")
+ "List of groups that gnus-registry-split-fancy-with-parent won't follow.
+The group names are matched, they don't have to be fully qualified."
+ :group 'gnus-registry
+ :type '(repeat string))
+
+(defcustom gnus-registry-install nil
+ "Whether the registry should be installed."
+ :group 'gnus-registry
+ :type 'boolean)
+
+(defcustom gnus-registry-clean-empty t
+ "Whether the empty registry entries should be deleted.
+Registry entries are considered empty when they have no groups."
+ :group 'gnus-registry
+ :type 'boolean)
+
+(defcustom gnus-registry-use-long-group-names nil
+ "Whether the registry should use long group names (BUGGY)."
+ :group 'gnus-registry
+ :type 'boolean)
+
+(defcustom gnus-registry-track-extra nil
+ "Whether the registry should track extra data about a message.
+The Subject and Sender (From:) headers are currently tracked this
+way."
+ :group 'gnus-registry
+ :type
+ '(set :tag "Tracking choices"
+ (const :tag "Track by subject (Subject: header)" subject)
+ (const :tag "Track by sender (From: header)" sender)))
+
+(defcustom gnus-registry-entry-caching t
+ "Whether the registry should cache extra information."
+ :group 'gnus-registry
+ :type 'boolean)
+
+(defcustom gnus-registry-minimum-subject-length 5
+ "The minimum length of a subject before it's considered trackable."
+ :group 'gnus-registry
+ :type 'integer)
+
+(defcustom gnus-registry-trim-articles-without-groups t
+ "Whether the registry should clean out message IDs without groups."
+ :group 'gnus-registry
+ :type 'boolean)
+
+(defcustom gnus-registry-cache-file "~/.gnus.registry.eld"
+ "File where the Gnus registry will be stored."
+ :group 'gnus-registry
+ :type 'file)
+
+(defcustom gnus-registry-max-entries nil
+ "Maximum number of entries in the registry, nil for unlimited."
+ :group 'gnus-registry
+ :type '(radio (const :format "Unlimited " nil)
+ (integer :format "Maximum number: %v\n" :size 0)))
+
+;; Function(s) missing in Emacs 20
+(when (memq nil (mapcar 'fboundp '(puthash)))
+ (require 'cl)
+ (unless (fboundp 'puthash)
+ ;; alias puthash is missing from Emacs 20 cl-extra.el
+ (defalias 'puthash 'cl-puthash)))
+
+(defun gnus-registry-track-subject-p ()
+ (memq 'subject gnus-registry-track-extra))
+
+(defun gnus-registry-track-sender-p ()
+ (memq 'sender gnus-registry-track-extra))
+
+(defun gnus-registry-cache-read ()
+ "Read the registry cache file."
+ (interactive)
+ (let ((file gnus-registry-cache-file))
+ (when (file-exists-p file)
+ (gnus-message 5 "Reading %s..." file)
+ (gnus-load file)
+ (gnus-message 5 "Reading %s...done" file))))
+
+(defun gnus-registry-cache-save ()
+ "Save the registry cache file."
+ (interactive)
+ (let ((file gnus-registry-cache-file))
+ (save-excursion
+ (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*"))
+ (make-local-variable 'version-control)
+ (setq version-control gnus-backup-startup-file)
+ (setq buffer-file-name file)
+ (setq default-directory (file-name-directory buffer-file-name))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (gnus-message 5 "Saving %s..." file)
+ (if gnus-save-startup-file-via-temp-buffer
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (standard-output (current-buffer)))
+ (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)
+ (gnus-registry-cache-whitespace file)
+ (save-buffer))
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (version-control gnus-backup-startup-file)
+ (startup-file file)
+ (working-dir (file-name-directory file))
+ working-file
+ (i -1))
+ ;; Generate the name of a non-existent file.
+ (while (progn (setq working-file
+ (format
+ (if (and (eq system-type 'ms-dos)
+ (not (gnus-long-file-names)))
+ "%s#%d.tm#" ; MSDOS limits files to 8+3
+ (if (memq system-type '(vax-vms axp-vms))
+ "%s$tmp$%d"
+ "%s#tmp#%d"))
+ working-dir (setq i (1+ i))))
+ (file-exists-p working-file)))
+
+ (unwind-protect
+ (progn
+ (gnus-with-output-to-file working-file
+ (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist))
+
+ ;; These bindings will mislead the current buffer
+ ;; into thinking that it is visiting the startup
+ ;; file.
+ (let ((buffer-backed-up nil)
+ (buffer-file-name startup-file)
+ (file-precious-flag t)
+ (setmodes (file-modes startup-file)))
+ ;; Backup the current version of the startup file.
+ (backup-buffer)
+
+ ;; Replace the existing startup file with the temp file.
+ (rename-file working-file startup-file t)
+ (set-file-modes startup-file setmodes)))
+ (condition-case nil
+ (delete-file working-file)
+ (file-error nil)))))
+
+ (gnus-kill-buffer (current-buffer))
+ (gnus-message 5 "Saving %s...done" file))))
+
+;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
+;; Save the gnus-registry file with extra line breaks.
+(defun gnus-registry-cache-whitespace (filename)
+ (gnus-message 5 "Adding whitespace to %s" filename)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^(\\|(\\\"" nil t)
+ (replace-match "\n\\&" t))
+ (goto-char (point-min))
+ (while (re-search-forward " $" nil t)
+ (replace-match "" t t))))
+
+(defun gnus-registry-save (&optional force)
+ (when (or gnus-registry-dirty force)
+ (let ((caching gnus-registry-entry-caching))
+ ;; turn off entry caching, so mtime doesn't get recorded
+ (setq gnus-registry-entry-caching nil)
+ ;; remove entry caches
+ (maphash
+ (lambda (key value)
+ (if (hash-table-p value)
+ (remhash key gnus-registry-hashtb)))
+ gnus-registry-hashtb)
+ ;; remove empty entries
+ (when gnus-registry-clean-empty
+ (gnus-registry-clean-empty-function))
+ ;; now trim the registry appropriately
+ (setq gnus-registry-alist (gnus-registry-trim
+ (hashtable-to-alist gnus-registry-hashtb)))
+ ;; really save
+ (gnus-registry-cache-save)
+ (setq gnus-registry-entry-caching caching)
+ (setq gnus-registry-dirty nil))))
+
+(defun gnus-registry-clean-empty-function ()
+ "Remove all empty entries from the registry. Returns count thereof."
+ (let ((count 0))
+ (maphash
+ (lambda (key value)
+ (unless (gnus-registry-fetch-group key)
+ (incf count)
+ (remhash key gnus-registry-hashtb)))
+ gnus-registry-hashtb)
+ count))
+
+(defun gnus-registry-read ()
+ (gnus-registry-cache-read)
+ (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
+ (setq gnus-registry-dirty nil))
+
+(defun gnus-registry-trim (alist)
+ "Trim alist to size, using gnus-registry-max-entries."
+ (if (null gnus-registry-max-entries)
+ alist ; just return the alist
+ ;; else, when given max-entries, trim the alist
+ (let ((timehash (make-hash-table
+ :size 4096
+ :test 'equal)))
+ (maphash
+ (lambda (key value)
+ (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
+ gnus-registry-hashtb)
+
+ ;; we use the return value of this setq, which is the trimmed alist
+ (setq alist
+ (nthcdr
+ (- (length alist) gnus-registry-max-entries)
+ (sort alist
+ (lambda (a b)
+ (time-less-p
+ (cdr (gethash (car a) timehash))
+ (cdr (gethash (car b) timehash))))))))))
+
+(defun alist-to-hashtable (alist)
+ "Build a hashtable from the values in ALIST."
+ (let ((ht (make-hash-table
+ :size 4096
+ :test 'equal)))
+ (mapc
+ (lambda (kv-pair)
+ (puthash (car kv-pair) (cdr kv-pair) ht))
+ alist)
+ ht))
+
+(defun hashtable-to-alist (hash)
+ "Build an alist from the values in HASH."
+ (let ((list nil))
+ (maphash
+ (lambda (key value)
+ (setq list (cons (cons key value) list)))
+ hash)
+ list))
+
+(defun gnus-registry-action (action data-header from &optional to method)
+ (let* ((id (mail-header-id data-header))
+ (subject (gnus-registry-simplify-subject
+ (mail-header-subject data-header)))
+ (sender (mail-header-from data-header))
+ (from (gnus-group-guess-full-name-from-command-method from))
+ (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
+ (to-name (if to to "the Bit Bucket"))
+ (old-entry (gethash id gnus-registry-hashtb)))
+ (gnus-message 5 "Registry: article %s %s from %s to %s"
+ id
+ (if method "respooling" "going")
+ from
+ to)
+
+ ;; All except copy will need a delete
+ (gnus-registry-delete-group id from)
+
+ (when (equal 'copy action)
+ (gnus-registry-add-group id from subject sender)) ; undo the delete
+
+ (gnus-registry-add-group id to subject sender)))
+
+(defun gnus-registry-spool-action (id group &optional subject sender)
+ (let ((group (gnus-group-guess-full-name-from-command-method group)))
+ (when (and (stringp id) (string-match "\r$" id))
+ (setq id (substring id 0 -1)))
+ (gnus-message 5 "Registry: article %s spooled to %s"
+ id
+ group)
+ (gnus-registry-add-group id group subject sender)))
+
+;; Function for nn{mail|imap}-split-fancy: look up all references in
+;; the cache and if a match is found, return that group.
+(defun gnus-registry-split-fancy-with-parent ()
+ "Split this message into the same group as its parent. The parent
+is obtained from the registry. This function can be used as an entry
+in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
+this: (: gnus-registry-split-fancy-with-parent)
+
+For a message to be split, it looks for the parent message in the
+References or In-Reply-To header and then looks in the registry to
+see which group that message was put in. This group is returned.
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
+ (let ((refstr (or (message-fetch-field "references")
+ (message-fetch-field "in-reply-to")))
+ (nnmail-split-fancy-with-parent-ignore-groups
+ (if (listp nnmail-split-fancy-with-parent-ignore-groups)
+ nnmail-split-fancy-with-parent-ignore-groups
+ (list nnmail-split-fancy-with-parent-ignore-groups)))
+ references res)
+ (if refstr
+ (progn
+ (setq references (nreverse (gnus-split-references refstr)))
+ (mapcar (lambda (x)
+ (setq res (or (gnus-registry-fetch-group x) res))
+ (when (or (gnus-registry-grep-in-list
+ res
+ gnus-registry-unfollowed-groups)
+ (gnus-registry-grep-in-list
+ res
+ nnmail-split-fancy-with-parent-ignore-groups))
+ (setq res nil)))
+ references))
+
+ ;; else: there were no references, now try the extra tracking
+ (let ((sender (message-fetch-field "from"))
+ (subject (gnus-registry-simplify-subject
+ (message-fetch-field "subject")))
+ (single-match t))
+ (when (and single-match
+ (gnus-registry-track-sender-p)
+ sender)
+ (maphash
+ (lambda (key value)
+ (let ((this-sender (cdr
+ (gnus-registry-fetch-extra key 'sender))))
+ (when (and single-match
+ this-sender
+ (equal sender this-sender))
+ ;; too many matches, bail
+ (unless (equal res (gnus-registry-fetch-group key))
+ (setq single-match nil))
+ (setq res (gnus-registry-fetch-group key))
+ (gnus-message
+ ;; raise level of messaging if gnus-registry-track-extra
+ (if gnus-registry-track-extra 5 9)
+ "%s (extra tracking) traced sender %s to group %s"
+ "gnus-registry-split-fancy-with-parent"
+ sender
+ (if res res "nil")))))
+ gnus-registry-hashtb))
+ (when (and single-match
+ (gnus-registry-track-subject-p)
+ subject
+ (< gnus-registry-minimum-subject-length (length subject)))
+ (maphash
+ (lambda (key value)
+ (let ((this-subject (cdr
+ (gnus-registry-fetch-extra key 'subject))))
+ (when (and single-match
+ this-subject
+ (equal subject this-subject))
+ ;; too many matches, bail
+ (unless (equal res (gnus-registry-fetch-group key))
+ (setq single-match nil))
+ (setq res (gnus-registry-fetch-group key))
+ (gnus-message
+ ;; raise level of messaging if gnus-registry-track-extra
+ (if gnus-registry-track-extra 5 9)
+ "%s (extra tracking) traced subject %s to group %s"
+ "gnus-registry-split-fancy-with-parent"
+ subject
+ (if res res "nil")))))
+ gnus-registry-hashtb))
+ (unless single-match
+ (gnus-message
+ 5
+ "gnus-registry-split-fancy-with-parent: too many extra matches for %s"
+ refstr)
+ (setq res nil))))
+ (gnus-message
+ 5
+ "gnus-registry-split-fancy-with-parent traced %s to group %s"
+ refstr (if res res "nil"))
+
+ (when (and res gnus-registry-use-long-group-names)
+ (let ((m1 (gnus-find-method-for-group res))
+ (m2 (or gnus-command-method
+ (gnus-find-method-for-group gnus-newsgroup-name)))
+ (short-res (gnus-group-short-name res)))
+ (if (gnus-methods-equal-p m1 m2)
+ (progn
+ (gnus-message
+ 9
+ "gnus-registry-split-fancy-with-parent stripped group %s to %s"
+ res
+ short-res)
+ (setq res short-res))
+ ;; else...
+ (gnus-message
+ 5
+ "gnus-registry-split-fancy-with-parent ignored foreign group %s"
+ res)
+ (setq res nil))))
+ res))
+
+(defun gnus-registry-register-message-ids ()
+ "Register the Message-ID of every article in the group"
+ (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
+ (dolist (article gnus-newsgroup-articles)
+ (let ((id (gnus-registry-fetch-message-id-fast article)))
+ (unless (gnus-registry-fetch-group id)
+ (gnus-message 9 "Registry: Registering article %d with group %s"
+ article gnus-newsgroup-name)
+ (gnus-registry-add-group
+ (gnus-registry-fetch-message-id-fast article)
+ gnus-newsgroup-name
+ (gnus-registry-fetch-simplified-message-subject-fast article)
+ (gnus-registry-fetch-sender-fast article)))))))
+
+(defun gnus-registry-fetch-message-id-fast (article)
+ "Fetch the Message-ID quickly, using the internal gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
+ nil))
+
+(defun gnus-registry-simplify-subject (subject)
+ (if (stringp subject)
+ (gnus-simplify-subject subject)
+ nil))
+
+(defun gnus-registry-fetch-simplified-message-subject-fast (article)
+ "Fetch the Subject quickly, using the internal gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (gnus-registry-simplify-subject
+ (mail-header-subject (gnus-data-header
+ (assoc article (gnus-data-list nil)))))
+ nil))
+
+(defun gnus-registry-fetch-sender-fast (article)
+ "Fetch the Sender quickly, using the internal gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (mail-header-from (gnus-data-header
+ (assoc article (gnus-data-list nil))))
+ nil))
+
+(defun gnus-registry-grep-in-list (word list)
+ (when word
+ (memq nil
+ (mapcar 'not
+ (mapcar
+ (lambda (x)
+ (string-match x word))
+ list)))))
+
+(defun gnus-registry-fetch-extra (id &optional entry)
+ "Get the extra data of a message, based on the message ID.
+Returns the first place where the trail finds a nonstring."
+ (let ((entry-cache (gethash entry gnus-registry-hashtb)))
+ (if (and entry
+ (hash-table-p entry-cache)
+ (gethash id entry-cache))
+ (gethash id entry-cache)
+ ;; else, if there is no caching possible...
+ (let ((trail (gethash id gnus-registry-hashtb)))
+ (when (listp trail)
+ (dolist (crumb trail)
+ (unless (stringp crumb)
+ (return (gnus-registry-fetch-extra-entry crumb entry id)))))))))
+
+(defun gnus-registry-fetch-extra-entry (alist &optional entry id)
+ "Get the extra data of a message, or a specific entry in it.
+Update the entry cache if needed."
+ (if (and entry id)
+ (let ((entry-cache (gethash entry gnus-registry-hashtb))
+ entree)
+ (when gnus-registry-entry-caching
+ ;; create the hash table
+ (unless (hash-table-p entry-cache)
+ (setq entry-cache (make-hash-table
+ :size 4096
+ :test 'equal))
+ (puthash entry entry-cache gnus-registry-hashtb))
+
+ ;; get the entree from the hash table or from the alist
+ (setq entree (gethash id entry-cache)))
+
+ (unless entree
+ (setq entree (assq entry alist))
+ (when gnus-registry-entry-caching
+ (puthash id entree entry-cache)))
+ entree)
+ alist))
+
+(defun gnus-registry-store-extra (id extra)
+ "Store the extra data of a message, based on the message ID.
+The message must have at least one group name."
+ (when (gnus-registry-group-count id)
+ ;; we now know the trail has at least 1 group name, so it's not empty
+ (let ((trail (gethash id gnus-registry-hashtb))
+ (old-extra (gnus-registry-fetch-extra id))
+ entry-cache)
+ (dolist (crumb trail)
+ (unless (stringp crumb)
+ (dolist (entry crumb)
+ (setq entry-cache (gethash (car entry) gnus-registry-hashtb))
+ (when entry-cache
+ (remhash id entry-cache))))
+ (puthash id (cons extra (delete old-extra trail))
+ gnus-registry-hashtb)
+ (setq gnus-registry-dirty t)))))
+
+(defun gnus-registry-store-extra-entry (id key value)
+ "Put a specific entry in the extras field of the registry entry for id."
+ (let* ((extra (gnus-registry-fetch-extra id))
+ (alist (cons (cons key value)
+ (gnus-assq-delete-all key (gnus-registry-fetch-extra id)))))
+ (gnus-registry-store-extra id alist)))
+
+(defun gnus-registry-fetch-group (id)
+ "Get the group of a message, based on the message ID.
+Returns the first place where the trail finds a group name."
+ (when (gnus-registry-group-count id)
+ ;; we now know the trail has at least 1 group name
+ (let ((trail (gethash id gnus-registry-hashtb)))
+ (dolist (crumb trail)
+ (when (stringp crumb)
+ (return (if gnus-registry-use-long-group-names
+ crumb
+ (gnus-group-short-name crumb))))))))
+
+(defun gnus-registry-group-count (id)
+ "Get the number of groups of a message, based on the message ID."
+ (let ((trail (gethash id gnus-registry-hashtb)))
+ (if (and trail (listp trail))
+ (apply '+ (mapcar (lambda (x) (if (stringp x) 1 0)) trail))
+ 0)))
+
+(defun gnus-registry-delete-group (id group)
+ "Delete a group for a message, based on the message ID."
+ (when group
+ (when id
+ (let ((trail (gethash id gnus-registry-hashtb))
+ (group (gnus-group-short-name group)))
+ (puthash id (if trail
+ (delete group trail)
+ nil)
+ gnus-registry-hashtb))
+ ;; now, clear the entry if there are no more groups
+ (when gnus-registry-trim-articles-without-groups
+ (unless (gnus-registry-group-count id)
+ (gnus-registry-delete-id id)))
+ (gnus-registry-store-extra-entry id 'mtime (current-time)))))
+
+(defun gnus-registry-delete-id (id)
+ "Delete a message ID from the registry."
+ (when (stringp id)
+ (remhash id gnus-registry-hashtb)
+ (maphash
+ (lambda (key value)
+ (when (hash-table-p value)
+ (remhash id value)))
+ gnus-registry-hashtb)))
+
+(defun gnus-registry-add-group (id group &optional subject sender)
+ "Add a group for a message, based on the message ID."
+ (when group
+ (when (and id
+ (not (string-match "totally-fudged-out-message-id" id)))
+ (let ((full-group group)
+ (group (if gnus-registry-use-long-group-names
+ group
+ (gnus-group-short-name group))))
+ (gnus-registry-delete-group id group)
+
+ (unless gnus-registry-use-long-group-names ;; unnecessary in this case
+ (gnus-registry-delete-group id full-group))
+
+ (let ((trail (gethash id gnus-registry-hashtb)))
+ (puthash id (if trail
+ (cons group trail)
+ (list group))
+ gnus-registry-hashtb)
+
+ (when (and (gnus-registry-track-subject-p)
+ subject)
+ (gnus-registry-store-extra-entry
+ id
+ 'subject
+ (gnus-registry-simplify-subject subject)))
+ (when (and (gnus-registry-track-sender-p)
+ sender)
+ (gnus-registry-store-extra-entry
+ id
+ 'sender
+ sender))
+
+ (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
+
+(defun gnus-registry-clear ()
+ "Clear the Gnus registry."
+ (interactive)
+ (setq gnus-registry-alist nil)
+ (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
+ (setq gnus-registry-dirty t))
+
+;;;###autoload
+(defun gnus-registry-initialize ()
+ (interactive)
+ (setq gnus-registry-install t)
+ (gnus-registry-install-hooks)
+ (gnus-registry-read))
+
+;;;###autoload
+(defun gnus-registry-install-hooks ()
+ "Install the registry hooks."
+ (interactive)
+ (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
+ (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
+ (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
+ (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
+
+ (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
+ (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
+
+ (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
+
+(defun gnus-registry-unload-hook ()
+ "Uninstall the registry hooks."
+ (interactive)
+ (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
+ (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
+ (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
+ (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
+
+ (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
+ (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
+
+ (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
+
+(when gnus-registry-install
+ (gnus-registry-install-hooks)
+ (gnus-registry-read))
+
+;; TODO: a lot of things
+
+(provide 'gnus-registry)
+
+;;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
+;;; gnus-registry.el ends here
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index a2c8d0609fb..d9720c819b2 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -1,6 +1,7 @@
;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2001
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -30,13 +31,15 @@
(require 'gnus)
(require 'gnus-sum)
+(require 'gnus-win)
;;;
;;; gnus-pick-mode
;;;
(defvar gnus-pick-mode nil
- "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
+ "Minor mode for providing a pick-and-read interface in Gnus
+summary buffers.")
(defcustom gnus-pick-display-summary nil
"*Display summary while reading."
@@ -48,18 +51,22 @@
:type 'hook
:group 'gnus-summary-pick)
+(when (featurep 'xemacs)
+ (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add))
+
(defcustom gnus-mark-unpicked-articles-as-read nil
"*If non-nil, mark all unpicked articles as read."
:type 'boolean
:group 'gnus-summary-pick)
(defcustom gnus-pick-elegant-flow t
- "If non-nil, `gnus-pick-start-reading' runs `gnus-summary-next-group' when no articles have been picked."
+ "If non-nil, `gnus-pick-start-reading' runs
+ `gnus-summary-next-group' when no articles have been picked."
:type 'boolean
:group 'gnus-summary-pick)
(defcustom gnus-summary-pick-line-format
- "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
"*The format specification of the lines in pick buffers.
It accepts the same format specs that `gnus-summary-line-format' does."
:type 'string
@@ -82,22 +89,22 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(defun gnus-pick-make-menu-bar ()
(unless (boundp 'gnus-pick-menu)
(easy-menu-define
- gnus-pick-menu gnus-pick-mode-map ""
- '("Pick"
- ("Pick"
- ["Article" gnus-summary-mark-as-processable t]
- ["Thread" gnus-uu-mark-thread t]
- ["Region" gnus-uu-mark-region t]
- ["Regexp" gnus-uu-mark-by-regexp t]
- ["Buffer" gnus-uu-mark-buffer t])
- ("Unpick"
- ["Article" gnus-summary-unmark-as-processable t]
- ["Thread" gnus-uu-unmark-thread t]
- ["Region" gnus-uu-unmark-region t]
- ["Regexp" gnus-uu-unmark-by-regexp t]
- ["Buffer" gnus-summary-unmark-all-processable t])
- ["Start reading" gnus-pick-start-reading t]
- ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
+ gnus-pick-menu gnus-pick-mode-map ""
+ '("Pick"
+ ("Pick"
+ ["Article" gnus-summary-mark-as-processable t]
+ ["Thread" gnus-uu-mark-thread t]
+ ["Region" gnus-uu-mark-region t]
+ ["Regexp" gnus-uu-mark-by-regexp t]
+ ["Buffer" gnus-uu-mark-buffer t])
+ ("Unpick"
+ ["Article" gnus-summary-unmark-as-processable t]
+ ["Thread" gnus-uu-unmark-thread t]
+ ["Region" gnus-uu-unmark-region t]
+ ["Regexp" gnus-uu-unmark-by-regexp t]
+ ["Buffer" gnus-summary-unmark-all-processable t])
+ ["Start reading" gnus-pick-start-reading t]
+ ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
(defun gnus-pick-mode (&optional arg)
"Minor mode for providing a pick-and-read interface in Gnus summary buffers.
@@ -148,11 +155,11 @@ If given a prefix, mark all unpicked articles as read."
(interactive "P")
(if gnus-newsgroup-processable
(progn
- (gnus-summary-limit-to-articles nil)
- (when (or catch-up gnus-mark-unpicked-articles-as-read)
+ (gnus-summary-limit-to-articles nil)
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
(gnus-summary-limit-mark-excluded-as-read))
- (gnus-summary-first-article)
- (gnus-configure-windows
+ (gnus-summary-first-article)
+ (gnus-configure-windows
(if gnus-pick-display-summary 'article 'pick) t))
(if gnus-pick-elegant-flow
(progn
@@ -223,7 +230,7 @@ This must be bound to a button-down mouse event."
(let* ((echo-keystrokes 0)
(start-posn (event-start start-event))
(start-point (posn-point start-posn))
- (start-line (1+ (count-lines 1 start-point)))
+ (start-line (1+ (count-lines 1 start-point)))
(start-window (posn-window start-posn))
(bounds (gnus-window-edges start-window))
(top (nth 1 bounds))
@@ -235,7 +242,7 @@ This must be bound to a button-down mouse event."
(setq mouse-selection-click-count click-count)
(setq mouse-selection-click-count-buffer (current-buffer))
(mouse-set-point start-event)
- ;; In case the down click is in the middle of some intangible text,
+ ;; In case the down click is in the middle of some intangible text,
;; use the end of that text, and put it in START-POINT.
(when (< (point) start-point)
(goto-char start-point))
@@ -246,61 +253,61 @@ This must be bound to a button-down mouse event."
;; (but not outside the window where the drag started).
(let (event end end-point (end-of-range (point)))
(track-mouse
- (while (progn
- (setq event (cdr (gnus-read-event-char)))
- (or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
- (if (eq (car-safe event) 'switch-frame)
- nil
- (setq end (event-end event)
- end-point (posn-point end))
-
- (cond
- ;; Are we moving within the original window?
- ((and (eq (posn-window end) start-window)
- (integer-or-marker-p end-point))
- ;; Go to START-POINT first, so that when we move to END-POINT,
- ;; if it's in the middle of intangible text,
- ;; point jumps in the direction away from START-POINT.
- (goto-char start-point)
- (goto-char end-point)
- (gnus-pick-article)
- ;; In case the user moved his mouse really fast, pick
- ;; articles on the line between this one and the last one.
- (let* ((this-line (1+ (count-lines 1 end-point)))
- (min-line (min this-line start-line))
- (max-line (max this-line start-line)))
- (while (< min-line max-line)
- (goto-line min-line)
- (gnus-pick-article)
- (setq min-line (1+ min-line)))
- (setq start-line this-line))
- (when (zerop (% click-count 3))
- (setq end-of-range (point))))
- (t
- (let ((mouse-row (cdr (cdr (mouse-position)))))
- (cond
- ((null mouse-row))
- ((< mouse-row top)
- (mouse-scroll-subr start-window (- mouse-row top)))
- ((>= mouse-row bottom)
- (mouse-scroll-subr start-window
- (1+ (- mouse-row bottom)))))))))))
+ (while (progn
+ (setq event (cdr (gnus-read-event-char)))
+ (or (mouse-movement-p event)
+ (eq (car-safe event) 'switch-frame)))
+ (if (eq (car-safe event) 'switch-frame)
+ nil
+ (setq end (event-end event)
+ end-point (posn-point end))
+
+ (cond
+ ;; Are we moving within the original window?
+ ((and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ ;; Go to START-POINT first, so that when we move to END-POINT,
+ ;; if it's in the middle of intangible text,
+ ;; point jumps in the direction away from START-POINT.
+ (goto-char start-point)
+ (goto-char end-point)
+ (gnus-pick-article)
+ ;; In case the user moved his mouse really fast, pick
+ ;; articles on the line between this one and the last one.
+ (let* ((this-line (1+ (count-lines 1 end-point)))
+ (min-line (min this-line start-line))
+ (max-line (max this-line start-line)))
+ (while (< min-line max-line)
+ (goto-line min-line)
+ (gnus-pick-article)
+ (setq min-line (1+ min-line)))
+ (setq start-line this-line))
+ (when (zerop (% click-count 3))
+ (setq end-of-range (point))))
+ (t
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
+ (cond
+ ((null mouse-row))
+ ((< mouse-row top)
+ (mouse-scroll-subr start-window (- mouse-row top)))
+ ((>= mouse-row bottom)
+ (mouse-scroll-subr start-window
+ (1+ (- mouse-row bottom)))))))))))
(when (consp event)
(let ((fun (key-binding (vector (car event)))))
;; Run the binding of the terminating up-event, if possible.
- ;; In the case of a multiple click, it gives the wrong results,
+ ;; In the case of a multiple click, it gives the wrong results,
;; because it would fail to set up a region.
(when nil
- ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
- ;; In this case, we can just let the up-event execute normally.
+ ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ ;; In this case, we can just let the up-event execute normally.
(let ((end (event-end event)))
;; Set the position in the event before we replay it,
;; because otherwise it may have a position in the wrong
;; buffer.
(setcar (cdr end) end-of-range)
;; Delete the overlay before calling the function,
- ;; because delete-overlay increases buffer-modified-tick.
+ ;; because delete-overlay increases buffer-modified-tick.
(push event unread-command-events))))))))
(defun gnus-pick-next-page ()
@@ -333,9 +340,9 @@ This must be bound to a button-down mouse event."
(defun gnus-binary-make-menu-bar ()
(unless (boundp 'gnus-binary-menu)
(easy-menu-define
- gnus-binary-menu gnus-binary-mode-map ""
- '("Pick"
- ["Switch binary mode off" gnus-binary-mode t]))))
+ gnus-binary-menu gnus-binary-mode-map ""
+ '("Pick"
+ ["Switch binary mode off" gnus-binary-mode t]))))
(defun gnus-binary-mode (&optional arg)
"Minor mode for providing a binary group interface in Gnus summary buffers."
@@ -361,7 +368,7 @@ This must be bound to a button-down mouse event."
(defun gnus-binary-display-article (article &optional all-header)
"Run ARTICLE through the binary decode functions."
(when (gnus-summary-goto-subject article)
- (let ((gnus-view-pseudos 'automatic))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu))))
(defun gnus-binary-show-article (&optional arg)
@@ -418,6 +425,11 @@ Two predefined functions are available:
:type 'hook
:group 'gnus-summary-tree)
+(when (featurep 'xemacs)
+ (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add)
+ (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off))
+
+
;;; Internal variables.
(defvar gnus-tree-line-format-alist
@@ -460,9 +472,9 @@ Two predefined functions are available:
(defun gnus-tree-make-menu-bar ()
(unless (boundp 'gnus-tree-menu)
(easy-menu-define
- gnus-tree-menu gnus-tree-mode-map ""
- '("Tree"
- ["Select article" gnus-tree-select-article t]))))
+ gnus-tree-menu gnus-tree-mode-map ""
+ '("Tree"
+ ["Select article" gnus-tree-select-article t]))))
(defun gnus-tree-mode ()
"Major mode for displaying thread trees."
@@ -543,7 +555,7 @@ Two predefined functions are available:
(defun gnus-tree-recenter ()
"Center point in the tree window."
(let ((selected (selected-window))
- (tree-window (get-buffer-window gnus-tree-buffer t)))
+ (tree-window (gnus-get-buffer-window gnus-tree-buffer t)))
(when tree-window
(select-window tree-window)
(when gnus-selected-tree-overlay
@@ -555,7 +567,7 @@ Two predefined functions are available:
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
(point))))
- ;; Set the window start to either `bottom', which is the biggest
+ ;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
@@ -656,6 +668,10 @@ Two predefined functions are available:
(let* ((score (or (cdr (assq article gnus-newsgroup-scored))
gnus-summary-default-score 0))
(default gnus-summary-default-score)
+ (default-high gnus-summary-default-high-score)
+ (default-low gnus-summary-default-low-score)
+ (uncached (memq article gnus-newsgroup-undownloaded))
+ (downloaded (not uncached))
(mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
;; Eval the cars of the lists until we find a match.
(while (and list
@@ -686,8 +702,8 @@ Two predefined functions are available:
(gnus-tree-minimize)
(gnus-tree-recenter)
(let ((selected (selected-window)))
- (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
- (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t))
(gnus-horizontal-recenter)
(select-window selected))))))
@@ -825,6 +841,13 @@ Two predefined functions are available:
(defun gnus-tree-close (group)
(gnus-kill-buffer gnus-tree-buffer))
+(defun gnus-tree-perhaps-minimize ()
+ (when (and gnus-tree-minimize-window
+ (get-buffer gnus-tree-buffer))
+ (save-excursion
+ (set-buffer gnus-tree-buffer)
+ (gnus-tree-minimize))))
+
(defun gnus-highlight-selected-tree (article)
"Highlight the selected article in the tree."
(let ((buf (current-buffer))
@@ -843,11 +866,11 @@ Two predefined functions are available:
(gnus-tree-minimize)
(gnus-tree-recenter)
(let ((selected (selected-window)))
- (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
- (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t))
(gnus-horizontal-recenter)
(select-window selected))))
- ;; If we remove this save-excursion, it updates the wrong mode lines?!?
+;; If we remove this save-excursion, it updates the wrong mode lines?!?
(save-excursion
(set-buffer gnus-tree-buffer)
(gnus-set-mode-line 'tree))
@@ -860,7 +883,7 @@ Two predefined functions are available:
(when (setq region (gnus-tree-article-region article))
(gnus-put-text-property (car region) (cdr region) 'face face)
(set-window-point
- (get-buffer-window (current-buffer) t) (cdr region))))))
+ (gnus-get-buffer-window (current-buffer) t) (cdr region))))))
;;;
;;; gnus-carpal
@@ -886,6 +909,7 @@ Two predefined functions are available:
("matching" . gnus-group-list-matching)
("post" . gnus-group-post-news)
("mail" . gnus-group-mail)
+ ("local" . (lambda () (interactive) (gnus-group-news 0)))
("rescan" . gnus-group-get-new-news)
("browse-foreign" . gnus-group-browse-foreign)
("exit" . gnus-group-exit)))
@@ -916,7 +940,8 @@ Two predefined functions are available:
("kill" . gnus-summary-kill-thread)
"post"
("post" . gnus-summary-post-news)
- ("mail" . gnus-summary-mail)
+ ("local" . gnus-summary-news-other-window)
+ ("mail" . gnus-summary-mail-other-window)
("followup" . gnus-summary-followup-with-original)
("reply" . gnus-summary-reply-with-original)
("cancel" . gnus-summary-cancel-article)
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 91035d89f2e..de59e862ebc 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1,5 +1,5 @@
;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2004
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
@@ -32,9 +32,12 @@
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-range)
+(require 'gnus-win)
(require 'message)
(require 'score-mode)
+(autoload 'ffap-string-at-point "ffap")
+
(defcustom gnus-global-score-files nil
"List of global score files and directories.
Set this variable if you want to use people's score files. One entry
@@ -47,7 +50,7 @@ score files in the \"/ftp.some-where:/pub/score\" directory.
(setq gnus-global-score-files
'(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
- \"/ftp.some-where:/pub/score\"))"
+ \"/ftp.some-where:/pub/score\"))"
:group 'gnus-score-files
:type '(repeat file))
@@ -232,6 +235,12 @@ This variable allows the same syntax as `gnus-home-score-file'."
(symbol :tag "other"))
(integer :tag "Score"))))))
+(defcustom gnus-adaptive-word-length-limit nil
+ "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
+ :group 'gnus-score-adapt
+ :type '(radio (const :format "Unlimited " nil)
+ (integer :format "Maximum length: %v\n" :size 0)))
+
(defcustom gnus-ignored-adaptive-words nil
"List of words to be ignored when doing adaptive word scoring."
:group 'gnus-score-adapt
@@ -483,7 +492,8 @@ of the last successful match.")
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
permanence, and the string to be used. The numerical prefix will be
-used as score."
+used as score. A symbolic prefix of `a' says to use the `all.SCORE'
+file for the command instead of the current score file."
(interactive (gnus-interactive "P\ny"))
(gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
@@ -497,7 +507,8 @@ used as score."
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
permanence, and the string to be used. The numerical prefix will be
-used as score."
+used as score. A symbolic prefix of `a' says to use the `all.SCORE'
+file for the command instead of the current score file."
(interactive (gnus-interactive "P\ny"))
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
@@ -637,7 +648,7 @@ used as score."
(and gnus-extra-headers
(equal (nth 1 entry) "extra")
(intern ; need symbol
- (gnus-completing-read
+ (gnus-completing-read-with-default
(symbol-name (car gnus-extra-headers)) ; default response
"Score extra header:" ; prompt
(mapcar (lambda (x) ; completion list
@@ -729,13 +740,16 @@ used as score."
(insert (format format (caar alist) (nth idx (car alist))))
(setq alist (cdr alist))
(setq i (1+ i))))
+ (goto-char (point-min))
;; display ourselves in a small window at the bottom
(gnus-appt-select-lowest-window)
- (split-window)
- (pop-to-buffer "*Score Help*")
+ (if (< (/ (window-height) 2) window-min-height)
+ (switch-to-buffer "*Score Help*")
+ (split-window)
+ (pop-to-buffer "*Score Help*"))
(let ((window-min-height 1))
(shrink-window-if-larger-than-buffer))
- (select-window (get-buffer-window gnus-summary-buffer t))))
+ (select-window (gnus-get-buffer-window gnus-summary-buffer t))))
(defun gnus-summary-header (header &optional no-err extra)
;; Return HEADER for current articles, or error.
@@ -863,7 +877,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
;; Return the new scoring rule.
new))
-(defun gnus-summary-score-effect (header match type score extra)
+(defun gnus-summary-score-effect (header match type score &optional extra)
"Simulate the effect of a score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
@@ -875,8 +889,8 @@ EXTRA is the possible non-standard header."
(lambda (x) (fboundp (nth 2 x)))
t)
(read-string "Match: ")
- (y-or-n-p "Use regexp match? ")
- (prefix-numeric-value current-prefix-arg)))
+ (if (y-or-n-p "Use regexp match? ") 'r 's)
+ (string-to-int (read-string "Score: "))))
(save-excursion
(unless (and (stringp match) (> (length match) 0))
(error "No match"))
@@ -926,7 +940,6 @@ EXTRA is the possible non-standard header."
;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-score-set-mark-below (score)
"Automatically mark articles with score below SCORE as read."
(interactive
@@ -1093,6 +1106,39 @@ EXTRA is the possible non-standard header."
4 (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+(defun gnus-score-edit-file-at-point (&optional format)
+ "Edit score file at point in Score Trace buffers.
+If FORMAT, also format the current score file."
+ (let* ((rule (save-excursion
+ (beginning-of-line)
+ (read (current-buffer))))
+ (sep "[ \n\r\t]*")
+ ;; Must be synced with `gnus-score-find-trace':
+ (reg " -> +")
+ (file (save-excursion
+ (end-of-line)
+ (if (and (re-search-backward reg (gnus-point-at-bol) t)
+ (re-search-forward reg (gnus-point-at-eol) t))
+ (buffer-substring (point) (gnus-point-at-eol))
+ nil))))
+ (if (or (not file)
+ (string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
+ ;; (see `gnus-score-find-trace' and `gnus-score-advanced')
+ (string= "" file))
+ (gnus-error 3 "Can't find a score file in current line.")
+ (gnus-score-edit-file file)
+ (when format
+ (gnus-score-pretty-print))
+ (when (consp rule) ;; the rule exists
+ (setq rule (mapconcat #'(lambda (obj)
+ (regexp-quote (format "%S" obj)))
+ rule
+ sep))
+ (goto-char (point-min))
+ (re-search-forward rule nil t)
+ ;; make it easy to use `kill-sexp':
+ (goto-char (1- (match-beginning 0)))))))
+
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
(let* ((file (expand-file-name
@@ -1143,7 +1189,7 @@ EXTRA is the possible non-standard header."
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
- (orphan (car (gnus-score-get 'orphan alist)))
+ (orphan (car (gnus-score-get 'orphan alist)))
(adapt (gnus-score-get 'adapt alist))
(thread-mark-and-expunge
(car (gnus-score-get 'thread-mark-and-expunge alist)))
@@ -1202,7 +1248,6 @@ EXTRA is the possible non-standard header."
(setq gnus-newsgroup-adaptive t)
adapt)
(t
- ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
gnus-default-adaptive-score-alist)))
(setq gnus-thread-expunge-below
(or thread-mark-and-expunge gnus-thread-expunge-below))
@@ -1366,7 +1411,7 @@ EXTRA is the possible non-standard header."
;; This is a normal score file, so we print it very
;; prettily.
(let ((lisp-mode-syntax-table score-mode-syntax-table))
- (pp score (current-buffer)))))
+ (gnus-pp score))))
(gnus-make-directory (file-name-directory file))
;; If the score file is empty, we delete it.
(if (zerop (buffer-size))
@@ -1428,7 +1473,7 @@ EXTRA is the possible non-standard header."
(headers gnus-newsgroup-headers)
(current-score-file gnus-current-score-file)
entry header new)
- (gnus-message 5 "Scoring...")
+ (gnus-message 7 "Scoring...")
;; Create articles, an alist of the form `(HEADER . SCORE)'.
(while (setq header (pop headers))
;; WARNING: The assq makes the function O(N*S) while it could
@@ -1470,7 +1515,7 @@ EXTRA is the possible non-standard header."
(with-current-buffer gnus-summary-buffer
(setq gnus-newsgroup-scored scored))))
;; Remove the buffer.
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
;; Add articles to `gnus-newsgroup-scored'.
(while gnus-scores-articles
@@ -1489,7 +1534,7 @@ EXTRA is the possible non-standard header."
(gnus-score-advanced (car score) trace))
(pop score))))
- (gnus-message 5 "Scoring...done"))))))
+ (gnus-message 7 "Scoring...done"))))))
(defun gnus-score-lower-thread (thread score-adjust)
"Lower the score on THREAD with SCORE-ADJUST.
@@ -1516,21 +1561,19 @@ A root is an article with no references. An orphan is an article
which has references, but is not connected via its references to a
root article. This function finds all the orphans, and adjusts their
score in `gnus-newsgroup-scored' by SCORE."
- (let ((threads (gnus-make-threads)))
- ;; gnus-make-threads produces a list, where each entry is a "thread"
- ;; as described in the gnus-score-lower-thread docs. This function
- ;; will be called again (after limiting has been done) if the display
- ;; is threaded. It would be nice to somehow save this info and use
- ;; it later.
- (while threads
- (let* ((thread (car threads))
- (id (aref (car thread) gnus-score-index)))
- ;; If the parent of the thread is not a root, lower the score of
- ;; it and its descendants. Note that some roots seem to satisfy
- ;; (eq id nil) and some (eq id ""); not sure why.
- (if (and id (not (string= id "")))
- (gnus-score-lower-thread thread score)))
- (setq threads (cdr threads)))))
+ ;; gnus-make-threads produces a list, where each entry is a "thread"
+ ;; as described in the gnus-score-lower-thread docs. This function
+ ;; will be called again (after limiting has been done) if the display
+ ;; is threaded. It would be nice to somehow save this info and use
+ ;; it later.
+ (dolist (thread (gnus-make-threads))
+ (let ((id (aref (car thread) gnus-score-index)))
+ ;; If the parent of the thread is not a root, lower the score of
+ ;; it and its descendants. Note that some roots seem to satisfy
+ ;; (eq id nil) and some (eq id ""); not sure why.
+ (when (and id
+ (not (string= id "")))
+ (gnus-score-lower-thread thread score)))))
(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
@@ -1718,7 +1761,8 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq found t)
(when trace
(push
- (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ (cons (car-safe (rassq alist gnus-score-cache))
+ kill)
gnus-score-trace)))
;; Update expire date
(unless trace
@@ -1776,7 +1820,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(put-text-property (1- (point)) (point) 'articles alike))
(setq alike (list art)
last this)))
- (when last ; Bwadr, duplicate code.
+ (when last ; Bwadr, duplicate code.
(insert last ?\n)
(put-text-property (1- (point)) (point) 'articles alike))
@@ -1785,7 +1829,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq alist (car scores)
scores (cdr scores)
entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
+ (while (cdr entries) ;First entry is the header index.
(let* ((rest (cdr entries))
(kill (car rest))
(match (nth 0 kill))
@@ -1805,7 +1849,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(goto-char (point-min))
(if (= dmt ?e)
(while (funcall search-func match nil t)
- (and (= (progn (beginning-of-line) (point))
+ (and (= (gnus-point-at-bol)
(match-beginning 0))
(= (progn (end-of-line) (point))
(match-end 0))
@@ -1824,6 +1868,12 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq found (setq arts (get-text-property (point) 'articles)))
;; Found a match, update scores.
(while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))
+ (when trace
+ (push (cons
+ (car-safe (rassq alist gnus-score-cache))
+ kill)
+ gnus-score-trace))
(when (setq new (gnus-score-add-followups
(car art) score all-scores thread))
(push new news)))))
@@ -1871,8 +1921,8 @@ score in `gnus-newsgroup-scored' by SCORE."
;; Insert the unique article headers in the buffer.
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
;; gnus-score-index is used as a free variable.
- (simplify (and gnus-score-thread-simplify
- (string= "subject" header)))
+ (simplify (and gnus-score-thread-simplify
+ (string= "subject" header)))
alike last this art entries alist articles
fuzzies arts words kill)
@@ -1897,7 +1947,7 @@ score in `gnus-newsgroup-scored' by SCORE."
;; with working on them as a group. What a hassle.
;; Just wait 'til you see what horrors we commit against `match'...
(if (= gnus-score-index 9)
- (setq this (prin1-to-string this))) ; ick.
+ (setq this (gnus-prin1-to-string this))) ; ick.
(if simplify
(setq this (gnus-map-function gnus-simplify-subject-functions this)))
@@ -1936,10 +1986,10 @@ score in `gnus-newsgroup-scored' by SCORE."
(dmt (downcase mt))
;; Assume user already simplified regexp and fuzzies
(match (if (and simplify (not (memq dmt '(?f ?r))))
- (gnus-map-function
- gnus-simplify-subject-functions
- (nth 0 kill))
- (nth 0 kill)))
+ (gnus-map-function
+ gnus-simplify-subject-functions
+ (nth 0 kill))
+ (nth 0 kill)))
(search-func
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
@@ -1949,7 +1999,7 @@ score in `gnus-newsgroup-scored' by SCORE."
;; Evil hackery to make match usable in non-standard headers.
(when extra
(setq match (concat "[ (](" extra " \\. \"[^)]*"
- match "[^(]*\")[ )]")
+ match "[^\"]*\")[ )]")
search-func 're-search-forward)) ; XXX danger?!?
(cond
@@ -2275,11 +2325,14 @@ score in `gnus-newsgroup-scored' by SCORE."
;; Put the word and score into the hashtb.
(setq val (gnus-gethash (setq word (match-string 0))
hashtb))
- (setq val (+ score (or val 0)))
- (if (and gnus-adaptive-word-minimum
- (< val gnus-adaptive-word-minimum))
- (setq val gnus-adaptive-word-minimum))
- (gnus-sethash word val hashtb))
+ (when (or (not gnus-adaptive-word-length-limit)
+ (> (length word)
+ gnus-adaptive-word-length-limit))
+ (setq val (+ score (or val 0)))
+ (if (and gnus-adaptive-word-minimum
+ (< val gnus-adaptive-word-minimum))
+ (setq val gnus-adaptive-word-minimum))
+ (gnus-sethash word val hashtb)))
(erase-buffer))))
(set-syntax-table syntab))
;; Make all the ignorable words ignored.
@@ -2318,7 +2371,10 @@ score in `gnus-newsgroup-scored' by SCORE."
(let ((gnus-newsgroup-headers
(list (gnus-summary-article-header)))
(gnus-newsgroup-scored nil)
- trace)
+ ;; Must be synced with `gnus-score-edit-file-at-point':
+ (frmt "%S [%s] -> %s\n")
+ trace
+ file)
(save-excursion
(nnheader-set-temp-buffer "*Score Trace*"))
(setq gnus-score-trace nil)
@@ -2328,11 +2384,44 @@ score in `gnus-newsgroup-scored' by SCORE."
1 "No score rules apply to the current article (default score %d)."
gnus-summary-default-score)
(set-buffer "*Score Trace*")
+ ;; Use a keymap instead?
+ (local-set-key "q"
+ (lambda ()
+ (interactive)
+ (bury-buffer nil)
+ (gnus-summary-expand-window)))
+ (local-set-key "e" (lambda ()
+ "Run `gnus-score-edit-file-at-point'."
+ (interactive)
+ (gnus-score-edit-file-at-point)))
+ (local-set-key "f" (lambda ()
+ "Run `gnus-score-edit-file-at-point'."
+ (interactive)
+ (gnus-score-edit-file-at-point 'format)))
+ (local-set-key "t" 'toggle-truncate-lines)
(setq truncate-lines t)
- (while trace
- (insert (format "%S -> %s\n" (cdar trace)
- (or (caar trace) "(non-file rule)")))
- (setq trace (cdr trace)))
+ (dolist (entry trace)
+ (setq file (or (car entry)
+ ;; Must be synced with
+ ;; `gnus-score-edit-file-at-point':
+ "(non-file rule)"))
+ (insert
+ (format frmt
+ (cdr entry)
+ ;; Don't use `file-name-sans-extension' to see .SCORE and
+ ;; .ADAPT directly:
+ (file-name-nondirectory file)
+ (abbreviate-file-name file))))
+ (insert
+ "\n\nQuick help:
+
+Type `e' to edit score file corresponding to the score rule on current line,
+`f' to format (pretty print) the score file and edit it,
+`t' toggle to truncate long lines in this buffer,
+`q' to quit.
+
+The first sexp on each line is the score rule, followed by the file name of
+the score file and its full name, including the directory.")
(goto-char (point-min))
(gnus-configure-windows 'score-trace)))
(set-buffer gnus-summary-buffer)
@@ -2460,7 +2549,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(defun gnus-summary-lower-thread (&optional score)
"Lower score of articles in the current thread with SCORE."
(interactive "P")
- (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score)))))
+ (gnus-summary-raise-thread (- (gnus-score-delta-default score))))
;;; Finding score files.
@@ -2522,7 +2611,8 @@ score in `gnus-newsgroup-scored' by SCORE."
(push file out))))
(or out
;; Return a dummy value.
- (list "~/News/this.file.does.not.exist.SCORE"))))
+ (list (expand-file-name "this.file.does.not.exist.SCORE"
+ gnus-kill-files-directory)))))
(defun gnus-score-file-regexp ()
"Return a regexp that match all score files."
@@ -2586,11 +2676,13 @@ GROUP using BNews sys file syntax."
(replace-match ".*" t t))
(goto-char (point-min))
;; Deal with "not."s.
- (setq not-match (looking-at "not."))
- (setq regexp
- (concat "^" (buffer-substring (+ (point-min) (if not-match 4 0))
- (point-max))
- "$"))
+ (if (looking-at "not.")
+ (progn
+ (setq not-match t)
+ (setq regexp
+ (concat "^" (buffer-substring 5 (point-max)) "$")))
+ (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
+ (setq not-match nil))
;; Finally - if this resulting regexp matches the group name,
;; we add this score file to the list of score files
;; applicable to this group.
@@ -2601,7 +2693,7 @@ GROUP using BNews sys file syntax."
(ignore-errors (string-match regexp group-trans))))
(push (car sfiles) ofiles)))
(setq sfiles (cdr sfiles)))
- (kill-buffer (current-buffer))
+ (gnus-kill-buffer (current-buffer))
;; Slight kludge here - the last score file returned should be
;; the local score file, whether it exists or not. This is so
;; that any score commands the user enters will go to the right
@@ -2733,9 +2825,10 @@ The list is determined from the variable `gnus-score-file-alist'."
;; Go through all the functions for finding score files (or actual
;; scores) and add them to a list.
(while funcs
- (when (gnus-functionp (car funcs))
+ (when (functionp (car funcs))
(setq score-files
- (nconc score-files (nreverse (funcall (car funcs) group)))))
+ (append score-files
+ (nreverse (funcall (car funcs) group)))))
(setq funcs (cdr funcs)))
(when gnus-score-use-all-scores
;; Add any home score files.
@@ -2800,7 +2893,7 @@ The list is determined from the variable `gnus-score-file-alist'."
(let (out)
(while files
;; #### /$ Unix-specific?
- (if (string-match "/$" (car files))
+ (if (file-directory-p (car files))
(setq out (nconc (directory-files
(car files) t
(concat (gnus-score-file-regexp) "$"))))
@@ -2835,16 +2928,17 @@ If ADAPT, return the home adaptive file instead."
((stringp elem)
elem)
;; Function.
- ((gnus-functionp elem)
+ ((functionp elem)
(funcall elem group))
;; Regexp-file cons.
((consp elem)
(when (string-match (gnus-globalify-regexp (car elem)) group)
(replace-match (cadr elem) t nil group))))))
(when found
+ (setq found (nnheader-translate-file-chars found))
(if (file-name-absolute-p found)
- found
- (nnheader-concat gnus-kill-files-directory found)))))
+ found
+ (nnheader-concat gnus-kill-files-directory found)))))
(defun gnus-hierarchial-home-score-file (group)
"Return the score file of the top-level hierarchy of GROUP."
@@ -2872,13 +2966,19 @@ If ADAPT, return the home adaptive file instead."
(defun gnus-decay-score (score)
"Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
- (floor
- (- score
- (* (if (< score 0) -1 1)
- (min (abs score)
- (max gnus-score-decay-constant
- (* (abs score)
- gnus-score-decay-scale)))))))
+ (let ((n (- score
+ (* (if (< score 0) -1 1)
+ (min (abs score)
+ (max gnus-score-decay-constant
+ (* (abs score)
+ gnus-score-decay-scale)))))))
+ (if (and (featurep 'xemacs)
+ ;; XEmacs' floor can handle only the floating point
+ ;; number below the half of the maximum integer.
+ (> (abs n) (lsh -1 -2)))
+ (string-to-number
+ (car (split-string (number-to-string n) "\\.")))
+ (floor n))))
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
@@ -2911,7 +3011,7 @@ In the `new' case, the string is a safe replacement for REGEXP.
In the `bad' case, the string is a unsafe subexpression of REGEXP,
and we do not have a simple replacement to suggest.
-See `(Gnus)Scoring Tips' for examples of good regular expressions."
+See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
(let (case-fold-search)
(and
;; First, try a relatively fast necessary condition.
diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el
index 1c8bb7c0f9e..11ecee18bbc 100644
--- a/lisp/gnus/gnus-setup.el
+++ b/lisp/gnus/gnus-setup.el
@@ -1,6 +1,7 @@
-;;; gnus-setup.el --- initialization & setup for Gnus 5
+;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-;; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Steven L. Baur <steve@miranova.com>
;; Keywords: news
@@ -89,8 +90,8 @@
(setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
(autoload 'mc-install-write-mode "mailcrypt" nil t)
(autoload 'mc-install-read-mode "mailcrypt" nil t)
- (add-hook 'message-mode-hook 'mc-install-write-mode)
- (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
+;;; (add-hook 'message-mode-hook 'mc-install-write-mode)
+;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
(when gnus-use-mhe
(add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
(add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
new file mode 100644
index 00000000000..e7409c39df0
--- /dev/null
+++ b/lisp/gnus/gnus-sieve.el
@@ -0,0 +1,240 @@
+;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: NAGY Andras <nagya@inf.elte.hu>,
+;; Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Gnus glue to generate complete Sieve scripts from Gnus Group
+;; Parameters with "if" test predicates.
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-sum)
+(require 'format-spec)
+(autoload 'sieve-mode "sieve-mode")
+(eval-when-compile
+ (require 'sieve))
+
+;; Variables
+
+(defgroup gnus-sieve nil
+ "Manage sieve scripts in Gnus."
+ :group 'gnus)
+
+(defcustom gnus-sieve-file "~/.sieve"
+ "Path to your Sieve script."
+ :type 'file
+ :group 'gnus-sieve)
+
+(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n"
+ "Line indicating the start of the autogenerated region in
+your Sieve script."
+ :type 'string
+ :group 'gnus-sieve)
+
+(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n"
+ "Line indicating the end of the autogenerated region in
+your Sieve script."
+ :type 'string
+ :group 'gnus-sieve)
+
+(defcustom gnus-sieve-select-method nil
+ "Which select method we generate the Sieve script for.
+
+For example: \"nnimap:mailbox\""
+ :group 'gnus-sieve)
+
+(defcustom gnus-sieve-crosspost t
+ "Whether the generated Sieve script should do crossposting."
+ :type 'boolean
+ :group 'gnus-sieve)
+
+(defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s"
+ "Shell command to execute after updating your Sieve script. The following
+formatting characters are recognized:
+
+%f Script's file name (gnus-sieve-file)
+%s Server name (from gnus-sieve-select-method)"
+ :type 'string
+ :group 'gnus-sieve)
+
+;;;###autoload
+(defun gnus-sieve-update ()
+ "Update the Sieve script in gnus-sieve-file, by replacing the region
+between gnus-sieve-region-start and gnus-sieve-region-end with
+\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then
+execute gnus-sieve-update-shell-command.
+See the documentation for these variables and functions for details."
+ (interactive)
+ (gnus-sieve-generate)
+ (save-buffer)
+ (shell-command
+ (format-spec gnus-sieve-update-shell-command
+ (format-spec-make ?f gnus-sieve-file
+ ?s (or (cadr (gnus-server-get-method
+ nil gnus-sieve-select-method))
+ "")))))
+
+;;;###autoload
+(defun gnus-sieve-generate ()
+ "Generate the Sieve script in gnus-sieve-file, by replacing the region
+between gnus-sieve-region-start and gnus-sieve-region-end with
+\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\).
+See the documentation for these variables and functions for details."
+ (interactive)
+ (require 'sieve)
+ (find-file gnus-sieve-file)
+ (goto-char (point-min))
+ (if (re-search-forward (regexp-quote gnus-sieve-region-start) nil t)
+ (delete-region (match-end 0)
+ (or (re-search-forward (regexp-quote
+ gnus-sieve-region-end) nil t)
+ (point)))
+ (insert sieve-template))
+ (insert gnus-sieve-region-start
+ (gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost)
+ gnus-sieve-region-end))
+
+(defun gnus-sieve-guess-rule-for-article ()
+ "Guess a sieve rule based on RFC822 article in buffer.
+Return nil if no rule could be guessed."
+ (when (message-fetch-field "sender")
+ `(sieve address "sender" ,(message-fetch-field "sender"))))
+
+;;;###autoload
+(defun gnus-sieve-article-add-rule ()
+ (interactive)
+ (gnus-summary-select-article nil 'force)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((rule (gnus-sieve-guess-rule-for-article))
+ (info (gnus-get-info gnus-newsgroup-name)))
+ (if (null rule)
+ (error "Could not guess rule for article.")
+ (gnus-info-set-params info (cons rule (gnus-info-params info)))
+ (message "Added rule in group %s for article: %s" gnus-newsgroup-name
+ rule)))))
+
+;; Internals
+
+;; FIXME: do proper quoting of " etc
+(defun gnus-sieve-string-list (list)
+ "Convert an elisp string list to a Sieve string list.
+
+For example:
+\(gnus-sieve-string-list '(\"to\" \"cc\"))
+ => \"[\\\"to\\\", \\\"cc\\\"]\"
+"
+ (concat "[\"" (mapconcat 'identity list "\", \"") "\"]"))
+
+(defun gnus-sieve-test-list (list)
+ "Convert an elisp test list to a Sieve test list.
+
+For example:
+\(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K)))
+ => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\""
+ (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")"))
+
+;; FIXME: do proper quoting
+(defun gnus-sieve-test-token (token)
+ "Convert an elisp test token to a Sieve test token.
+
+For example:
+\(gnus-sieve-test-token 'address)
+ => \"address\"
+
+\(gnus-sieve-test-token \"sender\")
+ => \"\\\"sender\\\"\"
+
+\(gnus-sieve-test-token '(\"to\" \"cc\"))
+ => \"[\\\"to\\\", \\\"cc\\\"]\""
+ (cond
+ ((symbolp token) ;; Keyword
+ (symbol-name token))
+
+ ((stringp token) ;; String
+ (concat "\"" token "\""))
+
+ ((and (listp token) ;; String list
+ (stringp (car token)))
+ (gnus-sieve-string-list token))
+
+ ((and (listp token) ;; Test list
+ (listp (car token)))
+ (gnus-sieve-test-list token))))
+
+(defun gnus-sieve-test (test)
+ "Convert an elisp test to a Sieve test.
+
+For example:
+\(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\"))
+ => \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\"
+
+\(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\")
+ (size :over 100K))))
+ => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\",
+ size :over 100K)\""
+ (mapconcat 'gnus-sieve-test-token test " "))
+
+(defun gnus-sieve-script (&optional method crosspost)
+ "Generate a Sieve script based on groups with select method METHOD
+\(or all groups if nil\). Only groups having a `sieve' parameter are
+considered. This parameter should contain an elisp test
+\(see the documentation of gnus-sieve-test for details\). For each
+such group, a Sieve IF control structure is generated, having the
+test as the condition and { fileinto \"group.name\"; } as the body.
+
+If CROSSPOST is nil, each conditional body contains a \"stop\" command
+which stops execution after a match is found.
+
+For example: If the INBOX.list.sieve group has the
+
+ (sieve address \"sender\" \"sieve-admin@extundo.com\")
+
+group parameter, (gnus-sieve-script) results in:
+
+ if address \"sender\" \"sieve-admin@extundo.com\" {
+ fileinto \"INBOX.list.sieve\";
+ }
+
+This is returned as a string."
+ (let* ((newsrc (cdr gnus-newsrc-alist))
+ script)
+ (dolist (info newsrc)
+ (when (or (not method)
+ (gnus-server-equal method (gnus-info-method info)))
+ (let* ((group (gnus-info-group info))
+ (spec (gnus-group-find-parameter group 'sieve t)))
+ (when spec
+ (push (concat "if " (gnus-sieve-test spec) " {\n"
+ "\tfileinto \"" (gnus-group-real-name group) "\";\n"
+ (if crosspost
+ ""
+ "\tstop;\n")
+ "}")
+ script)))))
+ (mapconcat 'identity script "\n")))
+
+(provide 'gnus-sieve)
+
+;;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3
+;;; gnus-sieve.el ends here
diff --git a/lisp/gnus/gnus-soup.el b/lisp/gnus/gnus-soup.el
index c02e23e9eae..55dc1635542 100644
--- a/lisp/gnus/gnus-soup.el
+++ b/lisp/gnus/gnus-soup.el
@@ -1,6 +1,6 @@
;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
@@ -154,11 +154,11 @@ move those articles instead."
gnus-soup-encoding-type
gnus-soup-index-type)
(gnus-soup-area-set-number
- area (1+ (or (gnus-soup-area-number area) 0))))
- ;; Mark article as read.
- (set-buffer gnus-summary-buffer)
+ area (1+ (or (gnus-soup-area-number area) 0)))
+ ;; Mark article as read.
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
(gnus-summary-remove-process-mark (car articles))
- (gnus-summary-mark-as-read (car articles) gnus-souped-mark)
(setq articles (cdr articles)))
(kill-buffer tmp-buf))
(gnus-soup-save-areas)
@@ -357,9 +357,9 @@ If NOT-ALL, don't pack ticked articles."
(gnus-make-directory dir)
(setq gnus-soup-areas nil)
(gnus-message 4 "Packing %s..." packer)
- (if (zerop (call-process shell-file-name
- nil nil nil shell-command-switch
- (concat "cd " dir " ; " packer)))
+ (if (eq 0 (call-process shell-file-name
+ nil nil nil shell-command-switch
+ (concat "cd " dir " ; " packer)))
(progn
(call-process shell-file-name nil nil nil shell-command-switch
(concat "cd " dir " ; rm " files))
@@ -496,10 +496,10 @@ Return whether the unpacking was successful."
(gnus-make-directory dir)
(gnus-message 4 "Unpacking: %s" (format unpacker packet))
(prog1
- (zerop (call-process
- shell-file-name nil nil nil shell-command-switch
- (format "cd %s ; %s" (expand-file-name dir)
- (format unpacker packet))))
+ (eq 0 (call-process
+ shell-file-name nil nil nil shell-command-switch
+ (format "cd %s ; %s" (expand-file-name dir)
+ (format unpacker packet))))
(gnus-message 4 "Unpacking...done")))
(defun gnus-soup-send-packet (packet)
@@ -540,26 +540,35 @@ Return whether the unpacking was successful."
(match-beginning 1) (match-end 1)))))
(switch-to-buffer tmp-buf)
(erase-buffer)
+ (mm-disable-multibyte)
(insert-buffer-substring msg-buf beg end)
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (insert mail-header-separator)
- (setq message-newsreader (setq message-mailer
- (gnus-extended-version)))
(cond
((string= (gnus-soup-reply-kind (car replies)) "news")
(gnus-message 5 "Sending news message to %s..."
(mail-fetch-field "newsgroups"))
(sit-for 1)
(let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function)))
+ 'dont-check-for-anything-just-trust-me)
+ (method (if (functionp message-post-method)
+ (funcall message-post-method)
+ message-post-method))
+ result)
+ (run-hooks 'message-send-news-hook)
+ (gnus-open-server method)
+ (message "Sending news via %s..."
+ (gnus-server-string method))
+ (unless (let ((mail-header-separator ""))
+ (gnus-request-post method))
+ (message "Couldn't send message via news: %s"
+ (nnheader-get-report (car method))))))
((string= (gnus-soup-reply-kind (car replies)) "mail")
(gnus-message 5 "Sending mail to %s..."
(mail-fetch-field "to"))
(sit-for 1)
- (message-send-mail))
+ (let ((mail-header-separator ""))
+ (mm-with-unibyte-current-buffer
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function)))))
(t
(error "Unknown reply kind")))
(set-buffer msg-buf)
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 9daf599c076..690fc7e026a 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -1,5 +1,5 @@
-;;; gnus-spec.el --- format spec functions for Gnus -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;; gnus-spec.el --- format spec functions for Gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -30,6 +30,17 @@
(require 'gnus)
+(defcustom gnus-use-correct-string-widths (featurep 'xemacs)
+ "*If non-nil, use correct functions for dealing with wide characters."
+ :group 'gnus-format
+ :type 'boolean)
+
+(defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
+ "*If non-nil, use a replacement `format' function which preserves
+text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
+ :group 'gnus-format
+ :type 'boolean)
+
;;; Internal variables.
(defvar gnus-summary-mark-positions nil)
@@ -69,6 +80,8 @@
(defvar gnus-tmp-article-number)
(defvar gnus-mouse-face)
(defvar gnus-mouse-face-prop)
+(defvar gnus-tmp-header)
+(defvar gnus-tmp-from)
(defun gnus-summary-line-format-spec ()
(insert gnus-tmp-unread gnus-tmp-replied
@@ -77,13 +90,15 @@
(point)
(progn
(insert
- gnus-tmp-opening-bracket
- (format "%4d: %-20s"
- gnus-tmp-lines
- (if (> (length gnus-tmp-name) 20)
- (substring gnus-tmp-name 0 20)
- gnus-tmp-name))
- gnus-tmp-closing-bracket)
+ (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
+ (let ((val
+ (inline
+ (gnus-summary-from-or-to-or-newsgroups
+ gnus-tmp-header gnus-tmp-from))))
+ (if (> (length val) 23)
+ (substring val 0 23)
+ val))
+ gnus-tmp-closing-bracket))
(point))
gnus-mouse-face-prop gnus-mouse-face)
(insert " " gnus-tmp-subject-or-nil "\n"))
@@ -120,18 +135,21 @@
(defvar gnus-format-specs
`((version . ,emacs-version)
+ (gnus-version . ,(gnus-continuum-version))
(group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
(summary-dummy "* %(: :%) %S\n"
,gnus-summary-dummy-line-format-spec)
- (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
,gnus-summary-line-format-spec))
"Alist of format specs.")
+(defvar gnus-default-format-specs gnus-format-specs)
+
(defvar gnus-article-mode-line-format-spec nil)
(defvar gnus-summary-mode-line-format-spec nil)
(defvar gnus-group-mode-line-format-spec nil)
-;;; Phew. All that gruft is over, fortunately.
+;;; Phew. All that gruft is over with, fortunately.
;;;###autoload
(defun gnus-update-format (var)
@@ -162,13 +180,16 @@
(pop-to-buffer "*Gnus Format*")
(erase-buffer)
(lisp-interaction-mode)
- (insert (pp-to-string spec))))
+ (insert (gnus-pp-to-string spec))))
(defun gnus-update-format-specifications (&optional force &rest types)
"Update all (necessary) format specifications."
;; Make the indentation array.
;; See whether all the stored info needs to be flushed.
(when (or force
+ (not gnus-newsrc-file-version)
+ (not (equal (gnus-continuum-version)
+ (gnus-continuum-version gnus-newsrc-file-version)))
(not (equal emacs-version
(cdr (assq 'version gnus-format-specs)))))
(setq gnus-format-specs nil))
@@ -176,8 +197,8 @@
;; Go through all the formats and see whether they need updating.
(let (new-format entry type val)
(while (setq type (pop types))
- ;; Jump to the proper buffer to find out the value of
- ;; the variable, if possible. (It may be buffer-local.)
+ ;; Jump to the proper buffer to find out the value of the
+ ;; variable, if possible. (It may be buffer-local.)
(save-excursion
(let ((buffer (intern (format "gnus-%s-buffer" type)))
val)
@@ -243,39 +264,109 @@
(defun gnus-balloon-face-function (form type)
`(gnus-put-text-property
(point) (progn ,@form (point))
- 'balloon-help
+ ,(if (fboundp 'balloon-help-mode)
+ ''balloon-help
+ ''help-echo)
,(intern (format "gnus-balloon-face-%d" type))))
+(defun gnus-spec-tab (column)
+ (if (> column 0)
+ `(insert (make-string (max (- ,column (current-column)) 0) ? ))
+ (let ((column (abs column)))
+ (if gnus-use-correct-string-widths
+ `(progn
+ (if (> (current-column) ,column)
+ (while (progn
+ (delete-backward-char 1)
+ (> (current-column) ,column))))
+ (insert (make-string (max (- ,column (current-column)) 0) ? )))
+ `(progn
+ (if (> (current-column) ,column)
+ (delete-region (point)
+ (- (point) (- (current-column) ,column)))
+ (insert (make-string (max (- ,column (current-column)) 0)
+ ? ))))))))
+
+(defun gnus-correct-length (string)
+ "Return the correct width of STRING."
+ (let ((length 0))
+ (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
+ length))
+
+(defun gnus-correct-substring (string start &optional end)
+ (let ((wstart 0)
+ (wend 0)
+ (wseek 0)
+ (seek 0)
+ (length (length string))
+ (string (concat string "\0")))
+ ;; Find the start position.
+ (while (and (< seek length)
+ (< wseek start))
+ (incf wseek (gnus-char-width (aref string seek)))
+ (incf seek))
+ (setq wstart seek)
+ ;; Find the end position.
+ (while (and (<= seek length)
+ (or (not end)
+ (<= wseek end)))
+ (incf wseek (gnus-char-width (aref string seek)))
+ (incf seek))
+ (setq wend seek)
+ (substring string wstart (1- wend))))
+
+(defun gnus-string-width-function ()
+ (cond
+ (gnus-use-correct-string-widths
+ 'gnus-correct-length)
+ ((fboundp 'string-width)
+ 'string-width)
+ (t
+ 'length)))
+
+(defun gnus-substring-function ()
+ (cond
+ (gnus-use-correct-string-widths
+ 'gnus-correct-substring)
+ ((fboundp 'string-width)
+ 'gnus-correct-substring)
+ (t
+ 'substring)))
+
(defun gnus-tilde-max-form (el max-width)
"Return a form that limits EL to MAX-WIDTH."
- (let ((max (abs max-width)))
+ (let ((max (abs max-width))
+ (length-fun (gnus-string-width-function))
+ (substring-fun (gnus-substring-function)))
(if (symbolp el)
- `(if (> (length ,el) ,max)
+ `(if (> (,length-fun ,el) ,max)
,(if (< max-width 0)
- `(substring ,el (- (length el) ,max))
- `(substring ,el 0 ,max))
+ `(,substring-fun ,el (- (,length-fun ,el) ,max))
+ `(,substring-fun ,el 0 ,max))
,el)
`(let ((val (eval ,el)))
- (if (> (length val) ,max)
+ (if (> (,length-fun val) ,max)
,(if (< max-width 0)
- `(substring val (- (length val) ,max))
- `(substring val 0 ,max))
+ `(,substring-fun val (- (,length-fun val) ,max))
+ `(,substring-fun val 0 ,max))
val)))))
(defun gnus-tilde-cut-form (el cut-width)
"Return a form that cuts CUT-WIDTH off of EL."
- (let ((cut (abs cut-width)))
+ (let ((cut (abs cut-width))
+ (length-fun (gnus-string-width-function))
+ (substring-fun (gnus-substring-function)))
(if (symbolp el)
- `(if (> (length ,el) ,cut)
+ `(if (> (,length-fun ,el) ,cut)
,(if (< cut-width 0)
- `(substring ,el 0 (- (length el) ,cut))
- `(substring ,el ,cut))
+ `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut))
+ `(,substring-fun ,el ,cut))
,el)
`(let ((val (eval ,el)))
- (if (> (length val) ,cut)
+ (if (> (,length-fun val) ,cut)
,(if (< cut-width 0)
- `(substring val 0 (- (length val) ,cut))
- `(substring val ,cut))
+ `(,substring-fun val 0 (- (,length-fun val) ,cut))
+ `(,substring-fun val ,cut))
val)))))
(defun gnus-tilde-ignore-form (el ignore-value)
@@ -287,6 +378,28 @@
(if (equal val ,ignore-value)
"" val))))
+(defun gnus-pad-form (el pad-width)
+ "Return a form that pads EL to PAD-WIDTH accounting for multi-column
+characters correctly. This is because `format' may pad to columns or to
+characters when given a pad value."
+ (let ((pad (abs pad-width))
+ (side (< 0 pad-width))
+ (length-fun (gnus-string-width-function)))
+ (if (symbolp el)
+ `(let ((need (- ,pad (,length-fun ,el))))
+ (if (> need 0)
+ (concat ,(when side '(make-string need ?\ ))
+ ,el
+ ,(when (not side) '(make-string need ?\ )))
+ ,el))
+ `(let* ((val (eval ,el))
+ (need (- ,pad (,length-fun val))))
+ (if (> need 0)
+ (concat ,(when side '(make-string need ?\ ))
+ val
+ ,(when (not side) '(make-string need ?\ )))
+ val)))))
+
(defun gnus-parse-format (format spec-alist &optional insert)
;; This function parses the FORMAT string with the help of the
;; SPEC-ALIST and returns a list that can be eval'ed to return the
@@ -294,52 +407,115 @@
;; the text between them will have the mouse-face text property.
;; If the FORMAT string contains the specifiers %[ and %], the text between
;; them will have the balloon-help text property.
- (if (string-match
- "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'"
- format)
- (gnus-parse-complex-format format spec-alist)
- ;; This is a simple format.
- (gnus-parse-simple-format format spec-alist insert)))
+ (let ((case-fold-search nil))
+ (if (string-match
+ "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*"
+ format)
+ (gnus-parse-complex-format format spec-alist)
+ ;; This is a simple format.
+ (gnus-parse-simple-format format spec-alist insert))))
(defun gnus-parse-complex-format (format spec-alist)
- (save-excursion
- (gnus-set-work-buffer)
- (insert format)
- (goto-char (point-min))
- (while (re-search-forward "\"" nil t)
- (replace-match "\\\"" nil t))
- (goto-char (point-min))
- (insert "(\"")
- (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
- (let ((number (if (match-beginning 1)
- (match-string 1) "0"))
- (delim (aref (match-string 2) 0)))
- (if (or (= delim ?\()
- (= delim ?\{)
- (= delim ?\«))
- (replace-match (concat "\"("
- (cond ((= delim ?\() "mouse")
- ((= delim ?\{) "face")
- (t "balloon"))
- " " number " \""))
- (replace-match "\")\""))))
- (goto-char (point-max))
- (insert "\")")
- (goto-char (point-min))
- (let ((form (read (current-buffer))))
- (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
+ (let ((cursor-spec nil))
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert format)
+ (goto-char (point-min))
+ (while (re-search-forward "\"" nil t)
+ (replace-match "\\\"" nil t))
+ (goto-char (point-min))
+ (insert "(\"")
+ ;; Convert all font specs into font spec lists.
+ (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
+ (let ((number (if (match-beginning 1)
+ (match-string 1) "0"))
+ (delim (aref (match-string 2) 0)))
+ (if (or (= delim ?\()
+ (= delim ?\{)
+ (= delim ?\«))
+ (replace-match (concat "\"("
+ (cond ((= delim ?\() "mouse")
+ ((= delim ?\{) "face")
+ (t "balloon"))
+ " " number " \"")
+ t t)
+ (replace-match "\")\""))))
+ (goto-char (point-max))
+ (insert "\")")
+ ;; Convert point position commands.
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t)
+ (replace-match "\"(point)\"" t t)
+ (setq cursor-spec t)))
+ ;; Convert TAB commands.
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([-0-9]+\\)=" nil t)
+ (replace-match (format "\"(tab %s)\"" (match-string 1)) t t))
+ ;; Convert the buffer into the spec.
+ (goto-char (point-min))
+ (let ((form (read (current-buffer))))
+ (if cursor-spec
+ `(let (gnus-position)
+ ,@(gnus-complex-form-to-spec form spec-alist)
+ (if gnus-position
+ (gnus-put-text-property gnus-position (1+ gnus-position)
+ 'gnus-position t)))
+ `(progn
+ ,@(gnus-complex-form-to-spec form spec-alist)))))))
(defun gnus-complex-form-to-spec (form spec-alist)
(delq nil
(mapcar
(lambda (sform)
- (if (stringp sform)
- (gnus-parse-simple-format sform spec-alist t)
+ (cond
+ ((stringp sform)
+ (gnus-parse-simple-format sform spec-alist t))
+ ((eq (car sform) 'point)
+ '(setq gnus-position (point)))
+ ((eq (car sform) 'tab)
+ (gnus-spec-tab (cadr sform)))
+ (t
(funcall (intern (format "gnus-%s-face-function" (car sform)))
(gnus-complex-form-to-spec (cddr sform) spec-alist)
- (nth 1 sform))))
+ (nth 1 sform)))))
form)))
+
+(defun gnus-xmas-format (fstring &rest args)
+ "A version of `format' which preserves text properties.
+
+Required for XEmacs, where the built in `format' function strips all text
+properties from both the format string and any inserted strings.
+
+Only supports the format sequence %s, and %% for inserting
+literal % characters. A pad width and an optional - (to right pad)
+are supported for %s."
+ (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s")
+ (n (length args)))
+ (with-temp-buffer
+ (insert fstring)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (goto-char (match-end 0))
+ (cond
+ ((string= (match-string 0) "%%")
+ (delete-char -1))
+ (t
+ (if (null args)
+ (error 'wrong-number-of-arguments #'my-format n fstring))
+ (let* ((minlen (string-to-int (or (match-string 2) "")))
+ (arg (car args))
+ (str (if (stringp arg) arg (format "%s" arg)))
+ (lpad (null (match-string 1)))
+ (padlen (max 0 (- minlen (length str)))))
+ (replace-match "")
+ (if lpad (insert-char ?\ padlen))
+ (insert str)
+ (unless lpad (insert-char ?\ padlen))
+ (setq args (cdr args))))))
+ (buffer-string))))
+
(defun gnus-parse-simple-format (format spec-alist &optional insert)
;; This function parses the FORMAT string with the help of the
;; SPEC-ALIST and returns a list that can be eval'ed to return a
@@ -347,7 +523,7 @@
(let ((max-width 0)
spec flist fstring elem result dontinsert user-defined
type value pad-width spec-beg cut-width ignore-value
- tilde-form tilde elem-type)
+ tilde-form tilde elem-type extended-spec)
(save-excursion
(gnus-set-work-buffer)
(insert format)
@@ -359,7 +535,8 @@
max-width nil
cut-width nil
ignore-value nil
- tilde-form nil)
+ tilde-form nil
+ extended-spec nil)
(setq spec-beg (1- (point)))
;; Parse this spec fully.
@@ -400,10 +577,18 @@
t)
(t
nil)))
- ;; User-defined spec -- find the spec name.
- (when (eq (setq spec (char-after)) ?u)
+ (cond
+ ;; User-defined spec -- find the spec name.
+ ((eq (setq spec (char-after)) ?u)
(forward-char 1)
- (setq user-defined (char-after)))
+ (when (and (eq (setq user-defined (char-after)) ?&)
+ (looking-at "&\\([^;]+\\);"))
+ (setq user-defined (match-string 1))
+ (goto-char (match-end 1))))
+ ;; extended spec
+ ((and (eq spec ?&) (looking-at "&\\([^;]+\\);"))
+ (setq extended-spec (intern (match-string 1)))
+ (goto-char (match-end 1))))
(forward-char 1)
(delete-region spec-beg (point))
@@ -421,20 +606,27 @@
(user-defined
(setq elem
(list
- (list (intern (format "gnus-user-format-function-%c"
- user-defined))
+ (list (intern (format
+ (if (stringp user-defined)
+ "gnus-user-format-function-%s"
+ "gnus-user-format-function-%c")
+ user-defined))
'gnus-tmp-header)
?s)))
;; Find the specification from `spec-alist'.
- ((setq elem (cdr (assq spec spec-alist))))
+ ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
(t
(setq elem '("*" ?s))))
(setq elem-type (cadr elem))
;; Insert the new format elements.
- (when pad-width
+ (when (and pad-width
+ (not (and (featurep 'xemacs)
+ gnus-use-correct-string-widths)))
(insert (number-to-string pad-width)))
;; Create the form to be evaled.
- (if (or max-width cut-width ignore-value)
+ (if (or max-width cut-width ignore-value
+ (and (featurep 'xemacs)
+ gnus-use-correct-string-widths))
(progn
(insert ?s)
(let ((el (car elem)))
@@ -448,16 +640,18 @@
(setq el (gnus-tilde-cut-form el cut-width)))
(when max-width
(setq el (gnus-tilde-max-form el max-width)))
+ (when pad-width
+ (setq el (gnus-pad-form el pad-width)))
(push el flist)))
(insert elem-type)
(push (car elem) flist))))
- (setq fstring (buffer-string)))
+ (setq fstring (buffer-substring-no-properties (point-min) (point-max))))
;; Do some postprocessing to increase efficiency.
(setq
result
(cond
- ;; Emptyness.
+ ;; Emptiness.
((string= fstring "")
nil)
;; Not a format string.
@@ -487,6 +681,13 @@
;; A single string spec in the end of the spec.
((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
(list (match-string 1 fstring) (car flist)))
+ ;; Only string (and %) specs (XEmacs only!)
+ ((and (featurep 'xemacs)
+ gnus-make-format-preserve-properties
+ (string-match
+ "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'"
+ fstring))
+ (list (cons 'gnus-xmas-format (cons fstring (nreverse flist)))))
;; A more complex spec.
(t
(list (cons 'format (cons fstring (nreverse flist)))))))
@@ -522,7 +723,7 @@ If PROPS, insert the result."
(while entries
(setq entry (pop entries))
- (if (eq (car entry) 'version)
+ (if (memq (car entry) '(gnus-version version))
(setq gnus-format-specs (delq entry gnus-format-specs))
(let ((form (caddr entry)))
(when (and (listp form)
@@ -531,7 +732,7 @@ If PROPS, insert the result."
;; Under XEmacs, it's (funcall #<compiled-function ...>)
(not (and (eq 'funcall (car form))
(byte-code-function-p (cadr form)))))
- (fset 'gnus-tmp-func `(lambda () ,form))
+ (defalias 'gnus-tmp-func `(lambda () ,form))
(byte-compile 'gnus-tmp-func)
(setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 4015916a674..775bdc485af 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -1,5 +1,5 @@
;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -34,10 +34,17 @@
(require 'gnus-int)
(require 'gnus-range)
-(defvar gnus-server-mode-hook nil
- "Hook run in `gnus-server-mode' buffers.")
+(defcustom gnus-server-mode-hook nil
+ "Hook run in `gnus-server-mode' buffers."
+ :group 'gnus-server
+ :type 'hook)
-(defconst gnus-server-line-format " {%(%h:%w%)} %s\n"
+(defcustom gnus-server-exit-hook nil
+ "Hook run when exiting the server buffer."
+ :group 'gnus-server
+ :type 'hook)
+
+(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n"
"Format of server lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
@@ -47,13 +54,25 @@ The following specs are understood:
%h backend
%n name
%w address
-%s status")
-
-(defvar gnus-server-mode-line-format "Gnus: %%b"
- "The format specification for the server mode line.")
-
-(defvar gnus-server-exit-hook nil
- "*Hook run when exiting the server buffer.")
+%s status
+%a agent covered
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
+ :group 'gnus-server-visual
+ :type 'string)
+
+(defcustom gnus-server-mode-line-format "Gnus: %%b"
+ "The format specification for the server mode line."
+ :group 'gnus-server-visual
+ :type 'string)
+
+(defcustom gnus-server-browse-in-group-buffer nil
+ "Whether server browsing should take place in the group buffer.
+If nil, a faster, but more primitive, buffer is used instead."
+ :group 'gnus-server-visual
+ :type 'boolean)
;;; Internal variables.
@@ -63,7 +82,8 @@ The following specs are understood:
`((?h gnus-tmp-how ?s)
(?n gnus-tmp-name ?s)
(?w gnus-tmp-where ?s)
- (?s gnus-tmp-status ?s)))
+ (?s gnus-tmp-status ?s)
+ (?a gnus-tmp-agent ?s)))
(defvar gnus-server-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
@@ -85,7 +105,7 @@ The following specs are understood:
(easy-menu-define
gnus-server-server-menu gnus-server-mode-map ""
'("Server"
- ["Add" gnus-server-add-server t]
+ ["Add..." gnus-server-add-server t]
["Browse" gnus-server-read-server t]
["Scan" gnus-server-scan-server t]
["List" gnus-server-list-servers t]
@@ -101,6 +121,7 @@ The following specs are understood:
'("Connections"
["Open" gnus-server-open-server t]
["Close" gnus-server-close-server t]
+ ["Offline" gnus-server-offline-server t]
["Deny" gnus-server-deny-server t]
"---"
["Open All" gnus-server-open-all-servers t]
@@ -117,7 +138,7 @@ The following specs are understood:
(suppress-keymap gnus-server-mode-map)
(gnus-define-keys gnus-server-mode-map
- " " gnus-server-read-server
+ " " gnus-server-read-server-in-server-buffer
"\r" gnus-server-read-server
gnus-mouse-2 gnus-server-pick-server
"q" gnus-server-exit
@@ -134,6 +155,7 @@ The following specs are understood:
"C" gnus-server-close-server
"\M-c" gnus-server-close-all-servers
"D" gnus-server-deny-server
+ "L" gnus-server-offline-server
"R" gnus-server-remove-denials
"n" next-line
@@ -144,6 +166,75 @@ The following specs are understood:
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug))
+(defface gnus-server-agent-face
+ '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
+ (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
+ (t (:bold t)))
+ "Face used for displaying AGENTIZED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-opened-face
+ '((((class color) (background light)) (:foreground "Green3" :bold t))
+ (((class color) (background dark)) (:foreground "Green1" :bold t))
+ (t (:bold t)))
+ "Face used for displaying OPENED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-closed-face
+ '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
+ (((class color) (background dark))
+ (:foreground "Light Steel Blue" :italic t))
+ (t (:italic t)))
+ "Face used for displaying CLOSED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-denied-face
+ '((((class color) (background light)) (:foreground "Red" :bold t))
+ (((class color) (background dark)) (:foreground "Pink" :bold t))
+ (t (:inverse-video t :bold t)))
+ "Face used for displaying DENIED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-offline-face
+ '((((class color) (background light)) (:foreground "Orange" :bold t))
+ (((class color) (background dark)) (:foreground "Yellow" :bold t))
+ (t (:inverse-video t :bold t)))
+ "Face used for displaying OFFLINE servers"
+ :group 'gnus-server-visual)
+
+(defcustom gnus-server-agent-face 'gnus-server-agent-face
+ "Face name to use on AGENTIZED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-opened-face 'gnus-server-opened-face
+ "Face name to use on OPENED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-closed-face 'gnus-server-closed-face
+ "Face name to use on CLOSED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-denied-face 'gnus-server-denied-face
+ "Face name to use on DENIED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-offline-face 'gnus-server-offline-face
+ "Face name to use on OFFLINE servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defvar gnus-server-font-lock-keywords
+ (list
+ '("(\\(agent\\))" 1 gnus-server-agent-face)
+ '("(\\(opened\\))" 1 gnus-server-opened-face)
+ '("(\\(closed\\))" 1 gnus-server-closed-face)
+ '("(\\(offline\\))" 1 gnus-server-offline-face)
+ '("(\\(denied\\))" 1 gnus-server-denied-face)))
+
(defun gnus-server-mode ()
"Major mode for listing and editing servers.
@@ -168,6 +259,10 @@ The following commands are available:
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t)
+ (if (featurep 'xemacs)
+ (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t))
+ (set (make-local-variable 'font-lock-defaults)
+ '(gnus-server-font-lock-keywords t)))
(gnus-run-hooks 'gnus-server-mode-hook))
(defun gnus-server-insert-server-line (gnus-tmp-name method)
@@ -175,21 +270,28 @@ The following commands are available:
(gnus-tmp-where (nth 1 method))
(elem (assoc method gnus-opened-servers))
(gnus-tmp-status
- (if (eq (nth 1 elem) 'denied)
- "(denied)"
+ (cond
+ ((eq (nth 1 elem) 'denied) "(denied)")
+ ((eq (nth 1 elem) 'offline) "(offline)")
+ (t
(condition-case nil
(if (or (gnus-server-opened method)
(eq (nth 1 elem) 'ok))
"(opened)"
"(closed)")
((error) "(error)")))))
+ (gnus-tmp-agent (if (and gnus-agent
+ (gnus-agent-method-p method))
+ " (agent)"
+ "")))
(beginning-of-line)
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
(eval gnus-server-line-format-spec))
- (list 'gnus-server (intern gnus-tmp-name)))))
+ (list 'gnus-server (intern gnus-tmp-name)
+ 'gnus-named-server (intern (gnus-method-to-server method))))))
(defun gnus-enter-server-buffer ()
"Set up the server buffer."
@@ -243,6 +345,12 @@ The following commands are available:
(let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
(and server (symbol-name server))))
+(defun gnus-server-named-server ()
+ "Returns a server name that matches one of the names returned by
+gnus-method-to-server."
+ (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server)))
+ (and server (symbol-name server))))
+
(defalias 'gnus-server-position-point 'gnus-goto-colon)
(defconst gnus-server-edit-buffer "*Gnus edit server*")
@@ -257,7 +365,7 @@ The following commands are available:
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string (cdr entry)) ")\n")))
+ (gnus-prin1-to-string (cdr entry)) ")\n")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
@@ -276,9 +384,13 @@ The following commands are available:
(when (and server info)
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string info) ")"))
+ (gnus-prin1-to-string info) ")"))
(let* ((server (nth 1 info))
- (entry (assoc server gnus-server-alist)))
+ (entry (assoc server gnus-server-alist))
+ (cached (assoc server gnus-server-method-cache)))
+ (if cached
+ (setq gnus-server-method-cache
+ (delq cached gnus-server-method-cache)))
(if entry (setcdr entry info)
(setq gnus-server-alist
(nconc gnus-server-alist (list (cons server info))))))))
@@ -330,7 +442,7 @@ The following commands are available:
(setq alist (cdr alist)))
(if alist
(setcdr alist (cons killed (cdr alist)))
- (setq gnus-server-alist (list killed)))))
+ (setq gnus-server-alist (list killed)))))
(gnus-server-update-server (car killed))
(setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
(gnus-server-position-point)))
@@ -339,7 +451,7 @@ The following commands are available:
"Return to the group buffer."
(interactive)
(gnus-run-hooks 'gnus-server-exit-hook)
- (kill-buffer (current-buffer))
+ (gnus-kill-buffer (current-buffer))
(gnus-configure-windows 'group t))
(defun gnus-server-list-servers ()
@@ -396,12 +508,23 @@ The following commands are available:
(gnus-server-update-server server)
(gnus-server-position-point))))
+(defun gnus-server-offline-server (server)
+ "Set SERVER to offline."
+ (interactive (list (gnus-server-server-name)))
+ (let ((method (gnus-server-to-method server)))
+ (unless method
+ (error "No such server: %s" server))
+ (prog1
+ (gnus-close-server method)
+ (gnus-server-set-status method 'offline)
+ (gnus-server-update-server server)
+ (gnus-server-position-point))))
+
(defun gnus-server-close-all-servers ()
"Close all servers."
(interactive)
- (let ((servers gnus-inserted-opened-servers))
- (while servers
- (gnus-server-close-server (car (pop servers))))))
+ (dolist (server gnus-inserted-opened-servers)
+ (gnus-server-close-server (car server))))
(defun gnus-server-deny-server (server)
"Make sure SERVER will never be attempted opened."
@@ -417,11 +540,9 @@ The following commands are available:
(defun gnus-server-remove-denials ()
"Make all denied servers into closed servers."
(interactive)
- (let ((servers gnus-opened-servers))
- (while servers
- (when (eq (nth 1 (car servers)) 'denied)
- (setcar (nthcdr 1 (car servers)) 'closed))
- (setq servers (cdr servers))))
+ (dolist (server gnus-opened-servers)
+ (when (eq (nth 1 server) 'denied)
+ (setcar (nthcdr 1 server) 'closed)))
(gnus-server-list-servers))
(defun gnus-server-copy-server (from to)
@@ -491,6 +612,12 @@ The following commands are available:
(gnus-request-scan nil method)
(gnus-message 3 "Scanning %s...done" server))))
+(defun gnus-server-read-server-in-server-buffer (server)
+ "Browse a server in server buffer."
+ (interactive (list (gnus-server-server-name)))
+ (let (gnus-server-browse-in-group-buffer)
+ (gnus-server-read-server server)))
+
(defun gnus-server-read-server (server)
"Browse a server."
(interactive (list (gnus-server-server-name)))
@@ -541,6 +668,7 @@ The following commands are available:
"L" gnus-browse-exit
"q" gnus-browse-exit
"Q" gnus-browse-exit
+ "d" gnus-browse-describe-group
"\C-c\C-c" gnus-browse-exit
"?" gnus-browse-describe-briefly
@@ -556,6 +684,7 @@ The following commands are available:
["Subscribe" gnus-browse-unsubscribe-current-group t]
["Read" gnus-browse-read-group t]
["Select" gnus-browse-select-group t]
+ ["Describe" gnus-browse-describe-group t]
["Next" gnus-browse-next-group t]
["Prev" gnus-browse-prev-group t]
["Exit" gnus-browse-exit t]))
@@ -571,6 +700,7 @@ The following commands are available:
(setq gnus-browse-current-method (gnus-server-to-method server))
(setq gnus-browse-return-buffer return-buffer)
(let* ((method gnus-browse-current-method)
+ (orig-select-method gnus-select-method)
(gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
@@ -589,58 +719,97 @@ The following commands are available:
1 "Couldn't request list: %s" (gnus-status-message method))
nil)
(t
- (gnus-get-buffer-create gnus-browse-buffer)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'browse))
- (gnus-configure-windows 'browse)
- (buffer-disable-undo)
- (let ((buffer-read-only nil))
- (erase-buffer))
- (gnus-browse-mode)
- (setq mode-line-buffer-identification
- (list
- (format
- "Gnus: %%b {%s:%s}" (car method) (cadr method))))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let ((cur (current-buffer)))
(goto-char (point-min))
(unless (string= gnus-ignored-newsgroups "")
(delete-matching-lines gnus-ignored-newsgroups))
- (while (not (eobp))
- (ignore-errors
- (push (cons
- (if (eq (char-after) ?\")
- (read cur)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
+ ;; We treat NNTP as a special case to avoid problems with
+ ;; garbage group names like `"foo' that appear in some badly
+ ;; managed active files. -jh.
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (cons
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ (let ((last (read cur)))
+ (cons (read cur) last)))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (cons
+ (if (eq (char-after) ?\")
+ (read cur)
+ (let ((p (point)) (name ""))
(skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- name))
- (max 0 (- (1+ (read cur)) (read cur))))
- groups))
- (forward-line))))
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ name))
+ (let ((last (read cur)))
+ (cons (read cur) last)))
+ groups))
+ (forward-line)))))
(setq groups (sort groups
(lambda (l1 l2)
(string< (car l1) (car l2)))))
- (let ((buffer-read-only nil) charset)
- (while groups
- (setq group (car groups))
- (setq charset (gnus-group-name-charset method group))
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- (insert
- (format "K%7d: %s\n" (cdr group)
- (gnus-group-name-decode (car group) charset))))
- (list 'gnus-group (car group)))
- (setq groups (cdr groups))))
- (switch-to-buffer (current-buffer))
+ (if gnus-server-browse-in-group-buffer
+ (let* ((gnus-select-method orig-select-method)
+ (gnus-group-listed-groups
+ (mapcar (lambda (group)
+ (let ((name
+ (gnus-group-prefixed-name
+ (car group) method)))
+ (gnus-set-active name (cdr group))
+ name))
+ groups)))
+ (gnus-configure-windows 'group)
+ (funcall gnus-group-prepare-function
+ gnus-level-killed 'ignore 1 'ignore))
+ (gnus-get-buffer-create gnus-browse-buffer)
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'browse))
+ (gnus-configure-windows 'browse)
+ (buffer-disable-undo)
+ (let ((buffer-read-only nil))
+ (erase-buffer))
+ (gnus-browse-mode)
+ (setq mode-line-buffer-identification
+ (list
+ (format
+ "Gnus: %%b {%s:%s}" (car method) (cadr method))))
+ (let ((buffer-read-only nil)
+ name
+ (prefix (let ((gnus-select-method orig-select-method))
+ (gnus-group-prefixed-name "" method))))
+ (while (setq group (pop groups))
+ (gnus-add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ (insert
+ (format "%c%7d: %s\n"
+ (let ((level (gnus-group-level
+ (concat prefix (setq name (car group))))))
+ (cond
+ ((<= level gnus-level-subscribed) ? )
+ ((<= level gnus-level-unsubscribed) ?U)
+ ((= level gnus-level-zombie) ?Z)
+ (t ?K)))
+ (max 0 (- (1+ (cddr group)) (cadr group)))
+ (mm-decode-coding-string
+ name
+ (inline (gnus-group-name-charset method name))))))
+ (list 'gnus-group name))))
+ (switch-to-buffer (current-buffer)))
(goto-char (point-min))
(gnus-group-position-point)
(gnus-message 5 "Connecting to %s...done" (nth 1 method))
@@ -683,7 +852,7 @@ buffer.
(if (or (not (gnus-get-info group))
(gnus-ephemeral-group-p group))
(unless (gnus-group-read-ephemeral-group
- (gnus-group-real-name group) gnus-browse-current-method nil
+ group gnus-browse-current-method nil
(cons (current-buffer) 'browse))
(error "Couldn't enter %s" group))
(unless (gnus-group-read-group nil no-article group)
@@ -728,10 +897,14 @@ buffer.
(beginning-of-line)
(let ((name (get-text-property (point) 'gnus-group)))
(when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
- (gnus-group-prefixed-name
- (or name
- (match-string-no-properties 1))
- gnus-browse-current-method)))))
+ (concat (gnus-method-to-server-name gnus-browse-current-method) ":"
+ (or name
+ (match-string-no-properties 1)))))))
+
+(defun gnus-browse-describe-group (group)
+ "Describe the current group."
+ (interactive (list (gnus-browse-group-name)))
+ (gnus-group-describe-group nil group))
(defun gnus-browse-unsubscribe-group ()
"Toggle subscription of the current group in the browse buffer."
@@ -741,13 +914,11 @@ buffer.
(save-excursion
(beginning-of-line)
;; If this group it killed, then we want to subscribe it.
- (when (eq (char-after) ?K)
+ (unless (eq (char-after) ? )
(setq sub t))
(setq group (gnus-browse-group-name))
- (when (and sub
- (cadr (gnus-gethash group gnus-newsrc-hashtb)))
- (error "Group already subscribed"))
- (delete-char 1)
+ (when (gnus-server-equal gnus-browse-current-method "native")
+ (setq group (gnus-group-real-name group)))
(if sub
(progn
;; Make sure the group has been properly removed before we
@@ -760,22 +931,24 @@ buffer.
nil
(gnus-method-simplify
gnus-browse-current-method)))
- gnus-level-default-subscribed gnus-level-killed
+ gnus-level-default-subscribed (gnus-group-level group)
(and (car (nth 1 gnus-newsrc-alist))
(gnus-gethash (car (nth 1 gnus-newsrc-alist))
gnus-newsrc-hashtb))
t)
+ (delete-char 1)
(insert ? ))
(gnus-group-change-level
- group gnus-level-killed gnus-level-default-subscribed)
- (insert ?K)))
+ group gnus-level-unsubscribed gnus-level-default-subscribed)
+ (delete-char 1)
+ (insert ?U)))
t))
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
(interactive)
(when (eq major-mode 'gnus-browse-mode)
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
(save-excursion
(set-buffer gnus-group-buffer)
@@ -796,15 +969,17 @@ buffer.
(let ((server (gnus-server-server-name)))
(unless server
(error "No server on the current line"))
- (if (not (gnus-check-backend-function
- 'request-regenerate (car (gnus-server-to-method server))))
- (error "This backend doesn't support regeneration")
- (gnus-message 5 "Requesting regeneration of %s..." server)
- (unless (gnus-open-server server)
- (error "Couldn't open server"))
- (if (gnus-request-regenerate server)
- (gnus-message 5 "Requesting regeneration of %s...done" server)
- (gnus-message 5 "Couldn't regenerate %s" server)))))
+ (condition-case ()
+ (gnus-get-function (gnus-server-to-method server)
+ 'request-regenerate)
+ (error
+ (error "This backend doesn't support regeneration")))
+ (gnus-message 5 "Requesting regeneration of %s..." server)
+ (unless (gnus-open-server server)
+ (error "Couldn't open server"))
+ (if (gnus-request-regenerate server)
+ (gnus-message 5 "Requesting regeneration of %s...done" server)
+ (gnus-message 5 "Couldn't regenerate %s" server))))
(provide 'gnus-srvr)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 63d551c4b40..229658b2d7b 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1,5 +1,5 @@
;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -32,7 +32,9 @@
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-util)
-(require 'message)
+(autoload 'message-make-date "message")
+(autoload 'gnus-agent-read-servers-validate "gnus-agent")
+(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
(eval-when-compile (require 'cl))
(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
@@ -41,6 +43,24 @@
:group 'gnus-start
:type 'file)
+(defcustom gnus-backup-startup-file 'never
+ "Whether to create backup files.
+This variable takes the same values as the `version-control'
+variable."
+ :group 'gnus-start
+ :type '(choice (const :tag "Never" never)
+ (const :tag "If existing" nil)
+ (other :tag "Always" t)))
+
+(defcustom gnus-save-startup-file-via-temp-buffer t
+ "Whether to write the startup file contents to a buffer then save
+the buffer or write directly to the file. The buffer is faster
+because all of the contents are written at once. The direct write
+uses considerably less memory."
+ :group 'gnus-start
+ :type '(choice (const :tag "Write via buffer" t)
+ (const :tag "Write directly to file" nil)))
+
(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
"Your Gnus Emacs-Lisp startup file name.
If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
@@ -224,12 +244,17 @@ nil if you set this variable to nil.
This variable can also be a regexp. In that case, all groups that do
not match this regexp will be removed before saving the list."
:group 'gnus-newsrc
- :type 'boolean)
+ :type '(radio (sexp :format "Non-nil\n"
+ :match (lambda (widget value)
+ (and value (not (stringp value))))
+ :value t)
+ (const nil)
+ (regexp :format "%t: %v\n" :size 0)))
(defcustom gnus-ignored-newsgroups
(mapconcat 'identity
'("^to\\." ; not "real" groups
- "^[0-9. \t]+ " ; all digits in name
+ "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
"^[\"][]\"[#'()]" ; bogus characters
)
"\\|")
@@ -241,7 +266,7 @@ thus making them effectively non-existent."
:type 'regexp)
(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
- "*Function called with a group name when new group is detected.
+ "*Function(s) called with a group name when new group is detected.
A few pre-made functions are supplied: `gnus-subscribe-randomly'
inserts new groups at the beginning of the list of groups;
`gnus-subscribe-alphabetically' inserts new groups in strict
@@ -259,11 +284,18 @@ claim them."
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
(function-item gnus-subscribe-topics)
- function))
+ function
+ (repeat function)))
+
+(defcustom gnus-subscribe-newsgroup-hooks nil
+ "*Hooks run after you subscribe to a new group.
+The hooks will be called with new group's name as argument."
+ :group 'gnus-group-new
+ :type 'hook)
(defcustom gnus-subscribe-options-newsgroup-method
'gnus-subscribe-alphabetically
- "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
+ "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
If, for instance, you want to subscribe to all newsgroups in the
\"no\" and \"alt\" hierarchies, you'd put the following in your
.newsrc file:
@@ -279,7 +311,9 @@ the subscription method in this variable."
(function-item gnus-subscribe-interactively)
(function-item gnus-subscribe-killed)
(function-item gnus-subscribe-zombies)
- function))
+ (function-item gnus-subscribe-topics)
+ function
+ (repeat function)))
(defcustom gnus-subscribe-hierarchical-interactive nil
"*If non-nil, Gnus will offer to subscribe hierarchically.
@@ -294,7 +328,7 @@ hierarchy in its entirety."
:type 'boolean)
(defcustom gnus-auto-subscribed-groups
- "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
+ "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
"*All new groups that match this regexp will be subscribed automatically.
Note that this variable only deals with new groups. It has no effect
whatsoever on old groups.
@@ -354,23 +388,34 @@ This hook is called as the first thing when Gnus is started."
:group 'gnus-start
:type 'hook)
-(defcustom gnus-setup-news-hook nil
+(defcustom gnus-setup-news-hook
+ '(gnus-fixup-nnimap-unread-after-getting-new-news)
"A hook after reading the .newsrc file, but before generating the buffer."
:group 'gnus-start
:type 'hook)
+(defcustom gnus-get-top-new-news-hook nil
+ "A hook run just before Gnus checks for new news globally."
+ :group 'gnus-group-new
+ :type 'hook)
+
(defcustom gnus-get-new-news-hook nil
"A hook run just before Gnus checks for new news."
:group 'gnus-group-new
:type 'hook)
(defcustom gnus-after-getting-new-news-hook
- (when (gnus-boundp 'display-time-timer)
- '(display-time-event-handler))
+ '(gnus-display-time-event-handler
+ gnus-fixup-nnimap-unread-after-getting-new-news)
"*A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
+(defcustom gnus-read-newsrc-el-hook nil
+ "A hook called after reading the newsrc.eld? file."
+ :group 'gnus-newsrc
+ :type 'hook)
+
(defcustom gnus-save-newsrc-hook nil
"A hook called before saving any of the newsrc files."
:group 'gnus-newsrc
@@ -388,6 +433,12 @@ Can be used to turn version control on or off."
:group 'gnus-newsrc
:type 'hook)
+(defcustom gnus-group-mode-hook nil
+ "Hook for Gnus group mode."
+ :group 'gnus-group-various
+ :options '(gnus-topic-mode)
+ :type 'hook)
+
(defcustom gnus-always-read-dribble-file nil
"Unconditionally read the dribble file."
:group 'gnus-newsrc
@@ -432,7 +483,7 @@ Can be used to turn version control on or off."
(condition-case var
(load file nil t)
(error
- (error "Error in %s: %s" file var)))))))))
+ (error "Error in %s: %s" file (cadr var))))))))))
;; For subscribing new newsgroup
@@ -508,7 +559,7 @@ Can be used to turn version control on or off."
(gnus-subscribe-newsgroup newsgroup))
(defun gnus-subscribe-alphabetically (newgroup)
- "Subscribe new NEWSGROUP and insert it in alphabetical order."
+ "Subscribe new NEWGROUP and insert it in alphabetical order."
(let ((groups (cdr gnus-newsrc-alist))
before)
(while (and (not before) groups)
@@ -518,26 +569,26 @@ Can be used to turn version control on or off."
(gnus-subscribe-newsgroup newgroup before)))
(defun gnus-subscribe-hierarchically (newgroup)
- "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
+ "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
(save-excursion
(set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
- (let ((groupkey newgroup)
- before)
- (while (and (not before) groupkey)
- (goto-char (point-min))
- (let ((groupkey-re
- (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
- (while (and (re-search-forward groupkey-re nil t)
- (progn
- (setq before (match-string 1))
- (string< before newgroup)))))
- ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
- (setq groupkey
- (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
- (substring groupkey (match-beginning 1) (match-end 1)))))
- (gnus-subscribe-newsgroup newgroup before))
- (kill-buffer (current-buffer))))
+ (prog1
+ (let ((groupkey newgroup) before)
+ (while (and (not before) groupkey)
+ (goto-char (point-min))
+ (let ((groupkey-re
+ (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
+ (while (and (re-search-forward groupkey-re nil t)
+ (progn
+ (setq before (match-string 1))
+ (string< before newgroup)))))
+ ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
+ (setq groupkey
+ (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
+ (substring groupkey (match-beginning 1) (match-end 1)))))
+ (gnus-subscribe-newsgroup newgroup before))
+ (kill-buffer (current-buffer)))))
(defun gnus-subscribe-interactively (group)
"Subscribe the new GROUP interactively.
@@ -566,7 +617,9 @@ the first newsgroup."
newsgroup gnus-level-default-subscribed
gnus-level-killed (gnus-gethash (or next "dummy.group")
gnus-newsrc-hashtb))
- (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
+ (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
+ (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
+ t))
(defun gnus-read-active-file-p ()
"Say whether the active file has been read from `gnus-select-method'."
@@ -575,27 +628,40 @@ the first newsgroup."
;;; General various misc type functions.
;; Silence byte-compiler.
-(defvar gnus-current-headers)
-(defvar gnus-thread-indent-array)
-(defvar gnus-newsgroup-name)
-(defvar gnus-newsgroup-headers)
-(defvar gnus-group-list-mode)
-(defvar gnus-group-mark-positions)
-(defvar gnus-newsgroup-data)
-(defvar gnus-newsgroup-unreads)
-(defvar nnoo-state-alist)
-(defvar gnus-current-select-method)
+(eval-when-compile
+ (defvar gnus-current-headers)
+ (defvar gnus-thread-indent-array)
+ (defvar gnus-newsgroup-name)
+ (defvar gnus-newsgroup-headers)
+ (defvar gnus-group-list-mode)
+ (defvar gnus-group-mark-positions)
+ (defvar gnus-newsgroup-data)
+ (defvar gnus-newsgroup-unreads)
+ (defvar nnoo-state-alist)
+ (defvar gnus-current-select-method)
+ (defvar mail-sources)
+ (defvar nnmail-scan-directory-mail-source-once)
+ (defvar nnmail-split-history)
+ (defvar nnmail-spool-file))
+
+(defun gnus-close-all-servers ()
+ "Close all servers."
+ (interactive)
+ (dolist (server gnus-opened-servers)
+ (gnus-close-server (car server))))
(defun gnus-clear-system ()
"Clear all variables and buffers."
;; Clear Gnus variables.
- (let ((variables gnus-variable-list))
+ (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
(while variables
(set (car variables) nil)
(setq variables (cdr variables))))
;; Clear other internal variables.
(setq gnus-list-of-killed-groups nil
gnus-have-read-active-file nil
+ gnus-agent-covered-methods nil
+ gnus-server-method-cache nil
gnus-newsrc-alist nil
gnus-newsrc-hashtb nil
gnus-killed-list nil
@@ -630,9 +696,8 @@ the first newsgroup."
(kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
(gnus-kill-buffer nntp-server-buffer)
;; Kill Gnus buffers.
- (let ((buffers (gnus-buffers)))
- (when buffers
- (mapcar 'kill-buffer buffers)))
+ (dolist (buffer (gnus-buffers))
+ (gnus-kill-buffer buffer))
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
@@ -670,6 +735,8 @@ prompt the user for the name of an NNTP server to use."
(nnheader-init-server-buffer)
(setq gnus-slave slave)
(gnus-read-init-file)
+ (if gnus-agent
+ (gnus-agentize))
(when gnus-simple-splash
(setq gnus-simple-splash nil)
@@ -707,6 +774,9 @@ prompt the user for the name of an NNTP server to use."
(add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
;; Do the actual startup.
+ (if gnus-agent
+ (gnus-request-create-group "queue" '(nndraft "")))
+ (gnus-request-create-group "drafts" '(nndraft ""))
(gnus-setup-news nil level dont-connect)
(gnus-run-hooks 'gnus-setup-news-hook)
(gnus-start-draft-setup)
@@ -726,17 +796,6 @@ prompt the user for the name of an NNTP server to use."
(gnus-group-set-parameter
"nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
-;;;###autoload
-(defun gnus-unload ()
- "Unload all Gnus features.
-\(For some value of `all' or `Gnus'.) Currently, features whose names
-have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded. Use
-cautiously -- unloading may cause trouble."
- (interactive)
- (dolist (feature features)
- (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature))
- (unload-feature feature 'force))))
-
;;;
;;; Dribble file
@@ -763,7 +822,11 @@ cautiously -- unloading may cause trouble."
(set-buffer gnus-dribble-buffer)
(goto-char (point-max))
(insert string "\n")
- (set-window-point (get-buffer-window (current-buffer)) (point-max))
+ ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
+ ;; It causes problems with both XEmacs and Emacs 21, and doesn't
+ ;; seem to be of much value. (FIXME: remove this after we make sure
+ ;; it's not needed).
+ ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
(bury-buffer gnus-dribble-buffer)
(save-excursion
(set-buffer gnus-group-buffer)
@@ -789,6 +852,7 @@ cautiously -- unloading may cause trouble."
(set-buffer-modified-p nil)
(let ((auto (make-auto-save-file-name))
(gnus-dribble-ignore t)
+ (purpose nil)
modes)
(when (or (file-exists-p auto) (file-exists-p dribble-file))
;; Load whichever file is newest -- the auto save file
@@ -804,10 +868,15 @@ cautiously -- unloading may cause trouble."
(file-exists-p dribble-file)
(setq modes (file-modes gnus-current-startup-file)))
(set-file-modes dribble-file modes))
+ (goto-char (point-min))
+ (when (search-forward "Gnus was exited on purpose" nil t)
+ (setq purpose t))
;; Possibly eval the file later.
(when (or gnus-always-read-dribble-file
(gnus-y-or-n-p
- "Gnus auto-save file exists. Do you want to read it? "))
+ (if purpose
+ "Gnus exited on purpose without saving; read auto-save file anyway? "
+ "Gnus auto-save file exists. Do you want to read it? ")))
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
@@ -869,10 +938,17 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Make sure the archive server is available to all and sundry.
(when gnus-message-archive-method
- (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist)
- gnus-server-alist))
- (push (cons "archive" gnus-message-archive-method)
- gnus-server-alist))
+ (unless (assoc "archive" gnus-server-alist)
+ (push `("archive"
+ nnfolder
+ "archive"
+ (nnfolder-directory
+ ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t))
+ gnus-server-alist)))
;; If we don't read the complete active file, we fill in the
;; hashtb here.
@@ -880,6 +956,15 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
(eq gnus-read-active-file 'some))
(gnus-update-active-hashtb-from-killed))
+ ;; Validate agent covered methods now that gnus-server-alist has
+ ;; been initialized.
+ ;; NOTE: This is here for one purpose only. By validating the
+ ;; agentized server's, it converts the old 5.10.3, and earlier,
+ ;; format to the current format. That enables the agent code
+ ;; within gnus-read-active-file to function correctly.
+ (if gnus-agent
+ (gnus-agent-read-servers-validate))
+
;; Read the active file and create `gnus-active-hashtb'.
;; If `gnus-read-active-file' is nil, then we just create an empty
;; hash table. The partial filling out of the hash table will be
@@ -908,6 +993,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; See whether we need to read the description file.
(when (and (boundp 'gnus-group-line-format)
+ (stringp gnus-group-line-format)
(let ((case-fold-search nil))
(string-match "%[-,0-9]*D" gnus-group-line-format))
(not gnus-description-hashtb)
@@ -922,6 +1008,12 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
gnus-plugged)
(gnus-find-new-newsgroups))
+ ;; Check and remove bogus newsgroups.
+ (when (and init gnus-check-bogus-newsgroups
+ gnus-read-active-file (not level)
+ (gnus-server-opened gnus-select-method))
+ (gnus-check-bogus-newsgroups))
+
;; We might read in new NoCeM messages here.
(when (and gnus-use-nocem
(not level)
@@ -933,12 +1025,22 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
- (gnus-get-unread-articles level))
-
- (when (and init gnus-check-bogus-newsgroups
- gnus-read-active-file (not level)
- (gnus-server-opened gnus-select-method))
- (gnus-check-bogus-newsgroups))))
+ (gnus-get-unread-articles level))))
+
+(defun gnus-call-subscribe-functions (method group)
+ "Call METHOD to subscribe GROUP.
+If no function returns `non-nil', call `gnus-subscribe-zombies'."
+ (unless (cond
+ ((functionp method)
+ (funcall method group))
+ ((listp method)
+ (catch 'found
+ (dolist (func method)
+ (if (funcall func group)
+ (throw 'found t)))
+ nil))
+ (t nil))
+ (gnus-subscribe-zombies group)))
(defun gnus-find-new-newsgroups (&optional arg)
"Search for new newsgroups and add them.
@@ -992,7 +1094,8 @@ for new groups, and subscribe the new groups as zombies."
((eq do-sub 'subscribe)
(setq groups (1+ groups))
(gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore)
nil)
(t
@@ -1000,7 +1103,8 @@ for new groups, and subscribe the new groups as zombies."
(gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-newsgroup-method group)))))))
gnus-active-hashtb)
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups))
@@ -1085,7 +1189,8 @@ for new groups, and subscribe the new groups as zombies."
((eq do-sub 'subscribe)
(incf groups)
(gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore)
nil)
(t
@@ -1093,7 +1198,8 @@ for new groups, and subscribe the new groups as zombies."
(gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (gnus-call-subscribe-functions
+ gnus-subscribe-newsgroup-method group)))))))
hashtb))
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups)))
@@ -1109,10 +1215,8 @@ for new groups, and subscribe the new groups as zombies."
(catch 'ended
;; First check if any of the following files exist. If they do,
;; it's not the first time the user has used Gnus.
- (dolist (file (list gnus-current-startup-file
- (concat gnus-current-startup-file ".el")
+ (dolist (file (list (concat gnus-current-startup-file ".el")
(concat gnus-current-startup-file ".eld")
- gnus-startup-file
(concat gnus-startup-file ".el")
(concat gnus-startup-file ".eld")))
(when (file-exists-p file)
@@ -1126,21 +1230,22 @@ for new groups, and subscribe the new groups as zombies."
(let ((groups (or gnus-default-subscribed-newsgroups
gnus-backup-default-subscribed-newsgroups))
group)
- (when (eq groups t)
- ;; If t, we subscribe (or not) all groups as if they were new.
- (mapatoms
- (lambda (sym)
- (when (setq group (symbol-name sym))
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (push group gnus-killed-list))))))
- gnus-active-hashtb)
+ (if (eq groups t)
+ ;; If t, we subscribe (or not) all groups as if they were new.
+ (mapatoms
+ (lambda (sym)
+ (when (setq group (symbol-name sym))
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (gnus-call-subscribe-functions
+ gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (push group gnus-killed-list))))))
+ gnus-active-hashtb)
(dolist (group groups)
;; Only subscribe the default groups that are activated.
(when (gnus-active group)
@@ -1148,12 +1253,14 @@ for new groups, and subscribe the new groups as zombies."
group gnus-level-default-subscribed gnus-level-killed)))
(save-excursion
(set-buffer gnus-group-buffer)
- (gnus-group-make-help-group))
+ ;; Don't error if the group already exists. This happens when a
+ ;; first-time user types 'F'. -- didier
+ (gnus-group-make-help-group t))
(when gnus-novice-user
(gnus-message 7 "`A k' to list killed groups"))))))
(defun gnus-subscribe-group (group &optional previous method)
- "Subcribe GROUP and put it after PREVIOUS."
+ "Subscribe GROUP and put it after PREVIOUS."
(gnus-group-change-level
(if method
(list t group gnus-level-default-subscribed nil nil method)
@@ -1213,9 +1320,9 @@ for new groups, and subscribe the new groups as zombies."
;; it from the newsrc hash table and assoc.
(cond
((>= oldlevel gnus-level-zombie)
- (if (= oldlevel gnus-level-zombie)
- (setq gnus-zombie-list (delete group gnus-zombie-list))
- (setq gnus-killed-list (delete group gnus-killed-list))))
+ ;; oldlevel could be wrong.
+ (setq gnus-zombie-list (delete group gnus-zombie-list))
+ (setq gnus-killed-list (delete group gnus-killed-list)))
(t
(when (and (>= level gnus-level-zombie)
entry)
@@ -1238,7 +1345,11 @@ for new groups, and subscribe the new groups as zombies."
(unless (gnus-group-foreign-p group)
(if (= level gnus-level-zombie)
(push group gnus-zombie-list)
- (push group gnus-killed-list))))
+ (if (= oldlevel gnus-level-killed)
+ ;; Remove from active hashtb.
+ (unintern group gnus-active-hashtb)
+ ;; Don't add it into killed-list if it was killed.
+ (push group gnus-killed-list)))))
(t
;; If the list is to be entered into the newsrc assoc, and
;; it was killed, we have to create an entry in the newsrc
@@ -1306,7 +1417,9 @@ newsgroup."
(setq info (pop newsrc)
group (gnus-info-group info))
(unless (or (gnus-active group) ; Active
- (gnus-info-method info)) ; Foreign
+ (and (gnus-info-method info)
+ (not (gnus-secondary-method-p
+ (gnus-info-method info))))) ; Foreign
;; Found a bogus newsgroup.
(push group bogus)))
(if confirm
@@ -1377,24 +1490,28 @@ newsgroup."
(gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan group method))
t)
- (condition-case ()
+ (if (or debug-on-error debug-on-quit)
(inline (gnus-request-group group dont-check method))
- ;;(error nil)
- (quit
- (message "Quit activating %s" group)
- nil))
- (setq active (gnus-parse-active))
- ;; If there are no articles in the group, the GROUP
- ;; command may have responded with the `(0 . 0)'. We
- ;; ignore this if we already have an active entry
- ;; for the group.
- (if (and (zerop (car active))
- (zerop (cdr active))
- (gnus-active group))
- (gnus-active group)
- (gnus-set-active group active)
- ;; Return the new active info.
- active))))
+ (condition-case nil
+ (inline (gnus-request-group group dont-check method))
+ ;;(error nil)
+ (quit
+ (message "Quit activating %s" group)
+ nil)))
+ (unless dont-check
+ (setq active (gnus-parse-active))
+ ;; If there are no articles in the group, the GROUP
+ ;; command may have responded with the `(0 . 0)'. We
+ ;; ignore this if we already have an active entry
+ ;; for the group.
+ (if (and (zerop (car active))
+ (zerop (cdr active))
+ (gnus-active group))
+ (gnus-active group)
+
+ (gnus-set-active group active)
+ ;; Return the new active info.
+ active)))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
@@ -1411,6 +1528,12 @@ newsgroup."
(when (and gnus-use-cache info)
(inline (gnus-cache-possibly-alter-active
(gnus-info-group info) active)))
+
+ ;; If the agent is enabled, we may have to alter the active info.
+ (when (and gnus-agent info)
+ (gnus-agent-possibly-alter-active
+ (gnus-info-group info) active))
+
;; Modify the list of read articles according to what articles
;; are available; then tally the unread articles and add the
;; number to the group hash table entry.
@@ -1477,13 +1600,15 @@ newsgroup."
(setq range (cdr range)))
(setq num (max 0 (- (cdr active) num)))))
;; Set the number of unread articles.
- (when info
+ (when (and info
+ (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
(setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
num)))
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
(defun gnus-get-unread-articles (&optional level)
+ (setq gnus-server-method-cache nil)
(let* ((newsrc (cdr gnus-newsrc-alist))
(level (or level gnus-activate-level (1+ gnus-level-subscribed)))
(foreign-level
@@ -1495,8 +1620,11 @@ newsgroup."
gnus-activate-foreign-newsgroups)
(t 0))
level))
- scanned-methods info group active method retrievegroups)
- (gnus-message 5 "Checking new news...")
+ (methods-cache nil)
+ (type-cache nil)
+ scanned-methods info group active method retrieve-groups cmethod
+ method-type)
+ (gnus-message 6 "Checking new news...")
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
@@ -1514,17 +1642,30 @@ newsgroup."
;; nil for non-foreign groups that the user has requested not be checked
;; t for unchecked foreign groups or bogus groups, or groups that can't
;; be checked, for one reason or other.
- (if (and (setq method (gnus-info-method info))
- (not (inline
- (gnus-server-equal
- gnus-select-method
- (setq method (gnus-server-get-method nil method)))))
- (not (gnus-secondary-method-p method)))
+ (when (setq method (gnus-info-method info))
+ (if (setq cmethod (assoc method methods-cache))
+ (setq method (cdr cmethod))
+ (setq cmethod (inline (gnus-server-get-method nil method)))
+ (push (cons method cmethod) methods-cache)
+ (setq method cmethod)))
+ (when (and method
+ (not (setq method-type (cdr (assoc method type-cache)))))
+ (setq method-type
+ (cond
+ ((gnus-secondary-method-p method)
+ 'secondary)
+ ((inline (gnus-server-equal gnus-select-method method))
+ 'primary)
+ (t
+ 'foreign)))
+ (push (cons method method-type) type-cache))
+ (if (and method
+ (eq method-type 'foreign))
;; These groups are foreign. Check the level.
(when (and (<= (gnus-info-level info) foreign-level)
- (setq active (gnus-activate-group group 'scan)))
+ (setq active (gnus-activate-group group 'scan)))
;; Let the Gnus agent save the active file.
- (when (and gnus-agent gnus-plugged active)
+ (when (and gnus-agent active (gnus-online method))
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
(unless (inline (gnus-virtual-group-p group))
@@ -1542,10 +1683,10 @@ newsgroup."
(if (gnus-check-backend-function 'retrieve-groups group)
;; if server support gnus-retrieve-groups we push
;; the group onto retrievegroups for later checking
- (if (assoc method retrievegroups)
- (setcdr (assoc method retrievegroups)
- (cons group (cdr (assoc method retrievegroups))))
- (push (list method group) retrievegroups))
+ (if (assoc method retrieve-groups)
+ (setcdr (assoc method retrieve-groups)
+ (cons group (cdr (assoc method retrieve-groups))))
+ (push (list method group) retrieve-groups))
;; hack: `nnmail-get-new-mail' changes the mail-source depending
;; on the group, so we must perform a scan for every group
;; if the users has any directory mail sources.
@@ -1563,8 +1704,8 @@ newsgroup."
(setq active (gnus-activate-group group))
(setq active (gnus-activate-group group 'scan))
(push method scanned-methods))
- (when active
- (gnus-close-group group))))))
+ (when active
+ (gnus-close-group group))))))
;; Get the number of unread articles in the group.
(cond
@@ -1578,33 +1719,33 @@ newsgroup."
;; unread articles and stuff.
(gnus-set-active group nil)
(let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
- (if tmp (setcar tmp t))))))
+ (when tmp
+ (setcar tmp t))))))
;; iterate through groups on methods which support gnus-retrieve-groups
;; and fetch a partial active file and use it to find new news.
- (while retrievegroups
- (let* ((mg (pop retrievegroups))
- (method (or (car mg) gnus-select-method))
- (groups (cdr mg)))
+ (dolist (rg retrieve-groups)
+ (let ((method (or (car rg) gnus-select-method))
+ (groups (cdr rg)))
(when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (gnus-read-active-file-2 (mapcar (lambda (group)
- (gnus-group-real-name group))
- groups) method)
- (dolist (group groups)
- (cond
- ((setq active (gnus-active (gnus-info-group
- (setq info (gnus-get-info group)))))
- (inline (gnus-get-unread-articles-in-group info active t)))
- (t
- ;; The group couldn't be reached, so we nix out the number of
- ;; unread articles and stuff.
- (gnus-set-active group nil)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
-
- (gnus-message 5 "Checking new news...done")))
+ ;; Request that the backend scan its incoming messages.
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (gnus-request-scan nil method))
+ (gnus-read-active-file-2
+ (mapcar (lambda (group) (gnus-group-real-name group)) groups)
+ method)
+ (dolist (group groups)
+ (cond
+ ((setq active (gnus-active (gnus-info-group
+ (setq info (gnus-get-info group)))))
+ (inline (gnus-get-unread-articles-in-group info active t)))
+ (t
+ ;; The group couldn't be reached, so we nix out the number of
+ ;; unread articles and stuff.
+ (gnus-set-active group nil)
+ (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
+
+ (gnus-message 6 "Checking new news...done")))
;; Create a hash table out of the newsrc alist. The `car's of the
;; alist elements are used as keys.
@@ -1664,8 +1805,82 @@ newsgroup."
(setq article (pop articles)) ranges)
(push article news)))
(when news
+ ;; Enter this list into the group info.
(gnus-info-set-read
info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
+ (gnus-group-update-group group t))))
+
+(defun gnus-make-ascending-articles-unread (group articles)
+ "Mark ascending ARTICLES in GROUP as unread."
+ (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash (gnus-group-real-name group)
+ gnus-newsrc-hashtb)))
+ (info (nth 2 entry))
+ (ranges (gnus-info-read info))
+ (r ranges)
+ modified)
+
+ (while articles
+ (let ((article (pop articles))) ; get the next article to remove from ranges
+ (while (let ((range (car ranges))) ; note the current range
+ (if (atom range) ; single value range
+ (cond ((not range)
+ ;; the articles extend past the end of the ranges
+ ;; OK - I'm done
+ (setq articles nil))
+ ((< range article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((= range article)
+ ;; this range exactly matches the article; REMOVE THE RANGE.
+ ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ nil))
+ (let ((min (car range))
+ (max (cdr range)))
+ ;; I have a min/max range to consider
+ (cond ((> min max) ; invalid range introduced by splitter
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))
+ (setq modified (if (car ranges) t 'remove-null))
+ ranges)
+ ((= min max)
+ ;; replace min/max range with a single-value range
+ (setcar ranges min)
+ ranges)
+ ((< max article)
+ ;; this range preceeds the article. Leave the range unmodified.
+ (pop ranges)
+ ranges)
+ ((< article min)
+ ;; this article preceeds the range. Return null to move to the
+ ;; next article
+ nil)
+ (t
+ ;; this article splits the range into two parts
+ (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
+ (setcdr range (1- article))
+ (setq modified t)
+ ranges))))))))
+
+ (when modified
+ (when (eq modified 'remove-null)
+ (setq r (delq nil r)))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read info r)
+
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+
+ ;; Insert the change into the group buffer and the dribble file.
(gnus-group-update-group group t))))
;; Enter all dead groups into the hashtb.
@@ -1731,13 +1946,15 @@ newsgroup."
;; Only do each method once, in case the methods appear more
;; than once in this list.
(unless (member method methods)
- (condition-case ()
+ (if (or debug-on-error debug-on-quit)
(gnus-read-active-file-1 method force)
- ;; We catch C-g so that we can continue past servers
- ;; that do not respond.
- (quit
- (message "Quit reading the active file")
- nil)))))))
+ (condition-case ()
+ (gnus-read-active-file-1 method force)
+ ;; We catch C-g so that we can continue past servers
+ ;; that do not respond.
+ (quit
+ (message "Quit reading the active file")
+ nil))))))))
(defun gnus-read-active-file-1 (method force)
(let (where mesg)
@@ -1782,7 +1999,7 @@ newsgroup."
(gnus-message 5 "%sdone" mesg)))))))
(defun gnus-read-active-file-2 (groups method)
- "Read an active file for GROUPS in METHOD using gnus-retrieve-groups."
+ "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
(when groups
(save-excursion
(set-buffer nntp-server-buffer)
@@ -1829,7 +2046,7 @@ newsgroup."
(insert ?\\)))
;; Let the Gnus agent save the active file.
- (when (and gnus-agent real-active gnus-plugged)
+ (when (and gnus-agent real-active (gnus-online method))
(gnus-agent-save-active method))
;; If these are groups from a foreign select method, we insert the
@@ -1849,7 +2066,7 @@ newsgroup."
(goto-char (point-min))
(let (group max min)
(while (not (eobp))
- (condition-case err
+ (condition-case ()
(progn
(narrow-to-region (point) (gnus-point-at-eol))
;; group gets set to a symbol interned in the hash table
@@ -1905,7 +2122,7 @@ newsgroup."
;; Let the Gnus agent save the active file.
(if (and gnus-agent
real-active
- gnus-plugged
+ (gnus-online method)
(gnus-agent-method-p method))
(progn
(gnus-agent-save-groups method)
@@ -1946,7 +2163,7 @@ newsgroup."
"Read startup file.
If FORCE is non-nil, the .newsrc file is read."
;; Reset variables that might be defined in the .newsrc.eld file.
- (let ((variables gnus-variable-list))
+ (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
(while variables
(set (car variables) nil)
(setq variables (cdr variables))))
@@ -2009,28 +2226,48 @@ If FORCE is non-nil, the .newsrc file is read."
(nconc (gnus-uncompress-range dormant)
(gnus-uncompress-range ticked)))))))))
+(defun gnus-load (file)
+ "Load FILE, but in such a way that read errors can be reported."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (while (not (eobp))
+ (condition-case type
+ (let ((form (read (current-buffer))))
+ (eval form))
+ (error
+ (unless (eq (car type) 'end-of-file)
+ (let ((error (format "Error in %s line %d" file
+ (count-lines (point-min) (point)))))
+ (ding)
+ (unless (gnus-yes-or-no-p (concat error "; continue? "))
+ (error "%s" error)))))))))
+
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
- ;; We always, always read the .eld file.
- (gnus-message 5 "Reading %s..." ding-file)
- (let (gnus-newsrc-assoc)
- (condition-case nil
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (load ding-file t t t))
- (error
- (ding)
- (unless (gnus-yes-or-no-p
- (format "Error in %s; continue? " ding-file))
- (error "Error in %s" ding-file))))
- (when gnus-newsrc-assoc
- (setq gnus-newsrc-alist gnus-newsrc-assoc)))
+ (when (file-exists-p ding-file)
+ ;; We always, always read the .eld file.
+ (gnus-message 5 "Reading %s..." ding-file)
+ (let (gnus-newsrc-assoc)
+ (let ((coding-system-for-read gnus-ding-file-coding-system))
+ (gnus-load ding-file))
+ ;; Older versions of `gnus-format-specs' are no longer valid
+ ;; in Oort Gnus 0.01.
+ (let ((version
+ (and gnus-newsrc-file-version
+ (gnus-continuum-version gnus-newsrc-file-version))))
+ (when (or (not version)
+ (< version 5.090009))
+ (setq gnus-format-specs gnus-default-format-specs)))
+ (when gnus-newsrc-assoc
+ (setq gnus-newsrc-alist gnus-newsrc-assoc))))
(gnus-make-hashtable-from-newsrc-alist)
(when (file-newer-than-file-p file ding-file)
;; Old format quick file
(gnus-message 5 "Reading %s..." file)
;; The .el file is newer than the .eld file, so we read that one
;; as well.
- (gnus-read-old-newsrc-el-file file))))
+ (gnus-read-old-newsrc-el-file file)))
+ (gnus-run-hooks 'gnus-read-newsrc-el-hook))
;; Parse the old-style quick startup file
(defun gnus-read-old-newsrc-el-file (file)
@@ -2156,7 +2393,7 @@ If FORCE is non-nil, the .newsrc file is read."
reads nil)
(if (eolp)
;; If the line ends here, this is clearly a buggy line, so
- ;; we put point at the beginning of line and let the cond
+ ;; we put point a the beginning of line and let the cond
;; below do the error handling.
(beginning-of-line)
;; We skip to the beginning of the ranges.
@@ -2342,6 +2579,12 @@ If FORCE is non-nil, the .newsrc file is read."
(setq gnus-newsrc-options-n out))))
+(eval-and-compile
+ (defalias 'gnus-long-file-names
+ (if (fboundp 'msdos-long-file-names)
+ 'msdos-long-file-names
+ (lambda () t))))
+
(defun gnus-save-newsrc-file (&optional force)
"Save .newsrc file."
;; Note: We cannot save .newsrc file if all newsgroups are removed
@@ -2368,45 +2611,100 @@ If FORCE is non-nil, the .newsrc file is read."
;; Save .newsrc.eld.
(set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
(make-local-variable 'version-control)
- (setq version-control 'never)
+ (setq version-control gnus-backup-startup-file)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
(setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo)
(erase-buffer)
- (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
- (gnus-gnus-to-quick-newsrc-format)
- (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
- (let ((coding-system-for-write gnus-ding-file-coding-system))
- (save-buffer))
- (kill-buffer (current-buffer))
+ (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
+
+ (if gnus-save-startup-file-via-temp-buffer
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (standard-output (current-buffer)))
+ (gnus-gnus-to-quick-newsrc-format)
+ (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
+ (save-buffer))
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (version-control gnus-backup-startup-file)
+ (startup-file (concat gnus-current-startup-file ".eld"))
+ (working-dir (file-name-directory gnus-current-startup-file))
+ working-file
+ (i -1))
+ ;; Generate the name of a non-existent file.
+ (while (progn (setq working-file
+ (format
+ (if (and (eq system-type 'ms-dos)
+ (not (gnus-long-file-names)))
+ "%s#%d.tm#" ; MSDOS limits files to 8+3
+ (if (memq system-type '(vax-vms axp-vms))
+ "%s$tmp$%d"
+ "%s#tmp#%d"))
+ working-dir (setq i (1+ i))))
+ (file-exists-p working-file)))
+
+ (unwind-protect
+ (progn
+ (gnus-with-output-to-file working-file
+ (gnus-gnus-to-quick-newsrc-format)
+ (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
+
+ ;; These bindings will mislead the current buffer
+ ;; into thinking that it is visiting the startup
+ ;; file.
+ (let ((buffer-backed-up nil)
+ (buffer-file-name startup-file)
+ (file-precious-flag t)
+ (setmodes (file-modes startup-file)))
+ ;; Backup the current version of the startup file.
+ (backup-buffer)
+
+ ;; Replace the existing startup file with the temp file.
+ (rename-file working-file startup-file t)
+ (set-file-modes startup-file setmodes)))
+ (condition-case nil
+ (delete-file working-file)
+ (file-error nil)))))
+
+ (gnus-kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
(gnus-dribble-delete-file)
(gnus-group-set-mode-line)))))
-(defun gnus-gnus-to-quick-newsrc-format ()
- "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
- (let ((print-quoted t)
- (print-escape-newlines t))
+(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
+ "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
+ (princ ";; -*- emacs-lisp -*-\n")
+ (if name
+ (princ (format ";; %s\n" name))
+ (princ ";; Gnus startup file.\n"))
- (insert ";; -*- emacs-lisp -*-\n")
- (insert ";; Gnus startup file.\n")
- (insert "\
+ (unless minimal
+ (princ "\
;; Never delete this file -- if you want to force Gnus to read the
;; .newsrc file (if you have one), touch .newsrc instead.\n")
- (insert "(setq gnus-newsrc-file-version "
- (prin1-to-string gnus-version) ")\n")
- (let* ((gnus-killed-list
+ (princ "(setq gnus-newsrc-file-version ")
+ (princ (gnus-prin1-to-string gnus-version))
+ (princ ")\n"))
+
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-escape-newlines t)
+ (gnus-killed-list
(if (and gnus-save-killed-list
(stringp gnus-save-killed-list))
(gnus-strip-killed-list)
gnus-killed-list))
(variables
- (if gnus-save-killed-list gnus-variable-list
- ;; Remove the `gnus-killed-list' from the list of variables
- ;; to be saved, if required.
- (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
+ (or specific-variables
+ (if gnus-save-killed-list gnus-variable-list
+ ;; Remove the `gnus-killed-list' from the list of variables
+ ;; to be saved, if required.
+ (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
;; Peel off the "dummy" group.
(gnus-newsrc-alist (cdr gnus-newsrc-alist))
variable)
@@ -2414,9 +2712,11 @@ If FORCE is non-nil, the .newsrc file is read."
(while variables
(when (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (insert "(setq " (symbol-name variable) " '")
- (gnus-prin1 (symbol-value variable))
- (insert ")\n"))))))
+ (princ "(setq ")
+ (princ (symbol-name variable))
+ (princ " '")
+ (prin1 (symbol-value variable))
+ (princ ")\n")))))
(defun gnus-strip-killed-list ()
"Return the killed list minus the groups that match `gnus-save-killed-list'."
@@ -2624,16 +2924,16 @@ If FORCE is non-nil, the .newsrc file is read."
(skip-chars-forward " \t")
;; ... which leads to this line being effectively ignored.
(when (symbolp group)
- (let ((str (buffer-substring
- (point) (progn (end-of-line) (point))))
- (coding
- (and (or (featurep 'xemacs)
- (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters))
- (fboundp 'gnus-mule-get-coding-system)
- (gnus-mule-get-coding-system (symbol-name group)))))
- (when coding
- (setq str (mm-decode-coding-string str (car coding))))
+ (let* ((str (buffer-substring
+ (point) (progn (end-of-line) (point))))
+ (name (symbol-name group))
+ (charset
+ (or (gnus-group-name-charset method name)
+ (gnus-parameter-charset name)
+ gnus-default-charset)))
+ ;; Fixme: Don't decode in unibyte mode.
+ (when (and str charset (featurep 'mule))
+ (setq str (mm-decode-coding-string str charset)))
(set group str)))
(forward-line 1))))
(gnus-message 5 "Reading descriptions file...done")
@@ -2650,7 +2950,7 @@ If FORCE is non-nil, the .newsrc file is read."
;;;###autoload
(defun gnus-declare-backend (name &rest abilities)
- "Declare backend NAME with ABILITIES as a Gnus backend."
+ "Declare back end NAME with ABILITIES as a Gnus back end."
(setq gnus-valid-select-methods
(nconc gnus-valid-select-methods
(list (apply 'list name abilities))))
@@ -2665,7 +2965,31 @@ If this variable is nil, don't do anything."
(file-name-as-directory (expand-file-name gnus-default-directory))
default-directory)))
+(eval-and-compile
+(defalias 'gnus-display-time-event-handler
+ (if (gnus-boundp 'display-time-timer)
+ 'display-time-event-handler
+ (lambda () "Does nothing as `display-time-timer' is not bound.
+Would otherwise be an alias for `display-time-event-handler'." nil))))
+
+;;;###autoload
+(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
+ (let (server group info)
+ (mapatoms
+ (lambda (sym)
+ (when (and (setq group (symbol-name sym))
+ (gnus-group-entry group)
+ (setq info (symbol-value sym)))
+ (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
+ gnus-newsrc-hashtb)))
+ (if (boundp 'nnimap-mailbox-info)
+ (symbol-value 'nnimap-mailbox-info)
+ (make-vector 1 0)))))
+
+
(provide 'gnus-start)
;;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
;;; gnus-start.el ends here
+
+
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 776d0a53df9..af5a2362194 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1,5 +1,5 @@
;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -26,7 +26,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-group)
@@ -36,12 +38,19 @@
(require 'gnus-undo)
(require 'gnus-util)
(require 'mm-decode)
-;; Recursive :-(.
-;; (require 'gnus-art)
(require 'nnoo)
+
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(autoload 'gnus-cache-write-active "gnus-cache")
+(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
+(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
(autoload 'mm-uu-dissect "mm-uu")
+(autoload 'gnus-article-outlook-deuglify-article "deuglify"
+ "Deuglify broken Outlook (Express) articles and redisplay."
+ t)
+(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
+(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
+(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
@@ -105,6 +114,11 @@ given by the `gnus-summary-same-subject' variable.)"
(const adopt)
(const empty)))
+(defcustom gnus-summary-make-false-root-always nil
+ "Always make a false dummy root."
+ :group 'gnus-thread
+ :type 'boolean)
+
(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
"*A regexp to match subjects to be excluded from loose thread gathering.
As loose thread gathering is done on subjects only, that means that
@@ -132,13 +146,14 @@ comparing subjects."
"List of functions taking a string argument that simplify subjects.
The functions are applied recursively.
-Useful functions to put in this list include: `gnus-simplify-subject-re',
-`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'."
+Useful functions to put in this list include:
+`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
+`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
:group 'gnus-thread
:type '(repeat function))
(defcustom gnus-simplify-ignored-prefixes nil
- "*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
+ "*Remove matches for this regexp from subject lines when simplifying fuzzily."
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
regexp))
@@ -197,6 +212,20 @@ If this variable is nil, scoring will be disabled."
:type '(choice (const :tag "disable")
integer))
+(defcustom gnus-summary-default-high-score 0
+ "*Default threshold for a high scored article.
+An article will be highlighted as high scored if its score is greater
+than this score."
+ :group 'gnus-score-default
+ :type 'integer)
+
+(defcustom gnus-summary-default-low-score 0
+ "*Default threshold for a low scored article.
+An article will be highlighted as low scored if its score is smaller
+than this score."
+ :group 'gnus-score-default
+ :type 'integer)
+
(defcustom gnus-summary-zcore-fuzz 0
"*Fuzziness factor for the zcore in the summary buffer.
Articles with scores closer than this to `gnus-summary-default-score'
@@ -219,11 +248,17 @@ simplification is selected."
(defcustom gnus-thread-hide-subtree nil
"*If non-nil, hide all threads initially.
+This can be a predicate specifier which says which threads to hide.
If threads are hidden, you have to run the command
`gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
to expose hidden threads."
:group 'gnus-thread
- :type 'boolean)
+ :type '(radio (sexp :format "Non-nil\n"
+ :match (lambda (widget value)
+ (not (or (consp value) (functionp value))))
+ :value t)
+ (const nil)
+ (sexp :tag "Predicate specifier" :size 0)))
(defcustom gnus-thread-hide-killed t
"*If non-nil, hide killed threads automatically."
@@ -262,36 +297,44 @@ equal will be included."
:type 'boolean)
(defcustom gnus-auto-select-first t
- "*If nil, don't select the first unread article when entering a group.
-If this variable is `best', select the highest-scored unread article
-in the group. If t, select the first unread article.
-
-This variable can also be a function to place point on a likely
-subject line. Useful values include `gnus-summary-first-unread-subject',
-`gnus-summary-first-unread-article' and
-`gnus-summary-best-unread-article'.
-
-If you want to prevent automatic selection of the first unread article
-in some newsgroups, set the variable to nil in
-`gnus-select-group-hook'."
+ "*If non-nil, select the article under point.
+Which article this is is controlled by the `gnus-auto-select-subject'
+variable.
+
+If you want to prevent automatic selection of articles in some
+newsgroups, set the variable to nil in `gnus-select-group-hook'."
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
- (const best)
- (sexp :menu-tag "first" t)
- (function-item gnus-summary-first-unread-subject)
- (function-item gnus-summary-first-unread-article)
- (function-item gnus-summary-best-unread-article)))
+ (sexp :menu-tag "first" t)))
+
+(defcustom gnus-auto-select-subject 'unread
+ "*Says what subject to place under point when entering a group.
+
+This variable can either be the symbols `first' (place point on the
+first subject), `unread' (place point on the subject line of the first
+unread article), `best' (place point on the subject line of the
+higest-scored article), `unseen' (place point on the subject line of
+the first unseen article), 'unseen-or-unread' (place point on the subject
+line of the first unseen article or, if all article have been seen, on the
+subject line of the first unread article), or a function to be called to
+place point on some subject line."
+ :group 'gnus-group-select
+ :type '(choice (const best)
+ (const unread)
+ (const first)
+ (const unseen)
+ (const unseen-or-unread)))
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
+summary mode and go back to group mode. If the value is neither nil
+nor t, Gnus will select the following unread newsgroup. In
particular, if the value is the symbol `quietly', the next unread
newsgroup will be selected without any confirmation, and if it is
`almost-quietly', the next group will be selected without any
confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
+Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
will go to the next group without confirmation."
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "off" nil)
@@ -307,6 +350,23 @@ the first unread article."
:group 'gnus-summary-maneuvering
:type 'boolean)
+(defcustom gnus-auto-goto-ignores 'unfetched
+ "*Says how to handle unfetched articles when maneuvering.
+
+This variable can either be the symbols nil (maneuver to any
+article), `undownloaded' (maneuvering while unplugged ignores articles
+that have not been fetched), `always-undownloaded' (maneuvering always
+ignores articles that have not been fetched), `unfetched' (maneuvering
+ignores articles whose headers have not been fetched).
+
+NOTE: The list of unfetched articles will always be nil when plugged
+and, when unplugged, a subset of the undownloaded article list."
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Undownloaded when unplugged" undownloaded)
+ (const :tag "Undownloaded" always-undownloaded)
+ (const :tag "Unfetched" unfetched)))
+
(defcustom gnus-summary-check-current nil
"*If non-nil, consider the current article when moving.
The \"unread\" movement commands will stay on the same line if the
@@ -324,6 +384,9 @@ and non-`vertical', do both horizontal and vertical recentering."
(integer :tag "height")
(sexp :menu-tag "both" t)))
+(defvar gnus-auto-center-group t
+ "*If non-nil, always center the group buffer.")
+
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
:group 'gnus-article-hiding
@@ -350,13 +413,15 @@ variable."
(defcustom gnus-move-split-methods nil
"*Variable used to suggest where articles are to be moved to.
-It uses the same syntax as the `gnus-split-methods' variable."
+It uses the same syntax as the `gnus-split-methods' variable.
+However, whereas `gnus-split-methods' specifies file names as targets,
+this variable specifies group names."
:group 'gnus-summary-mail
:type '(repeat (choice (list :value (fun) function)
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
-(defcustom gnus-unread-mark ? ;Whitespace
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
@@ -391,8 +456,13 @@ It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-spam-mark ?$
+ "*Mark used for spam articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-souped-mark ?F
- "*Mark used for killed articles."
+ "*Mark used for souped articles."
:group 'gnus-summary-marks
:type 'character)
@@ -416,13 +486,33 @@ It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-forwarded-mark ?F
+ "*Mark used for articles that have been forwarded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-recent-mark ?N
+ "*Mark used for articles that are recent."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-cached-mark ?*
"*Mark used for articles that are in the cache."
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-saved-mark ?S
- "*Mark used for articles that have been saved to."
+ "*Mark used for articles that have been saved."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-unseen-mark ?.
+ "*Mark used for articles that haven't been seen."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-no-mark ? ;Whitespace
+ "*Mark used for articles that have no other secondary mark."
:group 'gnus-summary-marks
:type 'character)
@@ -446,11 +536,16 @@ It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-undownloaded-mark ?@
+(defcustom gnus-undownloaded-mark ?-
"*Mark used for articles that weren't downloaded."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-downloaded-mark ?+
+ "*Mark used for articles that were downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-downloadable-mark ?%
"*Mark used for articles that are to be downloaded."
:group 'gnus-summary-marks
@@ -471,7 +566,7 @@ It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ? ;Whitespace
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
@@ -523,12 +618,16 @@ list of parameters to that command."
:type 'boolean)
(defcustom gnus-summary-dummy-line-format
- " %(: :%) %S\n"
+ " %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
-%S The subject"
+%S The subject
+
+General format specifiers can also be used.
+See `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:group 'gnus-threading
:type 'string)
@@ -574,29 +673,55 @@ score file."
(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
"*List of functions used for sorting articles in the summary buffer.
-This variable is only used when not using a threaded display."
+
+Each function takes two articles and returns non-nil if the first
+article should be sorted before the other. If you use more than one
+function, the primary sort function should be the last. You should
+probably always include `gnus-article-sort-by-number' in the list of
+sorting functions -- preferably first. Also note that sorting by date
+is often much slower than sorting by number, and the sorting order is
+very similar. (Sorting by date means sorting by the time the message
+was sent, sorting by number means sorting by arrival time.)
+
+Ready-made functions include `gnus-article-sort-by-number',
+`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
+`gnus-article-sort-by-date', `gnus-article-sort-by-random'
+and `gnus-article-sort-by-score'.
+
+When threading is turned on, the variable `gnus-thread-sort-functions'
+controls how articles are sorted."
:group 'gnus-summary-sort
:type '(repeat (choice (function-item gnus-article-sort-by-number)
(function-item gnus-article-sort-by-author)
(function-item gnus-article-sort-by-subject)
(function-item gnus-article-sort-by-date)
(function-item gnus-article-sort-by-score)
+ (function-item gnus-article-sort-by-random)
(function :tag "other"))))
(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
"*List of functions used for sorting threads in the summary buffer.
By default, threads are sorted by article number.
-Each function takes two threads and return non-nil if the first thread
-should be sorted before the other. If you use more than one function,
-the primary sort function should be the last. You should probably
-always include `gnus-thread-sort-by-number' in the list of sorting
-functions -- preferably first.
+Each function takes two threads and returns non-nil if the first
+thread should be sorted before the other. If you use more than one
+function, the primary sort function should be the last. You should
+probably always include `gnus-thread-sort-by-number' in the list of
+sorting functions -- preferably first. Also note that sorting by date
+is often much slower than sorting by number, and the sorting order is
+very similar. (Sorting by date means sorting by the time the message
+was sent, sorting by number means sorting by arrival time.)
Ready-made functions include `gnus-thread-sort-by-number',
`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')."
+`gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
+`gnus-thread-sort-by-most-recent-number',
+`gnus-thread-sort-by-most-recent-date',
+`gnus-thread-sort-by-random', and
+`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
+
+When threading is turned off, the variable
+`gnus-article-sort-functions' controls how articles are sorted."
:group 'gnus-summary-sort
:type '(repeat (choice (function-item gnus-thread-sort-by-number)
(function-item gnus-thread-sort-by-author)
@@ -604,6 +729,7 @@ Ready-made functions include `gnus-thread-sort-by-number',
(function-item gnus-thread-sort-by-date)
(function-item gnus-thread-sort-by-score)
(function-item gnus-thread-sort-by-total-score)
+ (function-item gnus-thread-sort-by-random)
(function :tag "other"))))
(defcustom gnus-thread-score-function '+
@@ -637,10 +763,17 @@ This variable is local to the summary buffers."
(defcustom gnus-summary-mode-hook nil
"*A hook for Gnus summary mode.
This hook is run before any variables are set in the summary buffer."
- :options '(turn-on-gnus-mailing-list-mode)
+ :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
:group 'gnus-summary-various
:type 'hook)
+;; Extracted from gnus-xmas-redefine in order to preserve user settings
+(when (featurep 'xemacs)
+ (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
+ (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
+ (add-hook 'gnus-summary-mode-hook
+ 'gnus-xmas-switch-horizontal-scrollbar-off))
+
(defcustom gnus-summary-menu-hook nil
"*Hook run after the creation of the summary mode menu."
:group 'gnus-summary-visual
@@ -677,21 +810,21 @@ If you'd like to simplify subjects like the
`gnus-summary-next-same-subject' command does, you can use the
following hook:
- (setq gnus-select-group-hook
- (list
- (lambda ()
- (mapcar (lambda (header)
- (mail-header-set-subject
- header
- (gnus-simplify-subject
- (mail-header-subject header) 're-only)))
- gnus-newsgroup-headers))))"
+ (add-hook gnus-select-group-hook
+ (lambda ()
+ (mapcar (lambda (header)
+ (mail-header-set-subject
+ header
+ (gnus-simplify-subject
+ (mail-header-subject header) 're-only)))
+ gnus-newsgroup-headers)))"
:group 'gnus-group-select
:type 'hook)
(defcustom gnus-select-article-hook nil
"*A hook called when an article is selected."
:group 'gnus-summary-choose
+ :options '(gnus-agent-fetch-selected-article)
:type 'hook)
(defcustom gnus-visual-mark-article-hook
@@ -741,64 +874,90 @@ automatically when it is selected."
:group 'gnus-summary
:type 'hook)
+(defcustom gnus-summary-article-move-hook nil
+ "*A hook called after an article is moved, copied, respooled, or crossposted."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-delete-hook nil
+ "*A hook called after an article is deleted."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-expire-hook nil
+ "*A hook called after an article is expired."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-display-arrow
+ (and (fboundp 'display-graphic-p)
+ (display-graphic-p))
+ "*If non-nil, display an arrow highlighting the current article."
+ :version "21.1"
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-summary-selected-face 'gnus-summary-selected-face
"Face used for highlighting the current article in the summary buffer."
:group 'gnus-summary-visual
:type 'face)
+(defvar gnus-tmp-downloaded nil)
+
(defcustom gnus-summary-highlight
- '(((= mark gnus-canceled-mark)
+ '(((eq mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
- ((and (> score default)
- (or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark)))
+ ((and uncached (> score default-high))
+ . gnus-summary-high-undownloaded-face)
+ ((and uncached (< score default-low))
+ . gnus-summary-low-undownloaded-face)
+ (uncached
+ . gnus-summary-normal-undownloaded-face)
+ ((and (> score default-high)
+ (or (eq mark gnus-dormant-mark)
+ (eq mark gnus-ticked-mark)))
. gnus-summary-high-ticked-face)
- ((and (< score default)
- (or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark)))
+ ((and (< score default-low)
+ (or (eq mark gnus-dormant-mark)
+ (eq mark gnus-ticked-mark)))
. gnus-summary-low-ticked-face)
- ((or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark))
+ ((or (eq mark gnus-dormant-mark)
+ (eq mark gnus-ticked-mark))
. gnus-summary-normal-ticked-face)
- ((and (> score default) (= mark gnus-ancient-mark))
+ ((and (> score default-high) (eq mark gnus-ancient-mark))
. gnus-summary-high-ancient-face)
- ((and (< score default) (= mark gnus-ancient-mark))
+ ((and (< score default-low) (eq mark gnus-ancient-mark))
. gnus-summary-low-ancient-face)
- ((= mark gnus-ancient-mark)
+ ((eq mark gnus-ancient-mark)
. gnus-summary-normal-ancient-face)
- ((and (> score default) (= mark gnus-unread-mark))
+ ((and (> score default-high) (eq mark gnus-unread-mark))
. gnus-summary-high-unread-face)
- ((and (< score default) (= mark gnus-unread-mark))
+ ((and (< score default-low) (eq mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((= mark gnus-unread-mark)
+ ((eq mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
- ((and (> score default) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
- . gnus-summary-high-unread-face)
- ((and (< score default) (memq mark (list gnus-downloadable-mark
- gnus-undownloaded-mark)))
- . gnus-summary-low-unread-face)
- ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
- . gnus-summary-normal-unread-face)
- ((> score default)
+ ((> score default-high)
. gnus-summary-high-read-face)
- ((< score default)
+ ((< score default-low)
. gnus-summary-low-read-face)
(t
. gnus-summary-normal-read-face))
"*Controls the highlighting of summary buffer lines.
-A list of (FORM . FACE) pairs. When deciding how a particular summary
-line should be displayed, each form is evaluated. The content of the
-face field after the first true form is used. You can change how those
-summary lines are displayed, by editing the face field.
+A list of (FORM . FACE) pairs. When deciding how a a particular
+summary line should be displayed, each form is evaluated. The content
+of the face field after the first true form is used. You can change
+how those summary lines are displayed, by editing the face field.
You can use the following variables in the FORM field.
-score: The articles score
-default: The default article score.
-below: The score below which articles are automatically marked as read.
-mark: The articles mark."
+score: The article's score
+default: The default article score.
+default-high: The default score for high scored articles.
+default-low: The default score for low scored articles.
+below: The score below which articles are automatically marked as read.
+mark: The article's mark.
+uncached: Non-nil if the article is uncached."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
@@ -814,7 +973,7 @@ which it may alter in any way."
(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
"Variable that says which function should be used to decode a string with encoded words.")
-(defcustom gnus-extra-headers nil
+(defcustom gnus-extra-headers '(To Newsgroups)
"*Extra headers to parse."
:version "21.1"
:group 'gnus-summary
@@ -827,25 +986,6 @@ which it may alter in any way."
:group 'gnus-summary
:type 'regexp)
-(defcustom gnus-group-charset-alist
- '(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
- ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
- ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
- ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
- ("^relcom\\>" koi8-r)
- ("^fido7\\>" koi8-r)
- ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
- ("^israel\\>" iso-8859-1)
- ("^han\\>" euc-kr)
- ("^alt.chinese.text.big5\\>" chinese-big5)
- ("^soc.culture.vietnamese\\>" vietnamese-viqr)
- ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
- (".*" iso-8859-1))
- "Alist of regexps (to match group names) and default charsets to be used when reading."
- :type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
- :group 'gnus-charset)
-
(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
"List of charsets that should be ignored.
When these charsets are used in the \"charset\" parameter, the
@@ -854,14 +994,29 @@ default charset will be used instead."
:type '(repeat symbol)
:group 'gnus-charset)
-(defcustom gnus-group-ignored-charsets-alist
- '(("alt\\.chinese\\.text" iso-8859-1))
- "Alist of regexps (to match group names) and charsets that should be ignored.
+(gnus-define-group-parameter
+ ignored-charsets
+ :type list
+ :function-document
+ "Return the ignored charsets of GROUP."
+ :variable gnus-group-ignored-charsets-alist
+ :variable-default
+ '(("alt\\.chinese\\.text" iso-8859-1))
+ :variable-document
+ "Alist of regexps (to match group names) and charsets that should be ignored.
When these charsets are used in the \"charset\" parameter, the
default charset will be used instead."
- :type '(repeat (cons (regexp :tag "Group")
- (repeat symbol)))
- :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type '(repeat (cons (regexp :tag "Group")
+ (repeat symbol)))
+ :parameter-type '(choice :tag "Ignored charsets"
+ :value nil
+ (repeat (symbol)))
+ :parameter-document "\
+List of charsets that should be ignored.
+
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead.")
(defcustom gnus-group-highlight-words-alist nil
"Alist of group regexps and highlight regexps.
@@ -904,20 +1059,54 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
integer))
(defcustom gnus-summary-save-parts-default-mime "image/.*"
- "*A regexp to match MIME parts when saving multiple parts of a message
-with gnus-summary-save-parts (X m). This regexp will be used by default
-when prompting the user for which type of files to save."
+ "*A regexp to match MIME parts when saving multiple parts of a
+message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
+This regexp will be used by default when prompting the user for which
+type of files to save."
:group 'gnus-summary
:type 'regexp)
+(defcustom gnus-read-all-available-headers nil
+ "Whether Gnus should parse all headers made available to it.
+This is mostly relevant for slow back ends where the user may
+wish to widen the summary buffer to include all headers
+that were fetched. Say, for nnultimate groups."
+ :group 'gnus-summary
+ :type '(choice boolean regexp))
+
+(defcustom gnus-summary-muttprint-program "muttprint"
+ "Command (and optional arguments) used to run Muttprint."
+ :version "21.3"
+ :group 'gnus-summary
+ :type 'string)
+
+(defcustom gnus-article-loose-mime nil
+ "If non-nil, don't require MIME-Version header.
+Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
+supply the MIME-Version header or deliberately strip it From the mail.
+Set it to non-nil, Gnus will treat some articles as MIME even if
+the MIME-Version header is missed."
+ :version "21.3"
+ :type 'boolean
+ :group 'gnus-article-mime)
+
+(defcustom gnus-article-emulate-mime t
+ "If non-nil, use MIME emulation for uuencode and the like.
+This means that Gnus will search message bodies for text that look
+like uuencoded bits, yEncoded bits, and so on, and present that using
+the normal Gnus MIME machinery."
+ :type 'boolean
+ :group 'gnus-article-mime)
;;; Internal variables
+(defvar gnus-summary-display-cache nil)
(defvar gnus-article-mime-handles nil)
(defvar gnus-article-decoded-p nil)
+(defvar gnus-article-charset nil)
+(defvar gnus-article-ignored-charsets nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
-(defvar gnus-inhibit-mime-unbuttonizing nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
@@ -929,7 +1118,7 @@ when prompting the user for which type of files to save."
"Function called to sort the articles within a thread after it has been gathered together.")
(defvar gnus-summary-save-parts-type-history nil)
-(defvar gnus-summary-save-parts-last-directory nil)
+(defvar gnus-summary-save-parts-last-directory mm-default-directory)
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
@@ -940,6 +1129,7 @@ when prompting the user for which type of files to save."
(defvar gnus-current-move-group nil)
(defvar gnus-current-copy-group nil)
(defvar gnus-current-crosspost-group nil)
+(defvar gnus-newsgroup-display nil)
(defvar gnus-newsgroup-dependencies nil)
(defvar gnus-newsgroup-adaptive nil)
@@ -964,7 +1154,9 @@ when prompting the user for which type of files to save."
(?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
(?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
- (?L gnus-tmp-lines ?d)
+ (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
+ (?L gnus-tmp-lines ?s)
+ (?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
(?R gnus-tmp-replied ?c)
@@ -977,7 +1169,8 @@ when prompting the user for which type of files to save."
(?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
- (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s)
+ (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
+ ?s)
(?t (gnus-summary-number-of-articles-in-thread
(and (boundp 'thread) (car thread)) gnus-tmp-level)
?d)
@@ -985,7 +1178,10 @@ when prompting the user for which type of files to save."
(and (boundp 'thread) (car thread)) gnus-tmp-level t)
?c)
(?u gnus-tmp-user-defined ?s)
- (?P (gnus-pick-line-number) ?d))
+ (?P (gnus-pick-line-number) ?d)
+ (?B gnus-tmp-thread-tree-header-string ?s)
+ (user-date (gnus-user-date
+ ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
"An alist of format specifications that can appear in summary lines.
These are paired with what variables they correspond with, along with
the type of the variable (string, integer, character, etc).")
@@ -1008,6 +1204,7 @@ the type of the variable (string, integer, character, etc).")
(?u gnus-tmp-user-defined ?s)
(?d (length gnus-newsgroup-dormant) ?d)
(?t (length gnus-newsgroup-marked) ?d)
+ (?h (length gnus-newsgroup-spam-marked) ?d)
(?r (length gnus-newsgroup-reads) ?d)
(?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
(?E gnus-newsgroup-expunged-tally ?d)
@@ -1019,6 +1216,8 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-last-shell-command nil
"Default shell command on article.")
+(defvar gnus-newsgroup-agentized nil
+ "Locally bound in each summary buffer to indicate whether the server has been agentized.")
(defvar gnus-newsgroup-begin nil)
(defvar gnus-newsgroup-end nil)
(defvar gnus-newsgroup-last-rmail nil)
@@ -1032,12 +1231,13 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-newsgroup-data-reverse nil)
(defvar gnus-newsgroup-limit nil)
(defvar gnus-newsgroup-limits nil)
+(defvar gnus-summary-use-undownloaded-faces nil)
(defvar gnus-newsgroup-unreads nil
- "List of unread articles in the current newsgroup.")
+ "Sorted list of unread articles in the current newsgroup.")
(defvar gnus-newsgroup-unselected nil
- "List of unselected unread articles in the current newsgroup.")
+ "Sorted list of unselected unread articles in the current newsgroup.")
(defvar gnus-newsgroup-reads nil
"Alist of read articles and article marks in the current newsgroup.")
@@ -1045,13 +1245,16 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-newsgroup-expunged-tally nil)
(defvar gnus-newsgroup-marked nil
- "List of ticked articles in the current newsgroup (a subset of unread art).")
+ "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
+
+(defvar gnus-newsgroup-spam-marked nil
+ "List of ranges of articles that have been marked as spam.")
(defvar gnus-newsgroup-killed nil
"List of ranges of articles that have been through the scoring process.")
(defvar gnus-newsgroup-cached nil
- "List of articles that come from the article cache.")
+ "Sorted list of articles that come from the article cache.")
(defvar gnus-newsgroup-saved nil
"List of articles that have been saved.")
@@ -1061,17 +1264,29 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-newsgroup-replied nil
"List of articles that have been replied to in the current newsgroup.")
+(defvar gnus-newsgroup-forwarded nil
+ "List of articles that have been forwarded in the current newsgroup.")
+
+(defvar gnus-newsgroup-recent nil
+ "List of articles that have are recent in the current newsgroup.")
+
(defvar gnus-newsgroup-expirable nil
- "List of articles in the current newsgroup that can be expired.")
+ "Sorted list of articles in the current newsgroup that can be expired.")
(defvar gnus-newsgroup-processable nil
"List of articles in the current newsgroup that can be processed.")
(defvar gnus-newsgroup-downloadable nil
- "List of articles in the current newsgroup that can be processed.")
+ "Sorted list of articles in the current newsgroup that can be processed.")
+
+(defvar gnus-newsgroup-unfetched nil
+ "Sorted list of articles in the current newsgroup whose headers have
+not been fetched into the agent.
+
+This list will always be a subset of gnus-newsgroup-undownloaded.")
(defvar gnus-newsgroup-undownloaded nil
- "List of articles in the current newsgroup that haven't been downloaded..")
+ "List of articles in the current newsgroup that haven't been downloaded.")
(defvar gnus-newsgroup-unsendable nil
"List of articles in the current newsgroup that won't be sent.")
@@ -1080,7 +1295,16 @@ the type of the variable (string, integer, character, etc).")
"List of articles in the current newsgroup that have bookmarks.")
(defvar gnus-newsgroup-dormant nil
- "List of dormant articles in the current newsgroup.")
+ "Sorted list of dormant articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-unseen nil
+ "List of unseen articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-seen nil
+ "Range of seen articles in the current newsgroup.")
+
+(defvar gnus-newsgroup-articles nil
+ "List of articles in the current newsgroup.")
(defvar gnus-newsgroup-scored nil
"List of scored articles in the current newsgroup.")
@@ -1108,18 +1332,25 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-newsgroup-ephemeral-charset nil)
(defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
-(defconst gnus-summary-local-variables
+(defvar gnus-article-before-search nil)
+
+(defvar gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-last-folder gnus-newsgroup-last-file
gnus-newsgroup-auto-expire gnus-newsgroup-unreads
gnus-newsgroup-unselected gnus-newsgroup-marked
+ gnus-newsgroup-spam-marked
gnus-newsgroup-reads gnus-newsgroup-saved
- gnus-newsgroup-replied gnus-newsgroup-expirable
+ gnus-newsgroup-replied gnus-newsgroup-forwarded
+ gnus-newsgroup-recent
+ gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
- gnus-newsgroup-unsendable
+ gnus-newsgroup-unfetched
+ gnus-newsgroup-unsendable gnus-newsgroup-unseen
+ gnus-newsgroup-seen gnus-newsgroup-articles
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
@@ -1141,11 +1372,49 @@ the type of the variable (string, integer, character, etc).")
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits
- gnus-newsgroup-charset)
+ gnus-newsgroup-charset gnus-newsgroup-display
+ gnus-summary-use-undownloaded-faces)
"Variables that are buffer-local to the summary buffers.")
+(defvar gnus-newsgroup-variables nil
+ "A list of variables that have separate values in different newsgroups.
+A list of newsgroup (summary buffer) local variables, or cons of
+variables and their default expressions to be evalled (when the default
+values are not nil), that should be made global while the summary buffer
+is active.
+
+Note: The default expressions will be evaluated (using function `eval')
+before assignment to the local variable rather than just assigned to it.
+If the default expression is the symbol `global', that symbol will not
+be evaluated but the global value of the local variable will be used
+instead.
+
+These variables can be used to set variables in the group parameters
+while still allowing them to affect operations done in other buffers.
+For example:
+
+\(setq gnus-newsgroup-variables
+ '(message-use-followup-to
+ (gnus-visible-headers .
+ \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
+")
+
;; Byte-compiler warning.
-(eval-when-compile (defvar gnus-article-mode-map))
+(eval-when-compile
+ ;; Bind features so that require will believe that gnus-sum has
+ ;; already been loaded (avoids infinite recursion)
+ (let ((features (cons 'gnus-sum features)))
+ ;; Several of the declarations in gnus-sum are needed to load the
+ ;; following files. Right now, these definitions have been
+ ;; compiled but not defined (evaluated). We could either do a
+ ;; eval-and-compile about all of the declarations or evaluate the
+ ;; source file.
+ (if (boundp 'gnus-newsgroup-variables)
+ nil
+ (load "gnus-sum.el" t t t))
+ (require 'gnus)
+ (require 'gnus-agent)
+ (require 'gnus-art)))
;; MIME stuff.
@@ -1153,13 +1422,13 @@ the type of the variable (string, integer, character, etc).")
'(mail-decode-encoded-word-string)
"List of methods used to decode encoded words.
-This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
-FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
-(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
+is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
whose names match REGEXP.
For example:
-((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
+\((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
mail-decode-encoded-word-string
(\"chinese\" . rfc1843-decode-string))")
@@ -1178,7 +1447,7 @@ For example:
(string-match (car x) gnus-newsgroup-name))
(nconc gnus-decode-encoded-word-methods-cache
(list (cdr x))))))
- gnus-decode-encoded-word-methods))
+ gnus-decode-encoded-word-methods))
(let ((xlist gnus-decode-encoded-word-methods-cache))
(pop xlist)
(while xlist
@@ -1189,23 +1458,28 @@ For example:
(defun gnus-simplify-whitespace (str)
"Remove excessive whitespace from STR."
- (let ((mystr str))
- ;; Multiple spaces.
- (while (string-match "[ \t][ \t]+" mystr)
- (setq mystr (concat (substring mystr 0 (match-beginning 0))
- " "
- (substring mystr (match-end 0)))))
- ;; Leading spaces.
- (when (string-match "^[ \t]+" mystr)
- (setq mystr (substring mystr (match-end 0))))
- ;; Trailing spaces.
- (when (string-match "[ \t]+$" mystr)
- (setq mystr (substring mystr 0 (match-beginning 0))))
- mystr))
+ ;; Multiple spaces.
+ (while (string-match "[ \t][ \t]+" str)
+ (setq str (concat (substring str 0 (match-beginning 0))
+ " "
+ (substring str (match-end 0)))))
+ ;; Leading spaces.
+ (when (string-match "^[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ ;; Trailing spaces.
+ (when (string-match "[ \t]+$" str)
+ (setq str (substring str 0 (match-beginning 0))))
+ str)
+
+(defun gnus-simplify-all-whitespace (str)
+ "Remove all whitespace from STR."
+ (while (string-match "[ \t\n]+" str)
+ (setq str (replace-match "" nil nil str)))
+ str)
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
- (if (string-match "^[Rr][Ee]: *" subject)
+ (if (string-match message-subject-re-regexp subject)
(substring subject (match-end 0))
subject))
@@ -1279,7 +1553,7 @@ See `gnus-simplify-buffer-fuzzy' for details."
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to gnus-summary-gather-subject-limit."
+ "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
(cond
(gnus-simplify-subject-functions
(gnus-map-function gnus-simplify-subject-functions subject))
@@ -1295,7 +1569,7 @@ See `gnus-simplify-buffer-fuzzy' for details."
(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
"Check whether two subjects are equal.
-If optional argument simple-first is t, first argument is already
+If optional argument SIMPLE-FIRST is t, first argument is already
simplified."
(cond
((null simple-first)
@@ -1320,352 +1594,467 @@ increase the score of each group you read."
(defvar gnus-article-commands-menu)
-(when t
- ;; Non-orthogonal keys
-
- (gnus-define-keys gnus-summary-mode-map
- " " gnus-summary-next-page
- "\177" gnus-summary-prev-page
- [delete] gnus-summary-prev-page
- [backspace] gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "\M-\r" gnus-summary-scroll-down
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\M-\C-n" gnus-summary-next-same-subject
- "\M-\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "." gnus-summary-first-unread-article
- "," gnus-summary-best-unread-article
- "\M-s" gnus-summary-search-article-forward
- "\M-r" gnus-summary-search-article-backward
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "j" gnus-summary-goto-article
- "^" gnus-summary-refer-parent-article
- "\M-^" gnus-summary-refer-article
- "u" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "U" gnus-summary-tick-article-backward
- "d" gnus-summary-mark-as-read-forward
- "D" gnus-summary-mark-as-read-backward
- "E" gnus-summary-mark-as-expirable
- "\M-u" gnus-summary-clear-mark-forward
- "\M-U" gnus-summary-clear-mark-backward
- "k" gnus-summary-kill-same-subject-and-select
- "\C-k" gnus-summary-kill-same-subject
- "\M-\C-k" gnus-summary-kill-thread
- "\M-\C-l" gnus-summary-lower-thread
- "e" gnus-summary-edit-article
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "\M-\C-t" gnus-summary-toggle-threads
- "\M-\C-s" gnus-summary-show-thread
- "\M-\C-h" gnus-summary-hide-thread
- "\M-\C-f" gnus-summary-next-thread
- "\M-\C-b" gnus-summary-prev-thread
- [(meta down)] gnus-summary-next-thread
- [(meta up)] gnus-summary-prev-thread
- "\M-\C-u" gnus-summary-up-thread
- "\M-\C-d" gnus-summary-down-thread
- "&" gnus-summary-execute-command
- "c" gnus-summary-catchup-and-exit
- "\C-w" gnus-summary-mark-region-as-read
- "\C-t" gnus-summary-toggle-truncation
- "?" gnus-summary-mark-as-dormant
- "\C-c\M-\C-s" gnus-summary-limit-include-expunged
- "\C-c\C-s\C-n" gnus-summary-sort-by-number
- "\C-c\C-s\C-l" gnus-summary-sort-by-lines
- "\C-c\C-s\C-c" gnus-summary-sort-by-chars
- "\C-c\C-s\C-a" gnus-summary-sort-by-author
- "\C-c\C-s\C-s" gnus-summary-sort-by-subject
- "\C-c\C-s\C-d" gnus-summary-sort-by-date
- "\C-c\C-s\C-i" gnus-summary-sort-by-score
- "=" gnus-summary-expand-window
- "\C-x\C-s" gnus-summary-reselect-current-group
- "\M-g" gnus-summary-rescan-group
- "w" gnus-summary-stop-page-breaking
- "\C-c\C-r" gnus-summary-caesar-message
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "C" gnus-summary-cancel-article
- "r" gnus-summary-reply
- "R" gnus-summary-reply-with-original
- "\C-c\C-f" gnus-summary-mail-forward
- "o" gnus-summary-save-article
- "\C-o" gnus-summary-save-article-mail
- "|" gnus-summary-pipe-output
- "\M-k" gnus-summary-edit-local-kill
- "\M-K" gnus-summary-edit-global-kill
- ;; "V" gnus-version
- "\C-c\C-d" gnus-summary-describe-group
- "q" gnus-summary-exit
- "Q" gnus-summary-exit-no-update
- "\C-c\C-i" gnus-info-find-node
- gnus-mouse-2 gnus-mouse-pick-article
- "m" gnus-summary-mail-other-window
- "a" gnus-summary-post-news
- "x" gnus-summary-limit-to-unread
- "s" gnus-summary-isearch-article
- "t" gnus-summary-toggle-header
- "g" gnus-summary-show-article
- "l" gnus-summary-goto-last-article
- "\C-c\C-v\C-v" gnus-uu-decode-uu-view
- "\C-d" gnus-summary-enter-digest-group
- "\M-\C-d" gnus-summary-read-document
- "\M-\C-e" gnus-summary-edit-parameters
- "\M-\C-a" gnus-summary-customize-parameters
- "\C-c\C-b" gnus-bug
- "*" gnus-cache-enter-article
- "\M-*" gnus-cache-remove-article
- "\M-&" gnus-summary-universal-argument
- "\C-l" gnus-recenter
- "I" gnus-summary-increase-score
- "L" gnus-summary-lower-score
- "\M-i" gnus-symbolic-argument
- "h" gnus-summary-select-article-buffer
-
- "b" gnus-article-view-part
- "\M-t" gnus-summary-toggle-display-buttonized
-
- "V" gnus-summary-score-map
- "X" gnus-uu-extract-map
- "S" gnus-summary-send-map)
-
- ;; Sort of orthogonal keymap
- (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
- "t" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "d" gnus-summary-mark-as-read-forward
- "r" gnus-summary-mark-as-read-forward
- "c" gnus-summary-clear-mark-forward
- " " gnus-summary-clear-mark-forward
- "e" gnus-summary-mark-as-expirable
- "x" gnus-summary-mark-as-expirable
- "?" gnus-summary-mark-as-dormant
- "b" gnus-summary-set-bookmark
- "B" gnus-summary-remove-bookmark
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "S" gnus-summary-limit-include-expunged
- "C" gnus-summary-catchup
- "H" gnus-summary-catchup-to-here
- "\C-c" gnus-summary-catchup-all
- "k" gnus-summary-kill-same-subject-and-select
- "K" gnus-summary-kill-same-subject
- "P" gnus-uu-mark-map)
-
- (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
- "c" gnus-summary-clear-above
- "u" gnus-summary-tick-above
- "m" gnus-summary-mark-above
- "k" gnus-summary-kill-below)
-
- (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
- "/" gnus-summary-limit-to-subject
- "n" gnus-summary-limit-to-articles
- "w" gnus-summary-pop-limit
- "s" gnus-summary-limit-to-subject
- "a" gnus-summary-limit-to-author
- "u" gnus-summary-limit-to-unread
- "m" gnus-summary-limit-to-marks
- "M" gnus-summary-limit-exclude-marks
- "v" gnus-summary-limit-to-score
- "*" gnus-summary-limit-include-cached
- "D" gnus-summary-limit-include-dormant
- "T" gnus-summary-limit-include-thread
- "d" gnus-summary-limit-exclude-dormant
- "t" gnus-summary-limit-to-age
- "x" gnus-summary-limit-to-extra
- "E" gnus-summary-limit-include-expunged
- "c" gnus-summary-limit-exclude-childless-dormant
- "C" gnus-summary-limit-mark-excluded-as-read)
-
- (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\C-n" gnus-summary-next-same-subject
- "\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "f" gnus-summary-first-unread-article
- "b" gnus-summary-best-unread-article
- "j" gnus-summary-goto-article
- "g" gnus-summary-goto-subject
- "l" gnus-summary-goto-last-article
- "o" gnus-summary-pop-article)
-
- (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
- "k" gnus-summary-kill-thread
- "l" gnus-summary-lower-thread
- "i" gnus-summary-raise-thread
- "T" gnus-summary-toggle-threads
- "t" gnus-summary-rethread-current
- "^" gnus-summary-reparent-thread
- "s" gnus-summary-show-thread
- "S" gnus-summary-show-all-threads
- "h" gnus-summary-hide-thread
- "H" gnus-summary-hide-all-threads
- "n" gnus-summary-next-thread
- "p" gnus-summary-prev-thread
- "u" gnus-summary-up-thread
- "o" gnus-summary-top-thread
- "d" gnus-summary-down-thread
- "#" gnus-uu-mark-thread
- "\M-#" gnus-uu-unmark-thread)
-
- (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
- "g" gnus-summary-prepare
- "c" gnus-summary-insert-cached-articles)
-
- (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
- "c" gnus-summary-catchup-and-exit
- "C" gnus-summary-catchup-all-and-exit
- "E" gnus-summary-exit-no-update
- "Q" gnus-summary-exit
- "Z" gnus-summary-exit
- "n" gnus-summary-catchup-and-goto-next-group
- "R" gnus-summary-reselect-current-group
- "G" gnus-summary-rescan-group
- "N" gnus-summary-next-group
- "s" gnus-summary-save-newsrc
- "P" gnus-summary-prev-group)
-
- (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
- " " gnus-summary-next-page
- "n" gnus-summary-next-page
- "\177" gnus-summary-prev-page
- [delete] gnus-summary-prev-page
- "p" gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "\M-\r" gnus-summary-scroll-down
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "b" gnus-summary-beginning-of-article
- "e" gnus-summary-end-of-article
- "^" gnus-summary-refer-parent-article
- "r" gnus-summary-refer-parent-article
- "D" gnus-summary-enter-digest-group
- "R" gnus-summary-refer-references
- "T" gnus-summary-refer-thread
- "g" gnus-summary-show-article
- "s" gnus-summary-isearch-article
- "P" gnus-summary-print-article
- "t" gnus-article-babel)
-
- (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
- "b" gnus-article-add-buttons
- "B" gnus-article-add-buttons-to-head
- "o" gnus-article-treat-overstrike
- "e" gnus-article-emphasize
- "w" gnus-article-fill-cited-article
- "Q" gnus-article-fill-long-lines
- "C" gnus-article-capitalize-sentences
- "c" gnus-article-remove-cr
- "q" gnus-article-de-quoted-unreadable
- "6" gnus-article-de-base64-unreadable
- "Z" gnus-article-decode-HZ
- "h" gnus-article-wash-html
- "f" gnus-article-display-x-face
- "l" gnus-summary-stop-page-breaking
- "r" gnus-summary-caesar-message
- "t" gnus-summary-toggle-header
- "v" gnus-summary-verbose-headers
- "H" gnus-article-strip-headers-in-body
- "d" gnus-article-treat-dumbquotes)
-
- (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
- "a" gnus-article-hide
- "h" gnus-article-hide-headers
- "b" gnus-article-hide-boring-headers
- "s" gnus-article-hide-signature
- "c" gnus-article-hide-citation
- "C" gnus-article-hide-citation-in-followups
- "l" gnus-article-hide-list-identifiers
- "p" gnus-article-hide-pgp
- "B" gnus-article-strip-banner
- "P" gnus-article-hide-pem
- "\C-c" gnus-article-hide-citation-maybe)
-
- (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
- "a" gnus-article-highlight
- "h" gnus-article-highlight-headers
- "c" gnus-article-highlight-citation
- "s" gnus-article-highlight-signature)
-
- (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
- "w" gnus-article-decode-mime-words
- "c" gnus-article-decode-charset
- "v" gnus-mime-view-all-parts
- "b" gnus-article-view-part)
-
- (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
- "z" gnus-article-date-ut
- "u" gnus-article-date-ut
- "l" gnus-article-date-local
- "e" gnus-article-date-lapsed
- "o" gnus-article-date-original
- "i" gnus-article-date-iso8601
- "s" gnus-article-date-user)
-
- (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
- "t" gnus-article-remove-trailing-blank-lines
- "l" gnus-article-strip-leading-blank-lines
- "m" gnus-article-strip-multiple-blank-lines
- "a" gnus-article-strip-blank-lines
- "A" gnus-article-strip-all-blank-lines
- "s" gnus-article-strip-leading-space
- "e" gnus-article-strip-trailing-space)
-
- (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
- "v" gnus-version
- "f" gnus-summary-fetch-faq
- "d" gnus-summary-describe-group
- "h" gnus-summary-describe-briefly
- "i" gnus-info-find-node)
-
- (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
- "e" gnus-summary-expire-articles
- "\M-\C-e" gnus-summary-expire-articles-now
- "\177" gnus-summary-delete-article
- [delete] gnus-summary-delete-article
- [backspace] gnus-summary-delete-article
- "m" gnus-summary-move-article
- "r" gnus-summary-respool-article
- "w" gnus-summary-edit-article
- "c" gnus-summary-copy-article
- "B" gnus-summary-crosspost-article
- "q" gnus-summary-respool-query
- "t" gnus-summary-respool-trace
- "i" gnus-summary-import-article
- "p" gnus-summary-article-posted-p)
-
- (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
- "o" gnus-summary-save-article
- "m" gnus-summary-save-article-mail
- "F" gnus-summary-write-article-file
- "r" gnus-summary-save-article-rmail
- "f" gnus-summary-save-article-file
- "b" gnus-summary-save-article-body-file
- "h" gnus-summary-save-article-folder
- "v" gnus-summary-save-article-vm
- "p" gnus-summary-pipe-output
- "s" gnus-soup-add-article)
-
- (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
- "b" gnus-summary-display-buttonized
- "m" gnus-summary-repair-multipart
- "v" gnus-article-view-part
- "o" gnus-article-save-part
- "c" gnus-article-copy-part
- "e" gnus-article-externalize-part
- "i" gnus-article-inline-part
- "|" gnus-article-pipe-part))
+;; Non-orthogonal keys
+
+(gnus-define-keys gnus-summary-mode-map
+ " " gnus-summary-next-page
+ "\177" gnus-summary-prev-page
+ [delete] gnus-summary-prev-page
+ [backspace] gnus-summary-prev-page
+ "\r" gnus-summary-scroll-up
+ "\M-\r" gnus-summary-scroll-down
+ "n" gnus-summary-next-unread-article
+ "p" gnus-summary-prev-unread-article
+ "N" gnus-summary-next-article
+ "P" gnus-summary-prev-article
+ "\M-\C-n" gnus-summary-next-same-subject
+ "\M-\C-p" gnus-summary-prev-same-subject
+ "\M-n" gnus-summary-next-unread-subject
+ "\M-p" gnus-summary-prev-unread-subject
+ "." gnus-summary-first-unread-article
+ "," gnus-summary-best-unread-article
+ "\M-s" gnus-summary-search-article-forward
+ "\M-r" gnus-summary-search-article-backward
+ "<" gnus-summary-beginning-of-article
+ ">" gnus-summary-end-of-article
+ "j" gnus-summary-goto-article
+ "^" gnus-summary-refer-parent-article
+ "\M-^" gnus-summary-refer-article
+ "u" gnus-summary-tick-article-forward
+ "!" gnus-summary-tick-article-forward
+ "U" gnus-summary-tick-article-backward
+ "d" gnus-summary-mark-as-read-forward
+ "D" gnus-summary-mark-as-read-backward
+ "E" gnus-summary-mark-as-expirable
+ "\M-u" gnus-summary-clear-mark-forward
+ "\M-U" gnus-summary-clear-mark-backward
+ "k" gnus-summary-kill-same-subject-and-select
+ "\C-k" gnus-summary-kill-same-subject
+ "\M-\C-k" gnus-summary-kill-thread
+ "\M-\C-l" gnus-summary-lower-thread
+ "e" gnus-summary-edit-article
+ "#" gnus-summary-mark-as-processable
+ "\M-#" gnus-summary-unmark-as-processable
+ "\M-\C-t" gnus-summary-toggle-threads
+ "\M-\C-s" gnus-summary-show-thread
+ "\M-\C-h" gnus-summary-hide-thread
+ "\M-\C-f" gnus-summary-next-thread
+ "\M-\C-b" gnus-summary-prev-thread
+ [(meta down)] gnus-summary-next-thread
+ [(meta up)] gnus-summary-prev-thread
+ "\M-\C-u" gnus-summary-up-thread
+ "\M-\C-d" gnus-summary-down-thread
+ "&" gnus-summary-execute-command
+ "c" gnus-summary-catchup-and-exit
+ "\C-w" gnus-summary-mark-region-as-read
+ "\C-t" gnus-summary-toggle-truncation
+ "?" gnus-summary-mark-as-dormant
+ "\C-c\M-\C-s" gnus-summary-limit-include-expunged
+ "\C-c\C-s\C-n" gnus-summary-sort-by-number
+ "\C-c\C-s\C-l" gnus-summary-sort-by-lines
+ "\C-c\C-s\C-c" gnus-summary-sort-by-chars
+ "\C-c\C-s\C-a" gnus-summary-sort-by-author
+ "\C-c\C-s\C-s" gnus-summary-sort-by-subject
+ "\C-c\C-s\C-d" gnus-summary-sort-by-date
+ "\C-c\C-s\C-i" gnus-summary-sort-by-score
+ "\C-c\C-s\C-o" gnus-summary-sort-by-original
+ "\C-c\C-s\C-r" gnus-summary-sort-by-random
+ "=" gnus-summary-expand-window
+ "\C-x\C-s" gnus-summary-reselect-current-group
+ "\M-g" gnus-summary-rescan-group
+ "w" gnus-summary-stop-page-breaking
+ "\C-c\C-r" gnus-summary-caesar-message
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "C" gnus-summary-cancel-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "\C-c\C-f" gnus-summary-mail-forward
+ "o" gnus-summary-save-article
+ "\C-o" gnus-summary-save-article-mail
+ "|" gnus-summary-pipe-output
+ "\M-k" gnus-summary-edit-local-kill
+ "\M-K" gnus-summary-edit-global-kill
+ ;; "V" gnus-version
+ "\C-c\C-d" gnus-summary-describe-group
+ "q" gnus-summary-exit
+ "Q" gnus-summary-exit-no-update
+ "\C-c\C-i" gnus-info-find-node
+ gnus-mouse-2 gnus-mouse-pick-article
+ "m" gnus-summary-mail-other-window
+ "a" gnus-summary-post-news
+ "i" gnus-summary-news-other-window
+ "x" gnus-summary-limit-to-unread
+ "s" gnus-summary-isearch-article
+ "t" gnus-summary-toggle-header
+ "g" gnus-summary-show-article
+ "l" gnus-summary-goto-last-article
+ "\C-c\C-v\C-v" gnus-uu-decode-uu-view
+ "\C-d" gnus-summary-enter-digest-group
+ "\M-\C-d" gnus-summary-read-document
+ "\M-\C-e" gnus-summary-edit-parameters
+ "\M-\C-a" gnus-summary-customize-parameters
+ "\C-c\C-b" gnus-bug
+ "*" gnus-cache-enter-article
+ "\M-*" gnus-cache-remove-article
+ "\M-&" gnus-summary-universal-argument
+ "\C-l" gnus-recenter
+ "I" gnus-summary-increase-score
+ "L" gnus-summary-lower-score
+ "\M-i" gnus-symbolic-argument
+ "h" gnus-summary-select-article-buffer
+
+ "b" gnus-article-view-part
+ "\M-t" gnus-summary-toggle-display-buttonized
+
+ "V" gnus-summary-score-map
+ "X" gnus-uu-extract-map
+ "S" gnus-summary-send-map)
+
+;; Sort of orthogonal keymap
+(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
+ "t" gnus-summary-tick-article-forward
+ "!" gnus-summary-tick-article-forward
+ "d" gnus-summary-mark-as-read-forward
+ "r" gnus-summary-mark-as-read-forward
+ "c" gnus-summary-clear-mark-forward
+ " " gnus-summary-clear-mark-forward
+ "e" gnus-summary-mark-as-expirable
+ "x" gnus-summary-mark-as-expirable
+ "?" gnus-summary-mark-as-dormant
+ "b" gnus-summary-set-bookmark
+ "B" gnus-summary-remove-bookmark
+ "#" gnus-summary-mark-as-processable
+ "\M-#" gnus-summary-unmark-as-processable
+ "S" gnus-summary-limit-include-expunged
+ "C" gnus-summary-catchup
+ "H" gnus-summary-catchup-to-here
+ "h" gnus-summary-catchup-from-here
+ "\C-c" gnus-summary-catchup-all
+ "k" gnus-summary-kill-same-subject-and-select
+ "K" gnus-summary-kill-same-subject
+ "P" gnus-uu-mark-map)
+
+(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
+ "c" gnus-summary-clear-above
+ "u" gnus-summary-tick-above
+ "m" gnus-summary-mark-above
+ "k" gnus-summary-kill-below)
+
+(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
+ "/" gnus-summary-limit-to-subject
+ "n" gnus-summary-limit-to-articles
+ "w" gnus-summary-pop-limit
+ "s" gnus-summary-limit-to-subject
+ "a" gnus-summary-limit-to-author
+ "u" gnus-summary-limit-to-unread
+ "m" gnus-summary-limit-to-marks
+ "M" gnus-summary-limit-exclude-marks
+ "v" gnus-summary-limit-to-score
+ "*" gnus-summary-limit-include-cached
+ "D" gnus-summary-limit-include-dormant
+ "T" gnus-summary-limit-include-thread
+ "d" gnus-summary-limit-exclude-dormant
+ "t" gnus-summary-limit-to-age
+ "." gnus-summary-limit-to-unseen
+ "x" gnus-summary-limit-to-extra
+ "p" gnus-summary-limit-to-display-predicate
+ "E" gnus-summary-limit-include-expunged
+ "c" gnus-summary-limit-exclude-childless-dormant
+ "C" gnus-summary-limit-mark-excluded-as-read
+ "o" gnus-summary-insert-old-articles
+ "N" gnus-summary-insert-new-articles)
+
+(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
+ "n" gnus-summary-next-unread-article
+ "p" gnus-summary-prev-unread-article
+ "N" gnus-summary-next-article
+ "P" gnus-summary-prev-article
+ "\C-n" gnus-summary-next-same-subject
+ "\C-p" gnus-summary-prev-same-subject
+ "\M-n" gnus-summary-next-unread-subject
+ "\M-p" gnus-summary-prev-unread-subject
+ "f" gnus-summary-first-unread-article
+ "b" gnus-summary-best-unread-article
+ "j" gnus-summary-goto-article
+ "g" gnus-summary-goto-subject
+ "l" gnus-summary-goto-last-article
+ "o" gnus-summary-pop-article)
+
+(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
+ "k" gnus-summary-kill-thread
+ "l" gnus-summary-lower-thread
+ "i" gnus-summary-raise-thread
+ "T" gnus-summary-toggle-threads
+ "t" gnus-summary-rethread-current
+ "^" gnus-summary-reparent-thread
+ "s" gnus-summary-show-thread
+ "S" gnus-summary-show-all-threads
+ "h" gnus-summary-hide-thread
+ "H" gnus-summary-hide-all-threads
+ "n" gnus-summary-next-thread
+ "p" gnus-summary-prev-thread
+ "u" gnus-summary-up-thread
+ "o" gnus-summary-top-thread
+ "d" gnus-summary-down-thread
+ "#" gnus-uu-mark-thread
+ "\M-#" gnus-uu-unmark-thread)
+
+(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
+ "g" gnus-summary-prepare
+ "c" gnus-summary-insert-cached-articles
+ "d" gnus-summary-insert-dormant-articles)
+
+(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
+ "c" gnus-summary-catchup-and-exit
+ "C" gnus-summary-catchup-all-and-exit
+ "E" gnus-summary-exit-no-update
+ "Q" gnus-summary-exit
+ "Z" gnus-summary-exit
+ "n" gnus-summary-catchup-and-goto-next-group
+ "R" gnus-summary-reselect-current-group
+ "G" gnus-summary-rescan-group
+ "N" gnus-summary-next-group
+ "s" gnus-summary-save-newsrc
+ "P" gnus-summary-prev-group)
+
+(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
+ " " gnus-summary-next-page
+ "n" gnus-summary-next-page
+ "\177" gnus-summary-prev-page
+ [delete] gnus-summary-prev-page
+ "p" gnus-summary-prev-page
+ "\r" gnus-summary-scroll-up
+ "\M-\r" gnus-summary-scroll-down
+ "<" gnus-summary-beginning-of-article
+ ">" gnus-summary-end-of-article
+ "b" gnus-summary-beginning-of-article
+ "e" gnus-summary-end-of-article
+ "^" gnus-summary-refer-parent-article
+ "r" gnus-summary-refer-parent-article
+ "D" gnus-summary-enter-digest-group
+ "R" gnus-summary-refer-references
+ "T" gnus-summary-refer-thread
+ "g" gnus-summary-show-article
+ "s" gnus-summary-isearch-article
+ "P" gnus-summary-print-article
+ "M" gnus-mailing-list-insinuate
+ "t" gnus-article-babel)
+
+(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
+ "b" gnus-article-add-buttons
+ "B" gnus-article-add-buttons-to-head
+ "o" gnus-article-treat-overstrike
+ "e" gnus-article-emphasize
+ "w" gnus-article-fill-cited-article
+ "Q" gnus-article-fill-long-lines
+ "C" gnus-article-capitalize-sentences
+ "c" gnus-article-remove-cr
+ "q" gnus-article-de-quoted-unreadable
+ "6" gnus-article-de-base64-unreadable
+ "Z" gnus-article-decode-HZ
+ "h" gnus-article-wash-html
+ "u" gnus-article-unsplit-urls
+ "s" gnus-summary-force-verify-and-decrypt
+ "f" gnus-article-display-x-face
+ "l" gnus-summary-stop-page-breaking
+ "r" gnus-summary-caesar-message
+ "m" gnus-summary-morse-message
+ "t" gnus-summary-toggle-header
+ "g" gnus-treat-smiley
+ "v" gnus-summary-verbose-headers
+ "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
+ "p" gnus-article-verify-x-pgp-sig
+ "d" gnus-article-treat-dumbquotes)
+
+(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
+ ;; mnemonic: deuglif*Y*
+ "u" gnus-article-outlook-unwrap-lines
+ "a" gnus-article-outlook-repair-attribution
+ "c" gnus-article-outlook-rearrange-citation
+ "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
+
+(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
+ "a" gnus-article-hide
+ "h" gnus-article-hide-headers
+ "b" gnus-article-hide-boring-headers
+ "s" gnus-article-hide-signature
+ "c" gnus-article-hide-citation
+ "C" gnus-article-hide-citation-in-followups
+ "l" gnus-article-hide-list-identifiers
+ "B" gnus-article-strip-banner
+ "P" gnus-article-hide-pem
+ "\C-c" gnus-article-hide-citation-maybe)
+
+(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
+ "a" gnus-article-highlight
+ "h" gnus-article-highlight-headers
+ "c" gnus-article-highlight-citation
+ "s" gnus-article-highlight-signature)
+
+(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
+ "f" gnus-article-treat-fold-headers
+ "u" gnus-article-treat-unfold-headers
+ "n" gnus-article-treat-fold-newsgroups)
+
+(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
+ "x" gnus-article-display-x-face
+ "d" gnus-article-display-face
+ "s" gnus-treat-smiley
+ "D" gnus-article-remove-images
+ "f" gnus-treat-from-picon
+ "m" gnus-treat-mail-picon
+ "n" gnus-treat-newsgroups-picon)
+
+(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
+ "w" gnus-article-decode-mime-words
+ "c" gnus-article-decode-charset
+ "v" gnus-mime-view-all-parts
+ "b" gnus-article-view-part)
+
+(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
+ "z" gnus-article-date-ut
+ "u" gnus-article-date-ut
+ "l" gnus-article-date-local
+ "p" gnus-article-date-english
+ "e" gnus-article-date-lapsed
+ "o" gnus-article-date-original
+ "i" gnus-article-date-iso8601
+ "s" gnus-article-date-user)
+
+(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
+ "t" gnus-article-remove-trailing-blank-lines
+ "l" gnus-article-strip-leading-blank-lines
+ "m" gnus-article-strip-multiple-blank-lines
+ "a" gnus-article-strip-blank-lines
+ "A" gnus-article-strip-all-blank-lines
+ "s" gnus-article-strip-leading-space
+ "e" gnus-article-strip-trailing-space
+ "w" gnus-article-remove-leading-whitespace)
+
+(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
+ "v" gnus-version
+ "f" gnus-summary-fetch-faq
+ "d" gnus-summary-describe-group
+ "h" gnus-summary-describe-briefly
+ "i" gnus-info-find-node
+ "c" gnus-group-fetch-charter
+ "C" gnus-group-fetch-control)
+
+(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
+ "e" gnus-summary-expire-articles
+ "\M-\C-e" gnus-summary-expire-articles-now
+ "\177" gnus-summary-delete-article
+ [delete] gnus-summary-delete-article
+ [backspace] gnus-summary-delete-article
+ "m" gnus-summary-move-article
+ "r" gnus-summary-respool-article
+ "w" gnus-summary-edit-article
+ "c" gnus-summary-copy-article
+ "B" gnus-summary-crosspost-article
+ "q" gnus-summary-respool-query
+ "t" gnus-summary-respool-trace
+ "i" gnus-summary-import-article
+ "I" gnus-summary-create-article
+ "p" gnus-summary-article-posted-p)
+
+(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
+ "o" gnus-summary-save-article
+ "m" gnus-summary-save-article-mail
+ "F" gnus-summary-write-article-file
+ "r" gnus-summary-save-article-rmail
+ "f" gnus-summary-save-article-file
+ "b" gnus-summary-save-article-body-file
+ "h" gnus-summary-save-article-folder
+ "v" gnus-summary-save-article-vm
+ "p" gnus-summary-pipe-output
+ "P" gnus-summary-muttprint
+ "s" gnus-soup-add-article)
+
+(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
+ "b" gnus-summary-display-buttonized
+ "m" gnus-summary-repair-multipart
+ "v" gnus-article-view-part
+ "o" gnus-article-save-part
+ "c" gnus-article-copy-part
+ "C" gnus-article-view-part-as-charset
+ "e" gnus-article-view-part-externally
+ "E" gnus-article-encrypt-body
+ "i" gnus-article-inline-part
+ "|" gnus-article-pipe-part)
+
+(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
+ "p" gnus-summary-mark-as-processable
+ "u" gnus-summary-unmark-as-processable
+ "U" gnus-summary-unmark-all-processable
+ "v" gnus-uu-mark-over
+ "s" gnus-uu-mark-series
+ "r" gnus-uu-mark-region
+ "g" gnus-uu-unmark-region
+ "R" gnus-uu-mark-by-regexp
+ "G" gnus-uu-unmark-by-regexp
+ "t" gnus-uu-mark-thread
+ "T" gnus-uu-unmark-thread
+ "a" gnus-uu-mark-all
+ "b" gnus-uu-mark-buffer
+ "S" gnus-uu-mark-sparse
+ "k" gnus-summary-kill-process-mark
+ "y" gnus-summary-yank-process-mark
+ "w" gnus-summary-save-process-mark
+ "i" gnus-uu-invert-processable)
+
+(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
+ ;;"x" gnus-uu-extract-any
+ "m" gnus-summary-save-parts
+ "u" gnus-uu-decode-uu
+ "U" gnus-uu-decode-uu-and-save
+ "s" gnus-uu-decode-unshar
+ "S" gnus-uu-decode-unshar-and-save
+ "o" gnus-uu-decode-save
+ "O" gnus-uu-decode-save
+ "b" gnus-uu-decode-binhex
+ "B" gnus-uu-decode-binhex
+ "p" gnus-uu-decode-postscript
+ "P" gnus-uu-decode-postscript-and-save)
+
+(gnus-define-keys
+ (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
+ "u" gnus-uu-decode-uu-view
+ "U" gnus-uu-decode-uu-and-save-view
+ "s" gnus-uu-decode-unshar-view
+ "S" gnus-uu-decode-unshar-and-save-view
+ "o" gnus-uu-decode-save-view
+ "O" gnus-uu-decode-save-view
+ "b" gnus-uu-decode-binhex-view
+ "B" gnus-uu-decode-binhex-view
+ "p" gnus-uu-decode-postscript-view
+ "P" gnus-uu-decode-postscript-and-save-view)
+
+(defvar gnus-article-post-menu nil)
+
+(defconst gnus-summary-menu-maxlen 20)
+
+(defun gnus-summary-menu-split (menu)
+ ;; If we have lots of elements, divide them into groups of 20
+ ;; and make a pane (or submenu) for each one.
+ (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2))
+ (let ((menu menu) sublists next
+ (i 1))
+ (while menu
+ ;; Pull off the next gnus-summary-menu-maxlen elements
+ ;; and make them the next element of sublist.
+ (setq next (nthcdr gnus-summary-menu-maxlen menu))
+ (if next
+ (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu)
+ nil))
+ (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0)
+ (aref (car (last menu)) 0)) menu)
+ sublists))
+ (setq i (1+ i))
+ (setq menu next))
+ (nreverse sublists))
+ ;; Few elements--put them all in one pane.
+ menu))
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
@@ -1673,152 +2062,224 @@ increase the score of each group you read."
(unless (boundp 'gnus-summary-misc-menu)
(easy-menu-define
- gnus-summary-kill-menu gnus-summary-mode-map ""
- (cons
- "Score"
- (nconc
- (list
- ["Enter score..." gnus-summary-score-entry t]
- ["Customize" gnus-score-customize t])
- (gnus-make-score-map 'increase)
- (gnus-make-score-map 'lower)
- '(("Mark"
- ["Kill below" gnus-summary-kill-below t]
- ["Mark above" gnus-summary-mark-above t]
- ["Tick above" gnus-summary-tick-above t]
- ["Clear above" gnus-summary-clear-above t])
- ["Current score" gnus-summary-current-score t]
- ["Set score" gnus-summary-set-score t]
- ["Switch current score file..." gnus-score-change-score-file t]
- ["Set mark below..." gnus-score-set-mark-below t]
- ["Set expunge below..." gnus-score-set-expunge-below t]
- ["Edit current score file" gnus-score-edit-current-scores t]
- ["Edit score file" gnus-score-edit-file t]
- ["Trace score" gnus-score-find-trace t]
- ["Find words" gnus-score-find-favourite-words t]
- ["Rescore buffer" gnus-summary-rescore t]
- ["Increase score..." gnus-summary-increase-score t]
- ["Lower score..." gnus-summary-lower-score t]))))
-
- ;; Define both the Article menu in the summary buffer and the equivalent
- ;; Commands menu in the article buffer here for consistency.
+ gnus-summary-kill-menu gnus-summary-mode-map ""
+ (cons
+ "Score"
+ (nconc
+ (list
+ ["Customize" gnus-score-customize t])
+ (gnus-make-score-map 'increase)
+ (gnus-make-score-map 'lower)
+ '(("Mark"
+ ["Kill below" gnus-summary-kill-below t]
+ ["Mark above" gnus-summary-mark-above t]
+ ["Tick above" gnus-summary-tick-above t]
+ ["Clear above" gnus-summary-clear-above t])
+ ["Current score" gnus-summary-current-score t]
+ ["Set score" gnus-summary-set-score t]
+ ["Switch current score file..." gnus-score-change-score-file t]
+ ["Set mark below..." gnus-score-set-mark-below t]
+ ["Set expunge below..." gnus-score-set-expunge-below t]
+ ["Edit current score file" gnus-score-edit-current-scores t]
+ ["Edit score file" gnus-score-edit-file t]
+ ["Trace score" gnus-score-find-trace t]
+ ["Find words" gnus-score-find-favourite-words t]
+ ["Rescore buffer" gnus-summary-rescore t]
+ ["Increase score..." gnus-summary-increase-score t]
+ ["Lower score..." gnus-summary-lower-score t]))))
+
+ ;; Define both the Article menu in the summary buffer and the
+ ;; equivalent Commands menu in the article buffer here for
+ ;; consistency.
(let ((innards
- '(("Hide"
- ["All" gnus-article-hide t]
- ["Headers" gnus-article-hide-headers t]
- ["Signature" gnus-article-hide-signature t]
- ["Citation" gnus-article-hide-citation t]
+ `(("Hide"
+ ["All" gnus-article-hide t]
+ ["Headers" gnus-article-hide-headers t]
+ ["Signature" gnus-article-hide-signature t]
+ ["Citation" gnus-article-hide-citation t]
["List identifiers" gnus-article-hide-list-identifiers t]
- ["PGP" gnus-article-hide-pgp t]
["Banner" gnus-article-strip-banner t]
- ["Boring headers" gnus-article-hide-boring-headers t])
- ("Highlight"
- ["All" gnus-article-highlight t]
- ["Headers" gnus-article-highlight-headers t]
- ["Signature" gnus-article-highlight-signature t]
- ["Citation" gnus-article-highlight-citation t])
+ ["Boring headers" gnus-article-hide-boring-headers t])
+ ("Highlight"
+ ["All" gnus-article-highlight t]
+ ["Headers" gnus-article-highlight-headers t]
+ ["Signature" gnus-article-highlight-signature t]
+ ["Citation" gnus-article-highlight-citation t])
("MIME"
["Words" gnus-article-decode-mime-words t]
["Charset" gnus-article-decode-charset t]
["QP" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
- ["View all" gnus-mime-view-all-parts t])
- ("Date"
- ["Local" gnus-article-date-local t]
- ["ISO8601" gnus-article-date-iso8601 t]
- ["UT" gnus-article-date-ut t]
- ["Original" gnus-article-date-original t]
- ["Lapsed" gnus-article-date-lapsed t]
- ["User-defined" gnus-article-date-user t])
- ("Washing"
- ("Remove Blanks"
- ["Leading" gnus-article-strip-leading-blank-lines t]
- ["Multiple" gnus-article-strip-multiple-blank-lines t]
- ["Trailing" gnus-article-remove-trailing-blank-lines t]
- ["All of the above" gnus-article-strip-blank-lines t]
- ["All" gnus-article-strip-all-blank-lines t]
- ["Leading space" gnus-article-strip-leading-space t]
- ["Trailing space" gnus-article-strip-trailing-space t])
- ["Overstrike" gnus-article-treat-overstrike t]
- ["Dumb quotes" gnus-article-treat-dumbquotes t]
- ["Emphasis" gnus-article-emphasize t]
- ["Word wrap" gnus-article-fill-cited-article t]
+ ["View MIME buttons" gnus-summary-display-buttonized t]
+ ["View all" gnus-mime-view-all-parts t]
+ ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
+ ["Encrypt body" gnus-article-encrypt-body
+ :active (not (gnus-group-read-only-p))
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Encrypt the message body on disk"))]
+ ["Extract all parts..." gnus-summary-save-parts t]
+ ("Multipart"
+ ["Repair multipart" gnus-summary-repair-multipart t]
+ ["Pipe part..." gnus-article-pipe-part t]
+ ["Inline part" gnus-article-inline-part t]
+ ["Encrypt body" gnus-article-encrypt-body
+ :active (not (gnus-group-read-only-p))
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Encrypt the message body on disk"))]
+ ["View part externally" gnus-article-view-part-externally t]
+ ["View part with charset..." gnus-article-view-part-as-charset t]
+ ["Copy part" gnus-article-copy-part t]
+ ["Save part..." gnus-article-save-part t]
+ ["View part" gnus-article-view-part t]))
+ ("Date"
+ ["Local" gnus-article-date-local t]
+ ["ISO8601" gnus-article-date-iso8601 t]
+ ["UT" gnus-article-date-ut t]
+ ["Original" gnus-article-date-original t]
+ ["Lapsed" gnus-article-date-lapsed t]
+ ["User-defined" gnus-article-date-user t])
+ ("Display"
+ ["Remove images" gnus-article-remove-images t]
+ ["Toggle smiley" gnus-treat-smiley t]
+ ["Show X-Face" gnus-article-display-x-face t]
+ ["Show picons in From" gnus-treat-from-picon t]
+ ["Show picons in mail headers" gnus-treat-mail-picon t]
+ ["Show picons in news headers" gnus-treat-newsgroups-picon t]
+ ("View as different encoding"
+ ,@(gnus-summary-menu-split
+ (mapcar
+ (lambda (cs)
+ ;; Since easymenu under Emacs doesn't allow
+ ;; lambda forms for menu commands, we should
+ ;; provide intern'ed function symbols.
+ (let ((command (intern (format "\
+gnus-summary-show-article-from-menu-as-charset-%s" cs))))
+ (fset command
+ `(lambda ()
+ (interactive)
+ (let ((gnus-summary-show-article-charset-alist
+ '((1 . ,cs))))
+ (gnus-summary-show-article 1))))
+ `[,(symbol-name cs) ,command t]))
+ (sort (if (fboundp 'coding-system-list)
+ (coding-system-list)
+ (mapcar 'car mm-mime-mule-charset-alist))
+ 'string<)))))
+ ("Washing"
+ ("Remove Blanks"
+ ["Leading" gnus-article-strip-leading-blank-lines t]
+ ["Multiple" gnus-article-strip-multiple-blank-lines t]
+ ["Trailing" gnus-article-remove-trailing-blank-lines t]
+ ["All of the above" gnus-article-strip-blank-lines t]
+ ["All" gnus-article-strip-all-blank-lines t]
+ ["Leading space" gnus-article-strip-leading-space t]
+ ["Trailing space" gnus-article-strip-trailing-space t]
+ ["Leading space in headers"
+ gnus-article-remove-leading-whitespace t])
+ ["Overstrike" gnus-article-treat-overstrike t]
+ ["Dumb quotes" gnus-article-treat-dumbquotes t]
+ ["Emphasis" gnus-article-emphasize t]
+ ["Word wrap" gnus-article-fill-cited-article t]
["Fill long lines" gnus-article-fill-long-lines t]
["Capitalize sentences" gnus-article-capitalize-sentences t]
- ["CR" gnus-article-remove-cr t]
- ["Show X-Face" gnus-article-display-x-face t]
- ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
- ["Base64" gnus-article-de-base64-unreadable t]
- ["Rot 13" gnus-summary-caesar-message
- :help "\"Caesar rotate\" article by 13"]
- ["Unix pipe" gnus-summary-pipe-message t]
- ["Add buttons" gnus-article-add-buttons t]
- ["Add buttons to head" gnus-article-add-buttons-to-head t]
- ["Stop page breaking" gnus-summary-stop-page-breaking t]
- ["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t]
+ ["Remove CR" gnus-article-remove-cr t]
+ ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
+ ["Base64" gnus-article-de-base64-unreadable t]
+ ["Rot 13" gnus-summary-caesar-message
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "\"Caesar rotate\" article by 13"))]
+ ["Morse decode" gnus-summary-morse-message t]
+ ["Unix pipe..." gnus-summary-pipe-message t]
+ ["Add buttons" gnus-article-add-buttons t]
+ ["Add buttons to head" gnus-article-add-buttons-to-head t]
+ ["Stop page breaking" gnus-summary-stop-page-breaking t]
+ ["Verbose header" gnus-summary-verbose-headers t]
+ ["Toggle header" gnus-summary-toggle-header t]
+ ["Unfold headers" gnus-article-treat-unfold-headers t]
+ ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
["Html" gnus-article-wash-html t]
- ["HZ" gnus-article-decode-HZ t])
- ("Output"
- ["Save in default format" gnus-summary-save-article
- :help "Save article using default method"]
- ["Save in file" gnus-summary-save-article-file
- :help "Save article in file"]
- ["Save in Unix mail format" gnus-summary-save-article-mail t]
- ["Save in MH folder" gnus-summary-save-article-folder t]
- ["Save in VM folder" gnus-summary-save-article-vm t]
- ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
- ["Save body in file" gnus-summary-save-article-body-file t]
- ["Pipe through a filter" gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t]
- ["Print" gnus-summary-print-article t])
- ("Backend"
- ["Respool article..." gnus-summary-respool-article t]
- ["Move article..." gnus-summary-move-article
- (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)]
- ["Copy article..." gnus-summary-copy-article t]
- ["Crosspost article..." gnus-summary-crosspost-article
- (gnus-check-backend-function
- 'request-replace-article gnus-newsgroup-name)]
- ["Import file..." gnus-summary-import-article t]
- ["Check if posted" gnus-summary-article-posted-p t]
- ["Edit article" gnus-summary-edit-article
- (not (gnus-group-read-only-p))]
- ["Delete article" gnus-summary-delete-article
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)]
- ["Query respool" gnus-summary-respool-query t]
+ ["Unsplit URLs" gnus-article-unsplit-urls t]
+ ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
+ ["Decode HZ" gnus-article-decode-HZ t]
+ ("(Outlook) Deuglify"
+ ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
+ ["Repair attribution" gnus-article-outlook-repair-attribution t]
+ ["Rearrange citation" gnus-article-outlook-rearrange-citation t]
+ ["Full (Outlook) deuglify"
+ gnus-article-outlook-deuglify-article t])
+ )
+ ("Output"
+ ["Save in default format..." gnus-summary-save-article
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Save article using default method"))]
+ ["Save in file..." gnus-summary-save-article-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Save article in file"))]
+ ["Save in Unix mail format..." gnus-summary-save-article-mail t]
+ ["Save in MH folder..." gnus-summary-save-article-folder t]
+ ["Save in VM folder..." gnus-summary-save-article-vm t]
+ ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
+ ["Save body in file..." gnus-summary-save-article-body-file t]
+ ["Pipe through a filter..." gnus-summary-pipe-output t]
+ ["Add to SOUP packet" gnus-soup-add-article t]
+ ["Print with Muttprint..." gnus-summary-muttprint t]
+ ["Print" gnus-summary-print-article t])
+ ("Backend"
+ ["Respool article..." gnus-summary-respool-article t]
+ ["Move article..." gnus-summary-move-article
+ (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)]
+ ["Copy article..." gnus-summary-copy-article t]
+ ["Crosspost article..." gnus-summary-crosspost-article
+ (gnus-check-backend-function
+ 'request-replace-article gnus-newsgroup-name)]
+ ["Import file..." gnus-summary-import-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
+ ["Create article..." gnus-summary-create-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
+ ["Check if posted" gnus-summary-article-posted-p t]
+ ["Edit article" gnus-summary-edit-article
+ (not (gnus-group-read-only-p))]
+ ["Delete article" gnus-summary-delete-article
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Query respool" gnus-summary-respool-query t]
["Trace respool" gnus-summary-respool-trace t]
- ["Delete expirable articles" gnus-summary-expire-articles-now
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)])
- ("Extract"
- ["Uudecode" gnus-uu-decode-uu
- :help "Decode uuencoded article(s)"]
- ["Uudecode and save" gnus-uu-decode-uu-and-save t]
- ["Unshar" gnus-uu-decode-unshar t]
- ["Unshar and save" gnus-uu-decode-unshar-and-save t]
- ["Save" gnus-uu-decode-save t]
- ["Binhex" gnus-uu-decode-binhex t]
- ["Postscript" gnus-uu-decode-postscript t])
- ("Cache"
- ["Enter article" gnus-cache-enter-article t]
- ["Remove article" gnus-cache-remove-article t])
+ ["Delete expirable articles" gnus-summary-expire-articles-now
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)])
+ ("Extract"
+ ["Uudecode" gnus-uu-decode-uu
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Decode uuencoded article(s)"))]
+ ["Uudecode and save" gnus-uu-decode-uu-and-save t]
+ ["Unshar" gnus-uu-decode-unshar t]
+ ["Unshar and save" gnus-uu-decode-unshar-and-save t]
+ ["Save" gnus-uu-decode-save t]
+ ["Binhex" gnus-uu-decode-binhex t]
+ ["Postscript" gnus-uu-decode-postscript t]
+ ["All MIME parts" gnus-summary-save-parts t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article t])
["Translate" gnus-article-babel t]
- ["Select article buffer" gnus-summary-select-article-buffer t]
- ["Enter digest buffer" gnus-summary-enter-digest-group t]
- ["Isearch article..." gnus-summary-isearch-article t]
- ["Beginning of the article" gnus-summary-beginning-of-article t]
- ["End of the article" gnus-summary-end-of-article t]
- ["Fetch parent of article" gnus-summary-refer-parent-article t]
- ["Fetch referenced articles" gnus-summary-refer-references t]
- ["Fetch current thread" gnus-summary-refer-thread t]
- ["Fetch article with id..." gnus-summary-refer-article t]
- ["Redisplay" gnus-summary-show-article t])))
+ ["Select article buffer" gnus-summary-select-article-buffer t]
+ ["Enter digest buffer" gnus-summary-enter-digest-group t]
+ ["Isearch article..." gnus-summary-isearch-article t]
+ ["Beginning of the article" gnus-summary-beginning-of-article t]
+ ["End of the article" gnus-summary-end-of-article t]
+ ["Fetch parent of article" gnus-summary-refer-parent-article t]
+ ["Fetch referenced articles" gnus-summary-refer-references t]
+ ["Fetch current thread" gnus-summary-refer-thread t]
+ ["Fetch article with id..." gnus-summary-refer-article t]
+ ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
+ ["Redisplay" gnus-summary-show-article t]
+ ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
(easy-menu-define
- gnus-summary-article-menu gnus-summary-mode-map ""
- (cons "Article" innards))
+ gnus-summary-article-menu gnus-summary-mode-map ""
+ (cons "Article" innards))
(if (not (keymapp gnus-summary-article-menu))
(easy-menu-define
@@ -1831,199 +2292,239 @@ increase the score of each group you read."
(cons "Commands" gnus-article-commands-menu))))
(easy-menu-define
- gnus-summary-thread-menu gnus-summary-mode-map ""
- '("Threads"
- ["Toggle threading" gnus-summary-toggle-threads t]
- ["Hide threads" gnus-summary-hide-all-threads t]
- ["Show threads" gnus-summary-show-all-threads t]
- ["Hide thread" gnus-summary-hide-thread t]
- ["Show thread" gnus-summary-show-thread t]
- ["Go to next thread" gnus-summary-next-thread t]
- ["Go to previous thread" gnus-summary-prev-thread t]
- ["Go down thread" gnus-summary-down-thread t]
- ["Go up thread" gnus-summary-up-thread t]
- ["Top of thread" gnus-summary-top-thread t]
- ["Mark thread as read" gnus-summary-kill-thread t]
- ["Lower thread score" gnus-summary-lower-thread t]
- ["Raise thread score" gnus-summary-raise-thread t]
- ["Rethread current" gnus-summary-rethread-current t]))
+ gnus-summary-thread-menu gnus-summary-mode-map ""
+ '("Threads"
+ ["Find all messages in thread" gnus-summary-refer-thread t]
+ ["Toggle threading" gnus-summary-toggle-threads t]
+ ["Hide threads" gnus-summary-hide-all-threads t]
+ ["Show threads" gnus-summary-show-all-threads t]
+ ["Hide thread" gnus-summary-hide-thread t]
+ ["Show thread" gnus-summary-show-thread t]
+ ["Go to next thread" gnus-summary-next-thread t]
+ ["Go to previous thread" gnus-summary-prev-thread t]
+ ["Go down thread" gnus-summary-down-thread t]
+ ["Go up thread" gnus-summary-up-thread t]
+ ["Top of thread" gnus-summary-top-thread t]
+ ["Mark thread as read" gnus-summary-kill-thread t]
+ ["Lower thread score" gnus-summary-lower-thread t]
+ ["Raise thread score" gnus-summary-raise-thread t]
+ ["Rethread current" gnus-summary-rethread-current t]))
(easy-menu-define
- gnus-summary-post-menu gnus-summary-mode-map ""
- '("Post"
- ["Post an article" gnus-summary-post-news
- :help "Post an article"]
- ["Followup" gnus-summary-followup
- :help "Post followup to this article"]
- ["Followup and yank" gnus-summary-followup-with-original
- :help "Post followup to this article, quoting its contents"]
- ["Supersede article" gnus-summary-supersede-article t]
- ["Cancel article" gnus-summary-cancel-article
- :help "Cancel an article you posted"]
- ["Reply" gnus-summary-reply t]
- ["Reply and yank" gnus-summary-reply-with-original t]
- ["Wide reply" gnus-summary-wide-reply t]
- ["Wide reply and yank" gnus-summary-wide-reply-with-original
- :help "Mail a reply, quoting this article"]
- ["Mail forward" gnus-summary-mail-forward t]
- ["Post forward" gnus-summary-post-forward t]
- ["Digest and mail" gnus-uu-digest-mail-forward t]
- ["Digest and post" gnus-uu-digest-post-forward t]
- ["Resend message" gnus-summary-resend-message t]
- ["Send bounced mail" gnus-summary-resend-bounced-mail t]
- ["Send a mail" gnus-summary-mail-other-window t]
- ["Uuencode and post" gnus-uu-post-news
- :help "Post a uuencoded article"]
- ["Followup via news" gnus-summary-followup-to-mail t]
- ["Followup via news and yank"
- gnus-summary-followup-to-mail-with-original t]
- ;;("Draft"
- ;;["Send" gnus-summary-send-draft t]
- ;;["Send bounced" gnus-resend-bounced-mail t])
- ))
+ gnus-summary-post-menu gnus-summary-mode-map ""
+ `("Post"
+ ["Send a message (mail or news)" gnus-summary-post-news
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Post an article"))]
+ ["Followup" gnus-summary-followup
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Post followup to this article"))]
+ ["Followup and yank" gnus-summary-followup-with-original
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Post followup to this article, quoting its contents"))]
+ ["Supersede article" gnus-summary-supersede-article t]
+ ["Cancel article" gnus-summary-cancel-article
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Cancel an article you posted"))]
+ ["Reply" gnus-summary-reply t]
+ ["Reply and yank" gnus-summary-reply-with-original t]
+ ["Wide reply" gnus-summary-wide-reply t]
+ ["Wide reply and yank" gnus-summary-wide-reply-with-original
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mail a reply, quoting this article"))]
+ ["Very wide reply" gnus-summary-very-wide-reply t]
+ ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mail a very wide reply, quoting this article"))]
+ ["Mail forward" gnus-summary-mail-forward t]
+ ["Post forward" gnus-summary-post-forward t]
+ ["Digest and mail" gnus-uu-digest-mail-forward t]
+ ["Digest and post" gnus-uu-digest-post-forward t]
+ ["Resend message" gnus-summary-resend-message t]
+ ["Resend message edit" gnus-summary-resend-message-edit t]
+ ["Send bounced mail" gnus-summary-resend-bounced-mail t]
+ ["Send a mail" gnus-summary-mail-other-window t]
+ ["Create a local message" gnus-summary-news-other-window t]
+ ["Uuencode and post" gnus-uu-post-news
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Post a uuencoded article"))]
+ ["Followup via news" gnus-summary-followup-to-mail t]
+ ["Followup via news and yank"
+ gnus-summary-followup-to-mail-with-original t]
+ ;;("Draft"
+ ;;["Send" gnus-summary-send-draft t]
+ ;;["Send bounced" gnus-resend-bounced-mail t])
+ ))
+
+ (cond
+ ((not (keymapp gnus-summary-post-menu))
+ (setq gnus-article-post-menu gnus-summary-post-menu))
+ ((not gnus-article-post-menu)
+ ;; Don't share post menu.
+ (setq gnus-article-post-menu
+ (copy-keymap gnus-summary-post-menu))))
+ (define-key gnus-article-mode-map [menu-bar post]
+ (cons "Post" gnus-article-post-menu))
(easy-menu-define
- gnus-summary-misc-menu gnus-summary-mode-map ""
- '("Misc"
- ("Mark Read"
- ["Mark as read" gnus-summary-mark-as-read-forward t]
- ["Mark same subject and select"
- gnus-summary-kill-same-subject-and-select t]
- ["Mark same subject" gnus-summary-kill-same-subject t]
- ["Catchup" gnus-summary-catchup
- :help "Mark unread articles in this group as read"]
- ["Catchup all" gnus-summary-catchup-all t]
- ["Catchup to here" gnus-summary-catchup-to-here t]
- ["Catchup region" gnus-summary-mark-region-as-read t]
- ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
- ("Mark Various"
- ["Tick" gnus-summary-tick-article-forward t]
- ["Mark as dormant" gnus-summary-mark-as-dormant t]
- ["Remove marks" gnus-summary-clear-mark-forward t]
- ["Set expirable mark" gnus-summary-mark-as-expirable t]
- ["Set bookmark" gnus-summary-set-bookmark t]
- ["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Mark Limit"
- ["Marks..." gnus-summary-limit-to-marks t]
- ["Subject..." gnus-summary-limit-to-subject t]
- ["Author..." gnus-summary-limit-to-author t]
- ["Age..." gnus-summary-limit-to-age t]
- ["Extra..." gnus-summary-limit-to-extra t]
- ["Score" gnus-summary-limit-to-score t]
- ["Unread" gnus-summary-limit-to-unread t]
- ["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Articles" gnus-summary-limit-to-articles t]
- ["Pop limit" gnus-summary-pop-limit t]
- ["Show dormant" gnus-summary-limit-include-dormant t]
- ["Hide childless dormant"
- gnus-summary-limit-exclude-childless-dormant t]
- ;;["Hide thread" gnus-summary-limit-exclude-thread t]
- ["Hide marked" gnus-summary-limit-exclude-marks t]
- ["Show expunged" gnus-summary-show-all-expunged t])
- ("Process Mark"
- ["Set mark" gnus-summary-mark-as-processable t]
- ["Remove mark" gnus-summary-unmark-as-processable t]
- ["Remove all marks" gnus-summary-unmark-all-processable t]
- ["Mark above" gnus-uu-mark-over t]
- ["Mark series" gnus-uu-mark-series t]
- ["Mark region" gnus-uu-mark-region t]
- ["Unmark region" gnus-uu-unmark-region t]
- ["Mark by regexp..." gnus-uu-mark-by-regexp t]
- ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
- ["Mark all" gnus-uu-mark-all t]
- ["Mark buffer" gnus-uu-mark-buffer t]
- ["Mark sparse" gnus-uu-mark-sparse t]
- ["Mark thread" gnus-uu-mark-thread t]
- ["Unmark thread" gnus-uu-unmark-thread t]
- ("Process Mark Sets"
- ["Kill" gnus-summary-kill-process-mark t]
- ["Yank" gnus-summary-yank-process-mark
- gnus-newsgroup-process-stack]
- ["Save" gnus-summary-save-process-mark t]))
- ("Scroll article"
- ["Page forward" gnus-summary-next-page
- :help "Show next page of article"]
- ["Page backward" gnus-summary-prev-page
- :help "Show previous page of article"]
- ["Line forward" gnus-summary-scroll-up t])
- ("Move"
- ["Next unread article" gnus-summary-next-unread-article t]
- ["Previous unread article" gnus-summary-prev-unread-article t]
- ["Next article" gnus-summary-next-article t]
- ["Previous article" gnus-summary-prev-article t]
- ["Next unread subject" gnus-summary-next-unread-subject t]
- ["Previous unread subject" gnus-summary-prev-unread-subject t]
- ["Next article same subject" gnus-summary-next-same-subject t]
- ["Previous article same subject" gnus-summary-prev-same-subject t]
- ["First unread article" gnus-summary-first-unread-article t]
- ["Best unread article" gnus-summary-best-unread-article t]
- ["Go to subject number..." gnus-summary-goto-subject t]
- ["Go to article number..." gnus-summary-goto-article t]
- ["Go to the last article" gnus-summary-goto-last-article t]
- ["Pop article off history" gnus-summary-pop-article t])
- ("Sort"
- ["Sort by number" gnus-summary-sort-by-number t]
- ["Sort by author" gnus-summary-sort-by-author t]
- ["Sort by subject" gnus-summary-sort-by-subject t]
- ["Sort by date" gnus-summary-sort-by-date t]
- ["Sort by score" gnus-summary-sort-by-score t]
- ["Sort by lines" gnus-summary-sort-by-lines t]
- ["Sort by characters" gnus-summary-sort-by-chars t])
- ("Help"
- ["Fetch group FAQ" gnus-summary-fetch-faq t]
- ["Describe group" gnus-summary-describe-group t]
- ["Read manual" gnus-info-find-node t])
- ("Modes"
- ["Pick and read" gnus-pick-mode t]
- ["Binary" gnus-binary-mode t])
- ("Regeneration"
- ["Regenerate" gnus-summary-prepare t]
- ["Insert cached articles" gnus-summary-insert-cached-articles t]
- ["Toggle threading" gnus-summary-toggle-threads t])
- ["Filter articles..." gnus-summary-execute-command t]
- ["Run command on subjects..." gnus-summary-universal-argument t]
- ["Search articles forward..." gnus-summary-search-article-forward t]
- ["Search articles backward..." gnus-summary-search-article-backward t]
- ["Toggle line truncation" gnus-summary-toggle-truncation t]
- ["Expand window" gnus-summary-expand-window t]
- ["Expire expirable articles" gnus-summary-expire-articles
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)]
- ["Edit local kill file" gnus-summary-edit-local-kill t]
- ["Edit main kill file" gnus-summary-edit-global-kill t]
- ["Edit group parameters" gnus-summary-edit-parameters t]
- ["Customize group parameters" gnus-summary-customize-parameters t]
- ["Send a bug report" gnus-bug t]
- ("Exit"
- ["Catchup and exit" gnus-summary-catchup-and-exit
- :help "Mark unread articles in this group as read, then exit"]
- ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
- ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
- ["Exit group" gnus-summary-exit
- :help "Exit current group, return to group selection mode"]
- ["Exit group without updating" gnus-summary-exit-no-update t]
- ["Exit and goto next group" gnus-summary-next-group t]
- ["Exit and goto prev group" gnus-summary-prev-group t]
- ["Reselect group" gnus-summary-reselect-current-group t]
- ["Rescan group" gnus-summary-rescan-group t]
- ["Update dribble" gnus-summary-save-newsrc t])))
+ gnus-summary-misc-menu gnus-summary-mode-map ""
+ `("Gnus"
+ ("Mark Read"
+ ["Mark as read" gnus-summary-mark-as-read-forward t]
+ ["Mark same subject and select"
+ gnus-summary-kill-same-subject-and-select t]
+ ["Mark same subject" gnus-summary-kill-same-subject t]
+ ["Catchup" gnus-summary-catchup
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark unread articles in this group as read"))]
+ ["Catchup all" gnus-summary-catchup-all t]
+ ["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup from here" gnus-summary-catchup-from-here t]
+ ["Catchup region" gnus-summary-mark-region-as-read
+ (gnus-mark-active-p)]
+ ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
+ ("Mark Various"
+ ["Tick" gnus-summary-tick-article-forward t]
+ ["Mark as dormant" gnus-summary-mark-as-dormant t]
+ ["Remove marks" gnus-summary-clear-mark-forward t]
+ ["Set expirable mark" gnus-summary-mark-as-expirable t]
+ ["Set bookmark" gnus-summary-set-bookmark t]
+ ["Remove bookmark" gnus-summary-remove-bookmark t])
+ ("Limit to"
+ ["Marks..." gnus-summary-limit-to-marks t]
+ ["Subject..." gnus-summary-limit-to-subject t]
+ ["Author..." gnus-summary-limit-to-author t]
+ ["Age..." gnus-summary-limit-to-age t]
+ ["Extra..." gnus-summary-limit-to-extra t]
+ ["Score..." gnus-summary-limit-to-score t]
+ ["Display Predicate" gnus-summary-limit-to-display-predicate t]
+ ["Unread" gnus-summary-limit-to-unread t]
+ ["Unseen" gnus-summary-limit-to-unseen t]
+ ["Non-dormant" gnus-summary-limit-exclude-dormant t]
+ ["Next articles" gnus-summary-limit-to-articles t]
+ ["Pop limit" gnus-summary-pop-limit t]
+ ["Show dormant" gnus-summary-limit-include-dormant t]
+ ["Hide childless dormant"
+ gnus-summary-limit-exclude-childless-dormant t]
+ ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Hide marked" gnus-summary-limit-exclude-marks t]
+ ["Show expunged" gnus-summary-limit-include-expunged t])
+ ("Process Mark"
+ ["Set mark" gnus-summary-mark-as-processable t]
+ ["Remove mark" gnus-summary-unmark-as-processable t]
+ ["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Mark above" gnus-uu-mark-over t]
+ ["Mark series" gnus-uu-mark-series t]
+ ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
+ ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)]
+ ["Mark by regexp..." gnus-uu-mark-by-regexp t]
+ ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
+ ["Mark all" gnus-uu-mark-all t]
+ ["Mark buffer" gnus-uu-mark-buffer t]
+ ["Mark sparse" gnus-uu-mark-sparse t]
+ ["Mark thread" gnus-uu-mark-thread t]
+ ["Unmark thread" gnus-uu-unmark-thread t]
+ ("Process Mark Sets"
+ ["Kill" gnus-summary-kill-process-mark t]
+ ["Yank" gnus-summary-yank-process-mark
+ gnus-newsgroup-process-stack]
+ ["Save" gnus-summary-save-process-mark t]
+ ["Run command on marked..." gnus-summary-universal-argument t]))
+ ("Scroll article"
+ ["Page forward" gnus-summary-next-page
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Show next page of article"))]
+ ["Page backward" gnus-summary-prev-page
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Show previous page of article"))]
+ ["Line forward" gnus-summary-scroll-up t])
+ ("Move"
+ ["Next unread article" gnus-summary-next-unread-article t]
+ ["Previous unread article" gnus-summary-prev-unread-article t]
+ ["Next article" gnus-summary-next-article t]
+ ["Previous article" gnus-summary-prev-article t]
+ ["Next unread subject" gnus-summary-next-unread-subject t]
+ ["Previous unread subject" gnus-summary-prev-unread-subject t]
+ ["Next article same subject" gnus-summary-next-same-subject t]
+ ["Previous article same subject" gnus-summary-prev-same-subject t]
+ ["First unread article" gnus-summary-first-unread-article t]
+ ["Best unread article" gnus-summary-best-unread-article t]
+ ["Go to subject number..." gnus-summary-goto-subject t]
+ ["Go to article number..." gnus-summary-goto-article t]
+ ["Go to the last article" gnus-summary-goto-last-article t]
+ ["Pop article off history" gnus-summary-pop-article t])
+ ("Sort"
+ ["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by author" gnus-summary-sort-by-author t]
+ ["Sort by subject" gnus-summary-sort-by-subject t]
+ ["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by score" gnus-summary-sort-by-score t]
+ ["Sort by lines" gnus-summary-sort-by-lines t]
+ ["Sort by characters" gnus-summary-sort-by-chars t]
+ ["Randomize" gnus-summary-sort-by-random t]
+ ["Original sort" gnus-summary-sort-by-original t])
+ ("Help"
+ ["Fetch group FAQ" gnus-summary-fetch-faq t]
+ ["Describe group" gnus-summary-describe-group t]
+ ["Fetch charter" gnus-group-fetch-charter
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the charter of the current group"))]
+ ["Fetch control message" gnus-group-fetch-control
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Display the archived control message for the current group"))]
+ ["Read manual" gnus-info-find-node t])
+ ("Modes"
+ ["Pick and read" gnus-pick-mode t]
+ ["Binary" gnus-binary-mode t])
+ ("Regeneration"
+ ["Regenerate" gnus-summary-prepare t]
+ ["Insert cached articles" gnus-summary-insert-cached-articles t]
+ ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
+ ["Toggle threading" gnus-summary-toggle-threads t])
+ ["See old articles" gnus-summary-insert-old-articles t]
+ ["See new articles" gnus-summary-insert-new-articles t]
+ ["Filter articles..." gnus-summary-execute-command t]
+ ["Run command on articles..." gnus-summary-universal-argument t]
+ ["Search articles forward..." gnus-summary-search-article-forward t]
+ ["Search articles backward..." gnus-summary-search-article-backward t]
+ ["Toggle line truncation" gnus-summary-toggle-truncation t]
+ ["Expand window" gnus-summary-expand-window t]
+ ["Expire expirable articles" gnus-summary-expire-articles
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Edit local kill file" gnus-summary-edit-local-kill t]
+ ["Edit main kill file" gnus-summary-edit-global-kill t]
+ ["Edit group parameters" gnus-summary-edit-parameters t]
+ ["Customize group parameters" gnus-summary-customize-parameters t]
+ ["Send a bug report" gnus-bug t]
+ ("Exit"
+ ["Catchup and exit" gnus-summary-catchup-and-exit
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark unread articles in this group as read, then exit"))]
+ ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
+ ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
+ ["Exit group" gnus-summary-exit
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Exit current group, return to group selection mode"))]
+ ["Exit group without updating" gnus-summary-exit-no-update t]
+ ["Exit and goto next group" gnus-summary-next-group t]
+ ["Exit and goto prev group" gnus-summary-prev-group t]
+ ["Reselect group" gnus-summary-reselect-current-group t]
+ ["Rescan group" gnus-summary-rescan-group t]
+ ["Update dribble" gnus-summary-save-newsrc t])))
(gnus-run-hooks 'gnus-summary-menu-hook)))
(defvar gnus-summary-tool-bar-map nil)
;; Emacs 21 tool bar. Should be no-op otherwise.
-;; NB: A new function tool-bar-local-item-from-menu is added in Emacs
-;; 21.2.50+. Considering many users use Emacs 21, use
-;; tool-bar-add-item-from-menu here.
(defun gnus-summary-make-tool-bar ()
- (if (and
- (condition-case nil (require 'tool-bar) (error nil))
- (fboundp 'tool-bar-add-item-from-menu)
- (default-value 'tool-bar-mode)
- (not gnus-summary-tool-bar-map))
+ (if (and (fboundp 'tool-bar-add-item-from-menu)
+ (default-value 'tool-bar-mode)
+ (not gnus-summary-tool-bar-map))
(setq gnus-summary-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
+ (let ((tool-bar-map (make-sparse-keymap))
+ (load-path (mm-image-load-path)))
(tool-bar-add-item-from-menu
'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
(tool-bar-add-item-from-menu
@@ -2156,7 +2657,7 @@ and backwards while displaying articles, type `\\[gnus-summary-next-unread-artic
respectively.
You can also post articles and send mail from this buffer. To
-follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
+follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
of an article, type `\\[gnus-summary-reply]'.
There are approx. one gazillion commands you can execute in this
@@ -2171,6 +2672,8 @@ The following commands are available:
(gnus-summary-make-menu-bar)
(gnus-summary-make-tool-bar))
(gnus-summary-make-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-make-local-variables))
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
@@ -2190,9 +2693,10 @@ The following commands are available:
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (make-local-hook 'pre-command-hook)
+ (gnus-make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
(gnus-run-hooks 'gnus-summary-mode-hook)
+ (turn-on-gnus-mailing-list-mode)
(mm-enable-multibyte)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
@@ -2290,7 +2794,7 @@ The following commands are available:
(setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
(when offset
(gnus-data-update-list odata offset)))
- ;; Find the last element in the list to be spliced into the main
+ ;; Find the last element in the list to be spliced into the main
;; list.
(while (cdr list)
(setq list (cdr list)))
@@ -2352,7 +2856,7 @@ The following commands are available:
(defun gnus-article-parent-p (number)
"Say whether this article is a parent or not."
(let ((data (gnus-data-find-list number)))
- (and (cdr data) ; There has to be an article after...
+ (and (cdr data) ; There has to be an article after...
(< (gnus-data-level (car data)) ; And it has to have a higher level.
(gnus-data-level (nth 1 data))))))
@@ -2380,6 +2884,7 @@ The following commands are available:
(defun gnus-article-read-p (article)
"Say whether ARTICLE is read or not."
(not (or (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-spam-marked)
(memq article gnus-newsgroup-unreads)
(memq article gnus-newsgroup-unselected)
(memq article gnus-newsgroup-dormant))))
@@ -2470,6 +2975,7 @@ article number."
This is all marks except unread, ticked, dormant, and expirable."
(not (or (= mark gnus-unread-mark)
(= mark gnus-ticked-mark)
+ (= mark gnus-spam-mark)
(= mark gnus-dormant-mark)
(= mark gnus-expirable-mark))))
@@ -2481,10 +2987,10 @@ time; i.e., when generating the summary lines. After that,
marks of articles."
`(cond
((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
- ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
+ ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
(t (or (cdr (assq ,number gnus-newsgroup-reads))
@@ -2492,9 +2998,6 @@ marks of articles."
;; Saving hidden threads.
-(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
-(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
-
(defmacro gnus-save-hidden-threads (&rest forms)
"Save hidden threads, eval FORMS, and restore the hidden threads."
(let ((config (make-symbol "config")))
@@ -2503,6 +3006,8 @@ marks of articles."
(save-excursion
,@forms)
(gnus-restore-hidden-threads-configuration ,config)))))
+(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
+(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
(defun gnus-data-compute-positions ()
"Compute the positions of all articles."
@@ -2558,7 +3063,7 @@ display only a single character."
;; Nix out all the control chars...
(while (>= (setq i (1- i)) 0)
(aset table i [??]))
- ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; ... but not newline and cr, of course. (cr is necessary for the
;; selective display).
(aset table ?\n nil)
(aset table ?\r nil)
@@ -2572,9 +3077,29 @@ display only a single character."
(aset table i [??]))))
(setq buffer-display-table table)))
+(defun gnus-summary-set-article-display-arrow (pos)
+ "Update the overlay arrow to point to line at position POS."
+ (when (and gnus-summary-display-arrow
+ (boundp 'overlay-arrow-position)
+ (boundp 'overlay-arrow-string))
+ (save-excursion
+ (goto-char pos)
+ (beginning-of-line)
+ (unless overlay-arrow-position
+ (setq overlay-arrow-position (make-marker)))
+ (setq overlay-arrow-string "=>"
+ overlay-arrow-position (set-marker overlay-arrow-position
+ (point)
+ (current-buffer))))))
+
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
- (let ((buffer (concat "*Summary " group "*")))
+ (let ((buffer (gnus-summary-buffer-name group))
+ (dead-name (concat "*Dead Summary "
+ (gnus-group-decoded-name group) "*")))
+ ;; If a dead summary buffer exists, we kill it.
+ (when (gnus-buffer-live-p dead-name)
+ (gnus-kill-buffer dead-name))
(if (get-buffer buffer)
(progn
(set-buffer buffer)
@@ -2590,6 +3115,8 @@ display only a single character."
(make-local-variable 'gnus-article-current)
(make-local-variable 'gnus-original-article-buffer))
(setq gnus-newsgroup-name group)
+ ;; Set any local variables in the group parameters.
+ (gnus-summary-set-local-parameters gnus-newsgroup-name)
t)))
(defun gnus-set-global-variables ()
@@ -2600,6 +3127,7 @@ buffer that was in action when the last article was fetched."
(setq gnus-summary-buffer (current-buffer))
(let ((name gnus-newsgroup-name)
(marked gnus-newsgroup-marked)
+ (spam gnus-newsgroup-spam-marked)
(unread gnus-newsgroup-unreads)
(headers gnus-current-headers)
(data gnus-newsgroup-data)
@@ -2609,11 +3137,20 @@ buffer that was in action when the last article was fetched."
(gac gnus-article-current)
(reffed gnus-reffed-article-number)
(score-file gnus-current-score-file)
- (default-charset gnus-newsgroup-charset))
+ (default-charset gnus-newsgroup-charset)
+ vlist)
+ (let ((locals gnus-newsgroup-variables))
+ (while locals
+ (if (consp (car locals))
+ (push (eval (caar locals)) vlist)
+ (push (eval (car locals)) vlist))
+ (setq locals (cdr locals)))
+ (setq vlist (nreverse vlist)))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
+ gnus-newsgroup-spam-marked spam
gnus-newsgroup-unreads unread
gnus-current-headers headers
gnus-newsgroup-data data
@@ -2624,6 +3161,12 @@ buffer that was in action when the last article was fetched."
gnus-reffed-article-number reffed
gnus-current-score-file score-file
gnus-newsgroup-charset default-charset)
+ (let ((locals gnus-newsgroup-variables))
+ (while locals
+ (if (consp (car locals))
+ (set (caar locals) (pop vlist))
+ (set (car locals) (pop vlist)))
+ (setq locals (cdr locals))))
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
@@ -2665,15 +3208,16 @@ buffer that was in action when the last article was fetched."
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
- (gnus-download-mark 131)
+ (gnus-undownloaded-mark 131)
(spec gnus-summary-line-format-spec)
gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
- (gnus-newsgroup-downloadable '((0 . t))))
+ (gnus-newsgroup-downloadable '(0)))
(gnus-summary-insert-line
- [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1)
+ [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
+ 0 nil t 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) (point-min) 1)))))
@@ -2699,36 +3243,36 @@ buffer that was in action when the last article was fetched."
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defun gnus-summary-from-or-to-or-newsgroups (header)
- (let ((to (cdr (assq 'To (mail-header-extra header))))
- (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))
- (mail-parse-charset gnus-newsgroup-charset)
+(defun gnus-summary-extract-address-component (from)
+ (or (car (funcall gnus-extract-address-components from))
+ from))
+
+(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ ; Is it really necessary to do this next part for each summary line?
+ ; Luckily, doesn't seem to slow things down much.
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
- (cond
- ((and to
- gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses
- (mail-header-from header)))
- (concat "-> "
- (or (car (funcall gnus-extract-address-components
- (funcall
- gnus-decode-encoded-word-function to)))
- (funcall gnus-decode-encoded-word-function to))))
- ((and newsgroups
- gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses
- (mail-header-from header)))
- (concat "=> " newsgroups))
- (t
- (or (car (funcall gnus-extract-address-components
- (mail-header-from header)))
- (mail-header-from header))))))
+ (or
+ (and gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses gnus-tmp-from)
+ (let ((extra-headers (mail-header-extra header))
+ to
+ newsgroups)
+ (cond
+ ((setq to (cdr (assq 'To extra-headers)))
+ (concat "-> "
+ (inline
+ (gnus-summary-extract-address-component
+ (funcall gnus-decode-encoded-word-function to)))))
+ ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
+ (concat "=> " newsgroups)))))
+ (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
- gnus-tmp-unread gnus-tmp-replied
+ undownloaded gnus-tmp-unread gnus-tmp-replied
gnus-tmp-expirable gnus-tmp-subject-or-nil
&optional gnus-tmp-dummy gnus-tmp-score
gnus-tmp-process)
@@ -2739,43 +3283,58 @@ buffer that was in action when the last article was fetched."
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
+ (gnus-tmp-number (mail-header-number gnus-tmp-header))
(gnus-tmp-replied
(cond (gnus-tmp-process gnus-process-mark)
((memq gnus-tmp-current gnus-newsgroup-cached)
gnus-cached-mark)
(gnus-tmp-replied gnus-replied-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-forwarded)
+ gnus-forwarded-mark)
((memq gnus-tmp-current gnus-newsgroup-saved)
gnus-saved-mark)
- (t gnus-unread-mark)))
+ ((memq gnus-tmp-number gnus-newsgroup-recent)
+ gnus-recent-mark)
+ ((memq gnus-tmp-number gnus-newsgroup-unseen)
+ gnus-unseen-mark)
+ (t gnus-no-mark)))
+ (gnus-tmp-downloaded
+ (cond (undownloaded
+ gnus-undownloaded-mark)
+ (gnus-newsgroup-agentized
+ gnus-downloaded-mark)
+ (t
+ gnus-no-mark)))
(gnus-tmp-from (mail-header-from gnus-tmp-header))
(gnus-tmp-name
(cond
((string-match "<[^>]+> *$" gnus-tmp-from)
(let ((beg (match-beginning 0)))
- (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
- (substring gnus-tmp-from (1+ (match-beginning 0))
- (1- (match-end 0))))
+ (or (and (string-match "^\".+\"" gnus-tmp-from)
+ (substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg))))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
- (gnus-tmp-number (mail-header-number gnus-tmp-header))
(gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
(gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
(buffer-read-only nil))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
- (setq gnus-tmp-lines 0))
- (gnus-put-text-property
+ (setq gnus-tmp-lines -1))
+ (if (= gnus-tmp-lines -1)
+ (setq gnus-tmp-lines "?")
+ (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number gnus-tmp-number)
+ 'gnus-number gnus-tmp-number)
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
(gnus-run-hooks 'gnus-summary-update-hook)
@@ -2804,7 +3363,7 @@ buffer that was in action when the last article was fetched."
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
@@ -2819,7 +3378,7 @@ buffer that was in action when the last article was fetched."
This may be 0 in some cases -- if none of the articles in
the thread are to be displayed."
(let* ((number
- ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
+ ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
(cond
((not (listp thread))
1)
@@ -2842,9 +3401,22 @@ the thread are to be displayed."
gnus-empty-thread-mark)
number)))
+(defsubst gnus-summary-line-message-size (head)
+ "Return pretty-printed version of message size.
+This function is intended to be used in
+`gnus-summary-line-format-alist'."
+ (let ((c (or (mail-header-chars head) -1)))
+ (cond ((< c 0) "n/a") ; chars not available
+ ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
+ ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
+ ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
+ (t (format "%dM" (/ c (* 1024.0 1024)))))))
+
+
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
(let ((params (gnus-group-find-parameter group))
+ (vars '(quit-config)) ; Ignore quit-config.
elem)
(while params
(setq elem (car params)
@@ -2852,8 +3424,9 @@ the thread are to be displayed."
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
- (not (memq (car elem) '(quit-config))) ; Ignore quit-config.
+ (not (memq (car elem) vars))
(ignore-errors ; So we set it.
+ (push (car elem) vars)
(make-local-variable (car elem))
(set (car elem) (eval (nth 1 elem))))))))
@@ -2890,10 +3463,11 @@ If NO-DISPLAY, don't generate a summary buffer."
kill-buffer no-display
&optional select-articles)
;; Killed foreign groups can't be entered.
- (when (and (not (gnus-group-native-p group))
- (not (gnus-gethash group gnus-newsrc-hashtb)))
- (error "Dead non-native groups can't be entered"))
- (gnus-message 5 "Retrieving newsgroup: %s..." group)
+ ;; (when (and (not (gnus-group-native-p group))
+ ;; (not (gnus-gethash group gnus-newsrc-hashtb)))
+ ;; (error "Dead non-native groups can't be entered"))
+ (gnus-message 5 "Retrieving newsgroup: %s..."
+ (gnus-group-decoded-name group))
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
(did-select (and new-group (gnus-select-newsgroup
@@ -2923,7 +3497,11 @@ If NO-DISPLAY, don't generate a summary buffer."
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(gnus-handle-ephemeral-exit quit-config)))
- (gnus-message 3 "Can't select group")
+ (let ((grpinfo (gnus-get-info group)))
+ (if (null (gnus-info-read grpinfo))
+ (gnus-message 3 "Group %s contains no messages"
+ (gnus-group-decoded-name group))
+ (gnus-message 3 "Can't select group")))
nil)
;; The user did a `C-g' while prompting for number of articles,
;; so we exit this group.
@@ -2951,8 +3529,6 @@ If NO-DISPLAY, don't generate a summary buffer."
(gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
(gnus-run-hooks 'gnus-select-group-hook)
- ;; Set any local variables in the group parameters.
- (gnus-summary-set-local-parameters gnus-newsgroup-name)
(gnus-update-format-specifications
nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions)
@@ -3004,11 +3580,10 @@ If NO-DISPLAY, don't generate a summary buffer."
;; Hide conversation thread subtrees. We cannot do this in
;; gnus-summary-prepare-hook since kill processing may not
;; work with hidden articles.
- (and gnus-show-threads
- gnus-thread-hide-subtree
- (gnus-summary-hide-all-threads))
+ (gnus-summary-maybe-hide-threads)
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
+ (gnus-summary-auto-select-subject)
;; Show first unread article if requested.
(if (and (not no-article)
(not no-display)
@@ -3016,20 +3591,17 @@ If NO-DISPLAY, don't generate a summary buffer."
gnus-auto-select-first)
(progn
(gnus-configure-windows 'summary)
- (cond
- ((eq gnus-auto-select-first 'best)
- (gnus-summary-best-unread-article))
- ((eq gnus-auto-select-first t)
- (gnus-summary-first-unread-article))
- ((gnus-functionp gnus-auto-select-first)
- (funcall gnus-auto-select-first))))
- ;; Don't select any articles, just move point to the first
- ;; article in the group.
- (goto-char (point-min))
+ (let ((art (gnus-summary-article-number)))
+ (unless (and (not gnus-plugged)
+ (or (memq art gnus-newsgroup-undownloaded)
+ (memq art gnus-newsgroup-downloadable)))
+ (gnus-summary-goto-article art))))
+ ;; Don't select any articles.
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
(gnus-set-mode-line 'summary))
- (when (get-buffer-window gnus-group-buffer t)
+ (when (and gnus-auto-center-group
+ (get-buffer-window gnus-group-buffer t))
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(let ((owin (selected-window)))
@@ -3040,8 +3612,28 @@ If NO-DISPLAY, don't generate a summary buffer."
;; Mark this buffer as "prepared".
(setq gnus-newsgroup-prepared t)
(gnus-run-hooks 'gnus-summary-prepared-hook)
+ (unless (gnus-ephemeral-group-p group)
+ (gnus-group-update-group group))
t)))))
+(defun gnus-summary-auto-select-subject ()
+ "Select the subject line on initial group entry."
+ (goto-char (point-min))
+ (cond
+ ((eq gnus-auto-select-subject 'best)
+ (gnus-summary-best-unread-subject))
+ ((eq gnus-auto-select-subject 'unread)
+ (gnus-summary-first-unread-subject))
+ ((eq gnus-auto-select-subject 'unseen)
+ (gnus-summary-first-unseen-subject))
+ ((eq gnus-auto-select-subject 'unseen-or-unread)
+ (gnus-summary-first-unseen-or-unread-subject))
+ ((eq gnus-auto-select-subject 'first)
+ ;; Do nothing.
+ )
+ ((functionp gnus-auto-select-subject)
+ (funcall gnus-auto-select-subject))))
+
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(interactive)
@@ -3066,7 +3658,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(gnus-run-hooks 'gnus-summary-prepare-hook)))
(defsubst gnus-general-simplify-subject (subject)
- "Simply subject by the same rules as gnus-gather-threads-by-subject."
+ "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
(setq subject
(cond
;; Truncate the subject.
@@ -3086,7 +3678,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(if (and gnus-summary-gather-exclude-subject
(string-match gnus-summary-gather-exclude-subject subject))
- nil ; This article shouldn't be gathered
+ nil ; This article shouldn't be gathered
subject))
(defun gnus-summary-simplify-subject-query ()
@@ -3122,7 +3714,16 @@ If NO-DISPLAY, don't generate a summary buffer."
(setcdr prev (cdr threads))
(setq threads prev))
;; Enter this thread into the hash table.
- (gnus-sethash subject threads hashtb)))
+ (gnus-sethash subject
+ (if gnus-summary-make-false-root-always
+ (progn
+ ;; If you want a dummy root above all
+ ;; threads...
+ (setcar threads (list whole-subject
+ (car threads)))
+ threads)
+ threads)
+ hashtb)))
(setq prev threads)
(setq threads (cdr threads)))
result)))
@@ -3137,7 +3738,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(while threads
(when (setq references (mail-header-references (caar threads)))
(setq id (mail-header-id (caar threads))
- ids (gnus-split-references references)
+ ids (inline (gnus-split-references references))
entered nil)
(while (setq ref (pop ids))
(setq ids (delete ref ids))
@@ -3221,8 +3822,8 @@ If NO-DISPLAY, don't generate a summary buffer."
(setq threads nil)
(throw 'infloop t))
(unless (car (symbol-value refs))
- ;; These threads do not refer back to any other articles,
- ;; so they're roots.
+ ;; These threads do not refer back to any other
+ ;; articles, so they're roots.
(setq threads (append (cdr (symbol-value refs)) threads))))
gnus-newsgroup-dependencies)))
threads))
@@ -3236,13 +3837,13 @@ if it was already present.
If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
will not be entered in the DEPENDENCIES table. Otherwise duplicate
-Message-IDs will be renamed be renamed to a unique Message-ID before
-being entered.
+Message-IDs will be renamed to a unique Message-ID before being
+entered.
Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(let* ((id (mail-header-id header))
(id-dep (and id (intern id dependencies)))
- ref ref-dep ref-header)
+ parent-id ref ref-dep ref-header replaced)
;; Enter this `header' in the `dependencies' table.
(cond
((not id-dep)
@@ -3259,7 +3860,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(force-new
;; Overrides an existing entry;
;; just set the header part of the entry.
- (setcar (symbol-value id-dep) header))
+ (setcar (symbol-value id-dep) header)
+ (setq replaced t))
;; Renames the existing `header' to a unique Message-ID.
((not gnus-summary-ignore-duplicates)
@@ -3282,9 +3884,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(or (mail-header-xref header) "")))
(setq header nil)))
- (when header
- ;; First check if that we are not creating a References loop.
- (setq ref (gnus-parent-id (mail-header-references header)))
+ (when (and header (not replaced))
+ ;; First check that we are not creating a References loop.
+ (setq parent-id (gnus-parent-id (mail-header-references header)))
+ (setq ref parent-id)
(while (and ref
(setq ref-dep (intern-soft ref dependencies))
(boundp ref-dep)
@@ -3294,10 +3897,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
;; root article.
(progn
(mail-header-set-references (car (symbol-value id-dep)) "none")
- (setq ref nil))
+ (setq ref nil)
+ (setq parent-id nil))
(setq ref (gnus-parent-id (mail-header-references ref-header)))))
- (setq ref (gnus-parent-id (mail-header-references header)))
- (setq ref-dep (intern (or ref "none") dependencies))
+ (setq ref-dep (intern (or parent-id "none") dependencies))
(if (boundp ref-dep)
(setcdr (symbol-value ref-dep)
(nconc (cdr (symbol-value ref-dep))
@@ -3305,6 +3908,11 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(set ref-dep (list nil (symbol-value id-dep)))))
header))
+(defun gnus-extract-message-id-from-in-reply-to (string)
+ (if (string-match "<[^>]+>" string)
+ (substring string (match-beginning 0) (match-end 0))
+ nil))
+
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
(mail-parse-charset gnus-newsgroup-charset)
@@ -3376,16 +3984,23 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(setq heads nil)))))
gnus-newsgroup-dependencies)))
+(defsubst gnus-remove-odd-characters (string)
+ "Translate STRING into something that doesn't contain weird characters."
+ (mm-subst-char-in-string
+ ?\r ?\-
+ (mm-subst-char-in-string
+ ?\n ?\- string)))
+
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
(let ((eol (gnus-point-at-eol))
(buffer (current-buffer))
- header)
+ header references in-reply-to)
;; overview: [num subject from date id refs chars lines misc]
(unwind-protect
- (progn
+ (let (x)
(narrow-to-region (point) eol)
(unless (eobp)
(forward-char))
@@ -3393,13 +4008,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(setq header
(make-full-mail-header
number ; number
- (funcall gnus-decode-encoded-word-function
- (nnheader-nov-field)) ; subject
- (funcall gnus-decode-encoded-word-function
- (nnheader-nov-field)) ; from
+ (condition-case () ; subject
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (condition-case () ; from
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
+ (error x))
(nnheader-nov-field) ; date
(nnheader-nov-read-message-id) ; id
- (nnheader-nov-field) ; refs
+ (setq references (nnheader-nov-field)) ; refs
(nnheader-nov-read-integer) ; chars
(nnheader-nov-read-integer) ; lines
(unless (eobp)
@@ -3410,6 +4031,12 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(widen))
+ (when (and (string= references "")
+ (setq in-reply-to (mail-header-extra header))
+ (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
+ (mail-header-set-references
+ header (gnus-extract-message-id-from-in-reply-to in-reply-to)))
+
(when gnus-alter-header-function
(funcall gnus-alter-header-function header))
(gnus-dependencies-add-header header dependencies force-new)))
@@ -3444,7 +4071,9 @@ the id of the parent article (if any)."
(push header gnus-newsgroup-headers)
(if (memq number gnus-newsgroup-unselected)
(progn
- (push number gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unreads
+ (gnus-add-to-sorted-list gnus-newsgroup-unreads
+ number))
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
(push number gnus-newsgroup-ancient)))))))
@@ -3470,14 +4099,16 @@ the id of the parent article (if any)."
(if (memq (setq article (mail-header-number header))
gnus-newsgroup-unselected)
(progn
- (push article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unreads
+ (gnus-add-to-sorted-list
+ gnus-newsgroup-unreads article))
(setq gnus-newsgroup-unselected
(delq article gnus-newsgroup-unselected)))
(push article gnus-newsgroup-ancient)))
(forward-line 1)))))))
(defun gnus-summary-update-article-line (article header)
- "Update the line for ARTICLE using HEADERS."
+ "Update the line for ARTICLE using HEADER."
(let* ((id (mail-header-id header))
(thread (gnus-id-to-thread id)))
(unless thread
@@ -3487,38 +4118,41 @@ the id of the parent article (if any)."
(gnus-summary-goto-subject article)
(let* ((datal (gnus-data-find-list article))
(data (car datal))
- (length (when (cdr datal)
- (- (gnus-data-pos data)
- (gnus-data-pos (cadr datal)))))
(buffer-read-only nil)
(level (gnus-summary-thread-level)))
(gnus-delete-line)
- (gnus-summary-insert-line
- header level nil (gnus-article-mark article)
- (memq article gnus-newsgroup-replied)
- (memq article gnus-newsgroup-expirable)
- ;; Only insert the Subject string when it's different
- ;; from the previous Subject string.
- (if (and
- gnus-show-threads
- (gnus-subject-equal
- (condition-case ()
- (mail-header-subject
- (gnus-data-header
- (cadr
- (gnus-data-find-list
- article
- (gnus-data-list t)))))
- ;; Error on the side of excessive subjects.
- (error ""))
- (mail-header-subject header)))
- ""
- (mail-header-subject header))
- nil (cdr (assq article gnus-newsgroup-scored))
- (memq article gnus-newsgroup-processable))
- (when length
- (gnus-data-update-list
- (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
+ (let ((inserted (- (point)
+ (progn
+ (gnus-summary-insert-line
+ header level nil
+ (memq article gnus-newsgroup-undownloaded)
+ (gnus-article-mark article)
+ (memq article gnus-newsgroup-replied)
+ (memq article gnus-newsgroup-expirable)
+ ;; Only insert the Subject string when it's different
+ ;; from the previous Subject string.
+ (if (and
+ gnus-show-threads
+ (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header)))
+ ""
+ (mail-header-subject header))
+ nil (cdr (assq article gnus-newsgroup-scored))
+ (memq article gnus-newsgroup-processable))
+ (point)))))
+ (when (cdr datal)
+ (gnus-data-update-list
+ (cdr datal)
+ (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
@@ -3756,11 +4390,11 @@ If LINE, insert the rebuilt thread starting on line LINE."
(if (not gnus-thread-sort-functions)
threads
(gnus-message 8 "Sorting threads...")
- (prog1
- (gnus-sort-threads-1
+ (let ((max-lisp-eval-depth 5000))
+ (prog1 (gnus-sort-threads-1
threads
(gnus-make-sort-function gnus-thread-sort-functions))
- (gnus-message 8 "Sorting threads...done"))))
+ (gnus-message 8 "Sorting threads...done")))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
@@ -3792,6 +4426,15 @@ using some other form will lead to serious barfage."
(gnus-article-sort-by-number
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-random (h1 h2)
+ "Sort articles by article number."
+ (zerop (random 2)))
+
+(defun gnus-thread-sort-by-random (h1 h2)
+ "Sort threads by root article number."
+ (gnus-article-sort-by-random
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-lines (h1 h2)
"Sort articles by article Lines header."
(< (mail-header-lines h1)
@@ -3873,15 +4516,47 @@ Unscored articles will be counted as having a score of zero."
(defun gnus-thread-total-score (thread)
;; This function find the total score of THREAD.
- (cond ((null thread)
- 0)
- ((consp thread)
- (if (stringp (car thread))
- (apply gnus-thread-score-function 0
- (mapcar 'gnus-thread-total-score-1 (cdr thread)))
- (gnus-thread-total-score-1 thread)))
- (t
- (gnus-thread-total-score-1 (list thread)))))
+ (cond
+ ((null thread)
+ 0)
+ ((consp thread)
+ (if (stringp (car thread))
+ (apply gnus-thread-score-function 0
+ (mapcar 'gnus-thread-total-score-1 (cdr thread)))
+ (gnus-thread-total-score-1 thread)))
+ (t
+ (gnus-thread-total-score-1 (list thread)))))
+
+(defun gnus-thread-sort-by-most-recent-number (h1 h2)
+ "Sort threads such that the thread with the most recently arrived article comes first."
+ (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
+
+(defun gnus-thread-highest-number (thread)
+ "Return the highest article number in THREAD."
+ (apply 'max (mapcar (lambda (header)
+ (mail-header-number header))
+ (message-flatten-list thread))))
+
+(defun gnus-thread-sort-by-most-recent-date (h1 h2)
+ "Sort threads such that the thread with the most recently dated article comes first."
+ (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
+
+(defun gnus-thread-latest-date (thread)
+ "Return the highest article date in THREAD."
+ (let ((previous-time 0))
+ (apply 'max
+ (mapcar
+ (lambda (header)
+ (setq previous-time
+ (condition-case ()
+ (time-to-seconds (mail-header-parse-date
+ (mail-header-date header)))
+ (error previous-time))))
+ (sort
+ (message-flatten-list thread)
+ (lambda (h1 h2)
+ (< (mail-header-number h1)
+ (mail-header-number h2))))))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
@@ -3909,6 +4584,40 @@ Unscored articles will be counted as having a score of zero."
(or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
""))
+(defvar gnus-tmp-thread-tree-header-string "")
+
+(defcustom gnus-sum-thread-tree-root "> "
+ "With %B spec, used for the root of a thread.
+If nil, use subject instead."
+ :type '(radio (const :format "%v " nil) (string :size 0))
+ :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-false-root "> "
+ "With %B spec, used for a false root of a thread.
+If nil, use subject instead."
+ :type '(radio (const :format "%v " nil) (string :size 0))
+ :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-single-indent ""
+ "With %B spec, used for a thread with just one message.
+If nil, use subject instead."
+ :type '(radio (const :format "%v " nil) (string :size 0))
+ :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-vertical "| "
+ "With %B spec, used for drawing a vertical line."
+ :type 'string
+ :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-indent " "
+ "With %B spec, used for indenting."
+ :type 'string
+ :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
+ "With %B spec, used for a leaf with brothers."
+ :type 'string
+ :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
+ "With %B spec, used for a leaf without brothers."
+ :type 'string
+ :group 'gnus-thread)
+
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
@@ -3921,15 +4630,19 @@ or a straight list of headers."
(let ((gnus-tmp-level 0)
(default-score (or gnus-summary-default-score 0))
(gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
+ (building-line-count gnus-summary-display-while-building)
+ (building-count (integerp gnus-summary-display-while-building))
thread number subject stack state gnus-tmp-gathered beg-match
- new-roots gnus-tmp-new-adopts thread-end
- gnus-tmp-header gnus-tmp-unread
+ new-roots gnus-tmp-new-adopts thread-end simp-subject
+ gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
gnus-tmp-replied gnus-tmp-subject-or-nil
gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
- gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
+ gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
+ tree-stack)
- (setq gnus-tmp-prev-subject nil)
+ (setq gnus-tmp-prev-subject nil
+ gnus-tmp-thread-tree-header-string "")
(if (vectorp (car threads))
;; If this is a straight (sic) list of headers, then a
@@ -3939,6 +4652,8 @@ or a straight list of headers."
;; Do the threaded display.
+ (if gnus-summary-display-while-building
+ (switch-to-buffer (buffer-name)))
(while (or threads stack gnus-tmp-new-adopts new-roots)
(if (and (= gnus-tmp-level 0)
@@ -3965,7 +4680,8 @@ or a straight list of headers."
;; the stack.
(setq state (car stack)
gnus-tmp-level (car state)
- thread (cdr state)
+ tree-stack (cadr state)
+ thread (caddr state)
stack (cdr stack)
gnus-tmp-header (caar thread))))
@@ -4009,7 +4725,8 @@ or a straight list of headers."
(setq gnus-tmp-level -1)))
(setq number (mail-header-number gnus-tmp-header)
- subject (mail-header-subject gnus-tmp-header))
+ subject (mail-header-subject gnus-tmp-header)
+ simp-subject (gnus-simplify-subject-fully subject))
(cond
;; If the thread has changed subject, we might want to make
@@ -4017,8 +4734,7 @@ or a straight list of headers."
((and (null gnus-thread-ignore-subject)
(not (zerop gnus-tmp-level))
gnus-tmp-prev-subject
- (not (inline
- (gnus-subject-equal gnus-tmp-prev-subject subject))))
+ (not (string= gnus-tmp-prev-subject simp-subject)))
(setq new-roots (nconc new-roots (list (car thread)))
thread-end t
gnus-tmp-header nil))
@@ -4049,7 +4765,9 @@ or a straight list of headers."
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
- (push number gnus-newsgroup-expirable)
+ (setq gnus-newsgroup-expirable
+ (gnus-add-to-sorted-list
+ gnus-newsgroup-expirable number))
(push (cons number gnus-low-score-mark)
gnus-newsgroup-reads))))
@@ -4077,15 +4795,13 @@ or a straight list of headers."
(cond
((and gnus-thread-ignore-subject
gnus-tmp-prev-subject
- (not (inline (gnus-subject-equal
- gnus-tmp-prev-subject subject))))
+ (not (string= gnus-tmp-prev-subject simp-subject)))
subject)
((zerop gnus-tmp-level)
(if (and (eq gnus-summary-make-false-root 'empty)
(memq number gnus-tmp-gathered)
gnus-tmp-prev-subject
- (inline (gnus-subject-equal
- gnus-tmp-prev-subject subject)))
+ (string= gnus-tmp-prev-subject simp-subject))
gnus-summary-same-subject
subject))
(t gnus-summary-same-subject)))
@@ -4106,7 +4822,7 @@ or a straight list of headers."
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
@@ -4116,41 +4832,93 @@ or a straight list of headers."
gnus-cached-mark)
((memq number gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq number gnus-newsgroup-forwarded)
+ gnus-forwarded-mark)
((memq number gnus-newsgroup-saved)
gnus-saved-mark)
- (t gnus-unread-mark))
+ ((memq number gnus-newsgroup-recent)
+ gnus-recent-mark)
+ ((memq number gnus-newsgroup-unseen)
+ gnus-unseen-mark)
+ (t gnus-no-mark))
+ gnus-tmp-downloaded
+ (cond ((memq number gnus-newsgroup-undownloaded)
+ gnus-undownloaded-mark)
+ (gnus-newsgroup-agentized
+ gnus-downloaded-mark)
+ (t
+ gnus-no-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(cond
((string-match "<[^>]+> *$" gnus-tmp-from)
(setq beg-match (match-beginning 0))
- (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
- (substring gnus-tmp-from (1+ (match-beginning 0))
- (1- (match-end 0))))
+ (or (and (string-match "^\".+\"" gnus-tmp-from)
+ (substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(1+ (match-beginning 0)) (1- (match-end 0))))
- (t gnus-tmp-from)))
+ (t gnus-tmp-from))
+
+ ;; Do the %B string
+ gnus-tmp-thread-tree-header-string
+ (cond
+ ((not gnus-show-threads) "")
+ ((zerop gnus-tmp-level)
+ (cond ((cdar thread)
+ (or gnus-sum-thread-tree-root subject))
+ (gnus-tmp-new-adopts
+ (or gnus-sum-thread-tree-false-root subject))
+ (t
+ (or gnus-sum-thread-tree-single-indent subject))))
+ (t
+ (concat (apply 'concat
+ (mapcar (lambda (item)
+ (if (= item 1)
+ gnus-sum-thread-tree-vertical
+ gnus-sum-thread-tree-indent))
+ (cdr (reverse tree-stack))))
+ (if (nth 1 thread)
+ gnus-sum-thread-tree-leaf-with-other
+ gnus-sum-thread-tree-single-leaf)))))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
- (setq gnus-tmp-lines 0))
- (gnus-put-text-property
+ (setq gnus-tmp-lines -1))
+ (if (= gnus-tmp-lines -1)
+ (setq gnus-tmp-lines "?")
+ (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number number)
+ 'gnus-number number)
(when gnus-visual-p
(forward-line -1)
(gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))
- (setq gnus-tmp-prev-subject subject)))
+ (setq gnus-tmp-prev-subject simp-subject)))
(when (nth 1 thread)
- (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
+ (push (list (max 0 gnus-tmp-level)
+ (copy-sequence tree-stack)
+ (nthcdr 1 thread))
+ stack))
+ (push (if (nth 1 thread) 1 0) tree-stack)
(incf gnus-tmp-level)
(setq threads (if thread-end nil (cdar thread)))
+ (if gnus-summary-display-while-building
+ (if building-count
+ (progn
+ ;; use a set frequency
+ (setq building-line-count (1- building-line-count))
+ (when (= building-line-count 0)
+ (sit-for 0)
+ (setq building-line-count
+ gnus-summary-display-while-building)))
+ ;; always
+ (sit-for 0)))
(unless threads
(setq gnus-tmp-level 0)))))
(gnus-message 7 "Generating summary...done"))
@@ -4184,6 +4952,7 @@ or a straight list of headers."
gnus-newsgroup-data)
(gnus-summary-insert-line
header 0 number
+ (memq number gnus-newsgroup-undownloaded)
mark (memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
(mail-header-subject header) nil
@@ -4192,21 +4961,50 @@ or a straight list of headers."
(defun gnus-summary-remove-list-identifiers ()
"Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
- (let ((regexp (if (stringp gnus-list-identifiers)
- gnus-list-identifiers
- (mapconcat 'identity gnus-list-identifiers " *\\|"))))
- (dolist (header gnus-newsgroup-headers)
- (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
- " *\\)\\)+\\(Re: +\\)?\\)")
- (mail-header-subject header))
- (mail-header-set-subject
- header (concat (substring (mail-header-subject header)
- 0 (match-beginning 1))
- (or
- (match-string 3 (mail-header-subject header))
- (match-string 5 (mail-header-subject header)))
- (substring (mail-header-subject header)
- (match-end 1))))))))
+ (let ((regexp (if (consp gnus-list-identifiers)
+ (mapconcat 'identity gnus-list-identifiers " *\\|")
+ gnus-list-identifiers))
+ changed subject)
+ (when regexp
+ (dolist (header gnus-newsgroup-headers)
+ (setq subject (mail-header-subject header)
+ changed nil)
+ (while (string-match
+ (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
+ subject)
+ (setq subject
+ (concat (substring subject 0 (match-beginning 2))
+ (substring subject (match-end 0)))
+ changed t))
+ (when (and changed
+ (string-match
+ "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
+ (setq subject
+ (concat (substring subject 0 (match-beginning 1))
+ (substring subject (match-end 1)))))
+ (when changed
+ (mail-header-set-subject header subject))))))
+
+(defun gnus-fetch-headers (articles)
+ "Fetch headers of ARTICLES."
+ (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
+ (gnus-message 5 "Fetching headers for %s..." name)
+ (prog1
+ (if (eq 'nov
+ (setq gnus-headers-retrieved-by
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers))))
+ (gnus-get-newsgroup-headers-xover
+ articles nil nil gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers))
+ (gnus-message 5 "Fetching headers for %s...done" name))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -4215,7 +5013,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
;;!!! Dirty hack; should be removed.
(gnus-summary-ignore-duplicates
- (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
t
gnus-summary-ignore-duplicates))
(info (nth 2 entry))
@@ -4230,43 +5028,91 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
+ (gnus-kill-buffer (current-buffer)))
+ (error "Couldn't activate group %s: %s"
group (gnus-status-message group))))
(unless (gnus-request-group group t)
(when (equal major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
group (gnus-status-message group)))
- (setq gnus-newsgroup-name group)
- (setq gnus-newsgroup-unselected nil)
- (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
- (gnus-summary-setup-default-charset)
+ (when gnus-agent
+ ;; The agent may be storing articles that are no longer in the
+ ;; server's active range. If that is the case, the active range
+ ;; needs to be expanded such that the agent's articles can be
+ ;; included in the summary.
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (alist (gnus-agent-load-alist group))
+ (active (gnus-active group)))
+ (if (and (car alist)
+ (< (caar alist) (car active)))
+ (gnus-set-active group (cons (caar alist) (cdr active)))))
+
+ (setq gnus-summary-use-undownloaded-faces
+ (gnus-agent-find-parameter
+ group
+ 'agent-enable-undownloaded-faces)))
+
+ (setq gnus-newsgroup-name group
+ gnus-newsgroup-unselected nil
+ gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
+
+ (let ((display (gnus-group-find-parameter group 'display)))
+ (setq gnus-newsgroup-display
+ (cond
+ ((not (zerop (or (car-safe read-all) 0)))
+ ;; The user entered the group with C-u SPC/RET, let's show
+ ;; all articles.
+ 'gnus-not-ignore)
+ ((eq display 'all)
+ 'gnus-not-ignore)
+ ((arrayp display)
+ (gnus-summary-display-make-predicate (mapcar 'identity display)))
+ ((numberp display)
+ ;; The following is probably the "correct" solution, but
+ ;; it makes Gnus fetch all headers and then limit the
+ ;; articles (which is slow), so instead we hack the
+ ;; select-articles parameter instead. -- Simon Josefsson
+ ;; <jas@kth.se>
+ ;;
+ ;; (gnus-byte-compile
+ ;; `(lambda () (> number ,(- (cdr (gnus-active group))
+ ;; display)))))
+ (setq select-articles
+ (gnus-uncompress-range
+ (cons (let ((tmp (- (cdr (gnus-active group)) display)))
+ (if (> tmp 0)
+ tmp
+ 1))
+ (cdr (gnus-active group)))))
+ nil)
+ (t
+ nil))))
- ;; Adjust and set lists of article marks.
- (when info
- (gnus-adjust-marked-articles info))
+ (gnus-summary-setup-default-charset)
;; Kludge to avoid having cached articles nixed out in virtual groups.
(when (gnus-virtual-group-p group)
(setq cached gnus-newsgroup-cached))
(setq gnus-newsgroup-unreads
- (gnus-set-difference
- (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
+ (gnus-sorted-ndifference
+ (gnus-sorted-ndifference gnus-newsgroup-unreads
+ gnus-newsgroup-marked)
gnus-newsgroup-dormant))
(setq gnus-newsgroup-processable nil)
(gnus-update-read-articles group gnus-newsgroup-unreads)
+ ;; Adjust and set lists of article marks.
+ (when info
+ (gnus-adjust-marked-articles info))
(if (setq articles select-articles)
(setq gnus-newsgroup-unselected
- (gnus-sorted-intersection
- gnus-newsgroup-unreads
- (gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (gnus-sorted-difference gnus-newsgroup-unreads articles))
(setq articles (gnus-articles-to-read group read-all)))
(cond
@@ -4280,23 +5126,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(gnus-make-hashtable (length articles)))
(gnus-set-global-variables)
;; Retrieve the headers and read them in.
- (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
- (setq gnus-newsgroup-headers
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
- (gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers)))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
+
+ (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
;; Kludge to avoid having cached articles nixed out in virtual groups.
(when cached
@@ -4309,15 +5140,18 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Set the initial limit.
(setq gnus-newsgroup-limit (copy-sequence articles))
;; Remove canceled articles from the list of unread articles.
+ (setq fetched-articles
+ (mapcar (lambda (headers) (mail-header-number headers))
+ gnus-newsgroup-headers))
+ (setq gnus-newsgroup-articles fetched-articles)
(setq gnus-newsgroup-unreads
- (gnus-set-sorted-intersection
- gnus-newsgroup-unreads
- (setq fetched-articles
- (mapcar (lambda (headers) (mail-header-number headers))
- gnus-newsgroup-headers))))
+ (gnus-sorted-nintersection
+ gnus-newsgroup-unreads fetched-articles))
+ (gnus-compute-unseen-list)
+
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
- (gnus-sorted-complement fetched-articles articles))
+ (gnus-sorted-difference articles fetched-articles))
;; We might want to build some more threads first.
(when (and gnus-fetch-old-headers
(eq gnus-headers-retrieved-by 'nov))
@@ -4346,22 +5180,97 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
+(defun gnus-compute-unseen-list ()
+ ;; The `seen' marks are treated specially.
+ (if (not gnus-newsgroup-seen)
+ (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
+ (setq gnus-newsgroup-unseen
+ (gnus-inverse-list-range-intersection
+ gnus-newsgroup-articles gnus-newsgroup-seen))))
+
+(defun gnus-summary-display-make-predicate (display)
+ (require 'gnus-agent)
+ (when (= (length display) 1)
+ (setq display (car display)))
+ (unless gnus-summary-display-cache
+ (dolist (elem (append '((unread . unread)
+ (read . read)
+ (unseen . unseen))
+ gnus-article-mark-lists))
+ (push (cons (cdr elem)
+ (gnus-byte-compile
+ `(lambda () (gnus-article-marked-p ',(cdr elem)))))
+ gnus-summary-display-cache)))
+ (let ((gnus-category-predicate-alist gnus-summary-display-cache)
+ (gnus-category-predicate-cache gnus-summary-display-cache))
+ (gnus-get-predicate display)))
+
+;; Uses the dynamically bound `number' variable.
+(eval-when-compile
+ (defvar number))
+(defun gnus-article-marked-p (type &optional article)
+ (let ((article (or article number)))
+ (cond
+ ((eq type 'tick)
+ (memq article gnus-newsgroup-marked))
+ ((eq type 'spam)
+ (memq article gnus-newsgroup-spam-marked))
+ ((eq type 'unsend)
+ (memq article gnus-newsgroup-unsendable))
+ ((eq type 'undownload)
+ (memq article gnus-newsgroup-undownloaded))
+ ((eq type 'download)
+ (memq article gnus-newsgroup-downloadable))
+ ((eq type 'unread)
+ (memq article gnus-newsgroup-unreads))
+ ((eq type 'read)
+ (memq article gnus-newsgroup-reads))
+ ((eq type 'dormant)
+ (memq article gnus-newsgroup-dormant) )
+ ((eq type 'expire)
+ (memq article gnus-newsgroup-expirable))
+ ((eq type 'reply)
+ (memq article gnus-newsgroup-replied))
+ ((eq type 'killed)
+ (memq article gnus-newsgroup-killed))
+ ((eq type 'bookmark)
+ (assq article gnus-newsgroup-bookmarks))
+ ((eq type 'score)
+ (assq article gnus-newsgroup-scored))
+ ((eq type 'save)
+ (memq article gnus-newsgroup-saved))
+ ((eq type 'cache)
+ (memq article gnus-newsgroup-cached))
+ ((eq type 'forward)
+ (memq article gnus-newsgroup-forwarded))
+ ((eq type 'seen)
+ (not (memq article gnus-newsgroup-unseen)))
+ ((eq type 'recent)
+ (memq article gnus-newsgroup-recent))
+ (t t))))
+
(defun gnus-articles-to-read (group &optional read-all)
"Find out what articles the user wants to read."
- (let* ((articles
+ (let* ((display (gnus-group-find-parameter group 'display))
+ (articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
(and (zerop (length gnus-newsgroup-marked))
(zerop (length gnus-newsgroup-unreads)))
- (eq (gnus-group-find-parameter group 'display)
- 'all))
+ ;; Fetch all if the predicate is non-nil.
+ gnus-newsgroup-display)
+ ;; We want to select the headers for all the articles in
+ ;; the group, so we select either all the active
+ ;; articles in the group, or (if that's nil), the
+ ;; articles in the cache.
(or
(gnus-uncompress-range (gnus-active group))
(gnus-cache-articles-in-group group))
- (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
- (copy-sequence gnus-newsgroup-unreads))
- '<)))
+ ;; Select only the "normal" subset of articles.
+ (gnus-sorted-nunion
+ (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
+ gnus-newsgroup-unreads)))
(scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
(scored (length scored-list))
(number (length articles))
@@ -4371,18 +5280,29 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(cond
((numberp read-all)
read-all)
+ ((numberp gnus-newsgroup-display)
+ gnus-newsgroup-display)
(t
(condition-case ()
(cond
((and (or (<= scored marked) (= scored number))
(numberp gnus-large-newsgroup)
(> number gnus-large-newsgroup))
- (let ((input
- (read-string
- (format
- "How many articles from %s (default %d): "
- (gnus-limit-string gnus-newsgroup-name 35)
- number))))
+ (let* ((cursor-in-echo-area nil)
+ (initial (gnus-parameter-large-newsgroup-initial
+ gnus-newsgroup-name))
+ (input
+ (read-string
+ (format
+ "How many articles from %s (%s %d): "
+ (gnus-limit-string
+ (gnus-group-decoded-name gnus-newsgroup-name)
+ 35)
+ (if initial "max" "default")
+ number)
+ (if initial
+ (cons (number-to-string initial)
+ 0)))))
(if (string-match "^[ \t]*$" input) number input)))
((and (> scored marked) (< scored number)
(> (- scored number) 20))
@@ -4390,7 +5310,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(read-string
(format "%s %s (%d scored, %d total): "
"How many articles from"
- group scored number))))
+ (gnus-group-decoded-name group)
+ scored number))))
(if (string-match "^[ \t]*$" input)
number input)))
(t number))
@@ -4413,14 +5334,12 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Select the N most recent articles.
(setq articles (nthcdr (- number select) articles))))
(setq gnus-newsgroup-unselected
- (gnus-sorted-intersection
- gnus-newsgroup-unreads
- (gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (gnus-sorted-difference gnus-newsgroup-unreads articles))
(when gnus-alter-articles-to-read-function
- (setq gnus-newsgroup-unreads
+ (setq articles
(sort
(funcall gnus-alter-articles-to-read-function
- gnus-newsgroup-name gnus-newsgroup-unreads)
+ gnus-newsgroup-name articles)
'<)))
articles)))
@@ -4443,6 +5362,15 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(setq marks (cdr marks)))
out))
+(defun gnus-article-mark-to-type (mark)
+ "Return the type of MARK."
+ (or (cadr (assq mark gnus-article-special-mark-lists))
+ 'list))
+
+(defun gnus-article-unpropagatable-p (mark)
+ "Return whether MARK should be propagated to back end."
+ (memq mark gnus-article-unpropagated-mark-lists))
+
(defun gnus-adjust-marked-articles (info)
"Set all article lists and remove all marks that are no longer valid."
(let* ((marked-lists (gnus-info-marks info))
@@ -4450,28 +5378,26 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
- (uncompressed '(score bookmark killed))
- marks var articles article mark)
+ marks var articles article mark mark-type)
- (while marked-lists
- (setq marks (pop marked-lists))
- (set (setq var (intern (format "gnus-newsgroup-%s"
- (car (rassq (setq mark (car marks))
- types)))))
- (if (memq (car marks) uncompressed) (cdr marks)
- (gnus-uncompress-range (cdr marks))))
+ (dolist (marks marked-lists)
+ (setq mark (car marks)
+ mark-type (gnus-article-mark-to-type mark)
+ var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
- (setq articles (symbol-value var))
-
- ;; All articles have to be subsets of the active articles.
+ ;; We set the variable according to the type of the marks list,
+ ;; and then adjust the marks to a subset of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expire reply save))
- (while articles
- (when (or (< (setq article (pop articles)) min) (> article max))
- (set var (delq article (symbol-value var))))))
+ ((eq mark-type 'list)
+ (set var (setq articles (gnus-uncompress-range (cdr marks))))
+ (when (memq mark '(tick dormant expire reply save))
+ (while articles
+ (when (or (< (setq article (pop articles)) min) (> article max))
+ (set var (delq article (symbol-value var)))))))
;; Adjust assocs.
- ((memq mark uncompressed)
+ ((eq mark-type 'tuple)
+ (set var (setq articles (cdr marks)))
(when (not (listp (cdr (symbol-value var))))
(set var (list (symbol-value var))))
(when (not (listp (cdr articles)))
@@ -4480,36 +5406,50 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(when (or (not (consp (setq article (pop articles))))
(< (car article) min)
(> (car article) max))
- (set var (delq article (symbol-value var))))))))))
+ (set var (delq article (symbol-value var))))))
+ ;; Adjust ranges (sloppily).
+ ((eq mark-type 'range)
+ (cond
+ ((eq mark 'seen)
+ ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2).
+ ;; It should be (seen (NUM1 . NUM2)).
+ (when (numberp (cddr marks))
+ (setcdr marks (list (cdr marks))))
+ (setq articles (cdr marks))
+ (while (and articles
+ (or (and (consp (car articles))
+ (> min (cdar articles)))
+ (and (numberp (car articles))
+ (> min (car articles)))))
+ (pop articles))
+ (set var articles))))))))
(defun gnus-update-missing-marks (missing)
"Go through the list of MISSING articles and remove them from the mark lists."
(when missing
- (let ((types gnus-article-mark-lists)
- var m)
+ (let (var m)
;; Go through all types.
- (while types
- (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
- (when (symbol-value var)
- ;; This list has articles. So we delete all missing articles
- ;; from it.
- (setq m missing)
- (while m
- (set var (delq (pop m) (symbol-value var)))))))))
+ (dolist (elem gnus-article-mark-lists)
+ (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
+ (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
+ (when (symbol-value var)
+ ;; This list has articles. So we delete all missing
+ ;; articles from it.
+ (setq m missing)
+ (while m
+ (set var (delq (pop m) (symbol-value var))))))))))
(defun gnus-update-marks ()
"Enter the various lists of marked articles into the newsgroup info list."
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
- (uncompressed '(score bookmark killed))
type list newmarked symbol delta-marks)
(when info
;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
(setq list (symbol-value
(setq symbol
- (intern (format "gnus-newsgroup-%s"
- (car type))))))
+ (intern (format "gnus-newsgroup-%s" (car type))))))
(when list
;; Get rid of the entries of the articles that have the
@@ -4528,27 +5468,23 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(setq arts (cdr arts)))
(setq list (cdr all)))))
- (unless (memq (cdr type) uncompressed)
+ (when (eq (cdr type) 'seen)
+ (setq list (gnus-range-add list gnus-newsgroup-unseen)))
+
+ (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
(setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
- (when (gnus-check-backend-function
- 'request-set-mark gnus-newsgroup-name)
- ;; propagate flags to server, with the following exceptions:
- ;; uncompressed:s are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- ;; download are local to one gnus installation (well)
- ;; unsend are for nndraft groups only
- ;; xxx: generality of this? this suits nnimap anyway
- (unless (memq (cdr type) (append '(cache download unsend)
- uncompressed))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range (gnus-copy-sequence old) list))
- (add (gnus-remove-from-range
- (gnus-copy-sequence list) old)))
- (when add
- (push (list add 'add (list (cdr type))) delta-marks))
- (when del
- (push (list del 'del (list (cdr type))) delta-marks)))))
+ (when (and (gnus-check-backend-function
+ 'request-set-mark gnus-newsgroup-name)
+ (not (gnus-article-unpropagatable-p (cdr type))))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (del (gnus-remove-from-range (gnus-copy-sequence old) list))
+ (add (gnus-remove-from-range
+ (gnus-copy-sequence list) old)))
+ (when add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (when del
+ (push (list del 'del (list (cdr type))) delta-marks))))
(when list
(push (cons (cdr type) list) newmarked)))
@@ -4584,16 +5520,13 @@ If WHERE is `summary', the summary mode line format will be used."
;; We evaluate this in the summary buffer since these
;; variables are buffer-local to that buffer.
(set-buffer gnus-summary-buffer)
- ;; We bind all these variables that are used in the `eval' form
+ ;; We bind all these variables that are used in the `eval' form
;; below.
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name (gnus-group-name-decode
- gnus-newsgroup-name
- (gnus-group-name-charset
- nil
- gnus-newsgroup-name)))
+ (gnus-tmp-group-name (gnus-group-decoded-name
+ gnus-newsgroup-name))
(gnus-tmp-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
@@ -4614,7 +5547,7 @@ If WHERE is `summary', the summary mode line format will be used."
(mail-header-subject gnus-current-headers))
""))
bufname-length max-len
- gnus-tmp-header);; passed as argument to any user-format-funcs
+ gnus-tmp-header) ;; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
(setq bufname-length (if (string-match "%b" mode-string)
(- (length
@@ -4755,9 +5688,11 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(gnus-info-set-read ',info ',(gnus-info-read info))
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
(gnus-group-update-group ,group t))))
;; Add the read articles to the range.
(gnus-info-set-read info range)
+ (gnus-request-set-mark group (list (list range 'add '(read))))
;; Then we have to re-compute how many unread
;; articles there are in this group.
(when active
@@ -4777,7 +5712,8 @@ The resulting hash table is returned, or nil if no Xrefs were found."
;; Update the number of unread articles.
(setcar entry num)
;; Update the group buffer.
- (gnus-group-update-group group t)))))
+ (unless (gnus-ephemeral-group-p group)
+ (gnus-group-update-group group t))))))
(defvar gnus-newsgroup-none-id 0)
@@ -4799,6 +5735,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
(subst-char-in-region (point-min) (point-max) ?\r ? t)
+ (ietf-drums-unfold-fws)
(gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines chars)
@@ -4829,22 +5766,21 @@ The resulting hash table is returned, or nil if no Xrefs were found."
;; Subject.
(progn
(goto-char p)
- (if (search-forward "\nsubject: " nil t)
+ (if (search-forward "\nsubject:" nil t)
(funcall gnus-decode-encoded-word-function
(nnheader-header-value))
"(none)"))
;; From.
(progn
(goto-char p)
- (if (or (search-forward "\nfrom: " nil t)
- (search-forward "\nfrom:" nil t))
+ (if (search-forward "\nfrom:" nil t)
(funcall gnus-decode-encoded-word-function
(nnheader-header-value))
"(nobody)"))
;; Date.
(progn
(goto-char p)
- (if (search-forward "\ndate: " nil t)
+ (if (search-forward "\ndate:" nil t)
(nnheader-header-value) ""))
;; Message-ID.
(progn
@@ -4861,7 +5797,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
;; References.
(progn
(goto-char p)
- (if (search-forward "\nreferences: " nil t)
+ (if (search-forward "\nreferences:" nil t)
(progn
(setq end (point))
(prog1
@@ -4878,7 +5814,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
;; Get the references from the in-reply-to header if there
;; were no references and the in-reply-to header looks
;; promising.
- (if (and (search-forward "\nin-reply-to: " nil t)
+ (if (and (search-forward "\nin-reply-to:" nil t)
(setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
(let (ref2)
@@ -4896,19 +5832,19 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(goto-char p)
(if (search-forward "\nchars: " nil t)
(if (numberp (setq chars (ignore-errors (read cur))))
- chars 0)
- 0))
+ chars -1)
+ -1))
;; Lines.
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
(if (numberp (setq lines (ignore-errors (read cur))))
- lines 0)
- 0))
+ lines -1)
+ -1))
;; Xref.
(progn
(goto-char p)
- (and (search-forward "\nxref: " nil t)
+ (and (search-forward "\nxref:" nil t)
(nnheader-header-value)))
;; Extra.
(when gnus-extra-headers
@@ -4917,7 +5853,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(while extra
(goto-char p)
(when (search-forward
- (concat "\n" (symbol-name (car extra)) ": ") nil t)
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
(push (cons (car extra) (nnheader-header-value))
out))
(pop extra))
@@ -4952,6 +5888,13 @@ Return a list of headers that match SEQUENCE (see
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
+ (allp (cond
+ ((eq gnus-read-all-available-headers t)
+ t)
+ ((stringp gnus-read-all-available-headers)
+ (string-match gnus-read-all-available-headers group))
+ (t
+ nil)))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
@@ -4959,26 +5902,24 @@ Return a list of headers that match SEQUENCE (see
;; Allow the user to mangle the headers before parsing them.
(gnus-run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
- (while (not (eobp))
- (condition-case ()
- (while (and sequence (not (eobp)))
- (setq number (read cur))
- (while (and sequence
- (< (car sequence) number))
- (setq sequence (cdr sequence)))
- (and sequence
- (eq number (car sequence))
- (progn
- (setq sequence (cdr sequence))
- (setq header (inline
- (gnus-nov-parse-line
- number dependencies force-new))))
- (push header headers))
- (forward-line 1))
- (error
- (gnus-error 4 "Strange nov line (%d)"
- (count-lines (point-min) (point)))))
- (forward-line 1))
+ (gnus-parse-without-error
+ (while (and (or sequence allp)
+ (not (eobp)))
+ (setq number (read cur))
+ (when (not allp)
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence))))
+ (when (and (or allp
+ (and sequence
+ (eq number (car sequence))))
+ (progn
+ (setq sequence (cdr sequence))
+ (setq header (inline
+ (gnus-nov-parse-line
+ number dependencies force-new)))))
+ (push header headers))
+ (forward-line 1)))
;; A common bug in inn is that if you have posted an article and
;; then retrieves the active file, it will answer correctly --
;; the new article is included. However, a NOV entry for the
@@ -4992,7 +5933,7 @@ Return a list of headers that match SEQUENCE (see
(let ((gnus-nov-is-evil t))
(nconc
(nreverse headers)
- (when (gnus-retrieve-headers sequence group)
+ (when (eq (gnus-retrieve-headers sequence group) 'headers)
(gnus-get-newsgroup-headers))))))))
(defun gnus-article-get-xrefs ()
@@ -5014,8 +5955,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'."
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point)
- (progn (end-of-line) (point))))
+ (setq xref (buffer-substring (point) (gnus-point-at-eol)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
@@ -5047,6 +5987,11 @@ the subject line on."
(prog1
(1+ (gnus-point-at-eol))
(gnus-delete-line))))))
+ ;; Remove list identifiers from subject.
+ (when gnus-list-identifiers
+ (let ((gnus-newsgroup-headers (list header)))
+ (gnus-summary-remove-list-identifiers)
+ (setq header (car gnus-newsgroup-headers))))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
@@ -5177,53 +6122,77 @@ If EXCLUDE-GROUP, do not go to this group."
(save-excursion
(gnus-group-best-unread-group exclude-group))))
-(defun gnus-summary-find-next (&optional unread article backward undownloaded)
- (if backward (gnus-summary-find-prev)
+(defun gnus-summary-find-next (&optional unread article backward)
+ (if backward
+ (gnus-summary-find-prev unread article)
(let* ((dummy (gnus-summary-article-intangible-p))
(article (or article (gnus-summary-article-number)))
- (arts (gnus-data-find-list article))
+ (data (gnus-data-find-list article))
result)
(when (and (not dummy)
(or (not gnus-summary-check-current)
(not unread)
- (not (gnus-data-unread-p (car arts)))))
- (setq arts (cdr arts)))
+ (not (gnus-data-unread-p (car data)))))
+ (setq data (cdr data)))
(when (setq result
(if unread
(progn
- (while arts
- (when (or (and undownloaded
- (eq gnus-undownloaded-mark
- (gnus-data-mark (car arts))))
- (gnus-data-unread-p (car arts)))
- (setq result (car arts)
- arts nil))
- (setq arts (cdr arts)))
+ (while data
+ (unless (memq (gnus-data-number (car data))
+ (cond
+ ((eq gnus-auto-goto-ignores
+ 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores
+ 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores
+ 'undownloaded)
+ gnus-newsgroup-undownloaded)))
+ (when (gnus-data-unread-p (car data))
+ (setq result (car data)
+ data nil)))
+ (setq data (cdr data)))
result)
- (car arts)))
+ (car data)))
(goto-char (gnus-data-pos result))
(gnus-data-number result)))))
(defun gnus-summary-find-prev (&optional unread article)
(let* ((eobp (eobp))
(article (or article (gnus-summary-article-number)))
- (arts (gnus-data-find-list article (gnus-data-list 'rev)))
+ (data (gnus-data-find-list article (gnus-data-list 'rev)))
result)
(when (and (not eobp)
(or (not gnus-summary-check-current)
(not unread)
- (not (gnus-data-unread-p (car arts)))))
- (setq arts (cdr arts)))
+ (not (gnus-data-unread-p (car data)))))
+ (setq data (cdr data)))
(when (setq result
(if unread
(progn
- (while arts
- (when (gnus-data-unread-p (car arts))
- (setq result (car arts)
- arts nil))
- (setq arts (cdr arts)))
+ (while data
+ (unless (memq (gnus-data-number (car data))
+ (cond
+ ((eq gnus-auto-goto-ignores
+ 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores
+ 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores
+ 'undownloaded)
+ gnus-newsgroup-undownloaded)))
+ (when (gnus-data-unread-p (car data))
+ (setq result (car data)
+ data nil)))
+ (setq data (cdr data)))
result)
- (car arts)))
+ (car data)))
(goto-char (gnus-data-pos result))
(gnus-data-number result))))
@@ -5274,18 +6243,18 @@ displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
(interactive)
- (let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 7) 1)
- (t (if (numberp gnus-auto-center-summary)
- gnus-auto-center-summary
- 2))))
- (height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
- ;; The user has to want it.
- (when gnus-auto-center-summary
+ ;; The user has to want it.
+ (when gnus-auto-center-summary
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ 2))))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point)))
+ (window (get-buffer-window (current-buffer))))
(when (get-buffer-window gnus-article-buffer)
;; Only do recentering when the article buffer is displayed,
;; Set the window start to either `bottom', which is the biggest
@@ -5377,13 +6346,13 @@ displayed, no centering will be performed."
(marked (gnus-info-marks info))
(active (gnus-active group)))
(and info active
- (gnus-set-difference
- (gnus-sorted-complement
- (gnus-uncompress-range active)
- (gnus-list-of-unread-articles group))
- (append
- (gnus-uncompress-range (cdr (assq 'dormant marked)))
- (gnus-uncompress-range (cdr (assq 'tick marked))))))))
+ (gnus-list-range-difference
+ (gnus-list-range-difference
+ (gnus-sorted-complement
+ (gnus-uncompress-range active)
+ (gnus-list-of-unread-articles group))
+ (cdr (assq 'dormant marked)))
+ (cdr (assq 'tick marked))))))
;; Various summary commands
@@ -5419,23 +6388,40 @@ displayed, no centering will be performed."
(defun gnus-summary-toggle-truncation (&optional arg)
"Toggle truncation of summary lines.
-With arg, turn line truncation on if arg is positive."
+With ARG, turn line truncation on if ARG is positive."
(interactive "P")
(setq truncate-lines
(if (null arg) (not truncate-lines)
(> (prefix-numeric-value arg) 0)))
(redraw-display))
+(defun gnus-summary-find-for-reselect ()
+ "Return the number of an article to stay on across a reselect.
+The current article is considered, then following articles, then previous
+articles. An article is sought which is not cancelled and isn't a temporary
+insertion from another group. If there's no such then return a dummy 0."
+ (let (found)
+ (dolist (rev '(nil t))
+ (unless found ; don't demand the reverse list if we don't need it
+ (let ((data (gnus-data-find-list
+ (gnus-summary-article-number) (gnus-data-list rev))))
+ (while (and data (not found))
+ (if (and (< 0 (gnus-data-number (car data)))
+ (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
+ (setq found (gnus-data-number (car data))))
+ (setq data (cdr data))))))
+ (or found 0)))
+
(defun gnus-summary-reselect-current-group (&optional all rescan)
"Exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
(interactive "P")
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
- (let ((current-subject (gnus-summary-article-number))
+ (let ((current-subject (gnus-summary-find-for-reselect))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
- (gnus-summary-exit)
+ (gnus-summary-exit nil 'leave-hidden)
;; We have to adjust the point of group mode buffer because
;; point was moved to the next unread newsgroup by exiting.
(gnus-summary-jump-to-group group)
@@ -5457,13 +6443,10 @@ The prefix argument ALL means to select all articles."
(when gnus-newsgroup-kill-headers
(setq gnus-newsgroup-killed
(gnus-compress-sequence
- (nconc
- (gnus-set-sorted-intersection
- (gnus-uncompress-range gnus-newsgroup-killed)
- (setq gnus-newsgroup-unselected
- (sort gnus-newsgroup-unselected '<)))
- (setq gnus-newsgroup-unreads
- (sort gnus-newsgroup-unreads '<)))
+ (gnus-sorted-union
+ (gnus-list-range-intersection
+ gnus-newsgroup-unselected gnus-newsgroup-killed)
+ gnus-newsgroup-unreads)
t)))
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
@@ -5473,7 +6456,8 @@ The prefix argument ALL means to select all articles."
(set-buffer gnus-group-buffer)
(gnus-undo-force-boundary))
(gnus-update-read-articles
- group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ group (gnus-sorted-union
+ gnus-newsgroup-unreads gnus-newsgroup-unselected))
;; Set the current article marks.
(let ((gnus-newsgroup-scored
(if (and (not gnus-save-score)
@@ -5500,7 +6484,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-save-newsrc-file)
(gnus-dribble-save)))
-(defun gnus-summary-exit (&optional temporary)
+(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
(interactive)
@@ -5516,8 +6500,9 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
+ (gnus-group-is-exiting-p t)
(mode major-mode)
- (group-point nil)
+ (group-point nil)
(buf (current-buffer)))
(unless quit-config
;; Do adaptive scoring, and possibly save score files.
@@ -5567,27 +6552,36 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(setq gnus-article-current nil))
(set-buffer buf)
(if (not gnus-kill-summary-on-exit)
- (gnus-deaden-summary)
+ (progn
+ (gnus-deaden-summary)
+ (setq mode nil))
;; We set all buffer-local variables to nil. It is unclear why
;; this is needed, but if we don't, buffer-local variables are
;; not garbage-collected, it seems. This would the lead to en
;; ever-growing Emacs.
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
;; We clear the global counterparts of the buffer-local
;; variables as well, just to be on the safe side.
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (pop-to-buffer gnus-group-buffer)
+ (if leave-hidden
+ (set-buffer gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer))
(if (not quit-config)
(progn
(goto-char group-point)
- (gnus-configure-windows 'group 'force))
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force)))
(gnus-handle-ephemeral-exit quit-config))
;; Clear the current group name.
(unless quit-config
@@ -5598,14 +6592,14 @@ If FORCE (the prefix), also save the .newsrc file(s)."
"Quit reading current newsgroup without updating read article info."
(interactive)
(let* ((group gnus-newsgroup-name)
+ (gnus-group-is-exiting-p t)
+ (gnus-group-is-exiting-without-update-p t)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (mapcar 'funcall
- (delq 'gnus-summary-expire-articles
- (copy-sequence gnus-summary-prepare-exit-hook)))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
@@ -5622,10 +6616,13 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-deaden-summary)
(gnus-close-group group)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
- (when (get-buffer gnus-summary-buffer)
- (kill-buffer gnus-summary-buffer)))
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
+ (gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(when gnus-use-trees
@@ -5637,10 +6634,12 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-configure-windows 'group 'force)
;; Clear the current group name.
(setq gnus-newsgroup-name nil)
+ (unless (gnus-ephemeral-group-p group)
+ (gnus-group-update-group group))
(when (equal (gnus-group-group-name) group)
(gnus-group-next-unread-group 1))
(when quit-config
- (gnus-handle-ephemeral-exit quit-config)))))
+ (gnus-handle-ephemeral-exit quit-config)))))
(defun gnus-handle-ephemeral-exit (quit-config)
"Handle movement when leaving an ephemeral group.
@@ -5649,25 +6648,28 @@ The state which existed when entering the ephemeral is reset."
(gnus-configure-windows 'group 'force)
(set-buffer (car quit-config))
(cond ((eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- ((eq major-mode 'gnus-article-mode)
- (save-excursion
- ;; The `gnus-summary-buffer' variable may point
- ;; to the old summary buffer when using a single
- ;; article buffer.
- (unless (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-group-buffer))
- (set-buffer gnus-summary-buffer)
- (gnus-set-global-variables))))
+ (gnus-set-global-variables))
+ ((eq major-mode 'gnus-article-mode)
+ (save-excursion
+ ;; The `gnus-summary-buffer' variable may point
+ ;; to the old summary buffer when using a single
+ ;; article buffer.
+ (unless (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-group-buffer))
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables))))
(if (or (eq (cdr quit-config) 'article)
- (eq (cdr quit-config) 'pick))
- (progn
- ;; The current article may be from the ephemeral group
- ;; thus it is best that we reload this article
- (gnus-summary-show-article)
- (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
- (gnus-configure-windows 'pick 'force)
- (gnus-configure-windows (cdr quit-config) 'force)))
+ (eq (cdr quit-config) 'pick))
+ (progn
+ ;; The current article may be from the ephemeral group
+ ;; thus it is best that we reload this article
+ ;;
+ ;; If we're exiting from a large digest, this can be
+ ;; extremely slow. So, it's better not to reload it. -- jh.
+ ;;(gnus-summary-show-article)
+ (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
+ (gnus-configure-windows 'pick 'force)
+ (gnus-configure-windows (cdr quit-config) 'force)))
(gnus-configure-windows (cdr quit-config) 'force))
(when (eq major-mode 'gnus-summary-mode)
(gnus-summary-next-subject 1 nil t)
@@ -5683,10 +6685,11 @@ The state which existed when entering the ephemeral is reset."
(suppress-keymap gnus-dead-summary-mode-map)
(substitute-key-definition
'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (let ((keys '("\C-d" "\r" "\177" [delete])))
- (while keys
- (define-key gnus-dead-summary-mode-map
- (pop keys) 'gnus-summary-wake-up-the-dead))))
+ (dolist (key '("\C-d" "\r" "\177" [delete]))
+ (define-key gnus-dead-summary-mode-map
+ key 'gnus-summary-wake-up-the-dead))
+ (dolist (key '("q" "Q"))
+ (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
(defvar gnus-dead-summary-mode nil
"Minor mode for Gnus summary buffers.")
@@ -5732,17 +6735,20 @@ The state which existed when entering the ephemeral is reset."
(set-buffer buffer)
(gnus-kill-buffer gnus-article-buffer)
(gnus-kill-buffer gnus-original-article-buffer)))
- (cond (gnus-kill-summary-on-exit
- (when (and gnus-use-trees
- (gnus-buffer-exists-p buffer))
- (save-excursion
- (set-buffer buffer)
- (gnus-tree-close gnus-newsgroup-name)))
- (gnus-kill-buffer buffer))
- ((gnus-buffer-exists-p buffer)
- (save-excursion
- (set-buffer buffer)
- (gnus-deaden-summary))))))
+ (cond
+ ;; Kill the buffer.
+ (gnus-kill-summary-on-exit
+ (when (and gnus-use-trees
+ (gnus-buffer-exists-p buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-tree-close gnus-newsgroup-name)))
+ (gnus-kill-buffer buffer))
+ ;; Deaden the buffer.
+ ((gnus-buffer-exists-p buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-deaden-summary))))))
(defun gnus-summary-wake-up-the-dead (&rest args)
"Wake up the dead summary buffer."
@@ -5789,7 +6795,7 @@ in."
(defun gnus-summary-next-group (&optional no-article target-group backward)
"Exit current newsgroup and then select next unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected
-initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
previous group instead."
(interactive "P")
;; Stop pre-fetching.
@@ -5826,10 +6832,10 @@ previous group instead."
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
- (gnus-summary-read-group
- target-group nil no-article
- (and (buffer-name current-buffer) current-buffer)
- nil backward))
+ (gnus-summary-read-group
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)
+ nil backward))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
@@ -5842,38 +6848,56 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
;; Walking around summary lines.
-(defun gnus-summary-first-subject (&optional unread undownloaded)
- "Go to the first unread subject.
-If UNREAD is non-nil, go to the first unread article.
-Returns the article selected or nil if there are no unread articles."
+(defun gnus-summary-first-subject (&optional unread undownloaded unseen)
+ "Go to the first subject satisfying any non-nil constraint.
+If UNREAD is non-nil, the article should be unread.
+If UNDOWNLOADED is non-nil, the article should be undownloaded.
+If UNSEEN is non-nil, the article should be unseen.
+Returns the article selected or nil if there are no matching articles."
(interactive "P")
- (prog1
- (cond
- ;; Empty summary.
- ((null gnus-newsgroup-data)
- (gnus-message 3 "No articles in the group")
- nil)
- ;; Pick the first article.
- ((not unread)
- (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
- (gnus-data-number (car gnus-newsgroup-data)))
- ;; No unread articles.
- ((null gnus-newsgroup-unreads)
- (gnus-message 3 "No more unread articles")
- nil)
- ;; Find the first unread article.
- (t
- (let ((data gnus-newsgroup-data))
- (while (and data
- (and (not (and undownloaded
- (eq gnus-undownloaded-mark
- (gnus-data-mark (car data)))))
- (not (gnus-data-unread-p (car data)))))
- (setq data (cdr data)))
- (when data
- (goto-char (gnus-data-pos (car data)))
- (gnus-data-number (car data))))))
- (gnus-summary-position-point)))
+ (cond
+ ;; Empty summary.
+ ((null gnus-newsgroup-data)
+ (gnus-message 3 "No articles in the group")
+ nil)
+ ;; Pick the first article.
+ ((not (or unread undownloaded unseen))
+ (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
+ (gnus-data-number (car gnus-newsgroup-data)))
+ ;; Find the first unread article.
+ (t
+ (let ((data gnus-newsgroup-data))
+ (while (and data
+ (let ((num (gnus-data-number (car data))))
+ (or (memq num gnus-newsgroup-unfetched)
+ (not (or (and unread
+ (memq num gnus-newsgroup-unreads))
+ (and undownloaded
+ (memq num gnus-newsgroup-undownloaded))
+ (and unseen
+ (memq num gnus-newsgroup-unseen)))))))
+ (setq data (cdr data)))
+ (prog1
+ (if data
+ (progn
+ (goto-char (gnus-data-pos (car data)))
+ (gnus-data-number (car data)))
+ (gnus-message 3 "No more%s articles"
+ (let* ((r (when unread " unread"))
+ (d (when undownloaded " undownloaded"))
+ (s (when unseen " unseen"))
+ (l (delq nil (list r d s))))
+ (cond ((= 3 (length l))
+ (concat r "," d ", or" s))
+ ((= 2 (length l))
+ (concat (car l) ", or" (cadr l)))
+ ((= 1 (length l))
+ (car l))
+ (t
+ ""))))
+ nil
+ )
+ (gnus-summary-position-point))))))
(defun gnus-summary-next-subject (n &optional unread dont-display)
"Go to next N'th summary line.
@@ -5914,10 +6938,20 @@ If optional argument UNREAD is non-nil, only unread article is selected."
(interactive "p")
(gnus-summary-next-subject (- n) t))
+(defun gnus-summary-goto-subjects (articles)
+ "Insert the subject header for ARTICLES in the current buffer."
+ (save-excursion
+ (dolist (article articles)
+ (gnus-summary-goto-subject article t)))
+ (gnus-summary-limit (append articles gnus-newsgroup-limit))
+ (gnus-summary-position-point))
+
(defun gnus-summary-goto-subject (article &optional force silent)
"Go the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
(interactive "nArticle number: ")
+ (unless (numberp article)
+ (error "Article %s is not a number" article))
(let ((b (point))
(data (gnus-data-find article)))
;; We read in the article if we have to.
@@ -5934,7 +6968,9 @@ If FORCE, also allow jumping to articles not currently shown."
(unless silent
(gnus-message 3 "Can't find article %d" article))
nil)
- (goto-char (gnus-data-pos data))
+ (let ((pt (gnus-data-pos data)))
+ (goto-char pt)
+ (gnus-summary-set-article-display-arrow pt))
(gnus-summary-position-point)
article)))
@@ -5954,6 +6990,11 @@ Given a prefix, will force an `article' buffer configuration."
(with-current-buffer gnus-article-buffer
(mm-enable-multibyte)))
(gnus-set-global-variables)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (setq gnus-article-charset gnus-newsgroup-charset)
+ (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
+ (mm-enable-multibyte)))
(if (null article)
nil
(prog1
@@ -6004,18 +7045,25 @@ be displayed."
(progn
(gnus-summary-display-article article all-headers)
(when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
+ (with-current-buffer gnus-article-buffer
(if (not gnus-article-decoded-p) ;; a local variable
(mm-disable-multibyte))))
- (when (or all-headers gnus-show-all-headers)
- (gnus-article-show-all-headers))
(gnus-article-set-window-start
(cdr (assq article gnus-newsgroup-bookmarks)))
article)
- (when (or all-headers gnus-show-all-headers)
- (gnus-article-show-all-headers))
'old))))
+(defun gnus-summary-force-verify-and-decrypt ()
+ "Display buttons for signed/encrypted parts and verify/decrypt them."
+ (interactive)
+ (let ((mm-verify-option 'known)
+ (mm-decrypt-option 'known)
+ (gnus-article-emulate-mime t)
+ (gnus-buttonized-mime-types (append (list "multipart/signed"
+ "multipart/encrypted")
+ gnus-buttonized-mime-types)))
+ (gnus-summary-select-article nil 'force)))
+
(defun gnus-summary-set-current-mark (&optional current-mark)
"Obsolete function."
nil)
@@ -6087,7 +7135,7 @@ If BACKWARD, the previous article is selected instead of the next."
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(?\C-p (gnus-group-prev-unread-group 1))))
(cursor-in-echo-area t)
- keve key group ended)
+ keve key group ended prompt)
(save-excursion
(set-buffer gnus-group-buffer)
(goto-char start)
@@ -6096,19 +7144,20 @@ If BACKWARD, the previous article is selected instead of the next."
(gnus-summary-best-group gnus-newsgroup-name)
(gnus-summary-search-group backward gnus-keep-same-level))))
(while (not ended)
- (gnus-message
- 5 "No more%s articles%s" (if unread " unread" "")
- (if (and group
- (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
- (format " (Type %s for %s [%s])"
- (single-key-description cmd) group
- (car (gnus-gethash group gnus-newsrc-hashtb)))
- (format " (Type %s to exit %s)"
- (single-key-description cmd)
- gnus-newsgroup-name)))
+ (setq prompt
+ (format
+ "No more%s articles%s " (if unread " unread" "")
+ (if (and group
+ (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
+ (format " (Type %s for %s [%s])"
+ (single-key-description cmd) group
+ (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (format " (Type %s to exit %s)"
+ (single-key-description cmd)
+ gnus-newsgroup-name))))
;; Confirm auto selection.
- (setq key (car (setq keve (gnus-read-event-char))))
- (setq ended t)
+ (setq key (car (setq keve (gnus-read-event-char prompt)))
+ ended t)
(cond
((assq key keystrokes)
(let ((obuf (current-buffer)))
@@ -6151,14 +7200,18 @@ If UNREAD is non-nil, only unread articles are selected."
(and gnus-auto-select-same
(gnus-summary-article-subject))))
-(defun gnus-summary-next-page (&optional lines circular)
+(defun gnus-summary-next-page (&optional lines circular stop)
"Show next page of the selected article.
If at the end of the current article, select the next article.
LINES says how many lines should be scrolled up.
If CIRCULAR is non-nil, go to the start of the article instead of
selecting the next article when reaching the end of the current
-article."
+article.
+
+If STOP is non-nil, just stop when reaching the end of the message.
+
+Also see the variable `gnus-article-skip-boring'."
(interactive "P")
(setq gnus-summary-buffer (current-buffer))
(gnus-set-global-variables)
@@ -6182,9 +7235,12 @@ article."
(gnus-summary-display-article article)
(when article-window
(gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
+ (setq endp (or (gnus-article-next-page lines)
+ (gnus-article-only-boring-p))))
(when endp
- (cond (circular
+ (cond (stop
+ (gnus-message 3 "End of message"))
+ (circular
(gnus-summary-beginning-of-article))
(lines
(gnus-message 3 "End of message"))
@@ -6296,6 +7352,30 @@ Return nil if there are no unread articles."
(gnus-summary-first-subject t))
(gnus-summary-position-point)))
+(defun gnus-summary-first-unseen-subject ()
+ "Place the point on the subject line of the first unseen article.
+Return nil if there are no unseen articles."
+ (interactive)
+ (prog1
+ (when (gnus-summary-first-subject nil nil t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject nil nil t))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-first-unseen-or-unread-subject ()
+ "Place the point on the subject line of the first unseen article or,
+if all article have been seen, on the subject line of the first unread
+article."
+ (interactive)
+ (prog1
+ (unless (when (gnus-summary-first-subject nil nil t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject nil nil t))
+ (when (gnus-summary-first-subject t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t)))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
@@ -6307,8 +7387,20 @@ Return nil if there are no articles."
(gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
-(defun gnus-summary-best-unread-article ()
- "Select the unread article with the highest score."
+(defun gnus-summary-best-unread-article (&optional arg)
+ "Select the unread article with the highest score.
+If given a prefix argument, select the next unread article that has a
+score higher than the default score."
+ (interactive "P")
+ (let ((article (if arg
+ (gnus-summary-better-unread-subject)
+ (gnus-summary-best-unread-subject))))
+ (if article
+ (gnus-summary-goto-article article)
+ (error "No unread articles"))))
+
+(defun gnus-summary-best-unread-subject ()
+ "Select the unread subject with the highest score."
(interactive)
(let ((best -1000000)
(data gnus-newsgroup-data)
@@ -6321,11 +7413,25 @@ Return nil if there are no articles."
(setq best score
article (gnus-data-number (car data))))
(setq data (cdr data)))
- (prog1
- (if article
- (gnus-summary-goto-article article)
- (error "No unread articles"))
- (gnus-summary-position-point))))
+ (when article
+ (gnus-summary-goto-subject article))
+ (gnus-summary-position-point)
+ article))
+
+(defun gnus-summary-better-unread-subject ()
+ "Select the first unread subject that has a score over the default score."
+ (interactive)
+ (let ((data gnus-newsgroup-data)
+ article score)
+ (while (and (setq article (gnus-data-number (car data)))
+ (or (gnus-data-read-p (car data))
+ (not (> (gnus-summary-article-score article)
+ gnus-summary-default-score))))
+ (setq data (cdr data)))
+ (when article
+ (gnus-summary-goto-subject article))
+ (gnus-summary-position-point)
+ article))
(defun gnus-summary-last-subject ()
"Go to the last displayed subject line in the group."
@@ -6348,7 +7454,7 @@ is a number, it is the line the article is to be displayed on."
t))
(prog1
(if (and (stringp article)
- (string-match "@" article))
+ (string-match "@\\|%40" article))
(gnus-summary-refer-article article)
(when (stringp article)
(setq article (string-to-number article)))
@@ -6443,12 +7549,18 @@ articles that are younger than AGE days."
days)
(while (not days-got)
(setq days (if younger
- (read-string "Limit to articles within (in days): ")
- (read-string "Limit to articles old than (in days): ")))
+ (read-string "Limit to articles younger than (in days, older when negative): ")
+ (read-string
+ "Limit to articles older than (in days, younger when negative): ")))
(when (> (length days) 0)
(setq days (read days)))
(if (numberp days)
- (setq days-got t)
+ (progn
+ (setq days-got t)
+ (if (< days 0)
+ (progn
+ (setq younger (not younger))
+ (setq days (* days -1)))))
(message "Please enter a number.")
(sleep-for 1)))
(list days younger)))
@@ -6476,7 +7588,7 @@ articles that are younger than AGE days."
(interactive
(let ((header
(intern
- (gnus-completing-read
+ (gnus-completing-read-with-default
(symbol-name (car gnus-extra-headers))
(if current-prefix-arg
"Exclude extra header:"
@@ -6501,6 +7613,18 @@ articles that are younger than AGE days."
(gnus-summary-limit articles))
(gnus-summary-position-point))))
+(defun gnus-summary-limit-to-display-predicate ()
+ "Limit the summary buffer to the predicated in the `display' group parameter."
+ (interactive)
+ (unless gnus-newsgroup-display
+ (error "There is no `display' group parameter"))
+ (let (articles)
+ (dolist (number gnus-newsgroup-articles)
+ (when (funcall gnus-newsgroup-display)
+ (push number articles)))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))
+
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
@@ -6515,7 +7639,7 @@ If ALL is non-nil, limit strictly to unread articles."
;; Concat all the marks that say that an article is read and have
;; those removed.
(list gnus-del-mark gnus-read-mark gnus-ancient-mark
- gnus-killed-mark gnus-kill-file-mark
+ gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
gnus-duplicate-mark gnus-souped-mark)
@@ -6553,12 +7677,9 @@ Returns how many articles were removed."
(gnus-summary-limit articles))
(gnus-summary-position-point)))
-(defun gnus-summary-limit-to-score (&optional score)
+(defun gnus-summary-limit-to-score (score)
"Limit to articles with score at or above SCORE."
- (interactive "P")
- (setq score (if score
- (prefix-numeric-value score)
- (or gnus-summary-default-score 0)))
+ (interactive "NLimit to articles with score of at least: ")
(let ((data gnus-newsgroup-data)
articles)
(while data
@@ -6570,15 +7691,45 @@ Returns how many articles were removed."
(gnus-summary-limit articles)
(gnus-summary-position-point))))
+(defun gnus-summary-limit-to-unseen ()
+ "Limit to unseen articles."
+ (interactive)
+ (prog1
+ (gnus-summary-limit gnus-newsgroup-unseen)
+ (gnus-summary-position-point)))
+
(defun gnus-summary-limit-include-thread (id)
- "Display all the hidden articles that in the current thread."
+ "Display all the hidden articles that is in the thread with ID in it.
+When called interactively, ID is the Message-ID of the current
+article."
(interactive (list (mail-header-id (gnus-summary-article-header))))
(let ((articles (gnus-articles-in-thread
(gnus-id-to-thread (gnus-root-id id)))))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
+ (gnus-summary-limit-include-matching-articles
+ "subject"
+ (regexp-quote (gnus-simplify-subject-re
+ (mail-header-subject (gnus-id-to-header id)))))
(gnus-summary-position-point))))
+(defun gnus-summary-limit-include-matching-articles (header regexp)
+ "Display all the hidden articles that have HEADERs that match REGEXP."
+ (interactive (list (read-string "Match on header: ")
+ (read-string "Regexp: ")))
+ (let ((articles (gnus-find-matching-articles header regexp)))
+ (prog1
+ (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-insert-dormant-articles ()
+ "Insert all the dormant articles for this group into the current buffer."
+ (interactive)
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if (not gnus-newsgroup-dormant)
+ (gnus-message 3 "No cached articles for this group")
+ (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
+
(defun gnus-summary-limit-include-dormant ()
"Display all the hidden articles that are marked as dormant.
Note that this command only works on a subset of the articles currently
@@ -6625,15 +7776,17 @@ fetched for this group."
"Mark all unread excluded articles as read.
If ALL, mark even excluded ticked and dormants as read."
(interactive "P")
- (let ((articles (gnus-sorted-complement
+ (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<))
+ (let ((articles (gnus-sorted-ndifference
(sort
(mapcar (lambda (h) (mail-header-number h))
gnus-newsgroup-headers)
'<)
- (sort gnus-newsgroup-limit '<)))
+ gnus-newsgroup-limit))
article)
(setq gnus-newsgroup-unreads
- (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit))
+ (gnus-sorted-intersection gnus-newsgroup-unreads
+ gnus-newsgroup-limit))
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
@@ -6663,9 +7816,7 @@ If ALL, mark even excluded ticked and dormants as read."
;; according to the new limit.
(gnus-summary-prepare)
;; Hide any threads, possibly.
- (and gnus-show-threads
- gnus-thread-hide-subtree
- (gnus-summary-hide-all-threads))
+ (gnus-summary-maybe-hide-threads)
;; Try to return to the article you were at, or one in the
;; neighborhood.
(when data
@@ -6725,7 +7876,7 @@ If ALL, mark even excluded ticked and dormants as read."
thread)
(defun gnus-cut-threads (threads)
- "Cut off all uninteresting articles from the beginning of threads."
+ "Cut off all uninteresting articles from the beginning of THREADS."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
(numberp gnus-fetch-old-headers)
@@ -6745,6 +7896,7 @@ fetch-old-headers verbiage, and so on."
;; Most groups have nothing to remove.
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
+ (eq gnus-newsgroup-display 'gnus-not-ignore)
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers))
(not (eq gnus-fetch-old-headers 'invisible))
@@ -6784,7 +7936,8 @@ fetch-old-headers verbiage, and so on."
;; will really go down to a leaf article first, before slowly
;; working its way up towards the root.
(when thread
- (let ((children
+ (let* ((max-lisp-eval-depth 5000)
+ (children
(if (cdr thread)
(apply '+ (mapcar 'gnus-summary-limit-children
(cdr thread)))
@@ -6833,6 +7986,9 @@ fetch-old-headers verbiage, and so on."
(push (cons number gnus-low-score-mark)
gnus-newsgroup-reads)))
t)
+ ;; Do the `display' group parameter.
+ (and gnus-newsgroup-display
+ (not (funcall gnus-newsgroup-display)))
;; Check NoCeM things.
(if (and gnus-use-nocem
(gnus-nocem-unwanted-article-p
@@ -6890,7 +8046,8 @@ The difference between N and the number of articles fetched is returned."
(set-buffer gnus-original-article-buffer)
(nnheader-narrow-to-headers)
(unless (setq ref (message-fetch-field "references"))
- (setq ref (message-fetch-field "in-reply-to")))
+ (when (setq ref (message-fetch-field "in-reply-to"))
+ (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
(widen))
(setq ref
;; It's not the current article, so we take a bet on
@@ -6936,19 +8093,24 @@ of what's specified by the `gnus-refer-thread-limit' variable."
(let ((id (mail-header-id (gnus-summary-article-header)))
(limit (if limit (prefix-numeric-value limit)
gnus-refer-thread-limit)))
- ;; We want to fetch LIMIT *old* headers, but we also have to
- ;; re-fetch all the headers in the current buffer, because many of
- ;; them may be undisplayed. So we adjust LIMIT.
- (when (numberp limit)
- (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin)))
(unless (eq gnus-fetch-old-headers 'invisible)
(gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
;; Retrieve the headers and read them in.
- (if (eq (gnus-retrieve-headers
- (list gnus-newsgroup-end) gnus-newsgroup-name limit)
+ (if (eq (if (numberp limit)
+ (gnus-retrieve-headers
+ (list (min
+ (+ (mail-header-number
+ (gnus-summary-article-header))
+ limit)
+ gnus-newsgroup-end))
+ gnus-newsgroup-name (* limit 2))
+ ;; gnus-refer-thread-limit is t, i.e. fetch _all_
+ ;; headers.
+ (gnus-retrieve-headers (list gnus-newsgroup-end)
+ gnus-newsgroup-name limit))
'nov)
(gnus-build-all-threads)
- (error "Can't fetch thread from backends that don't support NOV"))
+ (error "Can't fetch thread from back ends that don't support NOV"))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
(gnus-summary-limit-include-thread id)))
@@ -6957,12 +8119,16 @@ of what's specified by the `gnus-refer-thread-limit' variable."
(interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
+ (setq message-id (gnus-replace-in-string message-id " " ""))
;; Construct the correct Message-ID if necessary.
;; Suggested by tale@pawl.rpi.edu.
(unless (string-match "^<" message-id)
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
+ ;; People often post MIDs from URLs, so unhex it:
+ (unless (string-match "@" message-id)
+ (setq message-id (gnus-url-unhex-string message-id)))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
(gnus-summary-article-sparse-p
@@ -6985,9 +8151,10 @@ of what's specified by the `gnus-refer-thread-limit' variable."
;; We fetch the article.
(catch 'found
(dolist (gnus-override-method (gnus-refer-article-methods))
- (gnus-check-server gnus-override-method)
- ;; Fetch the header, and display the article.
- (when (setq number (gnus-summary-insert-subject message-id))
+ (when (and (gnus-check-server gnus-override-method)
+ ;; Fetch the header,
+ (setq number (gnus-summary-insert-subject message-id)))
+ ;; and display the article.
(gnus-summary-select-article nil nil nil number)
(throw 'found t)))
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
@@ -7031,8 +8198,12 @@ If FORCE, force a digest interpretation. If not, try
to guess what the document format is."
(interactive "P")
(let ((conf gnus-current-window-configuration))
- (save-excursion
- (gnus-summary-select-article))
+ (save-window-excursion
+ (save-excursion
+ (let (gnus-article-prepare-hook
+ gnus-display-mime-function
+ gnus-break-pages)
+ (gnus-summary-select-article))))
(setq gnus-current-window-configuration conf)
(let* ((name (format "%s-%d"
(gnus-group-prefixed-name
@@ -7043,6 +8214,7 @@ to guess what the document format is."
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))
+ (list (cons 'parent-group ogroup))
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
@@ -7051,8 +8223,8 @@ to guess what the document format is."
(set-buffer gnus-original-article-buffer)
;; Have the digest group inherit the main mail address of
;; the parent article.
- (when (setq to-address (or (message-fetch-field "reply-to")
- (message-fetch-field "from")))
+ (when (setq to-address (or (gnus-fetch-field "reply-to")
+ (gnus-fetch-field "from")))
(setq params (append
(list (cons 'to-address
(funcall gnus-decode-encoded-word-function
@@ -7068,21 +8240,24 @@ to guess what the document format is."
(delete-matching-lines "^Path:\\|^From ")
(widen))
(unwind-protect
- (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+ (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
(gnus-newsgroup-ephemeral-ignored-charsets
gnus-newsgroup-ignored-charsets))
(gnus-group-read-ephemeral-group
name `(nndoc ,name (nndoc-address ,(get-buffer dig))
(nndoc-article-type
- ,(if force 'mbox 'guess))) t))
+ ,(if force 'mbox 'guess)))
+ t nil nil nil
+ `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
+ "ADAPT")))))
;; Make all postings to this group go to the parent group.
- (nconc (gnus-info-params (gnus-get-info name))
- params)
- ;; Couldn't select this doc group.
- (switch-to-buffer buf)
- (gnus-set-global-variables)
- (gnus-configure-windows 'summary)
- (gnus-message 3 "Article couldn't be entered?"))
+ (nconc (gnus-info-params (gnus-get-info name))
+ params)
+ ;; Couldn't select this doc group.
+ (switch-to-buffer buf)
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'summary)
+ (gnus-message 3 "Article couldn't be entered?"))
(kill-buffer dig)))))
(defun gnus-summary-read-document (n)
@@ -7115,7 +8290,7 @@ Obeys the standard process/prefix convention."
(nndoc-article-type guess))
t nil t))
(progn
- ;; Make all postings to this group go to the parent group.
+ ;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info egroup))
params)
(push egroup groups))
@@ -7159,10 +8334,14 @@ If BACKWARD, search backward instead."
current-prefix-arg))
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
- (setq gnus-last-search-regexp regexp))
- (if (gnus-summary-search-article regexp backward)
- (gnus-summary-show-thread)
- (error "Search failed: \"%s\"" regexp)))
+ (setq gnus-last-search-regexp regexp)
+ (setq gnus-article-before-search gnus-current-article))
+ ;; Intentionally set gnus-last-article.
+ (setq gnus-last-article gnus-article-before-search)
+ (let ((gnus-last-article gnus-last-article))
+ (if (gnus-summary-search-article regexp backward)
+ (gnus-summary-show-thread)
+ (error "Search failed: \"%s\"" regexp))))
(defun gnus-summary-search-article-backward (regexp)
"Search for an article containing REGEXP backward."
@@ -7188,6 +8367,12 @@ Optional argument BACKWARD means do search for backward.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
+ (gnus-visual nil)
+ (gnus-keep-backlog nil)
+ (gnus-break-pages nil)
+ (gnus-summary-display-arrow nil)
+ (gnus-updated-mode-lines nil)
+ (gnus-auto-center-summary nil)
(sum (current-buffer))
(gnus-display-mime-function nil)
(found nil)
@@ -7241,6 +8426,18 @@ Optional argument BACKWARD means do search for backward.
(gnus-summary-position-point)
t)))
+(defun gnus-find-matching-articles (header regexp)
+ "Return a list of all articles that match REGEXP on HEADER.
+This search includes all articles in the current group that Gnus has
+fetched headers for, whether they are displayed or not."
+ (let ((articles nil)
+ (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
+ (case-fold-search t))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match regexp (funcall func header))
+ (push (mail-header-number header) articles)))
+ (nreverse articles)))
+
(defun gnus-summary-find-matching (header regexp &optional backward unread
not-case-fold not-matching)
"Return a list of all articles that match REGEXP on HEADER.
@@ -7287,9 +8484,11 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead."
(list (let ((completion-ignore-case t))
(completing-read
"Header name: "
- (mapcar (lambda (string) (list string))
- '("Number" "Subject" "From" "Lines" "Date"
- "Message-ID" "Xref" "References" "Body"))
+ (mapcar (lambda (header) (list (format "%s" header)))
+ (append
+ '("Number" "Subject" "From" "Lines" "Date"
+ "Message-ID" "Xref" "References" "Body")
+ gnus-extra-headers))
nil 'require-match))
(read-string "Regexp: ")
(read-key-sequence "Command: ")
@@ -7301,12 +8500,19 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead."
;; We don't want to change current point nor window configuration.
(save-excursion
(save-window-excursion
- (gnus-message 6 "Executing %s..." (key-description command))
- ;; We'd like to execute COMMAND interactively so as to give arguments.
- (gnus-execute header regexp
- `(call-interactively ',(key-binding command))
- backward)
- (gnus-message 6 "Executing %s...done" (key-description command)))))
+ (let (gnus-visual
+ gnus-treat-strip-trailing-blank-lines
+ gnus-treat-strip-leading-blank-lines
+ gnus-treat-strip-multiple-blank-lines
+ gnus-treat-hide-boring-headers
+ gnus-treat-fold-newsgroups
+ gnus-article-prepare-hook)
+ (gnus-message 6 "Executing %s..." (key-description command))
+ ;; We'd like to execute COMMAND interactively so as to give arguments.
+ (gnus-execute header regexp
+ `(call-interactively ',(key-binding command))
+ backward)
+ (gnus-message 6 "Executing %s...done" (key-description command))))))
(defun gnus-summary-beginning-of-article ()
"Scroll the article back to the beginning."
@@ -7316,7 +8522,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead."
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-page-broken
+ (when gnus-break-pages
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
@@ -7328,14 +8534,29 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead."
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-page-broken
+ (when gnus-break-pages
+ (when (re-search-backward page-delimiter nil t)
+ (narrow-to-region (match-end 0) (point-max)))
(gnus-narrow-to-page))))
+(defun gnus-summary-print-truncate-and-quote (string &optional len)
+ "Truncate to LEN and quote all \"(\"'s in STRING."
+ (gnus-replace-in-string (if (and len (> (length string) len))
+ (substring string 0 len)
+ string)
+ "[()]" "\\\\\\&"))
+
(defun gnus-summary-print-article (&optional filename n)
- "Generate and print a PostScript image of the N next (mail) articles.
+ "Generate and print a PostScript image of the process-marked (mail) articles.
+
+If used interactively, print the current article if none are
+process-marked. With prefix arg, prompt the user for the name of the
+file to save in.
-If N is negative, print the N previous articles. If N is nil and articles
-have been marked with the process mark, print these instead.
+When used from Lisp, accept two optional args FILENAME and N. N means
+to print the next N articles. If N is negative, print the N previous
+articles. If N is nil and articles have been marked with the process
+mark, print these instead.
If the optional first argument FILENAME is nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
@@ -7345,45 +8566,95 @@ to save in."
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-select-article nil nil 'pseudo article)
(gnus-eval-in-buffer-window gnus-article-buffer
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-article-delete-invisible-text)
- (let ((ps-left-header
- (list
- (concat "("
- (mail-header-subject gnus-current-headers) ")")
- (concat "("
- (mail-header-from gnus-current-headers) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
- (concat "("
- (mail-header-date gnus-current-headers) ")"))))
- (gnus-run-hooks 'gnus-ps-print-hook)
- (save-excursion
- (ps-spool-buffer-with-faces))))
- (kill-buffer buffer))))
+ (gnus-print-buffer))
(gnus-summary-remove-process-mark article))
(ps-despool filename))
+(defun gnus-print-buffer ()
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (gnus-remove-text-with-property 'gnus-decoration)
+ (when (gnus-visual-p 'article-highlight 'highlight)
+ ;; Copy-to-buffer doesn't copy overlay. So redo
+ ;; highlight.
+ (let ((gnus-article-buffer buffer))
+ (gnus-article-highlight-citation t)
+ (gnus-article-highlight-signature)
+ (gnus-article-emphasize)
+ (gnus-article-delete-invisible-text)))
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-subject gnus-current-headers)
+ 66) ")")
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-from gnus-current-headers)
+ 45) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (save-excursion
+ (if window-system
+ (ps-spool-buffer-with-faces)
+ (ps-spool-buffer)))))
+ (kill-buffer buffer))))
+
(defun gnus-summary-show-article (&optional arg)
- "Force re-fetching of the current article.
+ "Force redisplaying of the current article.
If ARG (the prefix) is a number, show the article with the charset
defined in `gnus-summary-show-article-charset-alist', or the charset
-inputed.
+input.
If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run."
+without any article massaging functions being run. Normally, the key
+strokes are `C-u g'."
(interactive "P")
(cond
((numberp arg)
+ (gnus-summary-show-article t)
(let ((gnus-newsgroup-charset
(or (cdr (assq arg gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: ")))
+ (mm-read-coding-system
+ "View as charset: " ;; actually it is coding system.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mm-detect-coding-region (point) (point-max))))))
(gnus-newsgroup-ignored-charsets 'gnus-all))
- (gnus-summary-select-article nil 'force)))
+ (gnus-summary-select-article nil 'force)
+ (let ((deps gnus-newsgroup-dependencies)
+ head header lines)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq head (buffer-string))
+ (goto-char (point-min))
+ (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
+ (goto-char (point-max))
+ (widen)
+ (setq lines (1- (count-lines (point) (point-max))))))
+ (with-temp-buffer
+ (insert (format "211 %d Article retrieved.\n"
+ (cdr gnus-article-current)))
+ (insert head)
+ (if lines (insert (format "Lines: %d\n" lines)))
+ (insert ".\n")
+ (let ((nntp-server-buffer (current-buffer)))
+ (setq header (car (gnus-get-newsgroup-headers deps t))))))
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header)
+ (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
+ (gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
((not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force))
@@ -7410,6 +8681,11 @@ without any article massaging functions being run."
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
+(defun gnus-summary-show-raw-article ()
+ "Show the raw article without any article massaging functions being run."
+ (interactive)
+ (gnus-summary-show-article t))
+
(defun gnus-summary-verbose-headers (&optional arg)
"Toggle permanent full header display.
If ARG is a positive number, turn header display on.
@@ -7428,42 +8704,46 @@ If ARG is a negative number, turn header display off."
If ARG is a positive number, show the entire header.
If ARG is a negative number, hide the unwanted header lines."
(interactive "P")
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
+ (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
+ (get-buffer-window gnus-article-buffer t))))
+ (with-current-buffer gnus-article-buffer
+ (widen)
+ (article-narrow-to-head)
(let* ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
- hidden s e)
- (setq hidden
- (if (numberp arg)
- (>= arg 0)
- (save-restriction
- (article-narrow-to-head)
- (gnus-article-hidden-text-p 'headers))))
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (point-min) (1- (point))))
- (goto-char (point-min))
+ (hidden (if (numberp arg)
+ (>= arg 0)
+ (gnus-article-hidden-text-p 'headers)))
+ s e)
+ (delete-region (point-min) (point-max))
(with-current-buffer gnus-original-article-buffer
(goto-char (setq s (point-min)))
- (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (setq e (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max))))
(insert-buffer-substring gnus-original-article-buffer s e)
- (save-restriction
- (narrow-to-region (point-min) (point))
- (article-decode-encoded-words)
- (if hidden
- (let ((gnus-treat-hide-headers nil)
- (gnus-treat-hide-boring-headers nil))
- (setq gnus-article-wash-types
- (delq 'headers gnus-article-wash-types))
- (gnus-treat-article 'head))
- (gnus-treat-article 'head)))
+ (run-hooks 'gnus-article-decode-hook)
+ (if hidden
+ (let ((gnus-treat-hide-headers nil)
+ (gnus-treat-hide-boring-headers nil))
+ (gnus-delete-wash-type 'headers)
+ (gnus-treat-article 'head))
+ (gnus-treat-article 'head))
+ (widen)
+ (if window
+ (set-window-start window (goto-char (point-min))))
+ (if gnus-break-pages
+ (gnus-narrow-to-page)
+ (when (gnus-visual-p 'page-marker)
+ (let ((buffer-read-only nil))
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next))))
(gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(interactive)
- (gnus-article-show-all-headers))
+ (gnus-summary-toggle-header 1))
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
@@ -7480,6 +8760,31 @@ forward."
(message-caesar-buffer-body arg)
(set-window-start (get-buffer-window (current-buffer)) start))))))
+(autoload 'unmorse-region "morse"
+ "Convert morse coded text in region to ordinary ASCII text."
+ t)
+
+(defun gnus-summary-morse-message (&optional arg)
+ "Morse decode the current article."
+ (interactive "P")
+ (gnus-summary-select-article)
+ (let ((mail-header-separator ""))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((pos (window-start))
+ buffer-read-only)
+ (goto-char (point-min))
+ (when (message-goto-body)
+ (gnus-narrow-to-body))
+ (goto-char (point-min))
+ (while (re-search-forward "·" (point-max) t)
+ (replace-match "."))
+ (unmorse-region (point-min) (point-max))
+ (widen)
+ (set-window-start (get-buffer-window (current-buffer)) pos)))))))
+
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
(interactive)
@@ -7503,6 +8808,10 @@ If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method.
+When called interactively with TO-NEWSGROUP being nil, the value of
+the variable `gnus-move-split-methods' is used for finding a default
+for the target newsgroup.
+
For this function to work, both the current newsgroup and the
newsgroup that you want to move to have to support the `request-move'
and `request-accept' functions.
@@ -7511,10 +8820,6 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(interactive "P")
(unless action
(setq action 'move))
- ;; Disable marking as read.
- (let (gnus-mark-article-hook)
- (save-window-excursion
- (gnus-summary-select-article)))
;; Check whether the source group supports the required functions.
(cond ((and (eq action 'move)
(not (gnus-check-backend-function
@@ -7526,7 +8831,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
(prefix (if (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)
+ 'request-move-article gnus-newsgroup-name)
(gnus-group-real-prefix gnus-newsgroup-name)
""))
(names '((move "Move" "Moving")
@@ -7540,6 +8845,18 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
;; Read the newsgroup name.
(when (and (not to-newsgroup)
(not select-method))
+ (if (and gnus-move-split-methods
+ (not
+ (and (memq gnus-current-article articles)
+ (gnus-buffer-live-p gnus-original-article-buffer))))
+ ;; When `gnus-move-split-methods' is non-nil, we have to
+ ;; select an article to give `gnus-read-move-group-name' an
+ ;; opportunity to suggest an appropriate default. However,
+ ;; we needn't render or mark the article.
+ (let ((gnus-display-mime-function nil)
+ (gnus-article-prepare-hook nil)
+ (gnus-mark-article-hook nil))
+ (gnus-summary-select-article nil nil nil (car articles))))
(setq to-newsgroup
(gnus-read-move-group-name
(cadr (assq action names))
@@ -7589,7 +8906,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(mail-header-xref (gnus-summary-article-header article))
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
- ":" article))
+ ":" (number-to-string article)))
(unless xref
(setq xref (list (system-name))))
(setq new-xref
@@ -7606,7 +8923,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(gnus-request-accept-article
to-newsgroup select-method (not articles))))
(setq new-xref (concat new-xref " " (car art-group)
- ":" (cdr art-group)))
+ ":"
+ (number-to-string (cdr art-group))))
;; Now we have the new Xrefs header, so we insert
;; it and replace the new article.
(nnheader-replace-header "Xref" new-xref)
@@ -7621,14 +8939,21 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
((eq art-group 'junk)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)))
+ (gnus-message 4 "Deleted article %s" article)
+ ;; run the delete hook
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name nil
+ select-method)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
(entry
(gnus-gethash pto-group gnus-newsrc-hashtb))
(info (nth 2 entry))
- (to-group (gnus-info-group info))
+ (to-group (gnus-info-group info))
to-marks)
;; Update the group that has been moved to.
(when (and info
@@ -7643,7 +8968,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(list (cdr art-group)))))
;; See whether the article is to be put in the cache.
- (let ((marks gnus-article-mark-lists)
+ (let ((marks (if (gnus-group-auto-expirable-p to-group)
+ gnus-article-mark-lists
+ (delete '(expirable . expire)
+ (copy-sequence gnus-article-mark-lists))))
(to-article (cdr art-group)))
;; Enter the article into the cache in the new group,
@@ -7665,26 +8993,26 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(setcdr gnus-newsgroup-active to-article))
(while marks
- (when (memq article (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))
- (push (cdar marks) to-marks)
- ;; If the other group is the same as this group,
- ;; then we have to add the mark to the list.
- (when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
- (cons to-article
- (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))))
- ;; Copy the marks to other group.
- (gnus-add-marked-articles
- to-group (cdar marks) (list to-article) info))
+ (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+ (when (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))
+ (push (cdar marks) to-marks)
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy the marks to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info)))
(setq marks (cdr marks)))
- (gnus-request-set-mark to-group (list (list (list to-article)
- 'set
- to-marks))))
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
@@ -7699,22 +9027,29 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer)))))
+ article gnus-newsgroup-name (current-buffer))))
+
+ ;; run the move/copy/crosspost/respool hook
+ (run-hook-with-args 'gnus-summary-article-move-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ to-newsgroup
+ select-method))
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
-
+
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))
(gnus-summary-remove-process-mark article))
;; Re-activate all groups that have been moved to.
- (while to-groups
- (save-excursion
- (set-buffer gnus-group-buffer)
- (when (gnus-group-goto-group (car to-groups) t)
- (gnus-group-get-new-news-this-group 1 t))
- (pop to-groups)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let ((gnus-group-marked to-groups))
+ (gnus-group-get-new-news-this-group nil t)))
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
@@ -7723,6 +9058,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Move the current article to a different newsgroup.
If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
+When called interactively, if TO-NEWSGROUP is nil, use the value of
+the variable `gnus-move-split-methods' for finding a default target
+newsgroup.
If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method."
(interactive "P")
@@ -7734,12 +9072,20 @@ re-spool using this method."
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
- "Default method for respooling an article.
+ "Default method type for respooling an article.
If nil, use to the current newsgroup method."
- :type '(choice (gnus-select-method :value (nnml ""))
- (const nil))
+ :type 'symbol
:group 'gnus-summary-mail)
+(defcustom gnus-summary-display-while-building nil
+ "If non-nil, show and update the summary buffer as it's being built.
+If the value is t, update the buffer after every line is inserted. If
+the value is an integer (N), update the display every N lines."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ number
+ (const :tag "frequently" t)))
+
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
@@ -7762,7 +9108,7 @@ latter case, they will be copied into the relevant groups."
(car (gnus-find-method-for-group
gnus-newsgroup-name)))))
(method
- (gnus-completing-read
+ (gnus-completing-read-with-default
methname "What backend do you want to use when respooling?"
methods nil t nil 'gnus-mail-method-history))
ms)
@@ -7784,12 +9130,12 @@ latter case, they will be copied into the relevant groups."
(gnus-summary-move-article n nil method)
(gnus-summary-copy-article n nil method)))
-(defun gnus-summary-import-article (file)
+(defun gnus-summary-import-article (file &optional edit)
"Import an arbitrary file into a mail newsgroup."
- (interactive "fImport file: ")
+ (interactive "fImport file: \nP")
(let ((group gnus-newsgroup-name)
(now (current-time))
- atts lines)
+ atts lines group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
(or (file-readable-p file)
@@ -7800,19 +9146,55 @@ latter case, they will be copied into the relevant groups."
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-min))
- (unless (nnheader-article-p)
- ;; This doesn't look like an article, so we fudge some headers.
+ (if (nnheader-article-p)
+ (save-restriction
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (narrow-to-region (point-min) (1- (point)))
+ (goto-char (point-min))
+ (unless (re-search-forward "^date:" nil t)
+ (goto-char (point-max))
+ (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
+ ;; This doesn't look like an article, so we fudge some headers.
(setq atts (file-attributes file)
lines (count-lines (point-min) (point-max)))
(insert "From: " (read-string "From: ") "\n"
"Subject: " (read-string "Subject: ") "\n"
- "Date: " (message-make-date (nth 5 atts))
- "\n"
+ "Date: " (message-make-date (nth 5 atts)) "\n"
"Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
- (gnus-request-accept-article group nil t)
- (kill-buffer (current-buffer)))))
+ (setq group-art (gnus-request-accept-article group nil t))
+ (kill-buffer (current-buffer)))
+ (setq gnus-newsgroup-active (gnus-activate-group group))
+ (forward-line 1)
+ (gnus-summary-goto-article (cdr group-art) nil t)
+ (when edit
+ (gnus-summary-edit-article))))
+
+(defun gnus-summary-create-article ()
+ "Create an article in a mail newsgroup."
+ (interactive)
+ (let ((group gnus-newsgroup-name)
+ (now (current-time))
+ group-art)
+ (unless (gnus-check-backend-function 'request-accept-article group)
+ (error "%s does not support article importing" group))
+ (save-excursion
+ (set-buffer (gnus-get-buffer-create " *import file*"))
+ (erase-buffer)
+ (goto-char (point-min))
+ ;; This doesn't look like an article, so we fudge some headers.
+ (insert "From: " (read-string "From: ") "\n"
+ "Subject: " (read-string "Subject: ") "\n"
+ "Date: " (message-make-date now) "\n"
+ "Message-ID: " (message-make-message-id) "\n")
+ (setq group-art (gnus-request-accept-article group nil t))
+ (kill-buffer (current-buffer)))
+ (setq gnus-newsgroup-active (gnus-activate-group group))
+ (forward-line 1)
+ (gnus-summary-goto-article (cdr group-art) nil t)
+ (gnus-summary-edit-article)))
(defun gnus-summary-article-posted-p ()
"Say whether the current (mail) article is available from news as well.
@@ -7830,8 +9212,9 @@ This will be the case if the article has both been mailed and posted."
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (when (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)
+ (when (and (not gnus-group-is-exiting-without-update-p)
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name))
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
@@ -7865,19 +9248,24 @@ This will be the case if the article has both been mailed and posted."
(setq es (gnus-request-expire-articles
expirable gnus-newsgroup-name)))
(setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name))))
- (unless total
- (setq gnus-newsgroup-expirable es))
- ;; We go through the old list of expirable, and mark all
- ;; really expired articles as nonexistent.
- (unless (eq es expirable) ;If nothing was expired, we don't mark.
- (let ((gnus-use-cache nil))
- (while expirable
- (unless (memq (car expirable) es)
- (when (gnus-data-find (car expirable))
- (gnus-summary-mark-article
- (car expirable) gnus-canceled-mark)))
- (setq expirable (cdr expirable)))))
+ expirable gnus-newsgroup-name)))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
+ ;; We go through the old list of expirable, and mark all
+ ;; really expired articles as nonexistent.
+ (unless (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (dolist (article expirable)
+ (when (and (not (memq article es))
+ (gnus-data-find article))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (run-hook-with-args 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ nil
+ nil))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
@@ -7897,9 +9285,13 @@ deleted forever, right now."
This command actually deletes articles. This is not a marking
command. The article will disappear forever from your life, never to
return.
+
If N is negative, delete backwards.
If N is nil and articles have been marked with the process mark,
-delete these instead."
+delete these instead.
+
+If `gnus-novice-user' is non-nil you will be asked for
+confirmation before the articles are deleted."
(interactive "P")
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
@@ -7908,6 +9300,7 @@ delete these instead."
(error "Couldn't open server"))
;; Compute the list of articles to delete.
(let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
+ (nnmail-expiry-target 'delete)
not-deleted)
(if (and gnus-novice-user
(not (gnus-yes-or-no-p
@@ -7925,6 +9318,12 @@ delete these instead."
;; after all.
(unless (memq (car articles) not-deleted)
(gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (id (mail-header-id (gnus-data-header
+ (assoc article (gnus-data-list nil))))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete id gnus-newsgroup-name nil
+ nil))
(setq articles (cdr articles)))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
@@ -7938,18 +9337,33 @@ This will have permanent effect only in mail groups.
If ARG is nil, edit the decoded articles.
If ARG is 1, edit the raw articles.
If ARG is 2, edit the raw articles even in read-only groups.
+If ARG is 3, edit the articles with the current handles.
Otherwise, allow editing of articles even in read-only
groups."
(interactive "P")
- (let (force raw)
+ (let (force raw current-handles)
(cond
((null arg))
- ((eq arg 1) (setq raw t))
- ((eq arg 2) (setq raw t
- force t))
- (t (setq force t)))
- (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts"))
- (error "Can't edit the raw article in group nndraft:drafts"))
+ ((eq arg 1)
+ (setq raw t))
+ ((eq arg 2)
+ (setq raw t
+ force t))
+ ((eq arg 3)
+ (setq current-handles
+ (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (prog1
+ gnus-article-mime-handles
+ (setq gnus-article-mime-handles nil))))))
+ (t
+ (setq force t)))
+ (when (and raw (not force)
+ (member gnus-newsgroup-name '("nndraft:delayed"
+ "nndraft:drafts"
+ "nndraft:queue")))
+ (error "Can't edit the raw article in group %s"
+ gnus-newsgroup-name))
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((mail-parse-charset gnus-newsgroup-charset)
@@ -7962,21 +9376,23 @@ groups."
(when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
(with-current-buffer gnus-article-buffer
(mm-enable-multibyte)))
- (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
(setq raw t))
(gnus-article-edit-article
(if raw 'ignore
- #'(lambda ()
- (let ((mbl mml-buffer-list))
- (setq mml-buffer-list nil)
- (mime-to-mml)
- (make-local-hook 'kill-buffer-hook)
- (let ((mml-buffer-list mml-buffer-list))
- (setq mml-buffer-list mbl)
- (make-local-variable 'mml-buffer-list))
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
+ `(lambda ()
+ (let ((mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (mime-to-mml ,'current-handles)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
`(lambda (no-highlight)
(let ((mail-parse-charset ',gnus-newsgroup-charset)
+ (message-options message-options)
+ (message-options-set-recipient)
(mail-parse-ignored-charsets
',gnus-newsgroup-ignored-charsets))
,(if (not raw) '(progn
@@ -7996,10 +9412,31 @@ groups."
no-highlight)
"Make edits to the current article permanent."
(interactive)
+ (save-excursion
+ ;; The buffer restriction contains the entire article if it exists.
+ (when (article-goto-body)
+ (let ((lines (count-lines (point) (point-max)))
+ (length (- (point-max) (point)))
+ (case-fold-search t)
+ (body (copy-marker (point))))
+ (goto-char (point-min))
+ (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^x-content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string lines))))))
;; Replace the article.
(let ((buf (current-buffer)))
(with-temp-buffer
(insert-buffer-substring buf)
+
(if (and (not read-only)
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
@@ -8023,20 +9460,24 @@ groups."
(insert ".\n")
(let ((nntp-server-buffer (current-buffer)))
(setq header (car (gnus-get-newsgroup-headers
- (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies)
- t))))
+ nil t))))
(save-excursion
(set-buffer gnus-summary-buffer)
(gnus-data-set-header
(gnus-data-find (cdr gnus-article-current))
header)
(gnus-summary-update-article-line
- (cdr gnus-article-current) header))))))
+ (cdr gnus-article-current) header)
+ (if (gnus-summary-goto-subject
+ (cdr gnus-article-current) nil t)
+ (gnus-summary-update-secondary-mark
+ (cdr gnus-article-current))))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current)))
+ (gnus-summary-update-article (cdr gnus-article-current))
+ (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
+ (gnus-summary-update-secondary-mark
+ (cdr gnus-article-current))))
;; Prettify the article buffer again.
(unless no-highlight
(save-excursion
@@ -8072,15 +9513,13 @@ groups."
(gnus-summary-select-article)
(save-excursion
(set-buffer gnus-original-article-buffer)
- (save-restriction
- (message-narrow-to-head)
- (let ((groups (nnmail-article-group 'identity trace)))
- (unless silent
- (if groups
- (message "This message would go to %s"
- (mapconcat 'car groups ", "))
- (message "This message would go to no groups"))
- groups))))))
+ (let ((groups (nnmail-article-group 'identity trace)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups)))))
(defun gnus-summary-respool-trace ()
"Trace where the respool algorithm would put this article.
@@ -8162,28 +9601,31 @@ If optional argument UNMARK is negative, mark articles as unread instead."
If N is negative, mark backward instead. If UNMARK is non-nil, remove
the process mark instead. The difference between N and the actual
number of articles marked is returned."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and
- (> n 0)
- (if unmark
- (gnus-summary-remove-process-mark
- (gnus-summary-article-number))
- (gnus-summary-set-process-mark (gnus-summary-article-number)))
- (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
- (setq n (1- n)))
- (when (/= 0 n)
- (gnus-message 7 "No more articles"))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- n))
+ (interactive "P")
+ (if (and (null n) (gnus-region-active-p))
+ (gnus-uu-mark-region (region-beginning) (region-end) unmark)
+ (setq n (prefix-numeric-value n))
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (while (and
+ (> n 0)
+ (if unmark
+ (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
+ (gnus-summary-set-process-mark (gnus-summary-article-number)))
+ (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more articles"))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ n)))
(defun gnus-summary-unmark-as-processable (n)
"Remove the process mark from the next N articles.
If N is negative, unmark backward instead. The difference between N and
the actual number of articles unmarked is returned."
- (interactive "p")
+ (interactive "P")
(gnus-summary-mark-as-processable n t))
(defun gnus-summary-unmark-all-processable ()
@@ -8194,6 +9636,20 @@ the actual number of articles unmarked is returned."
(gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
(gnus-summary-position-point))
+(defun gnus-summary-add-mark (article type)
+ "Mark ARTICLE with a mark of TYPE."
+ (let ((vtype (car (assq type gnus-article-mark-lists)))
+ var)
+ (if (not vtype)
+ (error "No such mark type: %s" type)
+ (setq var (intern (format "gnus-newsgroup-%s" type)))
+ (set var (cons article (symbol-value var)))
+ (if (memq type '(processable cached replied forwarded recent saved))
+ (gnus-summary-update-secondary-mark article)
+ ;;; !!! This is bogus. We should find out what primary
+ ;;; !!! mark we want to set.
+ (gnus-summary-update-mark gnus-del-mark 'unread)))))
+
(defun gnus-summary-mark-as-expirable (n)
"Mark N articles forward as expirable.
If N is negative, mark backward instead. The difference between N and
@@ -8201,12 +9657,35 @@ the actual number of articles marked is returned."
(interactive "p")
(gnus-summary-mark-forward n gnus-expirable-mark))
+(defun gnus-summary-mark-as-spam (n)
+ "Mark N articles forward as spam.
+If N is negative, mark backward instead. The difference between N and
+the actual number of articles marked is returned."
+ (interactive "p")
+ (gnus-summary-mark-forward n gnus-spam-mark))
+
(defun gnus-summary-mark-article-as-replied (article)
- "Mark ARTICLE replied and update the summary line."
- (push article gnus-newsgroup-replied)
- (let ((buffer-read-only nil))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-secondary-mark article))))
+ "Mark ARTICLE as replied to and update the summary line.
+ARTICLE can also be a list of articles."
+ (interactive (list (gnus-summary-article-number)))
+ (let ((articles (if (listp article) article (list article))))
+ (dolist (article articles)
+ (unless (numberp article)
+ (error "%s is not a number" article))
+ (push article gnus-newsgroup-replied)
+ (let ((buffer-read-only nil))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article))))))
+
+(defun gnus-summary-mark-article-as-forwarded (article)
+ "Mark ARTICLE as forwarded and update the summary line.
+ARTICLE can also be a list of articles."
+ (let ((articles (if (listp article) article (list article))))
+ (dolist (article articles)
+ (push article gnus-newsgroup-forwarded)
+ (let ((buffer-read-only nil))
+ (when (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article))))))
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
@@ -8217,10 +9696,7 @@ the actual number of articles marked is returned."
(not (equal gnus-newsgroup-name (car gnus-article-current))))
(error "No current article selected"))
;; Remove old bookmark, if one exists.
- (let ((old (assq article gnus-newsgroup-bookmarks)))
- (when old
- (setq gnus-newsgroup-bookmarks
- (delq old gnus-newsgroup-bookmarks))))
+ (gnus-pull article gnus-newsgroup-bookmarks)
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
(push
@@ -8230,8 +9706,7 @@ the actual number of articles marked is returned."
(count-lines
(min (point)
(save-excursion
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
+ (article-goto-body)
(point)))
(point))))
gnus-newsgroup-bookmarks)
@@ -8241,13 +9716,10 @@ the actual number of articles marked is returned."
"Remove the bookmark from the current article."
(interactive (list (gnus-summary-article-number)))
;; Remove old bookmark, if one exists.
- (let ((old (assq article gnus-newsgroup-bookmarks)))
- (if old
- (progn
- (setq gnus-newsgroup-bookmarks
- (delq old gnus-newsgroup-bookmarks))
- (gnus-message 6 "Removed bookmark."))
- (gnus-message 6 "No bookmark in current article."))))
+ (if (not (assq article gnus-newsgroup-bookmarks))
+ (gnus-message 6 "No bookmark in current article.")
+ (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-message 6 "Removed bookmark.")))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defun gnus-summary-mark-as-dormant (n)
@@ -8293,7 +9765,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(gnus-summary-goto-unread
(and gnus-summary-goto-unread
(not (eq gnus-summary-goto-unread 'never))
- (not (memq mark (list gnus-unread-mark
+ (not (memq mark (list gnus-unread-mark gnus-spam-mark
gnus-ticked-mark gnus-dormant-mark)))))
(n (abs n))
(mark (or mark gnus-del-mark)))
@@ -8317,6 +9789,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(let ((article (gnus-summary-article-number)))
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(push (cons article mark) gnus-newsgroup-reads)
;; Possibly remove from cache, if that is used.
@@ -8348,15 +9821,27 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(gnus-error 1 "Can't mark negative article numbers")
nil)
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-spam-marked
+ (delq article gnus-newsgroup-spam-marked))
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
(setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
(cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-marked
+ (gnus-add-to-sorted-list gnus-newsgroup-marked
+ article)))
+ ((= mark gnus-spam-mark)
+ (setq gnus-newsgroup-spam-marked
+ (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
+ article)))
((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-dormant
+ (gnus-add-to-sorted-list gnus-newsgroup-dormant
+ article)))
(t
- (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-unreads
+ (gnus-add-to-sorted-list gnus-newsgroup-unreads
+ article))))
(gnus-pull article gnus-newsgroup-reads)
;; See whether the article is to be put in the cache.
@@ -8388,7 +9873,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(setq mark gnus-del-mark))
(when (and (not no-expire)
gnus-newsgroup-auto-expire
- (memq mark gnus-auto-expirable-marks))
+ (memq mark gnus-auto-expirable-marks))
(setq mark gnus-expirable-mark))
(let ((article (or article (gnus-summary-article-number)))
(old-mark (gnus-summary-article-mark article)))
@@ -8400,6 +9885,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(error "No article on current line"))
(if (not (if (or (= mark gnus-unread-mark)
(= mark gnus-ticked-mark)
+ (= mark gnus-spam-mark)
(= mark gnus-dormant-mark))
(gnus-mark-article-as-unread article mark)
(gnus-mark-article-as-read article mark)))
@@ -8430,17 +9916,36 @@ If NO-EXPIRE, auto-expiry will be inhibited."
gnus-cached-mark)
((memq article gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq article gnus-newsgroup-forwarded)
+ gnus-forwarded-mark)
((memq article gnus-newsgroup-saved)
gnus-saved-mark)
- (t gnus-unread-mark))
+ ((memq article gnus-newsgroup-recent)
+ gnus-recent-mark)
+ ((memq article gnus-newsgroup-unseen)
+ gnus-unseen-mark)
+ (t gnus-no-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
(gnus-run-hooks 'gnus-summary-update-hook))
t)
+(defun gnus-summary-update-download-mark (article)
+ "Update the download mark."
+ (gnus-summary-update-mark
+ (cond ((memq article gnus-newsgroup-undownloaded)
+ gnus-undownloaded-mark)
+ (gnus-newsgroup-agentized
+ gnus-downloaded-mark)
+ (t
+ gnus-no-mark))
+ 'download)
+ (gnus-summary-update-line t)
+ t)
+
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
- (buffer-read-only nil))
+ (buffer-read-only nil))
(re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
(when forward
(when (looking-at "\r")
@@ -8460,12 +9965,14 @@ If NO-EXPIRE, auto-expiry will be inhibited."
"Enter ARTICLE in the pertinent lists and remove it from others."
;; Make the article expirable.
(let ((mark (or mark gnus-del-mark)))
- (if (= mark gnus-expirable-mark)
- (push article gnus-newsgroup-expirable)
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
+ (setq gnus-newsgroup-expirable
+ (if (= mark gnus-expirable-mark)
+ (gnus-add-to-sorted-list gnus-newsgroup-expirable article)
+ (delq article gnus-newsgroup-expirable)))
;; Remove from unread and marked lists.
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
(push (cons article mark) gnus-newsgroup-reads)
;; Possibly remove from cache, if that is used.
@@ -8481,6 +9988,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(gnus-error 1 "Can't mark negative article numbers")
nil)
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+ gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
@@ -8490,11 +9998,18 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(gnus-dup-unsuppress-article article))
(cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-marked
+ (gnus-add-to-sorted-list gnus-newsgroup-marked article)))
+ ((= mark gnus-spam-mark)
+ (setq gnus-newsgroup-spam-marked
+ (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
+ article)))
((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-dormant
+ (gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
(t
- (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-unreads
+ (gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
(gnus-pull article gnus-newsgroup-reads)
t)))
@@ -8569,12 +10084,26 @@ The difference between N and the number of marks cleared is returned."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-read-mark)))
-(defun gnus-summary-mark-read-and-unread-as-read ()
+(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
"Intended to be used by `gnus-summary-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
- (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
+ (gnus-summary-mark-article gnus-current-article
+ (or new-mark gnus-read-mark)))))
+
+(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
+ "Intended to be used by `gnus-summary-mark-article-hook'."
+ (let ((mark (gnus-summary-article-mark)))
+ (when (or (gnus-unread-mark-p mark)
+ (gnus-read-mark-p mark))
+ (gnus-summary-mark-article (gnus-summary-article-number)
+ (or new-mark gnus-read-mark)))))
+
+(defun gnus-summary-mark-unread-as-ticked ()
+ "Intended to be used by `gnus-summary-mark-article-hook'."
+ (when (memq gnus-current-article gnus-newsgroup-unreads)
+ (gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
(defun gnus-summary-mark-region-as-read (point mark all)
"Mark all unread articles between point and mark as read.
@@ -8649,8 +10178,8 @@ even ticked and dormant ones."
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
- (unless (gnus-summary-goto-subject (caar scored))
- (and (setq h (gnus-summary-article-header (caar scored)))
+ (unless (gnus-summary-article-header (caar scored))
+ (and (setq h (gnus-number-to-header (caar scored)))
(< (cdar scored) gnus-summary-expunge-below)
(push h headers)))
(setq scored (cdr scored)))
@@ -8658,20 +10187,29 @@ even ticked and dormant ones."
(when (not no-error)
(error "No expunged articles hidden"))
(goto-char (point-min))
+ (push gnus-newsgroup-limit gnus-newsgroup-limits)
+ (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
+ (mapcar (lambda (x) (push (mail-header-number x)
+ gnus-newsgroup-limit))
+ headers)
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(gnus-summary-position-point)
t))))
-(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
+(defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
"Mark all unread articles in this newsgroup as read.
If prefix argument ALL is non-nil, ticked and dormant articles will
also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
+
If TO-HERE is non-nil, it should be a point in the buffer. All
-articles before this point will be marked as read.
+articles before (after, if REVERSE is set) this point will be marked
+as read.
+
Note that this function will only catch up the unread article
in the current summary buffer limitation.
+
The number of articles marked as read is returned."
(interactive "P")
(prog1
@@ -8692,16 +10230,28 @@ The number of articles marked as read is returned."
(progn
(when all
(setq gnus-newsgroup-marked nil
+ gnus-newsgroup-spam-marked nil
gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable))
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion
+ (gnus-intersection gnus-newsgroup-unreads
+ gnus-newsgroup-downloadable)
+ gnus-newsgroup-unfetched)))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
- (when (gnus-summary-first-subject (not all) t)
- (while (and
- (if to-here (< (point) to-here) t)
- (gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all) nil nil t))))
+ (if (and to-here reverse)
+ (progn
+ (goto-char to-here)
+ (gnus-summary-mark-current-read-and-unread-as-read
+ gnus-catchup-mark)
+ (while (gnus-summary-find-next (not all))
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)))
+ (when (gnus-summary-first-subject (not all))
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all))))))
(gnus-set-mode-line 'summary))
t))
(gnus-summary-position-point)))
@@ -8718,14 +10268,29 @@ If ALL is non-nil, also mark ticked and dormant articles as read."
(gnus-summary-catchup all t beg)))))
(gnus-summary-position-point))
+(defun gnus-summary-catchup-from-here (&optional all)
+ "Mark all unticked articles after (and including) the current one as read.
+If ALL is non-nil, also mark ticked and dormant articles as read."
+ (interactive "P")
+ (save-excursion
+ (gnus-save-hidden-threads
+ (let ((beg (point)))
+ ;; We check that there are unread articles.
+ (when (or all (gnus-summary-find-next))
+ (gnus-summary-catchup all t beg nil t)))))
+ (gnus-summary-position-point))
+
(defun gnus-summary-catchup-all (&optional quietly)
- "Mark all articles in this newsgroup as read."
+ "Mark all articles in this newsgroup as read.
+This command is dangerous. Normally, you want \\[gnus-summary-catchup]
+instead, which marks only unread articles as read."
(interactive "P")
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all unread articles in this group as read, then exit.
-If prefix argument ALL is non-nil, all articles are marked as read."
+If prefix argument ALL is non-nil, all articles are marked as read.
+If QUIETLY is non-nil, no questions will be asked."
(interactive "P")
(when (gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
@@ -8735,7 +10300,9 @@ If prefix argument ALL is non-nil, all articles are marked as read."
(gnus-summary-exit))))
(defun gnus-summary-catchup-all-and-exit (&optional quietly)
- "Mark all articles in this newsgroup as read, and then exit."
+ "Mark all articles in this newsgroup as read, and then exit.
+This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit]
+instead, which marks only unread articles as read."
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
@@ -8870,6 +10437,8 @@ is non-nil or the Subject: of both articles are the same."
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-update-article current-article)
+ (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
+ (gnus-summary-update-secondary-mark (cdr gnus-article-current)))
(gnus-summary-rethread-current)
(gnus-message 3 "Article %d is now the child of article %d"
current-article parent-article)))))
@@ -8901,8 +10470,8 @@ Returns nil if no thread was there to be shown."
(interactive)
(let ((buffer-read-only nil)
(orig (point))
- ;; first goto end then to beg, to have point at beg after let
- (end (progn (end-of-line) (point)))
+ (end (gnus-point-at-eol))
+ ;; Leave point at bol
(beg (progn (beginning-of-line) (point))))
(prog1
;; Any hidden lines here?
@@ -8911,18 +10480,49 @@ Returns nil if no thread was there to be shown."
(goto-char orig)
(gnus-summary-position-point))))
-(defun gnus-summary-hide-all-threads ()
- "Hide all thread subtrees."
+(defun gnus-summary-maybe-hide-threads ()
+ "If requested, hide the threads that should be hidden."
+ (when (and gnus-show-threads
+ gnus-thread-hide-subtree)
+ (gnus-summary-hide-all-threads
+ (if (or (consp gnus-thread-hide-subtree)
+ (functionp gnus-thread-hide-subtree))
+ (gnus-make-predicate gnus-thread-hide-subtree)
+ nil))))
+
+;;; Hiding predicates.
+
+(defun gnus-article-unread-p (header)
+ (memq (mail-header-number header) gnus-newsgroup-unreads))
+
+(defun gnus-article-unseen-p (header)
+ (memq (mail-header-number header) gnus-newsgroup-unseen))
+
+(defun gnus-map-articles (predicate articles)
+ "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
+ (apply 'gnus-or (mapcar predicate
+ (mapcar 'gnus-summary-article-header articles))))
+
+(defun gnus-summary-hide-all-threads (&optional predicate)
+ "Hide all thread subtrees.
+If PREDICATE is supplied, threads that satisfy this predicate
+will not be hidden."
(interactive)
(save-excursion
(goto-char (point-min))
- (gnus-summary-hide-thread)
- (while (zerop (gnus-summary-next-thread 1 t))
- (gnus-summary-hide-thread)))
+ (let ((end nil))
+ (while (not end)
+ (when (or (not predicate)
+ (gnus-map-articles
+ predicate (gnus-summary-article-children)))
+ (gnus-summary-hide-thread))
+ (setq end (not (zerop (gnus-summary-next-thread 1 t)))))))
(gnus-summary-position-point))
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
+If PREDICATE is supplied, threads that satisfy this predicate
+will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
(let ((buffer-read-only nil)
@@ -9020,7 +10620,7 @@ taken."
(defun gnus-summary-up-thread (n)
"Go up thread N steps.
-If N is negative, go up instead.
+If N is negative, go down instead.
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
@@ -9071,6 +10671,12 @@ Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'number reverse))
+(defun gnus-summary-sort-by-random (&optional reverse)
+ "Randomize the order in the summary buffer.
+Argument REVERSE means to randomize in reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'random reverse))
+
(defun gnus-summary-sort-by-author (&optional reverse)
"Sort the summary buffer by author name alphabetically.
If `case-fold-search' is non-nil, case of letters is ignored.
@@ -9109,6 +10715,17 @@ Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'chars reverse))
+(defun gnus-summary-sort-by-original (&optional reverse)
+ "Sort the summary buffer using the default sorting method.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (let* ((buffer-read-only)
+ (gnus-summary-prepare-hook nil))
+ ;; We do the sorting by regenerating the threads.
+ (gnus-summary-prepare)
+ ;; Hide subthreads if needed.
+ (gnus-summary-maybe-hide-threads)))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
@@ -9130,8 +10747,7 @@ Argument REVERSE means reverse order."
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
;; Hide subthreads if needed.
- (when (and gnus-show-threads gnus-thread-hide-subtree)
- (gnus-summary-hide-all-threads))))
+ (gnus-summary-maybe-hide-threads)))
;; Summary saving commands.
@@ -9173,17 +10789,22 @@ The variable `gnus-default-article-saver' specifies the saver function."
(gnus-set-mode-line 'summary)
n))
-(defun gnus-summary-pipe-output (&optional arg)
+(defun gnus-summary-pipe-output (&optional arg headers)
"Pipe the current article to a subprocess.
If N is a positive number, pipe the N next articles.
If N is a negative number, pipe the N previous articles.
If N is nil and any articles have been marked with the process mark,
-pipe those articles instead."
- (interactive "P")
+pipe those articles instead.
+If HEADERS (the symbolic prefix), include the headers, too."
+ (interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
+ (gnus-save-all-headers (or headers gnus-save-all-headers)))
(gnus-summary-save-article arg t))
- (gnus-configure-windows 'pipe))
+ (let ((buffer (get-buffer "*Shell Command Output*")))
+ (when (and buffer
+ (not (zerop (buffer-size buffer))))
+ (gnus-configure-windows 'pipe))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to an mail file.
@@ -9240,6 +10861,17 @@ save those articles instead."
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-muttprint (&optional arg)
+ "Print the current article using Muttprint.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (require 'gnus-art)
+ (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
+ (gnus-summary-save-article arg t)))
+
(defun gnus-summary-pipe-message (program)
"Pipe the current article through PROGRAM."
(interactive "sProgram: ")
@@ -9247,11 +10879,11 @@ save those articles instead."
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
(save-restriction
- (widen)
- (let ((start (window-start))
- buffer-read-only)
- (message-pipe-buffer-body program)
- (set-window-start (get-buffer-window (current-buffer)) start))))))
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-pipe-buffer-body program)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
(defun gnus-get-split-value (methods)
"Return a value based on the split METHODS."
@@ -9270,7 +10902,7 @@ save those articles instead."
;; Regular expression.
(ignore-errors
(re-search-forward match nil t)))
- ((gnus-functionp match)
+ ((functionp match)
;; Function.
(save-restriction
(widen)
@@ -9309,24 +10941,27 @@ save those articles instead."
(to-newsgroup
(cond
((null split-name)
- (gnus-completing-read default prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil prefix
- 'gnus-group-history))
+ (gnus-completing-read-with-default
+ default prom
+ gnus-active-hashtb
+ 'gnus-valid-move-group-p
+ nil prefix
+ 'gnus-group-history))
((= 1 (length split-name))
- (gnus-completing-read (car split-name) prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil nil
- 'gnus-group-history))
+ (gnus-completing-read-with-default
+ (car split-name) prom
+ gnus-active-hashtb
+ 'gnus-valid-move-group-p
+ nil nil
+ 'gnus-group-history))
(t
- (gnus-completing-read nil prom
- (mapcar (lambda (el) (list el))
- (nreverse split-name))
- nil nil nil
- 'gnus-group-history))))
- (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
+ (gnus-completing-read-with-default
+ nil prom
+ (mapcar (lambda (el) (list el))
+ (nreverse split-name))
+ nil nil nil
+ 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
@@ -9365,7 +11000,9 @@ If REVERSE, save parts that do not match TYPE."
(save-excursion
(set-buffer gnus-article-buffer)
(let ((handles (or gnus-article-mime-handles
- (mm-dissect-buffer) (mm-uu-dissect))))
+ (mm-dissect-buffer nil gnus-article-loose-mime)
+ (and gnus-article-emulate-mime
+ (mm-uu-dissect)))))
(when handles
(gnus-summary-save-parts-1 type dir handles reverse)
(unless gnus-article-mime-handles ;; Don't destroy this case.
@@ -9379,13 +11016,17 @@ If REVERSE, save parts that do not match TYPE."
(not (string-match type (mm-handle-media-type handle)))
(string-match type (mm-handle-media-type handle)))
(let ((file (expand-file-name
- (file-name-nondirectory
- (or
- (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (concat gnus-newsgroup-name
- "." (number-to-string
- (cdr gnus-article-current)))))
+ (gnus-map-function
+ mm-file-name-rewrite-functions
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)
+ (concat gnus-newsgroup-name
+ "." (number-to-string
+ (cdr gnus-article-current))))))
dir)))
(unless (file-exists-p file)
(mm-save-part-to-file handle file))))))
@@ -9452,7 +11093,9 @@ If REVERSE, save parts that do not match TYPE."
(gnus-data-enter
after-article gnus-reffed-article-number
gnus-unread-mark b (car pslist) 0 (- e b))
- (push gnus-reffed-article-number gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unreads
+ (gnus-add-to-sorted-list gnus-newsgroup-unreads
+ gnus-reffed-article-number))
(setq gnus-reffed-article-number (1- gnus-reffed-article-number))
(setq pslist (cdr pslist)))))))
@@ -9518,14 +11161,6 @@ If REVERSE, save parts that do not match TYPE."
(not (gnus-summary-article-sparse-p (mail-header-number header))))
;; We have found the header.
header
- ;; If this is a sparse article, we have to nix out its
- ;; previous entry in the thread hashtb.
- (when (and header
- (gnus-summary-article-sparse-p (mail-header-number header)))
- (let* ((parent (gnus-parent-id (mail-header-references header)))
- (thread (and parent (gnus-id-to-thread parent))))
- (when thread
- (delq (assq header thread) thread))))
;; We have to really fetch the header to this article.
(save-excursion
(set-buffer nntp-server-buffer)
@@ -9583,8 +11218,8 @@ If REVERSE, save parts that do not match TYPE."
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (progn (beginning-of-line) (point)))
- (end (progn (end-of-line) (point)))
+ (let* ((beg (gnus-point-at-bol))
+ (end (gnus-point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
@@ -9611,41 +11246,55 @@ If REVERSE, save parts that do not match TYPE."
(setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
'face gnus-summary-selected-face))))))
-;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
+(defvar gnus-summary-highlight-line-cached nil)
+(defvar gnus-summary-highlight-line-trigger nil)
+
+(defun gnus-summary-highlight-line-0 ()
+ (if (and (eq gnus-summary-highlight-line-trigger
+ gnus-summary-highlight)
+ gnus-summary-highlight-line-cached)
+ gnus-summary-highlight-line-cached
+ (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
+ gnus-summary-highlight-line-cached
+ (let* ((cond (list 'cond))
+ (c cond)
+ (list gnus-summary-highlight))
+ (while list
+ (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
+ nil))
+ (setq c (cdr c)
+ list (cdr list)))
+ (gnus-byte-compile (list 'lambda nil cond))))))
+
(defun gnus-summary-highlight-line ()
"Highlight current line according to `gnus-summary-highlight'."
- (let* ((list gnus-summary-highlight)
- (p (point))
- (end (progn (end-of-line) (point)))
- ;; now find out where the line starts and leave point there.
- (beg (progn (beginning-of-line) (point)))
- (article (gnus-summary-article-number))
- (score (or (cdr (assq (or article gnus-current-article)
+ (let* ((beg (gnus-point-at-bol))
+ (article (or (gnus-summary-article-number) gnus-current-article))
+ (score (or (cdr (assq article
gnus-newsgroup-scored))
gnus-summary-default-score 0))
(mark (or (gnus-summary-article-mark) gnus-unread-mark))
- (inhibit-read-only t))
- ;; Eval the cars of the lists until we find a match.
- (let ((default gnus-summary-default-score))
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list))))
- (let ((face (cdar list)))
+ (inhibit-read-only t)
+ (default gnus-summary-default-score)
+ (default-high gnus-summary-default-high-score)
+ (default-low gnus-summary-default-low-score)
+ (uncached (and gnus-summary-use-undownloaded-faces
+ (memq article gnus-newsgroup-undownloaded))))
+ (let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
- beg end 'face
+ beg (gnus-point-at-eol) 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
- (funcall gnus-summary-highlight-line-function article face))))
- (goto-char p)))
+ (funcall gnus-summary-highlight-line-function article face))))))
(defun gnus-update-read-articles (group unread &optional compute)
- "Update the list of read articles in GROUP."
+ "Update the list of read articles in GROUP.
+UNREAD is a sorted list."
(let* ((active (or gnus-newsgroup-active (gnus-active group)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
(prev 1)
- (unread (sort (copy-sequence unread) '<))
read)
(if (or (not info) (not active))
;; There is no info on this group if it was, in fact,
@@ -9709,25 +11358,24 @@ If REVERSE, save parts that do not match TYPE."
(defun gnus-offer-save-summaries ()
"Offer to save all active summary buffers."
- (save-excursion
- (let ((buflist (buffer-list))
- buffers bufname)
- ;; Go through all buffers and find all summaries.
- (while buflist
- (and (setq bufname (buffer-name (car buflist)))
- (string-match "Summary" bufname)
- (save-excursion
- (set-buffer bufname)
- ;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
- ;; Also make sure this isn't bogus.
- gnus-newsgroup-prepared
- ;; Also make sure that this isn't a dead summary buffer.
- (not gnus-dead-summary-mode)))
- (push bufname buffers))
- (setq buflist (cdr buflist)))
- ;; Go through all these summary buffers and offer to save them.
- (when buffers
+ (let (buffers)
+ ;; Go through all buffers and find all summaries.
+ (dolist (buffer (buffer-list))
+ (when (and (setq buffer (buffer-name buffer))
+ (string-match "Summary" buffer)
+ (save-excursion
+ (set-buffer buffer)
+ ;; We check that this is, indeed, a summary buffer.
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared
+ ;; Also make sure that this isn't a
+ ;; dead summary buffer.
+ (not gnus-dead-summary-mode))))
+ (push buffer buffers)))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (save-excursion
(map-y-or-n-p
"Update summary buffer %s? "
(lambda (buf)
@@ -9737,37 +11385,18 @@ If REVERSE, save parts that do not match TYPE."
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
- (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
(setq gnus-newsgroup-charset nil)
- (let* ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name)))
- (ignored-charsets
+ (let* ((ignored-charsets
(or gnus-newsgroup-ephemeral-ignored-charsets
(append
(and gnus-newsgroup-name
- (or (gnus-group-find-parameter gnus-newsgroup-name
- 'ignored-charsets t)
- (let ((alist gnus-group-ignored-charsets-alist)
- elem (charsets nil))
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- charsets (cdr elem))))
- charsets)))
+ (gnus-parameter-ignored-charsets gnus-newsgroup-name))
gnus-newsgroup-ignored-charsets))))
(setq gnus-newsgroup-charset
(or gnus-newsgroup-ephemeral-charset
(and gnus-newsgroup-name
- (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
- (let ((alist gnus-group-charset-alist)
- elem charset)
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- charset (cadr elem))))
- charset)))
+ (gnus-parameter-charset gnus-newsgroup-name))
gnus-default-charset))
(set (make-local-variable 'gnus-newsgroup-ignored-charsets)
ignored-charsets))))
@@ -9791,17 +11420,17 @@ treated as multipart/mixed."
(interactive (list (gnus-summary-article-number)))
(gnus-with-article article
(message-narrow-to-head)
+ (message-remove-header "Mime-Version")
(goto-char (point-max))
+ (insert "Mime-Version: 1.0\n")
(widen)
(when (search-forward "\n--" nil t)
(let ((separator (buffer-substring (point) (gnus-point-at-eol))))
(message-narrow-to-head)
- (message-remove-header "Mime-Version")
(message-remove-header "Content-Type")
(goto-char (point-max))
(insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
separator))
- (insert "Mime-Version: 1.0\n")
(widen))))
(let (gnus-mark-article-hook)
(gnus-summary-select-article t t nil article)))
@@ -9892,6 +11521,137 @@ returned."
(gnus-set-mode-line 'summary)
n))
+(defun gnus-summary-insert-articles (articles)
+ (when (setq articles
+ (gnus-sorted-difference articles
+ (mapcar (lambda (h)
+ (mail-header-number h))
+ gnus-newsgroup-headers)))
+ (setq gnus-newsgroup-headers
+ (gnus-merge 'list
+ gnus-newsgroup-headers
+ (gnus-fetch-headers articles)
+ 'gnus-article-sort-by-number))
+ ;; Suppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-suppress-articles))
+
+ ;; We might want to build some more threads first.
+ (when (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads)))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
+ ;; Remove list identifiers from subject
+ (when gnus-list-identifiers
+ (gnus-summary-remove-list-identifiers))
+ ;; First and last article in this newsgroup.
+ (when gnus-newsgroup-headers
+ (setq gnus-newsgroup-begin
+ (mail-header-number (car gnus-newsgroup-headers))
+ gnus-newsgroup-end
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
+ (when gnus-use-scoring
+ (gnus-possibly-score-headers))))
+
+(defun gnus-summary-insert-old-articles (&optional all)
+ "Insert all old articles in this group.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles."
+ (interactive "P")
+ (prog1
+ (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
+ older len)
+ (setq older
+ ;; Some nntp servers lie about their active range. When
+ ;; this happens, the active range can be in the millions.
+ ;; Use a compressed range to avoid creating a huge list.
+ (gnus-range-difference (list gnus-newsgroup-active) old))
+ (setq len (gnus-range-length older))
+ (cond
+ ((null older) nil)
+ ((numberp all)
+ (if (< all len)
+ (let ((older-range (nreverse older)))
+ (setq older nil)
+
+ (while (> all 0)
+ (let* ((r (pop older-range))
+ (min (if (numberp r) r (car r)))
+ (max (if (numberp r) r (cdr r))))
+ (while (and (<= min max)
+ (> all 0))
+ (push max older)
+ (setq all (1- all)
+ max (1- max))))))
+ (setq older (gnus-uncompress-range older))))
+ (all
+ (setq older (gnus-uncompress-range older)))
+ (t
+ (when (and (numberp gnus-large-newsgroup)
+ (> len gnus-large-newsgroup))
+ (let* ((cursor-in-echo-area nil)
+ (initial (gnus-parameter-large-newsgroup-initial
+ gnus-newsgroup-name))
+ (input
+ (read-string
+ (format
+ "How many articles from %s (%s %d): "
+ (gnus-limit-string
+ (gnus-group-decoded-name gnus-newsgroup-name) 35)
+ (if initial "max" "default")
+ len)
+ (if initial
+ (cons (number-to-string initial)
+ 0)))))
+ (unless (string-match "^[ \t]*$" input)
+ (setq all (string-to-number input))
+ (if (< all len)
+ (let ((older-range (nreverse older)))
+ (setq older nil)
+
+ (while (> all 0)
+ (let* ((r (pop older-range))
+ (min (if (numberp r) r (car r)))
+ (max (if (numberp r) r (cdr r))))
+ (while (and (<= min max)
+ (> all 0))
+ (push max older)
+ (setq all (1- all)
+ max (1- max))))))))))
+ (setq older (gnus-uncompress-range older))))
+ (if (not older)
+ (message "No old news.")
+ (gnus-summary-insert-articles older)
+ (gnus-summary-limit (gnus-sorted-nunion old older))))
+ (gnus-summary-position-point)))
+
+(defun gnus-summary-insert-new-articles ()
+ "Insert all new articles in this group."
+ (interactive)
+ (prog1
+ (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
+ (old-active gnus-newsgroup-active)
+ (nnmail-fetched-sources (list t))
+ i new)
+ (setq gnus-newsgroup-active
+ (gnus-activate-group gnus-newsgroup-name 'scan))
+ (setq i (cdr gnus-newsgroup-active))
+ (while (> i (cdr old-active))
+ (push i new)
+ (decf i))
+ (if (not new)
+ (message "No gnus is bad news.")
+ (gnus-summary-insert-articles new)
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion gnus-newsgroup-unreads new))
+ (gnus-summary-limit (gnus-sorted-nunion old new))))
+ (gnus-summary-position-point)))
+
(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
@@ -9900,5 +11660,9 @@ returned."
(run-hooks 'gnus-sum-load-hook)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index ce5c381f72c..548bfa92c2c 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1,5 +1,5 @@
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
@@ -46,6 +46,9 @@
:type 'hook
:group 'gnus-topic)
+(when (featurep 'xemacs)
+ (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add))
+
(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
"Format of topic lines.
It works along the same lines as a normal formatting string,
@@ -57,7 +60,10 @@ with some simple extensions.
%g Number of groups in the topic.
%a Number of unread articles in the groups in the topic.
%A Number of unread articles in the groups in the topic and its subtopics.
-"
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:type 'string
:group 'gnus-topic)
@@ -161,6 +167,7 @@ with some simple extensions.
(mapcar 'list (gnus-topic-list))
nil t)))
(dolist (topic (gnus-current-topics topic))
+ (gnus-topic-goto-topic topic)
(gnus-topic-fold t))
(gnus-topic-goto-topic topic))
@@ -196,7 +203,7 @@ If TOPIC, start with that topic."
"Return entries for all visible groups in TOPIC.
If RECURSIVE is t, return groups in its subtopics too."
(let ((groups (cdr (assoc topic gnus-topic-alist)))
- info clevel unread group params visible-groups entry active)
+ info clevel unread group params visible-groups entry active)
(setq lowest (or lowest 1))
(setq level (or level gnus-level-unsubscribed))
;; We go through the newsrc to look for matches.
@@ -245,6 +252,28 @@ If RECURSIVE is t, return groups in its subtopics too."
(cdr recursive)))
visible-groups))
+(defun gnus-topic-goto-previous-topic (n)
+ "Go to the N'th previous topic."
+ (interactive "p")
+ (gnus-topic-goto-next-topic (- n)))
+
+(defun gnus-topic-goto-next-topic (n)
+ "Go to the N'th next topic."
+ (interactive "p")
+ (let ((backward (< n 0))
+ (n (abs n))
+ (topic (gnus-current-topic)))
+ (while (and (> n 0)
+ (setq topic
+ (if backward
+ (gnus-topic-previous-topic topic)
+ (gnus-topic-next-topic topic))))
+ (gnus-topic-goto-topic topic)
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more topics"))
+ n))
+
(defun gnus-topic-previous-topic (topic)
"Return the previous topic on the same level as TOPIC."
(let ((top (cddr (gnus-topic-find-topology
@@ -351,9 +380,17 @@ If RECURSIVE is t, return groups in its subtopics too."
"Compute the group parameters for GROUP taking into account inheritance from topics."
(let ((params-list (copy-sequence (gnus-group-get-parameter group))))
(save-excursion
- (gnus-group-goto-group group)
(nconc params-list
- (gnus-topic-hierarchical-parameters (gnus-current-topic))))))
+ (gnus-topic-hierarchical-parameters
+ ;; First we try to go to the group within the group
+ ;; buffer and find the topic for the group that way.
+ ;; This hopefully copes well with groups that are in
+ ;; more than one topic. Failing that (i.e. when the
+ ;; group isn't visible in the group buffer) we find a
+ ;; topic for the group via gnus-group-topic.
+ (or (and (gnus-group-goto-group group)
+ (gnus-current-topic))
+ (gnus-group-topic group)))))))
(defun gnus-topic-hierarchical-parameters (topic)
"Return a topic list computed for TOPIC."
@@ -384,16 +421,22 @@ If RECURSIVE is t, return groups in its subtopics too."
;;; Generating group buffers
-(defun gnus-group-prepare-topics (level &optional all lowest
+(defun gnus-group-prepare-topics (level &optional predicate lowest
regexp list-topic topic-level)
"List all newsgroups with unread articles of level LEVEL or lower.
Use the `gnus-group-topics' to sort the groups.
-If ALL is non-nil, list groups that have no unread articles.
+If PREDICTE is a function, list groups that the function returns non-nil;
+if it is t, list groups that have no unread articles.
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
(set-buffer gnus-group-buffer)
(let ((buffer-read-only nil)
- (lowest (or lowest 1)))
+ (lowest (or lowest 1))
+ (not-in-list
+ (and gnus-group-listed-groups
+ (copy-sequence gnus-group-listed-groups))))
+ (gnus-update-format-specifications nil 'topic)
+
(when (or (not gnus-topic-alist)
(not gnus-topology-checked-p))
(gnus-topic-check-topology))
@@ -402,48 +445,63 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
(erase-buffer))
;; List dead groups?
- (when (and (>= level gnus-level-zombie)
- (<= lowest gnus-level-zombie))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-zombie)
+ (<= lowest gnus-level-zombie)))
(gnus-group-prepare-flat-list-dead
(setq gnus-zombie-list (sort gnus-zombie-list 'string<))
gnus-level-zombie ?Z
regexp))
- (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
+ (when (or gnus-group-listed-groups
+ (and (>= level gnus-level-killed)
+ (<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
(setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K
- regexp))
+ gnus-level-killed ?K regexp)
+ (when not-in-list
+ (unless gnus-killed-hashtb
+ (gnus-make-hashtable-from-killed))
+ (gnus-group-prepare-flat-list-dead
+ (gnus-remove-if (lambda (group)
+ (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash group gnus-killed-hashtb)))
+ not-in-list)
+ gnus-level-killed ?K regexp)))
;; Use topics.
(prog1
- (when (< lowest gnus-level-zombie)
+ (when (or (< lowest gnus-level-zombie)
+ gnus-group-listed-groups)
(if list-topic
(let ((top (gnus-topic-find-topology list-topic)))
(gnus-topic-prepare-topic (cdr top) (car top)
- (or topic-level level) all
- nil lowest))
+ (or topic-level level) predicate
+ nil lowest regexp))
(gnus-topic-prepare-topic gnus-topic-topology 0
- (or topic-level level) all
- nil lowest)))
-
+ (or topic-level level) predicate
+ nil lowest regexp)))
(gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level all))
+ (setq gnus-group-list-mode (cons level predicate))
(gnus-run-hooks 'gnus-group-prepare-hook))))
-(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent
- lowest)
+(defun gnus-topic-prepare-topic (topicl level &optional list-level
+ predicate silent
+ lowest regexp)
"Insert TOPIC into the group buffer.
If SILENT, don't insert anything. Return the number of unread
articles in the topic and its subtopics."
(let* ((type (pop topicl))
(entries (gnus-topic-find-groups
- (car type) list-level
- (or all
+ (car type)
+ (if gnus-group-listed-groups
+ gnus-level-killed
+ list-level)
+ (or predicate gnus-group-listed-groups
(cdr (assq 'visible
(gnus-topic-hierarchical-parameters
(car type)))))
- lowest))
+ (if gnus-group-listed-groups 0 lowest)))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
(gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
@@ -458,32 +516,61 @@ articles in the topic and its subtopics."
(while topicl
(incf unread
(gnus-topic-prepare-topic
- (pop topicl) (1+ level) list-level all
- (not visiblep) lowest)))
+ (pop topicl) (1+ level) list-level predicate
+ (not visiblep) lowest regexp)))
(setq end (point))
(goto-char beg)
;; Insert all the groups that belong in this topic.
(while (setq entry (pop entries))
- (when visiblep
- (if (stringp entry)
- ;; Dead groups.
- (gnus-group-insert-group-line
- entry (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)
- nil (- (1+ (cdr (setq active (gnus-active entry))))
- (car active))
- nil)
- ;; Living groups.
- (when (setq info (nth 2 entry))
- (gnus-group-insert-group-line
- (gnus-info-group info)
- (gnus-info-level info) (gnus-info-marks info)
- (car entry) (gnus-info-method info)))))
- (when (and (listp entry)
- (numberp (car entry)))
- (incf unread (car entry)))
- (when (listp entry)
- (setq tick t)))
+ (when (if (stringp entry)
+ (gnus-group-prepare-logic
+ entry
+ (and
+ (or (not gnus-group-listed-groups)
+ (if (< list-level gnus-level-zombie) nil
+ (let ((entry-level
+ (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)))
+ (and (<= entry-level list-level)
+ (>= entry-level lowest)))))
+ (cond
+ ((stringp regexp)
+ (string-match regexp entry))
+ ((functionp regexp)
+ (funcall regexp entry))
+ ((null regexp) t)
+ (t nil))))
+ (setq info (nth 2 entry))
+ (gnus-group-prepare-logic
+ (gnus-info-group info)
+ (and (or (not gnus-group-listed-groups)
+ (let ((entry-level (gnus-info-level info)))
+ (and (<= entry-level list-level)
+ (>= entry-level lowest))))
+ (or (not (functionp predicate))
+ (funcall predicate info))
+ (or (not (stringp regexp))
+ (string-match regexp (gnus-info-group info))))))
+ (when visiblep
+ (if (stringp entry)
+ ;; Dead groups.
+ (gnus-group-insert-group-line
+ entry (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)
+ nil (- (1+ (cdr (setq active (gnus-active entry))))
+ (car active))
+ nil)
+ ;; Living groups.
+ (when (setq info (nth 2 entry))
+ (gnus-group-insert-group-line
+ (gnus-info-group info)
+ (gnus-info-level info) (gnus-info-marks info)
+ (car entry) (gnus-info-method info)))))
+ (when (and (listp entry)
+ (numberp (car entry)))
+ (incf unread (car entry)))
+ (when (listp entry)
+ (setq tick t))))
(goto-char beg)
;; Insert the topic line.
(when (and (not silent)
@@ -593,7 +680,7 @@ articles in the topic and its subtopics."
(when (and (eq major-mode 'gnus-group-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
- (m (point-marker))
+ (m (point-marker))
(buffer-read-only nil))
(when (and group
(gnus-get-info group)
@@ -611,7 +698,8 @@ articles in the topic and its subtopics."
(unfound t)
entry)
;; Try to jump to a visible group.
- (while (and g (not (gnus-group-goto-group (car g) t)))
+ (while (and g
+ (not (gnus-group-goto-group (car g) t)))
(pop g))
;; It wasn't visible, so we try to see where to insert it.
(when (not g)
@@ -623,20 +711,31 @@ articles in the topic and its subtopics."
(when (and unfound
topic
(not (gnus-topic-goto-missing-topic topic)))
- (let* ((top (gnus-topic-find-topology topic))
- (children (cddr top))
- (type (cadr top))
- (unread 0)
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode))))
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry))))
- (gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil unread))))))
+ (gnus-topic-display-missing-topic topic)))))
+
+(defun gnus-topic-display-missing-topic (topic)
+ "Insert topic lines recursively for missing topics."
+ (let ((parent (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))
+ (when (and parent
+ (not (gnus-topic-goto-missing-topic (caadr parent))))
+ (gnus-topic-display-missing-topic (caadr parent))))
+ (gnus-topic-goto-missing-topic topic)
+ (let* ((top (gnus-topic-find-topology topic))
+ (children (cddr top))
+ (type (cadr top))
+ (unread 0)
+ (entries (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode)))
+ entry)
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry))))
+ (gnus-topic-insert-topic-line
+ topic t t (car (gnus-topic-find-topology topic)) nil unread)))
(defun gnus-topic-goto-missing-topic (topic)
(if (gnus-topic-goto-topic topic)
@@ -830,8 +929,8 @@ articles in the topic and its subtopics."
? ))
(yanked (list group))
alist talist end)
- ;; Then we enter the yanked groups into the topics they belong
- ;; to.
+ ;; Then we enter the yanked groups into the topics
+ ;; they belong to.
(when (setq alist (assoc (save-excursion
(forward-line -1)
(or
@@ -949,6 +1048,7 @@ articles in the topic and its subtopics."
"\r" gnus-topic-select-group
" " gnus-topic-read-group
"\C-c\C-x" gnus-topic-expire-articles
+ "c" gnus-topic-catchup-articles
"\C-k" gnus-topic-kill-group
"\C-y" gnus-topic-yank-group
"\M-g" gnus-topic-get-new-news-this-topic
@@ -975,6 +1075,8 @@ articles in the topic and its subtopics."
"j" gnus-topic-jump-to-topic
"M" gnus-topic-move-matching
"C" gnus-topic-copy-matching
+ "\M-p" gnus-topic-goto-previous-topic
+ "\M-n" gnus-topic-goto-next-topic
"\C-i" gnus-topic-indent
[tab] gnus-topic-indent
"r" gnus-topic-rename
@@ -987,6 +1089,7 @@ articles in the topic and its subtopics."
"a" gnus-topic-sort-groups-by-alphabet
"u" gnus-topic-sort-groups-by-unread
"l" gnus-topic-sort-groups-by-level
+ "e" gnus-topic-sort-groups-by-server
"v" gnus-topic-sort-groups-by-score
"r" gnus-topic-sort-groups-by-rank
"m" gnus-topic-sort-groups-by-method))
@@ -998,21 +1101,23 @@ articles in the topic and its subtopics."
'("Topics"
["Toggle topics" gnus-topic-mode t]
("Groups"
- ["Copy" gnus-topic-copy-group t]
- ["Move" gnus-topic-move-group t]
+ ["Copy..." gnus-topic-copy-group t]
+ ["Move..." gnus-topic-move-group t]
["Remove" gnus-topic-remove-group t]
- ["Copy matching" gnus-topic-copy-matching t]
- ["Move matching" gnus-topic-move-matching t])
+ ["Copy matching..." gnus-topic-copy-matching t]
+ ["Move matching..." gnus-topic-move-matching t])
("Topics"
- ["Goto" gnus-topic-jump-to-topic t]
+ ["Goto..." gnus-topic-jump-to-topic t]
["Show" gnus-topic-show-topic t]
["Hide" gnus-topic-hide-topic t]
["Delete" gnus-topic-delete t]
- ["Rename" gnus-topic-rename t]
- ["Create" gnus-topic-create-topic t]
+ ["Rename..." gnus-topic-rename t]
+ ["Create..." gnus-topic-create-topic t]
["Mark" gnus-topic-mark-topic t]
["Indent" gnus-topic-indent t]
["Sort" gnus-topic-sort-topics t]
+ ["Previous topic" gnus-topic-goto-previous-topic t]
+ ["Next topic" gnus-topic-goto-next-topic t]
["Toggle hide empty" gnus-topic-toggle-display-empty-topics t]
["Edit parameters" gnus-topic-edit-parameters t])
["List active" gnus-topic-list-active t]))))
@@ -1027,7 +1132,7 @@ articles in the topic and its subtopics."
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
(if (not gnus-topic-mode)
- (setq gnus-goto-missing-group-function nil)
+ (setq gnus-goto-missing-group-function nil)
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
@@ -1050,8 +1155,9 @@ articles in the topic and its subtopics."
'gnus-group-sort-topic)
(setq gnus-group-change-level-function 'gnus-topic-change-level)
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
- (make-local-hook 'gnus-check-bogus-groups-hook)
- (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
+ (gnus-make-local-hook 'gnus-check-bogus-groups-hook)
+ (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist
+ nil 'local)
(setq gnus-topology-checked-p nil)
;; We check the topology.
(when gnus-newsrc-alist
@@ -1070,11 +1176,14 @@ articles in the topic and its subtopics."
(defun gnus-topic-select-group (&optional all)
"Select this newsgroup.
No article is selected automatically.
+If the group is opened, just switch the summary buffer.
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles.
If performed over a topic line, toggle folding the topic."
(interactive "P")
+ (when (and (eobp) (not (gnus-group-group-name)))
+ (forward-line -1))
(if (gnus-group-topic-p)
(let ((gnus-group-list-mode
(if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
@@ -1097,10 +1206,27 @@ If performed over a topic line, toggle folding the topic."
(gnus-message 5 "Expiring groups in %s..." topic)
(let ((gnus-group-marked
(mapcar (lambda (entry) (car (nth 2 entry)))
- (gnus-topic-find-groups topic gnus-level-killed t))))
+ (gnus-topic-find-groups topic gnus-level-killed t
+ nil t))))
(gnus-group-expire-articles nil))
(gnus-message 5 "Expiring groups in %s...done" topic))))
+(defun gnus-topic-catchup-articles (topic)
+ "Catchup this topic or group.
+Also see `gnus-group-catchup'."
+ (interactive (list (gnus-group-topic-name)))
+ (if (not topic)
+ (call-interactively 'gnus-group-catchup-current)
+ (save-excursion
+ (let* ((groups
+ (mapcar (lambda (entry) (car (nth 2 entry)))
+ (gnus-topic-find-groups topic gnus-level-killed t
+ nil t)))
+ (buffer-read-only nil)
+ (gnus-group-marked groups))
+ (gnus-group-catchup-current)
+ (mapcar 'gnus-topic-update-topics-containing-group groups)))))
+
(defun gnus-topic-read-group (&optional all no-article group)
"Read news in this newsgroup.
If the prefix argument ALL is non-nil, already read articles become
@@ -1157,7 +1283,8 @@ When used interactively, PARENT will be the topic under point."
If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
- (completing-read "Move to topic: " gnus-topic-alist nil t)))
+ (gnus-completing-read "Move to topic" gnus-topic-alist nil t
+ 'gnus-topic-history)))
(let ((use-marked (and (not n) (not (gnus-region-active-p))
gnus-group-marked t))
(groups (gnus-group-process-prefix n))
@@ -1303,9 +1430,9 @@ If PERMANENT, make it stay shown in subsequent sessions as well."
(setcar (cdr (cadr topic)) 'visible)
(gnus-group-list-groups)))))
-(defun gnus-topic-mark-topic (topic &optional unmark recursive)
+(defun gnus-topic-mark-topic (topic &optional unmark non-recursive)
"Mark all groups in the TOPIC with the process mark.
-If RECURSIVE is t, mark its subtopics too."
+If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics."
(interactive (list (gnus-group-topic-name)
nil
(and current-prefix-arg t)))
@@ -1313,28 +1440,32 @@ If RECURSIVE is t, mark its subtopics too."
(call-interactively 'gnus-group-mark-group)
(save-excursion
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil
- recursive)))
+ (not non-recursive))))
(while groups
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
(gnus-info-group (nth 2 (pop groups)))))))))
-(defun gnus-topic-unmark-topic (topic &optional dummy recursive)
+(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive)
"Remove the process mark from all groups in the TOPIC.
-If RECURSIVE is t, unmark its subtopics too."
+If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(interactive (list (gnus-group-topic-name)
nil
(and current-prefix-arg t)))
(if (not topic)
(call-interactively 'gnus-group-unmark-group)
- (gnus-topic-mark-topic topic t recursive)))
+ (gnus-topic-mark-topic topic t non-recursive)))
(defun gnus-topic-get-new-news-this-topic (&optional n)
"Check for new news in the current topic."
(interactive "P")
(if (not (gnus-group-topic-p))
(gnus-group-get-new-news-this-group n)
- (gnus-topic-mark-topic (gnus-group-topic-name) nil (and n t))
- (gnus-group-get-new-news-this-group)))
+ (let* ((topic (gnus-group-topic-name))
+ (data (cadr (gnus-topic-find-topology topic))))
+ (save-excursion
+ (gnus-topic-mark-topic topic nil (and n t))
+ (gnus-group-get-new-news-this-group))
+ (gnus-topic-remove-topic (eq 'visible (cadr data))))))
(defun gnus-topic-move-matching (regexp topic &optional copyp)
"Move all groups that match REGEXP to some topic."
@@ -1380,7 +1511,7 @@ If RECURSIVE is t, unmark its subtopics too."
(interactive
(let ((topic (gnus-current-topic)))
(list topic
- (read-string (format "Rename %s to: " topic)))))
+ (read-string (format "Rename %s to: " topic) topic))))
;; Check whether the new name exists.
(when (gnus-topic-find-topology new-name)
(error "Topic '%s' already exists" new-name))
@@ -1552,14 +1683,21 @@ If REVERSE, sort in reverse order."
(interactive "P")
(gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
+(defun gnus-topic-sort-groups-by-server (&optional reverse)
+ "Sort the current topic alphabetically by server name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse))
+
(defun gnus-topic-sort-topics-1 (top reverse)
(if (cdr top)
(let ((subtop
- (mapcar `(lambda (top)
- (gnus-topic-sort-topics-1 top ,reverse))
+ (mapcar (gnus-byte-compile
+ `(lambda (top)
+ (gnus-topic-sort-topics-1 top ,reverse)))
(sort (cdr top)
- '(lambda (t1 t2)
- (string-lessp (caar t1) (caar t2)))))))
+ (lambda (t1 t2)
+ (string-lessp (caar t1) (caar t2)))))))
(setcdr top (if reverse (reverse subtop) subtop))))
top)
@@ -1612,7 +1750,14 @@ If REVERSE, reverse the sorting order."
(gnus-subscribe-alphabetically newsgroup)
;; Add the group to the topic.
(nconc (assoc topic gnus-topic-alist) (list newsgroup))
- (throw 'end t))))))
+ ;; if this topic specifies a default level, use it
+ (let ((subscribe-level (cdr (assq 'subscribe-level
+ (gnus-topic-parameters topic)))))
+ (when subscribe-level
+ (gnus-group-change-level newsgroup subscribe-level
+ gnus-level-default-subscribed)))
+ (throw 'end t)))
+ nil)))
(provide 'gnus-topic)
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index e812e032f46..fcb3616330d 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -1,6 +1,6 @@
;;; gnus-undo.el --- minor mode for undoing in Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -114,7 +114,7 @@
(when (gnus-visual-p 'undo-menu 'menu)
(gnus-undo-make-menu-bar))
(gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
- (make-local-hook 'post-command-hook)
+ (gnus-make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'gnus-undo-boundary nil t)
(gnus-run-hooks 'gnus-undo-mode-hook)))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index ca46e52fc30..472f02afa55 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1,5 +1,5 @@
;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -29,6 +29,9 @@
;; used by Gnus and may be used by any other package without loading
;; Gnus first.
+;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
+;; autoloads below...]
+
;;; Code:
(require 'custom)
@@ -36,14 +39,38 @@
(require 'cl)
;; Fixme: this should be a gnus variable, not nnmail-.
(defvar nnmail-pathname-coding-system))
-(require 'nnheader)
(require 'time-date)
+(require 'netrc)
(eval-and-compile
(autoload 'message-fetch-field "message")
+ (autoload 'gnus-get-buffer-window "gnus-win")
(autoload 'rmail-insert-rmail-file-header "rmail")
(autoload 'rmail-count-new-messages "rmail")
- (autoload 'rmail-show-message "rmail"))
+ (autoload 'rmail-show-message "rmail")
+ (autoload 'nnheader-narrow-to-headers "nnheader")
+ (autoload 'nnheader-replace-chars-in-string "nnheader"))
+
+(eval-and-compile
+ (cond
+ ((fboundp 'replace-in-string)
+ (defalias 'gnus-replace-in-string 'replace-in-string))
+ ((fboundp 'replace-regexp-in-string)
+ (defun gnus-replace-in-string (string regexp newtext &optional literal)
+ (replace-regexp-in-string regexp newtext string nil literal)))
+ (t
+ (defun gnus-replace-in-string (string regexp newtext &optional literal)
+ (let ((start 0) tail)
+ (while (string-match regexp string start)
+ (setq tail (- (length string) (match-end 0)))
+ (setq string (replace-match newtext nil literal string))
+ (setq start (- (length string) tail))))
+ string))))
+
+;;; bring in the netrc functions as aliases
+(defalias 'gnus-netrc-get 'netrc-get)
+(defalias 'gnus-netrc-machine 'netrc-machine)
+(defalias 'gnus-parse-netrc 'netrc-parse)
(defun gnus-boundp (variable)
"Return non-nil if VARIABLE is bound and non-nil."
@@ -53,20 +80,20 @@
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
(let ((tempvar (make-symbol "GnusStartBufferWindow"))
- (w (make-symbol "w"))
- (buf (make-symbol "buf")))
+ (w (make-symbol "w"))
+ (buf (make-symbol "buf")))
`(let* ((,tempvar (selected-window))
- (,buf ,buffer)
- (,w (get-buffer-window ,buf 'visible)))
+ (,buf ,buffer)
+ (,w (gnus-get-buffer-window ,buf 'visible)))
(unwind-protect
- (progn
- (if ,w
- (progn
- (select-window ,w)
- (set-buffer (window-buffer ,w)))
- (pop-to-buffer ,buf))
- ,@forms)
- (select-window ,tempvar)))))
+ (progn
+ (if ,w
+ (progn
+ (select-window ,w)
+ (set-buffer (window-buffer ,w)))
+ (pop-to-buffer ,buf))
+ ,@forms)
+ (select-window ,tempvar)))))
(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
@@ -81,17 +108,12 @@
;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
;; to limit the length of a string. This function is necessary since
;; `(substr "abc" 0 30)' pukes with "Args out of range".
+;; Fixme: Why not `truncate-string-to-width'?
(defsubst gnus-limit-string (str width)
(if (> (length str) width)
(substring str 0 width)
str))
-(defsubst gnus-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))
- (byte-code-function-p form)))
-
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
@@ -101,11 +123,6 @@
(funcall (if (stringp buffer) 'get-buffer 'buffer-name)
buffer))))
-(defmacro gnus-kill-buffer (buffer)
- `(let ((buf ,buffer))
- (when (gnus-buffer-exists-p buf)
- (kill-buffer buf))))
-
(defalias 'gnus-point-at-bol
(if (fboundp 'point-at-bol)
'point-at-bol
@@ -116,6 +133,16 @@
'point-at-eol
'line-end-position))
+;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
+;; XEmacs. In Emacs we don't need to call `make-local-hook' first.
+;; It's harmless, though, so the main purpose of this alias is to shut
+;; up the byte compiler.
+(defalias 'gnus-make-local-hook
+ (if (eq (get 'make-local-hook 'byte-compile)
+ 'byte-compile-obsolete)
+ 'ignore ; Emacs
+ 'make-local-hook)) ; XEmacs
+
(defun gnus-delete-first (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
(if (equal (car list) elt)
@@ -130,7 +157,7 @@
;; Delete the current line (and the next N lines).
(defmacro gnus-delete-line (&optional n)
- `(delete-region (progn (beginning-of-line) (point))
+ `(delete-region (gnus-point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
(defun gnus-byte-code (func)
@@ -143,6 +170,11 @@
(cons 'progn (cddr fval)))))
(defun gnus-extract-address-components (from)
+ "Extract address components from a From header.
+Given an RFC-822 address FROM, extract full name and canonical address.
+Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple
+solution than `mail-extract-address-components', which works much better, but
+is slower."
(let (name address)
;; First find the address - the thing with the @ in it. This may
;; not be accurate in mail addresses, but does the trick most of
@@ -155,7 +187,7 @@
(string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
(and (setq name (substring from 0 (match-beginning 0)))
;; Strip any quotes from the name.
- (string-match "\".*\"" name)
+ (string-match "^\".*\"$" name)
(setq name (substring name 1 (1- (match-end 0))))))
;; If not, then "address (name)" is used.
(or name
@@ -180,9 +212,26 @@
(nnheader-narrow-to-headers)
(message-fetch-field field)))))
+(defun gnus-fetch-original-field (field)
+ "Fetch FIELD from the original version of the current article."
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field field)))
+
+
(defun gnus-goto-colon ()
(beginning-of-line)
- (search-forward ":" (gnus-point-at-eol) t))
+ (let ((eol (gnus-point-at-eol)))
+ (goto-char (or (text-property-any (point) eol 'gnus-position t)
+ (search-forward ":" eol t)
+ (point)))))
+
+(defun gnus-decode-newsgroups (newsgroups group &optional method)
+ (let ((method (or method (gnus-find-method-for-group group))))
+ (mapconcat (lambda (group)
+ (gnus-group-name-decode group (gnus-group-name-charset
+ method group)))
+ (message-tokenize-header newsgroups)
+ ",")))
(defun gnus-remove-text-with-property (prop)
"Delete all text in the current buffer with text property PROP."
@@ -195,20 +244,14 @@
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
- (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
- (len (length newsgroup))
- idx)
- ;; If this is a foreign group, we don't want to translate the
- ;; entire name.
- (if (setq idx (string-match ":" newsgroup))
- (aset newsgroup idx ?/)
- (setq idx 0))
- ;; Replace all occurrences of `.' with `/'.
- (while (< idx len)
- (when (= (aref newsgroup idx) ?.)
- (aset newsgroup idx ?/))
- (setq idx (1+ idx)))
- newsgroup))
+ (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
+ (idx (string-match ":" newsgroup)))
+ (concat
+ (if idx (substring newsgroup 0 idx))
+ (if idx "/")
+ (nnheader-replace-chars-in-string
+ (if idx (substring newsgroup (1+ idx)) newsgroup)
+ ?. ?/))))
(defun gnus-newsgroup-savable-name (group)
;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
@@ -271,7 +314,7 @@
(define-key keymap key (pop plist))
(pop plist)))))
-(defun gnus-completing-read (default prompt &rest args)
+(defun gnus-completing-read-with-default (default prompt &rest args)
;; Like `completing-read', except that DEFAULT is the default argument.
(let* ((prompt (if default
(concat prompt " (default " default ") ")
@@ -293,6 +336,74 @@
(yes-or-no-p prompt)
(message "")))
+;; By Frank Schmitt <ich@Frank-Schmitt.net>. Allows to have
+;; age-depending date representations. (e.g. just the time if it's
+;; from today, the day of the week if it's within the last 7 days and
+;; the full date if it's older)
+
+(defun gnus-seconds-today ()
+ "Return the number of seconds passed today."
+ (let ((now (decode-time (current-time))))
+ (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
+
+(defun gnus-seconds-month ()
+ "Return the number of seconds passed this month."
+ (let ((now (decode-time (current-time))))
+ (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
+ (* (- (car (nthcdr 3 now)) 1) 3600 24))))
+
+(defun gnus-seconds-year ()
+ "Return the number of seconds passed this year."
+ (let ((now (decode-time (current-time)))
+ (days (format-time-string "%j" (current-time))))
+ (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
+ (* (- (string-to-number days) 1) 3600 24))))
+
+(defvar gnus-user-date-format-alist
+ '(((gnus-seconds-today) . "%k:%M")
+ (604800 . "%a %k:%M") ;;that's one week
+ ((gnus-seconds-month) . "%a %d")
+ ((gnus-seconds-year) . "%b %d")
+ (t . "%b %d '%y")) ;;this one is used when no
+ ;;other does match
+ "Specifies date format depending on age of article.
+This is an alist of items (AGE . FORMAT). AGE can be a number (of
+seconds) or a Lisp expression evaluating to a number. When the age of
+the article is less than this number, then use `format-time-string'
+with the corresponding FORMAT for displaying the date of the article.
+If AGE is not a number or a Lisp expression evaluating to a
+non-number, then the corresponding FORMAT is used as a default value.
+
+Note that the list is processed from the beginning, so it should be
+sorted by ascending AGE. Also note that items following the first
+non-number AGE will be ignored.
+
+You can use the functions `gnus-seconds-today', `gnus-seconds-month'
+and `gnus-seconds-year' in the AGE spec. They return the number of
+seconds passed since the start of today, of this month, of this year,
+respectively.")
+
+(defun gnus-user-date (messy-date)
+ "Format the messy-date according to gnus-user-date-format-alist.
+Returns \" ? \" if there's bad input or if an other error occurs.
+Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
+ (condition-case ()
+ (let* ((messy-date (time-to-seconds (safe-date-to-time messy-date)))
+ (now (time-to-seconds (current-time)))
+ ;;If we don't find something suitable we'll use this one
+ (my-format "%b %d '%y"))
+ (let* ((difference (- now messy-date))
+ (templist gnus-user-date-format-alist)
+ (top (eval (caar templist))))
+ (while (if (numberp top) (< top difference) (not top))
+ (progn
+ (setq templist (cdr templist))
+ (setq top (eval (caar templist)))))
+ (if (stringp (cdr (car templist)))
+ (setq my-format (cdr (car templist)))))
+ (format-time-string (eval my-format) (seconds-to-time messy-date)))
+ (error " ? ")))
+
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string."
(condition-case ()
@@ -325,13 +436,7 @@ Cache the result as a text property stored in DATE."
(defun gnus-mode-string-quote (string)
"Quote all \"%\"'s in STRING."
- (save-excursion
- (gnus-set-work-buffer)
- (insert string)
- (goto-char (point-min))
- (while (search-forward "%" nil t)
- (insert "%"))
- (buffer-string)))
+ (gnus-replace-in-string string "%" "%%"))
;; Make a hash table (default and minimum size is 256).
;; Optional argument HASHSIZE specifies the table size.
@@ -359,12 +464,13 @@ jabbering all the time."
:group 'gnus-start
:type 'integer)
-;; Show message if message has a lower level than `gnus-verbose'.
-;; Guideline for numbers:
-;; 1 - error messages, 3 - non-serious error messages, 5 - messages
-;; for things that take a long time, 7 - not very important messages
-;; on stuff, 9 - messages inside loops.
(defun gnus-message (level &rest args)
+ "If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
+
+Guideline for numbers:
+1 - error messages, 3 - non-serious error messages, 5 - messages for things
+that take a long time, 7 - not very important messages on stuff, 9 - messages
+inside loops."
(if (<= level gnus-verbose)
(apply 'message args)
;; We have to do this format thingy here even if the result isn't
@@ -387,7 +493,7 @@ jabbering all the time."
"Return a list of Message-IDs in REFERENCES."
(let ((beg 0)
ids)
- (while (string-match "<[^>]+>" references beg)
+ (while (string-match "<[^<]+[^< \t]" references beg)
(push (substring references (match-beginning 0) (setq beg (match-end 0)))
ids))
(nreverse ids)))
@@ -395,13 +501,17 @@ jabbering all the time."
(defsubst gnus-parent-id (references &optional n)
"Return the last Message-ID in REFERENCES.
If N, return the Nth ancestor instead."
- (when references
- (let ((ids (inline (gnus-split-references references))))
- (while (nthcdr (or n 1) ids)
- (setq ids (cdr ids)))
- (car ids))))
-
-(defsubst gnus-buffer-live-p (buffer)
+ (when (and references
+ (not (zerop (length references))))
+ (if n
+ (let ((ids (inline (gnus-split-references references))))
+ (while (nthcdr n ids)
+ (setq ids (cdr ids)))
+ (car ids))
+ (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references)
+ (match-string 1 references)))))
+
+(defun gnus-buffer-live-p (buffer)
"Say whether BUFFER is alive or not."
(and buffer
(get-buffer buffer)
@@ -410,9 +520,9 @@ If N, return the Nth ancestor instead."
(defun gnus-horizontal-recenter ()
"Recenter the current buffer horizontally."
(if (< (current-column) (/ (window-width) 2))
- (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
+ (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)
(let* ((orig (point))
- (end (window-end (get-buffer-window (current-buffer) t)))
+ (end (window-end (gnus-get-buffer-window (current-buffer) t)))
(max 0))
(when end
;; Find the longest line currently displayed in the window.
@@ -426,15 +536,15 @@ If N, return the Nth ancestor instead."
;; Scroll horizontally to center (sort of) the point.
(if (> max (window-width))
(set-window-hscroll
- (get-buffer-window (current-buffer) t)
+ (gnus-get-buffer-window (current-buffer) t)
(min (- (current-column) (/ (window-width) 3))
(+ 2 (- max (window-width)))))
- (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
+ (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0))
max))))
-(defun gnus-read-event-char ()
+(defun gnus-read-event-char (&optional prompt)
"Get the next event."
- (let ((event (read-event)))
+ (let ((event (read-event prompt)))
;; should be gnus-characterp, but this can't be called in XEmacs anyway
(cons (and (numberp event) event) event)))
@@ -474,23 +584,24 @@ If N, return the Nth ancestor instead."
gname)))
(defun gnus-make-sort-function (funs)
- "Return a composite sort condition based on the functions in FUNC."
+ "Return a composite sort condition based on the functions in FUNS."
(cond
;; Just a simple function.
- ((gnus-functionp funs) funs)
+ ((functionp funs) funs)
;; No functions at all.
((null funs) funs)
;; A list of functions.
((or (cdr funs)
(listp (car funs)))
- `(lambda (t1 t2)
- ,(gnus-make-sort-function-1 (reverse funs))))
+ (gnus-byte-compile
+ `(lambda (t1 t2)
+ ,(gnus-make-sort-function-1 (reverse funs)))))
;; A list containing just one function.
(t
(car funs))))
(defun gnus-make-sort-function-1 (funs)
- "Return a composite sort condition based on the functions in FUNC."
+ "Return a composite sort condition based on the functions in FUNS."
(let ((function (car funs))
(first 't1)
(last 't2))
@@ -501,7 +612,7 @@ If N, return the Nth ancestor instead."
(setq function (cadr function)
first 't2
last 't1))
- ((gnus-functionp function)
+ ((functionp function)
;; Do nothing.
)
(t
@@ -517,20 +628,49 @@ If N, return the Nth ancestor instead."
(define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
[menu-bar edit] 'undefined))
+(defmacro gnus-bind-print-variables (&rest forms)
+ "Bind print-* variables and evaluate FORMS.
+This macro is used with `prin1', `pp', etc. in order to ensure printed
+Lisp objects are loadable. Bind `print-quoted' and `print-readably'
+to t, and `print-escape-multibyte', `print-escape-newlines',
+`print-escape-nonascii', `print-length', `print-level' and
+`print-string-length' to nil."
+ `(let ((print-quoted t)
+ (print-readably t)
+ ;;print-circle
+ ;;print-continuous-numbering
+ print-escape-multibyte
+ print-escape-newlines
+ print-escape-nonascii
+ ;;print-gensym
+ print-length
+ print-level
+ print-string-length)
+ ,@forms))
+
(defun gnus-prin1 (form)
"Use `prin1' on FORM in the current buffer.
-Bind `print-quoted' and `print-readably' to t while printing."
- (let ((print-quoted t)
- (print-readably t)
- (print-escape-multibyte nil)
- print-level print-length)
- (prin1 form (current-buffer))))
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil. See also `gnus-bind-print-variables'."
+ (gnus-bind-print-variables (prin1 form (current-buffer))))
(defun gnus-prin1-to-string (form)
- "The same as `prin1', but bind `print-quoted' and `print-readably' to t."
- (let ((print-quoted t)
- (print-readably t))
- (prin1-to-string form)))
+ "The same as `prin1'.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil. See also `gnus-bind-print-variables'."
+ (gnus-bind-print-variables (prin1-to-string form)))
+
+(defun gnus-pp (form)
+ "Use `pp' on FORM in the current buffer.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil. See also `gnus-bind-print-variables'."
+ (gnus-bind-print-variables (pp form (current-buffer))))
+
+(defun gnus-pp-to-string (form)
+ "The same as `pp-to-string'.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil. See also `gnus-bind-print-variables'."
+ (gnus-bind-print-variables (pp-to-string form)))
(defun gnus-make-directory (directory)
"Make DIRECTORY (and all its parents) if it doesn't exist."
@@ -571,6 +711,19 @@ Bind `print-quoted' and `print-readably' to t while printing."
(setq beg (point)))
(gnus-put-text-property beg (point) prop val)))))
+(defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
+ "The same as `put-text-property', but don't put this prop on any newlines in the region."
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (goto-char beg)
+ (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
+ (gnus-overlay-put
+ (gnus-make-overlay beg (match-beginning 0))
+ prop val)
+ (setq beg (point)))
+ (gnus-overlay-put (gnus-make-overlay beg (point)) prop val)))))
+
(defun gnus-put-text-property-excluding-characters-with-faces (beg end
prop val)
"The same as `put-text-property', but don't put props on characters with the `gnus-face' property."
@@ -579,9 +732,23 @@ Bind `print-quoted' and `print-readably' to t while printing."
(when (get-text-property b 'gnus-face)
(setq b (next-single-property-change b 'gnus-face nil end)))
(when (/= b end)
- (gnus-put-text-property
- b (setq b (next-single-property-change b 'gnus-face nil end))
- prop val)))))
+ (inline
+ (gnus-put-text-property
+ b (setq b (next-single-property-change b 'gnus-face nil end))
+ prop val))))))
+
+(defmacro gnus-faces-at (position)
+ "Return a list of faces at POSITION."
+ (if (featurep 'xemacs)
+ `(let ((pos ,position))
+ (mapcar-extents 'extent-face
+ nil (current-buffer) pos pos nil 'face))
+ `(let ((pos ,position))
+ (delq nil (cons (get-text-property pos 'face)
+ (mapcar
+ (lambda (overlay)
+ (overlay-get overlay 'face))
+ (overlays-at pos)))))))
;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996
;;; The primary idea here is to try to protect internal datastructures
@@ -660,10 +827,31 @@ with potentially long computations."
;;; Functions for saving to babyl/mail files.
-(defvar rmail-default-rmail-file)
+(eval-when-compile
+ (condition-case nil
+ (progn
+ (require 'rmail)
+ (autoload 'rmail-update-summary "rmailsum"))
+ (error
+ (define-compiler-macro rmail-select-summary (&rest body)
+ ;; Rmail of the XEmacs version is supplied by the package, and
+ ;; requires tm and apel packages. However, there may be those
+ ;; who haven't installed those packages. This macro helps such
+ ;; people even if they install those packages later.
+ `(eval '(rmail-select-summary ,@body)))
+ ;; If there's rmail but there's no tm (or there's apel of the
+ ;; mainstream, not the XEmacs version), loading rmail of the XEmacs
+ ;; version fails halfway, however it provides the rmail-select-summary
+ ;; macro which uses the following functions:
+ (autoload 'rmail-summary-displayed "rmail")
+ (autoload 'rmail-maybe-display-summary "rmail")))
+ (defvar rmail-default-rmail-file)
+ (defvar mm-text-coding-system))
+
(defun gnus-output-to-rmail (filename &optional ask)
"Append the current article to an Rmail file named FILENAME."
(require 'rmail)
+ (require 'mm-util)
;; Most of these codes are borrowed from rmailout.el.
(setq filename (expand-file-name filename))
(setq rmail-default-rmail-file filename)
@@ -706,10 +894,10 @@ with potentially long computations."
(when msg
(goto-char (point-min))
(widen)
- (search-backward "\n\^_")
- (narrow-to-region (point) (point-max))
- (rmail-count-new-messages t)
- (when (rmail-summary-exists)
+ (search-backward "\n\^_")
+ (narrow-to-region (point) (point-max))
+ (rmail-count-new-messages t)
+ (when (rmail-summary-exists)
(rmail-select-summary
(rmail-update-summary)))
(rmail-count-new-messages t)
@@ -785,106 +973,16 @@ with potentially long computations."
(insert "\^_")))
(defun gnus-map-function (funs arg)
- "Applies the result of the first function in FUNS to the second, and so on.
+ "Apply the result of the first function in FUNS to the second, and so on.
ARG is passed to the first function."
- (let ((myfuns funs))
- (while myfuns
- (setq arg (funcall (pop myfuns) arg)))
- arg))
+ (while funs
+ (setq arg (funcall (pop funs) arg)))
+ arg)
(defun gnus-run-hooks (&rest funcs)
- "Does the same as `run-hooks', but saves excursion."
- (let ((buf (current-buffer)))
- (unwind-protect
- (apply 'run-hooks funcs)
- (set-buffer buf))))
-
-;;;
-;;; .netrc and .authinforc parsing
-;;;
-
-(defun gnus-parse-netrc (file)
- "Parse FILE and return a list of all entries in the file."
- (when (file-exists-p file)
- (with-temp-buffer
- (let ((tokens '("machine" "default" "login"
- "password" "account" "macdef" "force"
- "port"))
- alist elem result pair)
- (insert-file-contents file)
- (goto-char (point-min))
- ;; Go through the file, line by line.
- (while (not (eobp))
- (narrow-to-region (point) (gnus-point-at-eol))
- ;; For each line, get the tokens and values.
- (while (not (eobp))
- (skip-chars-forward "\t ")
- ;; Skip lines that begin with a "#".
- (if (eq (char-after) ?#)
- (goto-char (point-max))
- (unless (eobp)
- (setq elem
- (if (= (following-char) ?\")
- (read (current-buffer))
- (buffer-substring
- (point) (progn (skip-chars-forward "^\t ")
- (point)))))
- (cond
- ((equal elem "macdef")
- ;; We skip past the macro definition.
- (widen)
- (while (and (zerop (forward-line 1))
- (looking-at "$")))
- (narrow-to-region (point) (point)))
- ((member elem tokens)
- ;; Tokens that don't have a following value are ignored,
- ;; except "default".
- (when (and pair (or (cdr pair)
- (equal (car pair) "default")))
- (push pair alist))
- (setq pair (list elem)))
- (t
- ;; Values that haven't got a preceding token are ignored.
- (when pair
- (setcdr pair elem)
- (push pair alist)
- (setq pair nil)))))))
- (when alist
- (push (nreverse alist) result))
- (setq alist nil
- pair nil)
- (widen)
- (forward-line 1))
- (nreverse result)))))
-
-(defun gnus-netrc-machine (list machine &optional port defaultport)
- "Return the netrc values from LIST for MACHINE or for the default entry.
-If PORT specified, only return entries with matching port tokens.
-Entries without port tokens default to DEFAULTPORT."
- (let ((rest list)
- result)
- (while list
- (when (equal (cdr (assoc "machine" (car list))) machine)
- (push (car list) result))
- (pop list))
- (unless result
- ;; No machine name matches, so we look for default entries.
- (while rest
- (when (assoc "default" (car rest))
- (push (car rest) result))
- (pop rest)))
- (when result
- (setq result (nreverse result))
- (while (and result
- (not (equal (or port defaultport "nntp")
- (or (gnus-netrc-get (car result) "port")
- defaultport "nntp"))))
- (pop result))
- (car result))))
-
-(defun gnus-netrc-get (alist type)
- "Return the value of token TYPE from ALIST."
- (cdr (assoc type alist)))
+ "Does the same as `run-hooks', but saves the current buffer."
+ (save-current-buffer
+ (apply 'run-hooks funcs)))
;;; Various
@@ -898,28 +996,31 @@ Entries without port tokens default to DEFAULTPORT."
(eq major-mode 'gnus-group-mode))))
(defun gnus-remove-duplicates (list)
- (let (new (tail list))
- (while tail
- (or (member (car tail) new)
- (setq new (cons (car tail) new)))
- (setq tail (cdr tail)))
+ (let (new)
+ (while list
+ (or (member (car list) new)
+ (setq new (cons (car list) new)))
+ (setq list (cdr list)))
(nreverse new)))
-(defun gnus-delete-if (predicate list)
- "Delete elements from LIST that satisfy PREDICATE."
+(defun gnus-remove-if (predicate list)
+ "Return a copy of LIST with all items satisfying PREDICATE removed."
(let (out)
(while list
(unless (funcall predicate (car list))
(push (car list) out))
- (pop list))
+ (setq list (cdr list)))
(nreverse out)))
-(defun gnus-delete-alist (key alist)
- "Delete all entries in ALIST that have a key eq to KEY."
- (let (entry)
- (while (setq entry (assq key alist))
- (setq alist (delq entry alist)))
- alist))
+(if (fboundp 'assq-delete-all)
+ (defalias 'gnus-delete-alist 'assq-delete-all)
+ (defun gnus-delete-alist (key alist)
+ "Delete from ALIST all elements whose car is KEY.
+Return the modified alist."
+ (let (entry)
+ (while (setq entry (assq key alist))
+ (setq alist (delq entry alist)))
+ alist)))
(defmacro gnus-pull (key alist &optional assoc-p)
"Modify ALIST to be without KEY."
@@ -929,14 +1030,14 @@ Entries without port tokens default to DEFAULTPORT."
`(setq ,alist (delq (,fun ,key ,alist) ,alist))))
(defun gnus-globalify-regexp (re)
- "Returns a regexp that matches a whole line, iff RE matches a part of it."
+ "Return a regexp that matches a whole line, iff RE matches a part of it."
(concat (unless (string-match "^\\^" re) "^.*")
re
(unless (string-match "\\$$" re) ".*$")))
(defun gnus-set-window-start (&optional point)
"Set the window start to POINT, or (point) if nil."
- (let ((win (get-buffer-window (current-buffer) t)))
+ (let ((win (gnus-get-buffer-window (current-buffer) t)))
(when win
(set-window-start win (or point (point))))))
@@ -980,11 +1081,55 @@ Entries without port tokens default to DEFAULTPORT."
(while (search-backward "\\." nil t)
(delete-char 1)))))
+;; Fixme: Why not use `with-output-to-temp-buffer'?
+(defmacro gnus-with-output-to-file (file &rest body)
+ (let ((buffer (make-symbol "output-buffer"))
+ (size (make-symbol "output-buffer-size"))
+ (leng (make-symbol "output-buffer-length"))
+ (append (make-symbol "output-buffer-append")))
+ `(let* ((,size 131072)
+ (,buffer (make-string ,size 0))
+ (,leng 0)
+ (,append nil)
+ (standard-output
+ (lambda (c)
+ (aset ,buffer ,leng c)
+
+ (if (= ,size (setq ,leng (1+ ,leng)))
+ (progn (write-region ,buffer nil ,file ,append 'no-msg)
+ (setq ,leng 0
+ ,append t))))))
+ ,@body
+ (when (> ,leng 0)
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region (substring ,buffer 0 ,leng) nil ,file
+ ,append 'no-msg))))))
+
+(put 'gnus-with-output-to-file 'lisp-indent-function 1)
+(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
+
+(if (fboundp 'union)
+ (defalias 'gnus-union 'union)
+ (defun gnus-union (l1 l2)
+ "Set union of lists L1 and L2."
+ (cond ((null l1) l2)
+ ((null l2) l1)
+ ((equal l1 l2) l1)
+ (t
+ (or (>= (length l1) (length l2))
+ (setq l1 (prog1 l2 (setq l2 l1))))
+ (while l2
+ (or (member (car l2) l1)
+ (push (car l2) l1))
+ (pop l2))
+ l1))))
+
(defun gnus-add-text-properties-when
(property value start end properties &optional object)
"Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
(let (point)
(while (and start
+ (< start end) ;; XEmacs will loop for every when start=end.
(setq point (text-property-not-all start end property value)))
(gnus-add-text-properties start point properties object)
(setq start (text-property-any point end property value)))
@@ -996,6 +1141,7 @@ Entries without port tokens default to DEFAULTPORT."
"Like `remove-text-properties', only applied on where PROPERTY is VALUE."
(let (point)
(while (and start
+ (< start end)
(setq point (text-property-not-all start end property value)))
(remove-text-properties start point properties object)
(setq start (text-property-any point end property value)))
@@ -1003,11 +1149,369 @@ Entries without port tokens default to DEFAULTPORT."
(remove-text-properties start end properties object))
t))
+;; This might use `compare-strings' to reduce consing in the
+;; case-insensitive case, but it has to cope with null args.
+;; (`string-equal' uses symbol print names.)
+(defun gnus-string-equal (x y)
+ "Like `string-equal', except it compares case-insensitively."
+ (and (= (length x) (length y))
+ (or (string-equal x y)
+ (string-equal (downcase x) (downcase y)))))
+
+(defcustom gnus-use-byte-compile t
+ "If non-nil, byte-compile crucial run-time code.
+Setting it to nil has no effect after the first time `gnus-byte-compile'
+is run."
+ :type 'boolean
+ :version "21.1"
+ :group 'gnus-various)
+
+(defun gnus-byte-compile (form)
+ "Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
+ (if gnus-use-byte-compile
+ (progn
+ (condition-case nil
+ ;; Work around a bug in XEmacs 21.4
+ (require 'byte-optimize)
+ (error))
+ (require 'bytecomp)
+ (defalias 'gnus-byte-compile
+ (lambda (form)
+ (let ((byte-compile-warnings '(unresolved callargs redefine)))
+ (byte-compile form))))
+ (gnus-byte-compile form))
+ form))
+
+(defun gnus-remassoc (key alist)
+ "Delete by side effect any elements of LIST whose car is `equal' to KEY.
+The modified LIST is returned. If the first member
+of LIST has a car that is `equal' to KEY, there is no way to remove it
+by side effect; therefore, write `(setq foo (remassoc key foo))' to be
+sure of changing the value of `foo'."
+ (when alist
+ (if (equal key (caar alist))
+ (cdr alist)
+ (setcdr alist (gnus-remassoc key (cdr alist)))
+ alist)))
+
+(defun gnus-update-alist-soft (key value alist)
+ (if value
+ (cons (cons key value) (gnus-remassoc key alist))
+ (gnus-remassoc key alist)))
+
+(defun gnus-create-info-command (node)
+ "Create a command that will go to info NODE."
+ `(lambda ()
+ (interactive)
+ ,(concat "Enter the info system at node " node)
+ (Info-goto-node ,node)
+ (setq gnus-info-buffer (current-buffer))
+ (gnus-configure-windows 'info)))
+
+(defun gnus-not-ignore (&rest args)
+ t)
+
(defvar gnus-directory-sep-char-regexp "/"
"The regexp of directory separator character.
If you find some problem with the directory separator character, try
\"[/\\\\\]\" for some systems.")
+(defun gnus-url-unhex (x)
+ (if (> x ?9)
+ (if (>= x ?a)
+ (+ 10 (- x ?a))
+ (+ 10 (- x ?A)))
+ (- x ?0)))
+
+;; Fixme: Do it like QP.
+(defun gnus-url-unhex-string (str &optional allow-newlines)
+ "Remove %XX, embedded spaces, etc in a url.
+If optional second argument ALLOW-NEWLINES is non-nil, then allow the
+decoding of carriage returns and line feeds in the string, which is normally
+forbidden in URL encoding."
+ (let ((tmp "")
+ (case-fold-search t))
+ (while (string-match "%[0-9a-f][0-9a-f]" str)
+ (let* ((start (match-beginning 0))
+ (ch1 (gnus-url-unhex (elt str (+ start 1))))
+ (code (+ (* 16 ch1)
+ (gnus-url-unhex (elt str (+ start 2))))))
+ (setq tmp (concat
+ tmp (substring str 0 start)
+ (cond
+ (allow-newlines
+ (char-to-string code))
+ ((or (= code ?\n) (= code ?\r))
+ " ")
+ (t (char-to-string code))))
+ str (substring str (match-end 0)))))
+ (setq tmp (concat tmp str))
+ tmp))
+
+(defun gnus-make-predicate (spec)
+ "Transform SPEC into a function that can be called.
+SPEC is a predicate specifier that contains stuff like `or', `and',
+`not', lists and functions. The functions all take one parameter."
+ `(lambda (elem) ,(gnus-make-predicate-1 spec)))
+
+(defun gnus-make-predicate-1 (spec)
+ (cond
+ ((symbolp spec)
+ `(,spec elem))
+ ((listp spec)
+ (if (memq (car spec) '(or and not))
+ `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
+ (error "Invalid predicate specifier: %s" spec)))))
+
+(defun gnus-local-map-property (map)
+ "Return a list suitable for a text property list specifying keymap MAP."
+ (cond
+ ((featurep 'xemacs)
+ (list 'keymap map))
+ ((>= emacs-major-version 21)
+ (list 'keymap map))
+ (t
+ (list 'local-map map))))
+
+(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
+ require-match initial-contents
+ history default)
+ "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
+ `(completing-read ,prompt ,table ,predicate ,require-match
+ ,initial-contents ,history
+ ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2))
+ ()
+ (list default))))
+
+(defun gnus-completing-read (prompt table &optional predicate require-match
+ history)
+ (when (and history
+ (not (boundp history)))
+ (set history nil))
+ (gnus-completing-read-maybe-default
+ (if (symbol-value history)
+ (concat prompt " (" (car (symbol-value history)) "): ")
+ (concat prompt ": "))
+ table
+ predicate
+ require-match
+ nil
+ history
+ (car (symbol-value history))))
+
+(defun gnus-graphic-display-p ()
+ (or (and (fboundp 'display-graphic-p)
+ (display-graphic-p))
+ ;;;!!!This is bogus. Fixme!
+ (and (featurep 'xemacs)
+ t)))
+
+(put 'gnus-parse-without-error 'lisp-indent-function 0)
+(put 'gnus-parse-without-error 'edebug-form-spec '(body))
+
+(defmacro gnus-parse-without-error (&rest body)
+ "Allow continuing onto the next line even if an error occurs."
+ `(while (not (eobp))
+ (condition-case ()
+ (progn
+ ,@body
+ (goto-char (point-max)))
+ (error
+ (gnus-error 4 "Invalid data on line %d"
+ (count-lines (point-min) (point)))
+ (forward-line 1)))))
+
+(defun gnus-cache-file-contents (file variable function)
+ "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION."
+ (let ((time (nth 5 (file-attributes file)))
+ contents value)
+ (if (or (null (setq value (symbol-value variable)))
+ (not (equal (car value) file))
+ (not (equal (nth 1 value) time)))
+ (progn
+ (setq contents (funcall function file))
+ (set variable (list file time contents))
+ contents)
+ (nth 2 value))))
+
+(defun gnus-multiple-choice (prompt choice &optional idx)
+ "Ask user a multiple choice question.
+CHOICE is a list of the choice char and help message at IDX."
+ (let (tchar buf)
+ (save-window-excursion
+ (save-excursion
+ (while (not tchar)
+ (message "%s (%s): "
+ prompt
+ (concat
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ choice ", ") ", ?"))
+ (setq tchar (read-char))
+ (when (not (assq tchar choice))
+ (setq tchar nil)
+ (setq buf (get-buffer-create "*Gnus Help*"))
+ (pop-to-buffer buf)
+ (fundamental-mode) ; for Emacs 20.4+
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert prompt ":\n\n")
+ (let ((max -1)
+ (list choice)
+ (alist choice)
+ (idx (or idx 1))
+ (i 0)
+ n width pad format)
+ ;; find the longest string to display
+ (while list
+ (setq n (length (nth idx (car list))))
+ (unless (> max n)
+ (setq max n))
+ (setq list (cdr list)))
+ (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
+ (setq n (/ (1- (window-width)) max)) ; items per line
+ (setq width (/ (1- (window-width)) n)) ; width of each item
+ ;; insert `n' items, each in a field of width `width'
+ (while alist
+ (if (< i n)
+ ()
+ (setq i 0)
+ (delete-char -1) ; the `\n' takes a char
+ (insert "\n"))
+ (setq pad (- width 3))
+ (setq format (concat "%c: %-" (int-to-string pad) "s"))
+ (insert (format format (caar alist) (nth idx (car alist))))
+ (setq alist (cdr alist))
+ (setq i (1+ i))))))))
+ (if (buffer-live-p buf)
+ (kill-buffer buf))
+ tchar))
+
+(defun gnus-select-frame-set-input-focus (frame)
+ "Select FRAME, raise it, and set input focus, if possible."
+ (cond ((featurep 'xemacs)
+ (raise-frame frame)
+ (select-frame frame)
+ (focus-frame frame))
+ ;; The function `select-frame-set-input-focus' won't set
+ ;; the input focus under Emacs 21.2 and X window system.
+ ;;((fboundp 'select-frame-set-input-focus)
+ ;; (defalias 'gnus-select-frame-set-input-focus
+ ;; 'select-frame-set-input-focus)
+ ;; (select-frame-set-input-focus frame))
+ (t
+ (raise-frame frame)
+ (select-frame frame)
+ (cond ((and (eq window-system 'x)
+ (fboundp 'x-focus-frame))
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
+ (when focus-follows-mouse
+ (set-mouse-position frame (1- (frame-width frame)) 0)))))
+
+(defun gnus-frame-or-window-display-name (object)
+ "Given a frame or window, return the associated display name.
+Return nil otherwise."
+ (if (featurep 'xemacs)
+ (device-connection (dfw-device object))
+ (if (or (framep object)
+ (and (windowp object)
+ (setq object (window-frame object))))
+ (let ((display (frame-parameter object 'display)))
+ (if (and (stringp display)
+ ;; Exclude invalid display names.
+ (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'"
+ display))
+ display)))))
+
+;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile.
+(defmacro gnus-mapcar (function seq1 &rest seqs2_n)
+ "Apply FUNCTION to each element of the sequences, and make a list of the results.
+If there are several sequences, FUNCTION is called with that many arguments,
+and mapping stops as soon as the shortest sequence runs out. With just one
+sequence, this is like `mapcar'. With several, it is like the Common Lisp
+`mapcar' function extended to arbitrary sequence types."
+
+ (if seqs2_n
+ (let* ((seqs (cons seq1 seqs2_n))
+ (cnt 0)
+ (heads (mapcar (lambda (seq)
+ (make-symbol (concat "head"
+ (int-to-string
+ (setq cnt (1+ cnt))))))
+ seqs))
+ (result (make-symbol "result"))
+ (result-tail (make-symbol "result-tail")))
+ `(let* ,(let* ((bindings (cons nil nil))
+ (heads heads))
+ (nconc bindings (list (list result '(cons nil nil))))
+ (nconc bindings (list (list result-tail result)))
+ (while heads
+ (nconc bindings (list (list (pop heads) (pop seqs)))))
+ (cdr bindings))
+ (while (and ,@heads)
+ (setcdr ,result-tail (cons (funcall ,function
+ ,@(mapcar (lambda (h) (list 'car h))
+ heads))
+ nil))
+ (setq ,result-tail (cdr ,result-tail)
+ ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads))))
+ (cdr ,result)))
+ `(mapcar ,function ,seq1)))
+
+(if (fboundp 'merge)
+ (defalias 'gnus-merge 'merge)
+ ;; Adapted from cl-seq.el
+ (defun gnus-merge (type list1 list2 pred)
+ "Destructively merge lists LIST1 and LIST2 to produce a new list.
+Argument TYPE is for compatibility and ignored.
+Ordering of the elements is preserved according to PRED, a `less-than'
+predicate on the elements."
+ (let ((res nil))
+ (while (and list1 list2)
+ (if (funcall pred (car list2) (car list1))
+ (push (pop list2) res)
+ (push (pop list1) res)))
+ (nconc (nreverse res) list1 list2))))
+
+(eval-when-compile
+ (defvar xemacs-codename))
+
+(defun gnus-emacs-version ()
+ "Stringified Emacs version."
+ (let ((system-v
+ (cond
+ ((eq gnus-user-agent 'emacs-gnus-config)
+ system-configuration)
+ ((eq gnus-user-agent 'emacs-gnus-type)
+ (symbol-name system-type))
+ (t nil))))
+ (cond
+ ((eq gnus-user-agent 'gnus)
+ nil)
+ ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
+ (concat "Emacs/" (match-string 1 emacs-version)
+ (if system-v
+ (concat " (" system-v ")")
+ "")))
+ ((string-match
+ "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
+ emacs-version)
+ (concat
+ (match-string 1 emacs-version)
+ (format "/%d.%d" emacs-major-version emacs-minor-version)
+ (if (match-beginning 3)
+ (match-string 3 emacs-version)
+ "")
+ (if (boundp 'xemacs-codename)
+ (concat
+ " (" xemacs-codename
+ (if system-v
+ (concat ", " system-v ")")
+ ")"))
+ "")))
+ (t emacs-version))))
+
(provide 'gnus-util)
;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 55beb8eb263..3b2a29c238e 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1,6 +1,6 @@
;;; gnus-uu.el --- extract (uu)encoded files in Gnus
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
-;; 2001 Free Software Foundation, Inc.
+;; 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Created: 2 Oct 1993
@@ -299,7 +299,8 @@ so I simply dropped them."
"^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
"^Content-ID:")
"*List of regexps to match headers included in digested messages.
-The headers will be included in the sequence they are matched."
+The headers will be included in the sequence they are matched. If nil
+include all headers."
:group 'gnus-extract
:type '(repeat regexp))
@@ -321,7 +322,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defvar gnus-uu-saved-article-name nil)
-(defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
(defvar gnus-uu-end-string "^end[ \t]*$")
(defvar gnus-uu-body-line "^M")
@@ -336,7 +337,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defvar gnus-uu-shar-file-name nil)
(defvar gnus-uu-shar-name-marker
- "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
+ "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
(defvar gnus-uu-postscript-begin-string "^%!PS-")
(defvar gnus-uu-postscript-end-string "^%%EOF$")
@@ -353,56 +354,6 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defvar gnus-uu-digest-from-subject nil)
(defvar gnus-uu-digest-buffer nil)
-;; Keymaps
-
-(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "g" gnus-uu-unmark-region
- "R" gnus-uu-mark-by-regexp
- "G" gnus-uu-unmark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse
- "k" gnus-summary-kill-process-mark
- "y" gnus-summary-yank-process-mark
- "w" gnus-summary-save-process-mark
- "i" gnus-uu-invert-processable)
-
-(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- "m" gnus-summary-save-parts
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
-
-(gnus-define-keys
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
-
-
;; Commands.
(defun gnus-uu-decode-uu (&optional n)
@@ -529,43 +480,44 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(if (and n (not (numberp n)))
(setq message-forward-as-mime (not message-forward-as-mime)
n nil))
- (gnus-setup-message 'forward
- (setq gnus-uu-digest-from-subject nil)
- (setq gnus-uu-digest-buffer
- (gnus-get-buffer-create " *gnus-uu-forward*"))
- (gnus-uu-decode-save n file)
- (switch-to-buffer gnus-uu-digest-buffer)
- (let ((fs gnus-uu-digest-from-subject))
- (when fs
- (setq from (caar fs)
- subject (gnus-simplify-subject-fuzzy (cdar fs))
- fs (cdr fs))
- (while (and fs (or from subject))
- (when from
- (unless (string= from (caar fs))
- (setq from nil)))
- (when subject
- (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
- subject)
- (setq subject nil)))
- (setq fs (cdr fs))))
- (unless subject
- (setq subject "Digested Articles"))
- (unless from
- (setq from
- (if (gnus-news-group-p gnus-newsgroup-name)
- gnus-newsgroup-name
- "Various"))))
- (goto-char (point-min))
- (when (re-search-forward "^Subject: ")
- (delete-region (point) (gnus-point-at-eol))
- (insert subject))
- (goto-char (point-min))
- (when (re-search-forward "^From:")
- (delete-region (point) (gnus-point-at-eol))
- (insert " " from))
- (let ((message-forward-decoded-p t))
- (message-forward post t)))
+ (let ((gnus-article-reply (gnus-summary-work-articles n)))
+ (gnus-setup-message 'forward
+ (setq gnus-uu-digest-from-subject nil)
+ (setq gnus-uu-digest-buffer
+ (gnus-get-buffer-create " *gnus-uu-forward*"))
+ (gnus-uu-decode-save n file)
+ (switch-to-buffer gnus-uu-digest-buffer)
+ (let ((fs gnus-uu-digest-from-subject))
+ (when fs
+ (setq from (caar fs)
+ subject (gnus-simplify-subject-fuzzy (cdar fs))
+ fs (cdr fs))
+ (while (and fs (or from subject))
+ (when from
+ (unless (string= from (caar fs))
+ (setq from nil)))
+ (when subject
+ (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
+ subject)
+ (setq subject nil)))
+ (setq fs (cdr fs))))
+ (unless subject
+ (setq subject "Digested Articles"))
+ (unless from
+ (setq from
+ (if (gnus-news-group-p gnus-newsgroup-name)
+ gnus-newsgroup-name
+ "Various"))))
+ (goto-char (point-min))
+ (when (re-search-forward "^Subject: ")
+ (delete-region (point) (gnus-point-at-eol))
+ (insert subject))
+ (goto-char (point-min))
+ (when (re-search-forward "^From:")
+ (delete-region (point) (gnus-point-at-eol))
+ (insert " " from))
+ (let ((message-forward-decoded-p t))
+ (message-forward post t))))
(setq gnus-uu-digest-from-subject nil)))
(defun gnus-uu-digest-post-forward (&optional n)
@@ -575,17 +527,40 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
;; Process marking.
+(defun gnus-message-process-mark (unmarkp new-marked)
+ (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
+ (message "%d mark%s %s%s"
+ (length new-marked)
+ (if (= (length new-marked) 1) "" "s")
+ (if unmarkp "removed" "added")
+ (cond
+ ((and (zerop old)
+ (not unmarkp))
+ "")
+ (unmarkp
+ (format ", %d remain marked"
+ (length gnus-newsgroup-processable)))
+ (t
+ (format ", %d already marked" old))))))
+
+(defun gnus-new-processable (unmarkp articles)
+ (if unmarkp
+ (gnus-intersection gnus-newsgroup-processable articles)
+ (gnus-set-difference articles gnus-newsgroup-processable)))
+
(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
"Set the process mark on articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP.
Optional UNMARK non-nil means unmark instead of mark."
(interactive "sMark (regexp): \nP")
- (let ((articles (gnus-uu-find-articles-matching regexp)))
- (while articles
- (if unmark
- (gnus-summary-remove-process-mark (pop articles))
- (gnus-summary-set-process-mark (pop articles))))
- (message ""))
+ (save-excursion
+ (let* ((articles (gnus-uu-find-articles-matching regexp))
+ (new-marked (gnus-new-processable unmark articles)))
+ (while articles
+ (if unmark
+ (gnus-summary-remove-process-mark (pop articles))
+ (gnus-summary-set-process-mark (pop articles))))
+ (gnus-message-process-mark unmark new-marked)))
(gnus-summary-position-point))
(defun gnus-uu-unmark-by-regexp (regexp)
@@ -597,11 +572,12 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-series ()
"Mark the current series with the process mark."
(interactive)
- (let ((articles (gnus-uu-find-articles-matching)))
+ (let* ((articles (gnus-uu-find-articles-matching))
+ (l (length articles)))
(while articles
(gnus-summary-set-process-mark (car articles))
(setq articles (cdr articles)))
- (message ""))
+ (message "Marked %d articles" l))
(gnus-summary-position-point))
(defun gnus-uu-mark-region (beg end &optional unmark)
@@ -862,9 +838,7 @@ When called interactively, prompt for REGEXP."
"Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
(current-time-string) name name))
(when (and message-forward-as-mime gnus-uu-digest-buffer)
- ;; The default part in multipart/digest is message/rfc822.
- ;; Subject is a fake head.
- (insert "<#part type=text/plain>\nSubject: Topics\n\n"))
+ (insert "<#part type=message/rfc822>\nSubject: Topics\n\n"))
(insert "Topics:\n")))
(when (not (eq in-state 'end))
(setq state (list 'middle))))
@@ -896,7 +870,7 @@ When called interactively, prompt for REGEXP."
(setq body (buffer-substring (1- (point)) (point-max)))
(narrow-to-region (point-min) (point))
(if (not (setq headers gnus-uu-digest-headers))
- (setq sorthead (buffer-substring (point-min) (point-max)))
+ (setq sorthead (buffer-string))
(while headers
(setq headline (car headers))
(setq headers (cdr headers))
@@ -1116,7 +1090,7 @@ When called interactively, prompt for REGEXP."
(while (re-search-forward "[ \t]+" nil t)
(replace-match "[ \t]+" t t))
- (buffer-substring (point-min) (point-max))))
+ (buffer-string)))
(defun gnus-uu-get-list-of-articles (n)
;; If N is non-nil, the article numbers of the N next articles
@@ -1208,11 +1182,12 @@ When called interactively, prompt for REGEXP."
;; Expand numbers.
(goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
- (replace-match
- (format "%06d"
- (string-to-int (buffer-substring
- (match-beginning 0) (match-end 0))))))
- (setq string (buffer-substring (point-min) (point-max)))
+ (ignore-errors
+ (replace-match
+ (format "%06d"
+ (string-to-int (buffer-substring
+ (match-beginning 0) (match-end 0)))))))
+ (setq string (buffer-substring 1 (point-max)))
(setcar (car string-list) string)
(setq string-list (cdr string-list))))
out-list))
@@ -1377,27 +1352,27 @@ When called interactively, prompt for REGEXP."
(setq process-state (list 'error))
(gnus-message 2 "No begin part at the beginning")
(sleep-for 2))
- (setq state 'middle)))
-
+ (setq state 'middle))))
+
;; When there are no result-files, then something must be wrong.
- (if result-files
- (message "")
- (cond
- ((not has-been-begin)
- (gnus-message 2 "Wrong type file"))
- ((memq 'error process-state)
- (gnus-message 2 "An error occurred during decoding"))
- ((not (or (memq 'ok process-state)
- (memq 'end process-state)))
- (gnus-message 2 "End of articles reached before end of file")))
- ;; Make unsuccessfully decoded articles unread.
- (when gnus-uu-unmark-articles-not-decoded
- (while article-series
- (gnus-summary-tick-article (pop article-series) t)))))
+ (if result-files
+ (message "")
+ (cond
+ ((not has-been-begin)
+ (gnus-message 2 "Wrong type file"))
+ ((memq 'error process-state)
+ (gnus-message 2 "An error occurred during decoding"))
+ ((not (or (memq 'ok process-state)
+ (memq 'end process-state)))
+ (gnus-message 2 "End of articles reached before end of file")))
+ ;; Make unsuccessfully decoded articles unread.
+ (when gnus-uu-unmark-articles-not-decoded
+ (while article-series
+ (gnus-summary-tick-article (pop article-series) t))))
;; The original article buffer is hosed, shoot it down.
(gnus-kill-buffer gnus-original-article-buffer)
-
+ (setq gnus-current-article nil)
result-files))
(defun gnus-uu-grab-view (file)
@@ -1463,10 +1438,10 @@ When called interactively, prompt for REGEXP."
;; This is the beginning of a uuencoded article.
;; We replace certain characters that could make things messy.
(setq gnus-uu-file-name
- (let ((nnheader-file-name-translation-alist
- '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
- (nnheader-translate-file-chars (match-string 1))))
- (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
+ (gnus-map-function
+ mm-file-name-rewrite-functions
+ (file-name-nondirectory (match-string 1))))
+ (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
;; Remove any non gnus-uu-body-line right after start.
(forward-line 1)
@@ -1655,7 +1630,7 @@ Gnus might fail to display all of it.")
(gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
- (if (= 0 (call-process shell-file-name nil
+ (if (eq 0 (call-process shell-file-name nil
(gnus-get-buffer-create gnus-uu-output-buffer-name)
nil shell-command-switch command))
(message "")
@@ -1820,9 +1795,13 @@ Gnus might fail to display all of it.")
(if (file-directory-p file)
(gnus-uu-delete-work-dir file)
(gnus-message 9 "Deleting file %s..." file)
- (delete-file file))))
- (delete-directory dir)))
- (gnus-message 7 ""))
+ (condition-case err
+ (delete-file file)
+ (error (gnus-message 3 "Deleting file %s failed... %s" file err))))))
+ (condition-case err
+ (delete-directory dir)
+ (error (gnus-message 3 "Deleting directory %s failed... %s" file err))))
+ (gnus-message 7 "")))
;; Initializing
@@ -1900,7 +1879,7 @@ is t."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(use-local-map map))
- (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
(local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
@@ -1933,8 +1912,8 @@ The user will be asked for a file name."
;; Encodes with base64 and adds MIME headers
(defun gnus-uu-post-encode-mime (path file-name)
- (when (zerop (call-process shell-file-name nil t nil shell-command-switch
- (format "%s %s -o %s" "mmencode" path file-name)))
+ (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch
+ (format "%s %s -o %s" "mmencode" path file-name)))
(gnus-uu-post-make-mime file-name "base64")
t))
@@ -1959,8 +1938,8 @@ The user will be asked for a file name."
;; Encodes a file PATH with COMMAND, leaving the result in the
;; current buffer.
(defun gnus-uu-post-encode-file (command path file-name)
- (= 0 (call-process shell-file-name nil t nil shell-command-switch
- (format "%s %s %s" command path file-name))))
+ (eq 0 (call-process shell-file-name nil t nil shell-command-switch
+ (format "%s %s %s" command path file-name))))
(defun gnus-uu-post-news-inews ()
"Posts the composed news article and encoded file.
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 36925fdff91..d23777dc454 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -1,6 +1,6 @@
;;; gnus-vm.el --- vm interface for Gnus
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Per Persson <pp@gnu.ai.mit.edu>
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 4d0c18a8daf..8de4673fddc 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -1,5 +1,5 @@
;;; gnus-win.el --- window configuration functions for Gnus
-;; Copyright (C) 1996, 97, 98, 1999, 2000, 02, 2004
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -29,6 +29,7 @@
(eval-when-compile (require 'cl))
(require 'gnus)
+(require 'gnus-util)
(defgroup gnus-windows nil
"Window configuration."
@@ -57,6 +58,13 @@
:group 'gnus-windows
:type 'boolean)
+(defcustom gnus-use-frames-on-any-display nil
+ "*If non-nil, frames on all displays will be considered useable by Gnus.
+When nil, only frames on the same display as the selected frame will be
+used to display Gnus windows."
+ :group 'gnus-windows
+ :type 'boolean)
+
(defvar gnus-buffer-configuration
'((group
(vertical 1.0
@@ -68,17 +76,6 @@
(if gnus-carpal '(summary-carpal 4))))
(article
(cond
- ((and gnus-use-picons
- (eq gnus-picons-display-where 'picons))
- '(frame 1.0
- (vertical 1.0
- (summary 0.25 point)
- (if gnus-carpal '(summary-carpal 4))
- (article 1.0))
- (vertical ((height . 5) (width . 15)
- (user-position . t)
- (left . -1) (top . 1))
- (picons 1.0))))
(gnus-use-trees
'(vertical 1.0
(summary 0.25 point)
@@ -126,7 +123,7 @@
(post 1.0 point)))
(reply
(vertical 1.0
- (article-copy 0.5)
+ (article 0.5)
(message 1.0 point)))
(forward
(vertical 1.0
@@ -165,7 +162,10 @@
(compose-bounce
(vertical 1.0
(article 0.5)
- (message 1.0 point))))
+ (message 1.0 point)))
+ (display-term
+ (vertical 1.0
+ ("*display*" 1.0))))
"Window configuration for all possible Gnus buffers.
See the Gnus manual for an explanation of the syntax used.")
@@ -187,7 +187,6 @@ See the Gnus manual for an explanation of the syntax used.")
(mail . gnus-message-buffer)
(post-news . gnus-message-buffer)
(faq . gnus-faq-buffer)
- (picons . gnus-picons-buffer-name)
(tree . gnus-tree-buffer)
(score-trace . "*Score Trace*")
(split-trace . "*Split Trace*")
@@ -197,6 +196,11 @@ See the Gnus manual for an explanation of the syntax used.")
(draft . gnus-draft-buffer))
"Mapping from short symbols to buffer names or buffer variables.")
+(defcustom gnus-configure-windows-hook nil
+ "*A hook called when configuring windows."
+ :group 'gnus-windows
+ :type 'hook)
+
;;; Internal variables.
(defvar gnus-current-window-configuration nil
@@ -301,7 +305,7 @@ See the Gnus manual for an explanation of the syntax used.")
;; The SPLIT might be something that is to be evaled to
;; return a new SPLIT.
(while (and (not (assq (car split) gnus-window-to-buffer))
- (gnus-functionp (car split)))
+ (functionp (car split)))
(setq split (eval split)))
(let* ((type (car split))
(subs (cddr split))
@@ -364,7 +368,7 @@ See the Gnus manual for an explanation of the syntax used.")
(while subs
(setq sub (append (pop subs) nil))
(while (and (not (assq (car sub) gnus-window-to-buffer))
- (gnus-functionp (car sub)))
+ (functionp (car sub)))
(setq sub (eval sub)))
(when sub
(push sub comp-subs)
@@ -447,7 +451,7 @@ See the Gnus manual for an explanation of the syntax used.")
;; This is not a `frame' split, so we ignore the
;; other frames.
(delete-other-windows)
- ;; This is a `frame' split, so we delete all windows
+ ;; This is a `frame' split, so we delete all windows
;; on all frames.
(gnus-delete-windows-in-gnusey-frames))
;; Just remove some windows.
@@ -462,6 +466,7 @@ See the Gnus manual for an explanation of the syntax used.")
(switch-to-buffer nntp-server-buffer)
(set-buffer nntp-server-buffer))
(gnus-configure-frame split)
+ (run-hooks 'gnus-configure-windows-hook)
(when gnus-window-frame-focus
(select-frame (window-frame gnus-window-frame-focus))))))))
@@ -502,7 +507,7 @@ should have point."
;; The SPLIT might be something that is to be evaled to
;; return a new SPLIT.
(while (and (not (assq (car split) gnus-window-to-buffer))
- (gnus-functionp (car split)))
+ (functionp (car split)))
(setq split (eval split)))
(setq type (elt split 0))
@@ -516,7 +521,7 @@ should have point."
(unless buffer
(error "Invalid buffer type: %s" type))
(if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
- (setq win (get-buffer-window buf 0)))
+ (setq win (gnus-get-buffer-window buf t)))
(if (memq 'point split)
(setq all-visible win))
(setq all-visible nil)))
@@ -548,7 +553,29 @@ should have point."
(if (featurep 'xemacs)
(switch-to-buffer nntp-server-buffer)
(set-buffer nntp-server-buffer)))
- (mapcar (lambda (b) (delete-windows-on b t)) bufs))))
+ (mapcar (lambda (b) (delete-windows-on b t))
+ (delq lowest-buf bufs)))))
+
+(eval-and-compile
+ (cond
+ ((fboundp 'frames-on-display-list)
+ (defalias 'gnus-frames-on-display-list 'frames-on-display-list))
+ ((and (featurep 'xemacs) (fboundp 'frame-device))
+ (defun gnus-frames-on-display-list ()
+ (apply 'filtered-frame-list 'identity (list (frame-device nil)))))
+ (t
+ (defalias 'gnus-frames-on-display-list 'frame-list))))
+
+(defun gnus-get-buffer-window (buffer &optional frame)
+ (cond ((and (null gnus-use-frames-on-any-display)
+ (memq frame '(t 0 visible)))
+ (car
+ (let ((frames (gnus-frames-on-display-list)))
+ (gnus-remove-if (lambda (win) (not (memq (window-frame win)
+ frames)))
+ (get-buffer-window-list buffer nil frame)))))
+ (t
+ (get-buffer-window buffer frame))))
(provide 'gnus-win)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 97a8d8587cf..5d09c4b5c3c 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,6 +1,7 @@
;;; gnus.el --- a newsreader for GNU Emacs
+
;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
-;; 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -30,13 +31,19 @@
(eval '(run-hooks 'gnus-load-hook))
(eval-when-compile (require 'cl))
+(require 'wid-edit)
(require 'mm-util)
+(require 'nnheader)
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
:group 'news
:group 'mail)
+(defgroup gnus-format nil
+ "Dealing with formatting issues."
+ :group 'gnus)
+
(defgroup gnus-charset nil
"Group character set issues."
:link '(custom-manual "(gnus)Charsets")
@@ -45,6 +52,11 @@
(defgroup gnus-cache nil
"Cache interface."
+ :link '(custom-manual "(gnus)Article Caching")
+ :group 'gnus)
+
+(defgroup gnus-registry nil
+ "Article Registry."
:group 'gnus)
(defgroup gnus-start nil
@@ -58,7 +70,7 @@
;; These belong to gnus-group.el.
(defgroup gnus-group nil
"Group buffers."
- :link '(custom-manual "(gnus)The Group Buffer")
+ :link '(custom-manual "(gnus)Group Buffer")
:group 'gnus)
(defgroup gnus-group-foreign nil
@@ -99,7 +111,7 @@
;; These belong to gnus-sum.el.
(defgroup gnus-summary nil
"Summary buffers."
- :link '(custom-manual "(gnus)The Summary Buffer")
+ :link '(custom-manual "(gnus)Summary Buffer")
:group 'gnus)
(defgroup gnus-summary-exit nil
@@ -132,6 +144,10 @@
:link '(custom-manual "(gnus)Summary Maneuvering")
:group 'gnus-summary)
+(defgroup gnus-picon nil
+ "Show pictures of people, domains, and newsgroups."
+ :group 'gnus-visual)
+
(defgroup gnus-summary-mail nil
"Mail group commands."
:link '(custom-manual "(gnus)Mail Group Commands")
@@ -139,7 +155,7 @@
(defgroup gnus-summary-sort nil
"Sorting the summary buffer."
- :link '(custom-manual "(gnus)Sorting")
+ :link '(custom-manual "(gnus)Sorting the Summary Buffer")
:group 'gnus-summary)
(defgroup gnus-summary-visual nil
@@ -207,7 +223,7 @@
;; Other
(defgroup gnus-visual nil
- "Options controling the visual fluff."
+ "Options controlling the visual fluff."
:group 'gnus
:group 'faces)
@@ -232,12 +248,17 @@
"Options related to newsservers and other servers used by Gnus."
:group 'gnus)
+(defgroup gnus-server-visual nil
+ "Highlighting and menus in the server buffer."
+ :group 'gnus-visual
+ :group 'gnus-server)
+
(defgroup gnus-message '((message custom-group))
"Composing replies and followups in Gnus."
:group 'gnus)
(defgroup gnus-meta nil
- "Meta variables controling major portions of Gnus.
+ "Meta variables controlling major portions of Gnus.
In general, modifying these variables does not take affect until Gnus
is restarted, and sometimes reloaded."
:group 'gnus)
@@ -256,7 +277,12 @@ is restarted, and sometimes reloaded."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.9.0"
+(defgroup gnus-fun nil
+ "Frivolous Gnus extensions."
+ :link '(custom-manual "(gnus)Exiting Gnus")
+ :group 'gnus)
+
+(defconst gnus-version-number "5.10.6"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
@@ -274,6 +300,12 @@ be set in `.emacs' instead."
:group 'gnus-start
:type 'boolean)
+(unless (fboundp 'gnus-group-remove-excess-properties)
+ (defalias 'gnus-group-remove-excess-properties 'ignore))
+
+(unless (fboundp 'gnus-set-text-properties)
+ (defalias 'gnus-set-text-properties 'set-text-properties))
+
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
@@ -284,11 +316,10 @@ be set in `.emacs' instead."
(defalias 'gnus-overlay-end 'overlay-end)
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
- (defalias 'gnus-set-text-properties 'set-text-properties)
- (defalias 'gnus-group-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'identity)
+ (defalias 'gnus-assq-delete-all 'assq-delete-all)
(defalias 'gnus-add-text-properties 'add-text-properties)
(defalias 'gnus-put-text-property 'put-text-property)
(defvar gnus-mode-line-image-cache t)
@@ -308,7 +339,9 @@ be set in `.emacs' instead."
(:type xbm :file "gnus-pointer.xbm"
:ascent center))))
gnus-mode-line-image-cache)
- 'help-echo "This is Gnus")
+ 'help-echo (format
+ "This is %s, %s."
+ gnus-version (gnus-emacs-version)))
str)
(list str))
line)))
@@ -317,7 +350,8 @@ be set in `.emacs' instead."
(defalias 'gnus-deactivate-mark 'deactivate-mark)
(defalias 'gnus-window-edges 'window-edges)
(defalias 'gnus-key-press-event-p 'numberp)
- (defalias 'gnus-decode-rfc1522 'ignore))
+ ;;(defalias 'gnus-decode-rfc1522 'ignore)
+ )
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
@@ -325,10 +359,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-1-face
'((((class color)
(background dark))
- (:foreground "PaleTurquoise" :weight bold))
+ (:foreground "PaleTurquoise" :bold t))
(((class color)
(background light))
- (:foreground "ForestGreen" :weight bold))
+ (:foreground "ForestGreen" :bold t))
(t
()))
"Level 1 newsgroup face.")
@@ -347,10 +381,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-2-face
'((((class color)
(background dark))
- (:foreground "turquoise" :weight bold))
+ (:foreground "turquoise" :bold t))
(((class color)
(background light))
- (:foreground "CadetBlue4" :weight bold))
+ (:foreground "CadetBlue4" :bold t))
(t
()))
"Level 2 newsgroup face.")
@@ -369,10 +403,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-3-face
'((((class color)
(background dark))
- (:weight bold))
+ (:bold t))
(((class color)
(background light))
- (:weight bold))
+ (:bold t))
(t
()))
"Level 3 newsgroup face.")
@@ -391,10 +425,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-4-face
'((((class color)
(background dark))
- (:weight bold))
+ (:bold t))
(((class color)
(background light))
- (:weight bold))
+ (:bold t))
(t
()))
"Level 4 newsgroup face.")
@@ -413,10 +447,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-5-face
'((((class color)
(background dark))
- (:weight bold))
+ (:bold t))
(((class color)
(background light))
- (:weight bold))
+ (:bold t))
(t
()))
"Level 5 newsgroup face.")
@@ -435,10 +469,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-6-face
'((((class color)
(background dark))
- (:weight bold))
+ (:bold t))
(((class color)
(background light))
- (:weight bold))
+ (:bold t))
(t
()))
"Level 6 newsgroup face.")
@@ -457,10 +491,10 @@ be set in `.emacs' instead."
(defface gnus-group-news-low-face
'((((class color)
(background dark))
- (:foreground "DarkTurquoise" :weight bold))
+ (:foreground "DarkTurquoise" :bold t))
(((class color)
(background light))
- (:foreground "DarkGreen" :weight bold))
+ (:foreground "DarkGreen" :bold t))
(t
()))
"Low level newsgroup face.")
@@ -479,12 +513,12 @@ be set in `.emacs' instead."
(defface gnus-group-mail-1-face
'((((class color)
(background dark))
- (:foreground "aquamarine1" :weight bold))
+ (:foreground "aquamarine1" :bold t))
(((class color)
(background light))
- (:foreground "DeepPink3" :weight bold))
+ (:foreground "DeepPink3" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Level 1 mailgroup face.")
(defface gnus-group-mail-1-empty-face
@@ -495,18 +529,18 @@ be set in `.emacs' instead."
(background light))
(:foreground "DeepPink3"))
(t
- (:slant italic :weight bold)))
+ (:italic t :bold t)))
"Level 1 empty mailgroup face.")
(defface gnus-group-mail-2-face
'((((class color)
(background dark))
- (:foreground "aquamarine2" :weight bold))
+ (:foreground "aquamarine2" :bold t))
(((class color)
(background light))
- (:foreground "HotPink3" :weight bold))
+ (:foreground "HotPink3" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Level 2 mailgroup face.")
(defface gnus-group-mail-2-empty-face
@@ -517,18 +551,18 @@ be set in `.emacs' instead."
(background light))
(:foreground "HotPink3"))
(t
- (:weight bold)))
+ (:bold t)))
"Level 2 empty mailgroup face.")
(defface gnus-group-mail-3-face
'((((class color)
(background dark))
- (:foreground "aquamarine3" :weight bold))
+ (:foreground "aquamarine3" :bold t))
(((class color)
(background light))
- (:foreground "magenta4" :weight bold))
+ (:foreground "magenta4" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Level 3 mailgroup face.")
(defface gnus-group-mail-3-empty-face
@@ -545,12 +579,12 @@ be set in `.emacs' instead."
(defface gnus-group-mail-low-face
'((((class color)
(background dark))
- (:foreground "aquamarine4" :weight bold))
+ (:foreground "aquamarine4" :bold t))
(((class color)
(background light))
- (:foreground "DeepPink4" :weight bold))
+ (:foreground "DeepPink4" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Low level mailgroup face.")
(defface gnus-group-mail-low-empty-face
@@ -561,7 +595,7 @@ be set in `.emacs' instead."
(background light))
(:foreground "DeepPink4"))
(t
- (:weight bold)))
+ (:bold t)))
"Low level empty mailgroup face.")
;; Summary mode faces.
@@ -578,23 +612,23 @@ be set in `.emacs' instead."
(defface gnus-summary-high-ticked-face
'((((class color)
(background dark))
- (:foreground "pink" :weight bold))
+ (:foreground "pink" :bold t))
(((class color)
(background light))
- (:foreground "firebrick" :weight bold))
+ (:foreground "firebrick" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for high interest ticked articles.")
(defface gnus-summary-low-ticked-face
'((((class color)
(background dark))
- (:foreground "pink" :slant italic))
+ (:foreground "pink" :italic t))
(((class color)
(background light))
- (:foreground "firebrick" :slant italic))
+ (:foreground "firebrick" :italic t))
(t
- (:slant italic)))
+ (:italic t)))
"Face used for low interest ticked articles.")
(defface gnus-summary-normal-ticked-face
@@ -611,23 +645,23 @@ be set in `.emacs' instead."
(defface gnus-summary-high-ancient-face
'((((class color)
(background dark))
- (:foreground "SkyBlue" :weight bold))
+ (:foreground "SkyBlue" :bold t))
(((class color)
(background light))
- (:foreground "RoyalBlue" :weight bold))
+ (:foreground "RoyalBlue" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for high interest ancient articles.")
(defface gnus-summary-low-ancient-face
'((((class color)
(background dark))
- (:foreground "SkyBlue" :slant italic))
+ (:foreground "SkyBlue" :italic t))
(((class color)
(background light))
- (:foreground "RoyalBlue" :slant italic))
+ (:foreground "RoyalBlue" :italic t))
(t
- (:slant italic)))
+ (:italic t)))
"Face used for low interest ancient articles.")
(defface gnus-summary-normal-ancient-face
@@ -641,14 +675,41 @@ be set in `.emacs' instead."
()))
"Face used for normal interest ancient articles.")
+(defface gnus-summary-high-undownloaded-face
+ '((((class color)
+ (background light))
+ (:bold t :foreground "cyan4"))
+ (((class color) (background dark))
+ (:bold t :foreground "LightGray"))
+ (t (:inverse-video t :bold t)))
+ "Face used for high interest uncached articles.")
+
+(defface gnus-summary-low-undownloaded-face
+ '((((class color)
+ (background light))
+ (:italic t :foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:italic t :foreground "LightGray" :bold nil))
+ (t (:inverse-video t :italic t)))
+ "Face used for low interest uncached articles.")
+
+(defface gnus-summary-normal-undownloaded-face
+ '((((class color)
+ (background light))
+ (:foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:foreground "LightGray" :bold nil))
+ (t (:inverse-video t)))
+ "Face used for normal interest uncached articles.")
+
(defface gnus-summary-high-unread-face
'((t
- (:weight bold)))
+ (:bold t)))
"Face used for high interest unread articles.")
(defface gnus-summary-low-unread-face
'((t
- (:slant italic)))
+ (:italic t)))
"Face used for low interest unread articles.")
(defface gnus-summary-normal-unread-face
@@ -660,26 +721,26 @@ be set in `.emacs' instead."
'((((class color)
(background dark))
(:foreground "PaleGreen"
- :weight bold))
+ :bold t))
(((class color)
(background light))
(:foreground "DarkGreen"
- :weight bold))
+ :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for high interest read articles.")
(defface gnus-summary-low-read-face
'((((class color)
(background dark))
(:foreground "PaleGreen"
- :slant italic))
+ :italic t))
(((class color)
(background light))
(:foreground "DarkGreen"
- :slant italic))
+ :italic t))
(t
- (:slant italic)))
+ (:italic t)))
"Face used for low interest read articles.")
(defface gnus-summary-normal-read-face
@@ -709,6 +770,13 @@ be set in `.emacs' instead."
"Add the current buffer to the list of Gnus buffers."
(push (current-buffer) gnus-buffers))
+(defmacro gnus-kill-buffer (buffer)
+ "Kill BUFFER and remove from the list of Gnus buffers."
+ `(let ((buf ,buffer))
+ (when (gnus-buffer-exists-p buf)
+ (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
+ (kill-buffer buf))))
+
(defun gnus-buffers ()
"Return a list of live Gnus buffers."
(while (and gnus-buffers
@@ -731,13 +799,13 @@ be set in `.emacs' instead."
(defface gnus-splash-face
'((((class color)
(background dark))
- (:foreground "Brown"))
+ (:foreground "#888888"))
(((class color)
(background light))
- (:foreground "Brown"))
+ (:foreground "#888888"))
(t
()))
- "Face of the splash screen.")
+ "Face for the splash screen.")
(defun gnus-splash ()
(save-excursion
@@ -765,6 +833,39 @@ be set in `.emacs' instead."
(defvar gnus-simple-splash nil)
+;;(format "%02x%02x%02x" 114 66 20) "724214"
+
+(defvar gnus-logo-color-alist
+ '((flame "#cc3300" "#ff2200")
+ (pine "#c0cc93" "#f8ffb8")
+ (moss "#a1cc93" "#d2ffb8")
+ (irish "#04cc90" "#05ff97")
+ (sky "#049acc" "#05deff")
+ (tin "#6886cc" "#82b6ff")
+ (velvet "#7c68cc" "#8c82ff")
+ (grape "#b264cc" "#cf7df")
+ (labia "#cc64c2" "#fd7dff")
+ (berry "#cc6485" "#ff7db5")
+ (dino "#724214" "#1e3f03")
+ (oort "#cccccc" "#888888")
+ (storm "#666699" "#99ccff")
+ (pdino "#9999cc" "#99ccff")
+ (purp "#9999cc" "#666699")
+ (no "#000000" "#ff0000")
+ (neutral "#b4b4b4" "#878787")
+ (september "#bf9900" "#ffcc00"))
+ "Color alist used for the Gnus logo.")
+
+(defcustom gnus-logo-color-style 'oort
+ "*Color styles used for the Gnus logo."
+ :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
+ gnus-logo-color-alist))
+ :group 'gnus-xmas)
+
+(defvar gnus-logo-colors
+ (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
+ "Colors used for the Gnus logo.")
+
(defun gnus-group-startup-message (&optional x y)
"Insert startup message in current buffer."
;; Insert the message.
@@ -773,16 +874,22 @@ be set in `.emacs' instead."
((and
(fboundp 'find-image)
(display-graphic-p)
- (let ((image (find-image
- `((:type xpm :file "gnus.xpm")
- (:type pbm :file "gnus.pbm"
- ;; Account for the pbm's blackground.
- :background ,(face-foreground 'gnus-splash-face)
- :foreground ,(face-background 'default))
- (:type xbm :file "gnus.xbm"
- ;; Account for the xbm's blackground.
- :background ,(face-foreground 'gnus-splash-face)
- :foreground ,(face-background 'default))))))
+ (let* ((data-directory (nnheader-find-etc-directory "gnus"))
+ (image (find-image
+ `((:type xpm :file "gnus.xpm"
+ :color-symbols
+ (("thing" . ,(car gnus-logo-colors))
+ ("shadow" . ,(cadr gnus-logo-colors))
+ ("oort" . "#eeeeee")
+ ("background" . ,(face-background 'default))))
+ (:type pbm :file "gnus.pbm"
+ ;; Account for the pbm's blackground.
+ :background ,(face-foreground 'gnus-splash-face)
+ :foreground ,(face-background 'default))
+ (:type xbm :file "gnus.xbm"
+ ;; Account for the xbm's blackground.
+ :background ,(face-foreground 'gnus-splash-face)
+ :foreground ,(face-background 'default))))))
(when image
(let ((size (image-size image)))
(insert-char ?\n (max 0 (round (- (window-height)
@@ -833,16 +940,113 @@ be set in `.emacs' instead."
(eval-when (load)
(let ((command (format "%s" this-command)))
- (if (and (string-match "gnus" command)
- (not (string-match "gnus-other-frame" command)))
- (gnus-splash)
- (gnus-get-buffer-create gnus-group-buffer))))
+ (when (string-match "gnus" command)
+ (if (string-match "gnus-other-frame" command)
+ (gnus-get-buffer-create gnus-group-buffer)
+ (gnus-splash)))))
;;; Do the rest.
(require 'gnus-util)
(require 'nnheader)
+(defcustom gnus-parameters nil
+ "Alist of group parameters.
+
+For example:
+ ((\"mail\\\\..*\" (gnus-show-threads nil)
+ (gnus-use-scoring nil)
+ (gnus-summary-line-format
+ \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
+ (gcc-self . t)
+ (display . all))
+ (\"mail\\\\.me\" (gnus-use-scoring t))
+ (\"list\\\\..*\" (total-expire . t)
+ (broken-reply-to . t)))"
+ :group 'gnus-group-various
+ :type '(repeat (cons regexp
+ (repeat sexp))))
+
+(defvar gnus-group-parameters-more nil)
+
+(defmacro gnus-define-group-parameter (param &rest rest)
+ "Define a group parameter PARAM.
+REST is a plist of following:
+:type One of `bool', `list' or nil.
+:function The name of the function.
+:function-document The documentation of the function.
+:parameter-type The type for customizing the parameter.
+:parameter-document The documentation for the parameter.
+:variable The name of the variable.
+:variable-document The documentation for the variable.
+:variable-group The group for customizing the variable.
+:variable-type The type for customizing the variable.
+:variable-default The default value of the variable."
+ (let* ((type (plist-get rest :type))
+ (parameter-type (plist-get rest :parameter-type))
+ (parameter-document (plist-get rest :parameter-document))
+ (function (or (plist-get rest :function)
+ (intern (format "gnus-parameter-%s" param))))
+ (function-document (or (plist-get rest :function-document) ""))
+ (variable (or (plist-get rest :variable)
+ (intern (format "gnus-parameter-%s-alist" param))))
+ (variable-document (or (plist-get rest :variable-document) ""))
+ (variable-group (plist-get rest :variable-group))
+ (variable-type (or (plist-get rest :variable-type)
+ `(quote (repeat
+ (list (regexp :tag "Group")
+ ,(car (cdr parameter-type)))))))
+ (variable-default (plist-get rest :variable-default)))
+ (list
+ 'progn
+ `(defcustom ,variable ,variable-default
+ ,variable-document
+ :group 'gnus-group-parameter
+ :group ',variable-group
+ :type ,variable-type)
+ `(setq gnus-group-parameters-more
+ (delq (assq ',param gnus-group-parameters-more)
+ gnus-group-parameters-more))
+ `(add-to-list 'gnus-group-parameters-more
+ (list ',param
+ ,parameter-type
+ ,parameter-document))
+ (if (eq type 'bool)
+ `(defun ,function (name)
+ ,function-document
+ (let ((params (gnus-group-find-parameter name))
+ val)
+ (cond
+ ((memq ',param params)
+ t)
+ ((setq val (assq ',param params))
+ (cdr val))
+ ((stringp ,variable)
+ (string-match ,variable name))
+ (,variable
+ (let ((alist ,variable)
+ elem value)
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ value (cdr elem))))
+ (if (consp value) (car value) value))))))
+ `(defun ,function (name)
+ ,function-document
+ (and name
+ (or (gnus-group-find-parameter name ',param ,(and type t))
+ (let ((alist ,variable)
+ elem value)
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ value (cdr elem))))
+ ,(if type
+ 'value
+ '(if (consp value) (car value) value))))))))))
+
(defcustom gnus-home-directory "~/"
"Directory variable that specifies the \"home\" directory.
All other Gnus file and directory variables are initialized from this variable."
@@ -891,21 +1095,17 @@ used to 899, you would say something along these lines:
:group 'gnus-server
:type 'file)
-;; This function is used to check both the environment variable
-;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
-;; an nntp server name default.
(defun gnus-getenv-nntpserver ()
+ "Find default nntp server.
+Check the NNTPSERVER environment variable and the
+`gnus-nntpserver-file' file."
(or (getenv "NNTPSERVER")
(and (file-readable-p gnus-nntpserver-file)
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus nntp*"))
+ (with-temp-buffer
(insert-file-contents gnus-nntpserver-file)
(let ((name (buffer-string)))
- (prog1
- (if (string-match "\\'[ \t\n]*$" name)
- nil
- name)
- (kill-buffer (current-buffer))))))))
+ (unless (string-match "\\`[ \t\n]*$" name)
+ name))))))
(defcustom gnus-select-method
(condition-case nil
@@ -926,8 +1126,8 @@ used to 899, you would say something along these lines:
This variable should be a list, where the first element is how the
news is to be fetched, the second is the address.
-For instance, if you want to get your news via NNTP from
-\"flab.flab.edu\", you could say:
+For instance, if you want to get your news via \"flab.flab.edu\" using
+NNTP, you could say:
\(setq gnus-select-method '(nntp \"flab.flab.edu\"))
@@ -942,26 +1142,13 @@ see the manual for details."
:group 'gnus-server
:type 'gnus-select-method)
-(defcustom gnus-message-archive-method
- (progn
- ;; Don't require it at top level to avoid circularity.
- (require 'message)
- `(nnfolder
- "archive"
- (nnfolder-directory ,(nnheader-concat message-directory "archive"))
- (nnfolder-active-file
- ,(nnheader-concat message-directory "archive/active"))
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t)))
+(defcustom gnus-message-archive-method "archive"
"*Method used for archiving messages you've sent.
-This should be a mail method.
-
-It's probably not very effective to change this variable once you've
-run Gnus once. After doing that, you must edit this server from the
-server buffer."
+This should be a mail method."
:group 'gnus-server
:group 'gnus-message
- :type 'gnus-select-method)
+ :type '(choice (const :tag "Default archive method" "archive")
+ gnus-select-method))
(defcustom gnus-message-archive-group nil
"*Name of the group in which to save the messages you've written.
@@ -974,9 +1161,9 @@ If you want to save your mail in one group and the news articles you
write in another group, you could say something like:
\(setq gnus-message-archive-group
- '((if (message-news-p)
- \"misc-news\"
- \"misc-mail\")))
+ '((if (message-news-p)
+ \"misc-news\"
+ \"misc-mail\")))
Normally the group names returned by this variable should be
unprefixed -- which implicitly means \"store on the archive server\".
@@ -1009,7 +1196,7 @@ variable instead."
This is a list where each element is a complete select method (see
`gnus-select-method').
-If, for instance, you want to read your mail with the nnml backend,
+If, for instance, you want to read your mail with the nnml back end,
you could set this variable:
\(setq gnus-secondary-select-methods '((nnml \"\")))"
@@ -1050,27 +1237,28 @@ It can also be a list of select methods, as well as the special symbol
list, Gnus will try all the methods in the list until it finds a match."
:group 'gnus-server
:type '(choice (const :tag "default" nil)
- (const :tag "DejaNews" (nnweb "refer" (nnweb-type dejanews)))
+ (const current)
+ (const :tag "Google" (nnweb "refer" (nnweb-type google)))
gnus-select-method
(repeat :menu-tag "Try multiple"
:tag "Multiple"
- :value (current (nnweb "refer" (nnweb-type dejanews)))
+ :value (current (nnweb "refer" (nnweb-type google)))
(choice :tag "Method"
(const current)
- (const :tag "DejaNews"
- (nnweb "refer" (nnweb-type dejanews)))
+ (const :tag "Google"
+ (nnweb "refer" (nnweb-type google)))
gnus-select-method))))
(defcustom gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
- "/ftp@sunsite.auc.dk:/pub/usenet/"
"/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
"/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
+ "/ftp@ftp.pasteur.fr:/pub/FAQ/"
"/ftp@rtfm.mit.edu:/pub/usenet/"
"/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
"/ftp@ftp.sunet.se:/pub/usenet/"
- "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
+ "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/"
"/ftp@hwarang.postech.ac.kr:/pub/usenet/"
"/ftp@ftp.hk.super.net:/mirror/faqs/")
"*Directory where the group FAQs are stored.
@@ -1091,16 +1279,50 @@ If the default site is too slow, try one of these:
ftp.seas.gwu.edu /pub/rtfm
rtfm.mit.edu /pub/usenet
Europe: ftp.uni-paderborn.de /pub/FAQ
- src.doc.ic.ac.uk /usenet/news-FAQS
+ src.doc.ic.ac.uk /usenet/news-FAQS
ftp.sunet.se /pub/usenet
- sunsite.auc.dk /pub/usenet
- Asia: nctuccca.edu.tw /USENET/FAQ
+ ftp.pasteur.fr /pub/FAQ
+ Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/
hwarang.postech.ac.kr /pub/usenet
ftp.hk.super.net /mirror/faqs"
:group 'gnus-group-various
:type '(choice directory
(repeat directory)))
+(defcustom gnus-group-charter-alist
+ '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
+ ("de" . (concat "http://purl.net/charta/" name ".html"))
+ ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
+ ("england" . (concat "http://england.news-admin.org/charters/" name))
+ ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
+ ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
+ (gnus-replace-in-string name "europa\\." "") ".html"))
+ ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
+ ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name))
+ ("pl" . (concat "http://www.usenet.pl/opisy/" name))
+ ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
+ ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
+ ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
+ ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
+ ("se" . (concat "http://www.usenet-se.net/Reglementen/"
+ (gnus-replace-in-string name "\\." "_") ".html"))
+ ("milw" . (concat "http://usenet.mil.wi.us/"
+ (gnus-replace-in-string name "milw\\." "") "-charter"))
+ ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
+ ("netins" . (concat "http://www.netins.net/usenet/charter/"
+ (gnus-replace-in-string name "\\." "-") "-charter.html")))
+ "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
+When FORM is evaluated `name' is bound to the name of the group."
+ :group 'gnus-group-various
+ :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
+
+(defcustom gnus-group-fetch-control-use-browse-url nil
+ "*Non-nil means that control messages are displayed using `browse-url'.
+Otherwise they are fetched with ange-ftp and displayed in an ephemeral
+group."
+ :group 'gnus-group-various
+ :type 'boolean)
+
(defcustom gnus-use-cross-reference t
"*Non-nil means that cross referenced articles will be marked as read.
If nil, ignore cross references. If t, mark articles as read in
@@ -1121,9 +1343,11 @@ newsgroups."
(defcustom gnus-large-newsgroup 200
"*The number of articles which indicates a large newsgroup.
If the number of articles in a newsgroup is greater than this value,
-confirmation is required for selecting the newsgroup."
+confirmation is required for selecting the newsgroup.
+If it is nil, no confirmation is required."
:group 'gnus-group-select
- :type 'integer)
+ :type '(choice (const :tag "No limit" nil)
+ integer))
(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
"*Non-nil means that the default name of a file to save articles in is the group name.
@@ -1139,7 +1363,14 @@ Note that the default for this variable varies according to what system
type you're using. On `usg-unix-v' and `xenix' this variable defaults
to nil while on all other systems it defaults to t."
:group 'gnus-start
- :type 'boolean)
+ :type '(radio (sexp :format "Non-nil\n"
+ :match (lambda (widget value)
+ (and value (not (listp value))))
+ :value t)
+ (const nil)
+ (checklist (const :format "%v " not-score)
+ (const :format "%v " not-save)
+ (const not-kill))))
(defcustom gnus-kill-files-directory gnus-directory
"*Name of the directory where kill files will be stored (default \"~/News\")."
@@ -1188,7 +1419,7 @@ cache to the full extent of the law."
:group 'gnus-meta
:type 'boolean)
-(defcustom gnus-keep-backlog nil
+(defcustom gnus-keep-backlog 20
"*If non-nil, Gnus will keep read articles for later re-retrieval.
If it is a number N, then Gnus will only keep the last N articles
read. If it is neither nil nor a number, Gnus will keep all read
@@ -1214,11 +1445,6 @@ articles. This is not a good idea."
:group 'gnus-meta
:type 'boolean)
-(defcustom gnus-use-picons nil
- "*If non-nil, display picons in a frame of their own."
- :group 'gnus-meta
- :type 'boolean)
-
(defcustom gnus-summary-prepare-exit-hook
'(gnus-summary-expire-articles)
"*A hook called when preparing to exit from the summary buffer.
@@ -1227,7 +1453,7 @@ It calls `gnus-summary-expire-articles' by default."
:type 'hook)
(defcustom gnus-novice-user t
- "*Non-nil means that you are a usenet novice.
+ "*Non-nil means that you are a Usenet novice.
If non-nil, verbose messages may be displayed and confirmations may be
required."
:group 'gnus-meta
@@ -1267,7 +1493,7 @@ slower."
:type 'boolean)
(defcustom gnus-shell-command-separator ";"
- "String used to separate to shell commands."
+ "String used to separate shell commands."
:group 'gnus-files
:type 'string)
@@ -1276,7 +1502,7 @@ slower."
("nnspool" post address)
("nnvirtual" post-mail virtual prompt-address)
("nnmbox" mail respool address)
- ("nnml" mail respool address)
+ ("nnml" post-mail respool address)
("nnmh" mail respool address)
("nndir" post-mail prompt-address physical-address)
("nneething" none address prompt-address physical-address)
@@ -1288,12 +1514,17 @@ slower."
("nnfolder" mail respool address)
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
+ ("nngoogle" post)
("nnslashdot" post)
("nnultimate" none)
+ ("nnrss" none)
+ ("nnwfm" none)
("nnwarchive" none)
("nnlistserv" none)
("nnagent" post-mail)
- ("nnimap" post-mail address prompt-address physical-address))
+ ("nnimap" post-mail address prompt-address physical-address)
+ ("nnmaildir" mail respool address)
+ ("nnnil" none))
"*An alist of valid select methods.
The first element of each list lists should be a string with the name
of the select method. The other elements may be the category of
@@ -1332,8 +1563,7 @@ this variable. I think."
:inline t
(list :format "%v"
variable
- (sexp :tag "Value"))))
- ))
+ (sexp :tag "Value"))))))
(gnus-redefine-select-method-widget)
@@ -1353,29 +1583,582 @@ If this variable is nil, screen refresh may be quicker."
(defcustom gnus-mode-non-string-length nil
"*Max length of mode-line non-string contents.
If this is nil, Gnus will take space as is needed, leaving the rest
-of the modeline intact. Note that the default of nil is unlikely
+of the mode line intact. Note that the default of nil is unlikely
to be desirable; see the manual for further details."
:group 'gnus-various
:type '(choice (const nil)
integer))
-(defcustom gnus-auto-expirable-newsgroups nil
- "*Groups in which to automatically mark read articles as expirable.
+;; There should be special validation for this.
+(define-widget 'gnus-email-address 'string
+ "An email address.")
+
+(gnus-define-group-parameter
+ to-address
+ :function-document
+ "Return GROUP's to-address."
+ :variable-document
+ "*Alist of group regexps and correspondent to-addresses."
+ :parameter-type '(gnus-email-address :tag "To Address")
+ :parameter-document "\
+This will be used when doing followups and posts.
+
+This is primarily useful in mail groups that represent closed
+mailing lists--mailing lists where it's expected that everybody that
+writes to the mailing list is subscribed to it. Since using this
+parameter ensures that the mail only goes to the mailing list itself,
+it means that members won't receive two copies of your followups.
+
+Using `to-address' will actually work whether the group is foreign or
+not. Let's say there's a group on the server that is called
+`fa.4ad-l'. This is a real newsgroup, but the server has gotten the
+articles from a mail-to-news gateway. Posting directly to this group
+is therefore impossible--you have to send mail to the mailing list
+address instead.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
+ to-list
+ :function-document
+ "Return GROUP's to-list."
+ :variable-document
+ "*Alist of group regexps and correspondent to-lists."
+ :parameter-type '(gnus-email-address :tag "To List")
+ :parameter-document "\
+This address will be used when doing a `a' in the group.
+
+It is totally ignored when doing a followup--except that if it is
+present in a news group, you'll get mail group semantics when doing
+`f'.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
+ subscribed
+ :type bool
+ :function-document
+ "Return GROUP's subscription status."
+ :variable-document
+ "*Groups which are automatically considered subscribed."
+ :parameter-type '(const :tag "Subscribed" t)
+ :parameter-document "\
+Gnus assumed that you are subscribed to the To/List address.
+
+When constructing a list of subscribed groups using
+`gnus-find-subscribed-addresses', Gnus includes the To address given
+above, or the list address (if the To address has not been set).")
+
+(gnus-define-group-parameter
+ auto-expire
+ :type bool
+ :function gnus-group-auto-expirable-p
+ :function-document
+ "Check whether GROUP is auto-expirable or not."
+ :variable gnus-auto-expirable-newsgroups
+ :variable-default nil
+ :variable-document
+ "*Groups in which to automatically mark read articles as expirable.
If non-nil, this should be a regexp that should match all groups in
which to perform auto-expiry. This only makes sense for mail groups."
- :group 'nnmail-expire
- :type '(choice (const nil)
- regexp))
-
-(defcustom gnus-total-expirable-newsgroups nil
- "*Groups in which to perform expiry of all read articles.
+ :variable-group nnmail-expire
+ :variable-type '(choice (const nil)
+ regexp)
+ :parameter-type '(const :tag "Automatic Expire" t)
+ :parameter-document
+ "All articles that are read will be marked as expirable.")
+
+(gnus-define-group-parameter
+ total-expire
+ :type bool
+ :function gnus-group-total-expirable-p
+ :function-document
+ "Check whether GROUP is total-expirable or not."
+ :variable gnus-total-expirable-newsgroups
+ :variable-default nil
+ :variable-document
+ "*Groups in which to perform expiry of all read articles.
Use with extreme caution. All groups that match this regexp will be
expiring - which means that all read articles will be deleted after
\(say) one week. (This only goes for mail groups and the like, of
course.)"
- :group 'nnmail-expire
- :type '(choice (const nil)
- regexp))
+ :variable-group nnmail-expire
+ :variable-type '(choice (const nil)
+ regexp)
+ :parameter-type '(const :tag "Total Expire" t)
+ :parameter-document
+ "All read articles will be put through the expiry process
+
+This happens even if they are not marked as expirable.
+Use with caution.")
+
+(gnus-define-group-parameter
+ charset
+ :function-document
+ "Return the default charset of GROUP."
+ :variable gnus-group-charset-alist
+ :variable-default
+ '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
+ ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
+ ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
+ ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
+ ("\\(^\\|:\\)relcom\\>" koi8-r)
+ ("\\(^\\|:\\)fido7\\>" koi8-r)
+ ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+ ("\\(^\\|:\\)israel\\>" iso-8859-1)
+ ("\\(^\\|:\\)han\\>" euc-kr)
+ ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
+ ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
+ ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1))
+ :variable-document
+ "Alist of regexps (to match group names) and default charsets to be used when reading."
+ :variable-group gnus-charset
+ :variable-type '(repeat (list (regexp :tag "Group")
+ (symbol :tag "Charset")))
+ :parameter-type '(symbol :tag "Charset")
+ :parameter-document "\
+The default charset to use in the group.")
+
+(gnus-define-group-parameter
+ post-method
+ :type list
+ :function-document
+ "Return a posting method for GROUP."
+ :variable gnus-post-method-alist
+ :variable-document
+ "Alist of regexps (to match group names) and method to be used when
+posting an article."
+ :variable-group gnus-group-foreign
+ :parameter-type
+ '(choice :tag "Posting Method"
+ (const :tag "Use native server" native)
+ (const :tag "Use current server" current)
+ (list :convert-widget
+ (lambda (widget)
+ (list 'sexp :tag "Methods"
+ :value gnus-select-method))))
+ :parameter-document
+ "Posting method for this group.")
+
+(gnus-define-group-parameter
+ large-newsgroup-initial
+ :type integer
+ :function-document
+ "Return GROUP's initial input of the number of articles."
+ :variable-document
+ "*Alist of group regexps and its initial input of the number of articles."
+ :parameter-type '(choice :tag "Initial Input for Large Newsgroup"
+ (const :tag "All" nil)
+ (integer))
+ :parameter-document "\
+
+This number will be prompted as the initial value of the number of
+articles to list when the group is a large newsgroup (see
+`gnus-large-newsgroup'). If it is nil, the default value is the
+total number of articles in the group.")
+
+;; The Gnus registry's ignored groups
+(gnus-define-group-parameter
+ registry-ignore
+ :type list
+ :function-document
+ "Whether this group should be ignored by the registry."
+ :variable gnus-registry-ignored-groups
+ :variable-default nil
+ :variable-document
+ "*Groups in which the registry should be turned off."
+ :variable-group gnus-registry
+ :variable-type '(repeat
+ (list
+ (regexp :tag "Group Name Regular Expression")
+ (boolean :tag "Ignored")))
+
+ :parameter-type '(boolean :tag "Group Ignored by the Registry")
+ :parameter-document
+ "Whether the Gnus Registry should ignore this group.")
+
+;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
+(defcustom gnus-install-group-spam-parameters t
+ "*Disable the group parameters for spam detection.
+Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
+ :type 'boolean
+ :group 'gnus-start)
+
+(when gnus-install-group-spam-parameters
+ (defvar gnus-group-spam-classification-spam t
+ "Spam group classification (requires spam.el).
+This group contains spam messages. On summary entry, unread messages
+will be marked as spam. On summary exit, the specified spam
+processors will be invoked on spam-marked messages, then those
+messages will be expired, so the spam processor will only see a
+spam-marked message once.")
+
+ (defvar gnus-group-spam-classification-ham 'ask
+ "The ham value for the spam group parameter (requires spam.el).
+On summary exit, the specified ham processors will be invoked on
+ham-marked messages. Exercise caution, since the ham processor will
+see the same message more than once because there is no ham message
+registry.")
+
+ (gnus-define-group-parameter
+ spam-contents
+ :type list
+ :function-document
+ "The spam type (spam, ham, or neither) of the group."
+ :variable gnus-spam-newsgroup-contents
+ :variable-default nil
+ :variable-document
+ "*Groups in which to automatically mark new articles as spam on
+summary entry. If non-nil, this should be a list of group name
+regexps that should match all groups in which to do automatic spam
+tagging, associated with a classification (spam, ham, or neither).
+This only makes sense for mail groups."
+ :variable-group spam
+ :variable-type '(repeat
+ (list :tag "Group contents spam/ham classification"
+ (regexp :tag "Group")
+ (choice
+ (variable-item gnus-group-spam-classification-spam)
+ (variable-item gnus-group-spam-classification-ham)
+ (const :tag "Unclassified" nil))))
+
+ :parameter-type '(list :tag "Group contents spam/ham classification"
+ (choice :tag "Group contents classification for spam sorting"
+ (variable-item gnus-group-spam-classification-spam)
+ (variable-item gnus-group-spam-classification-ham)
+ (const :tag "Unclassified" nil)))
+ :parameter-document
+ "The spam classification (spam, ham, or neither) of this group.
+When a spam group is entered, all unread articles are marked as spam.")
+
+ (defvar gnus-group-spam-exit-processor-ifile "ifile"
+ "OBSOLETE: The ifile summary exit spam processor.")
+
+ (defvar gnus-group-spam-exit-processor-stat "stat"
+ "OBSOLETE: The spam-stat summary exit spam processor.")
+
+ (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
+ "OBSOLETE: The Bogofilter summary exit spam processor.")
+
+ (defvar gnus-group-spam-exit-processor-blacklist "blacklist"
+ "OBSOLETE: The Blacklist summary exit spam processor.")
+
+ (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
+ "OBSOLETE: The Gmane reporting summary exit spam processor.
+Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
+
+ (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
+ "OBSOLETE: The spamoracle summary exit spam processor.")
+
+ (defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
+ "OBSOLETE: The ifile summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
+ "OBSOLETE: The Bogofilter summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (defvar gnus-group-ham-exit-processor-stat "stat-ham"
+ "OBSOLETE: The spam-stat summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (defvar gnus-group-ham-exit-processor-whitelist "whitelist"
+ "OBSOLETE: The whitelist summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (defvar gnus-group-ham-exit-processor-BBDB "bbdb"
+ "OBSOLETE: The BBDB summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (defvar gnus-group-ham-exit-processor-copy "copy"
+ "OBSOLETE: The ham copy exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
+ "OBSOLETE: The spamoracle summary exit ham processor.
+Only applicable to non-spam (unclassified and ham) groups.")
+
+ (gnus-define-group-parameter
+ spam-process
+ :type list
+ :parameter-type
+ '(choice
+ :tag "Spam Summary Exit Processor"
+ :value nil
+ (list :tag "Spam Summary Exit Processor Choices"
+ (set
+ (variable-item gnus-group-spam-exit-processor-ifile)
+ (variable-item gnus-group-spam-exit-processor-stat)
+ (variable-item gnus-group-spam-exit-processor-bogofilter)
+ (variable-item gnus-group-spam-exit-processor-blacklist)
+ (variable-item gnus-group-spam-exit-processor-spamoracle)
+ (variable-item gnus-group-spam-exit-processor-report-gmane)
+ (variable-item gnus-group-ham-exit-processor-bogofilter)
+ (variable-item gnus-group-ham-exit-processor-ifile)
+ (variable-item gnus-group-ham-exit-processor-stat)
+ (variable-item gnus-group-ham-exit-processor-whitelist)
+ (variable-item gnus-group-ham-exit-processor-BBDB)
+ (variable-item gnus-group-ham-exit-processor-spamoracle)
+ (variable-item gnus-group-ham-exit-processor-copy)
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
+ :function-document
+ "Which spam or ham processors will be applied when the summary is exited."
+ :variable gnus-spam-process-newsgroups
+ :variable-default nil
+ :variable-document
+ "*Groups in which to automatically process spam or ham articles with
+a backend on summary exit. If non-nil, this should be a list of group
+name regexps that should match all groups in which to do automatic
+spam processing, associated with the appropriate processor."
+ :variable-group spam
+ :variable-type
+ '(repeat :tag "Spam/Ham Processors"
+ (list :tag "Spam Summary Exit Processor Choices"
+ (regexp :tag "Group Regexp")
+ (set
+ :tag "Spam/Ham Summary Exit Processor"
+ (variable-item gnus-group-spam-exit-processor-ifile)
+ (variable-item gnus-group-spam-exit-processor-stat)
+ (variable-item gnus-group-spam-exit-processor-bogofilter)
+ (variable-item gnus-group-spam-exit-processor-blacklist)
+ (variable-item gnus-group-spam-exit-processor-spamoracle)
+ (variable-item gnus-group-spam-exit-processor-report-gmane)
+ (variable-item gnus-group-ham-exit-processor-bogofilter)
+ (variable-item gnus-group-ham-exit-processor-ifile)
+ (variable-item gnus-group-ham-exit-processor-stat)
+ (variable-item gnus-group-ham-exit-processor-whitelist)
+ (variable-item gnus-group-ham-exit-processor-BBDB)
+ (variable-item gnus-group-ham-exit-processor-spamoracle)
+ (variable-item gnus-group-ham-exit-processor-copy)
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
+
+ :parameter-document
+ "Which spam or ham processors will be applied when the summary is exited.")
+
+ (gnus-define-group-parameter
+ spam-autodetect
+ :type list
+ :parameter-type
+ '(boolean :tag "Spam autodetection")
+ :function-document
+ "Should spam be autodetected (with spam-split) in this group?"
+ :variable gnus-spam-autodetect
+ :variable-default nil
+ :variable-document
+ "*Groups in which spam should be autodetected when they are entered.
+ Only unseen articles will be examined, unless
+ spam-autodetect-recheck-messages is set."
+ :variable-group spam
+ :variable-type
+ '(repeat
+ :tag "Autodetection setting"
+ (list
+ (regexp :tag "Group Regexp")
+ boolean))
+ :parameter-document
+ "Spam autodetection.
+Only unseen articles will be examined, unless
+spam-autodetect-recheck-messages is set.")
+
+ (gnus-define-group-parameter
+ spam-autodetect-methods
+ :type list
+ :parameter-type
+ '(choice :tag "Spam autodetection-specific methods"
+ (const none)
+ (const default)
+ (set :tag "Use specific methods"
+ (variable-item spam-use-blacklist)
+ (variable-item spam-use-regex-headers)
+ (variable-item spam-use-regex-body)
+ (variable-item spam-use-whitelist)
+ (variable-item spam-use-BBDB)
+ (variable-item spam-use-ifile)
+ (variable-item spam-use-spamoracle)
+ (variable-item spam-use-stat)
+ (variable-item spam-use-blackholes)
+ (variable-item spam-use-hashcash)
+ (variable-item spam-use-bogofilter-headers)
+ (variable-item spam-use-bogofilter)))
+ :function-document
+ "Methods to be used for autodetection in each group"
+ :variable gnus-spam-autodetect-methods
+ :variable-default nil
+ :variable-document
+ "*Methods for autodetecting spam per group.
+Requires the spam-autodetect parameter. Only unseen articles
+will be examined, unless spam-autodetect-recheck-messages is
+set."
+ :variable-group spam
+ :variable-type
+ '(repeat
+ :tag "Autodetection methods"
+ (list
+ (regexp :tag "Group Regexp")
+ (choice
+ (const none)
+ (const default)
+ (set :tag "Use specific methods"
+ (variable-item spam-use-blacklist)
+ (variable-item spam-use-regex-headers)
+ (variable-item spam-use-regex-body)
+ (variable-item spam-use-whitelist)
+ (variable-item spam-use-BBDB)
+ (variable-item spam-use-ifile)
+ (variable-item spam-use-spamoracle)
+ (variable-item spam-use-stat)
+ (variable-item spam-use-blackholes)
+ (variable-item spam-use-hashcash)
+ (variable-item spam-use-bogofilter-headers)
+ (variable-item spam-use-bogofilter)))))
+ :parameter-document
+ "Spam autodetection methods.
+Requires the spam-autodetect parameter. Only unseen articles
+will be examined, unless spam-autodetect-recheck-messages is
+set.")
+
+ (gnus-define-group-parameter
+ spam-process-destination
+ :type list
+ :parameter-type
+ '(choice :tag "Destination for spam-processed articles at summary exit"
+ (string :tag "Move to a group")
+ (repeat :tag "Move to multiple groups"
+ (string :tag "Destination group"))
+ (const :tag "Expire" nil))
+ :function-document
+ "Where spam-processed articles will go at summary exit."
+ :variable gnus-spam-process-destinations
+ :variable-default nil
+ :variable-document
+ "*Groups in which to explicitly send spam-processed articles to
+another group, or expire them (the default). If non-nil, this should
+be a list of group name regexps that should match all groups in which
+to do spam-processed article moving, associated with the destination
+group or nil for explicit expiration. This only makes sense for
+mail groups."
+ :variable-group spam
+ :variable-type
+ '(repeat
+ :tag "Spam-processed articles destination"
+ (list
+ (regexp :tag "Group Regexp")
+ (choice
+ :tag "Destination for spam-processed articles at summary exit"
+ (string :tag "Move to a group")
+ (repeat :tag "Move to multiple groups"
+ (string :tag "Destination group"))
+ (const :tag "Expire" nil))))
+ :parameter-document
+ "Where spam-processed articles will go at summary exit.")
+
+ (gnus-define-group-parameter
+ ham-process-destination
+ :type list
+ :parameter-type
+ '(choice
+ :tag "Destination for ham articles at summary exit from a spam group"
+ (string :tag "Move to a group")
+ (repeat :tag "Move to multiple groups"
+ (string :tag "Destination group"))
+ (const :tag "Respool" respool)
+ (const :tag "Do nothing" nil))
+ :function-document
+ "Where ham articles will go at summary exit from a spam group."
+ :variable gnus-ham-process-destinations
+ :variable-default nil
+ :variable-document
+ "*Groups in which to explicitly send ham articles to
+another group, or do nothing (the default). If non-nil, this should
+be a list of group name regexps that should match all groups in which
+to do ham article moving, associated with the destination
+group or nil for explicit ignoring. This only makes sense for
+mail groups, and only works in spam groups."
+ :variable-group spam
+ :variable-type
+ '(repeat
+ :tag "Ham articles destination"
+ (list
+ (regexp :tag "Group Regexp")
+ (choice
+ :tag "Destination for ham articles at summary exit from spam group"
+ (string :tag "Move to a group")
+ (repeat :tag "Move to multiple groups"
+ (string :tag "Destination group"))
+ (const :tag "Respool" respool)
+ (const :tag "Expire" nil))))
+ :parameter-document
+ "Where ham articles will go at summary exit from a spam group.")
+
+ (gnus-define-group-parameter
+ ham-marks
+ :type 'list
+ :parameter-type '(list :tag "Ham mark choices"
+ (set
+ (variable-item gnus-del-mark)
+ (variable-item gnus-read-mark)
+ (variable-item gnus-ticked-mark)
+ (variable-item gnus-killed-mark)
+ (variable-item gnus-kill-file-mark)
+ (variable-item gnus-low-score-mark)))
+
+ :parameter-document
+ "Marks considered ham (positively not spam). Such articles will be
+processed as ham (non-spam) on group exit. When nil, the global
+spam-ham-marks variable takes precedence."
+ :variable-default '((".*" ((gnus-del-mark
+ gnus-read-mark
+ gnus-killed-mark
+ gnus-kill-file-mark
+ gnus-low-score-mark))))
+ :variable-group spam
+ :variable-document
+ "*Groups in which to explicitly set the ham marks to some value.")
+
+ (gnus-define-group-parameter
+ spam-marks
+ :type 'list
+ :parameter-type '(list :tag "Spam mark choices"
+ (set
+ (variable-item gnus-spam-mark)
+ (variable-item gnus-killed-mark)
+ (variable-item gnus-kill-file-mark)
+ (variable-item gnus-low-score-mark)))
+
+ :parameter-document
+ "Marks considered spam.
+Such articles will be processed as spam on group exit. When nil, the global
+spam-spam-marks variable takes precedence."
+ :variable-default '((".*" ((gnus-spam-mark))))
+ :variable-group spam
+ :variable-document
+ "*Groups in which to explicitly set the spam marks to some value."))
(defcustom gnus-group-uncollapsed-levels 1
"Number of group name elements to leave alone when making a short group name."
@@ -1466,6 +2249,18 @@ and `grouplens-menu'."
(const pick-menu)
(const grouplens-menu)))
+;; Byte-compiler warning.
+(defvar gnus-visual)
+;; Find out whether the gnus-visual TYPE is wanted.
+(defun gnus-visual-p (&optional type class)
+ (and gnus-visual ; Has to be non-nil, at least.
+ (if (not type) ; We don't care about type.
+ gnus-visual
+ (if (listp gnus-visual) ; It's a list, so we check it.
+ (or (memq type gnus-visual)
+ (memq class gnus-visual))
+ t))))
+
(defcustom gnus-mouse-face
(condition-case ()
(if (gnus-visual-p 'mouse-face 'highlight)
@@ -1488,41 +2283,97 @@ face."
(defvar gnus-plugged t
"Whether Gnus is plugged or not.")
-(defcustom gnus-default-charset 'iso-8859-1
+(defcustom gnus-agent-cache t
+ "Controls use of the agent cache while plugged.
+When set, Gnus will prefer using the locally stored content rather
+than re-fetching it from the server. You also need to enable
+`gnus-agent' for this to have any affect."
+ :version "21.3"
+ :group 'gnus-agent
+ :type 'boolean)
+
+(defcustom gnus-default-charset 'undecided
"Default charset assumed to be used when viewing non-ASCII characters.
This variable is overridden on a group-to-group basis by the
-gnus-group-charset-alist variable and is only used on groups not
+`gnus-group-charset-alist' variable and is only used on groups not
covered by that variable."
:type 'symbol
:group 'gnus-charset)
-(defcustom gnus-default-posting-charset nil
- "Default charset assumed to be used when posting non-ASCII characters.
-This variable is overridden on a group-to-group basis by the
-gnus-group-posting-charset-alist variable and is only used on groups not
-covered by that variable.
-If nil, no default charset is assumed when posting."
- :type 'symbol
- :group 'gnus-charset)
+;; Fixme: Doc reference to agent.
+(defcustom gnus-agent t
+ "Whether we want to use the Gnus agent or not.
+
+You may customize gnus-agent to disable its use. However, some
+back ends have started to use the agent as a client-side cache.
+Disabling the agent may result in noticeable loss of performance."
+ :version "21.3"
+ :group 'gnus-agent
+ :type 'boolean)
+
+(defcustom gnus-other-frame-function 'gnus
+ "Function called by the command `gnus-other-frame'."
+ :group 'gnus-start
+ :type '(choice (function-item gnus)
+ (function-item gnus-no-server)
+ (function-item gnus-slave)
+ (function-item gnus-slave-no-server)))
+
+(defcustom gnus-other-frame-parameters nil
+ "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
+This should be an alist for Emacs, or a plist for XEmacs."
+ :group 'gnus-start
+ :type (if (featurep 'xemacs)
+ '(repeat (list :inline t :format "%v"
+ (symbol :tag "Property")
+ (sexp :tag "Value")))
+ '(repeat (cons :format "%v"
+ (symbol :tag "Parameter")
+ (sexp :tag "Value")))))
+
+(defcustom gnus-user-agent 'emacs-gnus-type
+ "Which information should be exposed in the User-Agent header.
+
+It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
+\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
+`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
+`emacs-gnus' plus system type\) or a custom string. If you set it to a
+string, be sure to use a valid format, see RFC 2616."
+ :group 'gnus-message
+ :type '(choice
+ (item :tag "Show Gnus and Emacs versions and system type"
+ emacs-gnus-type)
+ (item :tag "Show Gnus and Emacs versions and system configuration"
+ emacs-gnus-config)
+ (item :tag "Show Gnus and Emacs versions" emacs-gnus)
+ (item :tag "Show only Gnus version" gnus)
+ (string :tag "Other")))
;;; Internal variables
(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+(defvar gnus-agent-method-p-cache nil
+ ; Reset each time gnus-agent-covered-methods is changed else
+ ; gnus-agent-method-p may mis-report a methods status.
+ )
+(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
+(defvar gnus-draft-meta-information-header "X-Draft-From")
(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
(defvar gnus-ephemeral-servers nil)
-
-(defvar gnus-agent nil
- "Whether we want to use the Gnus agent or not.")
+(defvar gnus-server-method-cache nil)
(defvar gnus-agent-fetching nil
"Whether Gnus agent is in fetching mode.")
+(defvar gnus-agent-covered-methods nil
+ "A list of servers, NOT methods, showing which servers are covered by the agent.")
+
(defvar gnus-command-method nil
- "Dynamically bound variable that says what the current backend is.")
+ "Dynamically bound variable that says what the current back end is.")
(defvar gnus-current-select-method nil
"The current method for selecting a newsgroup.")
@@ -1560,7 +2411,7 @@ If nil, no default charset is assumed when posting."
,(nnheader-concat gnus-cache-directory "active"))))
"List of predefined (convenience) servers.")
-(defvar gnus-topic-indentation "");; Obsolete variable.
+(defvar gnus-topic-indentation "") ;; Obsolete variable.
(defconst gnus-article-mark-lists
'((marked . tick) (replied . reply)
@@ -1568,7 +2419,28 @@ If nil, no default charset is assumed when posting."
(bookmarks . bookmark) (dormant . dormant)
(scored . score) (saved . save)
(cached . cache) (downloadable . download)
- (unsendable . unsend)))
+ (unsendable . unsend) (forwarded . forward)
+ (recent . recent) (seen . seen)))
+
+(defconst gnus-article-special-mark-lists
+ '((seen range)
+ (killed range)
+ (bookmark tuple)
+ (score tuple)))
+
+;; Propagate flags to server, with the following exceptions:
+;; `seen' is private to each gnus installation
+;; `cache' is a internal gnus flag for each gnus installation
+;; `download' is a agent flag private to each gnus installation
+;; `unsend' are for nndraft groups only
+;; `score' is not a proper mark
+;; `bookmark': don't propagated it, or fix the bug in update-mark.
+(defconst gnus-article-unpropagated-mark-lists
+ '(seen cache download unsend score bookmark)
+ "Marks that shouldn't be propagated to back ends.
+Typical marks are those that make no sense in a standalone back end,
+such as a mark that says whether an article is stored in the cache
+\(which doesn't make sense in a standalone back end).")
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
@@ -1585,10 +2457,10 @@ If nil, no default charset is assumed when posting."
"The mail address of the Gnus maintainers.")
(defvar gnus-info-nodes
- '((gnus-group-mode "(gnus)The Group Buffer")
- (gnus-summary-mode "(gnus)The Summary Buffer")
- (gnus-article-mode "(gnus)The Article Buffer")
- (gnus-server-mode "(gnus)The Server Buffer")
+ '((gnus-group-mode "(gnus)Group Buffer")
+ (gnus-summary-mode "(gnus)Summary Buffer")
+ (gnus-article-mode "(gnus)Article Buffer")
+ (gnus-server-mode "(gnus)Server Buffer")
(gnus-browse-mode "(gnus)Browse Foreign Server")
(gnus-tree-mode "(gnus)Tree Display"))
"Alist of major modes and related Info nodes.")
@@ -1615,16 +2487,20 @@ If nil, no default charset is assumed when posting."
(defvar gnus-newsrc-alist nil
"Assoc list of read articles.
-gnus-newsrc-hashtb should be kept so that both hold the same information.")
+`gnus-newsrc-hashtb' should be kept so that both hold the same information.")
+
+(defvar gnus-registry-alist nil
+ "Assoc list of registry data.
+gnus-registry.el will populate this if it's loaded.")
(defvar gnus-newsrc-hashtb nil
- "Hashtable of gnus-newsrc-alist.")
+ "Hashtable of `gnus-newsrc-alist'.")
(defvar gnus-killed-list nil
"List of killed newsgroups.")
(defvar gnus-killed-hashtb nil
- "Hash table equivalent of gnus-killed-list.")
+ "Hash table equivalent of `gnus-killed-list'.")
(defvar gnus-zombie-list nil
"List of almost dead newsgroups.")
@@ -1654,6 +2530,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
"Regexp matching invalid groups.")
+(defvar gnus-other-frame-object nil
+ "A frame object which will be created by `gnus-other-frame'.")
+
;;; End of variables.
;; Define some autoload functions Gnus might use.
@@ -1704,6 +2583,9 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
gnus-demon-remove-handler)
("gnus-demon" :interactive t
gnus-demon-init gnus-demon-cancel)
+ ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from
+ gnus-convert-image-to-gray-x-face gnus-convert-face-to-png
+ gnus-face-from-file)
("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
@@ -1762,7 +2644,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
("gnus-msg" :interactive t
- gnus-group-post-news gnus-group-mail gnus-summary-post-news
+ gnus-group-post-news gnus-group-mail gnus-group-news
+ gnus-summary-post-news gnus-summary-news-other-window
gnus-summary-followup gnus-summary-followup-with-original
gnus-summary-cancel-article gnus-summary-supersede-article
gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
@@ -1773,13 +2656,10 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
gnus-summary-wide-reply-with-original
gnus-summary-post-forward gnus-summary-wide-reply-with-original
gnus-summary-post-forward)
- ("gnus-picon" :interactive t gnus-article-display-picons
- gnus-group-display-picons gnus-picons-article-display-x-face
- gnus-picons-display-x-face)
- ("gnus-picon" gnus-picons-buffer-name)
+ ("gnus-picon" :interactive t gnus-treat-from-picon)
("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
gnus-grouplens-mode)
- ("smiley" :interactive t gnus-smiley-display)
+ ("smiley" :interactive t smiley-region)
("gnus-win" gnus-configure-windows gnus-add-configuration)
("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
gnus-list-of-unread-articles gnus-list-of-read-articles
@@ -1809,11 +2689,11 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
gnus-article-de-base64-unreadable
gnus-article-decode-HZ
gnus-article-wash-html
- gnus-article-hide-pgp
+ gnus-article-unsplit-urls
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
- gnus-article-show-all-headers
+;; gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer
@@ -1835,20 +2715,23 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
("gnus-agent" gnus-open-agent gnus-agent-get-function
gnus-agent-save-groups gnus-agent-save-active gnus-agent-method-p
gnus-agent-get-undownloaded-list gnus-agent-fetch-session
- gnus-summary-set-agent-mark gnus-agent-save-group-info)
+ gnus-summary-set-agent-mark gnus-agent-save-group-info
+ gnus-agent-request-article gnus-agent-retrieve-headers)
("gnus-agent" :interactive t
gnus-unplugged gnus-agentize gnus-agent-batch)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm)
- ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts)
+ ("compface" uncompface)
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
("gnus-mlspl" :interactive t gnus-group-split-setup
- gnus-group-split-update))))
+ gnus-group-split-update)
+ ("gnus-delay" gnus-delay-initialize))))
;;; gnus-sum.el thingies
-(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
+(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
"*The format specification of the lines in the summary buffer.
It works along the same lines as a normal formatting string,
@@ -1865,11 +2748,16 @@ with some simple extensions.
%x Contents of the Xref: header (string)
%D Date of the article (string)
%d Date of the article (string) in DD-MMM format
+%o Date of the article (string) in YYYYMMDD`T'HHMMSS format
%M Message-id of the article (string)
%r References of the article (string)
%c Number of characters in the article (integer)
+%k Pretty-printed version of the above (string)
+ For example, \"1.2k\" or \"0.4M\".
%L Number of lines in the article (integer)
%I Indentation based on thread level (a string of spaces)
+%B A complex trn-style thread tree (string)
+ The variables `gnus-sum-thread-*' can be used for customization.
%T A string with two possible values: 80 spaces if the article
is on thread level two or larger and 0 spaces on level one
%R \"A\" if this article has been replied to, \" \" otherwise (character)
@@ -1886,6 +2774,8 @@ with some simple extensions.
%V Total thread score (number).
%P The line number (number).
%O Download mark (character).
+%* If present, indicates desired cursor position
+ (instead of after first colon).
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
@@ -1893,10 +2783,6 @@ with some simple extensions.
will be inserted into the summary just like information from any other
summary specifier.
-Text between %( and %) will be highlighted with `gnus-mouse-face'
-when the mouse point is placed inside the area. There can only be one
-such area.
-
The %U (status), %R (replied) and %z (zcore) specs have to be handled
with care. For reasons of efficiency, Gnus will compute what column
these characters will end up in, and \"hard-code\" that. This means that
@@ -1904,10 +2790,14 @@ it is invalid to have these specs after a variable-length spec. Well,
you might not be arrested, but your summary buffer will look strange,
which is bad enough.
-The smart choice is to have these specs as for to the left as
+The smart choice is to have these specs as far to the left as
possible.
-This restriction may disappear in later versions of Gnus."
+This restriction may disappear in later versions of Gnus.
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
:type 'string
:group 'gnus-summary-format)
@@ -1951,6 +2841,12 @@ This restriction may disappear in later versions of Gnus."
"Get hash value of STRING in HASHTABLE."
`(symbol-value (intern-soft ,string ,hashtable)))
+(defmacro gnus-gethash-safe (string hashtable)
+ "Get hash value of STRING in HASHTABLE.
+Return nil if not defined."
+ `(let ((sym (intern-soft ,string ,hashtable)))
+ (and (boundp sym) (symbol-value sym))))
+
(defmacro gnus-sethash (string value hashtable)
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
`(set (intern ,string ,hashtable) ,value))
@@ -2036,18 +2932,6 @@ This restriction may disappear in later versions of Gnus."
(defmacro gnus-get-info (group)
`(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
-;; Byte-compiler warning.
-(defvar gnus-visual)
-;; Find out whether the gnus-visual TYPE is wanted.
-(defun gnus-visual-p (&optional type class)
- (and gnus-visual ; Has to be non-nil, at least.
- (if (not type) ; We don't care about type.
- gnus-visual
- (if (listp gnus-visual) ; It's a list, so we check it.
- (or (memq type gnus-visual)
- (memq class gnus-visual))
- t))))
-
;;; Load the compatibility functions.
(require 'gnus-ems)
@@ -2076,6 +2960,21 @@ This restriction may disappear in later versions of Gnus."
;;; Gnus Utility Functions
;;;
+(defun gnus-find-subscribed-addresses ()
+ "Return a regexp matching the addresses of all subscribed mail groups.
+It consists of the `to-address' or `to-list' parameter of all groups
+with a `subscribed' parameter."
+ (let (group address addresses)
+ (dolist (entry (cdr gnus-newsrc-alist))
+ (setq group (car entry))
+ (when (gnus-parameter-subscribed group)
+ (setq address (mail-strip-quoted-names
+ (or (gnus-group-fast-parameter group 'to-address)
+ (gnus-group-fast-parameter group 'to-list))))
+ (when address
+ (add-to-list 'addresses address))))
+ (when addresses
+ (list (mapconcat 'regexp-quote addresses "\\|")))))
(defmacro gnus-string-or (&rest strings)
"Return the first element of STRINGS that is a non-blank string.
@@ -2099,8 +2998,11 @@ If ARG, insert string at point."
(insert (message gnus-version))
(message gnus-version)))
-(defun gnus-continuum-version (version)
+(defun gnus-continuum-version (&optional version)
"Return VERSION as a floating point number."
+ (interactive)
+ (unless version
+ (setq version gnus-version))
(when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
(string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
(let ((alpha (and (match-beginning 1) (match-string 1 version)))
@@ -2116,23 +3018,23 @@ If ARG, insert string at point."
0))
(string-to-number
(if (zerop major)
- (format "%s00%02d%02d"
- (if (member alpha '("(ding)" "d"))
- "4.99"
- (+ 5 (* 0.02
- (abs
- (- (mm-char-int (aref (downcase alpha) 0))
- (mm-char-int ?t))))
- -0.01))
- minor least)
+ (format "%s00%02d%02d"
+ (if (member alpha '("(ding)" "d"))
+ "4.99"
+ (+ 5 (* 0.02
+ (abs
+ (- (mm-char-int (aref (downcase alpha) 0))
+ (mm-char-int ?t))))
+ -0.01))
+ minor least)
(format "%d.%02d%02d" major minor least))))))
-(defun gnus-info-find-node ()
+(defun gnus-info-find-node (&optional nodename)
"Find Info documentation of Gnus."
(interactive)
;; Enlarge info window if needed.
(let (gnus-info-buffer)
- (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
+ (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes))))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
@@ -2274,30 +3176,6 @@ that that variable is buffer-local to the summary buffers."
(let ((group (or group gnus-newsgroup-name)))
(not (gnus-check-backend-function 'request-replace-article group))))
-(defun gnus-group-total-expirable-p (group)
- "Check whether GROUP is total-expirable or not."
- (let ((params (gnus-group-find-parameter group))
- val)
- (cond
- ((memq 'total-expire params)
- t)
- ((setq val (assq 'total-expire params)) ; (auto-expire . t)
- (cdr val))
- (gnus-total-expirable-newsgroups ; Check var.
- (string-match gnus-total-expirable-newsgroups group)))))
-
-(defun gnus-group-auto-expirable-p (group)
- "Check whether GROUP is auto-expirable or not."
- (let ((params (gnus-group-find-parameter group))
- val)
- (cond
- ((memq 'auto-expire params)
- t)
- ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
- (cdr val))
- (gnus-auto-expirable-newsgroups ; Check var.
- (string-match gnus-auto-expirable-newsgroups group)))))
-
(defun gnus-virtual-group-p (group)
"Say whether GROUP is virtual or not."
(memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
@@ -2305,16 +3183,18 @@ that that variable is buffer-local to the summary buffers."
(defun gnus-news-group-p (group &optional article)
"Return non-nil if GROUP (and ARTICLE) come from a news server."
- (or (gnus-member-of-valid 'post group) ; Ordinary news group.
- (and (gnus-member-of-valid 'post-mail group) ; Combined group.
- (if (or (null article)
- (not (< article 0)))
- (eq (gnus-request-type group article) 'news)
- (if (not (vectorp article))
- nil
- ;; It's a real article.
- (eq (gnus-request-type group (mail-header-id article))
- 'news))))))
+ (cond ((gnus-member-of-valid 'post group) ;Ordinary news group
+ t) ;is news of course.
+ ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined.
+ nil) ;must be mail then.
+ ((vectorp article) ;Has header info.
+ (eq (gnus-request-type group (mail-header-id article)) 'news))
+ ((null article) ;Hasn't header info
+ (eq (gnus-request-type group) 'news)) ;(unknown ==> mail)
+ ((< article 0) ;Virtual message
+ nil) ;we don't know, guess mail.
+ (t ;Has positive number
+ (eq (gnus-request-type group article) 'news)))) ;use it.
;; Returns a list of writable groups.
(defun gnus-writable-groups ()
@@ -2376,6 +3256,85 @@ that that variable is buffer-local to the summary buffers."
(nth 1 method))))
method)))
+(defsubst gnus-server-to-method (server)
+ "Map virtual server names to select methods."
+ (or (and server (listp server) server)
+ (cdr (assoc server gnus-server-method-cache))
+ (let ((result
+ (or
+ ;; Perhaps this is the native server?
+ (and (equal server "native") gnus-select-method)
+ ;; It should be in the server alist.
+ (cdr (assoc server gnus-server-alist))
+ ;; It could be in the predefined server alist.
+ (cdr (assoc server gnus-predefined-server-alist))
+ ;; If not, we look through all the opened server
+ ;; to see whether we can find it there.
+ (let ((opened gnus-opened-servers))
+ (while (and opened
+ (not (equal server (format "%s:%s" (caaar opened)
+ (cadaar opened)))))
+ (pop opened))
+ (caar opened))
+ ;; It could be a named method, search all servers
+ (let ((servers gnus-secondary-select-methods))
+ (while (and servers
+ (not (equal server (format "%s:%s" (caar servers)
+ (cadar servers)))))
+ (pop servers))
+ (car servers))
+ ;; This could be some sort of foreign server that I
+ ;; simply haven't opened (yet). Do a brute-force scan
+ ;; of the entire gnus-newsrc-alist for the server name
+ ;; of every method. As a side-effect, loads the
+ ;; gnus-server-method-cache so this only happens once,
+ ;; if at all.
+ (let (match)
+ (mapcar
+ (lambda (info)
+ (let ((info-method (gnus-info-method info)))
+ (unless (stringp info-method)
+ (let ((info-server (gnus-method-to-server info-method)))
+ (when (equal server info-server)
+ (setq match info-method))))))
+ (cdr gnus-newsrc-alist))
+ match))))
+ (when result
+ (push (cons server result) gnus-server-method-cache))
+ result)))
+
+(defsubst gnus-method-to-server (method)
+ (catch 'server-name
+ (setq method (or method gnus-select-method))
+
+ ;; Perhaps it is already in the cache.
+ (mapc (lambda (name-method)
+ (if (equal (cdr name-method) method)
+ (throw 'server-name (car name-method))))
+ gnus-server-method-cache)
+
+ (mapc
+ (lambda (server-alist)
+ (mapc (lambda (name-method)
+ (when (gnus-methods-equal-p (cdr name-method) method)
+ (unless (member name-method gnus-server-method-cache)
+ (push name-method gnus-server-method-cache))
+ (throw 'server-name (car name-method))))
+ server-alist))
+ (let ((alists (list gnus-server-alist
+ gnus-predefined-server-alist)))
+ (if gnus-select-method
+ (push (list (cons "native" gnus-select-method)) alists))
+ alists))
+
+ (let* ((name (if (member (cadr method) '(nil ""))
+ (format "%s" (car method))
+ (format "%s:%s" (car method) (cadr method))))
+ (name-method (cons name method)))
+ (unless (member name-method gnus-server-method-cache)
+ (push name-method gnus-server-method-cache))
+ name)))
+
(defsubst gnus-server-get-method (group method)
;; Input either a server name, and extended server name, or a
;; select method, and return a select method.
@@ -2393,33 +3352,6 @@ that that variable is buffer-local to the summary buffers."
(t
(gnus-server-add-address method))))
-(defun gnus-server-to-method (server)
- "Map virtual server names to select methods."
- (or
- ;; Is this a method, perhaps?
- (and server (listp server) server)
- ;; Perhaps this is the native server?
- (and (equal server "native") gnus-select-method)
- ;; It should be in the server alist.
- (cdr (assoc server gnus-server-alist))
- ;; It could be in the predefined server alist.
- (cdr (assoc server gnus-predefined-server-alist))
- ;; If not, we look through all the opened server
- ;; to see whether we can find it there.
- (let ((opened gnus-opened-servers))
- (while (and opened
- (not (equal server (format "%s:%s" (caaar opened)
- (cadaar opened)))))
- (pop opened))
- (caar opened))
- ;; It could be a named method, search all servers
- (let ((servers gnus-secondary-select-methods))
- (while (and servers
- (not (equal server (format "%s:%s" (caar servers)
- (cadar servers)))))
- (pop servers))
- (car servers))))
-
(defmacro gnus-method-equal (ss1 ss2)
"Say whether two servers are equal."
`(let ((s1 ,ss1)
@@ -2474,27 +3406,77 @@ that that variable is buffer-local to the summary buffers."
(and active
(file-exists-p active))))))
-(defun gnus-group-prefixed-name (group method)
- "Return the whole name from GROUP and METHOD."
- (and (stringp method) (setq method (gnus-server-to-method method)))
+(defsubst gnus-method-to-server-name (method)
+ (concat
+ (format "%s" (car method))
+ (when (and
+ (or (assoc (format "%s" (car method))
+ (gnus-methods-using 'address))
+ (gnus-server-equal method gnus-message-archive-method))
+ (nth 1 method)
+ (not (string= (nth 1 method) "")))
+ (concat "+" (nth 1 method)))))
+
+(defsubst gnus-method-to-full-server-name (method)
+ (format "%s+%s" (car method) (nth 1 method)))
+
+(defun gnus-group-prefixed-name (group method &optional full)
+ "Return the whole name from GROUP and METHOD.
+Call with full set to get the fully qualified group name (even if the
+server is native)."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(if (or (not method)
- (gnus-server-equal method "native"))
+ (and (not full) (gnus-server-equal method "native"))
+ ;;;!!! This might not be right. We'll see...
+ ;(string-match ":" group)
+ )
group
- (concat (format "%s" (car method))
- (when (and
- (or (assoc (format "%s" (car method))
- (gnus-methods-using 'address))
- (gnus-server-equal method gnus-message-archive-method))
- (nth 1 method)
- (not (string= (nth 1 method) "")))
- (concat "+" (nth 1 method)))
- ":" group)))
+ (concat (gnus-method-to-server-name method) ":" group)))
+
+(defun gnus-group-guess-prefixed-name (group)
+ "Guess the whole name from GROUP and METHOD."
+ (gnus-group-prefixed-name group (gnus-find-method-for-group
+ group)))
+
+(defun gnus-group-full-name (group method)
+ "Return the full name from GROUP and METHOD, even if the method is native."
+ (gnus-group-prefixed-name group method t))
+
+(defun gnus-group-guess-full-name (group)
+ "Guess the full name from GROUP, even if the method is native."
+ (if (gnus-group-prefixed-p group)
+ group
+ (gnus-group-full-name group (gnus-find-method-for-group group))))
+
+(defun gnus-group-guess-full-name-from-command-method (group)
+ "Guess the full name from GROUP, even if the method is native."
+ (if (gnus-group-prefixed-p group)
+ group
+ (gnus-group-full-name group gnus-command-method)))
(defun gnus-group-real-prefix (group)
"Return the prefix of the current group name."
- (if (string-match "^[^:]+:" group)
- (substring group 0 (match-end 0))
- ""))
+ (if (stringp group)
+ (if (string-match "^[^:]+:" group)
+ (substring group 0 (match-end 0))
+ "")
+ nil))
+
+(defun gnus-group-short-name (group)
+ "Return the short group name."
+ (let ((prefix (gnus-group-real-prefix group)))
+ (if (< 0 (length prefix))
+ (substring group (length prefix) nil)
+ group)))
+
+(defun gnus-group-prefixed-p (group)
+ "Return the prefix of the current group name."
+ (< 0 (length (gnus-group-real-prefix group))))
+
+(defun gnus-summary-buffer-name (group)
+ "Return the summary buffer name of GROUP."
+ (concat "*Summary " (gnus-group-decoded-name group) "*"))
(defun gnus-group-method (group)
"Return the server or method used for selecting GROUP.
@@ -2528,10 +3510,10 @@ You should probably use `gnus-find-method-for-group' instead."
(defsubst gnus-secondary-method-p (method)
"Return whether METHOD is a secondary select method."
(let ((methods gnus-secondary-select-methods)
- (gmethod (gnus-server-get-method nil method)))
+ (gmethod (inline (gnus-server-get-method nil method))))
(while (and methods
(not (gnus-method-equal
- (gnus-server-get-method nil (car methods))
+ (inline (gnus-server-get-method nil (car methods)))
gmethod)))
(setq methods (cdr methods)))
methods))
@@ -2569,15 +3551,88 @@ You should probably use `gnus-find-method-for-group' instead."
"Say whether the group is secondary or not."
(gnus-secondary-method-p (gnus-find-method-for-group group)))
+(defun gnus-parameters-get-parameter (group)
+ "Return the group parameters for GROUP from `gnus-parameters'."
+ (let (params-list)
+ (dolist (elem gnus-parameters)
+ (when (string-match (car elem) group)
+ (setq params-list
+ (nconc (gnus-expand-group-parameters
+ (car elem) (cdr elem) group)
+ params-list))))
+ params-list))
+
+(defun gnus-expand-group-parameter (match value group)
+ "Use MATCH to expand VALUE in GROUP."
+ (with-temp-buffer
+ (insert group)
+ (goto-char (point-min))
+ (while (re-search-forward match nil t)
+ (replace-match value))
+ (buffer-string)))
+
+(defun gnus-expand-group-parameters (match parameters group)
+ "Go through PARAMETERS and expand them according to the match data."
+ (let (new)
+ (dolist (elem parameters)
+ (if (and (stringp (cdr elem))
+ (string-match "\\\\[0-9&]" (cdr elem)))
+ (push (cons (car elem)
+ (gnus-expand-group-parameter match (cdr elem) group))
+ new)
+ (push elem new)))
+ new))
+
+(defun gnus-group-fast-parameter (group symbol &optional allow-list)
+ "For GROUP, return the value of SYMBOL.
+
+You should call this in the `gnus-group-buffer' buffer.
+The function `gnus-group-find-parameter' will do that for you."
+ ;; The speed trick: No cons'ing and quit early.
+ (let* ((params (funcall gnus-group-get-parameter-function group))
+ ;; Start easy, check the "real" group parameters.
+ (simple-results
+ (gnus-group-parameter-value params symbol allow-list t)))
+ (if simple-results
+ ;; Found results; return them.
+ (car simple-results)
+ ;; We didn't found it there, try `gnus-parameters'.
+ (let ((result nil)
+ (head nil)
+ (tail gnus-parameters))
+ ;; A good old-fashioned non-cl loop.
+ (while tail
+ (setq head (car tail)
+ tail (cdr tail))
+ ;; The car is regexp matching for matching the group name.
+ (when (string-match (car head) group)
+ ;; The cdr is the parameters.
+ (setq result (gnus-group-parameter-value (cdr head)
+ symbol allow-list))
+ (when result
+ ;; Expand if necessary.
+ (if (and (stringp result) (string-match "\\\\[0-9&]" result))
+ (setq result (gnus-expand-group-parameter (car head)
+ result group)))
+ ;; Exit the loop early.
+ (setq tail nil))))
+ ;; Done.
+ result))))
+
(defun gnus-group-find-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters."
+If SYMBOL, return the value of that symbol in the group parameters.
+
+If you call this function inside a loop, consider using the faster
+`gnus-group-fast-parameter' instead."
(save-excursion
(set-buffer gnus-group-buffer)
- (let ((parameters (funcall gnus-group-get-parameter-function group)))
- (if symbol
- (gnus-group-parameter-value parameters symbol allow-list)
- parameters))))
+ (if symbol
+ (gnus-group-fast-parameter group symbol allow-list)
+ (nconc
+ (copy-sequence
+ (funcall gnus-group-get-parameter-function group))
+ (gnus-parameters-get-parameter group)))))
(defun gnus-group-get-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
@@ -2589,7 +3644,8 @@ also examines the topic parameters."
(gnus-group-parameter-value params symbol allow-list)
params)))
-(defun gnus-group-parameter-value (params symbol &optional allow-list)
+(defun gnus-group-parameter-value (params symbol &optional
+ allow-list present-p)
"Return the value of SYMBOL in group PARAMS."
;; We only wish to return group parameters (dotted lists) and
;; not local variables, which may have the same names.
@@ -2603,7 +3659,8 @@ also examines the topic parameters."
(eq (car elem) symbol)
(or allow-list
(atom (cdr elem))))
- (throw 'found (cdr elem))))))))
+ (throw 'found (if present-p (list (cdr elem))
+ (cdr elem)))))))))
(defun gnus-group-add-parameter (group param)
"Add parameter PARAM to GROUP."
@@ -2662,7 +3719,7 @@ just the host name."
depth (+ depth 1)))
depth))))
;; Separate foreign select method from group name and collapse.
- ;; If method contains a server, collapse to non-domain server name,
+ ;; If method contains a server, collapse to non-domain server name,
;; otherwise collapse to select method.
(let* ((colon (string-match ":" group))
(server (and colon (substring group 0 colon)))
@@ -2809,12 +3866,21 @@ If NEWSGROUP is nil, return the global kill file name instead."
(list (intern server) "")))
gnus-select-method))
+(defun gnus-server-string (server)
+ "Return a readable string that describes SERVER."
+ (let* ((server (gnus-server-to-method server))
+ (address (nth 1 server)))
+ (if (and address
+ (not (zerop (length address))))
+ (format "%s using %s" address (car server))
+ (format "%s" (car server)))))
+
(defun gnus-find-method-for-group (group &optional info)
"Find the select method that GROUP uses."
(or gnus-override-method
(and (not group)
gnus-select-method)
- (and (not (gnus-group-entry group));; a new group
+ (and (not (gnus-group-entry group)) ;; a new group
(gnus-group-name-to-method group))
(let ((info (or info (gnus-get-info group)))
method)
@@ -2857,18 +3923,40 @@ Disallow invalid group names."
(setq group (read-string (concat prefix prompt)
(cons (or default "") 0)
'gnus-group-history)))
- (setq prefix (format "Invalid group name: \"%s\". " group)
- group nil)))
+ (let ((match (match-string 0 group)))
+ ;; Might be okay (e.g. for nnimap), so ask the user:
+ (unless (and (not (string-match "^$\\|:" match))
+ (message-y-or-n-p
+ "Proceed and create group anyway? " t
+"The group name \"" group "\" contains a forbidden character: \"" match "\".
+
+Usually, it's dangerous to create a group with this name, because it's not
+supported by all back ends and servers. On IMAP servers it should work,
+though. If you are really sure, you can proceed anyway and create the group.
+
+You may customize the variable `gnus-invalid-group-regexp', which currently is
+set to \"" gnus-invalid-group-regexp
+"\", if you want to get rid of this query permanently."))
+ (setq prefix (format "Invalid group name: \"%s\". " group)
+ group nil)))))
group))
(defun gnus-read-method (prompt)
"Prompt the user for a method.
Allow completion over sensible values."
- (let* ((servers
- (append gnus-valid-select-methods
- (mapcar (lambda (i) (list (format "%s:%s" (caar i)
- (cadar i))))
- gnus-opened-servers)
+ (let* ((open-servers
+ (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
+ gnus-opened-servers))
+ (valid-methods
+ (let (methods)
+ (dolist (method gnus-valid-select-methods)
+ (if (or (memq 'prompt-address method)
+ (not (assoc (format "%s:" (car method)) open-servers)))
+ (push method methods)))
+ methods))
+ (servers
+ (append valid-methods
+ open-servers
gnus-predefined-server-alist
gnus-server-alist))
(method
@@ -2883,35 +3971,48 @@ Allow completion over sensible values."
(assoc method gnus-valid-select-methods))
(read-string "Address: ")
"")))
- (or (let ((opened gnus-opened-servers))
- (while (and opened
- (not (equal (format "%s:%s" method address)
- (format "%s:%s" (caaar opened)
- (cadaar opened)))))
- (pop opened))
- (caar opened))
+ (or (cadr (assoc (format "%s:%s" method address) open-servers))
(list (intern method) address))))
((assoc method servers)
method)
(t
(list (intern method) "")))))
+;;; Agent functions
+
+(defun gnus-agent-method-p (method)
+ "Say whether METHOD is covered by the agent."
+ (or (eq (car gnus-agent-method-p-cache) method)
+ (setq gnus-agent-method-p-cache
+ (cons method
+ (member (if (stringp method)
+ method
+ (gnus-method-to-server method)) gnus-agent-covered-methods))))
+ (cdr gnus-agent-method-p-cache))
+
+(defun gnus-online (method)
+ (not
+ (if gnus-plugged
+ (eq (cadr (assoc method gnus-opened-servers)) 'offline)
+ (gnus-agent-method-p method))))
+
;;; User-level commands.
;;;###autoload
(defun gnus-slave-no-server (&optional arg)
- "Read network news as a slave, without connecting to local server."
+ "Read network news as a slave, without connecting to the local server."
(interactive "P")
(gnus-no-server arg t))
;;;###autoload
(defun gnus-no-server (&optional arg slave)
"Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server."
+If ARG is a positive number, Gnus will use that as the startup
+level. If ARG is nil, Gnus will be started at level 2. If ARG is
+non-nil and not a positive number, Gnus will prompt the user for the
+name of an NNTP server to use.
+As opposed to `gnus', this command will not connect to the local
+server."
(interactive "P")
(gnus-no-server-1 arg slave))
@@ -2922,15 +4023,51 @@ As opposed to `gnus', this command will not connect to the local server."
(gnus arg nil 'slave))
;;;###autoload
-(defun gnus-other-frame (&optional arg)
- "Pop up a frame to read news."
+(defun gnus-other-frame (&optional arg display)
+ "Pop up a frame to read news.
+This will call one of the Gnus commands which is specified by the user
+option `gnus-other-frame-function' (default `gnus') with the argument
+ARG if Gnus is not running, otherwise just pop up a Gnus frame. The
+optional second argument DISPLAY should be a standard display string
+such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is
+omitted or the function `make-frame-on-display' is not available, the
+current display is used."
(interactive "P")
- (let ((window (get-buffer-window gnus-group-buffer)))
- (cond (window
- (select-frame (window-frame window)))
- (t
- (select-frame (make-frame)))))
- (gnus arg))
+ (if (fboundp 'make-frame-on-display)
+ (unless display
+ (setq display (gnus-frame-or-window-display-name (selected-frame))))
+ (setq display nil))
+ (let ((alive (gnus-alive-p)))
+ (unless (and alive
+ (catch 'found
+ (walk-windows
+ (lambda (window)
+ (when (and (or (not display)
+ (equal display
+ (gnus-frame-or-window-display-name
+ window)))
+ (with-current-buffer (window-buffer window)
+ (string-match "\\`gnus-"
+ (symbol-name major-mode))))
+ (gnus-select-frame-set-input-focus
+ (setq gnus-other-frame-object (window-frame window)))
+ (select-window window)
+ (throw 'found t)))
+ 'ignore t)))
+ (gnus-select-frame-set-input-focus
+ (setq gnus-other-frame-object
+ (if display
+ (make-frame-on-display display gnus-other-frame-parameters)
+ (make-frame gnus-other-frame-parameters))))
+ (if alive
+ (switch-to-buffer gnus-group-buffer)
+ (funcall gnus-other-frame-function arg)
+ (add-hook 'gnus-exit-gnus-hook
+ '(lambda nil
+ (when (and (frame-live-p gnus-other-frame-object)
+ (cdr (frame-list)))
+ (delete-frame gnus-other-frame-object))
+ (setq gnus-other-frame-object nil)))))))
;;(setq thing ? ; this is a comment
;; more 'yes)
@@ -2939,9 +4076,12 @@ As opposed to `gnus', this command will not connect to the local server."
(defun gnus (&optional arg dont-connect slave)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
+startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use."
(interactive "P")
+ (unless (byte-code-function-p (symbol-function 'gnus))
+ (message "You should byte-compile Gnus")
+ (sit-for 2))
(gnus-1 arg dont-connect slave))
;; Allow redefinition of Gnus functions.
diff --git a/lisp/gnus/gnus.xbm b/lisp/gnus/gnus.xbm
new file mode 100644
index 00000000000..58d1ac845aa
--- /dev/null
+++ b/lisp/gnus/gnus.xbm
@@ -0,0 +1,622 @@
+#define noname_width 271
+#define noname_height 273
+static char noname_bits[] = {
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfa,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x49,0xe0,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x97,0xaa,0x8a,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x57,0x2a,0x41,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa9,0x52,0x16,0xfe,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4a,0x49,0x05,
+ 0xf9,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0x95,0xaa,0x58,0xf4,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x7f,0xa5,0x54,0x26,0xe1,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x54,0x49,0x49,0xe4,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x2a,0xa5,
+ 0x2a,0xd1,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0xd5,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xaf,0x52,0x95,0x54,0xc4,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,
+ 0x24,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x57,0x29,0xa9,0x92,0x11,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x57,0xd5,0xfa,0xff,0xff,0xab,0xea,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x4a,0x55,0x2a,0x41,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x25,0x29,0xe5,0xff,0xff,0x95,0xa4,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa7,0xa4,
+ 0x24,0xa5,0x14,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4a,0xa5,0xd4,0xff,
+ 0x3f,0x52,0xa9,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x29,0x55,0x55,0x55,0x41,0x7e,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xa9,0x54,0xea,0xff,0xdf,0x2a,0x55,0xf1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x55,0x55,0x4a,0x49,0x12,0x7e,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0x55,0xa5,0x92,0xff,0x23,0xa5,0x4a,0xd6,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa5,0xa4,0x94,0xaa,0x42,
+ 0x7d,0xff,0xff,0xff,0xff,0xff,0xff,0x9f,0x4a,0x2a,0xa9,0xff,0xad,0x92,0x24,
+ 0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2a,
+ 0x95,0x52,0x52,0x29,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x52,0x49,0x55,
+ 0xfe,0x91,0x54,0x55,0x55,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0x49,0x29,0x55,0x25,0x85,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x4f,0x95,0xaa,0x92,0x7e,0x55,0x55,0xa9,0x4a,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2a,0x50,0x95,0xaa,0x24,0x7e,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x57,0x2a,0x95,0x54,0x79,0x95,0x92,0x92,0x94,0xfc,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xb9,0x62,0x29,0x49,
+ 0x85,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x49,0x49,0x95,0xba,0xa4,0x54,
+ 0xaa,0x52,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,
+ 0x1a,0xf8,0xa7,0xaa,0x22,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0x55,0x52,
+ 0x2a,0x75,0x55,0xa5,0x24,0xa5,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xbf,0x5a,0xfd,0x57,0x92,0x94,0x7e,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x4a,0x4a,0x55,0x49,0x89,0x92,0x94,0xaa,0x94,0xf4,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x1a,0xfc,0x2f,0x55,0x05,0x7c,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x55,0xa9,0x4a,0x55,0x2a,0x55,0x55,0x55,0x55,0xe5,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x4e,0xfd,0x5f,
+ 0x29,0xa5,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0xa4,0x54,0x52,0x4a,0x55,0xa9,
+ 0xa4,0x24,0xa5,0x94,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x2f,0x1d,0xfe,0x3f,0x95,0x04,0x7c,0xff,0xfd,0xff,0xff,0xff,0x3f,0x49,0xa5,
+ 0x54,0xa9,0xa4,0x92,0x4a,0x49,0x4a,0x55,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xaf,0x44,0xfe,0x5f,0xa9,0x52,0x7d,0xff,0xe5,0xff,0xff,
+ 0xff,0x5f,0x55,0x92,0x2a,0x95,0x52,0x4a,0x52,0xaa,0x52,0x4a,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x16,0xff,0xbf,0x4a,0x05,0x7c,
+ 0xff,0xd9,0xff,0xff,0xff,0x5f,0x95,0x42,0xa5,0x52,0x95,0xaa,0xaa,0xaa,0x94,
+ 0x54,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x43,0xfe,
+ 0xbf,0x54,0x52,0x7d,0x7f,0x25,0xff,0xff,0xff,0xa7,0xa4,0x28,0x92,0x54,0x4a,
+ 0xa5,0x4a,0x92,0xaa,0x4a,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xab,0x12,0xfe,0x7f,0xa5,0x02,0x7c,0x7f,0x55,0xfd,0xff,0xff,0x95,0x2a,
+ 0x82,0x54,0xa5,0x54,0x2a,0xa9,0x2a,0xa5,0x52,0xf5,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x27,0x4b,0xff,0xff,0x4a,0x29,0x7d,0xff,0x92,0xfe,
+ 0xff,0xff,0x55,0x92,0x20,0xa8,0x94,0x2a,0xa5,0x94,0x52,0x29,0xa9,0xf4,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x01,0xff,0x7f,0x52,0x42,
+ 0x7c,0xff,0x25,0xf9,0xff,0x7f,0xaa,0x02,0x8a,0x40,0x29,0x49,0x09,0x41,0x4a,
+ 0x55,0x25,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x57,
+ 0xff,0xff,0x95,0x12,0x7d,0xff,0xa9,0xfa,0xff,0x7f,0x25,0xa9,0x20,0x2a,0xa5,
+ 0xaa,0x42,0x92,0x54,0x92,0x54,0x95,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xaf,0x83,0xff,0xff,0xa9,0x42,0x7e,0xff,0xaa,0xf4,0xff,0xaf,0x54,
+ 0x01,0x82,0x80,0xaa,0x54,0x14,0x08,0xa2,0xaa,0x4a,0xd2,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xef,0xcf,0xd7,0xff,0xff,0x52,0x12,0x7f,0xff,0x4a,
+ 0xea,0xff,0x57,0x92,0xaa,0x28,0x24,0x29,0x25,0x81,0x82,0x08,0x49,0x52,0x55,
+ 0xff,0xff,0xff,0xff,0xbf,0xff,0xff,0xff,0xff,0xdf,0xef,0xe7,0xff,0xff,0x2a,
+ 0x05,0x7e,0xff,0x55,0xd5,0xff,0xa5,0x2a,0x00,0x8e,0x10,0x4a,0x89,0x24,0x28,
+ 0xa0,0xaa,0x2a,0x49,0xff,0xff,0xff,0xff,0xbf,0xff,0xff,0xff,0xff,0xe7,0xff,
+ 0xef,0xff,0xff,0xa5,0x50,0x7e,0xff,0x25,0xe5,0xff,0x2a,0xa5,0x52,0x7f,0x85,
+ 0x54,0x35,0x08,0x82,0x0a,0x55,0x95,0xaa,0xfc,0xff,0xff,0xff,0xcf,0xff,0xff,
+ 0xff,0xff,0xd7,0xff,0xff,0xff,0x7f,0x52,0x85,0x7e,0xff,0xab,0x94,0x1e,0x55,
+ 0x2a,0xc8,0xff,0x10,0x90,0x92,0xa0,0x08,0x20,0x24,0x52,0x25,0xfd,0xff,0xff,
+ 0xff,0xef,0xff,0xff,0xff,0xff,0xe9,0xff,0xff,0xff,0xff,0x94,0x10,0x7e,0xff,
+ 0x93,0xaa,0x6a,0x49,0x49,0xf2,0xff,0x85,0x52,0x09,0x0a,0xa2,0x4a,0x92,0x29,
+ 0xa9,0xf2,0xff,0xff,0xff,0xd3,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0x7f,
+ 0x55,0x25,0x7f,0xff,0x55,0x49,0x49,0x95,0x0a,0xf9,0xff,0x17,0x48,0x26,0x50,
+ 0x08,0x00,0xa9,0x4a,0x95,0xfa,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xf2,
+ 0xff,0xff,0xff,0xff,0x92,0x80,0x7e,0xff,0xa7,0x54,0xaa,0xa4,0x52,0xfc,0xff,
+ 0xaf,0x42,0x89,0xfa,0xbf,0x54,0x20,0xa9,0xa4,0xd4,0xff,0xff,0xff,0xcb,0xff,
+ 0xff,0xff,0xff,0xf5,0xff,0xff,0xff,0xff,0x54,0x29,0x7f,0xff,0x4b,0xa5,0x92,
+ 0x2a,0x01,0xff,0xff,0x1f,0xa8,0x22,0xff,0xff,0x01,0xa5,0x2a,0x55,0xa9,0xff,
+ 0xff,0xff,0xd4,0xff,0xff,0xff,0x7f,0xfa,0xff,0xff,0xff,0x7f,0xa5,0x04,0x7f,
+ 0xff,0x57,0x2a,0x55,0xa9,0x54,0xfe,0xff,0x3f,0x05,0x89,0xff,0xff,0x5f,0x48,
+ 0x92,0x2a,0x95,0xff,0xff,0xff,0xea,0xff,0xff,0xff,0xff,0xd2,0xff,0xff,0xff,
+ 0x7f,0x2a,0x91,0x7f,0xff,0xa9,0x54,0x4a,0x52,0x02,0xff,0xff,0xff,0x50,0xd1,
+ 0xff,0xff,0x1f,0x81,0xaa,0xa4,0x52,0xfe,0xff,0x3f,0xe9,0xff,0xff,0xff,0x7f,
+ 0x1d,0xff,0xff,0xff,0xff,0x54,0x41,0x7f,0xff,0x93,0x92,0x52,0x95,0xc8,0xff,
+ 0xff,0xff,0x8b,0xc4,0xff,0xff,0x7f,0x24,0xa5,0x2a,0x49,0xf9,0xff,0x7f,0xd5,
+ 0xff,0xff,0xff,0xbf,0x4a,0xff,0xff,0xff,0xff,0x4a,0x14,0x7f,0xff,0x28,0xa5,
+ 0x94,0x2a,0xa0,0xff,0xff,0x7f,0x22,0xf0,0xff,0xff,0x7f,0x12,0x94,0xa4,0xaa,
+ 0xea,0xff,0xaf,0xea,0xff,0xff,0xff,0x5f,0x8e,0xff,0xff,0xff,0x7f,0xa9,0x40,
+ 0x7f,0xff,0x48,0x55,0x55,0x12,0xca,0xff,0xff,0xff,0x0a,0xf5,0xff,0xff,0xff,
+ 0x80,0x52,0x95,0x54,0xaa,0xfe,0x55,0xc4,0xff,0xff,0xff,0x5f,0xa5,0xff,0xff,
+ 0xff,0xff,0x94,0x14,0x7f,0xff,0x52,0x2a,0xa9,0x4a,0xe1,0xff,0xff,0xbf,0x24,
+ 0xf0,0xff,0xff,0xff,0x0b,0x28,0xa9,0x92,0x24,0x55,0x49,0xe5,0xd7,0xff,0xff,
+ 0xa7,0x8a,0xff,0xff,0xff,0x7f,0xa5,0xc0,0x7f,0xff,0x50,0x49,0x95,0x04,0xf8,
+ 0xff,0xff,0x5f,0x1f,0xfd,0xff,0xff,0xff,0x47,0x45,0x55,0xaa,0xaa,0x4a,0xaa,
+ 0xea,0xaf,0xff,0xff,0x2b,0xc3,0xff,0xff,0xff,0x7f,0x55,0x94,0x7f,0x7f,0x4a,
+ 0x55,0x52,0x51,0xfe,0xff,0xff,0x5f,0x4e,0xf8,0xff,0xff,0xff,0x1f,0x50,0x92,
+ 0x52,0x49,0xa9,0x92,0xe4,0xd3,0xff,0xff,0x4b,0xd5,0xff,0xff,0xff,0xff,0x94,
+ 0xc0,0x7f,0x3f,0xa0,0xa4,0xaa,0x04,0xfe,0xff,0xff,0xa7,0x1d,0xfd,0xff,0xff,
+ 0xff,0x9f,0x84,0xaa,0x4a,0xaa,0x24,0x55,0xf2,0x2b,0xff,0x7f,0xa9,0xc1,0xff,
+ 0xff,0xff,0x7f,0x4a,0x95,0x7f,0xbf,0x2a,0x95,0x24,0x50,0xff,0xff,0xff,0x97,
+ 0x5e,0xfe,0xff,0xff,0xff,0x3f,0x92,0x24,0x95,0x92,0xaa,0xa4,0xf2,0xcb,0xff,
+ 0x5f,0xd5,0xe5,0xff,0xff,0xff,0xff,0x52,0x80,0x7f,0x3f,0xa0,0x52,0x15,0x85,
+ 0xff,0xff,0xff,0xd7,0x38,0xfe,0xff,0xff,0xff,0xff,0x20,0xaa,0x52,0x55,0x55,
+ 0x55,0xf9,0x29,0xfd,0xab,0xa4,0xf0,0xff,0xff,0xff,0x7f,0x29,0xa9,0x7f,0xff,
+ 0x42,0x25,0x49,0xe8,0xff,0xff,0xff,0x69,0x7a,0xff,0xff,0xff,0xff,0xff,0x82,
+ 0x52,0xaa,0x24,0x89,0x4a,0xf8,0x55,0x2a,0x49,0x95,0xf5,0xff,0xff,0xff,0xbf,
+ 0x2a,0xc4,0x7f,0x7f,0x90,0x54,0x15,0xe2,0xff,0xff,0xff,0x25,0xbc,0xff,0xff,
+ 0xff,0xff,0xff,0x29,0x48,0x49,0xaa,0xaa,0xa4,0xfa,0x95,0x92,0x54,0x52,0xf0,
+ 0xff,0xff,0xff,0xbf,0x4a,0xd1,0x7f,0xff,0x05,0xaa,0x40,0xf8,0xff,0xff,0x7f,
+ 0xaa,0xfc,0xff,0xff,0xff,0xff,0xff,0x43,0xa9,0xaa,0x4a,0x52,0xa9,0xf8,0xa4,
+ 0xaa,0x52,0x95,0xfc,0xff,0xff,0xff,0x7f,0x52,0xc0,0x7f,0xff,0xa1,0x00,0x24,
+ 0xfa,0xff,0xff,0xff,0x0a,0xfe,0xff,0xff,0xff,0xff,0xff,0x17,0x92,0x24,0xa5,
+ 0x2a,0x55,0xfe,0xaa,0xa4,0x2a,0x29,0xf9,0xff,0xff,0xff,0xbf,0x2a,0xea,0x7f,
+ 0xff,0x05,0x92,0x90,0xfc,0xff,0xff,0xbf,0xa4,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x4f,0xa0,0xaa,0x54,0x49,0x25,0x7c,0x49,0x95,0xa4,0x12,0xfc,0xff,0xff,0xff,
+ 0x7f,0x8a,0xe0,0x7f,0xff,0xa3,0x04,0x05,0xfe,0xff,0xff,0xbf,0x06,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x1f,0x49,0x95,0x52,0xaa,0x12,0x7f,0x55,0x52,0x55,0x0a,
+ 0xfd,0xff,0xff,0xff,0x3f,0x29,0xe8,0x7f,0xff,0x0f,0x50,0x50,0xff,0xff,0xff,
+ 0x5f,0xca,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x04,0xa9,0x4a,0x25,0x45,0x3e,
+ 0xa9,0x2a,0xa9,0xa2,0xfc,0xff,0xff,0xff,0x7f,0x55,0xe1,0x7f,0xff,0x27,0x05,
+ 0xc4,0xff,0xff,0xff,0x9f,0x91,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x41,0x4a,
+ 0x29,0xa9,0x12,0x5e,0x95,0x94,0x4a,0x0a,0xfe,0xff,0xff,0xff,0xbf,0x12,0xf4,
+ 0x7f,0xff,0x8f,0x50,0xf1,0xff,0xff,0xff,0xa7,0xc2,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x14,0x92,0xaa,0x4a,0xa2,0xbf,0xa4,0x52,0x95,0x22,0xff,0xff,0xff,
+ 0xff,0x3f,0x45,0xf2,0x7f,0xff,0x3f,0x04,0xf4,0xff,0xff,0xff,0xd7,0xe8,0xff,
+ 0xff,0xff,0xff,0x5f,0xff,0xff,0x83,0xa8,0x94,0x54,0x09,0x2f,0x55,0x4a,0x52,
+ 0x49,0xff,0xff,0xff,0xff,0x5f,0x99,0xf0,0x7f,0xff,0x7f,0x51,0xfc,0xff,0xff,
+ 0xff,0x6b,0xf1,0xff,0xff,0xff,0xff,0x5f,0xfd,0xff,0x2b,0x2a,0xa9,0x12,0x20,
+ 0x5f,0xa9,0xaa,0x54,0x00,0xff,0xff,0xff,0xff,0x5f,0x15,0xf2,0x7f,0xff,0xff,
+ 0x8f,0xff,0xff,0xff,0xff,0x2b,0xfc,0xff,0xff,0xff,0xff,0x2f,0xfd,0xff,0x87,
+ 0xa0,0x4a,0xaa,0x8a,0x9f,0x4a,0x52,0x15,0xa9,0xff,0xff,0xff,0xff,0x5f,0x8a,
+ 0xfc,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x94,0xf8,0xff,0xff,0xff,0xff,
+ 0x57,0xf2,0xff,0x2f,0x82,0x52,0x05,0xd0,0x2f,0x95,0x4a,0x49,0x84,0xff,0xff,
+ 0xff,0xff,0xbf,0x24,0xf8,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x12,0xfd,
+ 0xff,0xff,0xff,0xff,0x4b,0xd5,0xff,0x9f,0x28,0x54,0x48,0xc5,0xbf,0x52,0x55,
+ 0x0a,0xe1,0xff,0xff,0xff,0xff,0x9f,0x4a,0xfa,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x1a,0xfe,0xff,0xff,0xff,0xff,0x57,0xa9,0xff,0x3f,0x82,0x00,0x21,
+ 0xf0,0x5f,0x2a,0x49,0x21,0xc4,0xff,0xff,0xff,0xff,0xaf,0x1a,0xfd,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x3f,0x85,0xff,0xff,0xff,0xff,0xff,0x29,0xa5,0xff,
+ 0xff,0x24,0x52,0x88,0xfc,0xbf,0x92,0x2a,0x09,0xf1,0xff,0xff,0xff,0xff,0x9f,
+ 0x4c,0xfc,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x15,0xff,0xff,0xff,0x7f,
+ 0xff,0xa5,0x4a,0xff,0xff,0x90,0x08,0x01,0xfe,0x3f,0x55,0x52,0x24,0xf4,0xff,
+ 0xff,0xff,0xff,0xaf,0x02,0xfd,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xc6,
+ 0xff,0xff,0xff,0xbf,0xfe,0x95,0x54,0xff,0xff,0x05,0x42,0xa8,0xfe,0xbf,0xa4,
+ 0x2a,0x41,0xf9,0xff,0xff,0xff,0xff,0x5f,0x55,0xfc,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x4f,0xd0,0xff,0xff,0xff,0xbf,0x7c,0xaa,0x92,0xfc,0xff,0x53,0x08,
+ 0x01,0xff,0x1f,0x4a,0x01,0x04,0xfc,0xff,0xff,0xff,0xff,0x27,0x05,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xc5,0xff,0xff,0xff,0x4f,0xbf,0x52,0xaa,
+ 0xfe,0xff,0x07,0x42,0xea,0xff,0xbf,0x50,0x54,0x51,0xff,0xff,0xff,0xff,0xff,
+ 0x97,0x56,0xfe,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xf0,0xff,0xff,0xff,
+ 0x2f,0x7f,0xa5,0x54,0xfd,0xff,0x3f,0x09,0xe0,0xff,0x1f,0x02,0x01,0x04,0xff,
+ 0xff,0xff,0xff,0xff,0xaf,0x02,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,
+ 0xf5,0xff,0xff,0xff,0xab,0x9f,0x94,0x92,0xfc,0xff,0xff,0x40,0xfd,0xff,0x9f,
+ 0x48,0x48,0xa1,0xff,0xff,0xff,0xff,0xff,0xa7,0x56,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x6b,0xf8,0xff,0xff,0xff,0xa4,0x5f,0xa9,0x2a,0xfd,0xff,0xff,
+ 0xff,0xff,0xff,0x3f,0x22,0x21,0xc4,0xff,0xff,0xff,0xff,0xff,0x2f,0x03,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0xfa,0xff,0xff,0x7f,0xd5,0x2f,0xa5,
+ 0xa4,0xfa,0xff,0xff,0xff,0xff,0xff,0xbf,0x08,0x08,0xf9,0xff,0xff,0xff,0xff,
+ 0xff,0x97,0x4a,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x94,0xfc,0xff,0xff,
+ 0x7f,0x69,0xac,0x2a,0x55,0xf9,0xff,0xff,0xff,0xff,0xff,0x7f,0xa2,0x22,0xf8,
+ 0xff,0xff,0xff,0xff,0xff,0x53,0x21,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x15,0xfe,0xff,0xff,0x9f,0x2a,0x95,0x94,0x92,0xf4,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x08,0x88,0xfe,0xff,0xff,0xff,0xff,0xff,0x57,0x8b,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xa9,0xfe,0xff,0xff,0x5f,0x52,0xbc,0x52,0x55,0xf5,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x21,0x21,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xa1,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x7f,0x0d,0xff,0xff,0xff,0x57,0x15,0x3f,
+ 0x55,0x49,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xc8,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xd7,0x89,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xbf,0xd6,0xff,0xff,
+ 0xff,0x4b,0x45,0x3f,0x49,0xaa,0xf4,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0xf9,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xc9,0xe2,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0x3f,0x81,0xff,0xff,0xff,0x29,0x11,0x5f,0x28,0x55,0xf5,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0xc8,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0x5f,0xd6,0xff,0xff,0x7f,0xaa,0xc2,0x0f,0x55,0x49,0xea,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa5,
+ 0xe2,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x9f,0xe1,0xff,0xff,0xbf,0x4a,0xd1,
+ 0x5f,0x48,0xa5,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xe9,0xe0,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x27,0xf4,0xff,
+ 0xff,0xbf,0x94,0xc4,0x07,0x91,0x2a,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xca,0xea,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xaf,0xf1,0xff,0xff,0x9f,0x52,0xe0,0x4b,0x44,0x52,0xe9,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x6a,0xe0,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0x4b,0xfc,0xff,0xff,0xab,0x2a,0xf5,0x0f,0x51,0xa5,
+ 0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0x69,0xe5,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x55,0xf8,0xff,0xff,0x95,0x14,
+ 0xf0,0x5f,0x84,0x54,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0x75,0xf0,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x13,0xfd,
+ 0xff,0xff,0xa5,0x42,0xf9,0x7f,0x91,0x4a,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xb2,0xfa,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0x54,0xfe,0xff,0x7f,0x52,0x12,0xfa,0xff,0x20,0xa5,0xe4,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x34,0xf8,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0x25,0xff,0xff,0xaf,0xaa,0x48,0xfc,0xff,0x0b,
+ 0x29,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xb5,0xf8,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x52,0xff,0xff,0x2f,0x49,
+ 0x02,0xfe,0xff,0x43,0xaa,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x3f,0x3a,0xfa,0xff,0x7f,0xff,0xff,0xff,0xff,0x7f,0x4a,
+ 0xff,0xff,0xa5,0x2a,0xa9,0xff,0xff,0x17,0x25,0xe9,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x9a,0xfc,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0x2a,0xff,0x7f,0x95,0x54,0x80,0xff,0xff,0x07,0xa9,0xea,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x1d,0xfc,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0x3f,0xa9,0xfe,0x7f,0xa9,0x12,0xe5,0xff,0xff,
+ 0x5f,0x4a,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x5f,0xad,0xfe,0xff,0x7f,0xff,0xff,0xff,0xff,0x7f,0x95,0xea,0x97,0x54,
+ 0x4a,0xf0,0xff,0xff,0x1f,0xa8,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x5f,0x0e,0xfe,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,
+ 0x52,0x55,0xa9,0x92,0x02,0xfd,0xff,0xff,0x5f,0x53,0xf5,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x5e,0xfe,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xbf,0x2a,0x49,0x4a,0x55,0x49,0xfc,0xff,0xff,0x3f,0x94,0xf8,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0x0f,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4f,0xa5,0xaa,0x92,0xa4,0x20,0xff,0xff,
+ 0xff,0xbf,0xa4,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x5f,0x57,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,0x52,0x52,0xaa,
+ 0x2a,0x0a,0xff,0xff,0xff,0x7f,0x54,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x8f,0x07,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xa7,0x94,0x4a,0x55,0x4a,0xa0,0xff,0xff,0xff,0xff,0xa8,0xfa,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x57,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0x2f,0x55,0xa9,0x92,0x12,0xe9,0xff,0xff,0xff,0x7f,0x24,
+ 0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,
+ 0x87,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0xa5,0x4a,0xaa,0x44,0xf4,0xff,
+ 0xff,0xff,0xff,0x55,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xa7,0xab,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xab,0x94,0xa4,
+ 0x92,0x12,0xf9,0xff,0xff,0xff,0xff,0xa8,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xab,0x83,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0x47,0xa9,0x2a,0x55,0x40,0xfc,0xff,0xff,0xff,0xff,0x25,0xf5,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xff,0xff,0xd7,0x97,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0x33,0x55,0xa9,0x24,0x15,0xfe,0xff,0xff,0xff,0xff,
+ 0x95,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xff,
+ 0x93,0xc3,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0x25,0xa5,0x2a,0x40,0xff,
+ 0xff,0xff,0xff,0xff,0xa9,0xf4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe3,0xff,
+ 0xff,0xff,0xff,0xff,0xe7,0xd5,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4b,0x92,
+ 0x54,0x92,0xd4,0xff,0xff,0xff,0xff,0xff,0x55,0xf5,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xe9,0xff,0xff,0xff,0xff,0xff,0xd5,0xc1,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0x97,0xaa,0x4a,0x05,0xe2,0xff,0xff,0xff,0xff,0xff,0x25,0xf1,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xe3,0xfd,0xff,0xff,0xff,0xff,0xd5,0xea,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0x55,0x25,0xa1,0xf0,0xff,0xff,0xff,0xff,
+ 0xff,0x95,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe8,0xfa,0xff,0xff,0xff,
+ 0xff,0xea,0xe0,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xa7,0x24,0x59,0x04,0xfa,
+ 0xff,0xff,0xff,0xff,0xff,0xa9,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe2,
+ 0xfd,0xff,0xff,0xff,0xff,0xc9,0xe9,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4f,
+ 0x52,0x05,0xa1,0xfc,0xff,0xff,0xff,0xff,0xff,0xa5,0xfa,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x70,0xf9,0xff,0xff,0xff,0xff,0x74,0xe2,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0x47,0x95,0x92,0x04,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0xf8,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xe2,0xfa,0xff,0xff,0xff,0xff,0x72,0xe8,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x97,0xaa,0x20,0xd0,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x55,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xb8,0xfc,0xff,0xff,
+ 0xff,0xff,0xea,0xe2,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x07,0x04,0x82,0xc2,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x29,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0x71,0xfd,0xff,0xff,0xff,0x7f,0x2a,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0x4f,0x91,0x28,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xfc,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x1f,0x54,0xfe,0xff,0xff,0xff,0x7f,0x75,0xf2,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0x27,0x44,0x82,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x29,
+ 0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0xb8,0xfc,0xff,0xff,0xff,0xbf,0x14,
+ 0xf1,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x0f,0x11,0x20,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x55,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x9a,0xfe,0xff,
+ 0xff,0xff,0x7f,0x5a,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,0x40,0x85,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x09,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x4f,0x2d,0xfd,0xff,0xff,0xff,0x9f,0x12,0xf9,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0x3f,0x14,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xfe,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x07,0xa6,0xfe,0xff,0xff,0xff,0x5f,0x4d,0xfa,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0x40,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x09,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0x4b,0xfe,0xff,0xff,0xff,0xbf,
+ 0x2c,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xf5,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x43,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x57,0xff,
+ 0xff,0xff,0xff,0x5f,0x0a,0xfe,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x89,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xd5,0xa9,0xff,0xff,0xff,0xff,0xaf,0x5a,0xfc,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa3,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x81,0x95,0xff,0xff,0xff,0xff,0x9f,0x06,0xfd,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xc9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xca,0xa5,0xff,0xff,0xff,0xff,
+ 0x2f,0x95,0xfc,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe0,0xea,
+ 0xff,0xff,0xff,0xff,0xaf,0x26,0xfe,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd5,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xf5,0xf4,0xff,0xff,0xff,0xff,0xaf,0x86,0xfe,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc1,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0x70,0xe5,0xff,0xff,0xff,0xff,0x4f,0x2e,0xfe,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xb2,0xfa,0xff,0xff,0xff,
+ 0xff,0x57,0x83,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xf3,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x78,
+ 0xf2,0xff,0xff,0xff,0xff,0xa7,0x22,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x5f,0x5d,0xfd,0xff,0xff,0xff,0xff,0x97,0x87,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x3c,0xfd,0xff,0xff,0xff,0xff,0x53,0xa3,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xac,0xfe,0xff,0xff,
+ 0xff,0xff,0x57,0x95,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,
+ 0x9e,0xfe,0xff,0xff,0xff,0xff,0x97,0x81,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xa7,0x57,0xfe,0xff,0xff,0xff,0xff,0xa9,0xa5,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xaf,0xff,0xff,0xff,0xff,0xff,0x4b,
+ 0x89,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0x93,0xff,0xff,
+ 0xff,0xff,0xff,0x95,0xa2,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x83,0xab,0xff,0xff,0xff,0xff,0xff,0xd3,0xc8,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xff,
+ 0xff,0xff,0xff,0xff,0xe9,0xa5,0xff,0xff,0xff,0xff,0xff,0xa5,0xe1,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc0,0xd5,0xff,0xff,0xff,0xff,0xff,
+ 0xd5,0xc8,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xea,0xea,0xff,
+ 0xff,0xff,0xff,0xff,0x14,0xc1,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,
+ 0xff,0xe0,0xe4,0xff,0xff,0xff,0xff,0xff,0x65,0xe8,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,
+ 0xff,0xff,0xff,0xff,0x3f,0x72,0xe9,0xff,0xff,0xff,0xff,0xff,0x6a,0xe1,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,0xbf,0xb8,0xfa,0xff,0xff,0xff,0xff,
+ 0xff,0x52,0xea,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd3,0xff,0xff,0xff,0xff,0x1f,0x7a,0xf5,
+ 0xff,0xff,0xff,0xff,0x7f,0x2a,0xe0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,
+ 0xff,0x8f,0x58,0xfa,0xff,0xff,0xff,0xff,0x7f,0x25,0xf5,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xb5,0xff,0xff,0xdf,0xff,0x57,0x5e,0xfd,0xff,0xff,0xff,0xff,0xff,0x34,0xe0,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xca,0xff,0xff,0x8f,0xff,0x07,0xac,0xfc,0xff,0xff,0xff,
+ 0xff,0x7f,0x2a,0xf5,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd4,0xff,0xff,0x57,0xff,0x2b,0x2d,
+ 0xfd,0xff,0xff,0xff,0xff,0xff,0xb2,0xf0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd2,0xff,0xff,
+ 0x07,0xff,0x43,0x4a,0xff,0xff,0xff,0xff,0xff,0xbf,0x2a,0xf8,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x3f,0xc5,0xff,0xff,0x2b,0xfe,0x08,0xab,0xfe,0xff,0xff,0xff,0xff,0x7f,0xaa,
+ 0xf2,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xbf,0xea,0xff,0xff,0x83,0x36,0x20,0x55,0xff,0xff,0xff,
+ 0xff,0xff,0x3f,0x15,0xf0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0xc2,0xff,0xff,0x48,0x4a,0x85,
+ 0x49,0xff,0xff,0xff,0xff,0xff,0x7f,0x59,0xfa,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0xf5,0xff,
+ 0x7f,0x10,0x29,0x50,0xa5,0xff,0xff,0xff,0xff,0xff,0x3f,0x15,0xf9,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x97,0xe4,0xff,0x7f,0x05,0x95,0x42,0xd5,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0x35,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xab,0xea,0xff,0xbf,0xa0,0x24,0xa8,0xd4,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0x19,0xf9,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x27,0xe5,0xff,0x3f,0x92,0xaa,
+ 0x50,0xe9,0xff,0xff,0xff,0xff,0xff,0x9f,0x4a,0xfc,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa9,0xe2,
+ 0xff,0x9f,0xa0,0xaa,0x2a,0xf5,0xff,0xff,0xff,0xff,0xff,0x5f,0x1a,0xf9,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x95,0xf8,0xff,0x5f,0x4a,0x92,0x4a,0xf5,0xff,0xff,0xff,0xff,0xff,
+ 0xbf,0x4a,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0x52,0xf2,0xff,0x1f,0x20,0x49,0xa5,0xfa,0xff,
+ 0xff,0xff,0xff,0xff,0x5f,0x1a,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaa,0xf8,0xff,0x47,0xa9,
+ 0x2a,0x29,0xf9,0xff,0xff,0xff,0xff,0xff,0xbf,0x0a,0xfc,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x49,
+ 0xf2,0xff,0x17,0x92,0xaa,0xaa,0xfe,0xff,0xff,0xff,0xff,0xff,0x9f,0xac,0xfe,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x9f,0x2a,0xf8,0xff,0x43,0xa8,0x24,0x25,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xaf,0x0a,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x94,0xfa,0xff,0x91,0x54,0xaa,0x52,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x2f,0x4d,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0x45,0xfc,0xff,0x03,
+ 0x92,0x52,0xaa,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x06,0xfc,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,
+ 0x12,0xfe,0xff,0x50,0xaa,0x2a,0x95,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0xa5,
+ 0xfe,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xa7,0x44,0xff,0xff,0x0a,0x25,0xa5,0xa4,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x97,0x06,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0x15,0xff,0xff,0x40,0xa9,0x92,0xea,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x55,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xa1,0xff,0x7f,
+ 0x92,0x4a,0xaa,0xd4,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x06,0xfc,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x95,0x8a,0xff,0x3f,0x84,0x54,0xa9,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,
+ 0x25,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x52,0xe0,0xff,0xbf,0x50,0xa9,0x4a,0xf2,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xa7,0x8e,0xfe,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xa9,0xea,0xff,0x3f,0x24,0x95,0x54,
+ 0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x23,0xfe,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x4a,0xf0,0xff,
+ 0x9f,0x50,0x69,0x49,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x8b,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xa5,0xf4,0xff,0x0f,0x2d,0x75,0xaa,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xaf,0x03,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x9f,0x14,0xfa,0xff,0x2f,0xa8,0xfa,0x25,0xfd,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x97,0xd7,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xaa,0xfc,0xff,0x0f,0x4d,0xfd,
+ 0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,0x83,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x12,0xfc,
+ 0xff,0x27,0x92,0xfe,0xcb,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd7,0xd7,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x97,0x0a,0xff,0xff,0x83,0x56,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xef,0xc7,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xab,0x24,0xff,0xff,0x2b,0xaa,0xfe,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xe7,0xef,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x45,0xff,0xff,0x05,0x95,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0x82,
+ 0xff,0xff,0x51,0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xf7,
+ 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xa9,0xe8,0xff,0xff,0x85,0xca,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0x52,0xc1,0xff,0xff,0x90,0xd5,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x4d,0xe8,0xff,0xff,0xa5,
+ 0xe4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x51,
+ 0xf2,0xff,0x7f,0x40,0xd5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x3f,0x95,0xf8,0xff,0x7f,0xa9,0xea,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x15,0xfa,0xff,0x3f,0xa4,0xf4,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xa4,0xfc,0xff,0x7f,
+ 0x71,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,
+ 0x15,0xfe,0xff,0x3f,0x94,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xa7,0x0a,0xff,0xff,0x1f,0x79,0xf2,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0xa4,0xff,0xff,0x5f,0x8c,0xfa,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x53,0x82,0xff,0xff,
+ 0x1f,0x5c,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xa4,0x92,0xff,0xff,0xbf,0x56,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x9a,0xc4,0xff,0xff,0x0f,0x2e,0xfd,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa2,0xf0,0xff,0xff,0xaf,0xa7,0xfe,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x55,0xe4,0xff,
+ 0xff,0x0f,0x57,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xbf,0x54,0xf2,0xff,0xff,0x9f,0x4b,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x9f,0x92,0xf8,0xff,0xff,0xc7,0xab,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x15,0xfe,0xff,0xff,0x97,0xd7,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa7,0x94,0xfc,
+ 0xff,0xff,0xc7,0xe3,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x2f,0x05,0xfe,0xff,0xff,0xcf,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x53,0xa9,0xff,0xff,0xff,0xd3,0xeb,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x05,0xff,0xff,0xff,0xe3,
+ 0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x54,0xc2,
+ 0xff,0xff,0xff,0xeb,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x95,0xc8,0xff,0xff,0xff,0xf3,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xa5,0xd2,0xff,0xff,0xff,0xff,0xf5,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xaa,0xe0,0xff,0xff,0xff,
+ 0xff,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x49,
+ 0xf8,0xff,0xff,0xff,0xff,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x9f,0x2a,0xf5,0xff,0xff,0xff,0xff,0xfd,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x4a,0xf8,0xff,0xff,0xff,0xff,0xfc,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x14,0xfd,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,
+ 0x4a,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xab,0x04,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0x52,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x53,0x85,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x54,0xa2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x4a,0xc9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xa5,0xe0,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x94,0xe4,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x5f,0x55,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xbf,0x12,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x54,0xfa,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x0a,0xfc,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x53,0x45,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x97,0x14,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x45,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x54,0x82,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x4a,0xe9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x52,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x55,0xe8,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x24,
+ 0xf1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0x55,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x24,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x15,0xfe,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,
+ 0x49,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x2f,0x95,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x01,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0xd5,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x57,0x81,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x97,0xd4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xe0,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x93,0xf4,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x57,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x2b,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x89,0xfc,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xfc,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x05,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x49,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x22,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x89,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xe9,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x9f,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0x6f,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xbf,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0x9f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
+ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f};
diff --git a/lisp/gnus/gnus.xpm b/lisp/gnus/gnus.xpm
new file mode 100644
index 00000000000..b6ee4d0d733
--- /dev/null
+++ b/lisp/gnus/gnus.xpm
@@ -0,0 +1,284 @@
+/* XPM */
+static char *gnus[] = {
+/* width height num_colors chars_per_pixel */
+" 271 273 3 1",
+/* colors */
+". s thing c #bf9900",
+"# s shadow c #ffcc00",
+"a s None c None",
+/* pixels */
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........######aaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............#######aaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................######aaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................######aaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................#######aaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................#######aaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........................#######aaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................######aaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................######aaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............................#######aaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................#######aaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................aaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................#######aaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................aaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................#######aaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................aaaaaaaaaaaaaaaa....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................########aaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......................aaaaaaaaaaaaaa........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.................................#######aaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................aaaaaaaaaaa............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................########aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................aaaaaaaaa..............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................aaaaaaa................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................aaaaa..................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......######.......................#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................aaaa...................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#######aa....................#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................aa.....................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaa.................#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................a......................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaa................#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaa...............#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaa...............#######aaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaa..............#######aaaaa",
+"aaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaa..............#######aaaaa",
+"aaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa.............#######aaaaa",
+"aaaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............####....................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaa............########aaaaa",
+"aaaaaaa.........aaaaaaaaaaaaaaaaaaaaaaaaaaa.............########...................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaa...........########aaaaa",
+"aaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaa.............############..................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaa...........########aaaaa",
+"aaaaaaaa..........aaaaaaaaaaaaaaaaaaaaaa.............##############..................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaa...........########aaaaa",
+"aaaaaaaa...........aaaaaaaaaaaaaaaaaaaa............##################.......................##########................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaa..........########aaaaa",
+"aaaaaaaa............aaaaaaaaaaaaaaaaaa............####################....................###############..............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaa..........#######aaaaaa",
+"aaaaaaaa............aaaaaaaaaaaaaaaa..............#####################.................#####################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa..aaaaa###aaaaaaaaaaaaaaaaaa..........#######aaaaaa",
+"aaaaaaaa.............aaaaaaaaaaaaaa..............#######################...............#######################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa..aaaaa##aaaaaaaaaaaaaaaaaaa..........#######aaaaaa",
+"aaaaaaaaa.............aaaaaaaaaaa...............##########aa#############.............#########################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaa..........#######aaaaaa",
+"aaaaaaaaa.............aaaaaaaaa................#########aaaaaaa###########............##########################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
+"aaaaaaaaa................aaaa..................#######aaaaaaaaaa###########..........############################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
+"aaaaaaaaa.....................................######aaaaaaaaaaaaa###########.........#############################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
+"aaaaaaaaa....................................######aaaaaaaaaaaaaaaa#########........###############################.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
+"aaaaaaaaaa.................................#######aaaaaaaaaaaaaaaaaa#########.......#######aaaaaaaaaaa##############..........................aaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
+"aaaaaaaaaa................................#######aaaaaaaaaaaaaaaaaaaa########......#####aaaaaaaaaaaaaaaaa############..........................aaaaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
+"aaaaaaaaaa...............................########aaaaaaaaaaaaaaaaaaaaa########....#####aaaaaaaaaaaaaaaaaaaaa##########..........................aaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
+"aaaaaaaaa#..............................########aaaaaaaaaaaaaaaaaaaaaaaa#.####...#####aaaaaaaaaaaaaaaaaaaaaaa##########...........................aaaaaaaaaaaaaaaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
+"aaaaaaaaa#.............................########aaaaaaaaaaaaaaaaaaaaaaaaa...###..######aaaaaaaaaaaaaaaaaaaaaaaa##########...........................aaaaaaaaaaaaaaaaaaa......a#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
+"aaaaaaaa###...........................#########aaaaaaaaaaaaaaaaaaaaaaaa....##########aaaaaaaaaaaaaaaaaaaaaaaaaa##########............................aaaaaaaaaaaaaaa........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
+"aaaaaaaa###..........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....#########aaaaaaaaaaaaaaaaaaaaaaaaaaaa##########...............................aaaaaaaa...........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
+"aaaaaaaa###.........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....a#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##########................................................##aaaaaa...aaaaaaaaaaaaaaaaaaaaa......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
+"aaaaaaa####........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....aaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...............................................##aaaaaa....aaaaaaaaaaaaaaaaaaa.......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
+"aaaaaaa####.......................########aaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########..............................................##aaaaa.....aaaaaaaaaaaaaaaaaa.......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
+"aaaaaa######....................#########aaaaaaaaaaaaaaaaaaaaaaaaaa.....a#aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########............................................##aaaaaa......aaaaaaaaaaaaaaa.........a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
+"aaaaaa######...................#########aaaaaaaaaaaaaaaaaaaaaaaaaa......##aaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...........................................##aaaaa.......aaaaaaaaaaaaa..........aa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
+"aaaaaa#######.................#########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a###aaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.........................................###aaaaa.........aaaaaaa..............a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........########aaaaaaaa",
+"aaaaaaa#######...............#########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########........................................##aaaaa...............................a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
+"aaaaaaa########............##########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.......................................##aaaaa...............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
+"aaaaaaaa##########.......###########aaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.....................................###aaaaa..............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
+"aaaaaaaaa##########################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########....................................##aaaaa...............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........########aaaaaaaaa",
+"aaaaaaaaa#########################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########..................................###aaaaa..............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
+"aaaaaaaaaa#######################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...............................####aaaaa..............................######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
+"aaaaaaaaaaa#####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.............................#####aaaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
+"aaaaaaaaaaa###################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...........................######aaaa..............................######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......########aaaaaaaaaa",
+"aaaaaaaaaaaa#################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.........................######aaaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaaa",
+"aaaaaaaaaaaaa###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaa#########.......................#######aaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaaa",
+"aaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaa#########....................#########aaaa............................########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaaaaaaaaaaaaa#########..................#########aaaaa..........................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........aaaaaaaaaaaaaaa###########.............###########aaaaa.........................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............aaaaaaaaaaaaaaa##############....###############aaaaaaa.......................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............aaaaaaaaaaaaaaa##############################aaaaaaaaa.....................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaa############################aaaaaaaaaaa...................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaa................aaaaaaaaaaaaaaaa##########################aaaaaaaaaaaa#................#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaa.................aaaaaaaaaaaaaaaa########################aaaaaaaaaaaaa##..............#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaa...................aaaaaaaaaaaaaaaa######################aaaaaaaaaaaaa#####.........###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaa....................aaaaaaaaaaaaaaaaa###################aaaaaaaaaaaaaaa########..##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaa....................aaaaaaaaaaaaaaaaaaa################aaaaaaaaaaaaaaaa###########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaa......................aaaaaaaaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaa##########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa........a###a.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaa........a####a.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaa........a#####aaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaa#.....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaa##....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaa..........######aaaaa#####..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaa...........#####aaaaa#######..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaaa...........#####aaaaaa#######..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaaa...........######aaaaa#########.................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaa...........######aaaaa###########................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaa##########...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......####aaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaaaa#########...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaaaaaaa########..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......###aaaaaaaaaaaaaaaaaaaaa............#########aaaaaaaaaaaaa#######..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......###aaaaaaaaaaaaaaaaaaa.............#########aaaaaaaaaaaaaaa#######.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaaaa.............#########aaaaaaaaaaaaaaaaa######.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaa..............#########aaaaaaaaaaaaaaaaaaa#####.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaa...............#########aaaaaaaaaaaaaaaaaaaa#####.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaa...............#########aaaaaaaaaaaaaaaaaaaaaa#####............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaa..................########aaaaaaaaaaaaaaaaaaaaaaaaa####............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................................########aaaaaaaaaaaaaaaaaaaaaaaaaa####...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....................................########aaaaaaaaaaaaaaaaaaaaaaaaaaaa###...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaa####..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#...................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##................#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.......##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###............##############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#......###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#......###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######..###################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#....####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#aaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaa#######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#aaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaa#######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#aaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaa########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#aaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaa########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#aaaaaaaaaaaaaaaaaaaa#######aaaaaaa#########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......##aaaaaaaaaaaaaaaaaaa########a..aa##########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........##aaaaaaaaaaaaaaaaaa#########....##########a........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaaa#########......#########........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#aaaaaaaaaaaaaaaaaa#########......########a........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........##aaaaaaaaaaaaaaaaa#########.......#######.........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........##aaaaaaaaaaaaaaaaa########.........#####.........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........###aaaaaaaaaaaaaaaa########........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........###aaaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........###aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........####aaaaaaaaaaaaaaa#########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa#######........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaa#######.........a..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa#######a........aaa............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa#######........aaaaa..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaa#######a.......aaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa######a........aaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaa#######........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaa#######a......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaa#####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaa####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaa#####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaa####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaa####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaa###aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaa####aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaa####aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaa###aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaa###aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaa####aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaa###aaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaa###aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
+"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+};
+
diff --git a/lisp/gnus/grin.xpm b/lisp/gnus/grin.xpm
new file mode 100644
index 00000000000..292cb1110e8
--- /dev/null
+++ b/lisp/gnus/grin.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * grin_xpm[] = {
+"13 14 4 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+"@ c #FFFFFF",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++..+++..++.",
+".++..+++..++.",
+".+++++++++++.",
+".+.........+.",
+".+.@@@@@@@.+.",
+".++.@@@@@.++.",
+".+++.....+++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/hex-util.el b/lisp/gnus/hex-util.el
new file mode 100644
index 00000000000..bdaf197c8ce
--- /dev/null
+++ b/lisp/gnus/hex-util.el
@@ -0,0 +1,74 @@
+;;; hex-util.el --- Functions to encode/decode hexadecimal string.
+
+;; Copyright (C) 1999, 2001 Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: data
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+ (defmacro hex-char-to-num (chr)
+ (` (let ((chr (, chr)))
+ (cond
+ ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
+ ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
+ ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
+ (t (error "Invalid hexadecimal digit `%c'" chr))))))
+ (defmacro num-to-hex-char (num)
+ (` (aref "0123456789abcdef" (, num)))))
+
+(defun decode-hex-string (string)
+ "Decode hexadecimal STRING to octet string."
+ (let* ((len (length string))
+ (dst (make-string (/ len 2) 0))
+ (idx 0)(pos 0))
+ (while (< pos len)
+;;; logior and lsh are not byte-coded.
+;;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
+;;; (hex-char-to-num (aref string (1+ pos)))))
+ (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
+ (hex-char-to-num (aref string (1+ pos)))))
+ (setq idx (1+ idx)
+ pos (+ 2 pos)))
+ dst))
+
+(defun encode-hex-string (string)
+ "Encode octet STRING to hexadecimal string."
+ (let* ((len (length string))
+ (dst (make-string (* len 2) 0))
+ (idx 0)(pos 0))
+ (while (< pos len)
+;;; logand and lsh are not byte-coded.
+;;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
+ (aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
+ (setq idx (1+ idx))
+;;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
+ (aset dst idx (num-to-hex-char (% (aref string pos) 16)))
+ (setq idx (1+ idx)
+ pos (1+ pos)))
+ dst))
+
+(provide 'hex-util)
+
+;;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859
+;;; hex-util.el ends here
diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el
new file mode 100644
index 00000000000..f2aefbef993
--- /dev/null
+++ b/lisp/gnus/html2text.el
@@ -0,0 +1,550 @@
+;;; html2text.el --- a simple html to plain text converter
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Joakim Hove <hove@phys.ntnu.no>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; These functions provide a simple way to wash/clean html infected
+;; mails. Definitely do not work in all cases, but some improvement
+;; in readability is generally obtained. Formatting is only done in
+;; the buffer, so the next time you enter the article it will be
+;; "re-htmlized".
+;;
+;; The main function is "html2text"
+
+;;; Code:
+
+;;
+;; <Global variables>
+;;
+
+(eval-when-compile
+ (require 'cl))
+
+(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
+
+(defvar html2text-replace-list
+ '(("&nbsp;" . " ") ("&gt;" . ">") ("&lt;" . "<") ("&quot;" . "\""))
+ "The map of entity to text.
+
+This is an alist were each element is a dotted pair consisting of an
+old string, and a replacement string. This replacement is done by the
+function \"html2text-substitute\" which basically performs a
+replace-string operation for every element in the list. This is
+completely verbatim - without any use of REGEXP.")
+
+(defvar html2text-remove-tag-list
+ '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta")
+ "A list of removable tags.
+
+This is a list of tags which should be removed, without any
+formatting. Observe that if you the tags in the list are presented
+*without* any \"<\" or \">\". All occurences of a tag appearing in
+this list are removed, irrespective of whether it is a closing or
+opening tag, or if the tag has additional attributes. The actual
+deletion is done by the function \"html2text-remove-tags\".
+
+For instance the text:
+
+\"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\"
+
+will be reduced to:
+
+\"Here comes something big.\"
+
+If this list contains the element \"font\".")
+
+(defvar html2text-format-tag-list
+ '(("b" . html2text-clean-bold)
+ ("u" . html2text-clean-underline)
+ ("i" . html2text-clean-italic)
+ ("blockquote" . html2text-clean-blockquote)
+ ("a" . html2text-clean-anchor)
+ ("ul" . html2text-clean-ul)
+ ("ol" . html2text-clean-ol)
+ ("dl" . html2text-clean-dl)
+ ("center" . html2text-clean-center))
+ "An alist of tags and processing functions.
+
+This is an alist where each dotted pair consists of a tag, and then
+the name of a function to be called when this tag is found. The
+function is called with the arguments p1, p2, p3 and p4. These are
+demontrated below:
+
+\"<b> This is bold text </b>\"
+ ^ ^ ^ ^
+ | | | |
+p1 p2 p3 p4
+
+Then the called function will typically format the text somewhat and
+remove the tags.")
+
+(defvar html2text-remove-tag-list2 '("li" "dt" "dd" "meta")
+ "Another list of removable tags.
+
+This is a list of tags which are removed similarly to the list
+`html2text-remove-tag-list' - but these tags are retained for the
+formatting, and then moved afterward.")
+
+;;
+;; </Global variables>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Utility functions>
+;;
+
+(defun html2text-buffer-head ()
+ (if (string= mode-name "Article")
+ (beginning-of-buffer)
+ (beginning-of-buffer)
+ )
+ )
+
+(defun html2text-replace-string (from-string to-string p1 p2)
+ (goto-char p1)
+ (let ((delta (- (string-width to-string) (string-width from-string)))
+ (change 0))
+ (while (search-forward from-string p2 t)
+ (replace-match to-string)
+ (setq change (+ change delta))
+ )
+ change
+ )
+ )
+
+;;
+;; </Utility functions>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions related to attributes> i.e. <font size=+3>
+;;
+
+(defun html2text-attr-value (attr-list attr)
+ (nth 1 (assoc attr attr-list))
+ )
+
+(defun html2text-get-attr (p1 p2 tag)
+ (goto-char p1)
+ (re-search-forward " +[^ ]" p2 t)
+ (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
+ (tmp-list (split-string attr-string))
+ (attr-list)
+ (counter 0)
+ (prev (car tmp-list))
+ (this (nth 1 tmp-list))
+ (next (nth 2 tmp-list))
+ (index 1))
+
+ (cond
+ ;; size=3
+ ((string-match "[^ ]=[^ ]" prev)
+ (let ((attr (nth 0 (split-string prev "=")))
+ (value (nth 1 (split-string prev "="))))
+ (setq attr-list (cons (list attr value) attr-list))
+ )
+ )
+ ;; size= 3
+ ((string-match "[^ ]=\\'" prev)
+ (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))
+ )
+ )
+
+ (while (< index (length tmp-list))
+ (cond
+ ;; size=3
+ ((string-match "[^ ]=[^ ]" this)
+ (let ((attr (nth 0 (split-string this "=")))
+ (value (nth 1 (split-string this "="))))
+ (setq attr-list (cons (list attr value) attr-list))
+ )
+ )
+ ;; size =3
+ ((string-match "\\`=[^ ]" this)
+ (setq attr-list (cons (list prev (substring this 1)) attr-list)))
+
+ ;; size= 3
+ ((string-match "[^ ]=\\'" this)
+ (setq attr-list (cons (list (substring this 0 -1) next) attr-list))
+ )
+
+ ;; size = 3
+ ((string= "=" this)
+ (setq attr-list (cons (list prev next) attr-list))
+ )
+ )
+ (setq index (1+ index))
+ (setq prev this)
+ (setq this next)
+ (setq next (nth (1+ index) tmp-list))
+ )
+
+ ;;
+ ;; Tags with no accompanying "=" i.e. value=nil
+ ;;
+ (setq prev (car tmp-list))
+ (setq this (nth 1 tmp-list))
+ (setq next (nth 2 tmp-list))
+ (setq index 1)
+
+ (if (not (string-match "=" prev))
+ (progn
+ (if (not (string= (substring this 0 1) "="))
+ (setq attr-list (cons (list prev nil) attr-list))
+ )
+ )
+ )
+
+ (while (< index (1- (length tmp-list)))
+ (if (not (string-match "=" this))
+ (if (not (or (string= (substring next 0 1) "=")
+ (string= (substring prev -1) "=")))
+ (setq attr-list (cons (list this nil) attr-list))
+ )
+ )
+ (setq index (1+ index))
+ (setq prev this)
+ (setq this next)
+ (setq next (nth (1+ index) tmp-list))
+ )
+
+ (if this
+ (progn
+ (if (not (string-match "=" this))
+ (progn
+ (if (not (string= (substring prev -1) "="))
+ (setq attr-list (cons (list this nil) attr-list))
+ )
+ )
+ )
+ )
+ )
+ attr-list ;; return - value
+ )
+ )
+
+;;
+;; </Functions related to attributes>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to format a tag-pair>
+;;
+(defun html2text-clean-list-items (p1 p2 list-type)
+ (goto-char p1)
+ (let ((item-nr 0)
+ (items 0))
+ (while (re-search-forward "<li>" p2 t)
+ (setq items (1+ items)))
+ (goto-char p1)
+ (while (< item-nr items)
+ (setq item-nr (1+ item-nr))
+ (re-search-forward "<li>" (point-max) t)
+ (cond
+ ((string= list-type "ul") (insert " o "))
+ ((string= list-type "ol") (insert (format " %s: " item-nr)))
+ (t (insert " x ")))
+ )
+ )
+ )
+
+(defun html2text-clean-dtdd (p1 p2)
+ (goto-char p1)
+ (let ((items 0)
+ (item-nr 0))
+ (while (re-search-forward "<dt>" p2 t)
+ (setq items (1+ items)))
+ (goto-char p1)
+ (while (< item-nr items)
+ (setq item-nr (1+ item-nr))
+ (re-search-forward "<dt>\\([ ]*\\)" (point-max) t)
+ (when (match-string 1)
+ (delete-region (point) (- (point) (string-width (match-string 1)))))
+ (let ((def-p1 (point))
+ (def-p2 0))
+ (re-search-forward "\\([ ]*\\)\\(</dt>\\|<dd>\\)" (point-max) t)
+ (if (match-string 1)
+ (progn
+ (let* ((mw1 (string-width (match-string 1)))
+ (mw2 (string-width (match-string 2)))
+ (mw (+ mw1 mw2)))
+ (goto-char (- (point) mw))
+ (delete-region (point) (+ (point) mw1))
+ (setq def-p2 (point))))
+ (setq def-p2 (- (point) (string-width (match-string 2)))))
+ (put-text-property def-p1 def-p2 'face 'bold)))))
+
+(defun html2text-delete-tags (p1 p2 p3 p4)
+ (delete-region p1 p2)
+ (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1))))
+
+(defun html2text-delete-single-tag (p1 p2)
+ (delete-region p1 p2))
+
+(defun html2text-clean-hr (p1 p2)
+ (html2text-delete-single-tag p1 p2)
+ (goto-char p1)
+ (newline 1)
+ (insert (make-string fill-column ?-))
+ )
+
+(defun html2text-clean-ul (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")
+ )
+
+(defun html2text-clean-ol (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")
+ )
+
+(defun html2text-clean-dl (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (html2text-clean-dtdd p1 (- p3 (- p1 p2)))
+ )
+
+(defun html2text-clean-center (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ (center-region p1 (- p3 (- p2 p1)))
+ )
+
+(defun html2text-clean-bold (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'bold)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-title (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'bold)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-underline (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'underline)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-italic (p1 p2 p3 p4)
+ (put-text-property p2 p3 'face 'italic)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-font (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-blockquote (p1 p2 p3 p4)
+ (html2text-delete-tags p1 p2 p3 p4)
+ )
+
+(defun html2text-clean-anchor (p1 p2 p3 p4)
+ ;; If someone can explain how to make the URL clickable I will
+ ;; surely improve upon this.
+ (let* ((attr-list (html2text-get-attr p1 p2 "a"))
+ (href (html2text-attr-value attr-list "href")))
+ (delete-region p1 p4)
+ (when href
+ (goto-char p1)
+ (insert (substring href 1 -1 ))
+ (put-text-property p1 (point) 'face 'bold))))
+
+;;
+;; </Functions to be called to format a tag-pair>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Functions to be called to fix up paragraphs>
+;;
+
+(defun html2text-fix-paragraph (p1 p2)
+ (goto-char p1)
+ (let ((has-br-line)
+ (refill-start)
+ (refill-stop))
+ (if (re-search-forward "<br>$" p2 t)
+ (setq has-br-line t)
+ )
+ (if has-br-line
+ (progn
+ (goto-char p1)
+ (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
+ (progn
+ (beginning-of-line)
+ (setq refill-start (point))
+ (goto-char p2)
+ (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
+ (next-line 1)
+ (end-of-line)
+ ;; refill-stop should ideally be adjusted to
+ ;; accomodate the "<br>" strings which are removed
+ ;; between refill-start and refill-stop. Can simply
+ ;; be returned from my-replace-string
+ (setq refill-stop (+ (point)
+ (html2text-replace-string
+ "<br>" ""
+ refill-start (point))))
+ ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
+ ;; (sleep-for 4)
+ (fill-region refill-start refill-stop)
+ )
+ )
+ )
+ )
+ )
+ (html2text-replace-string "<br>" "" p1 p2)
+ )
+
+;;
+;; This one is interactive ...
+;;
+(defun html2text-fix-paragraphs ()
+ "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook
+fashion, quite close to pure guess-work. It does work in some cases though."
+ (interactive)
+ (html2text-buffer-head)
+ (replace-regexp "^<br>$" "")
+ ;; Removing lonely <br> on a single line, if they are left intact we
+ ;; dont have any paragraphs at all.
+ (html2text-buffer-head)
+ (while (not (eobp))
+ (let ((p1 (point)))
+ (forward-paragraph 1)
+ ;;(message "Kaller fix med p1=%s p2=%s " p1 (1- (point))) (sleep-for 5)
+ (html2text-fix-paragraph p1 (1- (point)))
+ (goto-char p1)
+ (when (not (eobp))
+ (forward-paragraph 1)))))
+
+;;
+;; </Functions to be called to fix up paragraphs>
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;; <Interactive functions>
+;;
+
+(defun html2text-remove-tags (tag-list)
+ "Removes the tags listed in the list \"html2text-remove-tag-list\".
+See the documentation for that variable."
+ (interactive)
+ (dolist (tag tag-list)
+ (html2text-buffer-head)
+ (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
+ (delete-region (match-beginning 0) (match-end 0)))))
+
+(defun html2text-format-tags ()
+ "See the variable \"html2text-format-tag-list\" for documentation"
+ (interactive)
+ (dolist (tag-and-function html2text-format-tag-list)
+ (let ((tag (car tag-and-function))
+ (function (cdr tag-and-function)))
+ (html2text-buffer-head)
+ (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+ (point-max) t)
+ (let ((p1)
+ (p2 (point))
+ (p3) (p4)
+ (attr (match-string 1)))
+ (search-backward "<" (point-min) t)
+ (setq p1 (point))
+ (re-search-forward (format "</%s>" tag) (point-max) t)
+ (setq p4 (point))
+ (search-backward "</" (point-min) t)
+ (setq p3 (point))
+ (funcall function p1 p2 p3 p4)
+ (goto-char p1)
+ )
+ )
+ )
+ )
+ )
+
+(defun html2text-substitute ()
+ "See the variable \"html2text-replace-list\" for documentation"
+ (interactive)
+ (dolist (e html2text-replace-list)
+ (html2text-buffer-head)
+ (let ((old-string (car e))
+ (new-string (cdr e)))
+ (html2text-replace-string old-string new-string (point-min) (point-max))
+ )
+ )
+ )
+
+(defun html2text-format-single-elements ()
+ ""
+ (interactive)
+ (dolist (tag-and-function html2text-format-single-element-list)
+ (let ((tag (car tag-and-function))
+ (function (cdr tag-and-function)))
+ (html2text-buffer-head)
+ (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
+ (point-max) t)
+ (let ((p1)
+ (p2 (point)))
+ (search-backward "<" (point-min) t)
+ (setq p1 (point))
+ (funcall function p1 p2)
+ )
+ )
+ )
+ )
+ )
+
+;;
+;; Main function
+;;
+
+;;;###autoload
+(defun html2text ()
+ "Convert HTML to plain text in the current buffer."
+ (interactive)
+ (save-excursion
+ (let ((case-fold-search t)
+ (buffer-read-only))
+ (html2text-remove-tags html2text-remove-tag-list)
+ (html2text-format-tags)
+ (html2text-remove-tags html2text-remove-tag-list2)
+ (html2text-substitute)
+ (html2text-format-single-elements)
+ (html2text-fix-paragraphs))))
+
+;;
+;; </Interactive functions>
+;;
+
+;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
+;;; html2text.el ends here
diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el
index a6e118ab5cf..f8837076b56 100644
--- a/lisp/gnus/ietf-drums.el
+++ b/lisp/gnus/ietf-drums.el
@@ -1,5 +1,5 @@
-;;; ietf-drums.el --- functions for parsing RFC822bis headers
-;; Copyright (C) 1998, 1999, 2000, 2002
+;;; ietf-drums.el --- Functions for parsing RFC822bis headers
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -27,6 +27,16 @@
;; Messages". This library is based on
;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
+;; Pending a real regression self test suite, Simon Josefsson added
+;; various self test expressions snipped from bug reports, and their
+;; expected value, below. I you believe it could be useful, please
+;; add your own test cases, or write a real self test suite, or just
+;; remove this.
+
+;; <m3oekvfd50.fsf@whitebox.m5r.de>
+;; (ietf-drums-parse-address "'foo' <foo@example.com>")
+;; => ("foo@example.com" . "'foo'")
+
;;; Code:
(eval-when-compile (require 'cl))
@@ -64,10 +74,14 @@ backslash and doublequote.")
(modify-syntax-entry ?> ")" table)
(modify-syntax-entry ?@ "w" table)
(modify-syntax-entry ?/ "w" table)
- (modify-syntax-entry ?= " " table)
- (modify-syntax-entry ?* " " table)
- (modify-syntax-entry ?\; " " table)
- (modify-syntax-entry ?\' " " table)
+ (modify-syntax-entry ?* "_" table)
+ (modify-syntax-entry ?\; "_" table)
+ (modify-syntax-entry ?\' "_" table)
+ (if (featurep 'xemacs)
+ (let ((i 128))
+ (while (< i 256)
+ (modify-syntax-entry i "w" table)
+ (setq i (1+ i)))))
table))
(defun ietf-drums-token-to-list (token)
@@ -200,25 +214,38 @@ backslash and doublequote.")
(defun ietf-drums-parse-addresses (string)
"Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
- (with-temp-buffer
- (ietf-drums-init string)
- (let ((beg (point))
- pairs c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((memq c '(?\" ?< ?\())
- (forward-sexp 1))
- ((eq c ?,)
- (push (ietf-drums-parse-address (buffer-substring beg (point)))
- pairs)
- (forward-char 1)
- (setq beg (point)))
- (t
- (forward-char 1))))
- (push (ietf-drums-parse-address (buffer-substring beg (point)))
- pairs)
- (nreverse pairs))))
+ (if (null string)
+ nil
+ (with-temp-buffer
+ (ietf-drums-init string)
+ (let ((beg (point))
+ pairs c address)
+ (while (not (eobp))
+ (setq c (char-after))
+ (cond
+ ((memq c '(?\" ?< ?\())
+ (condition-case nil
+ (forward-sexp 1)
+ (error
+ (skip-chars-forward "^,"))))
+ ((eq c ?,)
+ (setq address
+ (condition-case nil
+ (ietf-drums-parse-address
+ (buffer-substring beg (point)))
+ (error nil)))
+ (if address (push address pairs))
+ (forward-char 1)
+ (setq beg (point)))
+ (t
+ (forward-char 1))))
+ (setq address
+ (condition-case nil
+ (ietf-drums-parse-address
+ (buffer-substring beg (point)))
+ (error nil)))
+ (if address (push address pairs))
+ (nreverse pairs)))))
(defun ietf-drums-unfold-fws ()
"Unfold folding white space in the current buffer."
diff --git a/lisp/gnus/imap.el b/lisp/gnus/imap.el
index 45c7ba4bbbf..f53aeb32ca1 100644
--- a/lisp/gnus/imap.el
+++ b/lisp/gnus/imap.el
@@ -1,5 +1,5 @@
;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
@@ -125,6 +125,7 @@
;; o Don't use `read' at all (important places already fixed)
;; o Accept list of articles instead of message set string in most
;; imap-message-* functions.
+;; o Send strings as literal if they contain, e.g., ".
;;
;; Revision history:
;;
@@ -152,6 +153,7 @@
(autoload 'utf7-decode "utf7")
(autoload 'format-spec "format-spec")
(autoload 'format-spec-make "format-spec")
+ (autoload 'open-tls-stream "tls")
;; Avoid use gnus-point-at-eol so we're independent of Gnus. These
;; days we have point-at-eol anyhow.
(if (fboundp 'point-at-eol)
@@ -178,7 +180,12 @@ the list is tried until a successful connection is made."
:group 'imap
:type '(repeat string))
-(defcustom imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
+(defcustom imap-gssapi-program (list
+ (concat "gsasl --client --connect %s:%p "
+ "--imap --application-data "
+ "--mechanism GSSAPI "
+ "--authentication-id %l")
+ "imtest -m gssapi -u %l -p %p %s")
"List of strings containing commands for GSSAPI (krb5) authentication.
%s is replaced with server hostname, %p with port to connect to, and
%l with the value of `imap-default-user'. The program should accept
@@ -213,26 +220,67 @@ until a successful connection is made."
:group 'imap
:type '(repeat string))
-(defvar imap-shell-host "gateway"
- "Hostname of rlogin proxy.")
+(defcustom imap-process-connection-type nil
+ "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
+The `process-connection-type' variable control type of device
+used to communicate with subprocesses. Values are nil to use a
+pipe, or t or `pty' to use a pty. The value has no effect if the
+system has no ptys or if all ptys are busy: then a pipe is used
+in any case. The value takes effect when a IMAP server is
+opened, changing it after that has no effect.."
+ :group 'imap
+ :type 'boolean)
-(defvar imap-default-user (user-login-name)
- "Default username to use.")
+(defcustom imap-use-utf7 t
+ "If non-nil, do utf7 encoding/decoding of mailbox names.
+Since the UTF7 decoding currently only decodes into ISO-8859-1
+characters, you may disable this decoding if you need to access UTF7
+encoded mailboxes which doesn't translate into ISO-8859-1."
+ :group 'imap
+ :type 'boolean)
-(defvar imap-error nil
- "Error codes from the last command.")
+(defcustom imap-log nil
+ "If non-nil, a imap session trace is placed in *imap-log* buffer."
+ :group 'imap
+ :type 'boolean)
+
+(defcustom imap-debug nil
+ "If non-nil, random debug spews are placed in *imap-debug* buffer."
+ :group 'imap
+ :type 'boolean)
+
+(defcustom imap-shell-host "gateway"
+ "Hostname of rlogin proxy."
+ :group 'imap
+ :type 'string)
+
+(defcustom imap-default-user (user-login-name)
+ "Default username to use."
+ :group 'imap
+ :type 'string)
+
+(defcustom imap-read-timeout (if (string-match
+ "windows-nt\\|os/2\\|emx\\|cygwin"
+ (symbol-name system-type))
+ 1.0
+ 0.1)
+ "*How long to wait between checking for the end of output.
+Shorter values mean quicker response, but is more CPU intensive."
+ :type 'number
+ :group 'imap)
;; Various variables.
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
-(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
+(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
"Priority of streams to consider when opening connection to server.")
(defvar imap-stream-alist
'((gssapi imap-gssapi-stream-p imap-gssapi-open)
(kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
+ (tls imap-tls-p imap-tls-open)
(ssl imap-ssl-p imap-ssl-open)
(network imap-network-p imap-network-open)
(shell imap-shell-p imap-shell-open)
@@ -242,7 +290,7 @@ until a successful connection is made."
\(NAME CHECK OPEN)
NAME names the stream, CHECK is a function returning non-nil if the
-server supports the stream and OPEN is a function for opening the
+server support the stream and OPEN is a function for opening the
stream.")
(defvar imap-authenticators '(gssapi
@@ -268,16 +316,14 @@ NAME names the authenticator. CHECK is a function returning non-nil if
the server support the authenticator and AUTHENTICATE is a function
for doing the actual authentication.")
-(defvar imap-use-utf7 t
- "If non-nil, do utf7 encoding/decoding of mailbox names.
-Since the UTF7 decoding currently only decodes into ISO-8859-1
-characters, you may disable this decoding if you need to access UTF7
-encoded mailboxes which doesn't translate into ISO-8859-1.")
+(defvar imap-error nil
+ "Error codes from the last command.")
;; Internal constants. Change theese and die.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
+(defconst imap-default-tls-port 993)
(defconst imap-default-stream 'network)
(defconst imap-coding-system-for-read 'binary)
(defconst imap-coding-system-for-write 'binary)
@@ -301,6 +347,8 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
imap-process
imap-calculate-literal-size-first
imap-mailbox-data))
+(defconst imap-log-buffer "*imap-log*")
+(defconst imap-debug-buffer "*imap-debug*")
;; Internal variables.
@@ -368,38 +416,31 @@ human readable response text (a string).")
"Non-nil indicates that the server emitted a continuation request.
The actual value is really the text on the continuation line.")
-(defvar imap-log nil
- "Name of buffer for imap session trace.
-For example: (setq imap-log \"*imap-log*\")")
-
-(defvar imap-debug nil ;"*imap-debug*"
- "Name of buffer for random debug spew.
-For example: (setq imap-debug \"*imap-debug*\")")
+(defvar imap-callbacks nil
+ "List of response tags and callbacks, on the form `(number . function)'.
+The function should take two arguments, the first the IMAP tag and the
+second the status (OK, NO, BAD etc) of the command.")
;; Utility functions:
+(defun imap-remassoc (key alist)
+ "Delete by side effect any elements of LIST whose car is `equal' to KEY.
+The modified LIST is returned. If the first member
+of LIST has a car that is `equal' to KEY, there is no way to remove it
+by side effect; therefore, write `(setq foo (remassoc key foo))' to be
+sure of changing the value of `foo'."
+ (when alist
+ (if (equal key (caar alist))
+ (cdr alist)
+ (setcdr alist (imap-remassoc key (cdr alist)))
+ alist)))
+
(defsubst imap-disable-multibyte ()
"Enable multibyte in the current buffer."
(when (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil)))
-(defun imap-read-passwd (prompt &rest args)
- "Read a password using PROMPT.
-If ARGS, PROMPT is used as an argument to `format'."
- (let ((prompt (if args
- (apply 'format prompt args)
- prompt)))
- (funcall (if (or (fboundp 'read-passwd)
- (and (load "subr" t)
- (fboundp 'read-passwd))
- (and (load "passwd" t)
- (fboundp 'read-passwd)))
- 'read-passwd
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- 'ange-ftp-read-passwd)
- prompt)))
-
(defsubst imap-utf7-encode (string)
(if imap-use-utf7
(and string
@@ -447,6 +488,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
+ (process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
@@ -461,9 +503,17 @@ If ARGS, PROMPT is used as an argument to `format'."
(setq imap-client-eol "\n"
imap-calculate-literal-size-first t)
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
- ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
+ ;; Athena IMTEST can output SSL verify errors
+ (or (while (looking-at "^verify error:num=")
+ (forward-line))
+ t)
+ (or (while (looking-at "^TLS connection established")
+ (forward-line))
+ t)
+ ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
+ (or (while (looking-at "^C:")
(forward-line))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
@@ -481,7 +531,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(accept-process-output process 1)
(sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
@@ -493,7 +543,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-send-command "LOGOUT"))
(delete-process process)
nil)))))
done))
@@ -506,9 +556,11 @@ If ARGS, PROMPT is used as an argument to `format'."
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "Opening GSSAPI IMAP connection with `%s'..." cmd)
+ (erase-buffer)
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
+ (process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
@@ -520,11 +572,13 @@ If ARGS, PROMPT is used as an argument to `format'."
response)
(when process
(with-current-buffer buffer
- (setq imap-client-eol "\n")
+ (setq imap-client-eol "\n"
+ imap-calculate-literal-size-first t)
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
- ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
+ ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
+ (or (while (looking-at "^C:")
(forward-line))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
@@ -534,12 +588,15 @@ If ARGS, PROMPT is used as an argument to `format'."
(not (and (imap-parse-greeting)
;; success in imtest 1.6:
(re-search-forward
- "^\\(Authenticat.*\\)" nil t)
+ (concat "^\\(\\(Authenticat.*\\)\\|\\("
+ "Client authentication "
+ "finished.*\\)\\)")
+ nil t)
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
@@ -550,7 +607,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-send-command "LOGOUT"))
(delete-process process)
nil)))))
done))
@@ -565,16 +622,17 @@ If ARGS, PROMPT is used as an argument to `format'."
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening SSL connection with `%s'..." cmd)
+ (erase-buffer)
(let* ((port (or port imap-default-ssl-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
(process-connection-type nil)
process)
(when (progn
- (setq process (start-process
+ (setq process (start-process
name buffer shell-file-name
shell-command-switch
- (format-spec cmd
+ (format-spec cmd
(format-spec-make
?s server
?p (number-to-string port)))))
@@ -590,7 +648,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(accept-process-output process 1)
(sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
@@ -602,9 +660,34 @@ If ARGS, PROMPT is used as an argument to `format'."
(progn
(message "imap: Opening SSL connection with `%s'...done" cmd)
done)
- (message "imap: Opening SSL connection with `%s'...failed" cmd)
+ (message "imap: Opening SSL connection with `%s'...failed" cmd)
nil)))
+(defun imap-tls-p (buffer)
+ nil)
+
+(defun imap-tls-open (name buffer server port)
+ (let* ((port (or port imap-default-tls-port))
+ (coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (process (open-tls-stream name buffer server port)))
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (imap-parse-greeting)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer)))
+ (when (memq (process-status process) '(open run))
+ process))))
+
(defun imap-network-p (buffer)
t)
@@ -615,12 +698,13 @@ If ARGS, PROMPT is used as an argument to `format'."
(process (open-network-stream name buffer server port)))
(when process
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
@@ -632,7 +716,8 @@ If ARGS, PROMPT is used as an argument to `format'."
nil)
(defun imap-shell-open (name buffer server port)
- (let ((cmds imap-shell-program)
+ (let ((cmds (if (listp imap-shell-program) imap-shell-program
+ (list imap-shell-program)))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening IMAP connection with `%s'..." cmd)
@@ -651,68 +736,66 @@ If ARGS, PROMPT is used as an argument to `format'."
?l imap-default-user)))))
(when process
(while (and (memq (process-status process) '(open run))
- (goto-char (point-min))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (erase-buffer)
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
+ (erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process)))))
(if done
(progn
(message "imap: Opening IMAP connection with `%s'...done" cmd)
done)
- (message "imap: Opening IMAP connection with `%s'...failed" cmd)
+ (message "imap: Opening IMAP connection with `%s'...failed" cmd)
nil)))
(defun imap-starttls-p (buffer)
- (and (imap-capability 'STARTTLS buffer)
- (condition-case ()
- (progn
- (require 'starttls)
- (call-process "starttls"))
- (error nil))))
+ (imap-capability 'STARTTLS buffer))
(defun imap-starttls-open (name buffer server port)
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
(process (starttls-open-stream name buffer server port))
- done)
+ done tls-info)
(message "imap: Connecting with STARTTLS...")
(when process
(while (and (memq (process-status process) '(open run))
- (goto-char (point-min))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
+ (imap-send-command "STARTTLS")
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
+ (accept-process-output process 1)
+ (sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
- (let ((imap-process process))
- (unwind-protect
- (progn
- (set-process-filter imap-process 'imap-arrival-filter)
- (when (and (eq imap-stream 'starttls)
- (imap-ok-p (imap-send-command-wait "STARTTLS")))
- (starttls-negotiate imap-process)))
- (set-process-filter imap-process nil)))
- (when (memq (process-status process) '(open run))
+ (when (and (setq tls-info (starttls-negotiate process))
+ (memq (process-status process) '(open run)))
(setq done process)))
- (if done
- (progn
- (message "imap: Connecting with STARTTLS...done")
- done)
- (message "imap: Connecting with STARTTLS...failed")
- nil)))
+ (if (stringp tls-info)
+ (message "imap: STARTTLS info: %s" tls-info))
+ (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
+ done))
;; Server functions; authenticator stuff:
@@ -729,12 +812,15 @@ Returns t if login was successful, nil otherwise."
(while (or (not user) (not passwd))
(setq user (or imap-username
(read-from-minibuffer
- (concat "IMAP username for " imap-server ": ")
+ (concat "IMAP username for " imap-server
+ " (using stream `" (symbol-name imap-stream)
+ "'): ")
(or user imap-default-user))))
(setq passwd (or imap-password
- (imap-read-passwd
+ (read-passwd
(concat "IMAP password for " user "@"
- imap-server ": "))))
+ imap-server " (using authenticator `"
+ (symbol-name imap-auth) "'): "))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
@@ -745,6 +831,7 @@ Returns t if login was successful, nil otherwise."
(setq imap-password passwd)))
(message "Login failed...")
(setq passwd nil)
+ (setq imap-password nil)
(sit-for 1))))
;; (quit (with-current-buffer buffer
;; (setq user nil
@@ -755,7 +842,7 @@ Returns t if login was successful, nil otherwise."
ret)))
(defun imap-gssapi-auth-p (buffer)
- (imap-capability 'AUTH=GSSAPI buffer))
+ (eq imap-stream 'gssapi))
(defun imap-gssapi-auth (buffer)
(message "imap: Authenticating using GSSAPI...%s"
@@ -763,7 +850,8 @@ Returns t if login was successful, nil otherwise."
(eq imap-stream 'gssapi))
(defun imap-kerberos4-auth-p (buffer)
- (imap-capability 'AUTH=KERBEROS_V4 buffer))
+ (and (imap-capability 'AUTH=KERBEROS_V4 buffer)
+ (eq imap-stream 'kerberos4)))
(defun imap-kerberos4-auth (buffer)
(message "imap: Authenticating using Kerberos 4...%s"
@@ -793,8 +881,6 @@ Returns t if login was successful, nil otherwise."
(message "imap: Authenticating using CRAM-MD5...done")
(message "imap: Authenticating using CRAM-MD5...failed"))))
-
-
(defun imap-login-p (buffer)
(and (not (imap-capability 'LOGINDISABLED buffer))
(not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
@@ -898,46 +984,53 @@ necessary. If nil, the buffer name is generated."
(setq imap-auth (or auth imap-auth))
(setq imap-stream (or stream imap-stream))
(message "imap: Connecting to %s..." imap-server)
- (if (let ((imap-stream (or imap-stream imap-default-stream)))
- (imap-open-1 buffer))
- ;; Choose stream.
- (let (stream-changed)
- (message "imap: Connecting to %s...done" imap-server)
- (when (null imap-stream)
- (let ((streams imap-streams))
- (while (setq stream (pop streams))
- (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
- (setq stream-changed (not (eq (or imap-stream
- imap-default-stream)
- stream))
- imap-stream stream
- streams nil)))
- (unless imap-stream
- (error "Couldn't figure out a stream for server"))))
- (when stream-changed
- (message "imap: Reconnecting with stream `%s'..." imap-stream)
- (imap-close buffer)
- (if (imap-open-1 buffer)
- (message "imap: Reconnecting with stream `%s'...done"
- imap-stream)
- (message "imap: Reconnecting with stream `%s'...failed"
- imap-stream))
- (setq imap-capability nil))
- (if (imap-opened buffer)
- ;; Choose authenticator
- (when (and (null imap-auth) (not (eq imap-state 'auth)))
- (let ((auths imap-authenticators))
- (while (setq auth (pop auths))
- (if (funcall (nth 1 (assq auth imap-authenticator-alist))
- buffer)
- (setq imap-auth auth
- auths nil)))
- (unless imap-auth
- (error "Couldn't figure out authenticator for server"))))))
- (message "imap: Connecting to %s...failed" imap-server))
- (when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
- buffer)))
+ (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
+ (imap-open-1 buffer)))
+ (progn
+ (message "imap: Connecting to %s...failed" imap-server)
+ nil)
+ (when (null imap-stream)
+ ;; Need to choose stream.
+ (let ((streams imap-streams))
+ (while (setq stream (pop streams))
+ ;; OK to use this stream?
+ (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
+ ;; Stream changed?
+ (if (not (eq imap-default-stream stream))
+ (with-current-buffer (get-buffer-create
+ (generate-new-buffer-name " *temp*"))
+ (mapcar 'make-local-variable imap-local-variables)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (setq imap-server (or server imap-server))
+ (setq imap-port (or port imap-port))
+ (setq imap-auth (or auth imap-auth))
+ (message "imap: Reconnecting with stream `%s'..." stream)
+ (if (null (let ((imap-stream stream))
+ (imap-open-1 (current-buffer))))
+ (progn
+ (kill-buffer (current-buffer))
+ (message
+ "imap: Reconnecting with stream `%s'...failed"
+ stream))
+ ;; We're done, kill the first connection
+ (imap-close buffer)
+ (kill-buffer buffer)
+ (rename-buffer buffer)
+ (message "imap: Reconnecting with stream `%s'...done"
+ stream)
+ (setq imap-stream stream)
+ (setq imap-capability nil)
+ (setq streams nil)))
+ ;; We're done
+ (message "imap: Connecting to %s...done" imap-server)
+ (setq imap-stream stream)
+ (setq imap-capability nil)
+ (setq streams nil))))))
+ (when (imap-opened buffer)
+ (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ (when imap-stream
+ buffer))))
(defun imap-opened (&optional buffer)
"Return non-nil if connection to imap server in BUFFER is open.
@@ -964,16 +1057,36 @@ password is remembered in the buffer."
(make-local-variable 'imap-password)
(if user (setq imap-username user))
(if passwd (setq imap-password passwd))
- (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)
- (setq imap-state 'auth)))))
+ (if imap-auth
+ (and (funcall (nth 2 (assq imap-auth
+ imap-authenticator-alist)) buffer)
+ (setq imap-state 'auth))
+ ;; Choose authenticator.
+ (let ((auths imap-authenticators)
+ auth)
+ (while (setq auth (pop auths))
+ ;; OK to use authenticator?
+ (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
+ (message "imap: Authenticating to `%s' using `%s'..."
+ imap-server auth)
+ (setq imap-auth auth)
+ (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
+ (progn
+ (message "imap: Authenticating to `%s' using `%s'...done"
+ imap-server auth)
+ (setq auths nil))
+ (message "imap: Authenticating to `%s' using `%s'...failed"
+ imap-server auth)))))
+ imap-state))))
(defun imap-close (&optional buffer)
"Close connection to server in BUFFER.
If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
- (and (imap-opened)
- (not (imap-ok-p (imap-send-command-wait "LOGOUT")))
- (message "Server %s didn't let me log out" imap-server))
+ (when (imap-opened)
+ (condition-case nil
+ (imap-send-command-wait "LOGOUT")
+ (quit nil)))
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
@@ -1105,22 +1218,38 @@ If EXAMINE is non-nil, do a read-only select."
imap-state 'auth)
t)))
-(defun imap-mailbox-expunge (&optional buffer)
+(defun imap-mailbox-expunge (&optional asynch buffer)
"Expunge articles in current folder in BUFFER.
+If ASYNCH, do not wait for succesful completion of the command.
If BUFFER is nil the current buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
(when (and imap-current-mailbox (not (eq imap-state 'examine)))
- (imap-ok-p (imap-send-command-wait "EXPUNGE")))))
+ (if asynch
+ (imap-send-command "EXPUNGE")
+ (imap-ok-p (imap-send-command-wait "EXPUNGE"))))))
-(defun imap-mailbox-close (&optional buffer)
+(defun imap-mailbox-close (&optional asynch buffer)
"Expunge articles and close current folder in BUFFER.
+If ASYNCH, do not wait for succesful completion of the command.
If BUFFER is nil the current buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
- (when (and imap-current-mailbox
- (imap-ok-p (imap-send-command-wait "CLOSE")))
- (setq imap-current-mailbox nil
- imap-message-data nil
- imap-state 'auth)
+ (when imap-current-mailbox
+ (if asynch
+ (imap-add-callback (imap-send-command "CLOSE")
+ `(lambda (tag status)
+ (message "IMAP mailbox `%s' closed... %s"
+ imap-current-mailbox status)
+ (when (eq ,imap-current-mailbox
+ imap-current-mailbox)
+ ;; Don't wipe out data if another mailbox
+ ;; was selected...
+ (setq imap-current-mailbox nil
+ imap-message-data nil
+ imap-state 'auth))))
+ (when (imap-ok-p (imap-send-command-wait "CLOSE"))
+ (setq imap-current-mailbox nil
+ imap-message-data nil
+ imap-state 'auth)))
t)))
(defun imap-mailbox-create-1 (mailbox)
@@ -1225,16 +1354,31 @@ returned, if ITEMS is a symbol only its value is returned."
(imap-send-command-wait (list "STATUS \""
(imap-utf7-encode mailbox)
"\" "
- (format "%s"
- (if (listp items)
- items
- (list items))))))
+ (upcase
+ (format "%s"
+ (if (listp items)
+ items
+ (list items)))))))
(if (listp items)
(mapcar (lambda (item)
(imap-mailbox-get item mailbox))
items)
(imap-mailbox-get items mailbox)))))
+(defun imap-mailbox-status-asynch (mailbox items &optional buffer)
+ "Send status item request ITEM on MAILBOX to server in BUFFER.
+ITEMS can be a symbol or a list of symbols, valid symbols are one of
+the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
+or 'unseen. The IMAP command tag is returned."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-send-command (list "STATUS \""
+ (imap-utf7-encode mailbox)
+ "\" "
+ (format "%s"
+ (if (listp items)
+ items
+ (list items)))))))
+
(defun imap-mailbox-acl-get (&optional mailbox buffer)
"Get ACL on mailbox from server in BUFFER."
(let ((mailbox (imap-utf7-encode mailbox)))
@@ -1286,8 +1430,8 @@ returned, if ITEMS is a symbol only its value is returned."
(mapconcat
(lambda (item)
(if (consp item)
- (format "%d:%d"
- (car item) (cdr item))
+ (format "%d:%d"
+ (car item) (cdr item))
(format "%d" item)))
(if (and (listp range) (not (listp (cdr range))))
(list range) ;; make (1 . 2) into ((1 . 2))
@@ -1398,7 +1542,9 @@ is non-nil return theese properties."
(imap-mailbox-put 'search 'dummy)
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
(if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
- (error "Missing SEARCH response to a SEARCH command")
+ (progn
+ (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...")
+ nil)
(imap-mailbox-get-1 'search imap-current-mailbox)))))
(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
@@ -1464,8 +1610,11 @@ first element, rest of list contain the saved articles' UIDs."
(if (imap-ok-p (imap-send-command-wait cmd))
t
(when (and (not dont-create)
- (imap-mailbox-get-1 'trycreate mailbox))
- (imap-mailbox-create-1 mailbox)
+ ;; removed because of buggy Oracle server
+ ;; that doesn't send TRYCREATE tags (which
+ ;; is a MUST according to specifications):
+ ;;(imap-mailbox-get-1 'trycreate mailbox)
+ (imap-mailbox-create-1 mailbox))
(imap-ok-p (imap-send-command-wait cmd)))))
(or no-copyuid
(imap-message-copyuid-1 mailbox)))))))
@@ -1530,10 +1679,13 @@ on failure."
;; Internal functions.
+(defun imap-add-callback (tag func)
+ (setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
+
(defun imap-send-command-1 (cmdstr)
(setq cmdstr (concat cmdstr imap-client-eol))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
@@ -1570,14 +1722,14 @@ on failure."
(imap-send-command-1 cmdstr)
(setq cmdstr nil)
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil);; abort command if no cont-req
+ (setq command nil) ;; abort command if no cont-req
(let ((process imap-process)
(stream imap-stream)
(eol imap-client-eol))
(with-current-buffer cmd
(and imap-log
(with-current-buffer (get-buffer-create
- imap-log)
+ imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
@@ -1591,7 +1743,7 @@ on failure."
(setq cmdstr nil)
(unwind-protect
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil);; abort command if no cont-req
+ (setq command nil) ;; abort command if no cont-req
(setq command (cons (funcall cmd imap-continuation)
command)))
(setq imap-continuation nil)))
@@ -1603,15 +1755,34 @@ on failure."
(defun imap-wait-for-tag (tag &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (while (and (null imap-continuation)
- (< imap-reached-tag tag))
- (or (and (not (memq (process-status imap-process) '(open run)))
- (sit-for 1))
- (accept-process-output imap-process 1)))
- (or (assq tag imap-failed-tags)
- (if imap-continuation
- 'INCOMPLETE
- 'OK))))
+ (let (imap-have-messaged)
+ (while (and (null imap-continuation)
+ (memq (process-status imap-process) '(open run))
+ (< imap-reached-tag tag))
+ (let ((len (/ (point-max) 1024))
+ message-log-max)
+ (unless (< len 10)
+ (setq imap-have-messaged t)
+ (message "imap read: %dk" len))
+ (accept-process-output imap-process
+ (truncate imap-read-timeout)
+ (truncate (* (- imap-read-timeout
+ (truncate imap-read-timeout))
+ 1000)))))
+ ;; A process can die _before_ we have processed everything it
+ ;; has to say. Moreover, this can happen in between the call to
+ ;; accept-process-output and the call to process-status in an
+ ;; iteration of the loop above.
+ (when (and (null imap-continuation)
+ (< imap-reached-tag tag))
+ (accept-process-output imap-process 0 0))
+ (when imap-have-messaged
+ (message ""))
+ (and (memq (process-status imap-process) '(open run))
+ (or (assq tag imap-failed-tags)
+ (if imap-continuation
+ 'INCOMPLETE
+ 'OK))))))
(defun imap-sentinel (process string)
(delete-process process))
@@ -1631,34 +1802,37 @@ Return nil if no complete line has arrived."
(defun imap-arrival-filter (proc string)
"IMAP process filter."
- (with-current-buffer (process-buffer proc)
- (goto-char (point-max))
- (insert string)
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert string)))
- (let (end)
- (goto-char (point-min))
- (while (setq end (imap-find-next-line))
- (save-restriction
- (narrow-to-region (point-min) end)
- (delete-backward-char (length imap-server-eol))
- (goto-char (point-min))
- (unwind-protect
- (cond ((eq imap-state 'initial)
- (imap-parse-greeting))
- ((or (eq imap-state 'auth)
- (eq imap-state 'nonauth)
- (eq imap-state 'selected)
- (eq imap-state 'examine))
- (imap-parse-response))
- (t
- (message "Unknown state %s in arrival filter"
- imap-state)))
- (delete-region (point-min) (point-max))))))))
+ ;; Sometimes, we are called even though the process has died.
+ ;; Better abstain from doing stuff in that case.
+ (when (buffer-name (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-max))
+ (insert string)
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert string)))
+ (let (end)
+ (goto-char (point-min))
+ (while (setq end (imap-find-next-line))
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (delete-backward-char (length imap-server-eol))
+ (goto-char (point-min))
+ (unwind-protect
+ (cond ((eq imap-state 'initial)
+ (imap-parse-greeting))
+ ((or (eq imap-state 'auth)
+ (eq imap-state 'nonauth)
+ (eq imap-state 'selected)
+ (eq imap-state 'examine))
+ (imap-parse-response))
+ (t
+ (message "Unknown state %s in arrival filter"
+ imap-state)))
+ (delete-region (point-min) (point-max)))))))))
;; Imap parser.
@@ -1803,7 +1977,8 @@ Return nil if no complete line has arrived."
(when (eq (char-after) ?\))
(imap-forward)
(nreverse addresses)))
- ;; (assert (imap-parse-nil)) ; With assert, the code might not be eval'd.
+ ;; With assert, the code might not be eval'd.
+ ;; (assert (imap-parse-nil) t "In imap-parse-address-list")
(imap-parse-nil)))
;; mailbox = "INBOX" / astring
@@ -1857,7 +2032,7 @@ Return nil if no complete line has arrived."
;; resp-cond-bye = "BYE" SP resp-text
;;
;; mailbox-data = "FLAGS" SP flag-list /
-;; "LIST" SP mailbox-list /
+;; "LIST" SP mailbox-list /
;; "LSUB" SP mailbox-list /
;; "SEARCH" *(SP nz-number) /
;; "STATUS" SP mailbox SP "("
@@ -1895,9 +2070,9 @@ Return nil if no complete line has arrived."
(read (concat "(" (buffer-substring (point) (point-max)) ")"))))
(STATUS (imap-parse-status))
(CAPABILITY (setq imap-capability
- (read (concat "(" (upcase (buffer-substring
- (point) (point-max)))
- ")"))))
+ (read (concat "(" (upcase (buffer-substring
+ (point) (point-max)))
+ ")"))))
(ACL (imap-parse-acl))
(t (case (prog1 (read (current-buffer))
(imap-forward))
@@ -1939,7 +2114,11 @@ Return nil if no complete line has arrived."
(push (list token status code text) imap-failed-tags)
(error "Internal error, tag %s status %s code %s text %s"
token status code text))))
- (t (message "Garbage: %s" (buffer-string))))))))))
+ (t (message "Garbage: %s" (buffer-string))))
+ (when (assq token imap-callbacks)
+ (funcall (cdr (assq token imap-callbacks)) token status)
+ (setq imap-callbacks
+ (imap-remassoc token imap-callbacks)))))))))
;; resp-text = ["[" resp-text-code "]" SP] text
;;
@@ -1958,7 +2137,7 @@ Return nil if no complete line has arrived."
;; [flag-perm *(SP flag-perm)] ")" /
;; "READ-ONLY" /
;; "READ-WRITE" /
-;; "TRYCREATE" /
+;; "TRYCREATE" /
;; "UIDNEXT" SP nz-number /
;; "UIDVALIDITY" SP nz-number /
;; "UNSEEN" SP nz-number /
@@ -2005,14 +2184,17 @@ Return nil if no complete line has arrived."
;; resp-text-atom = 1*<any ATOM-CHAR except "]">
(defun imap-parse-resp-text-code ()
+ ;; xxx next line for stalker communigate pro 3.3.1 bug
+ (when (looking-at " \\[")
+ (imap-forward))
(when (eq (char-after) ?\[)
(imap-forward)
(cond ((search-forward "PERMANENTFLAGS " nil t)
(imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
- ((search-forward "UIDNEXT " nil t)
- (imap-mailbox-put 'uidnext (read (current-buffer))))
+ ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
+ (imap-mailbox-put 'uidnext (match-string 1)))
((search-forward "UNSEEN " nil t)
- (imap-mailbox-put 'unseen (read (current-buffer))))
+ (imap-mailbox-put 'first-unseen (read (current-buffer))))
((looking-at "UIDVALIDITY \\([0-9]+\\)")
(imap-mailbox-put 'uidvalidity (match-string 1)))
((search-forward "READ-ONLY" nil t)
@@ -2111,15 +2293,19 @@ Return nil if no complete line has arrived."
(defun imap-parse-fetch (response)
(when (eq (char-after) ?\()
(let (uid flags envelope internaldate rfc822 rfc822header rfc822text
- rfc822size body bodydetail bodystructure)
+ rfc822size body bodydetail bodystructure flags-empty)
(while (not (eq (char-after) ?\)))
(imap-forward)
(let ((token (read (current-buffer))))
(imap-forward)
(cond ((eq token 'UID)
- (setq uid (ignore-errors (read (current-buffer)))))
+ (setq uid (condition-case ()
+ (read (current-buffer))
+ (error))))
((eq token 'FLAGS)
- (setq flags (imap-parse-flag-list)))
+ (setq flags (imap-parse-flag-list))
+ (if (not flags)
+ (setq flags-empty 't)))
((eq token 'ENVELOPE)
(setq envelope (imap-parse-envelope)))
((eq token 'INTERNALDATE)
@@ -2148,7 +2334,7 @@ Return nil if no complete line has arrived."
(when uid
(setq imap-current-message uid)
(imap-message-put uid 'UID uid)
- (and flags (imap-message-put uid 'FLAGS flags))
+ (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
(and envelope (imap-message-put uid 'ENVELOPE envelope))
(and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
(and rfc822 (imap-message-put uid 'RFC822 rfc822))
@@ -2171,24 +2357,32 @@ Return nil if no complete line has arrived."
(defun imap-parse-status ()
(let ((mailbox (imap-parse-mailbox)))
- (when (and mailbox (search-forward "(" nil t))
- (while (not (eq (char-after) ?\)))
- (let ((token (read (current-buffer))))
- (cond ((eq token 'MESSAGES)
+ (if (eq (char-after) ? )
+ (forward-char))
+ (when (and mailbox (eq (char-after) ?\())
+ (while (and (not (eq (char-after) ?\)))
+ (or (forward-char) t)
+ (looking-at "\\([A-Za-z]+\\) "))
+ (let ((token (match-string 1)))
+ (goto-char (match-end 0))
+ (cond ((string= token "MESSAGES")
(imap-mailbox-put 'messages (read (current-buffer)) mailbox))
- ((eq token 'RECENT)
+ ((string= token "RECENT")
(imap-mailbox-put 'recent (read (current-buffer)) mailbox))
- ((eq token 'UIDNEXT)
- (imap-mailbox-put 'uidnext (read (current-buffer)) mailbox))
- ((eq token 'UIDVALIDITY)
- (and (looking-at " \\([0-9]+\\)")
- (imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
- (goto-char (match-end 1))))
- ((eq token 'UNSEEN)
+ ((string= token "UIDNEXT")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidnext (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UIDVALIDITY")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UNSEEN")
(imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
(t
(message "Unknown status data %s in mailbox %s ignored"
- token mailbox))))))))
+ token mailbox)
+ (read (current-buffer)))))))))
;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
;; rights)
@@ -2226,12 +2420,16 @@ Return nil if no complete line has arrived."
(defun imap-parse-flag-list ()
(let (flag-list start)
- (assert (eq (char-after) ?\())
+ (assert (eq (char-after) ?\() t "In imap-parse-flag-list")
(while (and (not (eq (char-after) ?\)))
- (setq start (progn (imap-forward) (point)))
+ (setq start (progn
+ (imap-forward)
+ ;; next line for Courier IMAP bug.
+ (skip-chars-forward " ")
+ (point)))
(> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
(push (buffer-substring start (point)) flag-list))
- (assert (eq (char-after) ?\)))
+ (assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
(imap-forward)
(nreverse flag-list)))
@@ -2262,31 +2460,31 @@ Return nil if no complete line has arrived."
(defun imap-parse-envelope ()
(when (eq (char-after) ?\()
(imap-forward)
- (vector (prog1 (imap-parse-nstring);; date
+ (vector (prog1 (imap-parse-nstring) ;; date
(imap-forward))
- (prog1 (imap-parse-nstring);; subject
+ (prog1 (imap-parse-nstring) ;; subject
(imap-forward))
- (prog1 (imap-parse-address-list);; from
+ (prog1 (imap-parse-address-list) ;; from
(imap-forward))
- (prog1 (imap-parse-address-list);; sender
+ (prog1 (imap-parse-address-list) ;; sender
(imap-forward))
- (prog1 (imap-parse-address-list);; reply-to
+ (prog1 (imap-parse-address-list) ;; reply-to
(imap-forward))
- (prog1 (imap-parse-address-list);; to
+ (prog1 (imap-parse-address-list) ;; to
(imap-forward))
- (prog1 (imap-parse-address-list);; cc
+ (prog1 (imap-parse-address-list) ;; cc
(imap-forward))
- (prog1 (imap-parse-address-list);; bcc
+ (prog1 (imap-parse-address-list) ;; bcc
(imap-forward))
- (prog1 (imap-parse-nstring);; in-reply-to
+ (prog1 (imap-parse-nstring) ;; in-reply-to
(imap-forward))
- (prog1 (imap-parse-nstring);; message-id
+ (prog1 (imap-parse-nstring) ;; message-id
(imap-forward)))))
;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil
(defsubst imap-parse-string-list ()
- (cond ((eq (char-after) ?\();; body-fld-param
+ (cond ((eq (char-after) ?\() ;; body-fld-param
(let (strlist str)
(imap-forward)
(while (setq str (imap-parse-string))
@@ -2316,7 +2514,7 @@ Return nil if no complete line has arrived."
(while (eq (char-after) ?\ )
(imap-forward)
(push (imap-parse-body-extension) b-e))
- (assert (eq (char-after) ?\)))
+ (assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
(imap-forward)
(nreverse b-e))
(or (imap-parse-number)
@@ -2334,7 +2532,7 @@ Return nil if no complete line has arrived."
(defsubst imap-parse-body-ext ()
(let (ext)
- (when (eq (char-after) ?\ );; body-fld-dsp
+ (when (eq (char-after) ?\ ) ;; body-fld-dsp
(imap-forward)
(let (dsp)
(if (eq (char-after) ?\()
@@ -2344,15 +2542,16 @@ Return nil if no complete line has arrived."
(imap-forward)
(push (imap-parse-string-list) dsp)
(imap-forward))
- ;; (assert (imap-parse-nil)) ; Code in assert might not be eval'd.
+ ;; With assert, the code might not be eval'd.
+ ;; (assert (imap-parse-nil) t "In imap-parse-body-ext")
(imap-parse-nil))
(push (nreverse dsp) ext))
- (when (eq (char-after) ?\ );; body-fld-lang
+ (when (eq (char-after) ?\ ) ;; body-fld-lang
(imap-forward)
(if (eq (char-after) ?\()
(push (imap-parse-string-list) ext)
(push (imap-parse-nstring) ext))
- (while (eq (char-after) ?\ );; body-extension
+ (while (eq (char-after) ?\ ) ;; body-extension
(imap-forward)
(setq ext (append (imap-parse-body-extension) ext)))))
ext))
@@ -2426,91 +2625,90 @@ Return nil if no complete line has arrived."
(let (subbody)
(while (and (eq (char-after) ?\()
(setq subbody (imap-parse-body)))
- ;; buggy stalker communigate pro 3.0 insert a SPC between
+ ;; buggy stalker communigate pro 3.0 insert a SPC between
;; parts in multiparts
(when (and (eq (char-after) ?\ )
(eq (char-after (1+ (point))) ?\())
(imap-forward))
(push subbody body))
(imap-forward)
- (push (imap-parse-string) body);; media-subtype
- (when (eq (char-after) ?\ );; body-ext-mpart:
+ (push (imap-parse-string) body) ;; media-subtype
+ (when (eq (char-after) ?\ ) ;; body-ext-mpart:
(imap-forward)
- (if (eq (char-after) ?\();; body-fld-param
+ (if (eq (char-after) ?\() ;; body-fld-param
(push (imap-parse-string-list) body)
(push (and (imap-parse-nil) nil) body))
(setq body
- (append (imap-parse-body-ext) body)));; body-ext-...
- (assert (eq (char-after) ?\)))
+ (append (imap-parse-body-ext) body))) ;; body-ext-...
+ (assert (eq (char-after) ?\)) t "In imap-parse-body")
(imap-forward)
(nreverse body))
- (push (imap-parse-string) body);; media-type
+ (push (imap-parse-string) body) ;; media-type
(imap-forward)
- (push (imap-parse-string) body);; media-subtype
+ (push (imap-parse-string) body) ;; media-subtype
(imap-forward)
;; next line for Sun SIMS bug
(and (eq (char-after) ? ) (imap-forward))
- (if (eq (char-after) ?\();; body-fld-param
+ (if (eq (char-after) ?\() ;; body-fld-param
(push (imap-parse-string-list) body)
(push (and (imap-parse-nil) nil) body))
(imap-forward)
- (push (imap-parse-nstring) body);; body-fld-id
+ (push (imap-parse-nstring) body) ;; body-fld-id
(imap-forward)
- (push (imap-parse-nstring) body);; body-fld-desc
+ (push (imap-parse-nstring) body) ;; body-fld-desc
(imap-forward)
;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
;; nstring and return nil instead of defaulting back to 7BIT
;; as the standard says.
- (push (or (imap-parse-nstring) "7BIT") body);; body-fld-enc
+ (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
(imap-forward)
- (push (imap-parse-number) body);; body-fld-octets
+ (push (imap-parse-number) body) ;; body-fld-octets
- ;; ok, we're done parsing the required parts, what comes now is one
+ ;; ok, we're done parsing the required parts, what comes now is one
;; of three things:
;;
;; envelope (then we're parsing body-type-msg)
;; body-fld-lines (then we're parsing body-type-text)
;; body-ext-1part (then we're parsing body-type-basic)
;;
- ;; the problem is that the two first are in turn optionally followed
- ;; by the third. So we parse the first two here (if there are any)...
+ ;; the problem is that the two first are in turn optionally followed
+;; by the third. So we parse the first two here (if there are any)...
(when (eq (char-after) ?\ )
(imap-forward)
(let (lines)
- (cond ((eq (char-after) ?\();; body-type-msg:
- (push (imap-parse-envelope) body);; envelope
+ (cond ((eq (char-after) ?\() ;; body-type-msg:
+ (push (imap-parse-envelope) body) ;; envelope
(imap-forward)
- (push (imap-parse-body) body);; body
+ (push (imap-parse-body) body) ;; body
;; buggy stalker communigate pro 3.0 doesn't print
;; number of lines in message/rfc822 attachment
(if (eq (char-after) ?\))
(push 0 body)
(imap-forward)
(push (imap-parse-number) body))) ;; body-fld-lines
- ((setq lines (imap-parse-number)) ;; body-type-text:
- (push lines body)) ;; body-fld-lines
+ ((setq lines (imap-parse-number)) ;; body-type-text:
+ (push lines body)) ;; body-fld-lines
(t
- (backward-char))))) ;; no match...
+ (backward-char))))) ;; no match...
;; ...and then parse the third one here...
- (when (eq (char-after) ?\ );; body-ext-1part:
+ (when (eq (char-after) ?\ ) ;; body-ext-1part:
(imap-forward)
- (push (imap-parse-nstring) body);; body-fld-md5
- (setq body (append (imap-parse-body-ext) body)));; body-ext-1part..
+ (push (imap-parse-nstring) body) ;; body-fld-md5
+ (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
- (assert (eq (char-after) ?\)))
+ (assert (eq (char-after) ?\)) t "In imap-parse-body 2")
(imap-forward)
(nreverse body)))))
(when imap-debug ; (untrace-all)
(require 'trace)
- (buffer-disable-undo (get-buffer-create imap-debug))
- (mapcar (lambda (f) (trace-function-background f imap-debug))
+ (buffer-disable-undo (get-buffer-create imap-debug-buffer))
+ (mapcar (lambda (f) (trace-function-background f imap-debug-buffer))
'(
- imap-read-passwd
imap-utf7-encode
imap-utf7-decode
imap-error-text
diff --git a/lisp/gnus/important.xpm b/lisp/gnus/important.xpm
new file mode 100644
index 00000000000..e972facff24
--- /dev/null
+++ b/lisp/gnus/important.xpm
@@ -0,0 +1,32 @@
+/* XPM */
+static char *magick[] = {
+/* columns rows colors chars-per-pixel */
+"24 24 2 1",
+"! c red",
+"w c Gray75",
+/* pixels */
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwww!!!wwwwwwwwwwww",
+"wwwwwwwww!!!wwwwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwww!!!!!!!wwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwwwww!!!wwwwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwww!!!wwwwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwwww!!!!!wwwwwwwwwww",
+"wwwwwwwww!!!wwwwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww"
+};
diff --git a/lisp/gnus/indifferent.xpm b/lisp/gnus/indifferent.xpm
new file mode 100644
index 00000000000..639523855a9
--- /dev/null
+++ b/lisp/gnus/indifferent.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * indifferent_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++..+++..++.",
+".++..+++..++.",
+".+++++++++++.",
+".+++++++++++.",
+".+++++++++++.",
+".++.......++.",
+".+++++++++++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/kill-group.xpm b/lisp/gnus/kill-group.xpm
index de83fd976d4..1ee4fa42add 100644
--- a/lisp/gnus/kill-group.xpm
+++ b/lisp/gnus/kill-group.xpm
@@ -1,50 +1,30 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 20 1",
-" c Gray0",
-". c Gray6",
-"X c Gray12",
-"o c #2ff42ff42ff4",
-"O c #3fff3fff3fff",
-"+ c Gray28",
-"@ c #53e353e353e3",
-"# c #5fe25fe25fe2",
-"$ c #67e767e767e7",
-"% c #6fff6fff6fff",
-"& c #77d777d777d7",
-"* c Gray50",
-"= c Gray56",
-"- c #9fff9fff9fff",
-"; c Gray70",
-": c Gray75",
-"> c Gray81",
-", c #dfffdfffdfff",
-"< c #efffefffefff",
-"1 c Gray100",
-/* pixels */
-"::::::::::::::::::::::::",
-"::::::::::::::::::::::::",
-"::::::::::::::::::::::::",
-"::::#oOOOOOOOOOo+;::::::",
-"::::#:111111111:O$::::::",
-"::::#:1111-O%11:*>@:::::",
-"::::#:111=X.o#<>OOo#::::",
-"::::#:111 OX# :111:#::::",
-"::::#:111 = :111:#::::",
-"::::#:111>Xo.-1111:#::::",
-"::::#:1111*:O11111:#::::",
-"::::#:11%1*oO->111:#::::",
-"::::#:1-O:,1:*O111:#::::",
-"::::#:111****:1111:#::::",
-"::::#:1111* 111111:#::::",
-"::::#:1,:O-1O*:111:#::::",
-"::::#:1:X1111*#111:#::::",
-"::::#:11>1111,<111:#::::",
-"::::#:111111111111:#::::",
-"::::#:111111111111:#::::",
-"::::#:111111111111:#::::",
-"::::&oooooooooooooo&::::",
-"::::::::::::::::::::::::",
-"::::::::::::::::::::::::"
-};
+static char * kill_group_xpm[] = {
+"24 24 3 1",
+". c None",
+"o c #000000000000",
+"+ c #9A9A6C6C4E4E",
+"o..o..o..o..o..o..o..o..",
+"........................",
+"........................",
+"o..o..o..o..o..o..o..o..",
+"........................",
+"........................",
+"o..o..o..o..++.o..o..o..",
+".......++..++++.........",
+"........++.+++..........",
+"o..o..o.+++++..o..o..o..",
+".........+++............",
+".........++++...........",
+"o..o..o.++++++.o..o..o..",
+"........++.++++.........",
+".......++...++++........",
+"o..o...+.o...++o..o..o..",
+"........................",
+"........................",
+"o..o..o..o..o..o..o..o..",
+"........................",
+"........................",
+"o..o..o..o..o..o..o..o..",
+"........................",
+"........................"};
diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el
index 3d0394c43e5..11f3ed9bf96 100644
--- a/lisp/gnus/mail-parse.el
+++ b/lisp/gnus/mail-parse.el
@@ -1,4 +1,4 @@
-;;; mail-parse.el --- interface functions for parsing mail
+;;; mail-parse.el --- Interface functions for parsing mail
;; Copyright (C) 1998, 1999, 2000
;; Free Software Foundation, Inc.
@@ -43,10 +43,11 @@
(require 'rfc2047)
(require 'rfc2045)
-(defalias 'mail-header-parse-content-type 'rfc2231-parse-string)
-(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-string)
+(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string)
+(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string)
(defalias 'mail-content-type-get 'rfc2231-get-value)
-(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
+;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
+(defalias 'mail-header-encode-parameter 'rfc2231-encode-string)
(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
@@ -58,7 +59,11 @@
(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header)
(defalias 'mail-quote-string 'ietf-drums-quote-string)
+(defalias 'mail-header-fold-field 'rfc2047-fold-field)
+(defalias 'mail-header-unfold-field 'rfc2047-unfold-field)
(defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field)
+(defalias 'mail-header-field-value 'rfc2047-field-value)
+
(defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
(defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header)
(defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string)
diff --git a/lisp/gnus/mail-prsvr.el b/lisp/gnus/mail-prsvr.el
index 16dd50f4f07..fc80459155a 100644
--- a/lisp/gnus/mail-prsvr.el
+++ b/lisp/gnus/mail-prsvr.el
@@ -1,4 +1,4 @@
-;;; mail-prsvr.el --- interface variables for parsing mail
+;;; mail-prsvr.el --- Interface variables for parsing mail
;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/mail-reply.xpm b/lisp/gnus/mail-reply.xpm
index 92f5dd5269f..a87f7846170 100644
--- a/lisp/gnus/mail-reply.xpm
+++ b/lisp/gnus/mail-reply.xpm
@@ -1,51 +1,32 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 21 1",
-" c Gray0",
-". c Gray6",
-"X c Gray12",
-"o c #2ff02ff02ff0",
-"O c #3fff3fff3fff",
-"+ c Gray28",
-"@ c #53f353f353f3",
-"# c #5ff95ff95ff9",
-"$ c #67e767e767e7",
-"% c #6fff6fff6fff",
-"& c #77dc77dc77dc",
-"* c Gray50",
-"= c Gray56",
-"- c #9beb9beb9beb",
-"; c #9fff9fff9fff",
-": c Gray70",
-"> c Gray75",
-", c Gray81",
-"< c #dfffdfffdfff",
-"1 c #efffefffefff",
-"2 c Gray100",
-/* pixels */
-">>>>>>>>>>>>>>>==:>>>>>>",
-">>>>>>>>>>>>>>&**$&>>>>>",
-">>>>>>>>>>>>>&-22,-o->>>",
-">>>>>>>>>=$O@$,,2222O>>>",
-">>>>>>>=#*>2*>2O222>$>>>",
-">>>>>>o&>222O2%,22,$:>>>",
-">>>:$O2222<#2*>222=+:>>>",
-">>&$>;;2;2*>2><22;**$&>>",
-">>o.;,,2,,*1%222;;,O;o>>",
-">>o2;O><2O2,%221#o%22o>>",
-">>o222***O2;22;**<222o>>",
-">>o2222<>.;2,O;,22222o>>",
-">>o2221>#2;O%;;,22222o>>",
-">>o222**<22222;*>2222o>>",
-">>o22%,222222221*,222o>>",
-">>o;O,22222222222%#<2o>>",
-">>o;22222222222222<**o>>",
-">>oOOOOOOOOOOOOOOOOX o>>",
-">>>>>>>>>>>>>>>>>>>>>>>>",
-">>>>>>>>>>>>>>>>>>>>>>>>",
-">>>>>>>>>>>>>>>>>>>>>>>>",
-">>>>>>>>>>>>>>>>>>>>>>>>",
-">>>>>>>>>>>>>>>>>>>>>>>>",
-">>>>>>>>>>>>>>>>>>>>>>>>"
-};
+static char * mail_reply_xpm[] = {
+"24 24 5 1",
+" c None",
+". c #000000000000",
+"X c #E1E1E0E0E0E0",
+"O c #FFFFFFFFFFFF",
+"o c #C7C7C6C6C6C6",
+" .. ",
+" .X. ",
+" ..XX. ",
+" ......XoXX.. ",
+" ...OOO.XooXXX. ",
+" ..OOOO.XooXXX. ",
+" ...OOOOO.XooXXX... ",
+" ..OOOOOO.XXooXX.OO.. ",
+" ...OOOO.oooXXX...... ",
+" .O...O.oXooXXX...OO. ",
+" .OOO...oXoXX...OOOO. ",
+" .OOOOO...X...OOOOOO. ",
+" .OOOOO.O...OO.OOOOO. ",
+" .OOO..OOOOOOOO..OOO. ",
+" .OO.OOOOOOOOOOOO.OO. ",
+" .O.OOOOOOOOOOOOOO.O. ",
+" ..OOOOOOOOOOOOOOOO.. ",
+" .................... ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 334d2755053..3c055c82000 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1,5 +1,6 @@
;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -32,9 +33,11 @@
(eval-and-compile
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
- (autoload 'nnheader-cancel-timer "nnheader"))
+ (autoload 'nnheader-cancel-timer "nnheader")
+ (autoload 'nnheader-run-at-time "nnheader"))
(require 'format-spec)
(require 'mm-util)
+(require 'message) ;; for `message-directory'
(defgroup mail-source nil
"The mail-fetching library."
@@ -58,6 +61,7 @@
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
+ :link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(repeat
(choice :format "%[Value Menu%] %v"
:value (file)
@@ -81,10 +85,16 @@ See Info node `(gnus)Mail Source Specifiers'."
(function :tag "Predicate"))
(group :inline t
(const :format "" :value :prescript)
- (string :tag "Prescript"))
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
- (string :tag "Postscript"))
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :plugged)
(boolean :tag "Plugged"))))
@@ -111,10 +121,16 @@ See Info node `(gnus)Mail Source Specifiers'."
(string :tag "Program"))
(group :inline t
(const :format "" :value :prescript)
- (string :tag "Prescript"))
+ (choice :tag "Prescript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
- (string :tag "Postscript"))
+ (choice :tag "Postscript"
+ :value nil
+ (string :format "%v")
+ (function :format "%v")))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
@@ -160,6 +176,9 @@ See Info node `(gnus)Mail Source Specifiers'."
:value network
,@mail-source-imap-streams))
(group :inline t
+ (const :format "" :value :program)
+ (string :tag "Program"))
+ (group :inline t
(const :format ""
:value :authenticator)
(choice :tag "Authenticator"
@@ -213,18 +232,28 @@ See Info node `(gnus)Mail Source Specifiers'."
(const :format "" :value :plugged)
(boolean :tag "Plugged")))))))
+(defcustom mail-source-ignore-errors nil
+ "*Ignore errors when querying mail sources.
+If nil, the user will be prompted when an error occurs. If non-nil,
+the error will be ignored.")
+
(defcustom mail-source-primary-source nil
"*Primary source for incoming mail.
If non-nil, this maildrop will be checked periodically for new mail."
:group 'mail-source
:type 'sexp)
+(defcustom mail-source-flash t
+ "*If non-nil, flash periodically when mail is available."
+ :group 'mail-source
+ :type 'boolean)
+
(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
"File where mail will be stored while processing it."
:group 'mail-source
:type 'file)
-(defcustom mail-source-directory "~/Mail/"
+(defcustom mail-source-directory message-directory
"Directory where files (if any) will be stored."
:group 'mail-source
:type 'directory)
@@ -235,7 +264,23 @@ If non-nil, this maildrop will be checked periodically for new mail."
:type 'integer)
(defcustom mail-source-delete-incoming t
- "*If non-nil, delete incoming files after handling."
+ "*If non-nil, delete incoming files after handling.
+If t, delete immediately, if nil, never delete. If a positive number, delete
+files older than number of days."
+ ;; Note: The removing happens in `mail-source-callback', i.e. no old
+ ;; incoming files will be deleted, unless you receive new mail.
+ ;;
+ ;; You may also set this to `nil' and call `mail-source-delete-old-incoming'
+ ;; from a hook or interactively.
+ :group 'mail-source
+ :type '(choice (const :tag "immediately" t)
+ (const :tag "never" nil)
+ (integer :tag "days")))
+
+(defcustom mail-source-delete-old-incoming-confirm t
+ "*If non-nil, ask for for confirmation before deleting old incoming files.
+This variable only applies when `mail-source-delete-incoming' is a positive
+number."
:group 'mail-source
:type 'boolean)
@@ -254,6 +299,11 @@ If non-nil, this maildrop will be checked periodically for new mail."
:group 'mail-source
:type 'number)
+(defcustom mail-source-movemail-program nil
+ "If non-nil, name of program for fetching new mail."
+ :group 'mail-source
+ :type '(choice (const nil) string))
+
;;; Internal variables.
(defvar mail-source-string ""
@@ -295,18 +345,22 @@ Common keywords should be listed here.")
(:authentication password))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
- (:subdirs ("new" "cur"))
+ (:subdirs ("cur" "new"))
(:function))
(imap
(:server (getenv "MAILHOST"))
(:port)
(:stream)
+ (:program)
(:authentication)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
(:password)
(:mailbox "INBOX")
(:predicate "UNSEEN UNDELETED")
(:fetchflag "\\Deleted")
+ (:prescript)
+ (:prescript-delay)
+ (:postscript)
(:dontexpunge))
(webmail
(:subtype hotmail)
@@ -365,7 +419,7 @@ the `mail-source-keyword-map' variable."
,@body))
(put 'mail-source-bind 'lisp-indent-function 1)
-(put 'mail-source-bind 'edebug-form-spec '(form body))
+(put 'mail-source-bind 'edebug-form-spec '(sexp body))
(defun mail-source-set-1 (source)
(let* ((type (pop source))
@@ -408,7 +462,7 @@ See `mail-source-bind'."
,@body))
(put 'mail-source-bind-common 'lisp-indent-function 1)
-(put 'mail-source-bind-common 'edebug-form-spec '(form body))
+(put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
(defun mail-source-value (value)
"Return the value of VALUE."
@@ -442,24 +496,52 @@ Return the number of files that were found."
(setq found (mail-source-callback
callback mail-source-crash-box)))
(+ found
- (condition-case err
+ (if (or debug-on-quit debug-on-error)
(funcall function source callback)
- (error
- (unless (yes-or-no-p
- (format "Mail source error (%s). Continue? " err))
- (error "Cannot get new mail"))
- 0))))))))
-
-(eval-and-compile
- (if (fboundp 'make-temp-file)
- (defalias 'mail-source-make-complex-temp-name 'make-temp-file)
- (defun mail-source-make-complex-temp-name (prefix)
- (let ((newname (make-temp-name prefix))
- (newprefix prefix))
- (while (file-exists-p newname)
- (setq newprefix (concat newprefix "x"))
- (setq newname (make-temp-name newprefix)))
- newname))))
+ (condition-case err
+ (funcall function source callback)
+ (error
+ (if (and (not mail-source-ignore-errors)
+ (not
+ (yes-or-no-p
+ (format "Mail source %s error (%s). Continue? "
+ (if (memq ':password source)
+ (let ((s (copy-sequence source)))
+ (setcar (cdr (memq ':password s))
+ "********")
+ s)
+ source)
+ (cadr err)))))
+ (error "Cannot get new mail"))
+ 0)))))))))
+
+(defun mail-source-delete-old-incoming (&optional age confirm)
+ "Remove incoming files older than AGE days.
+If CONFIRM is non-nil, ask for confirmation before removing a file."
+ (interactive "P")
+ (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days
+ (low2days (/ 1.0 65536.0)) ;; convert low bits to days
+ (diff (if (natnump age) age 30));; fallback, if no valid AGE given
+ currday files)
+ (setq files (directory-files
+ mail-source-directory t
+ (concat mail-source-incoming-file-prefix "*"))
+ currday (* (car (current-time)) high2days)
+ currday (+ currday (* low2days (nth 1 (current-time)))))
+ (while files
+ (let* ((ffile (car files))
+ (bfile (gnus-replace-in-string
+ ffile "\\`.*/\\([^/]+\\)\\'" "\\1"))
+ (filetime (nth 5 (file-attributes ffile)))
+ (fileday (* (car filetime) high2days))
+ (fileday (+ fileday (* low2days (nth 1 filetime)))))
+ (setq files (cdr files))
+ (when (and (> (- currday fileday) diff)
+ (gnus-message 8 "File `%s' is older than %s day(s)"
+ bfile diff)
+ (or (not confirm)
+ (y-or-n-p (concat "Remove file `" bfile "'? "))))
+ (delete-file ffile))))))
(defun mail-source-callback (callback info)
"Call CALLBACK on the mail file, and then remove the mail file.
@@ -474,16 +556,21 @@ Pass INFO on to CALLBACK."
(funcall callback mail-source-crash-box info)
(when (file-exists-p mail-source-crash-box)
;; Delete or move the incoming mail out of the way.
- (if mail-source-delete-incoming
+ (if (eq mail-source-delete-incoming t)
(delete-file mail-source-crash-box)
(let ((incoming
- (mail-source-make-complex-temp-name
+ (mm-make-temp-file
(expand-file-name
mail-source-incoming-file-prefix
mail-source-directory))))
(unless (file-exists-p (file-name-directory incoming))
(make-directory (file-name-directory incoming) t))
- (rename-file mail-source-crash-box incoming t)))))))
+ (rename-file mail-source-crash-box incoming t)
+ ;; remove old incoming files?
+ (when (natnump mail-source-delete-incoming)
+ (mail-source-delete-old-incoming
+ mail-source-delete-incoming
+ mail-source-delete-old-incoming-confirm))))))))
(defun mail-source-movemail (from to)
"Move FROM to TO using movemail."
@@ -518,12 +605,15 @@ Pass INFO on to CALLBACK."
'call-process
(append
(list
- (expand-file-name "movemail" exec-directory)
+ (or mail-source-movemail-program
+ (expand-file-name "movemail" exec-directory))
nil errors nil from to)))))
(when (file-exists-p to)
(set-file-modes to mail-source-default-file-modes))
- (if (and (not (buffer-modified-p errors))
- (zerop result))
+ (if (and (or (not (buffer-modified-p errors))
+ (zerop (buffer-size errors)))
+ (and (numberp result)
+ (zerop result)))
;; No output => movemail won.
t
(set-buffer errors)
@@ -540,8 +630,9 @@ Pass INFO on to CALLBACK."
(goto-char (point-min))
(when (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
+ ;; Result may be a signal description string.
(unless (yes-or-no-p
- (format "movemail: %s (%d return). Continue? "
+ (format "movemail: %s (%s return). Continue? "
(buffer-string) result))
(error "%s" (buffer-string)))
(setq to nil)))))))
@@ -557,29 +648,13 @@ Pass INFO on to CALLBACK."
(not (zerop (nth 7 (file-attributes from))))
(delete-file from)))
-(defvar mail-source-read-passwd nil)
-(defun mail-source-read-passwd (prompt &rest args)
- "Read a password using PROMPT.
-If ARGS, PROMPT is used as an argument to `format'."
- (let ((prompt
- (if args
- (apply 'format prompt args)
- prompt)))
- (unless mail-source-read-passwd
- (if (or (fboundp 'read-passwd) (load "passwd" t))
- (setq mail-source-read-passwd 'read-passwd)
- (unless (fboundp 'ange-ftp-read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp"))
- (setq mail-source-read-passwd 'ange-ftp-read-passwd)))
- (funcall mail-source-read-passwd prompt)))
-
(defun mail-source-fetch-with-program (program)
- (zerop (call-process shell-file-name nil nil nil
- shell-command-switch program)))
+ (eq 0 (call-process shell-file-name nil nil nil
+ shell-command-switch program)))
(defun mail-source-run-script (script spec &optional delay)
(when script
- (if (and (symbolp script) (fboundp script))
+ (if (functionp script)
(funcall script)
(mail-source-call-script
(format-spec script spec))))
@@ -616,8 +691,7 @@ If ARGS, PROMPT is used as an argument to `format'."
"Fetcher for directory sources."
(mail-source-bind (directory source)
(mail-source-run-script
- prescript (format-spec-make ?t path)
- prescript-delay)
+ prescript (format-spec-make ?t path) prescript-delay)
(let ((found 0)
(mail-source-string (format "directory:%s" path)))
(dolist (file (directory-files
@@ -626,8 +700,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(funcall predicate file)
(mail-source-movemail file mail-source-crash-box))
(incf found (mail-source-callback callback file))))
- (mail-source-run-script
- postscript (format-spec-make ?t path))
+ (mail-source-run-script postscript (format-spec-make ?t path))
found)))
(defun mail-source-fetch-pop (source callback)
@@ -645,7 +718,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(setq password
(or password
(cdr (assoc from mail-source-password-cache))
- (mail-source-read-passwd
+ (read-passwd
(format "Password for %s at %s: " user server)))))
(when server
(setenv "MAILHOST" server))
@@ -667,7 +740,17 @@ If ARGS, PROMPT is used as an argument to `format'."
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
- (save-excursion (pop3-movemail mail-source-crash-box))))))
+ (if (or debug-on-quit debug-on-error)
+ (save-excursion (pop3-movemail mail-source-crash-box))
+ (condition-case err
+ (save-excursion (pop3-movemail mail-source-crash-box))
+ (error
+ ;; We nix out the password in case the error
+ ;; was because of a wrong password being given.
+ (setq mail-source-password-cache
+ (delq (assoc from mail-source-password-cache)
+ mail-source-password-cache))
+ (signal (car err) (cdr err)))))))))
(if result
(progn
(when (eq authentication 'password)
@@ -699,7 +782,7 @@ If ARGS, PROMPT is used as an argument to `format'."
(setq password
(or password
(cdr (assoc from mail-source-password-cache))
- (mail-source-read-passwd
+ (read-passwd
(format "Password for %s at %s: " user server))))
(unless (assoc from mail-source-password-cache)
(push (cons from password) mail-source-password-cache)))
@@ -718,7 +801,17 @@ If ARGS, PROMPT is used as an argument to `format'."
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
- (save-excursion (pop3-get-message-count))))))
+ (if (or debug-on-quit debug-on-error)
+ (save-excursion (pop3-get-message-count))
+ (condition-case err
+ (save-excursion (pop3-get-message-count))
+ (error
+ ;; We nix out the password in case the error
+ ;; was because of a wrong password being given.
+ (setq mail-source-password-cache
+ (delq (assoc from mail-source-password-cache)
+ mail-source-password-cache))
+ (signal (car err) (cdr err)))))))))
(if result
;; Inform display-time that we have new mail.
(setq mail-source-new-mail-available (> result 0))
@@ -729,8 +822,31 @@ If ARGS, PROMPT is used as an argument to `format'."
mail-source-password-cache)))
result)))
+(defun mail-source-touch-pop ()
+ "Open and close a POP connection shortly.
+POP server should be defined in `mail-source-primary-source' (which is
+preferred) or `mail-sources'. You may use it for the POP-before-SMTP
+authentication. To do that, you need to set the
+`message-send-mail-function' variable as `message-smtpmail-send-it'
+and put the following line in your ~/.gnus.el file:
+
+\(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
+
+See the Gnus manual for details."
+ (let ((sources (if mail-source-primary-source
+ (list mail-source-primary-source)
+ mail-sources)))
+ (while sources
+ (if (eq 'pop (car (car sources)))
+ (mail-source-check-pop (car sources)))
+ (setq sources (cdr sources)))))
+
(defun mail-source-new-mail-p ()
"Handler for `display-time' to indicate when new mail is available."
+ ;; Flash (ie. ring the visible bell) if mail is available.
+ (if (and mail-source-flash mail-source-new-mail-available)
+ (let ((visible-bell t))
+ (ding)))
;; Only report flag setting; flag is updated on a different schedule.
mail-source-new-mail-available)
@@ -753,8 +869,9 @@ If ARGS, PROMPT is used as an argument to `format'."
mail-source-idle-time-delay
nil
(lambda ()
- (setq mail-source-report-new-mail-idle-timer nil)
- (mail-source-check-pop mail-source-primary-source))))
+ (unwind-protect
+ (mail-source-check-pop mail-source-primary-source)
+ (setq mail-source-report-new-mail-idle-timer nil)))))
;; Since idle timers created when Emacs is already in the idle
;; state don't get activated until Emacs _next_ becomes idle, we
;; need to force our timer to be considered active now. We do
@@ -785,8 +902,10 @@ This only works when `display-time' is enabled."
(setq display-time-mail-function #'mail-source-new-mail-p)
;; Set up the main timer.
(setq mail-source-report-new-mail-timer
- (run-at-time t (* 60 mail-source-report-new-mail-interval)
- #'mail-source-start-idle-timer))
+ (nnheader-run-at-time
+ (* 60 mail-source-report-new-mail-interval)
+ (* 60 mail-source-report-new-mail-interval)
+ #'mail-source-start-idle-timer))
;; When you get new mail, clear "Mail" from the mode line.
(add-hook 'nnmail-post-get-new-mail-hook
'display-time-event-handler)
@@ -817,13 +936,13 @@ This only works when `display-time' is enabled."
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(goto-char (point-min))
-;;; ;; Unix mail format
-;;; (unless (looking-at "\n*From ")
-;;; (insert "From maildir "
-;;; (current-time-string) "\n"))
-;;; (while (re-search-forward "^From " nil t)
-;;; (replace-match ">From "))
-;;; (goto-char (point-max))
+;;; ;; Unix mail format
+;;; (unless (looking-at "\n*From ")
+;;; (insert "From maildir "
+;;; (current-time-string) "\n"))
+;;; (while (re-search-forward "^From " nil t)
+;;; (replace-match ">From "))
+;;; (goto-char (point-max))
;;; (insert "\n\n")
;; MMDF mail format
(insert "\001\001\001\001\n"))
@@ -852,10 +971,15 @@ This only works when `display-time' is enabled."
(defun mail-source-fetch-imap (source callback)
"Fetcher for imap sources."
(mail-source-bind (imap source)
+ (mail-source-run-script
+ prescript (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user)
+ prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(found 0)
- (buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
+ (buf (generate-new-buffer " *imap source*"))
(mail-source-string (format "imap:%s:%s" server mailbox))
+ (imap-shell-program (or (list program) imap-shell-program))
remove)
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
@@ -870,12 +994,16 @@ This only works when `display-time' is enabled."
(mm-disable-multibyte)
;; remember password
(with-current-buffer buf
- (when (or imap-password
- (assoc from mail-source-password-cache))
+ (when (and imap-password
+ (not (assoc from mail-source-password-cache)))
(push (cons from imap-password) mail-source-password-cache)))
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
- (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
+ (when (setq str
+ (if (imap-capability 'IMAP4rev1 buf)
+ (caddar (imap-fetch uid "BODY.PEEK[]"
+ 'BODYDETAIL nil buf))
+ (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
(push uid remove)
(insert "From imap " (current-time-string) "\n")
(save-excursion
@@ -886,12 +1014,13 @@ This only works when `display-time' is enabled."
(nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server))
(when (and remove fetchflag)
+ (setq remove (nreverse remove))
(imap-message-flags-add
(imap-range-to-message-set (gnus-compress-sequence remove))
fetchflag nil buf))
(if dontexpunge
(imap-mailbox-unselect buf)
- (imap-mailbox-close buf))
+ (imap-mailbox-close nil buf))
(imap-close buf))
(imap-close buf)
;; We nix out the password in case the error
@@ -899,8 +1028,12 @@ This only works when `display-time' is enabled."
(setq mail-source-password-cache
(delq (assoc from mail-source-password-cache)
mail-source-password-cache))
- (error (imap-error-text buf)))
+ (error "IMAP error: %s" (imap-error-text buf)))
(kill-buffer buf)
+ (mail-source-run-script
+ postscript
+ (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user))
found)))
(eval-and-compile
@@ -917,7 +1050,7 @@ This only works when `display-time' is enabled."
(or password
(cdr (assoc (format "webmail:%s:%s" subtype user)
mail-source-password-cache))
- (mail-source-read-passwd
+ (read-passwd
(format "Password for %s at %s: " user subtype))))
(when (and password
(not (assoc (format "webmail:%s:%s" subtype user)
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index 6d35e2196ae..db0ab6143e1 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -1,5 +1,6 @@
;;; mailcap.el --- MIME media types configuration
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -46,14 +47,36 @@
(modify-syntax-entry ?{ "(" table)
(modify-syntax-entry ?} ")" table)
table)
- "A syntax table for parsing sgml attributes.")
+ "A syntax table for parsing SGML attributes.")
+
+(eval-and-compile
+ (when (featurep 'xemacs)
+ (condition-case nil
+ (require 'lpr)
+ (error nil))))
+
+(defvar mailcap-print-command
+ (mapconcat 'identity
+ (cons (if (boundp 'lpr-command)
+ lpr-command
+ "lpr")
+ (when (boundp 'lpr-switches)
+ (if (stringp lpr-switches)
+ (list lpr-switches)
+ lpr-switches)))
+ " ")
+ "Shell command (including switches) used to print Postscript files.")
;; Postpone using defcustom for this as it's so big and we essentially
;; have to have two copies of the data around then. Perhaps just
;; customize the Lisp viewers and rely on the normal configuration
;; files for the rest? -- fx
(defvar mailcap-mime-data
- '(("application"
+ `(("application"
+ ("vnd.ms-excel"
+ (viewer . "gnumeric %s")
+ (test . (getenv "DISPLAY"))
+ (type . "application/vnd.ms-excel"))
("x-x509-ca-cert"
(viewer . ssl-view-site-cert)
(test . (fboundp 'ssl-view-site-cert))
@@ -66,23 +89,23 @@
(viewer . mailcap-save-binary-file)
(non-viewer . t)
(type . "application/octet-stream"))
-;;; XEmacs says `ns' device-type not implemented.
-;; ("dvi"
-;; (viewer . "open %s")
-;; (type . "application/dvi")
-;; (test . (eq (mm-device-type) 'ns)))
("dvi"
- (viewer . "xdvi %s")
- (test . (eq (mm-device-type) 'x))
+ (viewer . "xdvi -safer %s")
+ (test . (eq window-system 'x))
("needsx11")
- (type . "application/dvi"))
+ (type . "application/dvi")
+ ("print" . "dvips -qRP %s"))
("dvi"
(viewer . "dvitty %s")
(test . (not (getenv "DISPLAY")))
- (type . "application/dvi"))
+ (type . "application/dvi")
+ ("print" . "dvips -qRP %s"))
("emacs-lisp"
(viewer . mailcap-maybe-eval)
(type . "application/emacs-lisp"))
+ ("x-emacs-lisp"
+ (viewer . mailcap-maybe-eval)
+ (type . "application/x-emacs-lisp"))
("x-tar"
(viewer . mailcap-save-binary-file)
(non-viewer . t)
@@ -114,36 +137,52 @@
("copiousoutput"))
;; Prefer free viewers.
("pdf"
- (viewer . "gv %s")
+ (viewer . "gv -safer %s")
(type . "application/pdf")
- (test . window-system))
+ (test . window-system)
+ ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
("pdf"
(viewer . "xpdf %s")
(type . "application/pdf")
- (test . (eq (mm-device-type) 'x)))
+ ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+ (test . (eq window-system 'x)))
("pdf"
(viewer . "acroread %s")
- (type . "application/pdf"))
-;;; XEmacs says `ns' device-type not implemented.
-;; ("postscript"
-;; (viewer . "open %s")
-;; (type . "application/postscript")
-;; (test . (eq (mm-device-type) 'ns)))
+ (type . "application/pdf")
+ ("print" . ,(concat "cat %s | acroread -toPostScript | "
+ mailcap-print-command))
+ (test . window-system))
+ ("pdf"
+ (viewer . ,(concat "pdftotext %s -"))
+ (type . "application/pdf")
+ ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+ ("copiousoutput"))
("postscript"
(viewer . "gv -safer %s")
(type . "application/postscript")
(test . window-system)
+ ("print" . ,(concat mailcap-print-command " %s"))
("needsx11"))
("postscript"
(viewer . "ghostview -dSAFER %s")
(type . "application/postscript")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
+ ("print" . ,(concat mailcap-print-command " %s"))
("needsx11"))
("postscript"
(viewer . "ps2ascii %s")
(type . "application/postscript")
(test . (not (getenv "DISPLAY")))
- ("copiousoutput")))
+ ("print" . ,(concat mailcap-print-command " %s"))
+ ("copiousoutput"))
+ ("sieve"
+ (viewer . sieve-mode)
+ (test . (fboundp 'sieve-mode))
+ (type . "application/sieve"))
+ ("pgp-keys"
+ (viewer . "gpg --import --interactive --verbose")
+ (type . "application/pgp-keys")
+ ("needsterminal")))
("audio"
("x-mpeg"
(viewer . "maplay %s")
@@ -173,34 +212,29 @@
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("x11-dump"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("windowdump"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
-;;; XEmacs says `ns' device-type not implemented.
-;; (".*"
-;; (viewer . "aopen %s")
-;; (type . "image/*")
-;; (test . (eq (mm-device-type) 'ns)))
(".*"
(viewer . "display %s")
(type . "image/*")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
(".*"
(viewer . "ee %s")
(type . "image/*")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11")))
("text"
("plain"
@@ -215,7 +249,7 @@
(viewer . fundamental-mode)
(type . "text/plain"))
("enriched"
- (viewer . enriched-decode-region)
+ (viewer . enriched-decode)
(test . (fboundp 'enriched-decode))
(type . "text/enriched"))
("html"
@@ -226,7 +260,7 @@
("mpeg"
(viewer . "mpeg_play %s")
(type . "video/mpeg")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11")))
("x-world"
("x-vrml"
@@ -280,6 +314,10 @@ nil means your home directory."
directory)
:group 'mailcap)
+(defvar mailcap-poor-system-types
+ '(ms-dos ms-windows windows-nt win32 w32 mswindows)
+ "Systems that don't have a Unix-like directory hierarchy.")
+
;;;
;;; Utility functions
;;;
@@ -356,7 +394,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
(cond
(path nil)
((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
+ ((memq system-type mailcap-poor-system-types)
(setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
(t (setq path
;; This is per RFC 1524, specifically
@@ -533,7 +571,7 @@ Also return non-nil if no test clause is present."
(cond
((equal (car (car major)) minor)
(setq exact (cons (cdr (car major)) exact)))
- ((and minor (string-match (car (car major)) minor))
+ ((and minor (string-match (concat "^" (car (car major)) "$") minor))
(setq wildcard (cons (cdr (car major)) wildcard))))
(setq major (cdr major)))
(nconc exact wildcard)))
@@ -590,7 +628,7 @@ Also return non-nil if no test clause is present."
(defun mailcap-viewer-passes-test (viewer-info type-info)
"Return non-nil iff viewer specified by VIEWER-INFO passes its test clause.
-Also retun non-nil if it has no test clause. TYPE-INFO is an argument
+Also return non-nil if it has no test clause. TYPE-INFO is an argument
to supply to the test."
(let* ((test-info (assq 'test viewer-info))
(test (cdr test-info))
@@ -619,7 +657,7 @@ to supply to the test."
test (list shell-file-name nil nil nil
shell-command-switch test)
status (apply 'call-process test))
- (= 0 status))))
+ (eq 0 status))))
(push (list otest result) mailcap-viewer-test-cache)
result)))
@@ -629,18 +667,18 @@ to supply to the test."
(setq mailcap-mime-data
(cons (cons major (list (cons minor info)))
mailcap-mime-data))
- (let ((cur-minor (assoc minor old-major)))
- (cond
- ((or (null cur-minor) ; New minor area, or
- (assq 'test info)) ; Has a test, insert at beginning
- (setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assq 'test info)) ; No test info, replace completely
- (not (assq 'test cur-minor))
+ (let ((cur-minor (assoc minor old-major)))
+ (cond
+ ((or (null cur-minor) ; New minor area, or
+ (assq 'test info)) ; Has a test, insert at beginning
+ (setcdr old-major (cons (cons minor info) (cdr old-major))))
+ ((and (not (assq 'test info)) ; No test info, replace completely
+ (not (assq 'test cur-minor))
(equal (assq 'viewer info) ; Keep alternative viewer
(assq 'viewer cur-minor)))
- (setcdr cur-minor info))
- (t
- (setcdr old-major (cons (cons minor info) (cdr old-major))))))
+ (setcdr cur-minor info))
+ (t
+ (setcdr old-major (cons (cons minor info) (cdr old-major))))))
)))
(defun mailcap-add (type viewer &optional test)
@@ -723,9 +761,8 @@ this type is returned."
((or (null request) (equal request ""))
(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
((stringp request)
- (if (or (eq request 'test) (eq request 'viewer))
- (mailcap-unescape-mime-test
- (cdr-safe (assoc request viewer)) info)))
+ (mailcap-unescape-mime-test
+ (cdr-safe (assoc request viewer)) info))
((eq request 'all)
passed)
(t
@@ -808,6 +845,7 @@ this type is returned."
(".rtx" . "text/richtext")
(".sh" . "application/x-sh")
(".sit" . "application/x-stuffit")
+ (".siv" . "application/sieve")
(".snd" . "audio/basic")
(".src" . "application/x-wais-source")
(".tar" . "archive/tar")
@@ -825,6 +863,7 @@ this type is returned."
(".vox" . "audio/basic")
(".vrml" . "x-world/x-vrml")
(".wav" . "audio/x-wav")
+ (".xls" . "application/vnd.ms-excel")
(".wrl" . "x-world/x-vrml")
(".xbm" . "image/xbm")
(".xpm" . "image/xpm")
@@ -851,7 +890,7 @@ If FORCE, re-parse even if already parsed."
(cond
(path nil)
((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
+ ((memq system-type mailcap-poor-system-types)
(setq path '("~/mime.typ" "~/etc/mime.typ")))
(t (setq path
;; mime.types seems to be the normal name, definitely so
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 4c6284b6d85..bd98cf0eac8 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1,5 +1,5 @@
-;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -32,14 +32,24 @@
(eval-when-compile
(require 'cl)
- (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+ (defvar gnus-message-group-art)
+ (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+(require 'canlock)
(require 'mailheader)
(require 'nnheader)
-;; This is apparently necessary even though things are autoloaded:
+;; This is apparently necessary even though things are autoloaded.
+;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
+;; require mailabbrev here.
(if (featurep 'xemacs)
- (require 'mail-abbrevs))
+ (require 'mail-abbrevs)
+ (require 'mailabbrev))
(require 'mail-parse)
(require 'mml)
+(require 'rfc822)
+(eval-and-compile
+ (autoload 'gnus-find-method-for-group "gnus")
+ (autoload 'nnvirtual-find-group-art "nnvirtual")
+ (autoload 'gnus-group-decoded-name "gnus-group"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
@@ -123,6 +133,11 @@ mailbox format."
(function :tag "Other"))
:group 'message-sending)
+(defcustom message-fcc-externalize-attachments nil
+ "If non-nil, attachments are included as external parts in Fcc copies."
+ :type 'boolean
+ :group 'message-sending)
+
(defcustom message-courtesy-message
"The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
"*This is inserted at the start of a mailed copy of a posted message.
@@ -130,9 +145,10 @@ If the string contains the format spec \"%s\", the Newsgroups
the article has been posted to will be inserted there.
If this variable is nil, no such courtesy message will be added."
:group 'message-sending
- :type 'string)
+ :type '(radio (string :format "%t: %v\n" :size 0) (const nil)))
-(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
+(defcustom message-ignored-bounced-headers
+ "^\\(Received\\|Return-Path\\|Delivered-To\\):"
"*Regexp that matches headers to be removed in resent bounced mail."
:group 'message-interface
:type 'regexp)
@@ -156,7 +172,14 @@ Otherwise, most addresses look like `angles', but they look like
(const default))
:group 'message-headers)
-(defcustom message-syntax-checks nil
+(defcustom message-insert-canlock t
+ "Whether to insert a Cancel-Lock header in news postings."
+ :version "21.3"
+ :group 'message-headers
+ :type 'boolean)
+
+(defcustom message-syntax-checks
+ (if message-insert-canlock '((sender . disabled)) nil)
;; Guess this one shouldn't be easy to customize...
"*Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
@@ -169,13 +192,32 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys',
`new-text', `quoting-style', `redirected-followup', `signature',
`approved', `sender', `empty', `empty-headers', `message-id', `from',
`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to',
+`continuation-headers', `long-header-lines', `invisible-text' and
+`illegible-text'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
+(defcustom message-required-headers '((optional . References)
+ From)
+ "*Headers to be generated or prompted for when sending a message.
+Also see `message-required-news-headers' and
+`message-required-mail-headers'."
+ :group 'message-news
+ :group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
+ :type '(repeat sexp))
+
+(defcustom message-draft-headers '(References From)
+ "*Headers to be generated when saving a draft message."
+ :group 'message-news
+ :group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
+ :type '(repeat sexp))
+
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
- (optional . Organization) Lines
+ (optional . Organization)
(optional . User-Agent))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
@@ -184,64 +226,200 @@ User-Agent are optional. If don't you want message to insert some
header, remove it from this list."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-required-mail-headers
- '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID
(optional . User-Agent))
"*Headers to be generated or prompted for when mailing a message.
-RFC822 required that From, Date, To, Subject and Message-ID be
-included. Organization, Lines and User-Agent are optional."
+It is recommended that From, Date, To, Subject and Message-ID be
+included. Organization and User-Agent are optional."
:group 'message-mail
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-deletable-headers '(Message-ID Date Lines)
"Headers to be deleted if they already exist and were generated by message previously."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type 'regexp)
-(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:"
+(defcustom message-ignored-mail-headers
+ "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
+ :link '(custom-manual "(message)Mail Headers")
:type 'regexp)
-(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:"
+(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:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-interface
+ :link '(custom-manual "(message)Superseding")
:type 'regexp)
-(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
+(defcustom message-subject-re-regexp
+ "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
"*Regexp matching \"Re: \" in the subject line."
:group 'message-various
+ :link '(custom-manual "(message)Message Headers")
:type 'regexp)
+;;; Start of variables adopted from `message-utils.el'.
+
+(defcustom message-subject-trailing-was-query 'ask
+ "*What to do with trailing \"(was: <old subject>)\" in subject lines.
+If nil, leave the subject unchanged. If it is the symbol `ask', query
+the user what do do. In this case, the subject is matched against
+`message-subject-trailing-was-ask-regexp'. If
+`message-subject-trailing-was-query' is t, always strip the trailing
+old subject. In this case, `message-subject-trailing-was-regexp' is
+used."
+ :type '(choice (const :tag "never" nil)
+ (const :tag "always strip" t)
+ (const ask))
+ :link '(custom-manual "(message)Message Headers")
+ :group 'message-various)
+
+(defcustom message-subject-trailing-was-ask-regexp
+ "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+The function `message-strip-subject-trailing-was' uses this regexp if
+`message-subject-trailing-was-query' is set to the symbol `ask'. If
+the variable is t instead of `ask', use
+`message-subject-trailing-was-regexp' instead.
+
+It is okay to create some false positives here, as the user is asked."
+ :group 'message-various
+ :link '(custom-manual "(message)Message Headers")
+ :type 'regexp)
+
+(defcustom message-subject-trailing-was-regexp
+ "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+If `message-subject-trailing-was-query' is set to t, the subject is
+matched against `message-subject-trailing-was-regexp' in
+`message-strip-subject-trailing-was'. You should use a regexp creating very
+few false positives here."
+ :group 'message-various
+ :link '(custom-manual "(message)Message Headers")
+ :type 'regexp)
+
+;; Fixme: Why are all these things autoloaded?
+
+;;; marking inserted text
+
+;;;###autoload
+(defcustom message-mark-insert-begin
+ "--8<---------------cut here---------------start------------->8---\n"
+ "How to mark the beginning of some inserted text."
+ :type 'string
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-mark-insert-end
+ "--8<---------------cut here---------------end--------------->8---\n"
+ "How to mark the end of some inserted text."
+ :type 'string
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-header
+ "X-No-Archive: Yes\n"
+ "Header to insert when you don't want your article to be archived.
+Archives \(such as groups.google.com\) respect this header."
+ :type 'string
+ :link '(custom-manual "(message)Header Commands")
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-note
+ "X-No-Archive: Yes - save http://groups.google.com/"
+ "Note to insert why you wouldn't want this posting archived.
+If nil, don't insert any text in the body."
+ :type '(radio (string :format "%t: %v\n" :size 0)
+ (const nil))
+ :link '(custom-manual "(message)Header Commands")
+ :group 'message-various)
+
+;;; Crossposts and Followups
+;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
+;; new suggestions by R. Weikusat <rw at another.de>
+
+(defvar message-cross-post-old-target nil
+ "Old target for cross-posts or follow-ups.")
+(make-variable-buffer-local 'message-cross-post-old-target)
+
+;;;###autoload
+(defcustom message-cross-post-default t
+ "When non-nil `message-cross-post-followup-to' will perform a crosspost.
+If nil, `message-cross-post-followup-to' will only do a followup. Note that
+you can explicitly override this setting by calling
+`message-cross-post-followup-to' with a prefix."
+ :type 'boolean
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-cross-post-note
+ "Crosspost & Followup-To: "
+ "Note to insert before signature to notify of cross-post and follow-up."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-followup-to-note
+ "Followup-To: "
+ "Note to insert before signature to notify of follow-up only."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-cross-post-note-function
+ 'message-cross-post-insert-note
+ "Function to use to insert note about Crosspost or Followup-To.
+The function will be called with four arguments. The function should not only
+insert a note, but also ensure old notes are deleted. See the documentation
+for `message-cross-post-insert-note'."
+ :type 'function
+ :group 'message-various)
+
+;;; End of variables adopted from `message-utils.el'.
+
;;;###autoload
(defcustom message-signature-separator "^-- *$"
"Regexp matching the signature separator."
:type 'regexp
+ :link '(custom-manual "(message)Various Message Variables")
:group 'message-various)
(defcustom message-elide-ellipsis "\n[...]\n\n"
"*The string which is inserted for elided text."
:type 'string
+ :link '(custom-manual "(message)Various Commands")
:group 'message-various)
-(defcustom message-interactive nil
+(defcustom message-interactive t
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors."
:group 'message-sending
:group 'message-mail
+ :link '(custom-manual "(message)Sending Variables")
:type 'boolean)
(defcustom message-generate-new-buffers 'unique
@@ -250,6 +428,7 @@ If this is a function, call that function with three parameters: The type,
the to address and the group name. (Any of these may be nil.) The function
should return the new buffer name."
:group 'message-buffers
+ :link '(custom-manual "(message)Message Buffers")
:type '(choice (const :tag "off" nil)
(const :tag "unique" unique)
(const :tag "unsent" unsent)
@@ -258,6 +437,7 @@ should return the new buffer name."
(defcustom message-kill-buffer-on-exit nil
"*Non-nil means that the message buffer will be killed after sending a message."
:group 'message-buffers
+ :link '(custom-manual "(message)Message Buffers")
:type 'boolean)
(eval-when-compile
@@ -278,50 +458,68 @@ If t, use `message-user-organization-file'."
(defcustom message-user-organization-file "/usr/lib/news/organization"
"*Local news organization file."
:type 'file
+ :link '(custom-manual "(message)News Headers")
:group 'message-headers)
(defcustom message-make-forward-subject-function
- 'message-forward-subject-author-subject
+ #'message-forward-subject-name-subject
"*List of functions called to generate subject headers for forwarded messages.
The subject generated by the previous function is passed into each
successive function.
The provided functions are:
-* `message-forward-subject-author-subject' (Source of article (author or
- newsgroup)), in brackets followed by the subject
-* `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended
+* `message-forward-subject-author-subject' Source of article (author or
+ newsgroup), in brackets followed by the subject
+* `message-forward-subject-name-subject' Source of article (name of author
+ or newsgroup), in brackets followed by the subject
+* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
to it."
:group 'message-forwarding
+ :link '(custom-manual "(message)Forwarding")
:type '(radio (function-item message-forward-subject-author-subject)
(function-item message-forward-subject-fwd)
+ (function-item message-forward-subject-name-subject)
(repeat :tag "List of functions" function)))
(defcustom message-forward-as-mime t
- "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ "*Non-nil means forward messages as an inline/rfc822 MIME section.
+Otherwise, directly inline the old message in the forwarded message."
:version "21.1"
:group 'message-forwarding
+ :link '(custom-manual "(message)Forwarding")
:type 'boolean)
-(defcustom message-forward-show-mml t
- "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged."
+(defcustom message-forward-show-mml 'best
+ "*Non-nil means show forwarded messages as MML (decoded from MIME).
+Otherwise, forwarded messages are unchanged.
+Can also be the symbol `best' to indicate that MML should be
+used, except when it is a bad idea to use MML. One example where
+it is a bad idea is when forwarding a signed or encrypted
+message, because converting MIME to MML would invalidate the
+digital signature."
:version "21.1"
:group 'message-forwarding
- :type 'boolean)
+ :type '(choice (const :tag "use MML" t)
+ (const :tag "don't use MML " nil)
+ (const :tag "use MML when appropriate" best)))
(defcustom message-forward-before-signature t
- "*If non-nil, put forwarded message before signature, else after."
+ "*Non-nil means put forwarded message before signature, else after."
:group 'message-forwarding
:type 'boolean)
(defcustom message-wash-forwarded-subjects nil
- "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
+ "*Non-nil means try to remove as much cruft as possible from the subject.
+Done before generating the new subject of a forward."
:group 'message-forwarding
+ :link '(custom-manual "(message)Forwarding")
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
+(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
+ :link '(custom-manual "(message)Resending")
:type 'regexp)
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
@@ -334,11 +532,36 @@ The provided functions are:
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
+ :link '(custom-manual "(message)Insertion Variables")
+ :type 'regexp)
+
+(defcustom message-cite-prefix-regexp
+ (if (string-match "[[:digit:]]" "1") ;; support POSIX?
+ "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
+ ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
+ (let ((old-table (syntax-table))
+ non-word-constituents)
+ (set-syntax-table text-mode-syntax-table)
+ (setq non-word-constituents
+ (concat
+ (if (string-match "\\w" "-") "" "-")
+ (if (string-match "\\w" "_") "" "_")
+ (if (string-match "\\w" ".") "" ".")))
+ (set-syntax-table old-table)
+ (if (equal non-word-constituents "")
+ "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
+ (concat "\\([ \t]*\\(\\w\\|["
+ non-word-constituents
+ "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
+ "*Regexp matching the longest possible citation prefix on a line."
+ :group 'message-insertion
+ :link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
(defcustom message-cancel-message "I am canceling my own article.\n"
"Message to be inserted in the cancel message."
:group 'message-interface
+ :link '(custom-manual "(message)Canceling News")
:type 'string)
;; Useful to set in site-init.el
@@ -350,16 +573,18 @@ variable `mail-header-separator'.
Valid values include `message-send-mail-with-sendmail' (the default),
`message-send-mail-with-mh', `message-send-mail-with-qmail',
-`smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
See also `send-mail-function'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
+ (function-item message-smtpmail-send-it)
(function-item smtpmail-send-it)
(function-item feedmail-send-it)
(function :tag "Other"))
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(defcustom message-send-news-function 'message-send-news
@@ -368,6 +593,7 @@ The headers should be delimited by a line whose contents match the
variable `mail-header-separator'."
:group 'message-sending
:group 'message-news
+ :link '(custom-manual "(message)News Variables")
:type 'function)
(defcustom message-reply-to-function nil
@@ -375,6 +601,7 @@ variable `mail-header-separator'."
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
+ :link '(custom-manual "(message)Reply")
:type '(choice function (const nil)))
(defcustom message-wide-reply-to-function nil
@@ -382,6 +609,7 @@ and respond with new To and Cc headers."
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
+ :link '(custom-manual "(message)Wide Reply")
:type '(choice function (const nil)))
(defcustom message-followup-to-function nil
@@ -389,6 +617,7 @@ and respond with new To and Cc headers."
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
+ :link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
(defcustom message-use-followup-to 'ask
@@ -398,31 +627,108 @@ query before using the \"poster\" value. If it is the symbol `ask',
always query the user whether to use the value. If it is the symbol
`use', always use the value."
:group 'message-interface
+ :link '(custom-manual "(message)Followup")
:type '(choice (const :tag "ignore" nil)
+ (const :tag "use & query" t)
(const use)
(const ask)))
+(defcustom message-use-mail-followup-to 'use
+ "*Specifies what to do with Mail-Followup-To header.
+If nil, always ignore the header. If it is the symbol `ask', always
+query the user whether to use the value. If it is the symbol `use',
+always use the value."
+ :group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
+ :type '(choice (const :tag "ignore" nil)
+ (const use)
+ (const ask)))
+
+(defcustom message-subscribed-address-functions nil
+ "*Specifies functions for determining list subscription.
+If nil, do not attempt to determine list subscription with functions.
+If non-nil, this variable contains a list of functions which return
+regular expressions to match lists. These functions can be used in
+conjunction with `message-subscribed-regexps' and
+`message-subscribed-addresses'."
+ :group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
+ :type '(repeat sexp))
+
+(defcustom message-subscribed-address-file nil
+ "*A file containing addresses the user is subscribed to.
+If nil, do not look at any files to determine list subscriptions. If
+non-nil, each line of this file should be a mailing list address."
+ :group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
+ :type '(radio (file :format "%t: %v\n" :size 0)
+ (const nil)))
+
+(defcustom message-subscribed-addresses nil
+ "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions. This list of
+addresses can be used in conjunction with
+`message-subscribed-address-functions' and `message-subscribed-regexps'."
+ :group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
+ :type '(repeat string))
+
+(defcustom message-subscribed-regexps nil
+ "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions. This list of
+regular expressions can be used in conjunction with
+`message-subscribed-address-functions' and `message-subscribed-addresses'."
+ :group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
+ :type '(repeat regexp))
+
+(defcustom message-allow-no-recipients 'ask
+ "Specifies what to do when there are no recipients other than Gcc/Fcc.
+If it is the symbol `always', the posting is allowed. If it is the
+symbol `never', the posting is not allowed. If it is the symbol
+`ask', you are prompted."
+ :group 'message-interface
+ :link '(custom-manual "(message)Message Headers")
+ :type '(choice (const always)
+ (const never)
+ (const ask)))
+
(defcustom message-sendmail-f-is-evil nil
"*Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type 'boolean)
+(defcustom message-sendmail-envelope-from nil
+ "*Envelope-from when sending mail with sendmail.
+If this is nil, use `user-mail-address'. If it is the symbol
+`header', use the From: header of the message."
+ :type '(choice (string :tag "From name")
+ (const :tag "Use From: header from message" header)
+ (const :tag "Use `user-mail-address'" nil))
+ :link '(custom-manual "(message)Mail Variables")
+ :group 'message-sending)
+
;; qmail-related stuff
(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
"Location of the qmail-inject program."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type 'file)
(defcustom message-qmail-inject-args nil
"Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument.
+This should be a list of strings, one string for each argument. It
+may also be a function.
For e.g., if you wish to set the envelope sender address so that bounces
go to the right place or to deal with listserv's usage of that address, you
might set this variable to '(\"-f\" \"you@some.where\")."
:group 'message-sending
- :type '(repeat string))
+ :link '(custom-manual "(message)Mail Variables")
+ :type '(choice (function)
+ (repeat string)))
(defvar message-cater-to-broken-inn t
"Non-nil means Gnus should not fold the `References' header.
@@ -449,20 +755,37 @@ variable isn't used."
;; create a dependence to `gnus.el'.
:type 'sexp)
-(defcustom message-generate-headers-first nil
- "*If non-nil, generate all possible headers before composing."
+;; FIXME: This should be a temporary workaround until someone implements a
+;; proper solution. If a crash happens while replying, the auto-save file
+;; will *not* have a `References:' header if `message-generate-headers-first'
+;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
+(defcustom message-generate-headers-first '(references)
+ "Which headers should be generated before starting to compose a message.
+If `t', generate all required headers. This can also be a list of headers to
+generate. The variables `message-required-news-headers' and
+`message-required-mail-headers' specify which headers to generate.
+
+Note that the variable `message-deletable-headers' specifies headers which
+are to be deleted and then re-generated before sending, so this variable
+will not have a visible effect for those headers."
:group 'message-headers
- :type 'boolean)
+ :link '(custom-manual "(message)Message Headers")
+ :type '(choice (const :tag "None" nil)
+ (const :tag "References" '(references))
+ (const :tag "All" t)
+ (repeat (sexp :tag "Header"))))
(defcustom message-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-cancel-hook nil
"Hook run when cancelling articles."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-signature-setup-hook nil
@@ -470,6 +793,7 @@ The function `message-setup' runs this hook."
It is run after the headers have been inserted and before
the signature is inserted."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-mode-hook nil
@@ -485,24 +809,49 @@ the signature is inserted."
(defcustom message-header-setup-hook nil
"Hook called narrowed to the headers when setting up a message buffer."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
+(defcustom message-minibuffer-local-map
+ (let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
+ (set-keymap-parent map minibuffer-local-map)
+ map)
+ "Keymap for `message-read-from-minibuffer'.")
+
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
- "*Function called to insert the \"Whomever writes:\" line."
+ "*Function called to insert the \"Whomever writes:\" line.
+
+Note that Gnus provides a feature where the reader can click on
+`writes:' to hide the cited text. If you change this line too much,
+people who read your message will have to change their Gnus
+configuration. See the variable `gnus-cite-attribution-suffix'."
:type 'function
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
(defcustom message-yank-prefix "> "
- "*Prefix inserted on the lines of yanked messages."
+ "*Prefix inserted on the lines of yanked messages.
+Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
+See also `message-yank-cited-prefix'."
+ :type 'string
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-insertion)
+
+(defcustom message-yank-cited-prefix ">"
+ "*Prefix inserted on cited or empty lines of yanked messages.
+Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
+See also `message-yank-prefix'."
:type 'string
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-indentation-spaces 3
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'."
:group 'message-insertion
+ :link '(custom-manual "(message)Insertion Variables")
:type 'integer)
;;;###autoload
@@ -515,6 +864,7 @@ Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
(function-item message-cite-original-without-signature)
(function-item sc-cite-original)
(function :tag "Other"))
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
@@ -524,10 +874,9 @@ This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave
point and mark around the citation text as modified."
:type 'function
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-(defvar message-abbrevs-loaded nil)
-
;;;###autoload
(defcustom message-signature t
"*String to be inserted at the end of the message buffer.
@@ -535,6 +884,7 @@ If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead."
:type 'sexp
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
@@ -543,12 +893,21 @@ If a form, the result from the form will be used instead."
Ignored if the named file doesn't exist.
If nil, don't insert a signature."
:type '(choice file (const :tags "None" nil))
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-insertion)
+
+;;;###autoload
+(defcustom message-signature-insert-empty-line t
+ "*If non-nil, insert an empty line before the signature separator."
+ :type 'boolean
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)News Headers")
:type '(choice function (const nil)))
(defcustom message-expires 14
@@ -569,7 +928,10 @@ If stringp, use this; if non-nil, use no host name (user name only)."
(sexp :tag "none" :format "%t" t)))
(defvar message-reply-buffer nil)
-(defvar message-reply-headers nil)
+(defvar message-reply-headers nil
+ "The headers of the current replied article.
+It is a vector of the following headers:
+\[number subject from date id references chars lines xref extra].")
(defvar message-newsreader nil)
(defvar message-mailer nil)
(defvar message-sent-message-via nil)
@@ -594,18 +956,21 @@ If stringp, use this; if non-nil, use no host name (user name only)."
It is inserted before you edit the message, so you can edit or delete
these lines."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type 'message-header-lines)
(defcustom message-default-mail-headers ""
"*A string of header lines to be inserted in outgoing mails."
:group 'message-headers
:group 'message-mail
+ :link '(custom-manual "(message)Mail Headers")
:type 'message-header-lines)
(defcustom message-default-news-headers ""
"*A string of header lines to be inserted in outgoing news articles."
:group 'message-headers
:group 'message-news
+ :link '(custom-manual "(message)News Headers")
:type 'message-header-lines)
;; Note: could use /usr/ucb/mail instead of sendmail;
@@ -633,6 +998,7 @@ these lines."
The value should be an expression to test whether the problem will
actually occur."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type 'sexp)
;;;###autoload
@@ -671,33 +1037,52 @@ mail aliases off."
"*Directory where Message auto-saves buffers if Gnus isn't running.
If nil, Message won't auto-save."
:group 'message-buffers
+ :link '(custom-manual "(message)Various Message Variables")
:type '(choice directory (const :tag "Don't auto-save" nil)))
-(defcustom message-buffer-naming-style 'unique
- "*The way new message buffers are named.
-Valid values are `unique' and `unsent'."
- :version "21.1"
- :group 'message-buffers
- :type '(choice (const :tag "unique" unique)
- (const :tag "unsent" unsent)))
-
(defcustom message-default-charset
(and (not (mm-multibyte-p)) 'iso-8859-1)
"Default charset used in non-MULE Emacsen.
If nil, you might be asked to input the charset."
:version "21.1"
:group 'message
+ :link '(custom-manual "(message)Various Message Variables")
:type 'symbol)
(defcustom message-dont-reply-to-names
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
- "*A regexp specifying names to prune when doing wide replies.
-A value of nil means exclude your own name only."
+ "*A regexp specifying addresses to prune when doing wide replies.
+A value of nil means exclude your own user name only."
:version "21.1"
:group 'message
+ :link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
regexp))
+(defvar message-shoot-gnksa-feet nil
+ "*A list of GNKSA feet you are allowed to shoot.
+Gnus gives you all the opportunity you could possibly want for
+shooting yourself in the foot. Also, Gnus allows you to shoot the
+feet of Good Net-Keeping Seal of Approval. The following are foot
+candidates:
+`empty-article' Allow you to post an empty article;
+`quoted-text-only' Allow you to post quoted text only;
+`multiple-copies' Allow you to post multiple copies;
+`cancel-messages' Allow you to cancel or supersede messages from
+ your other email addresses.")
+
+(defsubst message-gnksa-enable-p (feature)
+ (or (not (listp message-shoot-gnksa-feet))
+ (memq feature message-shoot-gnksa-feet)))
+
+(defcustom message-hidden-headers nil
+ "Regexp of headers to be hidden when composing new messages.
+This can also be a list of regexps to match headers. Or a list
+starting with `not' and followed by regexps."
+ :group 'message
+ :link '(custom-manual "(message)Message Headers")
+ :type '(repeat regexp))
+
;;; Internal variables.
;;; Well, not really internal.
@@ -709,31 +1094,27 @@ A value of nil means exclude your own name only."
table)
"Syntax table used while in Message mode.")
-(defvar message-mode-abbrev-table text-mode-abbrev-table
- "Abbrev table used in Message mode buffers.
-Defaults to `text-mode-abbrev-table'.")
-
(defface message-header-to-face
'((((class color)
(background dark))
- (:foreground "green2" :weight bold))
+ (:foreground "green2" :bold t))
(((class color)
(background light))
- (:foreground "MidnightBlue" :weight bold))
+ (:foreground "MidnightBlue" :bold t))
(t
- (:weight bold :slant italic)))
+ (:bold t :italic t)))
"Face used for displaying From headers."
:group 'message-faces)
(defface message-header-cc-face
'((((class color)
(background dark))
- (:foreground "green4" :weight bold))
+ (:foreground "green4" :bold t))
(((class color)
(background light))
(:foreground "MidnightBlue"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying Cc headers."
:group 'message-faces)
@@ -743,21 +1124,21 @@ Defaults to `text-mode-abbrev-table'.")
(:foreground "green3"))
(((class color)
(background light))
- (:foreground "navy blue" :weight bold))
+ (:foreground "navy blue" :bold t))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying subject headers."
:group 'message-faces)
(defface message-header-newsgroups-face
'((((class color)
(background dark))
- (:foreground "yellow" :weight bold :slant italic))
+ (:foreground "yellow" :bold t :italic t))
(((class color)
(background light))
- (:foreground "blue4" :weight bold :slant italic))
+ (:foreground "blue4" :bold t :italic t))
(t
- (:weight bold :slant italic)))
+ (:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
@@ -769,7 +1150,7 @@ Defaults to `text-mode-abbrev-table'.")
(background light))
(:foreground "steel blue"))
(t
- (:weight bold :slant italic)))
+ (:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
@@ -781,7 +1162,7 @@ Defaults to `text-mode-abbrev-table'.")
(background light))
(:foreground "cornflower blue"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying header names."
:group 'message-faces)
@@ -793,7 +1174,7 @@ Defaults to `text-mode-abbrev-table'.")
(background light))
(:foreground "blue"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying X-Header headers."
:group 'message-faces)
@@ -805,7 +1186,7 @@ Defaults to `text-mode-abbrev-table'.")
(background light))
(:foreground "brown"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying the separator."
:group 'message-faces)
@@ -817,7 +1198,7 @@ Defaults to `text-mode-abbrev-table'.")
(background light))
(:foreground "red"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying cited text names."
:group 'message-faces)
@@ -829,30 +1210,52 @@ Defaults to `text-mode-abbrev-table'.")
(background light))
(:foreground "ForestGreen"))
(t
- (:weight bold)))
+ (:bold t)))
"Face used for displaying MML."
:group 'message-faces)
+(defun message-font-lock-make-header-matcher (regexp)
+ (let ((form
+ `(lambda (limit)
+ (let ((start (point)))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (setq limit (min limit (match-beginning 0))))
+ (goto-char start))
+ (and (< start limit)
+ (re-search-forward ,regexp limit t))))))
+ (if (featurep 'bytecomp)
+ (byte-compile form)
+ form)))
+
(defvar message-font-lock-keywords
- (let* ((cite-prefix "[:alpha:]")
- (cite-suffix (concat cite-prefix "0-9_.@-"))
- (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
- `((,(concat "^\\([Tt]o:\\)" content)
+ (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
+ `((,(message-font-lock-make-header-matcher
+ (concat "^\\([Tt]o:\\)" content))
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
- (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
(1 'message-header-name-face)
(2 'message-header-cc-face nil t))
- (,(concat "^\\([Ss]ubject:\\)" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([Ss]ubject:\\)" content))
(1 'message-header-name-face)
(2 'message-header-subject-face nil t))
- (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
(1 'message-header-name-face)
(2 'message-header-newsgroups-face nil t))
- (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([A-Z][^: \n\t]+:\\)" content))
(1 'message-header-name-face)
(2 'message-header-other-face nil t))
- (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
(1 'message-header-name-face)
(2 'message-header-name-face))
,@(if (and mail-header-separator
@@ -860,14 +1263,17 @@ Defaults to `text-mode-abbrev-table'.")
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1 'message-separator-face))
nil)
- (,(concat "^[ \t]*"
- "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
- "[:>|}].*")
+ ((lambda (limit)
+ (re-search-forward (concat "^\\("
+ message-cite-prefix-regexp
+ "\\).*")
+ limit t))
(0 'message-cited-text-face))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
+ ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
(0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
+
;; XEmacs does it like this. For Emacs, we have to set the
;; `font-lock-defaults' buffer-local variable.
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
@@ -882,19 +1288,27 @@ Defaults to `text-mode-abbrev-table'.")
The cdr of each entry is a function for applying the face to a region.")
(defcustom message-send-hook nil
- "Hook run before sending messages."
+ "Hook run before sending messages.
+This hook is run quite early when sending."
:group 'message-various
:options '(ispell-message)
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-send-mail-hook nil
- "Hook run before sending mail messages."
+ "Hook run before sending mail messages.
+This hook is run very late -- just before the message is sent as
+mail."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-send-news-hook nil
- "Hook run before sending news messages."
+ "Hook run before sending news messages.
+This hook is run very late -- just before the message is sent as
+news."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-sent-hook nil
@@ -907,7 +1321,10 @@ The cdr of each entry is a function for applying the face to a region.")
(defvar message-draft-coding-system
mm-auto-save-coding-system
- "Coding system to compose mail.")
+ "*Coding system to compose mail.
+If you'd like to make it possible to share draft files between XEmacs
+and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
+Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
(defcustom message-send-mail-partially-limit 1000000
"The limitation of messages sent as message/partial.
@@ -915,6 +1332,7 @@ The lower bound of message size in characters, beyond which the message
should be sent in several parts. If it is nil, the size is unlimited."
:version "21.1"
:group 'message-buffers
+ :link '(custom-manual "(message)Mail Variables")
:type '(choice (const :tag "unlimited" nil)
(integer 1000000)))
@@ -922,9 +1340,23 @@ should be sent in several parts. If it is nil, the size is unlimited."
"A regexp to match the alternative email addresses.
The first matched address (not primary one) is used in the From field."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "Always use primary" nil)
regexp))
+(defcustom message-hierarchical-addresses nil
+ "A list of hierarchical mail address definitions.
+
+Inside each entry, the first address is the \"top\" address, and
+subsequent addresses are subaddresses; this is used to indicate that
+mail sent to the first address will automatically be delivered to the
+subaddresses. So if the first address appears in the recipient list
+for a message, the subaddresses will be removed (if present) before
+the mail is sent. All addresses in this structure should be
+downcased."
+ :group 'message-headers
+ :type '(repeat (repeat string)))
+
(defcustom message-mail-user-agent nil
"Like `mail-user-agent'.
Except if it is nil, use Gnus native MUA; if it is t, use
@@ -945,6 +1377,37 @@ Except if it is nil, use Gnus native MUA; if it is t, use
:version "21.1"
:group 'message)
+(defcustom message-wide-reply-confirm-recipients nil
+ "Whether to confirm a wide reply to multiple email recipients.
+If this variable is nil, don't ask whether to reply to all recipients.
+If this variable is non-nil, pose the question \"Reply to all
+recipients?\" before a wide reply to multiple recipients. If the user
+answers yes, reply to all recipients as usual. If the user answers
+no, only reply back to the author."
+ :version "21.3"
+ :group 'message-headers
+ :link '(custom-manual "(message)Wide Reply")
+ :type 'boolean)
+
+(defcustom message-user-fqdn nil
+ "*Domain part of Messsage-Ids."
+ :group 'message-headers
+ :link '(custom-manual "(message)News Headers")
+ :type '(radio (const :format "%v " nil)
+ (string :format "FQDN: %v\n" :size 0)))
+
+(defcustom message-use-idna (and (condition-case nil (require 'idna)
+ (file-error))
+ (mm-coding-system-p 'utf-8)
+ (executable-find idna-program)
+ 'ask)
+ "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+ :group 'message-headers
+ :link '(custom-manual "(message)IDNA")
+ :type '(choice (const :tag "Ask" ask)
+ (const :tag "Never" nil)
+ (const :tag "Always" t)))
+
;;; Internal variables.
(defvar message-sending-message "Sending...")
@@ -954,6 +1417,7 @@ Except if it is nil, use Gnus native MUA; if it is t, use
(defvar message-draft-article nil)
(defvar message-mime-part nil)
(defvar message-posting-charset nil)
+(defvar message-inserted-headers nil)
;; Byte-compiler warning
(eval-when-compile
@@ -979,7 +1443,7 @@ Except if it is nil, use Gnus native MUA; if it is t, use
;; can be removed, e.g.
;; From: joe@y.z (Joe K
;; User)
- ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
+ ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
;; From: Joe User
;; <joe@y.z>
;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
@@ -991,7 +1455,7 @@ Except if it is nil, use Gnus native MUA; if it is t, use
;; We want to match the results of any of these manglings.
;; The following regexp rejects names whose first characters are
;; obviously bogus, but after that anything goes.
- "\\([^\0-\b\n-\r\^?].*\\)? "
+ "\\([^\0-\b\n-\r\^?].*\\)?"
;; The time the message was sent.
"\\([^\0-\r \^?]+\\) +" ; day of the week
@@ -1044,7 +1508,30 @@ Except if it is nil, use Gnus native MUA; if it is t, use
(User-Agent))
"Alist used for formatting headers.")
+(defvar message-options nil
+ "Some saved answers when sending message.")
+
+(defvar message-send-mail-real-function nil
+ "Internal send mail function.")
+
+(defvar message-bogus-system-names "^localhost\\."
+ "The regexp of bogus system names.")
+
+(defcustom message-valid-fqdn-regexp
+ (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
+ ;; valid TLDs:
+ "\\([a-z][a-z]" ;; two letter country TDLs
+ "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
+ "\\|aero\\|coop\\|info\\|name\\|museum"
+ "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
+ "\\)")
+ "Regular expression that matches a valid FQDN."
+ ;; see also: gnus-button-valid-fqdn-regexp
+ :group 'message-headers
+ :type 'regexp)
+
(eval-and-compile
+ (autoload 'idna-to-ascii "idna")
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
@@ -1052,14 +1539,19 @@ Except if it is nil, use Gnus native MUA; if it is t, use
(autoload 'gnus-point-at-bol "gnus-util")
(autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'nndraft-request-expire-articles "nndraft")
(autoload 'gnus-open-server "gnus-int")
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-alive-p "gnus-util")
+ (autoload 'gnus-server-string "gnus")
(autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'rmail-output "rmailout"))
+ (autoload 'gnus-group-name-decode "gnus-group")
+ (autoload 'gnus-groups-from-server "gnus")
+ (autoload 'rmail-output "rmailout")
+ (autoload 'gnus-delay-article "gnus-delay")
+ (autoload 'gnus-make-local-hook "gnus-util")
+ (autoload 'gnus-extract-address-components "gnus-util"))
@@ -1076,14 +1568,18 @@ Except if it is nil, use Gnus native MUA; if it is t, use
`(delete-region (progn (beginning-of-line) (point))
(progn (forward-line ,(or n 1)) (point))))
+(defun message-mark-active-p ()
+ "Non-nil means the mark and region are currently active in this buffer."
+ mark-active)
+
(defun message-unquote-tokens (elems)
"Remove double quotes (\") from strings in list ELEMS."
(mapcar (lambda (item)
- (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
- (setq item (concat (match-string 1 item)
- (match-string 2 item))))
- item)
- elems))
+ (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
+ (setq item (concat (match-string 1 item)
+ (match-string 2 item))))
+ item)
+ elems))
(defun message-tokenize-header (header &optional separator)
"Split HEADER into a list of header elements.
@@ -1095,8 +1591,8 @@ is used by default."
(beg 1)
(first t)
quoted elems paren)
- (save-excursion
- (message-set-work-buffer)
+ (with-temp-buffer
+ (mm-enable-multibyte)
(insert header)
(goto-char (point-min))
(while (not (eobp))
@@ -1118,7 +1614,7 @@ is used by default."
((and (eq (char-after) ?\))
(not quoted))
(setq paren nil))))
- (nreverse elems)))))
+ (nreverse elems)))))
(defun message-mail-file-mbox-p (file)
"Say whether FILE looks like a Unix mbox file."
@@ -1131,7 +1627,9 @@ is used by default."
(looking-at message-unix-mail-delimiter))))
(defun message-fetch-field (header &optional not-all)
- "The same as `mail-fetch-field', only remove all newlines."
+ "The same as `mail-fetch-field', only remove all newlines.
+The buffer is expected to be narrowed to just the header of the message;
+see `message-narrow-to-headers-or-head'."
(let* ((inhibit-point-motion-hooks t)
(case-fold-search t)
(value (mail-fetch-field header nil (not not-all))))
@@ -1141,6 +1639,13 @@ is used by default."
(set-text-properties 0 (length value) nil value)
value)))
+(defun message-field-value (header &optional not-all)
+ "The same as `message-fetch-field', only narrow to the headers first."
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field header not-all))))
+
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(beginning-of-line)
@@ -1165,33 +1670,30 @@ is used by default."
(save-restriction
(message-narrow-to-headers)
(unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
- (insert (car headers) ?\n))))
+ (goto-char (point-max))
+ (if (string-match "\n$" (car headers))
+ (insert (car headers))
+ (insert (car headers) ?\n)))))
(setq headers (cdr headers))))
+(defmacro message-with-reply-buffer (&rest forms)
+ "Evaluate FORMS in the reply buffer, if it exists."
+ `(when (and message-reply-buffer
+ (buffer-name message-reply-buffer))
+ (save-excursion
+ (set-buffer message-reply-buffer)
+ ,@forms)))
+
+(put 'message-with-reply-buffer 'lisp-indent-function 0)
+(put 'message-with-reply-buffer 'edebug-form-spec '(body))
(defun message-fetch-reply-field (header)
"Fetch field HEADER from the message we're replying to."
- (when (and message-reply-buffer
- (buffer-name message-reply-buffer))
- (save-excursion
- (set-buffer message-reply-buffer)
+ (message-with-reply-buffer
+ (save-restriction
+ (mail-narrow-to-head)
(message-fetch-field header))))
-(defun message-set-work-buffer ()
- (if (get-buffer " *message work*")
- (progn
- (set-buffer " *message work*")
- (erase-buffer))
- (set-buffer (get-buffer-create " *message work*"))
- (kill-all-local-variables)
- (mm-enable-multibyte)))
-
-(defun message-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))
- (byte-code-function-p form)))
-
(defun message-strip-list-identifiers (subject)
"Remove list identifiers in `gnus-list-identifiers' from string SUBJECT."
(require 'gnus-sum) ; for gnus-list-identifiers
@@ -1199,7 +1701,7 @@ is used by default."
gnus-list-identifiers
(mapconcat 'identity gnus-list-identifiers " *\\|"))))
(if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
- " *\\)\\)+\\(Re: +\\)?\\)") subject)
+ " *\\)\\)+\\(Re: +\\)?\\)") subject)
(concat (substring subject 0 (match-beginning 1))
(or (match-string 3 subject)
(match-string 5 subject))
@@ -1213,6 +1715,265 @@ is used by default."
(substring subject (match-end 0))
subject))
+;;; Start of functions adopted from `message-utils.el'.
+
+(defun message-strip-subject-trailing-was (subject)
+ "Remove trailing \"(Was: <old subject>)\" from SUBJECT lines.
+Leading \"Re: \" is not stripped by this function. Use the function
+`message-strip-subject-re' for this."
+ (let* ((query message-subject-trailing-was-query)
+ (new) (found))
+ (setq found
+ (string-match
+ (if (eq query 'ask)
+ message-subject-trailing-was-ask-regexp
+ message-subject-trailing-was-regexp)
+ subject))
+ (if found
+ (setq new (substring subject 0 (match-beginning 0))))
+ (if (or (not found) (eq query nil))
+ subject
+ (if (eq query 'ask)
+ (if (message-y-or-n-p
+ "Strip `(was: <old subject>)' in subject? " t
+ (concat
+ "Strip `(was: <old subject>)' in subject "
+ "and use the new one instead?\n\n"
+ "Current subject is: \""
+ subject "\"\n\n"
+ "New subject would be: \""
+ new "\"\n\n"
+ "See the variable `message-subject-trailing-was-query' "
+ "to get rid of this query."
+ ))
+ new subject)
+ new))))
+
+;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
+
+;;;###autoload
+(defun message-change-subject (new-subject)
+ "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
+ ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
+ (interactive
+ (list
+ (read-from-minibuffer "New subject: ")))
+ (cond ((and (not (or (null new-subject) ; new subject not empty
+ (zerop (string-width new-subject))
+ (string-match "^[ \t]*$" new-subject))))
+ (save-excursion
+ (let ((old-subject
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "Subject"))))
+ (cond ((not old-subject)
+ (error "No current subject"))
+ ((not (string-match
+ (concat "^[ \t]*"
+ (regexp-quote new-subject)
+ " \t]*$")
+ old-subject)) ; yes, it really is a new subject
+ ;; delete eventual Re: prefix
+ (setq old-subject
+ (message-strip-subject-re old-subject))
+ (message-goto-subject)
+ (message-delete-line)
+ (insert (concat "Subject: "
+ new-subject
+ " (was: "
+ old-subject ")\n")))))))))
+
+;;;###autoload
+(defun message-mark-inserted-region (beg end)
+ "Mark some region in the current article with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+ (interactive "r")
+ (save-excursion
+ ;; add to the end of the region first, otherwise end would be invalid
+ (goto-char end)
+ (insert message-mark-insert-end)
+ (goto-char beg)
+ (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-mark-insert-file (file)
+ "Insert FILE at point, marking it with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+ (interactive "fFile to insert: ")
+ ;; reverse insertion to get correct result.
+ (let ((p (point)))
+ (insert message-mark-insert-end)
+ (goto-char p)
+ (insert-file-contents file)
+ (goto-char p)
+ (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-add-archive-header ()
+ "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
+The note can be customized using `message-archive-note'. When called with a
+prefix argument, ask for a text to insert. If you don't want the note in the
+body, set `message-archive-note' to nil."
+ (interactive)
+ (if current-prefix-arg
+ (setq message-archive-note
+ (read-from-minibuffer "Reason for No-Archive: "
+ (cons message-archive-note 0))))
+ (save-excursion
+ (if (message-goto-signature)
+ (re-search-backward message-signature-separator))
+ (when message-archive-note
+ (insert message-archive-note)
+ (newline))
+ (message-add-header message-archive-header)
+ (message-sort-headers)))
+
+;;;###autoload
+(defun message-cross-post-followup-to-header (target-group)
+ "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+ (interactive
+ (list ; Completion based on Gnus
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history))))
+ (message-remove-header "Follow[Uu]p-[Tt]o" t)
+ (message-goto-newsgroups)
+ (beginning-of-line)
+ ;; if we already did a crosspost before, kill old target
+ (if (and message-cross-post-old-target
+ (re-search-forward
+ (regexp-quote (concat "," message-cross-post-old-target))
+ nil t))
+ (replace-match ""))
+ ;; unless (followup is to poster or user explicitly asked not
+ ;; to cross-post, or target-group is already in Newsgroups)
+ ;; add target-group to Newsgroups line.
+ (cond ((and (or
+ ;; def: cross-post, req:no
+ (and message-cross-post-default (not current-prefix-arg))
+ ;; def: no-cross-post, req:yes
+ (and (not message-cross-post-default) current-prefix-arg))
+ (not (string-match "poster" target-group))
+ (not (string-match (regexp-quote target-group)
+ (message-fetch-field "Newsgroups"))))
+ (end-of-line)
+ (insert (concat "," target-group))))
+ (end-of-line) ; ensure Followup: comes after Newsgroups:
+ ;; unless new followup would be identical to Newsgroups line
+ ;; make a new Followup-To line
+ (if (not (string-match (concat "^[ \t]*"
+ target-group
+ "[ \t]*$")
+ (message-fetch-field "Newsgroups")))
+ (insert (concat "\nFollowup-To: " target-group)))
+ (setq message-cross-post-old-target target-group))
+
+;;;###autoload
+(defun message-cross-post-insert-note (target-group cross-post in-old
+ old-groups)
+ "Insert a in message body note about a set Followup or Crosspost.
+If there have been previous notes, delete them. TARGET-GROUP specifies the
+group to Followup-To. When CROSS-POST is t, insert note about
+crossposting. IN-OLD specifies whether TARGET-GROUP is a member of
+OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have
+been made to before the user asked for a Crosspost."
+ ;; start scanning body for previous uses
+ (message-goto-signature)
+ (let ((head (re-search-backward
+ (concat "^" mail-header-separator)
+ nil t))) ; just search in body
+ (message-goto-signature)
+ (while (re-search-backward
+ (concat "^" (regexp-quote message-cross-post-note) ".*")
+ head t)
+ (message-delete-line))
+ (message-goto-signature)
+ (while (re-search-backward
+ (concat "^" (regexp-quote message-followup-to-note) ".*")
+ head t)
+ (message-delete-line))
+ ;; insert new note
+ (if (message-goto-signature)
+ (re-search-backward message-signature-separator))
+ (if (or in-old
+ (not cross-post)
+ (string-match "^[ \t]*poster[ \t]*$" target-group))
+ (insert (concat message-followup-to-note target-group "\n"))
+ (insert (concat message-cross-post-note target-group "\n")))))
+
+;;;###autoload
+(defun message-cross-post-followup-to (target-group)
+ "Crossposts message and set Followup-To to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+ (interactive
+ (list ; Completion based on Gnus
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history))))
+ (cond ((not (or (null target-group) ; new subject not empty
+ (zerop (string-width target-group))
+ (string-match "^[ \t]*$" target-group)))
+ (save-excursion
+ (let* ((old-groups (message-fetch-field "Newsgroups"))
+ (in-old (string-match
+ (regexp-quote target-group)
+ (or old-groups ""))))
+ ;; check whether target exactly matches old Newsgroups
+ (cond ((not old-groups)
+ (error "No current newsgroup"))
+ ((or (not in-old)
+ (not (string-match
+ (concat "^[ \t]*"
+ (regexp-quote target-group)
+ "[ \t]*$")
+ old-groups)))
+ ;; yes, Newsgroups line must change
+ (message-cross-post-followup-to-header target-group)
+ ;; insert note whether we do cross-post or followup-to
+ (funcall message-cross-post-note-function
+ target-group
+ (if (or (and message-cross-post-default
+ (not current-prefix-arg))
+ (and (not message-cross-post-default)
+ current-prefix-arg)) t)
+ in-old old-groups))))))))
+
+;;; Reduce To: to Cc: or Bcc: header
+
+;;;###autoload
+(defun message-reduce-to-to-cc ()
+ "Replace contents of To: header with contents of Cc: or Bcc: header."
+ (interactive)
+ (let ((cc-content
+ (save-restriction (message-narrow-to-headers)
+ (message-fetch-field "cc")))
+ (bcc nil))
+ (if (and (not cc-content)
+ (setq cc-content
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "bcc"))))
+ (setq bcc t))
+ (cond (cc-content
+ (save-excursion
+ (message-goto-to)
+ (message-delete-line)
+ (insert (concat "To: " cc-content "\n"))
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header (if bcc
+ "bcc"
+ "cc"))))))))
+
+;;; End of functions adopted from `message-utils.el'.
+
(defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
@@ -1321,6 +2082,13 @@ Point is left at the beginning of the narrowed-to region."
(message-fetch-field "cc")
(message-fetch-field "bcc")))))))
+(defun message-subscribed-p ()
+ "Say whether we need to insert a MFT header."
+ (or message-subscribed-regexps
+ message-subscribed-addresses
+ message-subscribed-address-file
+ message-subscribed-address-functions))
+
(defun message-next-header ()
"Go to the beginning of the next header."
(beginning-of-line)
@@ -1364,6 +2132,7 @@ Point is left at the beginning of the narrowed-to region."
(1+ max)))))
(message-sort-headers-1))))
+
;;;
@@ -1380,6 +2149,7 @@ Point is left at the beginning of the narrowed-to region."
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
+ (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
(define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
@@ -1388,13 +2158,36 @@ Point is left at the beginning of the narrowed-to region."
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
(define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+ (define-key message-mode-map "\C-c\C-f\C-i"
+ 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\C-f\C-a"
+ 'message-generate-unsubscribed-mail-followup-to)
+
+ ;; modify headers (and insert notes in body)
+ (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
+ ;;
+ (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
+ ;; prefix+message-cross-post-followup-to = same w/o cross-post
+ (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
+ (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
+ ;; mark inserted text
+ (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
+ (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
+
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
+ (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
+ (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
+
+ (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\M-n"
+ 'message-insert-disposition-notification-to)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
@@ -1409,67 +2202,187 @@ Point is left at the beginning of the narrowed-to region."
(define-key message-mode-map "\C-c\C-s" 'message-send)
(define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
(define-key message-mode-map "\C-c\C-d" 'message-dont-send)
+ (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region)
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
+ ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
(define-key message-mode-map [remap split-line] 'message-split-line)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
- (define-key message-mode-map "\t" 'message-tab))
+ (define-key message-mode-map "\C-a" 'message-beginning-of-line)
+ (define-key message-mode-map "\t" 'message-tab)
+ (define-key message-mode-map "\M-;" 'comment-region))
(easy-menu-define
- message-mode-menu message-mode-map "Message Menu."
- '("Message"
- ["Sort Headers" message-sort-headers t]
- ["Yank Original" message-yank-original t]
- ["Fill Yanked Message" message-fill-yanked-message t]
- ["Insert Signature" message-insert-signature t]
- ["Caesar (rot13) Message" message-caesar-buffer-body t]
- ["Caesar (rot13) Region" message-caesar-region (mark t)]
- ["Elide Region" message-elide-region (mark t)]
- ["Delete Outside Region" message-delete-not-region (mark t)]
- ["Kill To Signature" message-kill-to-signature t]
- ["Newline and Reformat" message-newline-and-reformat t]
- ["Rename buffer" message-rename-buffer t]
- ["Spellcheck" ispell-message
- :help "Spellcheck this message"]
- ["Attach file as MIME" mml-attach-file
- :help "Attach a file at point"]
- "----"
- ["Send Message" message-send-and-exit
- :help "Send this message"]
- ["Abort Message" message-dont-send
- :help "File this draft message and exit"]
- ["Kill Message" message-kill-buffer
- :help "Delete this message without sending"]))
+ message-mode-menu message-mode-map "Message Menu."
+ `("Message"
+ ["Yank Original" message-yank-original message-reply-buffer]
+ ["Fill Yanked Message" message-fill-yanked-message t]
+ ["Insert Signature" message-insert-signature t]
+ ["Caesar (rot13) Message" message-caesar-buffer-body t]
+ ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
+ ["Elide Region" message-elide-region
+ :active (message-mark-active-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Replace text in region with an ellipsis"))]
+ ["Delete Outside Region" message-delete-not-region
+ :active (message-mark-active-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Delete all quoted text outside region"))]
+ ["Kill To Signature" message-kill-to-signature t]
+ ["Newline and Reformat" message-newline-and-reformat t]
+ ["Rename buffer" message-rename-buffer t]
+ ["Spellcheck" ispell-message
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Spellcheck this message"))]
+ "----"
+ ["Insert Region Marked" message-mark-inserted-region
+ :active (message-mark-active-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark region with enclosing tags"))]
+ ["Insert File Marked..." message-mark-insert-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert file at point marked with enclosing tags"))]
+ "----"
+ ["Send Message" message-send-and-exit
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Send this message"))]
+ ["Postpone Message" message-dont-send
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "File this draft message and exit"))]
+ ["Send at Specific Time..." gnus-delay-article
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Ask, then arrange to send message at that time"))]
+ ["Kill Message" message-kill-buffer
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Delete this message without sending"))]))
(easy-menu-define
- message-mode-field-menu message-mode-map ""
- '("Field"
- ["Fetch To" message-insert-to t]
- ["Fetch Newsgroups" message-insert-newsgroups t]
- "----"
- ["To" message-goto-to t]
- ["Subject" message-goto-subject t]
- ["Cc" message-goto-cc t]
- ["Reply-To" message-goto-reply-to t]
- ["Summary" message-goto-summary t]
- ["Keywords" message-goto-keywords t]
- ["Newsgroups" message-goto-newsgroups t]
- ["Followup-To" message-goto-followup-to t]
- ["Distribution" message-goto-distribution t]
- ["Body" message-goto-body t]
- ["Signature" message-goto-signature t]))
+ message-mode-field-menu message-mode-map ""
+ `("Field"
+ ["To" message-goto-to t]
+ ["From" message-goto-from t]
+ ["Subject" message-goto-subject t]
+ ["Change subject..." message-change-subject t]
+ ["Cc" message-goto-cc t]
+ ["Bcc" message-goto-bcc t]
+ ["Fcc" message-goto-fcc t]
+ ["Reply-To" message-goto-reply-to t]
+ ["Flag As Important" message-insert-importance-high
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as important"))]
+ ["Flag As Unimportant" message-insert-importance-low
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as unimportant"))]
+ ["Request Receipt"
+ message-insert-disposition-notification-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Request a receipt notification"))]
+ "----"
+ ;; (typical) news stuff
+ ["Summary" message-goto-summary t]
+ ["Keywords" message-goto-keywords t]
+ ["Newsgroups" message-goto-newsgroups t]
+ ["Fetch Newsgroups" message-insert-newsgroups t]
+ ["Followup-To" message-goto-followup-to t]
+ ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
+ ["Crosspost / Followup-To..." message-cross-post-followup-to t]
+ ["Distribution" message-goto-distribution t]
+ ["X-No-Archive:" message-add-archive-header t ]
+ "----"
+ ;; (typical) mailing-lists stuff
+ ["Fetch To" message-insert-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert a To header that points to the author."))]
+ ["Fetch To and Cc" message-insert-wide-reply
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help
+ "Insert To and Cc headers as if you were doing a wide reply."))]
+ "----"
+ ["Send to list only" message-to-list-only t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
+ ["Reduce To: to Cc:" message-reduce-to-to-cc t]
+ "----"
+ ["Sort Headers" message-sort-headers t]
+ ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
+ ["Goto Body" message-goto-body t]
+ ["Goto Signature" message-goto-signature t]))
+
+(defvar message-tool-bar-map nil)
(eval-when-compile
(defvar facemenu-add-face-function)
(defvar facemenu-remove-face-function))
+;;; Forbidden properties
+;;
+;; We use `after-change-functions' to keep special text properties
+;; that interfer with the normal function of message mode out of the
+;; buffer.
+
+(defcustom message-strip-special-text-properties t
+ "Strip special properties from the message buffer.
+
+Emacs has a number of special text properties which can break message
+composing in various ways. If this option is set, message will strip
+these properties from the message composition buffer. However, some
+packages requires these properties to be present in order to work.
+If you use one of these packages, turn this option off, and hope the
+message composition doesn't break too bad."
+ :group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
+ :type 'boolean)
+
+(defconst message-forbidden-properties
+ ;; No reason this should be clutter up customize. We make it a
+ ;; property list (rather than a list of property symbols), to be
+ ;; directly useful for `remove-text-properties'.
+ '(field nil read-only nil invisible nil intangible nil
+ mouse-face nil modification-hooks nil insert-in-front-hooks nil
+ insert-behind-hooks nil point-entered nil point-left nil)
+ ;; Other special properties:
+ ;; category, face, display: probably doesn't do any harm.
+ ;; fontified: is used by font-lock.
+ ;; syntax-table, local-map: I dunno.
+ ;; We need to add XEmacs names to the list.
+ "Property list of with properties.forbidden in message buffers.
+The values of the properties are ignored, only the property names are used.")
+
+(defun message-tamago-not-in-use-p (pos)
+ "Return t when tamago version 4 is not in use at the cursor position.
+Tamago version 4 is a popular input method for writing Japanese text.
+It uses the properties `intangible', `invisible', `modification-hooks'
+and `read-only' when translating ascii or kana text to kanji text.
+These properties are essential to work, so we should never strip them."
+ (not (and (boundp 'egg-modefull-mode)
+ (symbol-value 'egg-modefull-mode)
+ (or (memq (get-text-property pos 'intangible)
+ '(its-part-1 its-part-2))
+ (get-text-property pos 'egg-end)
+ (get-text-property pos 'egg-lang)
+ (get-text-property pos 'egg-start)))))
+
+(defun message-strip-forbidden-properties (begin end &optional old-length)
+ "Strip forbidden properties between BEGIN and END, ignoring the third arg.
+This function is intended to be called from `after-change-functions'.
+See also `message-forbidden-properties'."
+ (when (and message-strip-special-text-properties
+ (message-tamago-not-in-use-p begin))
+ (while (not (= begin end))
+ (when (not (get-text-property begin 'message-hidden))
+ (remove-text-properties begin (1+ begin)
+ message-forbidden-properties))
+ (incf begin))))
+
;;;###autoload
-(defun message-mode ()
+(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
Like Text Mode but with these additional commands:\\<message-mode-map>
C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit'
@@ -1480,8 +2393,16 @@ C-c C-f move to a header field (and create it if there isn't):
C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To
C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups
C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
+ C-c C-f C-o move to From (\"Originator\")
C-c C-f C-f move to Followup-To
+ C-c C-f C-m move to Mail-Followup-To
+ C-c C-f C-i cycle through Importance values
+ C-c C-f s change subject and append \"(was: <Old Subject>)\"
+ C-c C-f x crossposting with FollowUp-To header and note in body
+ C-c C-f t replace To: header with contents of Cc: or Bcc:
+ C-c C-f a Insert X-No-Archive: header and a note in the body
C-c C-t `message-insert-to' (add a To header to a news followup)
+C-c C-l `message-to-list-only' (removes all but list address in to/cc)
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
C-c C-b `message-goto-body' (move to beginning of message text).
C-c C-i `message-goto-signature' (move to the beginning of the signature).
@@ -1493,36 +2414,29 @@ C-c C-v `message-delete-not-region' (remove the text outside the region).
C-c C-z `message-kill-to-signature' (kill the text up to the signature).
C-c C-r `message-caesar-buffer-body' (rot13 the message body).
C-c C-a `mml-attach-file' (attach a file as MIME).
+C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
+C-c M-n `message-insert-disposition-notification-to' (request receipt).
+C-c M-m `message-mark-inserted-region' (mark region with enclosing tags).
+C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags).
M-RET `message-newline-and-reformat' (break the line and reformat)."
- (interactive)
- (if (local-variable-p 'mml-buffer-list (current-buffer))
- (mml-destroy-buffers))
- (kill-all-local-variables)
+ (setq local-abbrev-table text-mode-abbrev-table)
(set (make-local-variable 'message-reply-buffer) nil)
- (make-local-variable 'message-send-actions)
- (make-local-variable 'message-exit-actions)
- (make-local-variable 'message-kill-actions)
- (make-local-variable 'message-postpone-actions)
- (make-local-variable 'message-draft-article)
- (make-local-hook 'kill-buffer-hook)
- (set-syntax-table message-mode-syntax-table)
- (use-local-map message-mode-map)
- (setq local-abbrev-table message-mode-abbrev-table)
- (setq major-mode 'message-mode)
- (setq mode-name "Message")
+ (set (make-local-variable 'message-inserted-headers) nil)
+ (set (make-local-variable 'message-send-actions) nil)
+ (set (make-local-variable 'message-exit-actions) nil)
+ (set (make-local-variable 'message-kill-actions) nil)
+ (set (make-local-variable 'message-postpone-actions) nil)
+ (set (make-local-variable 'message-draft-article) nil)
(setq buffer-offer-save t)
- (make-local-variable 'facemenu-add-face-function)
- (make-local-variable 'facemenu-remove-face-function)
- (setq facemenu-add-face-function
- (lambda (face end)
- (let ((face-fun (cdr (assq face message-face-alist))))
- (if face-fun
- (funcall face-fun (point) end)
- (error "Face %s not configured for %s mode" face mode-name)))
- "")
- facemenu-remove-face-function t)
- (make-local-variable 'message-reply-headers)
- (setq message-reply-headers nil)
+ (set (make-local-variable 'facemenu-add-face-function)
+ (lambda (face end)
+ (let ((face-fun (cdr (assq face message-face-alist))))
+ (if face-fun
+ (funcall face-fun (point) end)
+ (error "Face %s not configured for %s mode" face mode-name)))
+ ""))
+ (set (make-local-variable 'facemenu-remove-face-function) t)
+ (set (make-local-variable 'message-reply-headers) nil)
(make-local-variable 'message-newsreader)
(make-local-variable 'message-mailer)
(make-local-variable 'message-post-method)
@@ -1531,65 +2445,81 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(set (make-local-variable 'message-mime-part) 0)
(message-setup-fill-variables)
;; Allow using comment commands to add/remove quoting.
+ ;; (set (make-local-variable 'comment-start) message-yank-prefix)
(when message-yank-prefix
(set (make-local-variable 'comment-start) message-yank-prefix)
(set (make-local-variable 'comment-start-skip)
(concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
- ;;(when (fboundp 'mail-hist-define-keys)
- ;; (mail-hist-define-keys))
(if (featurep 'xemacs)
(message-setup-toolbar)
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
- (if (boundp 'message-tool-bar-map)
- (set (make-local-variable 'tool-bar-map) message-tool-bar-map)))
+ (if (boundp 'tool-bar-map)
+ (set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
+ (gnus-make-local-hook 'after-change-functions)
+ ;; Mmmm... Forbidden properties...
+ (add-hook 'after-change-functions 'message-strip-forbidden-properties
+ nil 'local)
;; Allow mail alias things.
(when (eq message-mail-alias-type 'abbrev)
(if (fboundp 'mail-abbrevs-setup)
(mail-abbrevs-setup)
- (mail-aliases-setup)))
+ (if (fboundp 'mail-aliases-setup) ; warning avoidance
+ (mail-aliases-setup))))
(unless buffer-file-name
(message-set-auto-save-file-name))
- (mm-enable-multibyte)
- (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
- (setq indent-tabs-mode nil)
- (mml-mode)
- (run-hooks 'text-mode-hook 'message-mode-hook))
+ (unless (buffer-base-buffer)
+ ;; Don't enable multibyte on an indirect buffer. Maybe enabling
+ ;; multibyte is not necessary at all. -- zsh
+ (mm-enable-multibyte))
+ (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
+ (mml-mode))
(defun message-setup-fill-variables ()
"Setup message fill variables."
+ (set (make-local-variable 'fill-paragraph-function)
+ 'message-fill-paragraph)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
(make-local-variable 'adaptive-fill-regexp)
(unless (boundp 'adaptive-fill-first-line-regexp)
(setq adaptive-fill-first-line-regexp nil))
(make-local-variable 'adaptive-fill-first-line-regexp)
- (make-local-variable 'auto-fill-inhibit-regexp)
(let ((quote-prefix-regexp
- (concat
- "[ \t]*" ; possible initial space
- "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix
- "\\w+>\\|" ; supercite-style prefix
- "[|:>]" ; standard prefix
- "\\)[ \t]*\\)+"))) ; possible space after each prefix
+ ;; User should change message-cite-prefix-regexp if
+ ;; message-yank-prefix is set to an abnormal value.
+ (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
(setq paragraph-start
- (concat
- (regexp-quote mail-header-separator) "$\\|"
- "[ \t]*$\\|" ; blank lines
- "-- $\\|" ; signature delimiter
- "---+$\\|" ; delimiters for forwarded messages
- page-delimiter "$\\|" ; spoiler warnings
- ".*wrote:$\\|" ; attribution lines
- quote-prefix-regexp "$")) ; empty lines in quoted text
+ (concat
+ (regexp-quote mail-header-separator) "$\\|"
+ "[ \t]*$\\|" ; blank lines
+ "-- $\\|" ; signature delimiter
+ "---+$\\|" ; delimiters for forwarded messages
+ page-delimiter "$\\|" ; spoiler warnings
+ ".*wrote:$\\|" ; attribution lines
+ quote-prefix-regexp "$\\|" ; empty lines in quoted text
+ ; mml tags
+ "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
(setq paragraph-separate paragraph-start)
(setq adaptive-fill-regexp
- (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+ (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
(setq adaptive-fill-first-line-regexp
- (concat quote-prefix-regexp "\\|"
- adaptive-fill-first-line-regexp))
- (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
+ (concat quote-prefix-regexp "\\|"
+ adaptive-fill-first-line-regexp)))
+ (make-local-variable 'auto-fill-inhibit-regexp)
+ ;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
+ (setq auto-fill-inhibit-regexp nil)
+ (make-local-variable 'normal-auto-fill-function)
+ (setq normal-auto-fill-function 'message-do-auto-fill)
+ ;; KLUDGE: auto fill might already be turned on in `text-mode-hook'.
+ ;; In that case, ensure that it uses the right function. The real
+ ;; solution would be not to use `define-derived-mode', and run
+ ;; `text-mode-hook' ourself at the end of the mode.
+ ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-19.
+ (when auto-fill-function
+ (setq auto-fill-function normal-auto-fill-function)))
@@ -1604,6 +2534,11 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(interactive)
(message-position-on-field "To"))
+(defun message-goto-from ()
+ "Move point to the From header."
+ (interactive)
+ (message-position-on-field "From"))
+
(defun message-goto-subject ()
"Move point to the Subject header."
(interactive)
@@ -1644,6 +2579,11 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(interactive)
(message-position-on-field "Followup-To" "Newsgroups"))
+(defun message-goto-mail-followup-to ()
+ "Move point to the Mail-Followup-To header."
+ (interactive)
+ (message-position-on-field "Mail-Followup-To" "From"))
+
(defun message-goto-keywords ()
"Move point to the Keywords header."
(interactive)
@@ -1654,13 +2594,15 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(interactive)
(message-position-on-field "Summary" "Subject"))
-(defun message-goto-body ()
+(defun message-goto-body (&optional interactivep)
"Move point to the beginning of the message body."
- (interactive)
- (if (looking-at "[ \t]*\n") (expand-abbrev))
+ (interactive (list t))
+ (when (and interactivep
+ (looking-at "[ \t]*\n"))
+ (expand-abbrev))
(goto-char (point-min))
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (search-forward "\n\n" nil t)))
+ (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
(defun message-goto-eoh ()
"Move point to the end of the headers."
@@ -1679,26 +2621,93 @@ return nil."
(goto-char (point-max))
nil))
+(defun message-generate-unsubscribed-mail-followup-to (&optional include-cc)
+ "Insert a reasonable MFT header in a post to an unsubscribed list.
+When making original posts to a mailing list you are not subscribed to,
+you have to type in a MFT header by hand. The contents, usually, are
+the addresses of the list and your own address. This function inserts
+such a header automatically. It fetches the contents of the To: header
+in the current mail buffer, and appends the current `user-mail-address'.
+
+If the optional argument INCLUDE-CC is non-nil, the addresses in the
+Cc: header are also put into the MFT."
+
+ (interactive "P")
+ (let* (cc tos)
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Mail-Followup-To")
+ (setq cc (and include-cc (message-fetch-field "Cc")))
+ (setq tos (if cc
+ (concat (message-fetch-field "To") "," cc)
+ (message-fetch-field "To"))))
+ (message-goto-mail-followup-to)
+ (insert (concat tos ", " user-mail-address))))
+
(defun message-insert-to (&optional force)
"Insert a To header that points to the author of the article being replied to.
-If the original author requested not to be sent mail, the function signals
-an error.
-With the prefix argument FORCE, insert the header anyway."
+If the original author requested not to be sent mail, don't insert unless the
+prefix FORCE is given."
(interactive "P")
- (let ((co (message-fetch-reply-field "mail-copies-to")))
- (when (and (null force)
- co
- (or (equal (downcase co) "never")
- (equal (downcase co) "nobody")))
- (error "The user has requested not to have copies sent via mail")))
- (when (and (message-position-on-field "To")
- (mail-fetch-field "to")
- (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
- (insert ", "))
- (insert (or (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from") "")))
+ (let* ((mct (message-fetch-reply-field "mail-copies-to"))
+ (dont (and mct (or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))))
+ (to (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from"))))
+ (when (and dont to)
+ (message
+ (if force
+ "Ignoring the user request not to have copies sent via mail"
+ "Complying with the user request not to have copies sent via mail")))
+ (when (and force (not to))
+ (error "No mail address in the article"))
+ (when (and to (or force (not dont)))
+ (message-carefully-insert-headers (list (cons 'To to))))))
+
+(defun message-insert-wide-reply ()
+ "Insert To and Cc headers as if you were doing a wide reply."
+ (interactive)
+ (let ((headers (message-with-reply-buffer
+ (message-get-reply-headers t))))
+ (message-carefully-insert-headers headers)))
+
+(defcustom message-header-synonyms
+ '((To Cc Bcc))
+ "List of lists of header synonyms.
+E.g., if this list contains a member list with elements `Cc' and `To',
+then `message-carefully-insert-headers' will not insert a `To' header
+when the message is already `Cc'ed to the recipient."
+ :group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
+ :type '(repeat sexp))
+
+(defun message-carefully-insert-headers (headers)
+ "Insert the HEADERS, an alist, into the message buffer.
+Does not insert the headers when they are already present there
+or in the synonym headers, defined by `message-header-synonyms'."
+ ;; FIXME: Should compare only the address and not the full name. Comparison
+ ;; should be done case-folded (and with `string=' rather than
+ ;; `string-match').
+ (dolist (header headers)
+ (let* ((header-name (symbol-name (car header)))
+ (new-header (cdr header))
+ (synonyms (loop for synonym in message-header-synonyms
+ when (memq (car header) synonym) return synonym))
+ (old-header
+ (loop for synonym in synonyms
+ for old-header = (mail-fetch-field (symbol-name synonym))
+ when (and old-header (string-match new-header old-header))
+ return synonym)))
+ (if old-header
+ (message "already have `%s' in `%s'" new-header old-header)
+ (when (and (message-position-on-field header-name)
+ (setq old-header (mail-fetch-field header-name))
+ (not (string-match "\\` *\\'" old-header)))
+ (insert ", "))
+ (insert new-header)))))
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
@@ -1734,17 +2743,25 @@ With the prefix argument FORCE, insert the header anyway."
(defun message-delete-not-region (beg end)
"Delete everything in the body of the current message outside of the region."
(interactive "r")
- (save-excursion
- (goto-char end)
- (delete-region (point) (if (not (message-goto-signature))
- (point)
- (forward-line -2)
- (point)))
- (insert "\n")
- (goto-char beg)
- (delete-region beg (progn (message-goto-body)
- (forward-line 2)
- (point))))
+ (let (citeprefix)
+ (save-excursion
+ (goto-char beg)
+ ;; snarf citation prefix, if appropriate
+ (unless (eq (point) (progn (beginning-of-line) (point)))
+ (when (looking-at message-cite-prefix-regexp)
+ (setq citeprefix (match-string 0))))
+ (goto-char end)
+ (delete-region (point) (if (not (message-goto-signature))
+ (point)
+ (forward-line -2)
+ (point)))
+ (insert "\n")
+ (goto-char beg)
+ (delete-region beg (progn (message-goto-body)
+ (forward-line 2)
+ (point)))
+ (when citeprefix
+ (insert citeprefix))))
(when (message-goto-signature)
(forward-line -2)))
@@ -1754,39 +2771,121 @@ With the prefix argument FORCE, insert the header anyway."
(let ((point (point)))
(message-goto-signature)
(unless (eobp)
- (forward-line -2))
+ (end-of-line -1))
(kill-region point (point))
(unless (bolp)
(insert "\n"))))
-(defun message-newline-and-reformat ()
- "Insert four newlines, and then reformat if inside quoted text."
- (interactive)
- ;; The Latin-1 angle quote looks pretty dubious. -- fx
- (let ((prefix "[]>»|:}+ \t]*")
- (supercite-thing "[-._[:alnum:]]*[>]+[ \t]*")
- quoted point)
- (unless (bolp)
- (save-excursion
- (beginning-of-line)
- (when (looking-at (concat prefix
- supercite-thing))
- (setq quoted (match-string 0))))
- (insert "\n"))
+(defun message-newline-and-reformat (&optional arg not-break)
+ "Insert four newlines, and then reformat if inside quoted text.
+Prefix arg means justify as well."
+ (interactive (list (if current-prefix-arg 'full)))
+ (let (quoted point beg end leading-space bolp)
(setq point (point))
- (insert "\n\n\n")
- (delete-region (point) (re-search-forward "[ \t]*"))
- (when quoted
- (insert quoted))
- (fill-paragraph nil)
+ (beginning-of-line)
+ (setq beg (point))
+ (setq bolp (= beg point))
+ ;; Find first line of the paragraph.
+ (if not-break
+ (while (and (not (eobp))
+ (not (looking-at message-cite-prefix-regexp))
+ (looking-at paragraph-start))
+ (forward-line 1)))
+ ;; Find the prefix
+ (when (looking-at message-cite-prefix-regexp)
+ (setq quoted (match-string 0))
+ (goto-char (match-end 0))
+ (looking-at "[ \t]*")
+ (setq leading-space (match-string 0)))
+ (if (and quoted
+ (not not-break)
+ (not bolp)
+ (< (- point beg) (length quoted)))
+ ;; break inside the cite prefix.
+ (setq quoted nil
+ end nil))
+ (if quoted
+ (progn
+ (forward-line 1)
+ (while (and (not (eobp))
+ (not (looking-at paragraph-separate))
+ (looking-at message-cite-prefix-regexp)
+ (equal quoted (match-string 0)))
+ (goto-char (match-end 0))
+ (looking-at "[ \t]*")
+ (if (> (length leading-space) (length (match-string 0)))
+ (setq leading-space (match-string 0)))
+ (forward-line 1))
+ (setq end (point))
+ (goto-char beg)
+ (while (and (if (bobp) nil (forward-line -1) t)
+ (not (looking-at paragraph-start))
+ (looking-at message-cite-prefix-regexp)
+ (equal quoted (match-string 0)))
+ (setq beg (point))
+ (goto-char (match-end 0))
+ (looking-at "[ \t]*")
+ (if (> (length leading-space) (length (match-string 0)))
+ (setq leading-space (match-string 0)))))
+ (while (and (not (eobp))
+ (not (looking-at paragraph-separate))
+ (not (looking-at message-cite-prefix-regexp)))
+ (forward-line 1))
+ (setq end (point))
+ (goto-char beg)
+ (while (and (if (bobp) nil (forward-line -1) t)
+ (not (looking-at paragraph-start))
+ (not (looking-at message-cite-prefix-regexp)))
+ (setq beg (point))))
(goto-char point)
- (forward-line 1)))
+ (save-restriction
+ (narrow-to-region beg end)
+ (if not-break
+ (setq point nil)
+ (if bolp
+ (newline)
+ (newline)
+ (newline))
+ (setq point (point))
+ ;; (newline 2) doesn't mark both newline's as hard, so call
+ ;; newline twice. -jas
+ (newline)
+ (newline)
+ (delete-region (point) (re-search-forward "[ \t]*"))
+ (when (and quoted (not bolp))
+ (insert quoted leading-space)))
+ (undo-boundary)
+ (if quoted
+ (let* ((adaptive-fill-regexp
+ (regexp-quote (concat quoted leading-space)))
+ (adaptive-fill-first-line-regexp
+ adaptive-fill-regexp ))
+ (fill-paragraph arg))
+ (fill-paragraph arg))
+ (if point (goto-char point)))))
+
+(defun message-fill-paragraph (&optional arg)
+ "Like `fill-paragraph'."
+ (interactive (list (if current-prefix-arg 'full)))
+ (if (if (boundp 'filladapt-mode) filladapt-mode)
+ nil
+ (message-newline-and-reformat arg t)
+ t))
-(defun message-split-line ()
- "Split current line, moving portion beyond point vertically down.
-If the current line has `message-yank-prefix', insert it on the new line."
- (interactive "*")
- (split-line message-yank-prefix))
+;; Is it better to use `mail-header-end'?
+(defun message-point-in-header-p ()
+ "Return t if point is in the header."
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (point-min))
+ (not (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n")
+ p t)))))
+
+(defun message-do-auto-fill ()
+ "Like `do-auto-fill', but don't fill in message header."
+ (unless (message-point-in-header-p)
+ (do-auto-fill)))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for variable `message-signature'."
@@ -1801,7 +2900,7 @@ If the current line has `message-yank-prefix', insert it on the new line."
((and (null message-signature)
force)
t)
- ((message-functionp message-signature)
+ ((functionp message-signature)
(funcall message-signature))
((listp message-signature)
(eval message-signature))
@@ -1818,13 +2917,71 @@ If the current line has `message-yank-prefix', insert it on the new line."
;; Insert the signature.
(unless (bolp)
(insert "\n"))
- (insert "\n-- \n")
+ (when message-signature-insert-empty-line
+ (insert "\n"))
+ (insert "-- \n")
(if (eq signature t)
(insert-file-contents message-signature-file)
(insert signature))
(goto-char (point-max))
(or (bolp) (insert "\n")))))
+(defun message-insert-importance-high ()
+ "Insert header to mark message as important."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Importance"))
+ (message-goto-eoh)
+ (insert "Importance: high\n")))
+
+(defun message-insert-importance-low ()
+ "Insert header to mark message as unimportant."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Importance"))
+ (message-goto-eoh)
+ (insert "Importance: low\n")))
+
+(defun message-insert-or-toggle-importance ()
+ "Insert a \"Importance: high\" header, or cycle through the header values.
+The three allowed values according to RFC 1327 are `high', `normal'
+and `low'."
+ (interactive)
+ (save-excursion
+ (let ((valid '("high" "normal" "low"))
+ (new "high")
+ cur)
+ (save-restriction
+ (message-narrow-to-headers)
+ (when (setq cur (message-fetch-field "Importance"))
+ (message-remove-header "Importance")
+ (setq new (cond ((string= cur "high")
+ "low")
+ ((string= cur "low")
+ "normal")
+ (t
+ "high")))))
+ (message-goto-eoh)
+ (insert (format "Importance: %s\n" new)))))
+
+(defun message-insert-disposition-notification-to ()
+ "Request a disposition notification (return receipt) to this message.
+Note that this should not be used in newsgroups."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header "Disposition-Notification-To"))
+ (message-goto-eoh)
+ (insert (format "Disposition-Notification-To: %s\n"
+ (or (message-field-value "Reply-to")
+ (message-field-value "From")
+ (message-make-from))))))
+
(defun message-elide-region (b e)
"Elide the text in the region.
An ellipsis (from `message-elide-ellipsis') will be inserted where the
@@ -1845,7 +3002,7 @@ text was killed."
(prefix-numeric-value current-prefix-arg))))
(setq n (if (numberp n) (mod n 26) 13)) ;canonize N
- (unless (or (zerop n) ; no action needed for a rot of 0
+ (unless (or (zerop n) ; no action needed for a rot of 0
(= b e)) ; no region to rotate
;; We build the table, if necessary.
(when (or (not message-caesar-translation-table)
@@ -1888,7 +3045,7 @@ Mail and USENET news headers are not rotated."
(save-excursion
(save-restriction
(when (message-goto-body)
- (narrow-to-region (point) (point-max)))
+ (narrow-to-region (point) (point-max)))
(shell-command-on-region
(point-min) (point-max) program nil t))))
@@ -1968,7 +3125,9 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
(save-excursion
(goto-char start)
(while (< (point) (mark t))
- (insert message-yank-prefix)
+ (if (or (looking-at ">") (looking-at "^$"))
+ (insert message-yank-cited-prefix)
+ (insert message-yank-prefix))
(forward-line 1))))
(goto-char start)))
@@ -1999,7 +3158,7 @@ prefix, and don't delete any headers."
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
(interactive "bYank buffer: ")
- (let ((message-reply-buffer buffer))
+ (let ((message-reply-buffer (get-buffer buffer)))
(save-window-excursion
(message-yank-original))))
@@ -2016,13 +3175,27 @@ prefix, and don't delete any headers."
(defun message-cite-original-without-signature ()
"Cite function in the standard Message manner."
- (let ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function)))))
+ (let* ((start (point))
+ (end (mark t))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function))))
+ ;; This function may be called by `gnus-summary-yank-message' and
+ ;; may insert a different article from the original. So, we will
+ ;; modify the value of `message-reply-headers' with that article.
+ (message-reply-headers
+ (save-restriction
+ (narrow-to-region start end)
+ (message-narrow-to-head-1)
+ (vector 0
+ (or (message-fetch-field "subject") "none")
+ (message-fetch-field "from")
+ (message-fetch-field "date")
+ (message-fetch-field "message-id" t)
+ (message-fetch-field "references")
+ 0 0 ""))))
(mml-quote-region start end)
;; Allow undoing.
(undo-boundary)
@@ -2045,19 +3218,33 @@ prefix, and don't delete any headers."
(insert "\n"))
(funcall message-citation-line-function))))
-(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
+(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
(defun message-cite-original ()
"Cite function in the standard Message manner."
(if (and (boundp 'mail-citation-hook)
mail-citation-hook)
(run-hooks 'mail-citation-hook)
- (let ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function)))))
+ (let* ((start (point))
+ (end (mark t))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function))))
+ ;; This function may be called by `gnus-summary-yank-message' and
+ ;; may insert a different article from the original. So, we will
+ ;; modify the value of `message-reply-headers' with that article.
+ (message-reply-headers
+ (save-restriction
+ (narrow-to-region start end)
+ (message-narrow-to-head-1)
+ (vector 0
+ (or (message-fetch-field "subject") "none")
+ (message-fetch-field "from")
+ (message-fetch-field "date")
+ (message-fetch-field "message-id" t)
+ (message-fetch-field "references")
+ 0 0 ""))))
(mml-quote-region start end)
(goto-char start)
(while functions
@@ -2144,7 +3331,8 @@ The text will also be indented the normal way."
t)))
(defun message-dont-send ()
- "Don't send the message you have been editing."
+ "Don't send the message you have been editing.
+Instead, just auto-save the buffer and then bury it."
(interactive)
(set-buffer-modified-p t)
(save-buffer)
@@ -2157,9 +3345,23 @@ The text will also be indented the normal way."
(interactive)
(when (or (not (buffer-modified-p))
(yes-or-no-p "Message modified; kill anyway? "))
- (let ((actions message-kill-actions))
+ (let ((actions message-kill-actions)
+ (draft-article message-draft-article)
+ (auto-save-file-name buffer-auto-save-file-name)
+ (file-name buffer-file-name)
+ (modified (buffer-modified-p)))
(setq buffer-file-name nil)
(kill-buffer (current-buffer))
+ (when (and (or (and auto-save-file-name
+ (file-exists-p auto-save-file-name))
+ (and file-name
+ (file-exists-p file-name)))
+ (yes-or-no-p (format "Remove the backup file%s? "
+ (if modified " too" ""))))
+ (ignore-errors
+ (delete-file auto-save-file-name))
+ (let ((message-draft-article draft-article))
+ (message-disassociate-draft)))
(message-do-actions actions))))
(defun message-bury (buffer)
@@ -2190,21 +3392,40 @@ It should typically alter the sending method in some way or other."
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
- elem sent)
+ elem sent dont-barf-on-no-method
+ (message-options message-options))
+ (message-options-set-recipient)
(while (and success
(setq elem (pop alist)))
(when (funcall (cadr elem))
(when (and (or (not (memq (car elem)
message-sent-message-via))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem))))
+ (message-fetch-field "supersedes")
+ (if (or (message-gnksa-enable-p 'multiple-copies)
+ (not (eq (car elem) 'news)))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem)))
+ (error "Denied posting -- multiple copies")))
(setq success (funcall (caddr elem) arg)))
(setq sent t))))
- (unless (or sent (not success))
+ (unless (or sent
+ (not success)
+ (let ((fcc (message-fetch-field "Fcc"))
+ (gcc (message-fetch-field "Gcc")))
+ (when (or fcc gcc)
+ (or (eq message-allow-no-recipients 'always)
+ (and (not (eq message-allow-no-recipients 'never))
+ (setq dont-barf-on-no-method
+ (gnus-y-or-n-p
+ (format "No receiver, perform %s anyway? "
+ (cond ((and fcc gcc) "Fcc and Gcc")
+ (fcc "Fcc")
+ (t "Gcc"))))))))))
(error "No methods specified to send by"))
- (when (and success sent)
+ (when (or dont-barf-on-no-method
+ (and success sent))
(message-do-fcc)
(save-excursion
(run-hooks 'message-sent-hook))
@@ -2236,26 +3457,106 @@ It should typically alter the sending method in some way or other."
(put 'message-check 'lisp-indent-function 1)
(put 'message-check 'edebug-form-spec '(form body))
+(defun message-text-with-property (prop)
+ "Return a list of all points where the text has PROP."
+ (let ((points nil)
+ (point (point-min)))
+ (save-excursion
+ (while (< point (point-max))
+ (when (get-text-property point prop)
+ (push point points))
+ (incf point)))
+ (nreverse points)))
+
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
;; Make sure there's a newline at the end of the message.
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
- ;; Delete all invisible text.
+ ;; Make the hidden headers visible.
+ (let ((points (message-text-with-property 'message-hidden)))
+ (when points
+ (goto-char (car points))
+ (dolist (point points)
+ (add-text-properties point (1+ point)
+ '(invisible nil intangible nil)))))
+ ;; Make invisible text visible.
+ ;; It doesn't seem as if this is useful, since the invisible property
+ ;; is clobbered by an after-change hook anyhow.
(message-check 'invisible-text
- (when (text-property-any (point-min) (point-max) 'invisible t)
- (put-text-property (point-min) (point-max) 'invisible nil)
- (unless (yes-or-no-p
- "Invisible text found and made visible; continue posting? ")
- (error "Invisible text found and made visible")))))
+ (let ((points (message-text-with-property 'invisible)))
+ (when points
+ (goto-char (car points))
+ (dolist (point points)
+ (put-text-property point (1+ point) 'invisible nil)
+ (message-overlay-put (message-make-overlay point (1+ point))
+ 'face 'highlight))
+ (unless (yes-or-no-p
+ "Invisible text found and made visible; continue sending? ")
+ (error "Invisible text found and made visible")))))
+ (message-check 'illegible-text
+ (let (found choice)
+ (message-goto-body)
+ (skip-chars-forward mm-7bit-chars)
+ (while (not (eobp))
+ (when (let ((char (char-after)))
+ (or (< (mm-char-int char) 128)
+ (and (mm-multibyte-p)
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic
+ control-1))
+ (not (get-text-property
+ (point) 'untranslated-utf-8)))))
+ (message-overlay-put (message-make-overlay (point) (1+ (point)))
+ 'face 'highlight)
+ (setq found t))
+ (forward-char)
+ (skip-chars-forward mm-7bit-chars))
+ (when found
+ (setq choice
+ (gnus-multiple-choice
+ "Non-printable characters found. Continue sending?"
+ '((?d "Remove non-printable characters and send")
+ (?r "Replace non-printable characters with dots and send")
+ (?i "Ignore non-printable characters and send")
+ (?e "Continue editing"))))
+ (if (eq choice ?e)
+ (error "Non-printable characters"))
+ (message-goto-body)
+ (skip-chars-forward mm-7bit-chars)
+ (while (not (eobp))
+ (when (let ((char (char-after)))
+ (or (< (mm-char-int char) 128)
+ (and (mm-multibyte-p)
+ ;; Fixme: Wrong for Emacs 22 and for things
+ ;; like undecable utf-8. Should at least
+ ;; use find-coding-systems-region.
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic
+ control-1))
+ (not (get-text-property
+ (point) 'untranslated-utf-8)))))
+ (if (eq choice ?i)
+ (message-kill-all-overlays)
+ (delete-char 1)
+ (when (eq choice ?r)
+ (insert "."))))
+ (forward-char)
+ (skip-chars-forward mm-7bit-chars))))))
(defun message-add-action (action &rest types)
"Add ACTION to be performed when doing an exit of type TYPES."
+ (while types
+ (add-to-list (intern (format "message-%s-actions" (pop types)))
+ action)))
+
+(defun message-delete-action (action &rest types)
+ "Delete ACTION from lists of actions performed when doing an exit of type TYPES."
(let (var)
(while types
(set (setq var (intern (format "message-%s-actions" (pop types))))
- (nconc (symbol-value var) (list action))))))
+ (delq action (symbol-value var))))))
(defun message-do-actions (actions)
"Perform all actions in ACTIONS."
@@ -2264,7 +3565,7 @@ It should typically alter the sending method in some way or other."
(ignore-errors
(cond
;; A simple function.
- ((message-functionp (car actions))
+ ((functionp (car actions))
(funcall (car actions)))
;; Something to be evaled.
(t
@@ -2272,7 +3573,7 @@ It should typically alter the sending method in some way or other."
(pop actions)))
(defun message-send-mail-partially ()
- "Sendmail as message/partial."
+ "Send mail as message/partial."
;; replace the header delimiter with a blank line
(goto-char (point-min))
(re-search-forward
@@ -2320,24 +3621,23 @@ It should typically alter the sending method in some way or other."
(message-remove-header "Lines")
(goto-char (point-max))
(insert "Mime-Version: 1.0\n")
- (setq header (buffer-substring (point-min) (point-max))))
+ (setq header (buffer-string)))
(goto-char (point-max))
- (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n"
+ (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
id n total))
+ (forward-char -1)
(let ((mail-header-separator ""))
(when (memq 'Message-ID message-required-mail-headers)
(insert "Message-ID: " (message-make-message-id) "\n"))
(when (memq 'Lines message-required-mail-headers)
- (let ((mail-header-separator ""))
- (insert "Lines: " (message-make-lines) "\n")))
+ (insert "Lines: " (message-make-lines) "\n"))
(message-goto-subject)
(end-of-line)
(insert (format " (%d/%d)" n total))
- (goto-char (point-max))
- (insert "\n")
(widen)
(mm-with-unibyte-current-buffer
- (funcall message-send-mail-function)))
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function))))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
@@ -2353,22 +3653,34 @@ It should typically alter the sending method in some way or other."
(message-posting-charset
(if (fboundp 'gnus-setup-posting-charset)
(gnus-setup-posting-charset nil)
- message-posting-charset)))
+ message-posting-charset))
+ (headers message-required-mail-headers))
(save-restriction
(message-narrow-to-headers)
+ ;; Generate the Mail-Followup-To header if the header is not there...
+ (if (and (message-subscribed-p)
+ (not (mail-fetch-field "mail-followup-to")))
+ (setq headers
+ (cons
+ (cons "Mail-Followup-To" (message-make-mail-followup-to))
+ message-required-mail-headers))
+ ;; otherwise, delete the MFT header if the field is empty
+ (when (equal "" (mail-fetch-field "mail-followup-to"))
+ (message-remove-header "^Mail-Followup-To:")))
;; Insert some headers.
(let ((message-deletable-headers
(if news nil message-deletable-headers)))
- (message-generate-headers message-required-mail-headers))
+ (message-generate-headers headers))
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
(save-excursion
(set-buffer tembuf)
(erase-buffer)
- ;; Avoid copying text props.
+ ;; Avoid copying text props (except hard newlines).
(insert (with-current-buffer mailbuf
- (buffer-substring-no-properties (point-min) (point-max))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ (point-min) (point-max))))
;; Remove some headers.
(message-encode-message-body)
(save-restriction
@@ -2384,25 +3696,59 @@ It should typically alter the sending method in some way or other."
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
+ (message-cleanup-headers)
+ ;; FIXME: we're inserting the courtesy copy after encoding.
+ ;; This is wrong if the courtesy copy string contains
+ ;; non-ASCII characters. -- jh
(when
(save-restriction
(message-narrow-to-headers)
(and news
(or (message-fetch-field "cc")
+ (message-fetch-field "bcc")
(message-fetch-field "to"))
- (let ((content-type (message-fetch-field "content-type")))
- (or
- (not content-type)
- (string= "text/plain"
- (car
- (mail-header-parse-content-type
- content-type)))))))
+ (let ((content-type (message-fetch-field
+ "content-type")))
+ (and
+ (or
+ (not content-type)
+ (string= "text/plain"
+ (car
+ (mail-header-parse-content-type
+ content-type))))
+ (not
+ (string= "base64"
+ (message-fetch-field
+ "content-transfer-encoding")))))))
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
- (not (y-or-n-p "The message size is too large, should it be sent partially? ")))
+ (not (message-y-or-n-p
+ "The message size is too large, split? "
+ t
+ "\
+The message size, "
+ (/ (point-max) 1000) "KB, is too large.
+
+Some mail gateways (MTA's) bounce large messages. To avoid the
+problem, answer `y', and the message will be split into several
+smaller pieces, the size of each is about "
+ (/ message-send-mail-partially-limit 1000)
+ "KB except the last
+one.
+
+However, some mail readers (MUA's) can't read split messages, i.e.,
+mails in message/partially format. Answer `n', and the message will be
+sent in one piece.
+
+The size limit is controlled by `message-send-mail-partially-limit'.
+If you always want Gnus to send messages in one piece, set
+`message-send-mail-partially-limit' to nil.
+")))
(mm-with-unibyte-current-buffer
- (funcall message-send-mail-function))
+ (message "Sending via mail...")
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function)))
(message-send-mail-partially)))
(kill-buffer tembuf))
(set-buffer mailbuf)
@@ -2415,61 +3761,67 @@ It should typically alter the sending method in some way or other."
" sendmail errors")
0))
resend-to-addresses delimline)
- (let ((case-fold-search t))
- (save-restriction
- (message-narrow-to-headers)
- (setq resend-to-addresses (message-fetch-field "resent-to")))
- ;; Change header-delimiter to be what sendmail expects.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1)
- (setq delimline (point-marker))
- (run-hooks 'message-send-mail-hook)
- ;; Insert an extra newline if we need it to work around
- ;; Sun's bug that swallows newlines.
- (goto-char (1+ delimline))
- (when (eval message-mailer-swallows-blank-line)
- (newline))
- (when message-interactive
- (save-excursion
- (set-buffer errbuf)
- (erase-buffer))))
- (let ((default-directory "/")
- (coding-system-for-write message-send-coding-system))
- (apply 'call-process-region
- (append (list (point-min) (point-max)
- (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail")
- nil errbuf nil "-oi")
- ;; Always specify who from,
- ;; since some systems have broken sendmails.
- ;; But some systems are more broken with -f, so
- ;; we'll let users override this.
- (if (null message-sendmail-f-is-evil)
- (list "-f" (message-make-address)))
- ;; These mean "report errors by mail"
- ;; and "deliver in background".
- (if (null message-interactive) '("-oem" "-odb"))
- ;; Get the addresses from the message
- ;; unless this is a resend.
- ;; We must not do that for a resend
- ;; because we would find the original addresses.
- ;; For a resend, include the specific addresses.
- (if resend-to-addresses
- (list resend-to-addresses)
- '("-t")))))
- (when message-interactive
- (save-excursion
- (set-buffer errbuf)
- (goto-char (point-min))
- (while (re-search-forward "\n\n* *" nil t)
- (replace-match "; "))
- (if (not (zerop (buffer-size)))
- (error "Sending...failed to %s"
- (buffer-substring (point-min) (point-max)))))
+ (unwind-protect
+ (progn
+ (let ((case-fold-search t))
+ (save-restriction
+ (message-narrow-to-headers)
+ (setq resend-to-addresses (message-fetch-field "resent-to")))
+ ;; Change header-delimiter to be what sendmail expects.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1)
+ (setq delimline (point-marker))
+ (run-hooks 'message-send-mail-hook)
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (when (eval message-mailer-swallows-blank-line)
+ (newline))
+ (when message-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (erase-buffer))))
+ (let* ((default-directory "/")
+ (coding-system-for-write message-send-coding-system)
+ (cpr (apply
+ 'call-process-region
+ (append
+ (list (point-min) (point-max)
+ (if (boundp 'sendmail-program)
+ sendmail-program
+ "/usr/lib/sendmail")
+ nil errbuf nil "-oi")
+ ;; Always specify who from,
+ ;; since some systems have broken sendmails.
+ ;; But some systems are more broken with -f, so
+ ;; we'll let users override this.
+ (if (null message-sendmail-f-is-evil)
+ (list "-f" (message-sendmail-envelope-from)))
+ ;; These mean "report errors by mail"
+ ;; and "deliver in background".
+ (if (null message-interactive) '("-oem" "-odb"))
+ ;; Get the addresses from the message
+ ;; unless this is a resend.
+ ;; We must not do that for a resend
+ ;; because we would find the original addresses.
+ ;; For a resend, include the specific addresses.
+ (if resend-to-addresses
+ (list resend-to-addresses)
+ '("-t"))))))
+ (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
+ (error "Sending...failed with exit value %d" cpr)))
+ (when message-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (goto-char (point-min))
+ (while (re-search-forward "\n\n* *" nil t)
+ (replace-match "; "))
+ (if (not (zerop (buffer-size)))
+ (error "Sending...failed to %s"
+ (buffer-string))))))
(when (bufferp errbuf)
(kill-buffer errbuf)))))
@@ -2506,11 +3858,13 @@ to find out how to use this."
;; free for -inject-arguments -- a big win for the user and for us
;; since we don't have to play that double-guessing game and the user
;; gets full control (no gestapo'ish -f's, for instance). --sj
- message-qmail-inject-args))
+ (if (functionp message-qmail-inject-args)
+ (funcall message-qmail-inject-args)
+ message-qmail-inject-args)))
;; qmail-inject doesn't say anything on it's stdout/stderr,
;; we have to look at the retval instead
(0 nil)
- (1 (error "qmail-inject reported permanent failure"))
+ (100 (error "qmail-inject reported permanent failure"))
(111 (error "qmail-inject reported transient failure"))
;; should never happen
(t (error "qmail-inject reported unknown failure"))))
@@ -2533,29 +3887,75 @@ to find out how to use this."
;; Pass it on to mh.
(mh-send-letter)))
+(defun message-smtpmail-send-it ()
+ "Send the prepared message buffer with `smtpmail-send-it'.
+This only differs from `smtpmail-send-it' that this command evaluates
+`message-send-mail-hook' just before sending a message. It is useful
+if your ISP requires the POP-before-SMTP authentication. See the Gnus
+manual for details."
+ (run-hooks 'message-send-mail-hook)
+ (smtpmail-send-it))
+
+(defun message-canlock-generate ()
+ "Return a string that is non-trivial to guess.
+Do not use this for anything important, it is cryptographically weak."
+ (require 'sha1)
+ (let (sha1-maximum-internal-length)
+ (sha1 (concat (message-unique-id)
+ (format "%x%x%x" (random) (random t) (random))
+ (prin1-to-string (recent-keys))
+ (prin1-to-string (garbage-collect))))))
+
+(defun message-canlock-password ()
+ "The password used by message for cancel locks.
+This is the value of `canlock-password', if that option is non-nil.
+Otherwise, generate and save a value for `canlock-password' first."
+ (unless canlock-password
+ (customize-save-variable 'canlock-password (message-canlock-generate))
+ (setq canlock-password-for-verify canlock-password))
+ canlock-password)
+
+(defun message-insert-canlock ()
+ (when message-insert-canlock
+ (message-canlock-password)
+ (canlock-insert-header)))
+
(defun message-send-news (&optional arg)
(let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
(case-fold-search nil)
- (method (if (message-functionp message-post-method)
+ (method (if (functionp message-post-method)
(funcall message-post-method arg)
message-post-method))
- (group-name-charset (gnus-group-name-charset method ""))
+ (newsgroups-field (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Newsgroups")))
+ (followup-field (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Followup-To")))
+ ;; BUG: We really need to get the charset for each name in the
+ ;; Newsgroups and Followup-To lines to allow crossposting
+ ;; between group namess with incompatible character sets.
+ ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
+ (group-field-charset
+ (gnus-group-name-charset method newsgroups-field))
+ (followup-field-charset
+ (gnus-group-name-charset method (or followup-field "")))
(rfc2047-header-encoding-alist
- (if group-name-charset
- (cons (cons "Newsgroups" group-name-charset)
- rfc2047-header-encoding-alist)
- rfc2047-header-encoding-alist))
+ (append (when group-field-charset
+ (list (cons "Newsgroups" group-field-charset)))
+ (when followup-field-charset
+ (list (cons "Followup-To" followup-field-charset)))
+ rfc2047-header-encoding-alist))
(messbuf (current-buffer))
(message-syntax-checks
- (if arg
+ (if (and arg
+ (listp message-syntax-checks))
(cons '(existing-newsgroups . disabled)
message-syntax-checks)
message-syntax-checks))
(message-this-is-news t)
- (message-posting-charset (gnus-setup-posting-charset
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups"))))
+ (message-posting-charset
+ (gnus-setup-posting-charset newsgroups-field))
result)
(if (not (message-check-news-body-syntax))
nil
@@ -2563,24 +3963,30 @@ to find out how to use this."
(message-narrow-to-headers)
;; Insert some headers.
(message-generate-headers message-required-news-headers)
+ (message-insert-canlock)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- (if group-name-charset
- (setq message-syntax-checks
+ ;; Note: This check will be disabled by the ".*" default value for
+ ;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07.
+ (when (and group-field-charset
+ (listp message-syntax-checks))
+ (setq message-syntax-checks
(cons '(valid-newsgroups . disabled)
message-syntax-checks)))
(message-cleanup-headers)
- (if (not (message-check-news-syntax))
+ (if (not (let ((message-post-method method))
+ (message-check-news-syntax)))
nil
(unwind-protect
(save-excursion
(set-buffer tembuf)
(buffer-disable-undo)
(erase-buffer)
- ;; Avoid copying text props.
- (insert (with-current-buffer messbuf
- (buffer-substring-no-properties
- (point-min) (point-max))))
+ ;; Avoid copying text props (except hard newlines).
+ (insert
+ (with-current-buffer messbuf
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ (point-min) (point-max))))
(message-encode-message-body)
;; Remove some headers.
(save-restriction
@@ -2605,6 +4011,7 @@ to find out how to use this."
(backward-char 1))
(run-hooks 'message-send-news-hook)
(gnus-open-server method)
+ (message "Sending news via %s..." (gnus-server-string method))
(setq result (let ((mail-header-separator ""))
(gnus-request-post method))))
(kill-buffer tembuf))
@@ -2665,6 +4072,24 @@ to find out how to use this."
(y-or-n-p
"The control code \"cmsg\" is in the subject. Really post? ")
t))
+ ;; Check long header lines.
+ (message-check 'long-header-lines
+ (let ((start (point))
+ (header nil)
+ (length 0)
+ found)
+ (while (and (not found)
+ (re-search-forward "^\\([^ \t:]+\\): " nil t))
+ (if (> (- (point) (match-beginning 0)) 998)
+ (setq found t
+ length (- (point) (match-beginning 0)))
+ (setq header (match-string-no-properties 1)))
+ (setq start (match-beginning 0))
+ (forward-line 1))
+ (if found
+ (y-or-n-p (format "Your %s header is too long (%d). Really post? "
+ header length))
+ t)))
;; Check for multiple identical headers.
(message-check 'multiple-headers
(let (found)
@@ -2703,8 +4128,8 @@ to find out how to use this."
(zerop
(length
(setq to (completing-read
- "Followups to: (default all groups) "
- (mapcar (lambda (g) (list g))
+ "Followups to (default: no Followup-To header) "
+ (mapcar #'list
(cons "poster"
(message-tokenize-header
newsgroups)))))))))
@@ -2714,7 +4139,7 @@ to find out how to use this."
;; Check "Shoot me".
(message-check 'shoot
(if (re-search-forward
- "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t)
+ "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
(y-or-n-p "You appear to have a misconfigured system. Really post? ")
t))
;; Check for Approved.
@@ -2745,27 +4170,72 @@ to find out how to use this."
(if followup-to
(concat newsgroups "," followup-to)
newsgroups)))
- (hashtb (and (boundp 'gnus-active-hashtb)
- gnus-active-hashtb))
+ (post-method (if (functionp message-post-method)
+ (funcall message-post-method)
+ message-post-method))
+ ;; KLUDGE to handle nnvirtual groups. Doing this right
+ ;; would probably involve a new nnoo function.
+ ;; -- Per Abrahamsen <abraham@dina.kvl.dk>, 2001-10-17.
+ (method (if (and (consp post-method)
+ (eq (car post-method) 'nnvirtual)
+ gnus-message-group-art)
+ (let ((group (car (nnvirtual-find-group-art
+ (car gnus-message-group-art)
+ (cdr gnus-message-group-art)))))
+ (gnus-find-method-for-group group))
+ post-method))
+ (known-groups
+ (mapcar (lambda (n)
+ (gnus-group-name-decode
+ (gnus-group-real-name n)
+ (gnus-group-name-charset method n)))
+ (gnus-groups-from-server method)))
errors)
- (if (or (not hashtb)
- (not (boundp 'gnus-read-active-file))
- (not gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- t
- (while groups
- (when (and (not (boundp (intern (car groups) hashtb)))
- (not (equal (car groups) "poster")))
- (push (car groups) errors))
- (pop groups))
- (if (not errors)
- t
- (y-or-n-p
- (format
- "Really post to %s unknown group%s: %s? "
- (if (= (length errors) 1) "this" "these")
- (if (= (length errors) 1) "" "s")
- (mapconcat 'identity errors ", ")))))))
+ (while groups
+ (when (and (not (equal (car groups) "poster"))
+ (not (member (car groups) known-groups))
+ (not (member (car groups) errors)))
+ (push (car groups) errors))
+ (pop groups))
+ (cond
+ ;; Gnus is not running.
+ ((or (not (and (boundp 'gnus-active-hashtb)
+ gnus-active-hashtb))
+ (not (boundp 'gnus-read-active-file)))
+ t)
+ ;; We don't have all the group names.
+ ((and (or (not gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ errors)
+ (y-or-n-p
+ (format
+ "Really use %s possibly unknown group%s: %s? "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", "))))
+ ;; There were no errors.
+ ((not errors)
+ t)
+ ;; There are unknown groups.
+ (t
+ (y-or-n-p
+ (format
+ "Really post to %s unknown group%s: %s? "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", ")))))))
+ ;; Check continuation headers.
+ (message-check 'continuation-headers
+ (goto-char (point-min))
+ (let ((do-posting t))
+ (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t)
+ (if (y-or-n-p "Fix continuation lines? ")
+ (progn
+ (goto-char (match-beginning 0))
+ (insert " "))
+ (unless (y-or-n-p "Send anyway? ")
+ (setq do-posting nil))))
+ do-posting))
;; Check the Newsgroups & Followup-To headers for syntax errors.
(message-check 'valid-newsgroups
(let ((case-fold-search t)
@@ -2820,7 +4290,7 @@ to find out how to use this."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
(string-match "@\\." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
@@ -2828,6 +4298,40 @@ to find out how to use this."
(message
"Denied posting -- the From looks strange: \"%s\"." from)
nil)
+ ((let ((addresses (rfc822-addresses from)))
+ (while (and addresses
+ (not (eq (string-to-char (car addresses)) ?\()))
+ (setq addresses (cdr addresses)))
+ addresses)
+ (message
+ "Denied posting -- bad From address: \"%s\"." from)
+ nil)
+ (t t))))
+ ;; Check the Reply-To header.
+ (message-check 'reply-to
+ (let* ((case-fold-search t)
+ (reply-to (message-fetch-field "reply-to"))
+ ad)
+ (cond
+ ((not reply-to)
+ t)
+ ((string-match "," reply-to)
+ (y-or-n-p
+ (format "Multiple Reply-To addresses: \"%s\". Really post? "
+ reply-to)))
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ reply-to))))) ;larsi@ifi
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-match "\\.$" ad) ;larsi@ifi.uio.
+ (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+ (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
+ (y-or-n-p
+ (format
+ "The Reply-To looks strange: \"%s\". Really post? "
+ reply-to)))
(t t))))))
(defun message-check-news-body-syntax ()
@@ -2837,10 +4341,13 @@ to find out how to use this."
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
(while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
+ (or (looking-at
+ "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)")
+ (let ((p (point)))
+ (end-of-line)
+ (< (- (point) p) 80)))
(zerop (forward-line 1))))
(or (bolp)
(eobp)
@@ -2857,7 +4364,10 @@ to find out how to use this."
(re-search-backward message-signature-separator nil t)
(beginning-of-line)
(or (re-search-backward "[^ \n\t]" b t)
- (y-or-n-p "Empty article. Really post? "))))
+ (if (message-gnksa-enable-p 'empty-article)
+ (y-or-n-p "Empty article. Really post? ")
+ (message "Denied posting -- Empty article.")
+ nil))))
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
@@ -2876,8 +4386,11 @@ to find out how to use this."
(or
(not message-checksum)
(not (eq (message-checksum) message-checksum))
- (y-or-n-p
- "It looks like no new text has been added. Really post? ")))
+ (if (message-gnksa-enable-p 'quoted-text-only)
+ (y-or-n-p
+ "It looks like no new text has been added. Really post? ")
+ (message "Denied posting -- no new text has been added.")
+ nil)))
;; Check the length of the signature.
(message-check 'signature
(goto-char (point-max))
@@ -2891,15 +4404,20 @@ to find out how to use this."
(message-check 'quoting-style
(goto-char (point-max))
(let ((no-problem t))
- (when (search-backward-regexp "^>[^\n]*\n>" nil t)
- (setq no-problem nil)
- (while (not (eobp))
- (when (and (not (eolp)) (looking-at "[^> \t]"))
- (setq no-problem t))
- (forward-line)))
+ (when (search-backward-regexp "^>[^\n]*\n" nil t)
+ (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t)))
(if no-problem
t
- (y-or-n-p "Your text should follow quoted text. Really post? "))))))
+ (if (message-gnksa-enable-p 'quoted-text-only)
+ (y-or-n-p "Your text should follow quoted text. Really post? ")
+ ;; Ensure that
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (if (search-forward-regexp "^[ \t]*[^>\n]" nil t)
+ (y-or-n-p "Your text should follow quoted text. Really post? ")
+ (message "Denied posting -- only quoted text.")
+ nil)))))))
(defun message-checksum ()
"Return a \"checksum\" for the current buffer."
@@ -2910,8 +4428,8 @@ to find out how to use this."
(concat "^" (regexp-quote mail-header-separator) "$"))
(while (not (eobp))
(when (not (looking-at "[ \t\n]"))
- (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
- (char-after))))
+ (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+ (char-after))))
(forward-char 1)))
sum))
@@ -2919,49 +4437,52 @@ to find out how to use this."
"Process Fcc headers in the current buffer."
(let ((case-fold-search t)
(buf (current-buffer))
- list file)
+ list file
+ (mml-externalize-attachments message-fcc-externalize-attachments))
(save-excursion
- (set-buffer (get-buffer-create " *message temp*"))
- (erase-buffer)
- (insert-buffer-substring buf)
(save-restriction
(message-narrow-to-headers)
- (while (setq file (message-fetch-field "fcc"))
- (push file list)
- (message-remove-header "fcc" nil t)))
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (let ((mail-parse-charset message-default-charset)
- (rfc2047-header-encoding-alist
- (cons '("Newsgroups" . default)
- rfc2047-header-encoding-alist)))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (replace-match "" t t ))
- ;; Process FCC operations.
- (while list
- (setq file (pop list))
- (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
- ;; Pipe the article to the program in question.
- (call-process-region (point-min) (point-max) shell-file-name
- nil nil nil shell-command-switch
- (match-string 1 file))
- ;; Save the article.
- (setq file (expand-file-name file))
- (unless (file-exists-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (if (and message-fcc-handler-function
- (not (eq message-fcc-handler-function 'rmail-output)))
- (funcall message-fcc-handler-function file)
- (if (and (file-readable-p file) (mail-file-babyl-p file))
- (rmail-output file 1 nil t)
- (let ((mail-use-rfc822 t))
- (rmail-output file 1 t t))))))
- (kill-buffer (current-buffer)))))
+ (setq file (message-fetch-field "fcc" t)))
+ (when file
+ (set-buffer (get-buffer-create " *message temp*"))
+ (erase-buffer)
+ (insert-buffer-substring buf)
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (while (setq file (message-fetch-field "fcc" t))
+ (push file list)
+ (message-remove-header "fcc" nil t))
+ (let ((mail-parse-charset message-default-charset)
+ (rfc2047-header-encoding-alist
+ (cons '("Newsgroups" . default)
+ rfc2047-header-encoding-alist)))
+ (mail-encode-encoded-word-buffer)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
+ ;; Process FCC operations.
+ (while list
+ (setq file (pop list))
+ (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+ ;; Pipe the article to the program in question.
+ (call-process-region (point-min) (point-max) shell-file-name
+ nil nil nil shell-command-switch
+ (match-string 1 file))
+ ;; Save the article.
+ (setq file (expand-file-name file))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (if (and message-fcc-handler-function
+ (not (eq message-fcc-handler-function 'rmail-output)))
+ (funcall message-fcc-handler-function file)
+ (if (and (file-readable-p file) (mail-file-babyl-p file))
+ (rmail-output file 1 nil t)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))
+ (kill-buffer (current-buffer))))))
(defun message-output (filename)
"Append this article to Unix/babyl mail file FILENAME."
@@ -2993,7 +4514,7 @@ to find out how to use this."
(point)))
(goto-char (point-min))
(while (re-search-forward "\n[ \t]+" nil t)
- (replace-match " " t t)) ;No line breaks (too confusing)
+ (replace-match " " t t)) ;No line breaks (too confusing)
(goto-char (point-min))
(while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
(replace-match "," t t))
@@ -3012,6 +4533,9 @@ If NOW, use that time instead."
(setq sign "-")
(setq zone (- zone)))
(concat
+ ;; The day name of the %a spec is locale-specific. Pfff.
+ (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
+ parse-time-weekdays))))
(format-time-string "%d" now)
;; The month name of the %b spec is locale-specific. Pfff.
(format " %s "
@@ -3063,13 +4587,13 @@ If NOW, use that time instead."
(aset user (match-beginning 0) ?_))
user)
(message-number-base36 (user-uid) -1))
- (message-number-base36 (+ (car tm)
+ (message-number-base36 (+ (car tm)
(lsh (% message-unique-id-char 25) 16)) 4)
(message-number-base36 (+ (nth 1 tm)
(lsh (/ message-unique-id-char 25) 16)) 4)
- ;; Append the newsreader name, because while the generated
- ;; ID is unique to this newsreader, other newsreaders might
- ;; otherwise generate the same ID via another algorithm.
+ ;; Append a given name, because while the generated ID is unique
+ ;; to this newsreader, other newsreaders might otherwise generate
+ ;; the same ID via another algorithm.
".fsf")))
(defun message-number-base36 (num len)
@@ -3085,11 +4609,11 @@ If NOW, use that time instead."
"Make an Organization header."
(let* ((organization
(when message-user-organization
- (if (message-functionp message-user-organization)
+ (if (functionp message-user-organization)
(funcall message-user-organization)
message-user-organization))))
- (save-excursion
- (message-set-work-buffer)
+ (with-temp-buffer
+ (mm-enable-multibyte)
(cond ((stringp organization)
(insert organization))
((and (eq t organization)
@@ -3107,21 +4631,40 @@ If NOW, use that time instead."
(save-excursion
(save-restriction
(widen)
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
+ (message-goto-body)
(int-to-string (count-lines (point) (point-max))))))
+(defun message-make-references ()
+ "Return the References header for this message."
+ (when message-reply-headers
+ (let ((message-id (mail-header-message-id message-reply-headers))
+ (references (mail-header-references message-reply-headers))
+ new-references)
+ (if (or references message-id)
+ (concat (or references "") (and references " ")
+ (or message-id ""))
+ nil))))
+
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
- (mail-header-message-id message-reply-headers)))
+ (let ((from (mail-header-from message-reply-headers))
+ (date (mail-header-date message-reply-headers))
+ (msg-id (mail-header-message-id message-reply-headers)))
+ (when from
+ (let ((name (mail-extract-address-components from)))
+ (concat msg-id (if msg-id " (")
+ (or (car name)
+ (nth 1 name))
+ "'s message of \""
+ (if (or (not date) (string= date ""))
+ "(unknown date)" date)
+ "\"" (if msg-id ")")))))))
(defun message-make-distribution ()
"Make a Distribution header."
(let ((orig-distribution (message-fetch-reply-field "distribution")))
- (cond ((message-functionp message-distribution-function)
+ (cond ((functionp message-distribution-function)
(funcall message-distribution-function))
(t orig-distribution))))
@@ -3154,8 +4697,8 @@ If NOW, use that time instead."
(user-full-name))))
(when (string= fullname "&")
(setq fullname (user-login-name)))
- (save-excursion
- (message-set-work-buffer)
+ (with-temp-buffer
+ (mm-enable-multibyte)
(cond
((or (null style)
(equal fullname ""))
@@ -3172,15 +4715,15 @@ If NOW, use that time instead."
(string-match "[\\()]" tmp)))))
(insert fullname)
(goto-char (point-min))
- ;; Look for a character that cannot appear unquoted
- ;; according to RFC 822.
- (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
- ;; Quote fullname, escaping specials.
- (goto-char (point-min))
- (insert "\"")
- (while (re-search-forward "[\"\\]" nil 1)
- (replace-match "\\\\\\&" t))
- (insert "\""))
+ ;; Look for a character that cannot appear unquoted
+ ;; according to RFC 822.
+ (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
+ ;; Quote fullname, escaping specials.
+ (goto-char (point-min))
+ (insert "\"")
+ (while (re-search-forward "[\"\\]" nil 1)
+ (replace-match "\\\\\\&" t))
+ (insert "\""))
(insert " <" login ">"))
(t ; 'parens or default
(insert login " (")
@@ -3216,32 +4759,58 @@ give as trustworthy answer as possible."
(defun message-user-mail-address ()
"Return the pertinent part of `user-mail-address'."
- (when user-mail-address
+ (when (and user-mail-address
+ (string-match "@.*\\." user-mail-address))
(if (string-match " " user-mail-address)
(nth 1 (mail-extract-address-components user-mail-address))
user-mail-address)))
+(defun message-sendmail-envelope-from ()
+ "Return the envelope from."
+ (cond ((eq message-sendmail-envelope-from 'header)
+ (nth 1 (mail-extract-address-components
+ (message-fetch-field "from"))))
+ ((stringp message-sendmail-envelope-from)
+ message-sendmail-envelope-from)
+ (t
+ (message-make-address))))
+
(defun message-make-fqdn ()
"Return user's fully qualified domain name."
- (let ((system-name (system-name))
- (user-mail (message-user-mail-address)))
+ (let* ((system-name (system-name))
+ (user-mail (message-user-mail-address))
+ (user-domain
+ (if (and user-mail
+ (string-match "@\\(.*\\)\\'" user-mail))
+ (match-string 1 user-mail)))
+ (case-fold-search t))
(cond
- ((string-match "[^.]\\.[^.]" system-name)
+ ((and message-user-fqdn
+ (stringp message-user-fqdn)
+ (string-match message-valid-fqdn-regexp message-user-fqdn)
+ (not (string-match message-bogus-system-names message-user-fqdn)))
+ message-user-fqdn)
+ ;; `message-user-fqdn' seems to be valid
+ ((and (string-match message-valid-fqdn-regexp system-name)
+ (not (string-match message-bogus-system-names system-name)))
;; `system-name' returned the right result.
system-name)
;; Try `mail-host-address'.
((and (boundp 'mail-host-address)
(stringp mail-host-address)
- (string-match "\\." mail-host-address))
+ (string-match message-valid-fqdn-regexp mail-host-address)
+ (not (string-match message-bogus-system-names mail-host-address)))
mail-host-address)
;; We try `user-mail-address' as a backup.
- ((and user-mail
- (string-match "\\." user-mail)
- (string-match "@\\(.*\\)\\'" user-mail))
- (match-string 1 user-mail))
+ ((and user-domain
+ (stringp user-domain)
+ (string-match message-valid-fqdn-regexp user-domain)
+ (not (string-match message-bogus-system-names user-domain)))
+ user-domain)
;; Default to this bogus thing.
(t
- (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me")))))
+ (concat system-name
+ ".i-did-not-set--mail-host-address--so-tickle-me")))))
(defun message-make-host-name ()
"Return the name of the host."
@@ -3254,9 +4823,98 @@ give as trustworthy answer as possible."
(or mail-host-address
(message-make-fqdn)))
+(defun message-to-list-only ()
+ "Send a message to the list only.
+Remove all addresses but the list address from To and Cc headers."
+ (interactive)
+ (let ((listaddr (message-make-mail-followup-to t)))
+ (when listaddr
+ (save-excursion
+ (message-remove-header "to")
+ (message-remove-header "cc")
+ (message-position-on-field "To" "X-Draft-From")
+ (insert listaddr)))))
+
+(defun message-make-mail-followup-to (&optional only-show-subscribed)
+ "Return the Mail-Followup-To header.
+If passed the optional argument ONLY-SHOW-SUBSCRIBED only return the
+subscribed address (and not the additional To and Cc header contents)."
+ (let* ((case-fold-search t)
+ (to (message-fetch-field "To"))
+ (cc (message-fetch-field "cc"))
+ (msg-recipients (concat to (and to cc ", ") cc))
+ (recipients
+ (mapcar 'mail-strip-quoted-names
+ (message-tokenize-header msg-recipients)))
+ (file-regexps
+ (if message-subscribed-address-file
+ (let (begin end item re)
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents message-subscribed-address-file)
+ (while (not (eobp))
+ (setq begin (point))
+ (forward-line 1)
+ (setq end (point))
+ (if (bolp) (setq end (1- end)))
+ (setq item (regexp-quote (buffer-substring begin end)))
+ (if re (setq re (concat re "\\|" item))
+ (setq re (concat "\\`\\(" item))))
+ (and re (list (concat re "\\)\\'"))))))))
+ (mft-regexps (apply 'append message-subscribed-regexps
+ (mapcar 'regexp-quote
+ message-subscribed-addresses)
+ file-regexps
+ (mapcar 'funcall
+ message-subscribed-address-functions))))
+ (save-match-data
+ (let ((subscribed-lists nil)
+ (list
+ (loop for recipient in recipients
+ when (loop for regexp in mft-regexps
+ when (string-match regexp recipient) return t)
+ return recipient)))
+ (when list
+ (if only-show-subscribed
+ list
+ msg-recipients))))))
+
+(defun message-idna-to-ascii-rhs-1 (header)
+ "Interactively potentially IDNA encode domain names in HEADER."
+ (let ((field (message-fetch-field header))
+ rhs ace address)
+ (when field
+ (dolist (address (mail-header-parse-addresses field))
+ (setq address (car address)
+ rhs (downcase (or (cadr (split-string address "@")) ""))
+ ace (downcase (idna-to-ascii rhs)))
+ (when (and (not (equal rhs ace))
+ (or (not (eq message-use-idna 'ask))
+ (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^" header ":") nil t)
+ (message-narrow-to-field)
+ (while (search-forward (concat "@" rhs) nil t)
+ (replace-match (concat "@" ace) t t))
+ (goto-char (point-max))
+ (widen)))))))
+
+(defun message-idna-to-ascii-rhs ()
+ "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
+See `message-idna-encode'."
+ (interactive)
+ (when message-use-idna
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (message-idna-to-ascii-rhs-1 "From")
+ (message-idna-to-ascii-rhs-1 "To")
+ (message-idna-to-ascii-rhs-1 "Cc")))))
+
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
+ (setq headers (append headers message-required-headers))
(save-restriction
(message-narrow-to-headers)
(let* ((Date (message-make-date))
@@ -3267,13 +4925,15 @@ Headers already prepared in the buffer are not modified."
(Subject nil)
(Newsgroups nil)
(In-Reply-To (message-make-in-reply-to))
+ (References (message-make-references))
(To nil)
(Distribution (message-make-distribution))
(Lines (message-make-lines))
(User-Agent message-newsreader)
(Expires (message-make-expires))
(case-fold-search t)
- header value elem)
+ (optionalp nil)
+ header value elem header-string)
;; First we remove any old generated headers.
(let ((headers message-deletable-headers))
(unless (buffer-modified-p)
@@ -3294,42 +4954,49 @@ Headers already prepared in the buffer are not modified."
(setq elem (pop headers))
(if (consp elem)
(if (eq (car elem) 'optional)
- (setq header (cdr elem))
+ (setq header (cdr elem)
+ optionalp t)
(setq header (car elem)))
(setq header elem))
+ (setq header-string (if (stringp header)
+ header
+ (symbol-name header)))
(when (or (not (re-search-forward
(concat "^"
- (regexp-quote
- (downcase
- (if (stringp header)
- header
- (symbol-name header))))
+ (regexp-quote (downcase header-string))
":")
nil t))
(progn
;; The header was found. We insert a space after the
;; colon, if there is none.
(if (/= (char-after) ? ) (insert " ") (forward-char 1))
- ;; Find out whether the header is empty...
+ ;; Find out whether the header is empty.
(looking-at "[ \t]*\n[^ \t]")))
;; So we find out what value we should insert.
(setq value
(cond
- ((and (consp elem) (eq (car elem) 'optional))
+ ((and (consp elem)
+ (eq (car elem) 'optional)
+ (not (member header-string message-inserted-headers)))
;; This is an optional header. If the cdr of this
;; is something that is nil, then we do not insert
;; this header.
(setq header (cdr elem))
- (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
- (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+ (or (and (functionp (cdr elem))
+ (funcall (cdr elem)))
+ (and (boundp (cdr elem))
+ (symbol-value (cdr elem)))))
((consp elem)
;; The element is a cons. Either the cdr is a
;; string to be inserted verbatim, or it is a
;; function, and we insert the value returned from
;; this function.
- (or (and (stringp (cdr elem)) (cdr elem))
- (and (fboundp (cdr elem)) (funcall (cdr elem)))))
- ((and (boundp header) (symbol-value header))
+ (or (and (stringp (cdr elem))
+ (cdr elem))
+ (and (functionp (cdr elem))
+ (funcall (cdr elem)))))
+ ((and (boundp header)
+ (symbol-value header))
;; The element is a symbol. We insert the value
;; of this symbol, if any.
(symbol-value header))
@@ -3346,13 +5013,24 @@ Headers already prepared in the buffer are not modified."
(progn
;; This header didn't exist, so we insert it.
(goto-char (point-max))
- (insert (if (stringp header) header (symbol-name header))
- ": " value "\n")
- (forward-line -1))
+ (let ((formatter
+ (cdr (assq header message-header-format-alist))))
+ (if formatter
+ (funcall formatter header value)
+ (insert header-string ": " value))
+ ;; We check whether the value was ended by a
+ ;; newline. If now, we insert one.
+ (unless (bolp)
+ (insert "\n"))
+ (forward-line -1)))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
(delete-region (point) (gnus-point-at-eol))
- (insert value))
+ ;; If the header is optional, and the header was
+ ;; empty, we con't insert it anyway.
+ (unless optionalp
+ (push header-string message-inserted-headers)
+ (insert value)))
;; Add the deletable property to the headers that require it.
(and (memq header message-deletable-headers)
(progn (beginning-of-line) (looking-at "[^:]+: "))
@@ -3383,7 +5061,9 @@ Headers already prepared in the buffer are not modified."
(beginning-of-line))
(when (or (message-news-p)
(string-match "@.+\\.." secure-sender))
- (insert "Sender: " secure-sender "\n")))))))
+ (insert "Sender: " secure-sender "\n"))))
+ ;; Check for IDNA
+ (message-idna-to-ascii-rhs))))
(defun message-insert-courtesy-copy ()
"Insert a courtesy message in mail copies of combined messages."
@@ -3436,6 +5116,15 @@ Headers already prepared in the buffer are not modified."
(widen)
(forward-line 1)))
+(defun message-split-line ()
+ "Split current line, moving portion beyond point vertically down.
+If the current line has `message-yank-prefix', insert it on the new line."
+ (interactive "*")
+ (condition-case nil
+ (split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg.
+ (error
+ (split-line))))
+
(defun message-fill-header (header value)
(let ((begin (point))
(fill-column 78)
@@ -3463,12 +5152,12 @@ Headers already prepared in the buffer are not modified."
(nthcdr (+ (- cut 2) surplus 1) list)))
(defun message-shorten-references (header references)
- "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+ "Trim REFERENCES to be 21 Message-ID long or less, and fold them.
If folding is disallowed, also check that the REFERENCES are less
than 988 characters long, and if they are not, trim them until they are."
- (let ((maxcount 31)
+ (let ((maxcount 21)
(count 0)
- (cut 6)
+ (cut 2)
refs)
(with-temp-buffer
(insert references)
@@ -3534,6 +5223,41 @@ than 988 characters long, and if they are not, trim them until they are."
(forward-line 2)))
(sit-for 0)))
+(defcustom message-beginning-of-line t
+ "Whether \\<message-mode-map>\\[message-beginning-of-line]\
+ goes to beginning of header values."
+ :group 'message-buffers
+ :link '(custom-manual "(message)Movement")
+ :type 'boolean)
+
+(defun message-beginning-of-line (&optional n)
+ "Move point to beginning of header value or to beginning of line.
+The prefix argument N is passed directly to `beginning-of-line'.
+
+This command is identical to `beginning-of-line' if point is
+outside the message header or if the option `message-beginning-of-line'
+is nil.
+
+If point is in the message header and on a (non-continued) header
+line, move point to the beginning of the header value. If point
+is already there, move point to beginning of line. Therefore,
+repeated calls will toggle point between beginning of field and
+beginning of line."
+ (interactive "p")
+ (let ((zrs 'zmacs-region-stays))
+ (when (and (interactive-p) (boundp zrs))
+ (set zrs t)))
+ (if (and message-beginning-of-line
+ (message-point-in-header-p))
+ (let* ((here (point))
+ (bol (progn (beginning-of-line n) (point)))
+ (eol (gnus-point-at-eol))
+ (eoh (re-search-forward ": *" eol t)))
+ (if (or (not eoh) (equal here eoh))
+ (goto-char bol)
+ (goto-char eoh)))
+ (beginning-of-line n)))
+
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(cond
@@ -3550,7 +5274,7 @@ than 988 characters long, and if they are not, trim them until they are."
"*")))
;; Check whether `message-generate-new-buffers' is a function,
;; and if so, call it.
- ((message-functionp message-generate-new-buffers)
+ ((functionp message-generate-new-buffers)
(funcall message-generate-new-buffers type to group))
((eq message-generate-new-buffers 'unsent)
(generate-new-buffer-name
@@ -3587,7 +5311,7 @@ than 988 characters long, and if they are not, trim them until they are."
;; list of buffers.
(setq message-buffer-list (delq (current-buffer) message-buffer-list))
(while (and message-max-buffers
- message-buffer-list
+ message-buffer-list
(>= (length message-buffer-list) message-max-buffers))
;; Kill the oldest buffer -- unless it has been changed.
(let ((buffer (pop message-buffer-list)))
@@ -3597,9 +5321,30 @@ than 988 characters long, and if they are not, trim them until they are."
;; Rename the buffer.
(if message-send-rename-function
(funcall message-send-rename-function)
- (when (string-match "\\`\\*\\(unsent \\)?" (buffer-name))
- (rename-buffer
- (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+ ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
+ (when (string-match
+ "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
+ (buffer-name))
+ (let ((name (match-string 2 (buffer-name)))
+ to group)
+ (if (not (or (null name)
+ (string-equal name "mail")
+ (string-equal name "posting")))
+ (setq name (concat "*sent " name "*"))
+ (message-narrow-to-headers)
+ (setq to (message-fetch-field "to"))
+ (setq group (message-fetch-field "newsgroups"))
+ (widen)
+ (setq name
+ (cond
+ (to (concat "*sent mail to "
+ (or (car (mail-extract-address-components to))
+ to) "*"))
+ ((and group (not (string= group "")))
+ (concat "*sent posting on " group "*"))
+ (t "*sent mail*"))))
+ (unless (string-equal name (buffer-name))
+ (rename-buffer name t)))))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
@@ -3639,13 +5384,32 @@ than 988 characters long, and if they are not, trim them until they are."
headers)
nil switch-function yank-action actions)))))
-(eval-when-compile (defvar mc-modes-alist))
+(defun message-headers-to-generate (headers included-headers excluded-headers)
+ "Return a list that includes all headers from HEADERS.
+If INCLUDED-HEADERS is a list, just include those headers. If if is
+t, include all headers. In any case, headers from EXCLUDED-HEADERS
+are not included."
+ (let ((result nil)
+ header-name)
+ (dolist (header headers)
+ (setq header-name (cond
+ ((and (consp header)
+ (eq (car header) 'optional))
+ ;; On the form (optional . Header)
+ (cdr header))
+ ((consp header)
+ ;; On the form (Header . function)
+ (car header))
+ (t
+ ;; Just a Header.
+ header)))
+ (when (and (not (memq header-name excluded-headers))
+ (or (eq included-headers t)
+ (memq header-name included-headers)))
+ (push header result)))
+ (nreverse result)))
+
(defun message-setup-1 (headers &optional replybuffer actions)
- (when (and (boundp 'mc-modes-alist)
- (not (assq 'message-mode mc-modes-alist)))
- (push '(message-mode (encrypt . mc-encrypt-message)
- (sign . mc-sign-message))
- mc-modes-alist))
(dolist (action actions)
(condition-case nil
(add-to-list 'message-send-actions
@@ -3679,24 +5443,30 @@ than 988 characters long, and if they are not, trim them until they are."
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-news-headers))))))
+ (message-headers-to-generate
+ (append message-required-news-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(when (message-mail-p)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
+ (save-restriction
+ (message-narrow-to-headers)
+ (if message-alternative-emails
+ (message-use-alternative-email-as-from)))
(when message-generate-headers-first
(message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-mail-headers))))))
+ (message-headers-to-generate
+ (append message-required-mail-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(save-restriction
(message-narrow-to-headers)
- (if message-alternative-emails
- (message-use-alternative-email-as-from))
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
@@ -3713,8 +5483,14 @@ than 988 characters long, and if they are not, trim them until they are."
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
- (setq buffer-file-name (expand-file-name "*message*"
- message-auto-save-directory))
+ (setq buffer-file-name (expand-file-name
+ (if (memq system-type
+ '(ms-dos ms-windows windows-nt
+ cygwin cygwin32 win32 w32
+ mswindows))
+ "message"
+ "*message*")
+ message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
(clear-visited-file-modtime)
(setq buffer-file-coding-system message-draft-coding-system)))
@@ -3775,18 +5551,30 @@ OTHER-HEADERS is an alist of header/value pairs."
"Start editing a news article to be sent."
(interactive)
(let ((message-this-is-news t))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
-(defun message-get-reply-headers (wide &optional to-address)
- (let (follow-to mct never-mct from to cc reply-to ccalist)
+(defun message-get-reply-headers (wide &optional to-address address-headers)
+ (let (follow-to mct never-mct to cc author mft recipients)
;; Find all relevant headers we need.
- (setq from (message-fetch-field "from")
- to (message-fetch-field "to")
- cc (message-fetch-field "cc")
- mct (message-fetch-field "mail-copies-to")
- reply-to (message-fetch-field "reply-to"))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ ;; Gmane renames "To". Look at "Original-To", too, if it is present in
+ ;; message-header-synonyms.
+ (setq to (or (message-fetch-field "to")
+ (and (loop for synonym in message-header-synonyms
+ when (memq 'Original-To synonym)
+ return t)
+ (message-fetch-field "original-to")))
+ cc (message-fetch-field "cc")
+ mct (message-fetch-field "mail-copies-to")
+ author (or (message-fetch-field "mail-reply-to")
+ (message-fetch-field "reply-to")
+ (message-fetch-field "from")
+ "")
+ mft (and message-use-mail-followup-to
+ (message-fetch-field "mail-followup-to"))))
;; Handle special values of Mail-Copies-To.
(when mct
@@ -3796,51 +5584,105 @@ OTHER-HEADERS is an alist of header/value pairs."
(setq mct nil))
((or (equal (downcase mct) "always")
(equal (downcase mct) "poster"))
- (setq mct (or reply-to from)))))
+ (setq mct author))))
- (if (or (not wide)
- to-address)
- (progn
- (setq follow-to (list (cons 'To (or to-address reply-to from))))
- (when (and wide mct)
- (push (cons 'Cc mct) follow-to)))
- (let (ccalist)
- (save-excursion
- (message-set-work-buffer)
- (unless never-mct
- (insert (or reply-to from "")))
- (insert (if to (concat (if (bolp) "" ", ") to "") ""))
- (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
- (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+" nil t)
- (replace-match " " t t))
- ;; Remove addresses that match `rmail-dont-reply-to-names'.
- (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
- (insert (prog1 (rmail-dont-reply-to (buffer-string))
- (erase-buffer))))
- (goto-char (point-min))
- ;; Perhaps "Mail-Copies-To: never" removed the only address?
- (when (eobp)
- (insert (or reply-to from "")))
- (setq ccalist
- (mapcar
- (lambda (addr)
- (cons (mail-strip-quoted-names addr) addr))
- (message-tokenize-header (buffer-string))))
- (let ((s ccalist))
- (while s
- (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
- (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
- (when ccalist
- (let ((ccs (cons 'Cc (mapconcat
- (lambda (addr) (cdr addr)) ccalist ", "))))
- (when (string-match "^ +" (cdr ccs))
- (setcdr ccs (substring (cdr ccs) (match-end 0))))
- (push ccs follow-to)))))
+ (save-match-data
+ ;; Build (textual) list of new recipient addresses.
+ (cond
+ ((not wide)
+ (setq recipients (concat ", " author)))
+ (address-headers
+ (dolist (header address-headers)
+ (let ((value (message-fetch-field header)))
+ (when value
+ (setq recipients (concat recipients ", " value))))))
+ ((and mft
+ (string-match "[^ \t,]" mft)
+ (or (not (eq message-use-mail-followup-to 'ask))
+ (message-y-or-n-p "Obey Mail-Followup-To? " t "\
+You should normally obey the Mail-Followup-To: header. In this
+article, it has the value of
+
+" mft "
+
+which directs your response to " (if (string-match "," mft)
+ "the specified addresses"
+ "that address only") ".
+
+Most commonly, Mail-Followup-To is used by a mailing list poster to
+express that responses should be sent to just the list, and not the
+poster as well.
+
+If a message is posted to several mailing lists, Mail-Followup-To may
+also be used to direct the following discussion to one list only,
+because discussions that are spread over several lists tend to be
+fragmented and very difficult to follow.
+
+Also, some source/announcement lists are not intended for discussion;
+responses here are directed to other addresses.")))
+ (setq recipients (concat ", " mft)))
+ (to-address
+ (setq recipients (concat ", " to-address))
+ ;; If the author explicitly asked for a copy, we don't deny it to them.
+ (if mct (setq recipients (concat recipients ", " mct))))
+ (t
+ (setq recipients (if never-mct "" (concat ", " author)))
+ (if to (setq recipients (concat recipients ", " to)))
+ (if cc (setq recipients (concat recipients ", " cc)))
+ (if mct (setq recipients (concat recipients ", " mct)))))
+ (if (>= (length recipients) 2)
+ ;; Strip the leading ", ".
+ (setq recipients (substring recipients 2)))
+ ;; Squeeze whitespace.
+ (while (string-match "[ \t][ \t]+" recipients)
+ (setq recipients (replace-match " " t t recipients)))
+ ;; Remove addresses that match `rmail-dont-reply-to-names'.
+ (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+ (setq recipients (rmail-dont-reply-to recipients)))
+ ;; Perhaps "Mail-Copies-To: never" removed the only address?
+ (if (string-equal recipients "")
+ (setq recipients author))
+ ;; Convert string to a list of (("foo@bar" . "Name <Foo@BAR>") ...).
+ (setq recipients
+ (mapcar
+ (lambda (addr)
+ (cons (downcase (mail-strip-quoted-names addr)) addr))
+ (message-tokenize-header recipients)))
+ ;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
+ (let ((s recipients))
+ (while s
+ (setq recipients (delq (assoc (car (pop s)) s) recipients))))
+
+ ;; Remove hierarchical lists that are contained within each other,
+ ;; if message-hierarchical-addresses is defined.
+ (when message-hierarchical-addresses
+ (let ((plain-addrs (mapcar 'car recipients))
+ subaddrs recip)
+ (while plain-addrs
+ (setq subaddrs (assoc (car plain-addrs)
+ message-hierarchical-addresses)
+ plain-addrs (cdr plain-addrs))
+ (when subaddrs
+ (setq subaddrs (cdr subaddrs))
+ (while subaddrs
+ (setq recip (assoc (car subaddrs) recipients)
+ subaddrs (cdr subaddrs))
+ (if recip
+ (setq recipients (delq recip recipients))))))))
+
+ ;; Build the header alist. Allow the user to be asked whether
+ ;; or not to reply to all recipients in a wide reply.
+ (setq follow-to (list (cons 'To (cdr (pop recipients)))))
+ (when (and recipients
+ (or (not message-wide-reply-confirm-recipients)
+ (y-or-n-p "Reply to all recipients? ")))
+ (setq recipients (mapconcat
+ (lambda (addr) (cdr addr)) recipients ", "))
+ (if (string-match "^ +" recipients)
+ (setq recipients (substring recipients (match-end 0))))
+ (push (cons 'Cc recipients) follow-to)))
follow-to))
-
;;;###autoload
(defun message-reply (&optional to-address wide)
"Start editing a reply to the article in the current buffer."
@@ -3857,28 +5699,31 @@ OTHER-HEADERS is an alist of header/value pairs."
;; Allow customizations to have their say.
(if (not wide)
;; This is a regular reply.
- (if (message-functionp message-reply-to-function)
- (setq follow-to (funcall message-reply-to-function)))
- ;; This is a followup.
- (if (message-functionp message-wide-reply-to-function)
+ (when (functionp message-reply-to-function)
(save-excursion
- (setq follow-to
- (funcall message-wide-reply-to-function)))))
+ (setq follow-to (funcall message-reply-to-function))))
+ ;; This is a followup.
+ (when (functionp message-wide-reply-to-function)
+ (save-excursion
+ (setq follow-to
+ (funcall message-wide-reply-to-function)))))
(setq message-id (message-fetch-field "message-id" t)
references (message-fetch-field "references")
date (message-fetch-field "date")
from (message-fetch-field "from")
subject (or (message-fetch-field "subject") "none"))
- (if gnus-list-identifiers
+ (when gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
- (setq subject (concat "Re: " (message-strip-subject-re subject)))
+ (setq subject (concat "Re: " (message-strip-subject-re subject)))
+ (when message-subject-trailing-was-query
+ (setq subject (message-strip-subject-trailing-was subject)))
- (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
- (string-match "<[^>]+>" gnus-warning))
- (setq message-id (match-string 0 gnus-warning)))
+ (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+ (string-match "<[^>]+>" gnus-warning))
+ (setq message-id (match-string 0 gnus-warning)))
- (unless follow-to
- (setq follow-to (message-get-reply-headers wide to-address))))
+ (unless follow-to
+ (setq follow-to (message-get-reply-headers wide to-address))))
(unless (message-mail-user-agent)
(message-pop-to-buffer
@@ -3891,11 +5736,7 @@ OTHER-HEADERS is an alist of header/value pairs."
(message-setup
`((Subject . ,subject)
- ,@follow-to
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id ""))))
- nil))
+ ,@follow-to)
cur)))
;;;###autoload
@@ -3911,7 +5752,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
(interactive)
(require 'gnus-sum) ; for gnus-list-identifiers
(let ((cur (current-buffer))
- from subject date reply-to mct
+ from subject date reply-to mrt mct
references message-id follow-to
(inhibit-point-motion-hooks t)
(message-this-is-news t)
@@ -3922,7 +5763,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
(if (search-forward "\n\n" nil t)
(1- (point))
(point-max)))
- (when (message-functionp message-followup-to-function)
+ (when (functionp message-followup-to-function)
(setq follow-to
(funcall message-followup-to-function)))
(setq from (message-fetch-field "from")
@@ -3934,6 +5775,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
newsgroups (message-fetch-field "newsgroups")
posted-to (message-fetch-field "posted-to")
reply-to (message-fetch-field "reply-to")
+ mrt (message-fetch-field "mail-reply-to")
distribution (message-fetch-field "distribution")
mct (message-fetch-field "mail-copies-to"))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
@@ -3947,10 +5789,15 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
(if gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
(setq subject (concat "Re: " (message-strip-subject-re subject)))
+ (when message-subject-trailing-was-query
+ (setq subject (message-strip-subject-trailing-was subject)))
(widen))
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+ (setq message-reply-headers
+ (vector 0 subject from date message-id references 0 0 ""))
+
(message-setup
`((Subject . ,subject)
,@(cond
@@ -3971,7 +5818,7 @@ A typical situation where `Followup-To: poster' is used is when the poster
does not read the newsgroup, so he wouldn't see any replies sent to it."))
(progn
(setq message-this-is-news nil)
- (cons 'To (or reply-to from "")))
+ (cons 'To (or mrt reply-to from "")))
(cons 'Newsgroups newsgroups)))
(t
(if (or (equal followup-to newsgroups)
@@ -3990,7 +5837,7 @@ used to direct the following discussion to one newsgroup only,
because discussions that are spread over several newsgroup tend to
be fragmented and very difficult to follow.
-Also, some source/announcement newsgroups are not indented for discussion;
+Also, some source/announcement newsgroups are not intended for discussion;
responses here are directed to other newsgroups."))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
@@ -3999,22 +5846,58 @@ responses here are directed to other newsgroups."))
(t
`((Newsgroups . ,newsgroups))))
,@(and distribution (list (cons 'Distribution distribution)))
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id "")))))
,@(when (and mct
(not (or (equal (downcase mct) "never")
(equal (downcase mct) "nobody"))))
(list (cons 'Cc (if (or (equal (downcase mct) "always")
(equal (downcase mct) "poster"))
- (or reply-to from "")
+ (or mrt reply-to from "")
mct)))))
- cur)
-
- (setq message-reply-headers
- (vector 0 subject from date message-id references 0 0 ""))))
+ cur)))
+(defun message-is-yours-p ()
+ "Non-nil means current article is yours.
+If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles
+are yours except those that have Cancel-Lock header not belonging to you.
+Instead of shooting GNKSA feet, you should modify 'message-alternative-emails'
+regexp to match all of yours addresses."
+ ;; Canlock-logic as suggested by Per Abrahamsen
+ ;; <abraham@dina.kvl.dk>
+ ;;
+ ;; IF article has cancel-lock THEN
+ ;; IF we can verify it THEN
+ ;; issue cancel
+ ;; ELSE
+ ;; error: cancellock: article is not yours
+ ;; ELSE
+ ;; Use old rules, comparing sender...
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head-1)
+ (if (message-fetch-field "Cancel-Lock")
+ (if (null (canlock-verify))
+ t
+ (error "Failed to verify Cancel-lock: This article is not yours"))
+ (let (sender from)
+ (or
+ (message-gnksa-enable-p 'cancel-messages)
+ (and (setq sender (message-fetch-field "sender"))
+ (string-equal (downcase sender)
+ (downcase (message-make-sender))))
+ ;; Email address in From field equals to our address
+ (and (setq from (message-fetch-field "from"))
+ (string-equal
+ (downcase (cadr (mail-extract-address-components from)))
+ (downcase (cadr (mail-extract-address-components
+ (message-make-from))))))
+ ;; Email address in From field matches
+ ;; 'message-alternative-emails' regexp
+ (and from
+ message-alternative-emails
+ (string-match
+ message-alternative-emails
+ (cadr (mail-extract-address-components from))))))))))
;;;###autoload
(defun message-cancel-news (&optional arg)
@@ -4023,34 +5906,26 @@ If ARG, allow editing of the cancellation message."
(interactive "P")
(unless (message-news-p)
(error "This is not a news article; canceling is impossible"))
- (when (yes-or-no-p "Do you really want to cancel this article? ")
- (let (from newsgroups message-id distribution buf sender)
- (save-excursion
- ;; Get header info from original article.
- (save-restriction
- (message-narrow-to-head-1)
- (setq from (message-fetch-field "from")
- sender (message-fetch-field "sender")
- newsgroups (message-fetch-field "newsgroups")
- message-id (message-fetch-field "message-id" t)
- distribution (message-fetch-field "distribution")))
- ;; Make sure that this article was written by the user.
- (unless (or (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
- (error "This article is not yours"))
+ (let (from newsgroups message-id distribution buf)
+ (save-excursion
+ ;; Get header info from original article.
+ (save-restriction
+ (message-narrow-to-head-1)
+ (setq from (message-fetch-field "from")
+ newsgroups (message-fetch-field "newsgroups")
+ message-id (message-fetch-field "message-id" t)
+ distribution (message-fetch-field "distribution")))
+ ;; Make sure that this article was written by the user.
+ (unless (message-is-yours-p)
+ (error "This article is not yours"))
+ (when (yes-or-no-p "Do you really want to cancel this article? ")
;; Make control message.
(if arg
(message-news)
(setq buf (set-buffer (get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
- "From: " from "\n"
+ "From: " from "\n"
"Subject: cmsg cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
@@ -4073,18 +5948,9 @@ If ARG, allow editing of the cancellation message."
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
(interactive)
- (let ((cur (current-buffer))
- (sender (message-fetch-field "sender"))
- (from (message-fetch-field "from")))
+ (let ((cur (current-buffer)))
;; Check whether the user owns the article that is to be superseded.
- (unless (or (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
+ (unless (message-is-yours-p)
(error "This article is not yours"))
;; Get a normal message buffer.
(message-pop-to-buffer (message-buffer-name "supersede"))
@@ -4161,26 +6027,48 @@ Previous forwarders, replyers, etc. may add it."
(defvar message-forward-decoded-p nil
"Non-nil means the original message is decoded.")
+(defun message-forward-subject-name-subject (subject)
+ "Generate a SUBJECT for a forwarded message.
+The form is: [Source] Subject, where if the original message was mail,
+Source is the name of the sender, and if the original message was
+news, Source is the list of newsgroups is was posted to."
+ (let* ((group (message-fetch-field "newsgroups"))
+ (from (message-fetch-field "from"))
+ (prefix
+ (if group
+ (gnus-group-decoded-name group)
+ (or (and from (car (gnus-extract-address-components from)))
+ "(nowhere)"))))
+ (concat "["
+ (if message-forward-decoded-p
+ prefix
+ (mail-decode-encoded-word-string prefix))
+ "] " subject)))
+
(defun message-forward-subject-author-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
Source is the sender, and if the original message was news, Source is
the list of newsgroups is was posted to."
- (concat "["
- (let ((prefix
- (or (message-fetch-field "newsgroups")
- (message-fetch-field "from")
- "(nowhere)")))
- (if message-forward-decoded-p
- prefix
- (mail-decode-encoded-word-string prefix)))
- "] " subject))
+ (let* ((group (message-fetch-field "newsgroups"))
+ (prefix
+ (if group
+ (gnus-group-decoded-name group)
+ (or (message-fetch-field "from")
+ "(nowhere)"))))
+ (concat "["
+ (if message-forward-decoded-p
+ prefix
+ (mail-decode-encoded-word-string prefix))
+ "] " subject)))
(defun message-forward-subject-fwd (subject)
"Generate a SUBJECT for a forwarded message.
The form is: Fwd: Subject, where Subject is the original subject of
the message."
- (concat "Fwd: " subject))
+ (if (string-match "^Fwd: " subject)
+ subject
+ (concat "Fwd: " subject)))
(defun message-make-forward-subject ()
"Return a Subject header suitable for the message in the current buffer."
@@ -4204,7 +6092,7 @@ the message."
;; Apply funcs in order, passing subject generated by previous
;; func to the next one.
(while funcs
- (when (message-functionp (car funcs))
+ (when (functionp (car funcs))
(setq subject (funcall (car funcs) subject)))
(setq funcs (cdr funcs)))
subject))))
@@ -4230,6 +6118,108 @@ Optional DIGEST will use digest to forward."
(message-mail nil subject))
(message-forward-make-body cur digest)))
+(defun message-forward-make-body-plain (forward-buffer)
+ (insert
+ "\n-------------------- Start of forwarded message --------------------\n")
+ (let ((b (point)) e)
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-with-unibyte-current-buffer (buffer-string))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
+ (setq e (point))
+ (insert
+ "\n-------------------- End of forwarded message --------------------\n")
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
+
+(defun message-forward-make-body-mime (forward-buffer)
+ (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
+ (let ((b (point)) e)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mml-insert-buffer forward-buffer)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (goto-char (point-max)))
+ (setq e (point))
+ (insert "<#/part>\n")))
+
+(defun message-forward-make-body-mml (forward-buffer)
+ (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+ (let ((b (point)) e)
+ (if (not message-forward-decoded-p)
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-with-unibyte-current-buffer (buffer-string))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mml-insert-buffer forward-buffer)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (goto-char (point-max))))
+ (setq e (point))
+ (insert "<#/mml>\n")
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
+
+(defun message-forward-make-body-digest-plain (forward-buffer)
+ (insert
+ "\n-------------------- Start of forwarded message --------------------\n")
+ (let ((b (point)) e)
+ (mml-insert-buffer forward-buffer)
+ (setq e (point))
+ (insert
+ "\n-------------------- End of forwarded message --------------------\n")))
+
+(defun message-forward-make-body-digest-mime (forward-buffer)
+ (insert "\n<#multipart type=digest>\n")
+ (let ((b (point)) e)
+ (insert-buffer-substring forward-buffer)
+ (setq e (point))
+ (insert "<#/multipart>\n")
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (delete-region (point-min) (point-max)))))
+
+(defun message-forward-make-body-digest (forward-buffer)
+ (if message-forward-as-mime
+ (message-forward-make-body-digest-mime forward-buffer)
+ (message-forward-make-body-digest-plain forward-buffer)))
+
;;;###autoload
(defun message-forward-make-body (forward-buffer &optional digest)
;; Put point where we want it before inserting the forwarded
@@ -4237,75 +6227,37 @@ Optional DIGEST will use digest to forward."
(if message-forward-before-signature
(message-goto-body)
(goto-char (point-max)))
- (if message-forward-as-mime
- (if digest
- (insert "\n<#multipart type=digest>\n")
- (if message-forward-show-mml
- (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
- (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
- (insert "\n-------------------- Start of forwarded message --------------------\n"))
- (let ((b (point)) e)
- (if digest
- (if message-forward-as-mime
- (insert-buffer-substring forward-buffer)
- (mml-insert-buffer forward-buffer))
- (if (and message-forward-show-mml
- (not message-forward-decoded-p))
- (insert
- (with-temp-buffer
- (mm-disable-multibyte) ;; Must copy buffer in unibyte mode
- (insert
- (with-current-buffer forward-buffer
- (mm-string-as-unibyte (buffer-string))))
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (goto-char (point-max)))))
- (setq e (point))
+ (if digest
+ (message-forward-make-body-digest forward-buffer)
(if message-forward-as-mime
- (if digest
- (insert "<#/multipart>\n")
- (if message-forward-show-mml
- (insert "<#/mml>\n")
- (insert "<#/part>\n")))
- (insert "\n-------------------- End of forwarded message --------------------\n"))
- (if (and digest message-forward-as-mime)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (delete-region (point-min) (point-max)))
- (when (and (not current-prefix-arg)
- message-forward-ignored-headers)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
+ (if (and message-forward-show-mml
+ (not (and (eq message-forward-show-mml 'best)
+ (with-current-buffer forward-buffer
+ (goto-char (point-min))
+ (re-search-forward
+ "Content-Type: *multipart/\\(signed\\|encrypted\\)"
+ nil t)))))
+ (message-forward-make-body-mml forward-buffer)
+ (message-forward-make-body-mime forward-buffer))
+ (message-forward-make-body-plain forward-buffer)))
(message-position-point))
;;;###autoload
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
+ ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
+ ;; 20. FIXIT, or we drop support for rmail in Emacs 20.
(if (rmail-msg-is-pruned)
(rmail-msg-restore-non-pruned-header)))
(message-forward-make-body forward-buffer))
+(eval-when-compile (defvar rmail-enable-mime-composing))
+
+;; Fixme: Should have defcustom.
;;;###autoload
(defun message-insinuate-rmail ()
- "Let RMAIL uses message to forward."
+ "Let RMAIL use message to forward."
(interactive)
(setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function
@@ -4324,12 +6276,16 @@ Optional DIGEST will use digest to forward."
(unless (message-mail-user-agent)
(set-buffer (get-buffer-create " *message resend*"))
(erase-buffer))
- (let ((message-this-is-mail t))
+ (let ((message-this-is-mail t)
+ message-setup-hook)
(message-setup `((To . ,address))))
;; Insert our usual headers.
- (message-generate-headers '(From Date To))
+ (message-generate-headers '(From Date To Message-ID))
(message-narrow-to-headers)
+ ;; Remove X-Draft-From header etc.
+ (message-remove-header message-ignored-mail-headers t)
;; Rename them all to "Resent-*".
+ (goto-char (point-min))
(while (re-search-forward "^[A-Za-z]" nil t)
(forward-char -1)
(insert "Resent-"))
@@ -4380,18 +6336,23 @@ you."
(mm-insert-part handles)
(undo-boundary)
(goto-char (point-min))
- (search-forward "\n\n" nil t)
- (or (and (re-search-forward message-unsent-separator nil t)
- (forward-line 1))
- (re-search-forward "^Return-Path:.*\n" nil t))
+ (re-search-forward "\n\n+" nil t)
+ (setq boundary (point))
;; We remove everything before the bounced mail.
- (delete-region
- (point-min)
- (if (re-search-forward "^[^ \n\t]+:" nil t)
- (match-beginning 0)
- (point))))
+ (if (or (re-search-forward message-unsent-separator nil t)
+ (progn
+ (search-forward "\n\n" nil 'move)
+ (re-search-backward "^Return-Path:.*\n" boundary t)))
+ (progn
+ (forward-line 1)
+ (delete-region (point-min)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
+ (match-beginning 0)
+ (point))))
+ (goto-char boundary)
+ (when (re-search-backward "^.?From .*\n" nil t)
+ (delete-region (match-beginning 0) (match-end 0)))))
(mm-enable-multibyte)
- (mime-to-mml)
(save-restriction
(message-narrow-to-head-1)
(message-remove-header message-ignored-bounced-headers t)
@@ -4442,7 +6403,7 @@ you."
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
@@ -4456,7 +6417,7 @@ you."
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
@@ -4495,49 +6456,112 @@ which specify the range to operate on."
(if (eq (char-after) (char-after (- (point) 2)))
(delete-char -2))))))
-(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+(defun message-exchange-point-and-mark ()
+ "Exchange point and mark, but don't activate region if it was inactive."
+ (unless (prog1
+ (message-mark-active-p)
+ (exchange-point-and-mark))
+ (setq mark-active nil)))
+
+(defalias 'message-make-overlay 'make-overlay)
+(defalias 'message-delete-overlay 'delete-overlay)
+(defalias 'message-overlay-put 'overlay-put)
+(defun message-kill-all-overlays ()
+ (if (featurep 'xemacs)
+ (map-extents (lambda (extent ignore) (delete-extent extent)))
+ (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
;; Support for toolbar
-(eval-when-compile (defvar tool-bar-map))
-(if (featurep 'xemacs)
- (require 'messagexmas)
- (when (and
- (condition-case nil (require 'tool-bar) (error nil))
- (fboundp 'tool-bar-add-item-from-menu)
- tool-bar-mode)
- (defvar message-tool-bar-map
- (let ((tool-bar-map (copy-keymap tool-bar-map)))
- ;; Zap some items which aren't so relevant and take up space.
- (dolist (key '(print-buffer kill-buffer save-buffer write-file
- dired open-file))
- (define-key tool-bar-map (vector key) nil))
-
- (tool-bar-add-item-from-menu
- 'message-send-and-exit "mail_send" message-mode-map)
- (tool-bar-add-item-from-menu
- 'message-kill-buffer "close" message-mode-map)
- (tool-bar-add-item-from-menu
- 'message-dont-send "cancel" message-mode-map)
- (tool-bar-add-item-from-menu
- 'mml-attach-file "attach" message-mode-map)
- (tool-bar-add-item-from-menu
- 'ispell-message "spell" message-mode-map)
- tool-bar-map))))
+(eval-when-compile
+ (defvar tool-bar-map)
+ (defvar tool-bar-mode))
+
+(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
+ ;; We need to make tool bar entries in local keymaps with
+ ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
+ (if (fboundp 'tool-bar-local-item-from-menu)
+ ;; This is for Emacs 21.3
+ (tool-bar-local-item-from-menu command icon in-map from-map props)
+ (tool-bar-add-item-from-menu command icon from-map props)))
+
+(defun message-tool-bar-map ()
+ (or message-tool-bar-map
+ (setq message-tool-bar-map
+ (and
+ (condition-case nil (require 'tool-bar) (error nil))
+ (fboundp 'tool-bar-add-item-from-menu)
+ tool-bar-mode
+ (let ((tool-bar-map (copy-keymap tool-bar-map))
+ (load-path (mm-image-load-path)))
+ ;; Zap some items which aren't so relevant and take
+ ;; up space.
+ (dolist (key '(print-buffer kill-buffer save-buffer
+ write-file dired open-file))
+ (define-key tool-bar-map (vector key) nil))
+ (message-tool-bar-local-item-from-menu
+ 'message-send-and-exit "mail_send" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-kill-buffer "close" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-dont-send "cancel" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'mml-attach-file "attach" tool-bar-map mml-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'ispell-message "spell" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'mml-preview "preview"
+ tool-bar-map mml-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-insert-importance-high "important"
+ tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-insert-importance-low "unimportant"
+ tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-insert-disposition-notification-to "receipt"
+ tool-bar-map message-mode-map)
+ tool-bar-map)))))
;;; Group name completion.
-(defvar message-newgroups-header-regexp
+(defcustom message-newgroups-header-regexp
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
- "Regexp that match headers that lists groups.")
+ "Regexp that match headers that lists groups."
+ :group 'message
+ :type 'regexp)
+
+(defcustom message-completion-alist
+ (list (cons message-newgroups-header-regexp 'message-expand-group)
+ '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
+ '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
+ . message-expand-name)
+ '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
+ . message-expand-name))
+ "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
+ :group 'message
+ :type '(alist :key-type regexp :value-type function))
+
+(defcustom message-tab-body-function nil
+ "*Function to execute when `message-tab' (TAB) is executed in the body.
+If nil, the function bound in `text-mode-map' or `global-map' is executed."
+ :group 'message
+ :link '(custom-manual "(message)Various Commands")
+ :type 'function)
(defun message-tab ()
- "Expand group names in Newsgroups and Followup-To headers.
-Do a `tab-to-tab-stop' if not in those headers."
+ "Complete names according to `message-completion-alist'.
+Execute function specified by `message-tab-body-function' when not in
+those headers."
(interactive)
- (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
- (mail-abbrev-in-expansion-header-p))
- (message-expand-group)
- (tab-to-tab-stop)))
+ (let ((alist message-completion-alist))
+ (while (and alist
+ (let ((mail-abbrev-mode-regexp (caar alist)))
+ (not (mail-abbrev-in-expansion-header-p))))
+ (setq alist (cdr alist)))
+ (funcall (or (cdar alist) message-tab-body-function
+ (lookup-key text-mode-map "\t")
+ (lookup-key global-map "\t")
+ 'indent-relative))))
(defun message-expand-group ()
"Expand the group name under point."
@@ -4581,6 +6605,11 @@ Do a `tab-to-tab-stop' if not in those headers."
(goto-char (point-min))
(delete-region (point) (progn (forward-line 3) (point))))))))))
+(defun message-expand-name ()
+ (if (fboundp 'bbdb-complete-name)
+ (bbdb-complete-name)
+ (expand-abbrev)))
+
;;; Help stuff.
(defun message-talkative-question (ask question show &rest text)
@@ -4610,10 +6639,10 @@ The following arguments may contain lists of values."
(list list))))
(defun message-generate-new-buffer-clone-locals (name &optional varstr)
- "Create and return a buffer with name based on NAME using `generate-new-buffer.'
+ "Create and return a buffer with name based on NAME using `generate-new-buffer'.
Then clone the local variables and values from the old buffer to the
new one, cloning only the locals having a substring matching the
-regexp varstr."
+regexp VARSTR."
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
@@ -4671,16 +6700,17 @@ regexp varstr."
(when lines
(insert lines))
(setq content-type-p
- (re-search-backward "^Content-Type:" nil t)))
+ (or mml-boundary
+ (re-search-backward "^Content-Type:" nil t))))
(save-restriction
(message-narrow-to-headers-or-head)
(message-remove-first-header "Content-Type")
(message-remove-first-header "Content-Transfer-Encoding"))
- ;; We always make sure that the message has a Content-Type header.
- ;; This is because some broken MTAs and MUAs get awfully confused
- ;; when confronted with a message with a MIME-Version header and
- ;; without a Content-Type header. For instance, Solaris'
- ;; /usr/bin/mail.
+ ;; We always make sure that the message has a Content-Type
+ ;; header. This is because some broken MTAs and MUAs get
+ ;; awfully confused when confronted with a message with a
+ ;; MIME-Version header and without a Content-Type header. For
+ ;; instance, Solaris' /usr/bin/mail.
(unless content-type-p
(goto-char (point-min))
;; For unknown reason, MIME-Version doesn't exist.
@@ -4688,14 +6718,16 @@ regexp varstr."
(forward-line 1)
(insert "Content-Type: text/plain; charset=us-ascii\n"))))))
-(defun message-read-from-minibuffer (prompt)
+(defun message-read-from-minibuffer (prompt &optional initial-contents)
"Read from the minibuffer while providing abbrev expansion."
(if (fboundp 'mail-abbrevs-setup)
(let ((mail-abbrev-mode-regexp "")
- (minibuffer-setup-hook 'mail-abbrevs-setup))
- (read-from-minibuffer prompt))
- (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
- (read-string prompt))))
+ (minibuffer-setup-hook 'mail-abbrevs-setup)
+ (minibuffer-local-map message-minibuffer-local-map))
+ (read-from-minibuffer prompt initial-contents))
+ (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
+ (minibuffer-local-map message-minibuffer-local-map))
+ (read-string prompt initial-contents))))
(defun message-use-alternative-email-as-from ()
(require 'mail-utils)
@@ -4715,6 +6747,74 @@ regexp varstr."
(goto-char (point-max))
(insert "From: " email "\n"))))
+(defun message-options-get (symbol)
+ (cdr (assq symbol message-options)))
+
+(defun message-options-set (symbol value)
+ (let ((the-cons (assq symbol message-options)))
+ (if the-cons
+ (if value
+ (setcdr the-cons value)
+ (setq message-options (delq the-cons message-options)))
+ (and value
+ (push (cons symbol value) message-options))))
+ value)
+
+(defun message-options-set-recipient ()
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-options-set 'message-sender
+ (mail-strip-quoted-names
+ (message-fetch-field "from")))
+ (message-options-set 'message-recipients
+ (mail-strip-quoted-names
+ (let ((to (message-fetch-field "to"))
+ (cc (message-fetch-field "cc"))
+ (bcc (message-fetch-field "bcc")))
+ (concat
+ (or to "")
+ (if (and to cc) ", ")
+ (or cc "")
+ (if (and (or to cc) bcc) ", ")
+ (or bcc "")))))))
+
+(defun message-hide-headers ()
+ "Hide headers based on the `message-hidden-headers' variable."
+ (let ((regexps (if (stringp message-hidden-headers)
+ (list message-hidden-headers)
+ message-hidden-headers))
+ (inhibit-point-motion-hooks t)
+ (after-change-functions nil))
+ (when regexps
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (message-hide-header-p regexps))
+ (message-next-header)
+ (let ((begin (point)))
+ (message-next-header)
+ (add-text-properties
+ begin (point)
+ '(invisible t message-hidden t))))))))))
+
+(defun message-hide-header-p (regexps)
+ (let ((result nil)
+ (reverse nil))
+ (when (eq (car regexps) 'not)
+ (setq reverse t)
+ (pop regexps))
+ (dolist (regexp regexps)
+ (setq result (or result (looking-at regexp))))
+ (if reverse
+ (not result)
+ result)))
+
+(when (featurep 'xemacs)
+ (require 'messagexmas)
+ (message-xmas-redefine))
+
(provide 'message)
(run-hooks 'message-load-hook)
diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el
index 796b346c9d9..bc8be178ea8 100644
--- a/lisp/gnus/messcompat.el
+++ b/lisp/gnus/messcompat.el
@@ -1,6 +1,6 @@
;;; messcompat.el --- making message mode compatible with mail mode
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -40,7 +40,7 @@
(defvar message-from-style mail-from-style
"*Specifies how \"From\" headers look.
-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index b3c7e31bd8d..7e95ef3986b 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -1,5 +1,7 @@
-;;; mm-bodies.el --- functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
+;;; mm-bodies.el --- Functions for decoding MIME things
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2003
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -42,7 +44,14 @@
(defcustom mm-body-charset-encoding-alist
'((iso-2022-jp . 7bit)
- (iso-2022-jp-2 . 7bit))
+ (iso-2022-jp-2 . 7bit)
+ ;; We MUST encode UTF-16 because it can contain \0's which is
+ ;; known to break servers.
+ ;; Note: UTF-16 variants are invalid for text parts [RFC 2781],
+ ;; so this can't happen :-/.
+ (utf-16 . base64)
+ (utf-16be . base64)
+ (utf-16le . base64))
"Alist of MIME charsets to encodings.
Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'."
:type '(repeat (cons (symbol :tag "charset")
@@ -53,51 +62,82 @@ Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'."
(const base64))))
:group 'mime)
-(defun mm-encode-body ()
+(defun mm-encode-body (&optional charset)
"Encode a body.
Should be called narrowed to the body that is to be encoded.
-If there is more than one non-ASCII Mule charset, then the list of found
-Mule charsets is returned.
+If there is more than one non-ASCII MULE charset in the body, then the
+list of MULE charsets found is returned.
+If CHARSET is non-nil, it is used as the MIME charset to encode the body.
If successful, the MIME charset is returned.
If no encoding was done, nil is returned."
(if (not (mm-multibyte-p))
;; In the non-Mule case, we search for non-ASCII chars and
;; return the value of `mail-parse-charset' if any are found.
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "[^\x0-\x7f]" nil t)
- (or mail-parse-charset
- (mm-read-charset "Charset used in the article: "))
- ;; The logic in `mml-generate-mime-1' confirms that it's OK
- ;; to return nil here.
- nil))
+ (or charset
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "[^\x0-\x7f]" nil t)
+ (or mail-parse-charset
+ (message-options-get 'mm-encody-body-charset)
+ (message-options-set
+ 'mm-encody-body-charset
+ (mm-read-coding-system "Charset used in the article: ")))
+ ;; The logic in `mml-generate-mime-1' confirms that it's OK
+ ;; to return nil here.
+ nil)))
(save-excursion
- (goto-char (point-min))
- (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))))
- (cond
- ;; No encoding.
- ((null charsets)
- nil)
- ;; Too many charsets.
- ((> (length charsets) 1)
- charsets)
- ;; We encode.
- (t
- (mm-encode-coding-region (point-min) (point-max)
- (mm-charset-to-coding-system
- (car charsets)))
- (car charsets)))))))
-
-(eval-when-compile (defvar message-posting-charset))
+ (if charset
+ (progn
+ (mm-encode-coding-region (point-min) (point-max) charset)
+ charset)
+ (goto-char (point-min))
+ (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)
+ mm-hack-charsets)))
+ (cond
+ ;; No encoding.
+ ((null charsets)
+ nil)
+ ;; Too many charsets.
+ ((> (length charsets) 1)
+ charsets)
+ ;; We encode.
+ (t
+ (prog1
+ (setq charset (car charsets))
+ (mm-encode-coding-region (point-min) (point-max)
+ (mm-charset-to-coding-system charset))))
+ ))))))
+
+(defun mm-long-lines-p (length)
+ "Say whether any of the lines in the buffer is longer than LENGTH."
+ (save-excursion
+ (goto-char (point-min))
+ (end-of-line)
+ (while (and (not (eobp))
+ (not (> (current-column) length)))
+ (forward-line 1)
+ (end-of-line))
+ (and (> (current-column) length)
+ (current-column))))
+
+(defvar message-posting-charset)
(defun mm-body-encoding (charset &optional encoding)
"Do Content-Transfer-Encoding and return the encoding of the current buffer."
- (let ((bits (mm-body-7-or-8)))
+ (when (stringp encoding)
+ (setq encoding (intern (downcase encoding))))
+ (let ((bits (mm-body-7-or-8))
+ (longp (mm-long-lines-p 1000)))
(require 'message)
(cond
- ((and (not mm-use-ultra-safe-encoding) (eq bits '7bit))
+ ((and (not longp)
+ (not (and mm-use-ultra-safe-encoding
+ (save-excursion (re-search-forward "^From " nil t))))
+ (eq bits '7bit))
bits)
((and (not mm-use-ultra-safe-encoding)
+ (not longp)
+ (not (cdr (assq charset mm-body-charset-encoding-alist)))
(or (eq t (cdr message-posting-charset))
(memq charset (cdr message-posting-charset))
(eq charset mail-parse-charset)))
@@ -124,12 +164,17 @@ If no encoding was done, nil is returned."
;;; Functions for decoding
;;;
+(eval-when-compile (defvar mm-uu-yenc-decode-function))
+
(defun mm-decode-content-transfer-encoding (encoding &optional type)
+ "Decodes buffer encoded with ENCODING, returning success status.
+If TYPE is `text/plain' CRLF->LF translation may occur."
(prog1
(condition-case error
(cond
((eq encoding 'quoted-printable)
- (quoted-printable-decode-region (point-min) (point-max)))
+ (quoted-printable-decode-region (point-min) (point-max))
+ t)
((eq encoding 'base64)
(base64-decode-region
(point-min)
@@ -144,49 +189,57 @@ If no encoding was done, nil is returned."
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-max))
(when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t)
- (forward-line)
- (delete-region (point) (point-max)))
- (point-max))))
+ (forward-line))
+ (point))))
((memq encoding '(7bit 8bit binary))
;; Do nothing.
- )
+ t)
((null encoding)
;; Do nothing.
- )
+ t)
((memq encoding '(x-uuencode x-uue))
(require 'mm-uu)
- (funcall mm-uu-decode-function (point-min) (point-max)))
+ (funcall mm-uu-decode-function (point-min) (point-max))
+ t)
((eq encoding 'x-binhex)
(require 'mm-uu)
- (funcall mm-uu-binhex-decode-function (point-min) (point-max)))
+ (funcall mm-uu-binhex-decode-function (point-min) (point-max))
+ t)
+ ((eq encoding 'x-yenc)
+ (require 'mm-uu)
+ (funcall mm-uu-yenc-decode-function (point-min) (point-max))
+ )
((functionp encoding)
- (funcall encoding (point-min) (point-max)))
+ (funcall encoding (point-min) (point-max))
+ t)
(t
(message "Unknown encoding %s; defaulting to 8bit" encoding)))
(error
(message "Error while decoding: %s" error)
nil))
(when (and
- (memq encoding '(base64 x-uuencode x-uue x-binhex))
+ (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc))
(equal type "text/plain"))
(goto-char (point-min))
(while (search-forward "\r\n" nil t)
(replace-match "\n" t t)))))
(defun mm-decode-body (charset &optional encoding type)
- "Decode the current article that has been encoded with ENCODING.
-The characters in CHARSET should then be decoded."
- (if (stringp charset)
- (setq charset (intern (downcase charset))))
- (if (or (not charset)
- (eq 'gnus-all mail-parse-ignored-charsets)
- (memq 'gnus-all mail-parse-ignored-charsets)
- (memq charset mail-parse-ignored-charsets))
- (setq charset mail-parse-charset))
+ "Decode the current article that has been encoded with ENCODING to CHARSET.
+ENCODING is a MIME content transfer encoding.
+CHARSET is the MIME charset with which to decode the data after transfer
+decoding. If it is nil, default to `mail-parse-charset'."
+ (when (stringp charset)
+ (setq charset (intern (downcase charset))))
+ (when (or (not charset)
+ (eq 'gnus-all mail-parse-ignored-charsets)
+ (memq 'gnus-all mail-parse-ignored-charsets)
+ (memq charset mail-parse-ignored-charsets))
+ (setq charset mail-parse-charset))
(save-excursion
(when encoding
(mm-decode-content-transfer-encoding encoding type))
- (when (featurep 'mule)
+ (when (featurep 'mule) ; Fixme: Wrong test for unibyte session.
(let ((coding-system (mm-charset-to-coding-system charset)))
(if (and (not coding-system)
(listp mail-parse-ignored-charsets)
@@ -201,7 +254,12 @@ The characters in CHARSET should then be decoded."
(or (not (eq coding-system 'ascii))
(setq coding-system mail-parse-charset))
(not (eq coding-system 'gnus-decoded)))
- (mm-decode-coding-region (point-min) (point-max) coding-system))))))
+ (mm-decode-coding-region (point-min) (point-max)
+ coding-system))
+ (setq buffer-file-coding-system
+ (if (boundp 'last-coding-system-used)
+ (symbol-value 'last-coding-system-used)
+ coding-system))))))
(defun mm-decode-string (string charset)
"Decode STRING with CHARSET."
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 8dab45c2bab..c396789957c 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1,5 +1,6 @@
-;;; mm-decode.el --- functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;;; mm-decode.el --- Functions for decoding MIME things
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -27,20 +28,32 @@
(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl)
+ (require 'term))
(eval-and-compile
+ (autoload 'executable-find "executable")
(autoload 'mm-inline-partial "mm-partial")
+ (autoload 'mm-inline-external-body "mm-extern")
(autoload 'mm-insert-inline "mm-view"))
+(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
+
(defgroup mime-display ()
"Display of MIME in mail and news articles."
- :link '(custom-manual "(emacs-mime)Customization")
+ :link '(custom-manual "(emacs-mime)Display Customization")
:version "21.1"
:group 'mail
:group 'news
:group 'multimedia)
+(defgroup mime-security ()
+ "MIME security in mail and news articles."
+ :link '(custom-manual "(emacs-mime)Display Customization")
+ :group 'mail
+ :group 'news
+ :group 'multimedia)
+
;;; Convenience macros.
(defmacro mm-handle-buffer (handle)
@@ -71,14 +84,94 @@
`(setcar (nthcdr 6 ,handle) ,contents))
(defmacro mm-handle-id (handle)
`(nth 7 ,handle))
+(defmacro mm-handle-multipart-original-buffer (handle)
+ `(get-text-property 0 'buffer (car ,handle)))
+(defmacro mm-handle-multipart-from (handle)
+ `(get-text-property 0 'from (car ,handle)))
+(defmacro mm-handle-multipart-ctl-parameter (handle parameter)
+ `(get-text-property 0 ,parameter (car ,handle)))
+
(defmacro mm-make-handle (&optional buffer type encoding undisplayer
disposition description cache
id)
`(list ,buffer ,type ,encoding ,undisplayer
,disposition ,description ,cache ,id))
+(defcustom mm-text-html-renderer
+ (cond ((locate-library "w3") 'w3)
+ ((executable-find "w3m") (if (locate-library "w3m")
+ 'w3m
+ 'w3m-standalone))
+ ((executable-find "links") 'links)
+ ((executable-find "lynx") 'lynx)
+ (t 'html2text))
+ "Render of HTML contents.
+It is one of defined renderer types, or a rendering function.
+The defined renderer types are:
+`w3' : use Emacs/W3;
+`w3m' : use emacs-w3m;
+`w3m-standalone': use w3m;
+`links': use links;
+`lynx' : use lynx;
+`html2text' : use html2text;
+nil : use external viewer."
+ :type '(choice (const w3)
+ (const w3m)
+ (const w3m-standalone)
+ (const links)
+ (const lynx)
+ (const html2text)
+ (const nil)
+ (function))
+ :version "21.3"
+ :group 'mime-display)
+
+(defvar mm-inline-text-html-renderer nil
+ "Function used for rendering inline HTML contents.
+It is suggested to customize `mm-text-html-renderer' instead.")
+
+(defcustom mm-inline-text-html-with-images nil
+ "If non-nil, Gnus will allow retrieving images in HTML contents with
+the <img> tags. It has no effect on Emacs/w3. See also the
+documentation for the `mm-w3m-safe-url-regexp' variable."
+ :type 'boolean
+ :group 'mime-display)
+
+(defcustom mm-w3m-safe-url-regexp "\\`cid:"
+ "Regexp matching URLs which are considered to be safe.
+Some HTML mails might contain a nasty trick used by spammers, using
+the <img> tag which is far more evil than the [Click Here!] button.
+It is most likely intended to check whether the ominous spam mail has
+reached your eyes or not, in which case the spammer knows for sure
+that your email address is valid. It is done by embedding an
+identifier string into a URL that you might automatically retrieve
+when displaying the image. The default value is \"\\\\`cid:\" which only
+matches parts embedded to the Multipart/Related type MIME contents and
+Gnus will never connect to the spammer's site arbitrarily. You may
+set this variable to nil if you consider all urls to be safe."
+ :type '(choice (regexp :tag "Regexp")
+ (const :tag "All URLs are safe" nil))
+ :group 'mime-display)
+
+(defcustom mm-inline-text-html-with-w3m-keymap t
+ "If non-nil, use emacs-w3m command keys in the article buffer."
+ :type 'boolean
+ :group 'mime-display)
+
+(defcustom mm-enable-external t
+ "Indicate whether external MIME handlers should be used.
+
+If t, all defined external MIME handlers are used. If nil, files are saved by
+`mailcap-save-binary-file'. If it is the symbol `ask', you are prompted
+before the external MIME handler is invoked."
+ :version "21.4"
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :group 'mime-display)
+
(defcustom mm-inline-media-tests
- '(("image/jpeg"
+ '(("image/p?jpeg"
mm-inline-image
(lambda (handle)
(mm-valid-and-fit-image-p 'jpeg handle)))
@@ -106,7 +199,7 @@
mm-inline-image
(lambda (handle)
(mm-valid-and-fit-image-p 'xpm handle)))
- ("image/x-pixmap"
+ ("image/x-xpixmap"
mm-inline-image
(lambda (handle)
(mm-valid-and-fit-image-p 'xpm handle)))
@@ -125,18 +218,21 @@
(lambda (handle)
(locate-library "diff-mode")))
("application/emacs-lisp" mm-display-elisp-inline identity)
+ ("application/x-emacs-lisp" mm-display-elisp-inline identity)
("text/html"
- mm-inline-text
+ mm-inline-text-html
(lambda (handle)
- (locate-library "w3")))
+ (or mm-inline-text-html-renderer
+ mm-text-html-renderer)))
("text/x-vcard"
- mm-inline-text
+ mm-inline-text-vcard
(lambda (handle)
(or (featurep 'vcard)
(locate-library "vcard"))))
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
("message/partial" mm-inline-partial identity)
+ ("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
("audio/wav" mm-inline-audio
(lambda (handle)
@@ -148,20 +244,42 @@
(and (or (featurep 'nas-sound) (featurep 'native-sound))
(device-sound-enabled-p))))
("application/pgp-signature" ignore identity)
+ ("application/x-pkcs7-signature" ignore identity)
+ ("application/pkcs7-signature" ignore identity)
+ ("application/x-pkcs7-mime" ignore identity)
+ ("application/pkcs7-mime" ignore identity)
("multipart/alternative" ignore identity)
("multipart/mixed" ignore identity)
- ("multipart/related" ignore identity))
+ ("multipart/related" ignore identity)
+ ;; Disable audio and image
+ ("audio/.*" ignore ignore)
+ ("image/.*" ignore ignore)
+ ;; Default to displaying as text
+ (".*" mm-inline-text mm-readable-p))
"Alist of media types/tests saying whether types can be displayed inline."
- :type '(repeat (list (string :tag "MIME type")
+ :type '(repeat (list (regexp :tag "MIME type")
(function :tag "Display function")
(function :tag "Display test")))
:group 'mime-display)
(defcustom mm-inlined-types
'("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
- "message/partial" "application/emacs-lisp"
- "application/pgp-signature")
- "List of media types that are to be displayed inline."
+ "message/partial" "message/external-body" "application/emacs-lisp"
+ "application/x-emacs-lisp"
+ "application/pgp-signature" "application/x-pkcs7-signature"
+ "application/pkcs7-signature" "application/x-pkcs7-mime"
+ "application/pkcs7-mime")
+ "List of media types that are to be displayed inline.
+See also `mm-inline-media-tests', which says how to display a media
+type inline."
+ :type '(repeat string)
+ :group 'mime-display)
+
+(defcustom mm-keep-viewer-alive-types
+ '("application/postscript" "application/msword" "application/vnd.ms-excel"
+ "application/pdf" "application/x-dvi")
+ "List of media types for which the external viewer will not be killed
+when selecting a different article."
:type '(repeat string)
:group 'mime-display)
@@ -169,12 +287,19 @@
'("text/plain" "text/enriched" "text/richtext" "text/html"
"text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
"message/rfc822" "text/x-patch" "application/pgp-signature"
- "application/emacs-lisp")
+ "application/emacs-lisp" "application/x-emacs-lisp"
+ "application/x-pkcs7-signature"
+ "application/pkcs7-signature" "application/x-pkcs7-mime"
+ "application/pkcs7-mime")
"A list of MIME types to be displayed automatically."
:type '(repeat string)
:group 'mime-display)
-(defcustom mm-attachment-override-types '("text/x-vcard")
+(defcustom mm-attachment-override-types '("text/x-vcard"
+ "application/pkcs7-mime"
+ "application/x-pkcs7-mime"
+ "application/pkcs7-signature"
+ "application/x-pkcs7-signature")
"Types to have \"attachment\" ignored if they can be displayed inline."
:type '(repeat string)
:group 'mime-display)
@@ -202,28 +327,125 @@ to:
:type '(repeat string)
:group 'mime-display)
-(defvar mm-tmp-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/"))
- "Where mm will store its temporary files.")
+(defcustom mm-tmp-directory
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ (if (boundp 'temporary-file-directory)
+ temporary-file-directory
+ "/tmp/"))
+ "Where mm will store its temporary files."
+ :type 'directory
+ :group 'mime-display)
(defcustom mm-inline-large-images nil
"If non-nil, then all images fit in the buffer."
:type 'boolean
:group 'mime-display)
+(defvar mm-file-name-rewrite-functions
+ '(mm-file-name-delete-control mm-file-name-delete-gotchas)
+ "*List of functions used for rewriting file names of MIME parts.
+Each function takes a file name as input and returns a file name.
+
+Ready-made functions include
+`mm-file-name-delete-control'
+`mm-file-name-delete-gotchas'
+`mm-file-name-delete-whitespace',
+`mm-file-name-trim-whitespace',
+`mm-file-name-collapse-whitespace',
+`mm-file-name-replace-whitespace',
+`capitalize', `downcase', `upcase', and
+`upcase-initials'.")
+
+(defvar mm-path-name-rewrite-functions nil
+ "*List of functions for rewriting the full file names of MIME parts.
+This is used when viewing parts externally, and is meant for
+transforming the absolute name so that non-compliant programs can find
+the file where it's saved.
+
+Each function takes a file name as input and returns a file name.")
+
+(defvar mm-file-name-replace-whitespace nil
+ "String used for replacing whitespace characters; default is `\"_\"'.")
+
+(defcustom mm-default-directory nil
+ "The default directory where mm will save files.
+If not set, `default-directory' will be used."
+ :type '(choice directory (const :tag "Default" nil))
+ :group 'mime-display)
+
+(defcustom mm-attachment-file-modes 384
+ "Set the mode bits of saved attachments to this integer."
+ :type 'integer
+ :group 'mime-display)
+
+(defcustom mm-external-terminal-program "xterm"
+ "The program to start an external terminal."
+ :type 'string
+ :group 'mime-display)
+
;;; Internal variables.
-(defvar mm-dissection-list nil)
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
+(defvar mm-postponed-undisplay-list nil)
;; According to RFC2046, in particular, in a digest, the default
;; Content-Type value for a body part is changed from "text/plain" to
;; "message/rfc822".
(defvar mm-dissect-default-type "text/plain")
+(autoload 'mml2015-verify "mml2015")
+(autoload 'mml2015-verify-test "mml2015")
+(autoload 'mml-smime-verify "mml-smime")
+(autoload 'mml-smime-verify-test "mml-smime")
+
+(defvar mm-verify-function-alist
+ '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
+ ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP"
+ mm-uu-pgp-signed-test)
+ ("application/pkcs7-signature" mml-smime-verify "S/MIME"
+ mml-smime-verify-test)
+ ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
+ mml-smime-verify-test)))
+
+(defcustom mm-verify-option 'never
+ "Option of verifying signed parts.
+`never', not verify; `always', always verify;
+`known', only verify known protocols. Otherwise, ask user."
+ :type '(choice (item always)
+ (item never)
+ (item :tag "only known protocols" known)
+ (item :tag "ask" nil))
+ :group 'mime-security)
+
+(autoload 'mml2015-decrypt "mml2015")
+(autoload 'mml2015-decrypt-test "mml2015")
+
+(defvar mm-decrypt-function-alist
+ '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
+ ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
+ mm-uu-pgp-encrypted-test)))
+
+(defcustom mm-decrypt-option nil
+ "Option of decrypting encrypted parts.
+`never', not decrypt; `always', always decrypt;
+`known', only decrypt known protocols. Otherwise, ask user."
+ :type '(choice (item always)
+ (item never)
+ (item :tag "only known protocols" known)
+ (item :tag "ask" nil))
+ :group 'mime-security)
+
+(defvar mm-viewer-completion-map
+ (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ map)
+ "Keymap for input viewer with completion.")
+
+;; Should we bind other key to minibuffer-complete-word?
+(define-key mm-viewer-completion-map " " 'self-insert-command)
+
(defvar mm-viewer-completion-map
(let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
(set-keymap-parent map minibuffer-local-completion-map)
@@ -235,20 +457,72 @@ to:
;;; The functions.
-(defun mm-dissect-buffer (&optional no-strict-mime)
+(defun mm-alist-to-plist (alist)
+ "Convert association list ALIST into the equivalent property-list form.
+The plist is returned. This converts from
+
+\((a . 1) (b . 2) (c . 3))
+
+into
+
+\(a 1 b 2 c 3)
+
+The original alist is not modified. See also `destructive-alist-to-plist'."
+ (let (plist)
+ (while alist
+ (let ((el (car alist)))
+ (setq plist (cons (cdr el) (cons (car el) plist))))
+ (setq alist (cdr alist)))
+ (nreverse plist)))
+
+(defun mm-keep-viewer-alive-p (handle)
+ "Say whether external viewer for HANDLE should stay alive."
+ (let ((types mm-keep-viewer-alive-types)
+ (type (mm-handle-media-type handle))
+ ty)
+ (catch 'found
+ (while (setq ty (pop types))
+ (when (string-match ty type)
+ (throw 'found t))))))
+
+(defun mm-handle-set-external-undisplayer (handle function)
+ "Set the undisplayer for HANDLE to FUNCTION.
+Postpone undisplaying of viewers for types in
+`mm-keep-viewer-alive-types'."
+ (if (mm-keep-viewer-alive-p handle)
+ (let ((new-handle (copy-sequence handle)))
+ (mm-handle-set-undisplayer new-handle function)
+ (mm-handle-set-undisplayer handle nil)
+ (push new-handle mm-postponed-undisplay-list))
+ (mm-handle-set-undisplayer handle function)))
+
+(defun mm-destroy-postponed-undisplay-list ()
+ (when mm-postponed-undisplay-list
+ (message "Destroying external MIME viewers")
+ (mm-destroy-parts mm-postponed-undisplay-list)))
+
+(defun mm-dissect-buffer (&optional no-strict-mime loose-mime)
"Dissect the current buffer and return a list of MIME handles."
(save-excursion
- (let (ct ctl type subtype cte cd description id result)
+ (let (ct ctl type subtype cte cd description id result from)
(save-restriction
(mail-narrow-to-head)
(when (or no-strict-mime
+ loose-mime
(mail-fetch-field "mime-version"))
(setq ct (mail-fetch-field "content-type")
ctl (ignore-errors (mail-header-parse-content-type ct))
cte (mail-fetch-field "content-transfer-encoding")
cd (mail-fetch-field "content-disposition")
description (mail-fetch-field "content-description")
- id (mail-fetch-field "content-id"))))
+ from (mail-fetch-field "from")
+ id (mail-fetch-field "content-id"))
+ ;; FIXME: In some circumstances, this code is running within
+ ;; an unibyte macro. mail-extract-address-components
+ ;; creates unibyte buffers. This `if', though not a perfect
+ ;; solution, avoids most of them.
+ (if from
+ (setq from (cadr (mail-extract-address-components from))))))
(when cte
(setq cte (mail-header-strip cte)))
(if (or (not ctl)
@@ -270,17 +544,34 @@ to:
((equal type "multipart")
(let ((mm-dissect-default-type (if (equal subtype "digest")
"message/rfc822"
- "text/plain")))
+ "text/plain"))
+ (start (cdr (assq 'start (cdr ctl)))))
+ (add-text-properties 0 (length (car ctl))
+ (mm-alist-to-plist (cdr ctl)) (car ctl))
+
+ ;; what really needs to be done here is a way to link a
+ ;; MIME handle back to it's parent MIME handle (in a multilevel
+ ;; MIME article). That would probably require changing
+ ;; the mm-handle API so we simply store the multipart buffert
+ ;; name as a text property of the "multipart/whatever" string.
+ (add-text-properties 0 (length (car ctl))
+ (list 'buffer (mm-copy-to-buffer)
+ 'from from
+ 'start start)
+ (car ctl))
(cons (car ctl) (mm-dissect-multipart ctl))))
(t
- (mm-dissect-singlepart
- ctl
- (and cte (intern (downcase (mail-header-remove-whitespace
- (mail-header-remove-comments
- cte)))))
- no-strict-mime
- (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
- description id))))
+ (mm-possibly-verify-or-decrypt
+ (mm-dissect-singlepart
+ ctl
+ (and cte (intern (downcase (mail-header-remove-whitespace
+ (mail-header-remove-comments
+ cte)))))
+ no-strict-mime
+ (and cd (ignore-errors
+ (mail-header-parse-content-disposition cd)))
+ description id)
+ ctl))))
(when id
(when (string-match " *<\\(.*\\)> *" id)
(setq id (match-string 1 id)))
@@ -292,16 +583,8 @@ to:
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
- (let ((res (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
- (push (car res) mm-dissection-list)
- res)))
-
-(defun mm-remove-all-parts ()
- "Remove all MIME handles."
- (interactive)
- (mapcar 'mm-remove-part mm-dissection-list)
- (setq mm-dissection-list nil))
+ (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
(defun mm-dissect-multipart (ctl)
(goto-char (point-min))
@@ -321,14 +604,16 @@ to:
(save-restriction
(narrow-to-region start (point))
(setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
- (forward-line 2)
+ (end-of-line 2)
+ (or (looking-at boundary)
+ (forward-line 1))
(setq start (point)))
(when (and start (< start end))
(save-excursion
(save-restriction
(narrow-to-region start end)
(setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
- (nreverse parts)))
+ (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
(defun mm-copy-to-buffer ()
"Copy the contents of the current buffer to a fresh buffer."
@@ -342,6 +627,16 @@ to:
(insert-buffer-substring obuf beg)
(current-buffer))))
+(defun mm-display-parts (handle &optional no-default)
+ (if (stringp (car handle))
+ (mapcar 'mm-display-parts (cdr handle))
+ (if (bufferp (car handle))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-display-part handle)
+ (goto-char (point-max)))
+ (mapcar 'mm-display-parts handle))))
+
(defun mm-display-part (handle &optional no-default)
"Display the MIME part represented by HANDLE.
Returns nil if the part is removed; inline if displayed inline;
@@ -351,8 +646,15 @@ external if displayed external."
(if (mm-handle-displayed-p handle)
(mm-remove-part handle)
(let* ((type (mm-handle-media-type handle))
- (method (mailcap-mime-info type)))
- (if (mm-inlined-p handle)
+ (method (mailcap-mime-info type))
+ (filename (or (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)
+ "<file>"))
+ (external mm-enable-external))
+ (if (and (mm-inlinable-p handle)
+ (mm-inlined-p handle))
(progn
(forward-line 1)
(mm-display-inline handle)
@@ -365,8 +667,27 @@ external if displayed external."
(forward-line 1)
(mm-insert-inline handle (mm-get-part handle))
'inline)
- (mm-display-external
- handle (or method 'mailcap-save-binary-file)))))))))
+ (if (and method ;; If nil, we always use "save".
+ (stringp method) ;; 'mailcap-save-binary-file
+ (or (eq mm-enable-external t)
+ (and (eq mm-enable-external 'ask)
+ (y-or-n-p
+ (concat
+ "Display part (" type
+ ") using external program"
+ ;; Can non-string method ever happen?
+ (if (stringp method)
+ (concat
+ " \"" (format method filename) "\"")
+ "")
+ "? ")))))
+ (setq external t)
+ (setq external nil))
+ (if external
+ (mm-display-external
+ handle (or method 'mailcap-save-binary-file))
+ (mm-display-external
+ handle 'mailcap-save-binary-file)))))))))
(defun mm-display-external (handle method)
"Display HANDLE using METHOD."
@@ -383,10 +704,12 @@ external if displayed external."
(when win
(select-window win)))
(switch-to-buffer (generate-new-buffer " *mm*")))
+ (buffer-disable-undo)
(mm-set-buffer-file-coding-system mm-binary-coding-system)
(insert-buffer-substring cur)
(goto-char (point-min))
- (message "Viewing with %s" method)
+ (when method
+ (message "Viewing with %s" method))
(let ((mm (current-buffer))
(non-viewer (assq 'non-viewer
(mailcap-mime-info
@@ -400,10 +723,13 @@ external if displayed external."
(mm-handle-set-undisplayer handle mm)))))
;; The function is a string to be executed.
(mm-insert-part handle)
- (let* ((dir (mm-make-temp-file
+ (let* ((dir (mm-make-temp-file
(expand-file-name "emm." mm-tmp-directory) 'dir))
- (filename (mail-content-type-get
- (mm-handle-disposition handle) 'filename))
+ (filename (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)))
(mime-info (mailcap-mime-info
(mm-handle-media-type handle) t))
(needsterm (or (assoc "needsterm" mime-info)
@@ -413,66 +739,89 @@ external if displayed external."
;; We create a private sub-directory where we store our files.
(set-file-modes dir 448)
(if filename
- (setq file (expand-file-name (file-name-nondirectory filename)
- dir))
+ (setq file (expand-file-name
+ (gnus-map-function mm-file-name-rewrite-functions
+ (file-name-nondirectory filename))
+ dir))
(setq file (mm-make-temp-file (expand-file-name "mm." dir))))
(let ((coding-system-for-write mm-binary-coding-system))
(write-region (point-min) (point-max) file nil 'nomesg))
(message "Viewing with %s" method)
- (cond (needsterm
- (unwind-protect
- (start-process "*display*" nil
- "xterm"
- "-e" shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (mm-handle-set-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
- 'external)
- (copiousoutput
- (with-current-buffer outbuf
- (forward-line 1)
- (mm-insert-inline
- handle
- (unwind-protect
- (progn
- (call-process shell-file-name nil
- (setq buffer
- (generate-new-buffer "*mm*"))
- nil
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (if (buffer-live-p buffer)
- (save-excursion
- (set-buffer buffer)
- (buffer-string))))
- (progn
- (ignore-errors (delete-file file))
- (ignore-errors (delete-directory
- (file-name-directory file)))
- (ignore-errors (kill-buffer buffer))))))
- 'inline)
- (t
- (unwind-protect
- (start-process "*display*"
- (setq buffer
- (generate-new-buffer "*mm*"))
- shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (mm-handle-set-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
- 'external)))))))
+ (cond
+ (needsterm
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (if window-system
+ (start-process "*display*" nil
+ mm-external-terminal-program
+ "-e" shell-file-name
+ shell-command-switch command)
+ (require 'term)
+ (require 'gnus-win)
+ (set-buffer
+ (setq buffer
+ (make-term "display"
+ shell-file-name
+ nil
+ shell-command-switch command)))
+ (term-mode)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buffer)
+ `(lambda (process state)
+ (if (eq 'exit (process-status process))
+ (gnus-configure-windows
+ ',gnus-current-window-configuration))))
+ (gnus-configure-windows 'display-term))
+ (mm-handle-set-external-undisplayer handle (cons file buffer)))
+ (message "Displaying %s..." command))
+ 'external)
+ (copiousoutput
+ (with-current-buffer outbuf
+ (forward-line 1)
+ (mm-insert-inline
+ handle
+ (unwind-protect
+ (progn
+ (call-process shell-file-name nil
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ nil
+ shell-command-switch
+ (mm-mailcap-command
+ method file (mm-handle-type handle)))
+ (if (buffer-live-p buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (buffer-string))))
+ (progn
+ (ignore-errors (delete-file file))
+ (ignore-errors (delete-directory
+ (file-name-directory file)))
+ (ignore-errors (kill-buffer buffer))))))
+ 'inline)
+ (t
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ shell-file-name
+ shell-command-switch command)
+ (mm-handle-set-external-undisplayer
+ handle (cons file buffer)))
+ (message "Displaying %s..." command))
+ 'external)))))))
(defun mm-mailcap-command (method file type-list)
(let ((ctl (cdr type-list))
(beg 0)
(uses-stdin t)
out sub total)
- (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
+ (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%"
+ method beg)
(push (substring method beg (match-beginning 0)) out)
(setq beg (match-end 0)
total (match-string 0 method)
@@ -480,18 +829,23 @@ external if displayed external."
(cond
((string= total "%%")
(push "%" out))
- ((string= total "%s")
+ ((or (string= total "%s")
+ ;; We do our own quoting.
+ (string= total "'%s'")
+ (string= total "\"%s\""))
(setq uses-stdin nil)
- (push (mm-quote-arg file) out))
+ (push (mm-quote-arg
+ (gnus-map-function mm-path-name-rewrite-functions file)) out))
((string= total "%t")
(push (mm-quote-arg (car type-list)) out))
(t
(push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
(push (substring method beg (length method)) out)
- (if uses-stdin
- (progn
- (push "<" out)
- (push (mm-quote-arg file) out)))
+ (when uses-stdin
+ (push "<" out)
+ (push (mm-quote-arg
+ (gnus-map-function mm-path-name-rewrite-functions file))
+ out))
(mapconcat 'identity (nreverse out) "")))
(defun mm-remove-parts (handles)
@@ -503,8 +857,8 @@ external if displayed external."
(while (setq handle (pop handles))
(cond
((stringp handle)
- ;; Do nothing.
- )
+ (when (buffer-live-p (get-text-property 0 'buffer handle))
+ (kill-buffer (get-text-property 0 'buffer handle))))
((and (listp handle)
(stringp (car handle)))
(mm-remove-parts (cdr handle)))
@@ -520,11 +874,11 @@ external if displayed external."
(while (setq handle (pop handles))
(cond
((stringp handle)
- ;; Do nothing.
- )
+ (when (buffer-live-p (get-text-property 0 'buffer handle))
+ (kill-buffer (get-text-property 0 'buffer handle))))
((and (listp handle)
(stringp (car handle)))
- (mm-destroy-parts (cdr handle)))
+ (mm-destroy-parts handle))
(t
(mm-destroy-part handle)))))))
@@ -543,9 +897,18 @@ external if displayed external."
(funcall object))
;; Externally displayed part.
((consp object)
+ (condition-case ()
+ (while (get-buffer-process (cdr object))
+ (interrupt-process (get-buffer-process (cdr object)))
+ (message "Waiting for external displayer to die...")
+ (sit-for 1))
+ (quit)
+ (error))
+ (ignore-errors (and (cdr object) (kill-buffer (cdr object))))
+ (message "Waiting for external displayer to die...done")
(ignore-errors (delete-file (car object)))
- (ignore-errors (delete-directory (file-name-directory (car object))))
- (ignore-errors (kill-buffer (cdr object))))
+ (ignore-errors (delete-directory (file-name-directory
+ (car object)))))
((bufferp object)
(when (buffer-live-p object)
(kill-buffer object)))))
@@ -562,6 +925,18 @@ external if displayed external."
(when (string-match (car elem) type)
(return elem))))
+(defun mm-automatic-display-p (handle)
+ "Say whether the user wants HANDLE to be displayed automatically."
+ (let ((methods mm-automatic-display)
+ (type (mm-handle-media-type handle))
+ method result)
+ (while (setq method (pop methods))
+ (when (and (not (mm-inline-override-p handle))
+ (string-match method type))
+ (setq result t
+ methods nil)))
+ result))
+
(defun mm-inlinable-p (handle)
"Say whether HANDLE can be displayed inline."
(let ((alist mm-inline-media-tests)
@@ -575,28 +950,14 @@ external if displayed external."
(pop alist))
test))
-(defun mm-automatic-display-p (handle)
- "Say whether the user wants HANDLE to be displayed automatically."
- (let ((methods mm-automatic-display)
- (type (mm-handle-media-type handle))
- method result)
- (while (setq method (pop methods))
- (when (and (not (mm-inline-override-p handle))
- (string-match method type)
- (mm-inlinable-p handle))
- (setq result t
- methods nil)))
- result))
-
(defun mm-inlined-p (handle)
- "Say whether the user wants HANDLE to be displayed automatically."
+ "Say whether the user wants HANDLE to be displayed inline."
(let ((methods mm-inlined-types)
(type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
(when (and (not (mm-inline-override-p handle))
- (string-match method type)
- (mm-inlinable-p handle))
+ (string-match method type))
(setq result t
methods nil)))
result))
@@ -650,7 +1011,12 @@ external if displayed external."
(defun mm-get-part (handle)
"Return the contents of HANDLE as a string."
(mm-with-unibyte-buffer
- (mm-insert-part handle)
+ (insert (with-current-buffer (mm-handle-buffer handle)
+ (mm-with-unibyte-current-buffer
+ (buffer-string))))
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle))
(buffer-string)))
(defun mm-insert-part (handle)
@@ -659,23 +1025,61 @@ external if displayed external."
(save-excursion
(if (member (mm-handle-media-supertype handle) '("text" "message"))
(with-temp-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
- (let ((temp (current-buffer)))
- (set-buffer cur)
- (insert-buffer-substring temp)))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (prog1
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle))
+ (let ((temp (current-buffer)))
+ (set-buffer cur)
+ (insert-buffer-substring temp))))
(mm-with-unibyte-buffer
(insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
- (let ((temp (current-buffer)))
- (set-buffer cur)
- (insert-buffer-substring temp)))))))
-
-(defvar mm-default-directory nil)
+ (prog1
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle)
+ (mm-handle-media-type handle))
+ (let ((temp (current-buffer)))
+ (set-buffer cur)
+ (insert-buffer-substring temp))))))))
+
+(defun mm-file-name-delete-whitespace (file-name)
+ "Remove all whitespace characters from FILE-NAME."
+ (while (string-match "\\s-+" file-name)
+ (setq file-name (replace-match "" t t file-name)))
+ file-name)
+
+(defun mm-file-name-trim-whitespace (file-name)
+ "Remove leading and trailing whitespace characters from FILE-NAME."
+ (when (string-match "\\`\\s-+" file-name)
+ (setq file-name (substring file-name (match-end 0))))
+ (when (string-match "\\s-+\\'" file-name)
+ (setq file-name (substring file-name 0 (match-beginning 0))))
+ file-name)
+
+(defun mm-file-name-collapse-whitespace (file-name)
+ "Collapse multiple whitespace characters in FILE-NAME."
+ (while (string-match "\\s-\\s-+" file-name)
+ (setq file-name (replace-match " " t t file-name)))
+ file-name)
+
+(defun mm-file-name-replace-whitespace (file-name)
+ "Replace whitespace characters in FILE-NAME with underscores.
+Set the option `mm-file-name-replace-whitespace' to any other
+string if you do not like underscores."
+ (let ((s (or mm-file-name-replace-whitespace "_")))
+ (while (string-match "\\s-" file-name)
+ (setq file-name (replace-match s t t file-name))))
+ file-name)
+
+(defun mm-file-name-delete-control (filename)
+ "Delete control characters from FILENAME."
+ (gnus-replace-in-string filename "[\x00-\x1f\x7f]" ""))
+
+(defun mm-file-name-delete-gotchas (filename)
+ "Delete shell gotchas from FILENAME."
+ (setq filename (gnus-replace-in-string filename "[<>|]" ""))
+ (gnus-replace-in-string filename "^[.-]+" ""))
(defun mm-save-part (handle)
"Write HANDLE to a file."
@@ -684,29 +1088,36 @@ external if displayed external."
(mm-handle-disposition handle) 'filename))
file)
(when filename
- (setq filename (file-name-nondirectory filename)))
+ (setq filename (gnus-map-function mm-file-name-rewrite-functions
+ (file-name-nondirectory filename))))
(setq file
- (read-file-name "Save MIME part to: "
- (expand-file-name
- (or filename name "")
- (or mm-default-directory default-directory))))
+ (mm-with-multibyte
+ (read-file-name "Save MIME part to: "
+ (or mm-default-directory default-directory)
+ nil nil (or filename name ""))))
(setq mm-default-directory (file-name-directory file))
- (when (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? "
- file)))
- (mm-save-part-to-file handle file))))
+ (and (or (not (file-exists-p file))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
+ (progn
+ (mm-save-part-to-file handle file)
+ file))))
(defun mm-save-part-to-file (handle file)
(mm-with-unibyte-buffer
(mm-insert-part handle)
(let ((coding-system-for-write 'binary)
+ (current-file-modes (default-file-modes))
;; Don't re-compress .gz & al. Arguably we should make
;; `file-name-handler-alist' nil, but that would chop
;; ange-ftp, which is reasonable to use here.
(inhibit-file-name-operation 'write-region)
(inhibit-file-name-handlers
(cons 'jka-compr-handler inhibit-file-name-handlers)))
- (write-region (point-min) (point-max) file))))
+ (set-default-file-modes mm-attachment-file-modes)
+ (unwind-protect
+ (write-region (point-min) (point-max) file)
+ (set-default-file-modes current-file-modes)))))
(defun mm-pipe-part (handle)
"Pipe HANDLE to a process."
@@ -715,7 +1126,8 @@ external if displayed external."
(read-string "Shell command on MIME part: " mm-last-shell-command)))
(mm-with-unibyte-buffer
(mm-insert-part handle)
- (shell-command-on-region (point-min) (point-max) command nil))))
+ (let ((coding-system-for-write 'binary))
+ (shell-command-on-region (point-min) (point-max) command nil)))))
(defun mm-interactively-view-part (handle)
"Display HANDLE using METHOD."
@@ -768,6 +1180,35 @@ external if displayed external."
"Return the handle(s) referred to by ID."
(cdr (assoc id mm-content-id-alist)))
+(defconst mm-image-type-regexps
+ '(("/\\*.*XPM.\\*/" . xpm)
+ ("P[1-6]" . pbm)
+ ("GIF8" . gif)
+ ("\377\330" . jpeg)
+ ("\211PNG\r\n" . png)
+ ("#define" . xbm)
+ ("\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff)
+ ("%!PS" . postscript))
+ "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
+When the first bytes of an image file match REGEXP, it is assumed to
+be of image type IMAGE-TYPE.")
+
+;; Steal from image.el. image-type-from-data suffers multi-line matching bug.
+(defun mm-image-type-from-buffer ()
+ "Determine the image type from data in the current buffer.
+Value is a symbol specifying the image type or nil if type cannot
+be determined."
+ (let ((types mm-image-type-regexps)
+ type)
+ (goto-char (point-min))
+ (while (and types (null type))
+ (let ((regexp (car (car types)))
+ (image-type (cdr (car types))))
+ (when (looking-at regexp)
+ (setq type image-type))
+ (setq types (cdr types))))
+ type))
+
(defun mm-get-image (handle)
"Return an image instance based on HANDLE."
(let ((type (mm-handle-media-subtype handle))
@@ -788,31 +1229,40 @@ external if displayed external."
(prog1
(setq spec
(ignore-errors
- ;; Avoid testing `make-glyph' since W3 may define
- ;; a bogus version of it.
+ ;; Avoid testing `make-glyph' since W3 may define
+ ;; a bogus version of it.
(if (fboundp 'create-image)
- (create-image (buffer-string) (intern type) 'data-p)
- (cond
- ((equal type "xbm")
- ;; xbm images require special handling, since
- ;; the only way to create glyphs from these
- ;; (without a ton of work) is to write them
- ;; out to a file, and then create a file
- ;; specifier.
- (let ((file (mm-make-temp-file
- (expand-file-name "emm.xbm"
- mm-tmp-directory))))
- (unwind-protect
- (progn
- (write-region (point-min) (point-max) file)
- (make-glyph (list (cons 'x file))))
- (ignore-errors
- (delete-file file)))))
- (t
- (make-glyph
- (vector (intern type) :data (buffer-string))))))))
+ (create-image (buffer-string)
+ (or (mm-image-type-from-buffer)
+ (intern type))
+ 'data-p)
+ (mm-create-image-xemacs type))))
(mm-handle-set-cache handle spec))))))
+(defun mm-create-image-xemacs (type)
+ (cond
+ ((equal type "xbm")
+ ;; xbm images require special handling, since
+ ;; the only way to create glyphs from these
+ ;; (without a ton of work) is to write them
+ ;; out to a file, and then create a file
+ ;; specifier.
+ (let ((file (mm-make-temp-file
+ (expand-file-name "emm.xbm"
+ mm-tmp-directory))))
+ (unwind-protect
+ (progn
+ (write-region (point-min) (point-max) file)
+ (make-glyph (list (cons 'x file))))
+ (ignore-errors
+ (delete-file file)))))
+ (t
+ (make-glyph
+ (vector
+ (or (mm-image-type-from-buffer)
+ (intern type))
+ :data (buffer-string))))))
+
(defun mm-image-fit-p (handle)
"Say whether the image in HANDLE will fit the current window."
(let ((image (mm-get-image handle)))
@@ -848,6 +1298,188 @@ external if displayed external."
(and (mm-valid-image-format-p format)
(mm-image-fit-p handle)))
+(defun mm-find-part-by-type (handles type &optional notp recursive)
+ "Search in HANDLES for part with TYPE.
+If NOTP, returns first non-matching part.
+If RECURSIVE, search recursively."
+ (let (handle)
+ (while handles
+ (if (and recursive (stringp (caar handles)))
+ (if (setq handle (mm-find-part-by-type (cdar handles) type
+ notp recursive))
+ (setq handles nil))
+ (if (if notp
+ (not (equal (mm-handle-media-type (car handles)) type))
+ (equal (mm-handle-media-type (car handles)) type))
+ (setq handle (car handles)
+ handles nil)))
+ (setq handles (cdr handles)))
+ handle))
+
+(defun mm-find-raw-part-by-type (ctl type &optional notp)
+ (goto-char (point-min))
+ (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl
+ 'boundary)))
+ (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$"))
+ start
+ (end (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward close-delimiter nil t)
+ (match-beginning 0)
+ (point-max))))
+ result)
+ (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$"))
+ (while (and (not result)
+ (re-search-forward boundary end t))
+ (goto-char (match-beginning 0))
+ (when start
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (1- (point)))
+ (when (let ((ctl (ignore-errors
+ (mail-header-parse-content-type
+ (mail-fetch-field "content-type")))))
+ (if notp
+ (not (equal (car ctl) type))
+ (equal (car ctl) type)))
+ (setq result (buffer-string))))))
+ (forward-line 1)
+ (setq start (point)))
+ (when (and (not result) start)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (when (let ((ctl (ignore-errors
+ (mail-header-parse-content-type
+ (mail-fetch-field "content-type")))))
+ (if notp
+ (not (equal (car ctl) type))
+ (equal (car ctl) type)))
+ (setq result (buffer-string))))))
+ result))
+
+(defvar mm-security-handle nil)
+
+(defsubst mm-set-handle-multipart-parameter (handle parameter value)
+ ;; HANDLE could be a CTL.
+ (when handle
+ (put-text-property 0 (length (car handle)) parameter value
+ (car handle))))
+
+(defun mm-possibly-verify-or-decrypt (parts ctl)
+ (let ((type (car ctl))
+ (subtype (cadr (split-string (car ctl) "/")))
+ (mm-security-handle ctl) ;; (car CTL) is the type.
+ protocol func functest)
+ (cond
+ ((or (equal type "application/x-pkcs7-mime")
+ (equal type "application/pkcs7-mime"))
+ (with-temp-buffer
+ (when (and (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known) t)
+ (t (y-or-n-p
+ (format "Decrypt (S/MIME) part? "))))
+ (mm-view-pkcs7 parts))
+ (setq parts (mm-dissect-buffer t)))))
+ ((equal subtype "signed")
+ (unless (and (setq protocol
+ (mm-handle-multipart-ctl-parameter ctl 'protocol))
+ (not (equal protocol "multipart/mixed")))
+ ;; The message is broken or draft-ietf-openpgp-multsig-01.
+ (let ((protocols mm-verify-function-alist))
+ (while protocols
+ (if (and (or (not (setq functest (nth 3 (car protocols))))
+ (funcall functest parts ctl))
+ (mm-find-part-by-type parts (caar protocols) nil t))
+ (setq protocol (caar protocols)
+ protocols nil)
+ (setq protocols (cdr protocols))))))
+ (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
+ (when (cond
+ ((eq mm-verify-option 'never) nil)
+ ((eq mm-verify-option 'always) t)
+ ((eq mm-verify-option 'known)
+ (and func
+ (or (not (setq functest
+ (nth 3 (assoc protocol
+ mm-verify-function-alist))))
+ (funcall functest parts ctl))))
+ (t
+ (y-or-n-p
+ (format "Verify signed (%s) part? "
+ (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (format "protocol=%s" protocol))))))
+ (save-excursion
+ (if func
+ (funcall func parts ctl)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown sign protocol (%s)" protocol))))))
+ ((equal subtype "encrypted")
+ (unless (setq protocol
+ (mm-handle-multipart-ctl-parameter ctl 'protocol))
+ ;; The message is broken.
+ (let ((parts parts))
+ (while parts
+ (if (assoc (mm-handle-media-type (car parts))
+ mm-decrypt-function-alist)
+ (setq protocol (mm-handle-media-type (car parts))
+ parts nil)
+ (setq parts (cdr parts))))))
+ (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
+ (when (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known)
+ (and func
+ (or (not (setq functest
+ (nth 3 (assoc protocol
+ mm-decrypt-function-alist))))
+ (funcall functest parts ctl))))
+ (t
+ (y-or-n-p
+ (format "Decrypt (%s) part? "
+ (or (nth 2 (assoc protocol mm-decrypt-function-alist))
+ (format "protocol=%s" protocol))))))
+ (save-excursion
+ (if func
+ (setq parts (funcall func parts ctl))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown encrypt protocol (%s)" protocol))))))
+ (t nil))
+ parts))
+
+(defun mm-multiple-handles (handles)
+ (and (listp handles)
+ (> (length handles) 1)
+ (or (listp (car handles))
+ (stringp (car handles)))))
+
+(defun mm-complicated-handles (handles)
+ (and (listp (car handles))
+ (> (length handles) 1)))
+
+(defun mm-merge-handles (handles1 handles2)
+ (append
+ (if (listp (car handles1))
+ handles1
+ (list handles1))
+ (if (listp (car handles2))
+ handles2
+ (list handles2))))
+
+(defun mm-readable-p (handle)
+ "Say whether the content of HANDLE is readable."
+ (and (< (with-current-buffer (mm-handle-buffer handle)
+ (buffer-size)) 10000)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (and (eq (mm-body-7-or-8) '7bit)
+ (not (mm-long-lines-p 76))))))
+
(provide 'mm-decode)
;;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index dd6974a7090..63c963b49c1 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -1,5 +1,6 @@
-;;; mm-encode.el --- functions for encoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
+;;; mm-encode.el --- Functions for encoding MIME things
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -28,19 +29,38 @@
(require 'mail-parse)
(require 'mailcap)
(eval-and-compile
- (autoload 'mm-body-7-or-8 "mm-bodies"))
+ (autoload 'mm-body-7-or-8 "mm-bodies")
+ (autoload 'mm-long-lines-p "mm-bodies"))
-(defvar mm-content-transfer-encoding-defaults
+(defcustom mm-content-transfer-encoding-defaults
'(("text/x-patch" 8bit)
("text/.*" qp-or-base64)
("message/rfc822" 8bit)
- ("application/emacs-lisp" 8bit)
- ("application/x-emacs-lisp" 8bit)
- ("application/x-patch" 8bit)
+ ("application/emacs-lisp" qp-or-base64)
+ ("application/x-emacs-lisp" qp-or-base64)
+ ("application/x-patch" qp-or-base64)
(".*" base64))
"Alist of regexps that match MIME types and their encodings.
If the encoding is `qp-or-base64', then either quoted-printable
-or base64 will be used, depending on what is more efficient.")
+or base64 will be used, depending on what is more efficient.
+
+`qp-or-base64' has another effect. It will fold long lines so that
+MIME parts may not be broken by MTA. So do `quoted-printable' and
+`base64'.
+
+Note: It affects body encoding only when a part is a raw forwarded
+message (which will be made by `gnus-summary-mail-forward' with the
+arg 2 for example) or is neither the text/* type nor the message/*
+type. Even though in those cases, you can use the `encoding' MML tag
+to specify encoding of non-ASCII MIME parts."
+ :type '(repeat (list (regexp :tag "MIME type")
+ (choice :tag "encoding"
+ (const 7bit)
+ (const 8bit)
+ (const qp-or-base64)
+ (const quoted-printable)
+ (const base64))))
+ :group 'mime)
(defvar mm-use-ultra-safe-encoding nil
"If non-nil, use encodings aimed at Procrustean bed survival.
@@ -76,40 +96,47 @@ This variable should never be set directly, but bound before a call to
(mailcap-extension-to-mime (match-string 0 file))))
(defun mm-safer-encoding (encoding)
- "Return a safer but similar encoding."
+ "Return an encoding similar to ENCODING but safer than it."
(cond
- ((memq encoding '(7bit 8bit quoted-printable)) 'quoted-printable)
+ ((eq encoding '7bit) '7bit) ;; 7bit is considered safe.
+ ((memq encoding '(8bit quoted-printable)) 'quoted-printable)
;; The remaining encodings are binary and base64 (and perhaps some
;; non-standard ones), which are both turned into base64.
(t 'base64)))
(defun mm-encode-content-transfer-encoding (encoding &optional type)
+ "Encode the current buffer with ENCODING for MIME type TYPE.
+ENCODING can be: nil (do nothing); one of `quoted-printable', `base64';
+`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding."
(cond
((eq encoding 'quoted-printable)
+ ;; This used to try to make a multibyte buffer unibyte. That's
+ ;; completely wrong, since you'd get QP-encoded emacs-mule. If
+ ;; this gets run on multibyte text it's an error that needs
+ ;; fixing, and the encoding function will signal an error.
+ ;; Likewise base64 below.
(quoted-printable-encode-region (point-min) (point-max) t))
((eq encoding 'base64)
(when (equal type "text/plain")
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match "\r\n" t t)))
- (condition-case error
- (base64-encode-region (point-min) (point-max))
- (error
- (message "Error while decoding: %s" error)
- nil)))
+ (base64-encode-region (point-min) (point-max)))
((memq encoding '(7bit 8bit binary))
;; Do nothing.
)
((null encoding)
;; Do nothing.
)
+ ;; Fixme: Ignoring errors here looks bogus.
((functionp encoding)
(ignore-errors (funcall encoding (point-min) (point-max))))
(t
- (message "Unknown encoding %s; defaulting to 8bit" encoding))))
+ (error "Unknown encoding %s" encoding))))
(defun mm-encode-buffer (type)
- "Encode the buffer which contains data of TYPE.
+ "Encode the buffer which contains data of MIME type TYPE.
+TYPE is a string or a list of the components.
The encoding used is returned."
(let* ((mime-type (if (stringp type) type (car type)))
(encoding
@@ -119,7 +146,8 @@ The encoding used is returned."
(bits (mm-body-7-or-8)))
;; We force buffers that are 7bit to be unencoded, no matter
;; what the preferred encoding is.
- (when (eq bits '7bit)
+ ;; Only if the buffers don't contain lone lines.
+ (when (and (eq bits '7bit) (not (mm-long-lines-p 76)))
(setq encoding bits))
(mm-encode-content-transfer-encoding encoding mime-type)
encoding))
@@ -154,21 +182,26 @@ The encoding used is returned."
(pop rules)))))
(defun mm-qp-or-base64 ()
- (save-excursion
- (let ((limit (min (point-max) (+ 2000 (point-min))))
- (n8bit 0))
- (goto-char (point-min))
- (skip-chars-forward "\x20-\x7f\r\n\t" limit)
- (while (< (point) limit)
- (incf n8bit)
- (forward-char 1)
- (skip-chars-forward "\x20-\x7f\r\n\t" limit))
- (if (or (< (* 6 n8bit) (- limit (point-min)))
- ;; Don't base64, say, a short line with a single
- ;; non-ASCII char when splitting parts by charset.
- (= n8bit 1))
- 'quoted-printable
- 'base64))))
+ "Return the type with which to encode the buffer.
+This is either `base64' or `quoted-printable'."
+ (if (equal mm-use-ultra-safe-encoding '(sign . "pgp"))
+ ;; perhaps not always accurate?
+ 'quoted-printable
+ (save-excursion
+ (let ((limit (min (point-max) (+ 2000 (point-min))))
+ (n8bit 0))
+ (goto-char (point-min))
+ (skip-chars-forward "\x20-\x7f\r\n\t" limit)
+ (while (< (point) limit)
+ (incf n8bit)
+ (forward-char 1)
+ (skip-chars-forward "\x20-\x7f\r\n\t" limit))
+ (if (or (< (* 6 n8bit) (- limit (point-min)))
+ ;; Don't base64, say, a short line with a single
+ ;; non-ASCII char when splitting parts by charset.
+ (= n8bit 1))
+ 'quoted-printable
+ 'base64)))))
(provide 'mm-encode)
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
new file mode 100644
index 00000000000..994dd1d9c02
--- /dev/null
+++ b/lisp/gnus/mm-extern.el
@@ -0,0 +1,169 @@
+;;; mm-extern.el --- showing message/external-body
+;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: message external-body
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mm-util)
+(require 'mm-decode)
+(require 'mm-url)
+
+(defvar mm-extern-function-alist
+ '((local-file . mm-extern-local-file)
+ (url . mm-extern-url)
+ (anon-ftp . mm-extern-anon-ftp)
+ (ftp . mm-extern-ftp)
+;;; (tftp . mm-extern-tftp)
+ (mail-server . mm-extern-mail-server)
+;;; (afs . mm-extern-afs))
+ ))
+
+(defvar mm-extern-anonymous "anonymous")
+
+(defun mm-extern-local-file (handle)
+ (erase-buffer)
+ (let ((name (cdr (assq 'name (cdr (mm-handle-type handle)))))
+ (coding-system-for-read mm-binary-coding-system))
+ (unless name
+ (error "The filename is not specified"))
+ (mm-disable-multibyte)
+ (if (file-exists-p name)
+ (mm-insert-file-contents name nil nil nil nil t)
+ (error (format "File %s is gone" name)))))
+
+(defun mm-extern-url (handle)
+ (erase-buffer)
+ (let ((url (cdr (assq 'url (cdr (mm-handle-type handle)))))
+ (name buffer-file-name)
+ (coding-system-for-read mm-binary-coding-system))
+ (unless url
+ (error "URL is not specified"))
+ (mm-with-unibyte-current-buffer
+ (mm-url-insert-file-contents url))
+ (mm-disable-multibyte)
+ (setq buffer-file-name name)))
+
+(defun mm-extern-anon-ftp (handle)
+ (erase-buffer)
+ (let* ((params (cdr (mm-handle-type handle)))
+ (name (cdr (assq 'name params)))
+ (site (cdr (assq 'site params)))
+ (directory (cdr (assq 'directory params)))
+ (mode (cdr (assq 'mode params)))
+ (path (concat "/" (or mm-extern-anonymous
+ (read-string (format "ID for %s: " site)))
+ "@" site ":" directory "/" name))
+ (coding-system-for-read mm-binary-coding-system))
+ (unless name
+ (error "The filename is not specified"))
+ (mm-disable-multibyte)
+ (mm-insert-file-contents path nil nil nil nil t)))
+
+(defun mm-extern-ftp (handle)
+ (let (mm-extern-anonymous)
+ (mm-extern-anon-ftp handle)))
+
+(defun mm-extern-mail-server (handle)
+ (require 'message)
+ (let* ((params (cdr (mm-handle-type handle)))
+ (server (cdr (assq 'server params)))
+ (subject (or (cdr (assq 'subject params)) "none"))
+ (buf (current-buffer))
+ info)
+ (if (y-or-n-p (format "Send a request message to %s?" server))
+ (save-window-excursion
+ (message-mail server subject)
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert-buffer-substring buf)
+ (message "Requesting external body...")
+ (message-send-and-exit)
+ (setq info "Request is sent.")
+ (message info))
+ (setq info "Request is not sent."))
+ (goto-char (point-min))
+ (insert "[" info "]\n\n")))
+
+;;;###autoload
+(defun mm-inline-external-body (handle &optional no-display)
+ "Show the external-body part of HANDLE.
+This function replaces the buffer of HANDLE with a buffer contains
+the entire message.
+If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
+ (let* ((access-type (cdr (assq 'access-type
+ (cdr (mm-handle-type handle)))))
+ (func (cdr (assq (intern
+ (downcase
+ (or access-type
+ (error "Couldn't find access type"))))
+ mm-extern-function-alist)))
+ gnus-displaying-mime buf
+ handles)
+ (unless (mm-handle-cache handle)
+ (unless func
+ (error (format "Access type (%s) is not supported" access-type)))
+ (with-temp-buffer
+ (mm-insert-part handle)
+ (goto-char (point-max))
+ (insert "\n\n")
+ (setq handles (mm-dissect-buffer t)))
+ (unless (bufferp (car handles))
+ (mm-destroy-parts handles)
+ (error "Multipart external body is not supported"))
+ (save-excursion ;; single part
+ (set-buffer (setq buf (mm-handle-buffer handles)))
+ (let (good)
+ (unwind-protect
+ (progn
+ (funcall func handle)
+ (setq good t))
+ (unless good
+ (mm-destroy-parts handles))))
+ (mm-handle-set-cache handle handles))
+ (setq gnus-article-mime-handles
+ (mm-merge-handles gnus-article-mime-handles handles)))
+ (unless no-display
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (gnus-display-mime (mm-handle-cache handle))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (condition-case nil
+ ;; This is only valid on XEmacs.
+ (mapcar (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop) (current-buffer)))
+ '(background background-pixmap foreground))
+ (error nil))
+ (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
+
+(provide 'mm-extern)
+
+;;; arch-tag: 9653808e-14d9-4172-86e6-adceaa05378e
+;;; mm-extern.el ends here
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index f424062130b..693e8e9278d 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -1,5 +1,5 @@
;;; mm-partial.el --- showing message/partial
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message partial
@@ -25,8 +25,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
(require 'gnus-sum)
(require 'mm-util)
@@ -43,7 +42,8 @@
(gnus-request-article-this-buffer (aref header 0)
gnus-newsgroup-name)
(when (search-forward id nil t)
- (let ((nhandles (mm-dissect-buffer)) nid)
+ (let ((nhandles (mm-dissect-buffer
+ nil gnus-article-loose-mime)) nid)
(if (consp (car nhandles))
(mm-destroy-parts nhandles)
(setq nid (cdr (assq 'id
@@ -83,10 +83,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(cdr (mm-handle-type b)))))))
(< anumber bnumber)))))
(setq gnus-article-mime-handles
- (append (if (listp (car gnus-article-mime-handles))
- gnus-article-mime-handles
- (list gnus-article-mime-handles))
- phandles))
+ (mm-merge-handles gnus-article-mime-handles phandles))
(save-excursion
(set-buffer (generate-new-buffer " *mm*"))
(while (setq phandle (pop phandles))
@@ -117,6 +114,13 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(if (<= n total)
(error "Missing part %d" n))
(kill-buffer (mm-handle-buffer handle))
+ (goto-char (point-min))
+ (let ((point (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max))))
+ (goto-char (point-min))
+ (unless (re-search-forward "^mime-version:" point t)
+ (insert "MIME-Version: 1.0\n")))
(setcar handle (current-buffer))
(mm-handle-set-cache handle t)))
(unless no-display
@@ -131,11 +135,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(when handles
;; It is in article buffer.
(setq gnus-article-mime-handles
- (nconc (if (listp (car gnus-article-mime-handles))
- gnus-article-mime-handles
- (list gnus-article-mime-handles))
- (if (listp (car handles))
- handles (list handles)))))
+ (mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer
handle
`(lambda ()
@@ -149,5 +149,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(error nil))
(delete-region ,(point-min-marker) ,(point-max-marker))))))))))
+(provide 'mm-partial)
+
;;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d
;;; mm-partial.el ends here
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
new file mode 100644
index 00000000000..1652dbca245
--- /dev/null
+++ b/lisp/gnus/mm-url.el
@@ -0,0 +1,450 @@
+;;; mm-url.el --- a wrapper of url functions/commands for Gnus
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Some codes are stolen from w3 and url packages. Some are moved from
+;; nnweb.
+
+;; TODO: Support POST, cookie.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'mm-util)
+(require 'gnus)
+
+(eval-and-compile
+ (autoload 'executable-find "executable"))
+
+(eval-when-compile
+ (require 'timer))
+
+(defgroup mm-url nil
+ "A wrapper of url package and external url command for Gnus."
+ :group 'gnus)
+
+(defcustom mm-url-use-external (not
+ (condition-case nil
+ (require 'url)
+ (error nil)))
+ "*If non-nil, use external grab program `mm-url-program'."
+ :type 'boolean
+ :group 'mm-url)
+
+(defvar mm-url-predefined-programs
+ '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
+ (w3m "w3m" "-dump_source")
+ (lynx "lynx" "-source")
+ (curl "curl")))
+
+(defcustom mm-url-program
+ (cond
+ ((executable-find "wget") 'wget)
+ ((executable-find "w3m") 'w3m)
+ ((executable-find "lynx") 'lynx)
+ ((executable-find "curl") 'curl)
+ (t "GET"))
+ "The url grab program.
+Likely values are `wget', `w3m', `lynx' and `curl'."
+ :type '(choice
+ (symbol :tag "wget" wget)
+ (symbol :tag "w3m" w3m)
+ (symbol :tag "lynx" lynx)
+ (symbol :tag "curl" curl)
+ (string :tag "other"))
+ :group 'mm-url)
+
+(defcustom mm-url-arguments nil
+ "The arguments for `mm-url-program'."
+ :type '(repeat string)
+ :group 'mm-url)
+
+
+;;; Internal variables
+
+(defvar mm-url-package-name
+ (gnus-replace-in-string
+ (gnus-replace-in-string gnus-version " v.*$" "")
+ " " "-"))
+
+(defvar mm-url-package-version gnus-version-number)
+
+;; Stolen from w3.
+(defvar mm-url-html-entities
+ '(
+ ;;(excl . 33)
+ (quot . 34)
+ ;;(num . 35)
+ ;;(dollar . 36)
+ ;;(percent . 37)
+ (amp . 38)
+ (rsquo . 39) ; should be U+8217
+ ;;(apos . 39)
+ ;;(lpar . 40)
+ ;;(rpar . 41)
+ ;;(ast . 42)
+ ;;(plus . 43)
+ ;;(comma . 44)
+ ;;(period . 46)
+ ;;(colon . 58)
+ ;;(semi . 59)
+ (lt . 60)
+ ;;(equals . 61)
+ (gt . 62)
+ ;;(quest . 63)
+ ;;(commat . 64)
+ ;;(lsqb . 91)
+ ;;(rsqb . 93)
+ (uarr . 94) ; should be U+8593
+ ;;(lowbar . 95)
+ (lsquo . 96) ; should be U+8216
+ (lcub . 123)
+ ;;(verbar . 124)
+ (rcub . 125)
+ (tilde . 126)
+ (nbsp . 160)
+ (iexcl . 161)
+ (cent . 162)
+ (pound . 163)
+ (curren . 164)
+ (yen . 165)
+ (brvbar . 166)
+ (sect . 167)
+ (uml . 168)
+ (copy . 169)
+ (ordf . 170)
+ (laquo . 171)
+ (not . 172)
+ (shy . 173)
+ (reg . 174)
+ (macr . 175)
+ (deg . 176)
+ (plusmn . 177)
+ (sup2 . 178)
+ (sup3 . 179)
+ (acute . 180)
+ (micro . 181)
+ (para . 182)
+ (middot . 183)
+ (cedil . 184)
+ (sup1 . 185)
+ (ordm . 186)
+ (raquo . 187)
+ (frac14 . 188)
+ (frac12 . 189)
+ (frac34 . 190)
+ (iquest . 191)
+ (Agrave . 192)
+ (Aacute . 193)
+ (Acirc . 194)
+ (Atilde . 195)
+ (Auml . 196)
+ (Aring . 197)
+ (AElig . 198)
+ (Ccedil . 199)
+ (Egrave . 200)
+ (Eacute . 201)
+ (Ecirc . 202)
+ (Euml . 203)
+ (Igrave . 204)
+ (Iacute . 205)
+ (Icirc . 206)
+ (Iuml . 207)
+ (ETH . 208)
+ (Ntilde . 209)
+ (Ograve . 210)
+ (Oacute . 211)
+ (Ocirc . 212)
+ (Otilde . 213)
+ (Ouml . 214)
+ (times . 215)
+ (Oslash . 216)
+ (Ugrave . 217)
+ (Uacute . 218)
+ (Ucirc . 219)
+ (Uuml . 220)
+ (Yacute . 221)
+ (THORN . 222)
+ (szlig . 223)
+ (agrave . 224)
+ (aacute . 225)
+ (acirc . 226)
+ (atilde . 227)
+ (auml . 228)
+ (aring . 229)
+ (aelig . 230)
+ (ccedil . 231)
+ (egrave . 232)
+ (eacute . 233)
+ (ecirc . 234)
+ (euml . 235)
+ (igrave . 236)
+ (iacute . 237)
+ (icirc . 238)
+ (iuml . 239)
+ (eth . 240)
+ (ntilde . 241)
+ (ograve . 242)
+ (oacute . 243)
+ (ocirc . 244)
+ (otilde . 245)
+ (ouml . 246)
+ (divide . 247)
+ (oslash . 248)
+ (ugrave . 249)
+ (uacute . 250)
+ (ucirc . 251)
+ (uuml . 252)
+ (yacute . 253)
+ (thorn . 254)
+ (yuml . 255)
+
+ ;; Special handling of these
+ (frac56 . "5/6")
+ (frac16 . "1/6")
+ (frac45 . "4/5")
+ (frac35 . "3/5")
+ (frac25 . "2/5")
+ (frac15 . "1/5")
+ (frac23 . "2/3")
+ (frac13 . "1/3")
+ (frac78 . "7/8")
+ (frac58 . "5/8")
+ (frac38 . "3/8")
+ (frac18 . "1/8")
+
+ ;; The following 5 entities are not mentioned in the HTML 2.0
+ ;; standard, nor in any other HTML proposed standard of which I
+ ;; am aware. I am not even sure they are ISO entity names. ***
+ ;; Hence, some arrangement should be made to give a bad HTML
+ ;; message when they are seen.
+ (ndash . 45)
+ (mdash . 45)
+ (emsp . 32)
+ (ensp . 32)
+ (sim . 126)
+ (le . "<=")
+ (agr . "alpha")
+ (rdquo . "''")
+ (ldquo . "``")
+ (trade . "(TM)")
+ ;; To be done
+ ;; (shy . ????) ; soft hyphen
+ )
+ "*An assoc list of entity names and how to actually display them.")
+
+(defconst mm-url-unreserved-chars
+ '(
+ ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
+ ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
+ ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+ ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
+ "A list of characters that are _NOT_ reserved in the URL spec.
+This is taken from RFC 2396.")
+
+(defun mm-url-load-url ()
+ "Load `url-insert-file-contents'."
+ (unless (condition-case ()
+ (require 'url-handlers)
+ (error nil))
+ ;; w3-4.0pre0.46 or earlier version.
+ (require 'w3-vars)
+ (require 'url)))
+
+;;;###autoload
+(defun mm-url-insert-file-contents (url)
+ "Insert file contents of URL.
+If `mm-url-use-external' is non-nil, use `mm-url-program'."
+ (if mm-url-use-external
+ (progn
+ (if (string-match "^file:/+" url)
+ (insert-file-contents (substring url (1- (match-end 0))))
+ (mm-url-insert-file-contents-external url))
+ (goto-char (point-min))
+ (if (fboundp 'url-generic-parse-url)
+ (setq url-current-object
+ (url-generic-parse-url url)))
+ (list url (buffer-size)))
+ (mm-url-load-url)
+ (let ((name buffer-file-name)
+ (url-request-extra-headers (list (cons "Connection" "Close")))
+ (url-package-name (or mm-url-package-name
+ url-package-name))
+ (url-package-version (or mm-url-package-version
+ url-package-version))
+ result)
+ (setq result (url-insert-file-contents url))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\r 1000\r ?" nil t)
+ (replace-match "")))
+ (setq buffer-file-name name)
+ (if (and (fboundp 'url-generic-parse-url)
+ (listp result))
+ (setq url-current-object (url-generic-parse-url
+ (car result))))
+ result)))
+
+;;;###autoload
+(defun mm-url-insert-file-contents-external (url)
+ "Insert file contents of URL using `mm-url-program'."
+ (let (program args)
+ (if (symbolp mm-url-program)
+ (let ((item (cdr (assq mm-url-program mm-url-predefined-programs))))
+ (setq program (car item)
+ args (append (cdr item) (list url))))
+ (setq program mm-url-program
+ args (append mm-url-arguments (list url))))
+ (unless (eq 0 (apply 'call-process program nil t nil args))
+ (error "Couldn't fetch %s" url))))
+
+(defvar mm-url-timeout 30
+ "The number of seconds before timing out an URL fetch.")
+
+(defvar mm-url-retries 10
+ "The number of retries after timing out when fetching an URL.")
+
+(defun mm-url-insert (url &optional follow-refresh)
+ "Insert the contents from an URL in the current buffer.
+If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
+ (let ((times mm-url-retries)
+ (done nil)
+ (first t)
+ result)
+ (while (and (not (zerop (decf times)))
+ (not done))
+ (with-timeout (mm-url-timeout)
+ (unless first
+ (message "Trying again (%s)..." (- mm-url-retries times)))
+ (setq first nil)
+ (if follow-refresh
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-url-insert-file-contents url)
+ (goto-char (point-min))
+ (when (re-search-forward
+ "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
+ (let ((url (match-string 1)))
+ (delete-region (point-min) (point-max))
+ (setq result (mm-url-insert url t)))))
+ (setq result (mm-url-insert-file-contents url)))
+ (setq done t)))
+ result))
+
+(defun mm-url-decode-entities ()
+ "Decode all HTML entities."
+ (goto-char (point-min))
+ (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
+ (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
+ (let ((c
+ (string-to-number (substring
+ (match-string 1) 1))))
+ (if (mm-char-or-char-int-p c) c 32))
+ (or (cdr (assq (intern (match-string 1))
+ mm-url-html-entities))
+ ?#))))
+ (unless (stringp elem)
+ (setq elem (char-to-string elem)))
+ (replace-match elem t t))))
+
+(defun mm-url-decode-entities-nbsp ()
+ "Decode all HTML entities and &nbsp; to a space."
+ (let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities)))
+ (mm-url-decode-entities)))
+
+(defun mm-url-decode-entities-string (string)
+ (with-temp-buffer
+ (insert string)
+ (mm-url-decode-entities)
+ (buffer-string)))
+
+(defun mm-url-form-encode-xwfu (chunk)
+ "Escape characters in a string for application/x-www-form-urlencoded.
+Blasphemous crap because someone didn't think %20 was good enough for encoding
+spaces. Die Die Die."
+ ;; This will get rid of the 'attributes' specified by the file type,
+ ;; which are useless for an application/x-www-form-urlencoded form.
+ (if (consp chunk)
+ (setq chunk (cdr chunk)))
+
+ (mapconcat
+ (lambda (char)
+ (cond
+ ((= char ? ) "+")
+ ((memq char mm-url-unreserved-chars) (char-to-string char))
+ (t (upcase (format "%%%02x" char)))))
+ ;; Fixme: Should this actually be accepting multibyte? Is there a
+ ;; better way in XEmacs?
+ (if (featurep 'mule)
+ (encode-coding-string chunk
+ (if (fboundp 'find-coding-systems-string)
+ (car (find-coding-systems-string chunk))
+ buffer-file-coding-system))
+ chunk)
+ ""))
+
+(defun mm-url-encode-www-form-urlencoded (pairs)
+ "Return PAIRS encoded for forms."
+ (mapconcat
+ (lambda (data)
+ (concat (mm-url-form-encode-xwfu (car data)) "="
+ (mm-url-form-encode-xwfu (cdr data))))
+ pairs "&"))
+
+(defun mm-url-fetch-form (url pairs)
+ "Fetch a form from URL with PAIRS as the data using the POST method."
+ (mm-url-load-url)
+ (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs))
+ (url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-type" . "application/x-www-form-urlencoded"))))
+ (url-insert-file-contents url)
+ (setq buffer-file-name nil))
+ t)
+
+(defun mm-url-fetch-simple (url content)
+ (mm-url-load-url)
+ (let ((url-request-data content)
+ (url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-type" . "application/x-www-form-urlencoded"))))
+ (url-insert-file-contents url)
+ (setq buffer-file-name nil))
+ t)
+
+(defun mm-url-remove-markup ()
+ "Remove all HTML markup, leaving just plain text."
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (delete-region (match-beginning 0)
+ (or (search-forward "-->" nil t)
+ (point-max))))
+ (goto-char (point-min))
+ (while (re-search-forward "<[^>]+>" nil t)
+ (replace-match "" t t)))
+
+(provide 'mm-url)
+
+;;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f
+;;; mm-url.el ends here
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 435deaaa875..6cb01ee2f44 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -1,5 +1,6 @@
;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -24,9 +25,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl)
- (defvar mm-mime-mule-charset-alist))
+(eval-when-compile (require 'cl))
(require 'mail-prsvr)
(eval-and-compile
@@ -42,7 +41,6 @@
(coding-system-list . ignore)
(decode-coding-region . ignore)
(char-int . identity)
- (device-type . ignore)
(coding-system-equal . equal)
(annotationp . ignore)
(set-buffer-file-coding-system . ignore)
@@ -71,10 +69,19 @@
(setq idx (1+ idx)))
string)))
(string-as-unibyte . identity)
+ (string-make-unibyte . identity)
(string-as-multibyte . identity)
(multibyte-string-p . ignore)
- (point-at-bol . line-beginning-position)
- (point-at-eol . line-end-position)
+ ;; It is not a MIME function, but some MIME functions use it.
+ (make-temp-file . (lambda (prefix &optional dir-flag)
+ (let ((file (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))
+ (if dir-flag
+ (make-directory file))
+ file)))
(insert-byte . insert-char)
(multibyte-char-to-unibyte . identity))))
@@ -85,6 +92,14 @@
((fboundp 'char-valid-p) 'char-valid-p)
(t 'identity))))
+;; Fixme: This seems always to be used to read a MIME charset, so it
+;; should be re-named and fixed (in Emacs) to offer completion only on
+;; proper charset names (base coding systems which have a
+;; mime-charset defined). XEmacs doesn't believe in mime-charset;
+;; test with
+;; `(or (coding-system-get 'iso-8859-1 'mime-charset)
+;; (coding-system-get 'iso-8859-1 :mime-charset))'
+;; Actually, there should be an `mm-coding-system-mime-charset'.
(eval-and-compile
(defalias 'mm-read-coding-system
(cond
@@ -106,10 +121,15 @@
(or mm-coding-system-list
(setq mm-coding-system-list (mm-coding-system-list))))
-(defun mm-coding-system-p (sym)
- "Return non-nil if SYM is a coding system."
- (or (and (fboundp 'coding-system-p) (coding-system-p sym))
- (memq sym (mm-get-coding-system-list))))
+(defun mm-coding-system-p (cs)
+ "Return non-nil if CS is a symbol naming a coding system.
+In XEmacs, also return non-nil if CS is a coding system object."
+ (if (fboundp 'find-coding-system)
+ (find-coding-system cs)
+ (if (fboundp 'coding-system-p)
+ (coding-system-p cs)
+ ;; Is this branch ever actually useful?
+ (memq cs (mm-get-coding-system-list)))))
(defvar mm-charset-synonym-alist
`(
@@ -122,10 +142,12 @@
;; Apparently not defined in Emacs 20, but is a valid MIME name.
,@(unless (mm-coding-system-p 'gb2312)
'((gb2312 . cn-gb-2312)))
- ;; ISO-8859-15 is very similar to ISO-8859-1.
- ;; But this is just wrong. --fx
- ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
+ ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
+ ,@(unless (mm-coding-system-p 'iso-8859-15)
'((iso-8859-15 . iso-8859-1)))
+ ;; BIG-5HKSCS is similar to, but different than, BIG-5.
+ ,@(unless (mm-coding-system-p 'big5-hkscs)
+ '((big5-hkscs . big5)))
;; Windows-1252 is actually a superset of Latin-1. See also
;; `gnus-article-dumbquotes-map'.
,@(unless (mm-coding-system-p 'windows-1252)
@@ -135,10 +157,6 @@
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
;; Outlook users in Czech republic. Use this to allow reading of their
;; e-mails. cp1250 should be defined by M-x codepage-setup.
-
- ;; This is not TRT, the MIME name, windows-1250, should be an
- ;; alias, and cp1250 should have a mime-charset property, per
- ;; code-page.el. -- fx
,@(if (and (not (mm-coding-system-p 'windows-1250))
(mm-coding-system-p 'cp1250))
'((windows-1250 . cp1250)))
@@ -164,7 +182,7 @@
(defvar mm-auto-save-coding-system
(cond
- ((mm-coding-system-p 'utf-8-emacs)
+ ((mm-coding-system-p 'utf-8-emacs) ; Mule 7
(if (memq system-type '(windows-nt ms-dos ms-windows))
(if (mm-coding-system-p 'utf-8-emacs-dos)
'utf-8-emacs-dos mm-binary-coding-system)
@@ -286,23 +304,29 @@ Valid elements include:
mm-iso-8859-15-compatible))
"A table of the difference character between ISO-8859-X and ISO-8859-15.")
-(defvar mm-coding-system-priorities nil
- "Preferred coding systems for encoding outgoing mails.
-
-More than one suitable coding systems may be found for some texts. By
-default, a coding system with the highest priority is used to encode
-outgoing mails (see `sort-coding-systems'). If this variable is set,
-it overrides the default priority. For example, Japanese users may
-prefer iso-2022-jp to japanese-shift-jis:
-
-\(setq mm-coding-system-priorities
- '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
-")
-
-;; Why on earth was this broken out? -- fx
+(defcustom mm-coding-system-priorities
+ (if (boundp 'current-language-environment)
+ (let ((lang (symbol-value 'current-language-environment)))
+ (cond ((string= lang "Japanese")
+ ;; Japanese users may prefer iso-2022-jp to shift-jis.
+ '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
+ iso-latin-1 utf-8)))))
+ "Preferred coding systems for encoding outgoing messages.
+
+More than one suitable coding system may be found for some text.
+By default, the coding system with the highest priority is used
+to encode outgoing messages (see `sort-coding-systems'). If this
+variable is set, it overrides the default priority."
+ :type '(repeat (symbol :tag "Coding system"))
+ :group 'mime)
+
+;; ??
(defvar mm-use-find-coding-systems-region
(fboundp 'find-coding-systems-region)
- "Use `find-coding-systems-region' to find proper coding systems.")
+ "Use `find-coding-systems-region' to find proper coding systems.
+
+Setting it to nil is useful on Emacsen supporting Unicode if sending
+mail with multiple parts is preferred to sending a Unicode one.")
;;; Internal variables:
@@ -310,9 +334,12 @@ prefer iso-2022-jp to japanese-shift-jis:
(defun mm-mule-charset-to-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
- (if (fboundp 'find-coding-systems-for-charsets)
+ (if (and (fboundp 'find-coding-systems-for-charsets)
+ (fboundp 'sort-coding-systems))
(let (mime)
- (dolist (cs (find-coding-systems-for-charsets (list charset)))
+ (dolist (cs (sort-coding-systems
+ (copy-sequence
+ (find-coding-systems-for-charsets (list charset)))))
(unless mime
(when cs
(setq mime (or (coding-system-get cs :mime-charset)
@@ -340,7 +367,8 @@ used as the line break code type of the coding system."
((null charset)
charset)
;; Running in a non-MULE environment.
- ((null (mm-get-coding-system-list))
+ ((or (null (mm-get-coding-system-list))
+ (not (fboundp 'coding-system-get)))
charset)
;; ascii
((eq charset 'us-ascii)
@@ -356,7 +384,7 @@ used as the line break code type of the coding system."
charset)
;; Translate invalid charsets.
((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
- (and cs (mm-coding-system-p charset) cs)))
+ (and cs (mm-coding-system-p cs) cs)))
;; Last resort: search the coding system list for entries which
;; have the right mime-charset in case the canonical name isn't
;; defined (though it should be).
@@ -385,7 +413,7 @@ used as the line break code type of the coding system."
"Set the multibyte flag of the current buffer.
Only do this if the default value of `enable-multibyte-characters' is
non-nil. This is a no-op in XEmacs."
- (set-buffer-multibyte t))
+ (set-buffer-multibyte 'to))
(defalias 'mm-enable-multibyte 'ignore))
(if mm-emacs-mule
@@ -400,6 +428,27 @@ This is a no-op in XEmacs."
(or (get-charset-property charset 'preferred-coding-system)
(get-charset-property charset 'prefered-coding-system)))
+;; Mule charsets shouldn't be used.
+(defsubst mm-guess-charset ()
+ "Guess Mule charset from the language environment."
+ (or
+ mail-parse-mule-charset ;; cached mule-charset
+ (progn
+ (setq mail-parse-mule-charset
+ (and (boundp 'current-language-environment)
+ (car (last
+ (assq 'charset
+ (assoc current-language-environment
+ language-info-alist))))))
+ (if (or (not mail-parse-mule-charset)
+ (eq mail-parse-mule-charset 'ascii))
+ (setq mail-parse-mule-charset
+ (or (car (last (assq mail-parse-charset
+ mm-mime-mule-charset-alist)))
+ ;; default
+ 'latin-iso8859-1)))
+ mail-parse-mule-charset)))
+
(defun mm-charset-after (&optional pos)
"Return charset of a character in current buffer at position POS.
If POS is nil, it defauls to the current point.
@@ -416,23 +465,7 @@ If the charset is `composition', return the actual one."
(if (and charset (not (memq charset '(ascii eight-bit-control
eight-bit-graphic))))
charset
- (or
- mail-parse-mule-charset ;; cached mule-charset
- (progn
- (setq mail-parse-mule-charset
- (and (boundp 'current-language-environment)
- (car (last
- (assq 'charset
- (assoc current-language-environment
- language-info-alist))))))
- (if (or (not mail-parse-mule-charset)
- (eq mail-parse-mule-charset 'ascii))
- (setq mail-parse-mule-charset
- (or (car (last (assq mail-parse-charset
- mm-mime-mule-charset-alist)))
- ;; Fixme: don't fix that!
- 'latin-iso8859-1)))
- mail-parse-mule-charset)))))))
+ (mm-guess-charset))))))
(defun mm-mime-charset (charset)
"Return the MIME charset corresponding to the given Mule CHARSET."
@@ -462,14 +495,23 @@ If the charset is `composition', return the actual one."
(setq result (cons head result)))
(nreverse result)))
-;; It's not clear whether this is supposed to mean the global or local
-;; setting. I think it's used inconsistently. -- fx
-(defsubst mm-multibyte-p ()
- "Say whether multibyte is enabled."
+;; Fixme: This is used in places when it should be testing the
+;; default multibyteness. See mm-default-multibyte-p.
+(eval-and-compile
(if (and (not (featurep 'xemacs))
(boundp 'enable-multibyte-characters))
- enable-multibyte-characters
- (featurep 'mule)))
+ (defun mm-multibyte-p ()
+ "Non-nil if multibyte is enabled in the current buffer."
+ enable-multibyte-characters)
+ (defun mm-multibyte-p () (featurep 'mule))))
+
+(defun mm-default-multibyte-p ()
+ "Return non-nil if the session is multibyte.
+This affects whether coding conversion should be attempted generally."
+ (if (featurep 'mule)
+ (if (boundp 'default-enable-multibyte-characters)
+ default-enable-multibyte-characters
+ t)))
(defun mm-iso-8859-x-to-15-region (&optional b e)
(if (fboundp 'char-charset)
@@ -487,13 +529,20 @@ If the charset is `composition', return the actual one."
(setq inconvertible t)
(forward-char))
(t
- (insert (prog1 (+ c (car (cdr item))) (delete-char 1))))
- (skip-chars-forward "\0-\177"))))
+ (insert-before-markers (prog1 (+ c (car (cdr item)))
+ (delete-char 1)))))
+ (skip-chars-forward "\0-\177")))
(not inconvertible))))
(defun mm-sort-coding-systems-predicate (a b)
- (> (length (memq a mm-coding-system-priorities))
- (length (memq b mm-coding-system-priorities))))
+ (let ((priorities
+ (mapcar (lambda (cs)
+ ;; Note: invalid entries are dropped silently
+ (and (coding-system-p cs)
+ (coding-system-base cs)))
+ mm-coding-system-priorities)))
+ (> (length (memq a priorities))
+ (length (memq b priorities)))))
(defun mm-find-mime-charset-region (b e &optional hack-charsets)
"Return the MIME charsets needed to encode the region between B and E.
@@ -509,26 +558,42 @@ charset, and a longer list means no appropriate charset."
(when mm-coding-system-priorities
(setq systems
(sort systems 'mm-sort-coding-systems-predicate)))
- ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
- ;; is not in the IANA list.
(setq systems (delq 'compound-text systems))
(unless (equal systems '(undecided))
(while systems
(let* ((head (pop systems))
(cs (or (coding-system-get head :mime-charset)
(coding-system-get head 'mime-charset))))
- (if cs
+ ;; The mime-charset (`x-ctext') of
+ ;; `compound-text' is not in the IANA list. We
+ ;; shouldn't normally use anything here with a
+ ;; mime-charset having an `x-' prefix.
+ ;; Fixme: Allow this to be overridden, since
+ ;; there is existing use of x-ctext.
+ ;; Also people apparently need the coding system
+ ;; `iso-2022-jp-3' (which Mule-UCS defines with
+ ;; mime-charset, though it's not valid).
+ (if (and cs
+ (not (string-match "^[Xx]-" (symbol-name cs)))
+ ;; UTF-16 of any variety is invalid for
+ ;; text parts and, unfortunately, has
+ ;; mime-charset defined both in Mule-UCS
+ ;; and versions of Emacs. (The name
+ ;; might be `mule-utf-16...' or
+ ;; `utf-16...'.)
+ (not (string-match "utf-16" (symbol-name cs))))
(setq systems nil
charsets (list cs))))))
charsets))
- ;; Otherwise we're not multibyte, XEmacs or a single coding
- ;; system won't cover it.
+ ;; Otherwise we're not multibyte, we're XEmacs, or a single
+ ;; coding system won't cover it.
(setq charsets
(mm-delete-duplicates
(mapcar 'mm-mime-charset
(delq 'ascii
(mm-find-charset-region b e))))))
- (if (and (memq 'iso-8859-15 charsets)
+ (if (and (> (length charsets) 1)
+ (memq 'iso-8859-15 charsets)
(memq 'iso-8859-15 hack-charsets)
(save-excursion (mm-iso-8859-x-to-15-region b e)))
(mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
@@ -546,6 +611,14 @@ Use unibyte mode for this."
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
+(defmacro mm-with-multibyte-buffer (&rest forms)
+ "Create a temporary buffer, and evaluate FORMS there like `progn'.
+Use multibyte mode for this."
+ `(let ((default-enable-multibyte-characters t))
+ (with-temp-buffer ,@forms)))
+(put 'mm-with-multibyte-buffer 'lisp-indent-function 0)
+(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body))
+
(defmacro mm-with-unibyte-current-buffer (&rest forms)
"Evaluate FORMS with current buffer temporarily made unibyte.
Also bind `default-enable-multibyte-characters' to nil.
@@ -567,12 +640,19 @@ Equivalent to `progn' in XEmacs"
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
(defmacro mm-with-unibyte (&rest forms)
- "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."
+ "Eval the FORMS with the default value of `enable-multibyte-characters' nil."
`(let (default-enable-multibyte-characters)
,@forms))
(put 'mm-with-unibyte 'lisp-indent-function 0)
(put 'mm-with-unibyte 'edebug-form-spec '(body))
+(defmacro mm-with-multibyte (&rest forms)
+ "Eval the FORMS with the default value of `enable-multibyte-characters' t."
+ `(let ((default-enable-multibyte-characters t))
+ ,@forms))
+(put 'mm-with-multibyte 'lisp-indent-function 0)
+(put 'mm-with-multibyte 'edebug-form-spec '(body))
+
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
(cond
@@ -638,10 +718,10 @@ Equivalent to `progn' in XEmacs"
(defun mm-insert-file-contents (filename &optional visit beg end replace
inhibit)
- "Like `insert-file-contents', q.v., but only reads in the file.
+ "Like `insert-file-contents', but only reads in the file.
A buffer may be modified in several ways after reading into the buffer due
to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
+`find-file-hooks', etc.
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
This function ensures that none of these modifications will take place."
(let ((format-alist nil)
@@ -668,7 +748,7 @@ START, END and FILENAME. START and END are buffer positions
saying what text to write.
Optional fourth argument specifies the coding system to use when
encoding the file.
-If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
(let ((coding-system-for-write
(or codesys mm-text-coding-system-for-write
mm-text-coding-system))
@@ -680,13 +760,14 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
(append mm-inhibit-file-name-handlers
inhibit-file-name-handlers)
inhibit-file-name-handlers)))
- (append-to-file start end filename)))
+ (write-region start end filename t 'no-message)
+ (message "Appended to %s" filename)))
(defun mm-write-region (start end filename &optional append visit lockname
coding-system inhibit)
"Like `write-region'.
-If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
(let ((coding-system-for-write
(or coding-system mm-text-coding-system-for-write
mm-text-coding-system))
@@ -710,19 +791,32 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
(push dir result))
(push path result))))
-;; It is not a MIME function, but some MIME functions use it.
-(defalias 'mm-make-temp-file
- (if (fboundp 'make-temp-file)
- 'make-temp-file
- (lambda (prefix &optional dir-flag)
- (let ((file (expand-file-name
- (make-temp-name prefix)
- (if (fboundp 'temp-directory)
- (temp-directory)
- temporary-file-directory))))
- (if dir-flag
- (make-directory file))
- file))))
+;; Fixme: This doesn't look useful where it's used.
+(if (fboundp 'detect-coding-region)
+ (defun mm-detect-coding-region (start end)
+ "Like `detect-coding-region' except returning the best one."
+ (let ((coding-systems
+ (detect-coding-region (point) (point-max))))
+ (or (car-safe coding-systems)
+ coding-systems)))
+ (defun mm-detect-coding-region (start end)
+ (let ((point (point)))
+ (goto-char start)
+ (skip-chars-forward "\0-\177" end)
+ (prog1
+ (if (eq (point) end) 'ascii (mm-guess-charset))
+ (goto-char point)))))
+
+(if (fboundp 'coding-system-get)
+ (defun mm-detect-mime-charset-region (start end)
+ "Detect MIME charset of the text in the region between START and END."
+ (let ((cs (mm-detect-coding-region start end)))
+ (coding-system-get cs 'mime-charset)))
+ (defun mm-detect-mime-charset-region (start end)
+ "Detect MIME charset of the text in the region between START and END."
+ (let ((cs (mm-detect-coding-region start end)))
+ cs)))
+
(provide 'mm-util)
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 671f9550525..17fa59311db 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -1,8 +1,8 @@
-;;; mm-uu.el --- return uu stuff as mm handles
-;; Copyright (c) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;;; mm-uu.el --- Return uu stuff as mm handles
+;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: postscript uudecode binhex shar forward news
+;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
;; This file is part of GNU Emacs.
@@ -30,194 +30,462 @@
(require 'nnheader)
(require 'mm-decode)
(require 'mailcap)
-(require 'uudecode)
-(require 'binhex)
+(require 'mml2015)
-(defun mm-uu-copy-to-buffer (from to)
- "Copy the contents of the current buffer to a fresh buffer.
-Return that buffer."
- (save-excursion
- (let ((obuf (current-buffer)))
- (set-buffer (generate-new-buffer " *mm-uu*"))
- (insert-buffer-substring obuf from to)
- (current-buffer))))
-
-;;; postscript
+(autoload 'uudecode-decode-region "uudecode")
+(autoload 'uudecode-decode-region-external "uudecode")
+(autoload 'uudecode-decode-region-internal "uudecode")
-(defconst mm-uu-postscript-begin-line "^%!PS-")
-(defconst mm-uu-postscript-end-line "^%%EOF$")
+(autoload 'binhex-decode-region "binhex")
+(autoload 'binhex-decode-region-external "binhex")
+(autoload 'binhex-decode-region-internal "binhex")
-(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")
-(defconst mm-uu-uu-end-line "^end[ \t]*$")
+(autoload 'yenc-decode-region "yenc")
+(autoload 'yenc-extract-filename "yenc")
-;; This is not the right place for this. uudecode.el should decide
-;; whether or not to use a program with a single interface, but I
-;; guess it's too late now. Also the default should depend on a test
-;; for the program. -- fx
(defcustom mm-uu-decode-function 'uudecode-decode-region
"*Function to uudecode.
Internal function is done in Lisp by default, therefore decoding may
appear to be horribly slow. You can make Gnus use an external
decoder, such as uudecode."
:type '(choice
- (function-item :tag "Internal" uudecode-decode-region)
+ (function-item :tag "Auto detect" uudecode-decode-region)
+ (function-item :tag "Internal" uudecode-decode-region-internal)
(function-item :tag "External" uudecode-decode-region-external))
:group 'gnus-article-mime)
-(defconst mm-uu-binhex-begin-line
- "^:...............................................................$")
-(defconst mm-uu-binhex-end-line ":$")
-
(defcustom mm-uu-binhex-decode-function 'binhex-decode-region
"*Function to binhex decode.
-Internal function is done in Lisp by default, therefore decoding may
-appear to be horribly slow. You can make Gnus use an external
+Internal function is done in elisp by default, therefore decoding may
+appear to be horribly slow . You can make Gnus use the external Unix
decoder, such as hexbin."
- :type '(choice
- (function-item :tag "Internal" binhex-decode-region)
- (function-item :tag "External" binhex-decode-region-external))
+ :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
+ (function-item :tag "Internal" binhex-decode-region-internal)
+ (function-item :tag "External" binhex-decode-region-external))
:group 'gnus-article-mime)
-(defconst mm-uu-shar-begin-line "^#! */bin/sh")
-(defconst mm-uu-shar-end-line "^exit 0\\|^$")
+(defvar mm-uu-yenc-decode-function 'yenc-decode-region)
-;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
-;;; Peter von der Ah\'e <pahe@daimi.au.dk>
-(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
-(defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")
+(defvar mm-uu-pgp-beginning-signature
+ "^-----BEGIN PGP SIGNATURE-----")
-(defvar mm-uu-begin-line nil)
-
-(defconst mm-uu-identifier-alist
- '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
- (?- . forward)))
+(defvar mm-uu-beginning-regexp nil)
(defvar mm-dissect-disposition "inline"
"The default disposition of uu parts.
This can be either \"inline\" or \"attachment\".")
+(defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources"
+ "The regexp of Emacs sources groups.")
+
+(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
+ "*Regexp matching diff groups."
+ :type 'regexp
+ :group 'gnus-article-mime)
+
+(defvar mm-uu-type-alist
+ '((postscript
+ "^%!PS-"
+ "^%%EOF$"
+ mm-uu-postscript-extract
+ nil)
+ (uu
+ "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
+ "^end[ \t]*$"
+ mm-uu-uu-extract
+ mm-uu-uu-filename)
+ (binhex
+ "^:...............................................................$"
+ ":$"
+ mm-uu-binhex-extract
+ nil
+ mm-uu-binhex-filename)
+ (yenc
+ "^=ybegin.*size=[0-9]+.*name=.*$"
+ "^=yend.*size=[0-9]+"
+ mm-uu-yenc-extract
+ mm-uu-yenc-filename)
+ (shar
+ "^#! */bin/sh"
+ "^exit 0$"
+ mm-uu-shar-extract)
+ (forward
+;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
+;;; Peter von der Ah\'e <pahe@daimi.au.dk>
+ "^-+ \\(Start of \\)?Forwarded message"
+ "^-+ End \\(of \\)?forwarded message"
+ mm-uu-forward-extract
+ nil
+ mm-uu-forward-test)
+ (gnatsweb
+ "^----gnatsweb-attachment----"
+ nil
+ mm-uu-gnatsweb-extract)
+ (pgp-signed
+ "^-----BEGIN PGP SIGNED MESSAGE-----"
+ "^-----END PGP SIGNATURE-----"
+ mm-uu-pgp-signed-extract
+ nil
+ nil)
+ (pgp-encrypted
+ "^-----BEGIN PGP MESSAGE-----"
+ "^-----END PGP MESSAGE-----"
+ mm-uu-pgp-encrypted-extract
+ nil
+ nil)
+ (pgp-key
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
+ "^-----END PGP PUBLIC KEY BLOCK-----"
+ mm-uu-pgp-key-extract
+ mm-uu-gpg-key-skip-to-last
+ nil)
+ (emacs-sources
+ "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
+ "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
+ mm-uu-emacs-sources-extract
+ nil
+ mm-uu-emacs-sources-test)
+ (diff
+ "^Index: "
+ nil
+ mm-uu-diff-extract
+ nil
+ mm-uu-diff-test)))
+
+(defcustom mm-uu-configure-list '((shar . disabled))
+ "A list of mm-uu configuration.
+To disable dissecting shar codes, for instance, add
+`(shar . disabled)' to this list."
+ :type 'alist
+ :options (mapcar (lambda (entry)
+ (list (car entry) '(const disabled)))
+ mm-uu-type-alist)
+ :group 'gnus-article-mime)
+
+;; functions
+
+(defsubst mm-uu-type (entry)
+ (car entry))
+
+(defsubst mm-uu-beginning-regexp (entry)
+ (nth 1 entry))
+
+(defsubst mm-uu-end-regexp (entry)
+ (nth 2 entry))
+
+(defsubst mm-uu-function-extract (entry)
+ (nth 3 entry))
+
+(defsubst mm-uu-function-1 (entry)
+ (nth 4 entry))
+
+(defsubst mm-uu-function-2 (entry)
+ (nth 5 entry))
+
+(defun mm-uu-copy-to-buffer (&optional from to)
+ "Copy the contents of the current buffer to a fresh buffer.
+Return that buffer."
+ (save-excursion
+ (let ((obuf (current-buffer))
+ (coding-system
+ ;; Might not exist in non-MULE XEmacs
+ (when (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (set-buffer (generate-new-buffer " *mm-uu*"))
+ (setq buffer-file-coding-system coding-system)
+ (insert-buffer-substring obuf from to)
+ (current-buffer))))
+
(defun mm-uu-configure-p (key val)
(member (cons key val) mm-uu-configure-list))
(defun mm-uu-configure (&optional symbol value)
(if symbol (set-default symbol value))
- (setq mm-uu-begin-line nil)
- (mapcar (lambda (type)
- (if (mm-uu-configure-p type 'disabled)
- nil
- (setq mm-uu-begin-line
- (concat mm-uu-begin-line
- (if mm-uu-begin-line "\\|")
- (symbol-value
- (intern (concat "mm-uu-" (symbol-name type)
- "-begin-line")))))))
- '(uu postscript binhex shar forward)))
-
-;; Needs to come after mm-uu-configure.
-(defcustom mm-uu-configure-list nil
- "Alist of mm-uu configurations to disable.
-To disable dissecting shar codes, for instance, add
-`(shar . disabled)' to this list."
- :type '(repeat (choice (const :tag "postscript" (postscript . disabled))
- (const :tag "uu" (uu . disabled))
- (const :tag "binhex" (binhex . disabled))
- (const :tag "shar" (shar . disabled))
- (const :tag "forward" (forward . disabled))))
- :group 'gnus-article-mime
- :set 'mm-uu-configure)
+ (setq mm-uu-beginning-regexp nil)
+ (mapcar (lambda (entry)
+ (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
+ nil
+ (setq mm-uu-beginning-regexp
+ (concat mm-uu-beginning-regexp
+ (if mm-uu-beginning-regexp "\\|")
+ (mm-uu-beginning-regexp entry)))))
+ mm-uu-type-alist))
(mm-uu-configure)
+(eval-when-compile
+ (defvar file-name)
+ (defvar start-point)
+ (defvar end-point)
+ (defvar entry))
+
+(defun mm-uu-uu-filename ()
+ (if (looking-at ".+")
+ (setq file-name
+ (let ((nnheader-file-name-translation-alist
+ '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_))))
+ (nnheader-translate-file-chars (match-string 0))))))
+
+(defun mm-uu-binhex-filename ()
+ (setq file-name
+ (ignore-errors
+ (binhex-decode-region start-point end-point t))))
+
+(defun mm-uu-yenc-filename ()
+ (goto-char start-point)
+ (setq file-name
+ (ignore-errors
+ (yenc-extract-filename))))
+
+(defun mm-uu-forward-test ()
+ (save-excursion
+ (goto-char start-point)
+ (forward-line)
+ (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
+
+(defun mm-uu-postscript-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ '("application/postscript")))
+
+(defun mm-uu-emacs-sources-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ '("application/emacs-lisp")
+ nil nil
+ (list mm-dissect-disposition
+ (cons 'filename file-name))))
+
+(eval-when-compile
+ (defvar gnus-newsgroup-name))
+
+(defun mm-uu-emacs-sources-test ()
+ (setq file-name (match-string 1))
+ (and gnus-newsgroup-name
+ mm-uu-emacs-sources-regexp
+ (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
+
+(defun mm-uu-diff-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ '("text/x-patch")))
+
+(defun mm-uu-diff-test ()
+ (and gnus-newsgroup-name
+ mm-uu-diff-groups-regexp
+ (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
+
+(defun mm-uu-forward-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer
+ (progn (goto-char start-point) (forward-line) (point))
+ (progn (goto-char end-point) (forward-line -1) (point)))
+ '("message/rfc822" (charset . gnus-decoded))))
+
+(defun mm-uu-uu-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ (list (or (and file-name
+ (string-match "\\.[^\\.]+$"
+ file-name)
+ (mailcap-extension-to-mime
+ (match-string 0 file-name)))
+ "application/octet-stream"))
+ 'x-uuencode nil
+ (if (and file-name (not (equal file-name "")))
+ (list mm-dissect-disposition
+ (cons 'filename file-name)))))
+
+(defun mm-uu-binhex-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ (list (or (and file-name
+ (string-match "\\.[^\\.]+$" file-name)
+ (mailcap-extension-to-mime
+ (match-string 0 file-name)))
+ "application/octet-stream"))
+ 'x-binhex nil
+ (if (and file-name (not (equal file-name "")))
+ (list mm-dissect-disposition
+ (cons 'filename file-name)))))
+
+(defun mm-uu-yenc-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ (list (or (and file-name
+ (string-match "\\.[^\\.]+$" file-name)
+ (mailcap-extension-to-mime
+ (match-string 0 file-name)))
+ "application/octet-stream"))
+ 'x-yenc nil
+ (if (and file-name (not (equal file-name "")))
+ (list mm-dissect-disposition
+ (cons 'filename file-name)))))
+
+
+(defun mm-uu-shar-extract ()
+ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+ '("application/x-shar")))
+
+(defun mm-uu-gnatsweb-extract ()
+ (save-restriction
+ (goto-char start-point)
+ (forward-line)
+ (narrow-to-region (point) end-point)
+ (mm-dissect-buffer t)))
+
+(defun mm-uu-pgp-signed-test (&rest rest)
+ (and
+ mml2015-use
+ (mml2015-clear-verify-function)
+ (cond
+ ((eq mm-verify-option 'never) nil)
+ ((eq mm-verify-option 'always) t)
+ ((eq mm-verify-option 'known) t)
+ (t (y-or-n-p "Verify pgp signed part? ")))))
+
+(eval-when-compile
+ (defvar gnus-newsgroup-charset))
+
+(defun mm-uu-pgp-signed-extract-1 (handles ctl)
+ (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
+ (with-current-buffer buf
+ (if (mm-uu-pgp-signed-test)
+ (progn
+ (mml2015-clean-buffer)
+ (let ((coding-system-for-write (or gnus-newsgroup-charset
+ 'iso-8859-1)))
+ (funcall (mml2015-clear-verify-function))))
+ (when (and mml2015-use (null (mml2015-clear-verify-function)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Clear verification not supported by `%s'.\n" mml2015-use))))
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-region (point-min) (point)))
+ (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
+ (delete-region (match-beginning 0) (point-max)))
+ (goto-char (point-min))
+ (while (re-search-forward "^- " nil t)
+ (replace-match "" t t)
+ (forward-line 1)))
+ (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded))))))
+
+(defun mm-uu-pgp-signed-extract ()
+ (let ((mm-security-handle (list (format "multipart/signed"))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'protocol "application/x-gnus-pgp-signature")
+ (save-restriction
+ (narrow-to-region start-point end-point)
+ (add-text-properties 0 (length (car mm-security-handle))
+ (list 'buffer (mm-uu-copy-to-buffer))
+ (car mm-security-handle))
+ (setcdr mm-security-handle
+ (mm-uu-pgp-signed-extract-1 nil
+ mm-security-handle)))
+ mm-security-handle))
+
+(defun mm-uu-pgp-encrypted-test (&rest rest)
+ (and
+ mml2015-use
+ (mml2015-clear-decrypt-function)
+ (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known) t)
+ (t (y-or-n-p "Decrypt pgp encrypted part? ")))))
+
+(defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
+ (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
+ (if (mm-uu-pgp-encrypted-test)
+ (with-current-buffer buf
+ (mml2015-clean-buffer)
+ (funcall (mml2015-clear-decrypt-function))))
+ (list
+ (mm-make-handle buf
+ '("text/plain" (charset . gnus-decoded))))))
+
+(defun mm-uu-pgp-encrypted-extract ()
+ (let ((mm-security-handle (list (format "multipart/encrypted"))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
+ (save-restriction
+ (narrow-to-region start-point end-point)
+ (add-text-properties 0 (length (car mm-security-handle))
+ (list 'buffer (mm-uu-copy-to-buffer))
+ (car mm-security-handle))
+ (setcdr mm-security-handle
+ (mm-uu-pgp-encrypted-extract-1 nil
+ mm-security-handle)))
+ mm-security-handle))
+
+(defun mm-uu-gpg-key-skip-to-last ()
+ (let ((point (point))
+ (end-regexp (mm-uu-end-regexp entry))
+ (beginning-regexp (mm-uu-beginning-regexp entry)))
+ (when (and end-regexp
+ (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
+ (while (re-search-forward end-regexp nil t)
+ (skip-chars-forward " \t\n\r")
+ (if (looking-at beginning-regexp)
+ (setq point (match-end 0)))))
+ (goto-char point)))
+
+(defun mm-uu-pgp-key-extract ()
+ (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+ (mm-make-handle buf
+ '("application/pgp-keys"))))
+
;;;###autoload
(defun mm-uu-dissect ()
"Dissect the current buffer and return a list of uu handles."
- (let (text-start start-char end-char
- type file-name end-line result text-plain-type
- start-char-1 end-char-1
- (case-fold-search t))
+ (let ((case-fold-search t)
+ text-start start-point end-point file-name result
+ text-plain-type entry func)
(save-excursion
- (save-restriction
- (mail-narrow-to-head)
- (goto-char (point-max)))
- (forward-line)
+ (goto-char (point-min))
+ (cond
+ ((looking-at "\n")
+ (forward-line))
+ ((search-forward "\n\n" nil t)
+ t)
+ (t (goto-char (point-max))))
;;; gnus-decoded is a fake charset, which means no further
;;; decoding.
(setq text-start (point)
text-plain-type '("text/plain" (charset . gnus-decoded)))
- (while (re-search-forward mm-uu-begin-line nil t)
- (setq start-char (match-beginning 0))
- (setq type (cdr (assq (aref (match-string 0) 0)
- mm-uu-identifier-alist)))
- (setq file-name
- (if (and (eq type 'uu)
- (looking-at "\\(.+\\)$"))
- (and (match-string 1)
- (let ((nnheader-file-name-translation-alist
- '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_))))
- (nnheader-translate-file-chars (match-string 1))))))
+ (while (re-search-forward mm-uu-beginning-regexp nil t)
+ (setq start-point (match-beginning 0))
+ (let ((alist mm-uu-type-alist)
+ (beginning-regexp (match-string 0)))
+ (while (not entry)
+ (if (string-match (mm-uu-beginning-regexp (car alist))
+ beginning-regexp)
+ (setq entry (car alist))
+ (pop alist))))
+ (if (setq func (mm-uu-function-1 entry))
+ (funcall func))
(forward-line);; in case of failure
- (setq start-char-1 (point))
- (setq end-line (symbol-value
- (intern (concat "mm-uu-" (symbol-name type)
- "-end-line"))))
- (when (and (re-search-forward end-line nil t)
- (not (eq (match-beginning 0) (match-end 0))))
- (setq end-char-1 (match-beginning 0))
- (forward-line)
- (setq end-char (point))
- (when (cond
- ((eq type 'binhex)
- (setq file-name
- (ignore-errors
- (binhex-decode-region start-char end-char t))))
- ((eq type 'forward)
- (save-excursion
- (goto-char start-char-1)
- (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
- (t t))
- (if (> start-char text-start)
- (push
- (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
- text-plain-type)
- result))
- (push
- (cond
- ((eq type 'postscript)
- (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
- '("application/postscript")))
- ((eq type 'forward)
- (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)
- '("message/rfc822" (charset . gnus-decoded))))
- ((eq type 'uu)
- (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
- (list (or (and file-name
- (string-match "\\.[^\\.]+$"
- file-name)
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- "application/octet-stream"))
- 'x-uuencode nil
- (if (and file-name (not (equal file-name "")))
- (list mm-dissect-disposition
- (cons 'filename file-name)))))
- ((eq type 'binhex)
- (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
- (list (or (and file-name
- (string-match "\\.[^\\.]+$" file-name)
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- "application/octet-stream"))
- 'x-binhex nil
- (if (and file-name (not (equal file-name "")))
- (list mm-dissect-disposition
- (cons 'filename file-name)))))
- ((eq type 'shar)
- (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
- '("application/x-shar"))))
- result)
- (setq text-start end-char))))
+ (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
+ (let ((end-regexp (mm-uu-end-regexp entry)))
+ (if (not end-regexp)
+ (or (setq end-point (point-max)) t)
+ (prog1
+ (re-search-forward end-regexp nil t)
+ (forward-line)
+ (setq end-point (point)))))
+ (or (not (setq func (mm-uu-function-2 entry)))
+ (funcall func)))
+ (if (and (> start-point text-start)
+ (progn
+ (goto-char text-start)
+ (re-search-forward "." start-point t)))
+ (push
+ (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
+ text-plain-type)
+ result))
+ (push
+ (funcall (mm-uu-function-extract entry))
+ result)
+ (goto-char (setq text-start end-point))))
(when result
- (if (> (point-max) (1+ text-start))
+ (if (and (> (point-max) (1+ text-start))
+ (save-excursion
+ (goto-char text-start)
+ (re-search-forward "." nil t)))
(push
(mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
text-plain-type)
@@ -225,26 +493,6 @@ To disable dissecting shar codes, for instance, add
(setq result (cons "multipart/mixed" (nreverse result))))
result)))
-;;;###autoload
-(defun mm-uu-test ()
- "Check whether the current buffer contains uu stuff."
- (save-excursion
- (goto-char (point-min))
- (let (type end-line result
- (case-fold-search t))
- (while (and mm-uu-begin-line
- (not result) (re-search-forward mm-uu-begin-line nil t))
- (forward-line)
- (setq type (cdr (assq (aref (match-string 0) 0)
- mm-uu-identifier-alist)))
- (setq end-line (symbol-value
- (intern (concat "mm-uu-" (symbol-name type)
- "-end-line"))))
- (if (and (re-search-forward end-line nil t)
- (not (eq (match-beginning 0) (match-end 0))))
- (setq result t)))
- result)))
-
(provide 'mm-uu)
;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 69cbd3d8a1d..c0ed098fa6f 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -1,5 +1,6 @@
;;; mm-view.el --- functions for viewing MIME objects
-;; Copyright (C) 1998, 1999, 2000, 01, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -34,34 +35,67 @@
(autoload 'vcard-parse-string "vcard")
(autoload 'vcard-format-string "vcard")
(autoload 'fill-flowed "flow-fill")
+ (autoload 'html2text "html2text")
(unless (fboundp 'diff-mode)
(autoload 'diff-mode "diff-mode" "" t nil)))
+(defvar mm-text-html-renderer-alist
+ '((w3 . mm-inline-text-html-render-with-w3)
+ (w3m . mm-inline-text-html-render-with-w3m)
+ (w3m-standalone mm-inline-render-with-stdin nil
+ "w3m" "-dump" "-T" "text/html")
+ (links mm-inline-render-with-file
+ mm-links-remove-leading-blank
+ "links" "-dump" file)
+ (lynx mm-inline-render-with-stdin nil
+ "lynx" "-dump" "-force_html" "-stdin" "-nolist")
+ (html2text mm-inline-render-with-function html2text))
+ "The attributes of renderer types for text/html.")
+
+(defvar mm-text-html-washer-alist
+ '((w3 . gnus-article-wash-html-with-w3)
+ (w3m . gnus-article-wash-html-with-w3m)
+ (w3m-standalone mm-inline-wash-with-stdin nil
+ "w3m" "-dump" "-T" "text/html")
+ (links mm-inline-wash-with-file
+ mm-links-remove-leading-blank
+ "links" "-dump" file)
+ (lynx mm-inline-wash-with-stdin nil
+ "lynx" "-dump" "-force_html" "-stdin" "-nolist")
+ (html2text html2text))
+ "The attributes of washer types for text/html.")
+
+;;; Internal variables.
+
;;;
;;; Functions for displaying various formats inline
;;;
+
(defun mm-inline-image-emacs (handle)
(let ((b (point-marker))
buffer-read-only)
- (insert "\n")
(put-image (mm-get-image handle) b)
+ (insert "\n\n")
(mm-handle-set-undisplayer
handle
- `(lambda () (remove-images ,b (1+ ,b))))))
+ `(lambda ()
+ (let ((b ,b)
+ buffer-read-only)
+ (remove-images b b)
+ (delete-region b (+ b 2)))))))
(defun mm-inline-image-xemacs (handle)
- (insert "\n")
- (forward-char -1)
- (let ((b (point))
- (annot (make-annotation (mm-get-image handle) nil 'text))
+ (insert "\n\n")
+ (forward-char -2)
+ (let ((annot (make-annotation (mm-get-image handle) nil 'text))
buffer-read-only)
(mm-handle-set-undisplayer
handle
`(lambda ()
- (let (buffer-read-only)
+ (let ((b ,(point-marker))
+ buffer-read-only)
(delete-annotation ,annot)
- (delete-region ,(set-marker (make-marker) b)
- ,(set-marker (make-marker) (point))))))
+ (delete-region (- b 2) b))))
(set-extent-property annot 'mm t)
(set-extent-property annot 'duplicable t)))
@@ -80,125 +114,264 @@
(require 'url-vars)
(setq mm-w3-setup t)))
-(defun mm-inline-text (handle)
- (let ((type (mm-handle-media-subtype handle))
- text buffer-read-only)
- (cond
- ((equal type "html")
- (mm-setup-w3)
- (setq text (mm-get-part handle))
- (let ((b (point))
- (url-standalone-mode t)
- (url-gateway-unplugged t)
- (url-current-object
- (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
- (width (window-width))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (save-excursion
- (insert text)
+(defun mm-inline-text-html-render-with-w3 (handle)
+ (mm-setup-w3)
+ (let ((text (mm-get-part handle))
+ (b (point))
+ (url-standalone-mode t)
+ (url-gateway-unplugged t)
+ (w3-honor-stylesheets nil)
+ (url-current-object
+ (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
+ (width (window-width))
+ (charset (mail-content-type-get
+ (mm-handle-type handle) 'charset)))
+ (save-excursion
+ (insert text)
+ (save-restriction
+ (narrow-to-region b (point))
+ (goto-char (point-min))
+ (if (or (and (boundp 'w3-meta-content-type-charset-regexp)
+ (re-search-forward
+ w3-meta-content-type-charset-regexp nil t))
+ (and (boundp 'w3-meta-charset-content-type-regexp)
+ (re-search-forward
+ w3-meta-charset-content-type-regexp nil t)))
+ (setq charset
+ (or (let ((bsubstr (buffer-substring-no-properties
+ (match-beginning 2)
+ (match-end 2))))
+ (if (fboundp 'w3-coding-system-for-mime-charset)
+ (w3-coding-system-for-mime-charset bsubstr)
+ (mm-charset-to-coding-system bsubstr)))
+ charset)))
+ (delete-region (point-min) (point-max))
+ (insert (mm-decode-string text charset))
+ (save-window-excursion
(save-restriction
- (narrow-to-region b (point))
- (goto-char (point-min))
- (if (or (and (boundp 'w3-meta-content-type-charset-regexp)
- (re-search-forward
- w3-meta-content-type-charset-regexp nil t))
- (and (boundp 'w3-meta-charset-content-type-regexp)
- (re-search-forward
- w3-meta-charset-content-type-regexp nil t)))
- (setq charset
- (or (let ((bsubstr (buffer-substring-no-properties
- (match-beginning 2)
- (match-end 2))))
- (if (fboundp 'w3-coding-system-for-mime-charset)
- (w3-coding-system-for-mime-charset bsubstr)
- (mm-charset-to-coding-system bsubstr)))
- charset)))
+ (let ((w3-strict-width width)
+ ;; Don't let w3 set the global version of
+ ;; this variable.
+ (fill-column fill-column))
+ (if (or debug-on-error debug-on-quit)
+ (w3-region (point-min) (point-max))
+ (condition-case ()
+ (w3-region (point-min) (point-max))
+ (error
+ (delete-region (point-min) (point-max))
+ (let ((b (point))
+ (charset (mail-content-type-get
+ (mm-handle-type handle) 'charset)))
+ (if (or (eq charset 'gnus-decoded)
+ (eq mail-parse-charset 'gnus-decoded))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-insert-part handle)
+ (goto-char (point-max)))
+ (insert (mm-decode-string (mm-get-part handle)
+ charset))))
+ (message
+ "Error while rendering html; showing as text/plain")))))))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (if (functionp 'remove-specifier)
+ (mapcar (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop)
+ (current-buffer)))
+ '(background background-pixmap foreground)))
+ (delete-region ,(point-min-marker)
+ ,(point-max-marker)))))))))
+
+(defvar mm-w3m-setup nil
+ "Whether gnus-article-mode has been setup to use emacs-w3m.")
+
+(defun mm-setup-w3m ()
+ "Setup gnus-article-mode to use emacs-w3m."
+ (unless mm-w3m-setup
+ (require 'w3m)
+ (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
+ (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
+ w3m-cid-retrieve-function-alist))
+ (setq mm-w3m-setup t))
+ (setq w3m-display-inline-images mm-inline-text-html-with-images))
+
+(defun mm-w3m-cid-retrieve-1 (url handle)
+ (if (mm-multiple-handles handle)
+ (dolist (elem handle)
+ (mm-w3m-cid-retrieve-1 url elem))
+ (when (and (listp handle)
+ (equal url (mm-handle-id handle)))
+ (mm-insert-part handle)
+ (throw 'found-handle (mm-handle-media-type handle)))))
+
+(defun mm-w3m-cid-retrieve (url &rest args)
+ "Insert a content pointed by URL if it has the cid: scheme."
+ (when (string-match "\\`cid:" url)
+ (catch 'found-handle
+ (mm-w3m-cid-retrieve-1 (concat "<" (substring url (match-end 0)) ">")
+ (with-current-buffer w3m-current-buffer
+ gnus-article-mime-handles)))))
+
+(defun mm-inline-text-html-render-with-w3m (handle)
+ "Render a text/html part using emacs-w3m."
+ (mm-setup-w3m)
+ (let ((text (mm-get-part handle))
+ (b (point))
+ (charset (mail-content-type-get (mm-handle-type handle) 'charset)))
+ (save-excursion
+ (insert (if charset (mm-decode-string text charset) text))
+ (save-restriction
+ (narrow-to-region b (point))
+ (unless charset
+ (goto-char (point-min))
+ (when (setq charset (w3m-detect-meta-charset))
(delete-region (point-min) (point-max))
- (insert (mm-decode-string text charset))
- (save-window-excursion
- (save-restriction
- (let ((w3-strict-width width)
- ;; Don't let w3 set the global version of
- ;; this variable.
- (fill-column fill-column))
- (condition-case var
- (w3-region (point-min) (point-max))
- (error
- (delete-region (point-min) (point-max))
- (let ((b (point))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (if (or (eq charset 'gnus-decoded)
- (eq mail-parse-charset 'gnus-decoded))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part handle)
- (goto-char (point-max)))
- (insert (mm-decode-string (mm-get-part handle)
- charset))))
- (message
- "Error while rendering html; showing as text/plain"))))))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (if (functionp 'remove-specifier)
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop)
- (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))
- ((equal type "x-vcard")
- (mm-insert-inline
+ (insert (mm-decode-string text charset))))
+ (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
+ w3m-force-redisplay)
+ (w3m-region (point-min) (point-max) nil charset))
+ (when (and mm-inline-text-html-with-w3m-keymap
+ (boundp 'w3m-minor-mode-map)
+ w3m-minor-mode-map)
+ (add-text-properties
+ (point-min) (point-max)
+ (list 'keymap w3m-minor-mode-map
+ ;; Put the mark meaning this part was rendered by emacs-w3m.
+ 'mm-inline-text-html-with-w3m t))))
+ (mm-handle-set-undisplayer
handle
- (concat "\n-- \n"
- (ignore-errors
- (if (fboundp 'vcard-pretty-print)
- (vcard-pretty-print (mm-get-part handle))
- (vcard-format-string
- (vcard-parse-string (mm-get-part handle)
- 'vcard-standard-filter)))))))
+ `(lambda ()
+ (let (buffer-read-only)
+ (if (functionp 'remove-specifier)
+ (mapcar (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop)
+ (current-buffer)))
+ '(background background-pixmap foreground)))
+ (delete-region ,(point-min-marker)
+ ,(point-max-marker))))))))
+
+(defun mm-links-remove-leading-blank ()
+ ;; Delete the annoying three spaces preceding each line of links
+ ;; output.
+ (goto-char (point-min))
+ (while (re-search-forward "^ " nil t)
+ (delete-region (match-beginning 0) (match-end 0))))
+
+(defun mm-inline-wash-with-file (post-func cmd &rest args)
+ (let ((file (mm-make-temp-file
+ (expand-file-name "mm" mm-tmp-directory))))
+ (let ((coding-system-for-write 'binary))
+ (write-region (point-min) (point-max) file nil 'silent))
+ (delete-region (point-min) (point-max))
+ (unwind-protect
+ (apply 'call-process cmd nil t nil (mapcar 'eval args))
+ (delete-file file))
+ (and post-func (funcall post-func))))
+
+(defun mm-inline-wash-with-stdin (post-func cmd &rest args)
+ (let ((coding-system-for-write 'binary))
+ (apply 'call-process-region (point-min) (point-max)
+ cmd t t nil args))
+ (and post-func (funcall post-func)))
+
+(defun mm-inline-render-with-file (handle post-func cmd &rest args)
+ (let ((source (mm-get-part handle)))
+ (mm-insert-inline
+ handle
+ (mm-with-unibyte-buffer
+ (insert source)
+ (apply 'mm-inline-wash-with-file post-func cmd args)
+ (buffer-string)))))
+
+(defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
+ (let ((source (mm-get-part handle)))
+ (mm-insert-inline
+ handle
+ (mm-with-unibyte-buffer
+ (insert source)
+ (apply 'mm-inline-wash-with-stdin post-func cmd args)
+ (buffer-string)))))
+
+(defun mm-inline-render-with-function (handle func &rest args)
+ (let ((source (mm-get-part handle))
+ (charset (mail-content-type-get (mm-handle-type handle) 'charset)))
+ (mm-insert-inline
+ handle
+ (mm-with-multibyte-buffer
+ (insert (if charset
+ (mm-decode-string source charset)
+ source))
+ (apply func args)
+ (buffer-string)))))
+
+(defun mm-inline-text-html (handle)
+ (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer))
+ (entry (assq func mm-text-html-renderer-alist))
+ buffer-read-only)
+ (if entry
+ (setq func (cdr entry)))
+ (cond
+ ((functionp func)
+ (funcall func handle))
(t
- (let ((b (point))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (if (or (eq charset 'gnus-decoded)
- ;; This is probably not entirely correct, but
- ;; makes rfc822 parts with embedded multiparts work.
- (eq mail-parse-charset 'gnus-decoded))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part handle)
- (goto-char (point-max)))
- (insert (mm-decode-string (mm-get-part handle) charset)))
- (when (and (equal type "plain")
- (equal (cdr (assoc 'format (mm-handle-type handle)))
- "flowed"))
- (save-restriction
- (narrow-to-region b (point))
- (goto-char b)
- (fill-flowed)
- (goto-char (point-max))))
+ (apply (car func) handle (cdr func))))))
+
+(defun mm-inline-text-vcard (handle)
+ (let (buffer-read-only)
+ (mm-insert-inline
+ handle
+ (concat "\n-- \n"
+ (ignore-errors
+ (if (fboundp 'vcard-pretty-print)
+ (vcard-pretty-print (mm-get-part handle))
+ (vcard-format-string
+ (vcard-parse-string (mm-get-part handle)
+ 'vcard-standard-filter))))))))
+
+(defun mm-inline-text (handle)
+ (let ((b (point))
+ (type (mm-handle-media-subtype handle))
+ (charset (mail-content-type-get
+ (mm-handle-type handle) 'charset))
+ buffer-read-only)
+ (if (or (eq charset 'gnus-decoded)
+ ;; This is probably not entirely correct, but
+ ;; makes rfc822 parts with embedded multiparts work.
+ (eq mail-parse-charset 'gnus-decoded))
(save-restriction
- (narrow-to-region b (point))
- (set-text-properties (point-min) (point-max) nil)
- (when (or (equal type "enriched")
- (equal type "richtext"))
- (enriched-decode (point-min) (point-max)))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))))
+ (narrow-to-region (point) (point))
+ (mm-insert-part handle)
+ (goto-char (point-max)))
+ (insert (mm-decode-string (mm-get-part handle) charset)))
+ (when (and (equal type "plain")
+ (equal (cdr (assoc 'format (mm-handle-type handle)))
+ "flowed"))
+ (save-restriction
+ (narrow-to-region b (point))
+ (goto-char b)
+ (fill-flowed)
+ (goto-char (point-max))))
+ (save-restriction
+ (narrow-to-region b (point))
+ (set-text-properties (point-min) (point-max) nil)
+ (when (or (equal type "enriched")
+ (equal type "richtext"))
+ (ignore-errors
+ (enriched-decode (point-min) (point-max))))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (delete-region ,(point-min-marker)
+ ,(point-max-marker))))))))
(defun mm-insert-inline (handle text)
"Insert TEXT inline from HANDLE."
- (let ((b (point))
- (inhibit-read-only t))
+ (let ((b (point)))
(insert text)
(mm-handle-set-undisplayer
handle
@@ -216,7 +389,8 @@
(defun mm-w3-prepare-buffer ()
(require 'w3)
(let ((url-standalone-mode t)
- (url-gateway-unplugged t))
+ (url-gateway-unplugged t)
+ (w3-honor-stylesheets nil))
(w3-prepare-buffer)))
(defun mm-view-message ()
@@ -229,9 +403,7 @@
(setq handles gnus-article-mime-handles))
(when handles
(setq gnus-article-mime-handles
- (nconc gnus-article-mime-handles
- (if (listp (car handles))
- handles (list handles))))))
+ (mm-merge-handles gnus-article-mime-handles handles))))
(fundamental-mode)
(goto-char (point-min)))
@@ -255,7 +427,8 @@
gnus-article-prepare-hook
(gnus-newsgroup-charset
(or charset gnus-newsgroup-charset)))
- (run-hooks 'gnus-article-decode-hook)
+ (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
+ (run-hooks 'gnus-article-decode-hook))
(gnus-article-prepare-display)
(setq handles gnus-article-mime-handles))
(goto-char (point-min))
@@ -267,9 +440,7 @@
(insert "----------\n\n")
(when handles
(setq gnus-article-mime-handles
- (nconc gnus-article-mime-handles
- (if (listp (car handles))
- handles (list handles)))))
+ (mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer
handle
`(lambda ()
@@ -284,24 +455,120 @@
(defun mm-display-inline-fontify (handle mode)
(let (text)
- (with-temp-buffer
- (mm-insert-part handle)
- (funcall mode)
- (font-lock-fontify-buffer)
- (when (fboundp 'extent-list)
- (map-extents (lambda (ext ignored)
- (set-extent-property ext 'duplicable t)
- nil)
- nil nil nil nil nil 'text-prop))
- (setq text (buffer-string)))
+ ;; XEmacs @#$@ version of font-lock refuses to fully turn itself
+ ;; on for buffers whose name begins with " ". That's why we use
+ ;; save-current-buffer/get-buffer-create rather than
+ ;; with-temp-buffer.
+ (save-current-buffer
+ (set-buffer (generate-new-buffer "*fontification*"))
+ (unwind-protect
+ (progn
+ (buffer-disable-undo)
+ (mm-insert-part handle)
+ (funcall mode)
+ (require 'font-lock)
+ (let ((font-lock-verbose nil))
+ ;; I find font-lock a bit too verbose.
+ (font-lock-fontify-buffer))
+ ;; By default, XEmacs font-lock uses non-duplicable text
+ ;; properties. This code forces all the text properties
+ ;; to be copied along with the text.
+ (when (fboundp 'extent-list)
+ (map-extents (lambda (ext ignored)
+ (set-extent-property ext 'duplicable t)
+ nil)
+ nil nil nil nil nil 'text-prop))
+ (setq text (buffer-string)))
+ (kill-buffer (current-buffer))))
(mm-insert-inline handle text)))
+;; Shouldn't these functions check whether the user even wants to use
+;; font-lock? At least under XEmacs, this fontification is pretty
+;; much unconditional. Also, it would be nice to change for the size
+;; of the fontified region.
+
(defun mm-display-patch-inline (handle)
(mm-display-inline-fontify handle 'diff-mode))
(defun mm-display-elisp-inline (handle)
(mm-display-inline-fontify handle 'emacs-lisp-mode))
+;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
+;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
+(defvar mm-pkcs7-signed-magic
+ (mm-string-as-unibyte
+ (apply 'concat
+ (mapcar 'char-to-string
+ (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
+ ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
+ ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
+ ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))
+
+;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
+;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
+(defvar mm-pkcs7-enveloped-magic
+ (mm-string-as-unibyte
+ (apply 'concat
+ (mapcar 'char-to-string
+ (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
+ ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
+ ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
+ ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))
+
+(defun mm-view-pkcs7-get-type (handle)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (cond ((looking-at mm-pkcs7-enveloped-magic)
+ 'enveloped)
+ ((looking-at mm-pkcs7-signed-magic)
+ 'signed)
+ (t
+ (error "Could not identify PKCS#7 type")))))
+
+(defun mm-view-pkcs7 (handle)
+ (case (mm-view-pkcs7-get-type handle)
+ (enveloped (mm-view-pkcs7-decrypt handle))
+ (signed (mm-view-pkcs7-verify handle))
+ (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
+
+(defun mm-view-pkcs7-verify (handle)
+ ;; A bogus implementation of PKCS#7. FIXME::
+ (mm-insert-part handle)
+ (goto-char (point-min))
+ (if (search-forward "Content-Type: " nil t)
+ (delete-region (point-min) (match-beginning 0)))
+ (goto-char (point-max))
+ (if (re-search-backward "--\r?\n?" nil t)
+ (delete-region (match-end 0) (point-max)))
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (message "Verify signed PKCS#7 message is unimplemented.")
+ (sit-for 1)
+ t)
+
+(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro)
+
+(defun mm-view-pkcs7-decrypt (handle)
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (goto-char (point-min))
+ (insert "MIME-Version: 1.0\n")
+ (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
+ (smime-decrypt-region
+ (point-min) (point-max)
+ (if (= (length smime-keys) 1)
+ (cadar smime-keys)
+ (smime-get-key-by-email
+ (gnus-completing-read-maybe-default
+ (concat "Decipher using which key? "
+ (if smime-keys (concat "(default " (caar smime-keys) ") ")
+ ""))
+ smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (goto-char (point-min)))
+
(provide 'mm-view)
;;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
new file mode 100644
index 00000000000..f726013dc2c
--- /dev/null
+++ b/lisp/gnus/mml-sec.el
@@ -0,0 +1,293 @@
+;;; mml-sec.el --- A package with security functions for MML documents
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'mml-smime)
+(eval-when-compile (require 'cl))
+(autoload 'mml2015-sign "mml2015")
+(autoload 'mml2015-encrypt "mml2015")
+(autoload 'mml1991-sign "mml1991")
+(autoload 'mml1991-encrypt "mml1991")
+(autoload 'message-goto-body "message")
+(autoload 'mml-insert-tag "mml")
+
+(defvar mml-sign-alist
+ '(("smime" mml-smime-sign-buffer mml-smime-sign-query)
+ ("pgp" mml-pgp-sign-buffer list)
+ ("pgpauto" mml-pgpauto-sign-buffer list)
+ ("pgpmime" mml-pgpmime-sign-buffer list))
+ "Alist of MIME signer functions.")
+
+(defcustom mml-default-sign-method "pgpmime"
+ "Default sign method.
+The string must have an entry in `mml-sign-alist'."
+ :type '(choice (const "smime")
+ (const "pgp")
+ (const "pgpauto")
+ (const "pgpmime")
+ string)
+ :group 'message)
+
+(defvar mml-encrypt-alist
+ '(("smime" mml-smime-encrypt-buffer mml-smime-encrypt-query)
+ ("pgp" mml-pgp-encrypt-buffer list)
+ ("pgpauto" mml-pgpauto-sign-buffer list)
+ ("pgpmime" mml-pgpmime-encrypt-buffer list))
+ "Alist of MIME encryption functions.")
+
+(defcustom mml-default-encrypt-method "pgpmime"
+ "Default encryption method.
+The string must have an entry in `mml-encrypt-alist'."
+ :type '(choice (const "smime")
+ (const "pgp")
+ (const "pgpauto")
+ (const "pgpmime")
+ string)
+ :group 'message)
+
+(defcustom mml-signencrypt-style-alist
+ '(("smime" separate)
+ ("pgp" combined)
+ ("pgpauto" combined)
+ ("pgpmime" combined))
+ "Alist specifying if `signencrypt' results in two separate operations or not.
+The first entry indicates the MML security type, valid entries include
+the strings \"smime\", \"pgp\", and \"pgpmime\". The second entry is
+a symbol `separate' or `combined' where `separate' means that MML signs
+and encrypt messages in a two step process, and `combined' means that MML
+signs and encrypt the message in one step.
+
+Note that the output generated by using a `combined' mode is NOT
+understood by all PGP implementations, in particular PGP version
+2 does not support it! See Info node `(message)Security' for
+details."
+ :type '(repeat (list (choice (const :tag "S/MIME" "smime")
+ (const :tag "PGP" "pgp")
+ (const :tag "PGP/MIME" "pgpmime")
+ (string :tag "User defined"))
+ (choice (const :tag "Separate" separate)
+ (const :tag "Combined" combined)))))
+
+;;; Configuration/helper functions
+
+(defun mml-signencrypt-style (method &optional style)
+ "Function for setting/getting the signencrypt-style used. Takes two
+arguments, the method (e.g. \"pgp\") and optionally the mode
+\(e.g. combined). If the mode is omitted, the current value is returned.
+
+For example, if you prefer to use combined sign & encrypt with
+smime, putting the following in your Gnus startup file will
+enable that behavior:
+
+\(mml-set-signencrypt-style \"smime\" combined)
+
+You can also customize or set `mml-signencrypt-style-alist' instead."
+ (let ((style-item (assoc method mml-signencrypt-style-alist)))
+ (if style-item
+ (if (or (eq style 'separate)
+ (eq style 'combined))
+ ;; valid style setting?
+ (setf (second style-item) style)
+ ;; otherwise, just return the current value
+ (second style-item))
+ (gnus-message 3 "Warning, attempt to set invalid signencrypt-style"))))
+
+;;; Security functions
+
+(defun mml-smime-sign-buffer (cont)
+ (or (mml-smime-sign cont)
+ (error "Signing failed... inspect message logs for errors")))
+
+(defun mml-smime-encrypt-buffer (cont &optional sign)
+ (when sign
+ (message "Combined sign and encrypt S/MIME not support yet")
+ (sit-for 1))
+ (or (mml-smime-encrypt cont)
+ (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgp-sign-buffer (cont)
+ (or (mml1991-sign cont)
+ (error "Signing failed... inspect message logs for errors")))
+
+(defun mml-pgp-encrypt-buffer (cont &optional sign)
+ (or (mml1991-encrypt cont sign)
+ (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgpmime-sign-buffer (cont)
+ (or (mml2015-sign cont)
+ (error "Signing failed... inspect message logs for errors")))
+
+(defun mml-pgpmime-encrypt-buffer (cont &optional sign)
+ (or (mml2015-encrypt cont sign)
+ (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgpauto-sign-buffer (cont)
+ (message-goto-body)
+ (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way...
+ (mml2015-sign cont)
+ (mml1991-sign cont))
+ (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-pgpauto-encrypt-buffer (cont &optional sign)
+ (message-goto-body)
+ (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way...
+ (mml2015-encrypt cont sign)
+ (mml1991-encrypt cont sign))
+ (error "Encryption failed... inspect message logs for errors")))
+
+(defun mml-secure-part (method &optional sign)
+ (save-excursion
+ (let ((tags (funcall (nth 2 (assoc method (if sign mml-sign-alist
+ mml-encrypt-alist))))))
+ (cond ((re-search-backward
+ "<#\\(multipart\\|part\\|external\\|mml\\)" nil t)
+ (goto-char (match-end 0))
+ (insert (if sign " sign=" " encrypt=") method)
+ (while tags
+ (let ((key (pop tags))
+ (value (pop tags)))
+ (when value
+ ;; Quote VALUE if it contains suspicious characters.
+ (when (string-match "[\"'\\~/*;() \t\n]" value)
+ (setq value (prin1-to-string value)))
+ (insert (format " %s=%s" key value))))))
+ ((or (re-search-backward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
+ (goto-char (match-end 0))
+ (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt)
+ (cons method tags))))
+ (t (error "The message is corrupted. No mail header separator"))))))
+
+(defun mml-secure-sign-pgp ()
+ "Add MML tags to PGP sign this MML part."
+ (interactive)
+ (mml-secure-part "pgp" 'sign))
+
+(defun mml-secure-sign-pgpauto ()
+ "Add MML tags to PGP-auto sign this MML part."
+ (interactive)
+ (mml-secure-part "pgpauto" 'sign))
+
+(defun mml-secure-sign-pgpmime ()
+ "Add MML tags to PGP/MIME sign this MML part."
+ (interactive)
+ (mml-secure-part "pgpmime" 'sign))
+
+(defun mml-secure-sign-smime ()
+ "Add MML tags to S/MIME sign this MML part."
+ (interactive)
+ (mml-secure-part "smime" 'sign))
+
+(defun mml-secure-encrypt-pgp ()
+ "Add MML tags to PGP encrypt this MML part."
+ (interactive)
+ (mml-secure-part "pgp"))
+
+(defun mml-secure-encrypt-pgpmime ()
+ "Add MML tags to PGP/MIME encrypt this MML part."
+ (interactive)
+ (mml-secure-part "pgpmime"))
+
+(defun mml-secure-encrypt-smime ()
+ "Add MML tags to S/MIME encrypt this MML part."
+ (interactive)
+ (mml-secure-part "smime"))
+
+;; defuns that add the proper <#secure ...> tag to the top of the message body
+(defun mml-secure-message (method &optional modesym)
+ (let ((mode (prin1-to-string modesym))
+ insert-loc)
+ (mml-unsecure-message)
+ (save-excursion
+ (goto-char (point-min))
+ (cond ((re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (goto-char (setq insert-loc (match-end 0)))
+ (unless (looking-at "<#secure")
+ (mml-insert-tag
+ 'secure 'method method 'mode mode)))
+ (t (error
+ "The message is corrupted. No mail header separator"))))
+ (when (eql insert-loc (point))
+ (forward-line 1))))
+
+(defun mml-unsecure-message ()
+ "Remove security related MML tags from message."
+ (interactive)
+ (save-excursion
+ (goto-char (point-max))
+ (when (re-search-backward "^<#secure.*>\n" nil t)
+ (delete-region (match-beginning 0) (match-end 0)))))
+
+(defun mml-secure-message-sign-smime ()
+ "Add MML tag to encrypt/sign the entire message."
+ (interactive)
+ (mml-secure-message "smime" 'sign))
+
+(defun mml-secure-message-sign-pgp ()
+ "Add MML tag to encrypt/sign the entire message."
+ (interactive)
+ (mml-secure-message "pgp" 'sign))
+
+(defun mml-secure-message-sign-pgpmime ()
+ "Add MML tag to encrypt/sign the entire message."
+ (interactive)
+ (mml-secure-message "pgpmime" 'sign))
+
+(defun mml-secure-message-sign-pgpauto ()
+ "Add MML tag to encrypt/sign the entire message."
+ (interactive)
+ (mml-secure-message "pgpauto" 'sign))
+
+(defun mml-secure-message-encrypt-smime (&optional dontsign)
+ "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+ (interactive "P")
+ (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt)))
+
+(defun mml-secure-message-encrypt-pgp (&optional dontsign)
+ "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+ (interactive "P")
+ (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt)))
+
+(defun mml-secure-message-encrypt-pgpmime (&optional dontsign)
+ "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+ (interactive "P")
+ (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt)))
+
+(defun mml-secure-message-encrypt-pgpauto (&optional dontsign)
+ "Add MML tag to encrypt and sign the entire message.
+If called with a prefix argument, only encrypt (do NOT sign)."
+ (interactive "P")
+ (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt)))
+
+(provide 'mml-sec)
+
+;;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c
+;;; mml-sec.el ends here
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
new file mode 100644
index 00000000000..596585afc72
--- /dev/null
+++ b/lisp/gnus/mml-smime.el
@@ -0,0 +1,201 @@
+;;; mml-smime.el --- S/MIME support for MML
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: Gnus, MIME, S/MIME, MML
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'smime)
+(require 'mm-decode)
+(autoload 'message-narrow-to-headers "message")
+
+(defun mml-smime-sign (cont)
+ (when (null smime-keys)
+ (customize-variable 'smime-keys)
+ (error "No S/MIME keys configured, use customize to add your key"))
+ (smime-sign-buffer (cdr (assq 'keyfile cont)))
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (goto-char (point-max)))
+
+(defun mml-smime-encrypt (cont)
+ (let (certnames certfiles tmp file tmpfiles)
+ ;; xxx tmp files are always an security issue
+ (while (setq tmp (pop cont))
+ (if (and (consp tmp) (eq (car tmp) 'certfile))
+ (push (cdr tmp) certnames)))
+ (while (setq tmp (pop certnames))
+ (if (not (and (not (file-exists-p tmp))
+ (get-buffer tmp)))
+ (push tmp certfiles)
+ (setq file (mm-make-temp-file (expand-file-name "mml."
+ mm-tmp-directory)))
+ (with-current-buffer tmp
+ (write-region (point-min) (point-max) file))
+ (push file certfiles)
+ (push file tmpfiles)))
+ (if (smime-encrypt-buffer certfiles)
+ (progn
+ (while (setq tmp (pop tmpfiles))
+ (delete-file tmp))
+ t)
+ (while (setq tmp (pop tmpfiles))
+ (delete-file tmp))
+ nil))
+ (goto-char (point-max)))
+
+(defun mml-smime-sign-query ()
+ ;; query information (what certificate) from user when MML tag is
+ ;; added, for use later by the signing process
+ (when (null smime-keys)
+ (customize-variable 'smime-keys)
+ (error "No S/MIME keys configured, use customize to add your key"))
+ (list 'keyfile
+ (if (= (length smime-keys) 1)
+ (cadar smime-keys)
+ (or (let ((from (cadr (funcall gnus-extract-address-components
+ (or (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "from")))
+ "")))))
+ (and from (smime-get-key-by-email from)))
+ (smime-get-key-by-email
+ (completing-read "Sign this part with what signature? "
+ smime-keys nil nil
+ (and (listp (car-safe smime-keys))
+ (caar smime-keys))))))))
+
+(defun mml-smime-get-file-cert ()
+ (ignore-errors
+ (list 'certfile (read-file-name
+ "File with recipient's S/MIME certificate: "
+ smime-certificate-directory nil t ""))))
+
+(defun mml-smime-get-dns-cert ()
+ ;; todo: deal with comma separated multiple recipients
+ (let (result who bad cert)
+ (condition-case ()
+ (while (not result)
+ (setq who (read-from-minibuffer
+ (format "%sLookup certificate for: " (or bad ""))
+ (cadr (funcall gnus-extract-address-components
+ (or (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-fetch-field "to")))
+ "")))))
+ (if (setq cert (smime-cert-by-dns who))
+ (setq result (list 'certfile (buffer-name cert)))
+ (setq bad (format "`%s' not found. " who))))
+ (quit))
+ result))
+
+(defun mml-smime-encrypt-query ()
+ ;; todo: add ldap support (xemacs ldap api?)
+ ;; todo: try dns/ldap automatically first, before prompting user
+ (let (certs done)
+ (while (not done)
+ (ecase (read (gnus-completing-read-with-default
+ "dns" "Fetch certificate from"
+ '(("dns") ("file")) nil t))
+ (dns (setq certs (append certs
+ (mml-smime-get-dns-cert))))
+ (file (setq certs (append certs
+ (mml-smime-get-file-cert)))))
+ (setq done (not (y-or-n-p "Add more recipients? "))))
+ certs))
+
+(defun mml-smime-verify (handle ctl)
+ (with-temp-buffer
+ (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
+ (goto-char (point-min))
+ (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))
+ (insert (format "protocol=\"%s\"; "
+ (mm-handle-multipart-ctl-parameter ctl 'protocol)))
+ (insert (format "micalg=\"%s\"; "
+ (mm-handle-multipart-ctl-parameter ctl 'micalg)))
+ (insert (format "boundary=\"%s\"\n\n"
+ (mm-handle-multipart-ctl-parameter ctl 'boundary)))
+ (when (get-buffer smime-details-buffer)
+ (kill-buffer smime-details-buffer))
+ (let ((buf (current-buffer))
+ (good-signature (smime-noverify-buffer))
+ (good-certificate (and (or smime-CA-file smime-CA-directory)
+ (smime-verify-buffer)))
+ addresses openssl-output)
+ (setq openssl-output (with-current-buffer smime-details-buffer
+ (buffer-string)))
+ (if (not good-signature)
+ (progn
+ ;; we couldn't verify message, fail with openssl output as message
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat "OpenSSL failed to verify message integrity:\n"
+ "-------------------------------------------\n"
+ openssl-output)))
+ ;; verify mail addresses in mail against those in certificate
+ (when (and (smime-pkcs7-region (point-min) (point-max))
+ (smime-pkcs7-certificates-region (point-min) (point-max)))
+ (with-temp-buffer
+ (insert-buffer-substring buf)
+ (goto-char (point-min))
+ (while (re-search-forward "-----END CERTIFICATE-----" nil t)
+ (when (smime-pkcs7-email-region (point-min) (point))
+ (setq addresses (append (smime-buffer-as-string-region
+ (point-min) (point)) addresses)))
+ (delete-region (point-min) (point)))
+ (setq addresses (mapcar 'downcase addresses))))
+ (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Sender address forged")
+ (if good-certificate
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Ok (sender authenticated)")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Ok (sender not trusted)")))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"
+ (if addresses
+ (concat "Addresses in certificate: "
+ (mapconcat 'identity addresses ", "))
+ "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)")
+ "\n" "\n"
+ "OpenSSL output:\n"
+ "---------------\n" openssl-output "\n"
+ "Certificate(s) inside S/MIME signature:\n"
+ "---------------------------------------\n"
+ (buffer-string) "\n")))))
+ handle)
+
+(defun mml-smime-verify-test (handle ctl)
+ smime-openssl-program)
+
+(provide 'mml-smime)
+
+;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
+;;; mml-smime.el ends here
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 8b1e4b63e55..4b083ee461b 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1,5 +1,6 @@
-;;; mml.el --- package for parsing and validating MML documents
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;;; mml.el --- A package for parsing and validating MML documents
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -27,15 +28,61 @@
(require 'mm-bodies)
(require 'mm-encode)
(require 'mm-decode)
+(require 'mml-sec)
(eval-when-compile (require 'cl))
(eval-and-compile
(autoload 'message-make-message-id "message")
(autoload 'gnus-setup-posting-charset "gnus-msg")
(autoload 'gnus-add-minor-mode "gnus-ems")
+ (autoload 'gnus-make-local-hook "gnus-util")
(autoload 'message-fetch-field "message")
+ (autoload 'fill-flowed-encode "flow-fill")
(autoload 'message-posting-charset "message"))
+(defcustom mml-content-type-parameters
+ '(name access-type expiration size permission format)
+ "*A list of acceptable parameters in MML tag.
+These parameters are generated in Content-Type header if exists."
+ :type '(repeat (symbol :tag "Parameter"))
+ :group 'message)
+
+(defcustom mml-content-disposition-parameters
+ '(filename creation-date modification-date read-date)
+ "*A list of acceptable parameters in MML tag.
+These parameters are generated in Content-Disposition header if exists."
+ :type '(repeat (symbol :tag "Parameter"))
+ :group 'message)
+
+(defcustom mml-insert-mime-headers-always nil
+ "If non-nil, always put Content-Type: text/plain at top of empty parts.
+It is necessary to work against a bug in certain clients."
+ :type 'boolean
+ :group 'message)
+
+(defvar mml-tweak-type-alist nil
+ "A list of (TYPE . FUNCTION) for tweaking MML parts.
+TYPE is a string containing a regexp to match the MIME type. FUNCTION
+is a Lisp function which is called with the MML handle to tweak the
+part. This variable is used only when no TWEAK parameter exists in
+the MML handle.")
+
+(defvar mml-tweak-function-alist nil
+ "A list of (NAME . FUNCTION) for tweaking MML parts.
+NAME is a string containing the name of the TWEAK parameter in the MML
+handle. FUNCTION is a Lisp function which is called with the MML
+handle to tweak the part.")
+
+(defvar mml-tweak-sexp-alist
+ '((mml-externalize-attachments . mml-tweak-externalize-attachments))
+ "A list of (SEXP . FUNCTION) for tweaking MML parts.
+SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION
+is called. FUNCTION is a Lisp function which is called with the MML
+handle to tweak the part.")
+
+(defvar mml-externalize-attachments nil
+ "*If non-nil, local-file attachments are generated as external parts.")
+
(defvar mml-generate-multipart-alist nil
"*Alist of multipart generation functions.
Each entry has the form (NAME . FUNCTION), where
@@ -73,15 +120,6 @@ unknown encoding; `use-ascii': always use ASCII for those characters
with unknown encoding; `multipart': always send messages with more than
one charsets.")
-(defvar mml-generate-mime-preprocess-function nil
- "A function called before generating a mime part.
-The function is called with one parameter, which is the part to be
-generated.")
-
-(defvar mml-generate-mime-postprocess-function nil
- "A function called after generating a mime part.
-The function is called with one parameter, which is the generated part.")
-
(defvar mml-generate-default-type "text/plain")
(defvar mml-buffer-list nil)
@@ -98,13 +136,14 @@ The function is called with one parameter, which is the generated part.")
(defun mml-parse ()
"Parse the current buffer as an MML document."
- (goto-char (point-min))
- (let ((table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table mml-syntax-table)
- (mml-parse-1))
- (set-syntax-table table))))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((table (syntax-table)))
+ (unwind-protect
+ (progn
+ (set-syntax-table mml-syntax-table)
+ (mml-parse-1))
+ (set-syntax-table table)))))
(defun mml-parse-1 ()
"Parse the current buffer as an MML document."
@@ -112,6 +151,43 @@ The function is called with one parameter, which is the generated part.")
(while (and (not (eobp))
(not (looking-at "<#/multipart")))
(cond
+ ((looking-at "<#secure")
+ ;; The secure part is essentially a meta-meta tag, which
+ ;; expands to either a part tag if there are no other parts in
+ ;; the document or a multipart tag if there are other parts
+ ;; included in the message
+ (let* (secure-mode
+ (taginfo (mml-read-tag))
+ (recipients (cdr (assq 'recipients taginfo)))
+ (sender (cdr (assq 'sender taginfo)))
+ (location (cdr (assq 'tag-location taginfo)))
+ (mode (cdr (assq 'mode taginfo)))
+ (method (cdr (assq 'method taginfo)))
+ tags)
+ (save-excursion
+ (if
+ (re-search-forward
+ "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
+ (setq secure-mode "multipart")
+ (setq secure-mode "part")))
+ (save-excursion
+ (goto-char location)
+ (re-search-forward "<#secure[^\n]*>\n"))
+ (delete-region (match-beginning 0) (match-end 0))
+ (cond ((string= mode "sign")
+ (setq tags (list "sign" method)))
+ ((string= mode "encrypt")
+ (setq tags (list "encrypt" method)))
+ ((string= mode "signencrypt")
+ (setq tags (list "sign" method "encrypt" method))))
+ (eval `(mml-insert-tag ,secure-mode
+ ,@tags
+ ,(if recipients "recipients")
+ ,recipients
+ ,(if sender "sender")
+ ,sender))
+ ;; restart the parse
+ (goto-char location)))
((looking-at "<#multipart")
(push (nconc (mml-read-tag) (mml-parse-1)) struct))
((looking-at "<#external")
@@ -128,18 +204,25 @@ The function is called with one parameter, which is the generated part.")
(setq raw (cdr (assq 'raw tag))
point (point)
contents (mml-read-part (eq 'mml (car tag)))
- charsets (if raw nil
- (mm-find-mime-charset-region point (point))))
+ charsets (cond
+ (raw nil)
+ ((assq 'charset tag)
+ (list
+ (intern (downcase (cdr (assq 'charset tag))))))
+ (t
+ (mm-find-mime-charset-region point (point)
+ mm-hack-charsets))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
- (prog1 (y-or-n-p
- "\
-Message contains characters with unknown encoding. Really send?")
- (set (make-local-variable 'mml-confirmation-set)
- (push 'unknown-encoding mml-confirmation-set))))
+ (message-options-get 'unknown-encoding)
+ (and (y-or-n-p "\
+Message contains characters with unknown encoding. Really send? ")
+ (message-options-set 'unknown-encoding t)))
(if (setq use-ascii
(or (memq 'use-ascii mml-confirmation-set)
- (y-or-n-p "Use ASCII as charset?")))
+ (message-options-get 'use-ascii)
+ (and (y-or-n-p "Use ASCII as charset? ")
+ (message-options-set 'use-ascii t))))
(setq charsets (delq nil charsets))
(setq warn nil))
(error "Edit your message to remove those characters")))
@@ -155,14 +238,11 @@ Message contains characters with unknown encoding. Really send?")
tag point (point) use-ascii)))
(when (and warn
(not (memq 'multipart mml-confirmation-set))
- (not
- (prog1 (y-or-n-p
- (format
- "\
+ (not (message-options-get 'multipart))
+ (not (and (y-or-n-p (format "\
A message part needs to be split into %d charset parts. Really send? "
- (length nstruct)))
- (set (make-local-variable 'mml-confirmation-set)
- (push 'multipart mml-confirmation-set)))))
+ (length nstruct)))
+ (message-options-set 'multipart t))))
(error "Edit your message to use only one charset"))
(setq struct (nconc nstruct struct)))))))
(unless (eobp)
@@ -229,12 +309,13 @@ A message part needs to be split into %d charset parts. Really send? "
(defun mml-read-tag ()
"Read a tag and return the contents."
- (let (contents name elem val)
+ (let ((orig-point (point))
+ contents name elem val)
(forward-char 2)
(setq name (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
(skip-chars-forward " \t\n")
- (while (not (looking-at ">"))
+ (while (not (looking-at ">[ \t]*\n?"))
(setq elem (buffer-substring-no-properties
(point) (progn (forward-sexp 1) (point))))
(skip-chars-forward "= \t\n")
@@ -244,15 +325,27 @@ A message part needs to be split into %d charset parts. Really send? "
(setq val (match-string 1 val)))
(push (cons (intern elem) val) contents)
(skip-chars-forward " \t\n"))
- (forward-char 1)
- (skip-chars-forward " \t\n")
+ (goto-char (match-end 0))
+ ;; Don't skip the leading space.
+ ;;(skip-chars-forward " \t\n")
+ ;; Put the tag location into the returned contents
+ (setq contents (append (list (cons 'tag-location orig-point)) contents))
(cons (intern name) (nreverse contents))))
+(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+ (let ((str (buffer-substring-no-properties start end))
+ (bufstart start) tmp)
+ (while (setq tmp (text-property-any start end 'hard 't))
+ (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
+ '(hard t) str)
+ (setq start (1+ tmp)))
+ str))
+
(defun mml-read-part (&optional mml)
"Return the buffer up till the next part, multipart or closing part or multipart.
If MML is non-nil, return the buffer up till the correspondent mml tag."
(let ((beg (point)) (count 1))
- ;; If the tag ended at the end of the line, we go to the next line.
+ ;; If the tag ended at the end of the line, we go to the next line.
(when (looking-at "[ \t]*\n")
(forward-line 1))
(if mml
@@ -261,19 +354,22 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
- (buffer-substring-no-properties beg (if (> count 0)
- (point)
- (match-beginning 0))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (if (> count 0)
+ (point)
+ (match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
- (buffer-substring-no-properties beg (match-beginning 0))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
- (buffer-substring-no-properties beg (goto-char (point-max)))))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
(defvar mml-base-boundary "-=-=")
@@ -294,129 +390,183 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(buffer-string)))))
(defun mml-generate-mime-1 (cont)
- (save-restriction
- (narrow-to-region (point) (point))
- (if mml-generate-mime-preprocess-function
- (funcall mml-generate-mime-preprocess-function cont))
- (cond
- ((or (eq (car cont) 'part) (eq (car cont) 'mml))
- (let ((raw (cdr (assq 'raw cont)))
- coded encoding charset filename type)
- (setq type (or (cdr (assq 'type cont)) "text/plain"))
- (if (and (not raw)
- (member (car (split-string type "/")) '("text" "message")))
- (progn
- (with-temp-buffer
- (cond
- ((cdr (assq 'buffer cont))
- (insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and (setq filename (cdr (assq 'filename cont)))
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (mm-insert-file-contents filename))
- ((eq 'mml (car cont))
- (insert (cdr (assq 'contents cont))))
- (t
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (cdr (assq 'contents cont)))
- ;; Remove quotes from quoted tags.
- (goto-char (point-min))
- (while (re-search-forward
- "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t)
- (delete-region (+ (match-beginning 0) 2)
- (+ (match-beginning 0) 3))))))
- (cond
- ((eq (car cont) 'mml)
- (let ((mml-boundary (funcall mml-boundary-function
- (incf mml-multipart-number)))
- (mml-generate-default-type "text/plain"))
- (mml-to-mime))
- (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
- ;; ignore 0x1b, it is part of iso-2022-jp
- (setq encoding (mm-body-7-or-8))))
- ((string= (car (split-string type "/")) "message")
- (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
- ;; ignore 0x1b, it is part of iso-2022-jp
- (setq encoding (mm-body-7-or-8))))
- (t
- (setq charset (mm-encode-body))
- (setq encoding (mm-body-encoding
- charset (cdr (assq 'encoding cont))))))
- (setq coded (buffer-string)))
- (mml-insert-mime-headers cont type charset encoding)
- (insert "\n")
- (insert coded))
- (mm-with-unibyte-buffer
- (cond
- ((cdr (assq 'buffer cont))
- (insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and (setq filename (cdr (assq 'filename cont)))
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (let ((coding-system-for-read mm-binary-coding-system))
- (mm-insert-file-contents filename nil nil nil nil t)))
- (t
- (insert (cdr (assq 'contents cont)))))
- (setq encoding (mm-encode-buffer type)
- coded (buffer-string)))
- (mml-insert-mime-headers cont type charset encoding)
- (insert "\n")
- (mm-with-unibyte-current-buffer
- (insert coded)))))
- ((eq (car cont) 'external)
- (insert "Content-Type: message/external-body")
- (let ((parameters (mml-parameter-string
- cont '(expiration size permission)))
- (name (cdr (assq 'name cont))))
- (when name
- (setq name (mml-parse-file-name name))
- (if (stringp name)
+ (let ((mm-use-ultra-safe-encoding
+ (or mm-use-ultra-safe-encoding (assq 'sign cont))))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mml-tweak-part cont)
+ (cond
+ ((or (eq (car cont) 'part) (eq (car cont) 'mml))
+ (let ((raw (cdr (assq 'raw cont)))
+ coded encoding charset filename type flowed)
+ (setq type (or (cdr (assq 'type cont)) "text/plain"))
+ (if (and (not raw)
+ (member (car (split-string type "/")) '("text" "message")))
+ (progn
+ (with-temp-buffer
+ (setq charset (mm-charset-to-coding-system
+ (cdr (assq 'charset cont))))
+ (when (eq charset 'ascii)
+ (setq charset nil))
+ (cond
+ ((cdr (assq 'buffer cont))
+ (insert-buffer-substring (cdr (assq 'buffer cont))))
+ ((and (setq filename (cdr (assq 'filename cont)))
+ (not (equal (cdr (assq 'nofile cont)) "yes")))
+ (let ((coding-system-for-read charset))
+ (mm-insert-file-contents filename)))
+ ((eq 'mml (car cont))
+ (insert (cdr (assq 'contents cont))))
+ (t
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (cdr (assq 'contents cont)))
+ ;; Remove quotes from quoted tags.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<#!+/?\\(part\\|multipart\\|external\\|mml\\)"
+ nil t)
+ (delete-region (+ (match-beginning 0) 2)
+ (+ (match-beginning 0) 3))))))
+ (cond
+ ((eq (car cont) 'mml)
+ (let ((mml-boundary (mml-compute-boundary cont))
+ (mml-generate-default-type "text/plain"))
+ (mml-to-mime))
+ (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
+ ;; ignore 0x1b, it is part of iso-2022-jp
+ (setq encoding (mm-body-7-or-8))))
+ ((string= (car (split-string type "/")) "message")
+ (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
+ ;; ignore 0x1b, it is part of iso-2022-jp
+ (setq encoding (mm-body-7-or-8))))
+ (t
+ ;; Only perform format=flowed filling on text/plain
+ ;; parts where there either isn't a format parameter
+ ;; in the mml tag or it says "flowed" and there
+ ;; actually are hard newlines in the text.
+ (let (use-hard-newlines)
+ (when (and (string= type "text/plain")
+ (or (null (assq 'format cont))
+ (string= (cdr (assq 'format cont))
+ "flowed"))
+ (setq use-hard-newlines
+ (text-property-any
+ (point-min) (point-max) 'hard 't)))
+ (fill-flowed-encode)
+ ;; Indicate that `mml-insert-mime-headers' should
+ ;; insert a "; format=flowed" string unless the
+ ;; user has already specified it.
+ (setq flowed (null (assq 'format cont)))))
+ (setq charset (mm-encode-body charset))
+ (setq encoding (mm-body-encoding
+ charset (cdr (assq 'encoding cont))))))
+ (setq coded (buffer-string)))
+ (mml-insert-mime-headers cont type charset encoding flowed)
+ (insert "\n")
+ (insert coded))
+ (mm-with-unibyte-buffer
+ (cond
+ ((cdr (assq 'buffer cont))
+ (insert-buffer-substring (cdr (assq 'buffer cont))))
+ ((and (setq filename (cdr (assq 'filename cont)))
+ (not (equal (cdr (assq 'nofile cont)) "yes")))
+ (let ((coding-system-for-read mm-binary-coding-system))
+ (mm-insert-file-contents filename nil nil nil nil t)))
+ (t
+ (insert (cdr (assq 'contents cont)))))
+ (setq encoding (mm-encode-buffer type)
+ coded (mm-string-as-multibyte (buffer-string))))
+ (mml-insert-mime-headers cont type charset encoding nil)
+ (insert "\n")
+ (mm-with-unibyte-current-buffer
+ (insert coded)))))
+ ((eq (car cont) 'external)
+ (insert "Content-Type: message/external-body")
+ (let ((parameters (mml-parameter-string
+ cont '(expiration size permission)))
+ (name (cdr (assq 'name cont)))
+ (url (cdr (assq 'url cont))))
+ (when name
+ (setq name (mml-parse-file-name name))
+ (if (stringp name)
+ (mml-insert-parameter
+ (mail-header-encode-parameter "name" name)
+ "access-type=local-file")
(mml-insert-parameter
- (mail-header-encode-parameter "name" name)
- "access-type=local-file")
- (mml-insert-parameter
- (mail-header-encode-parameter
- "name" (file-name-nondirectory (nth 2 name)))
- (mail-header-encode-parameter "site" (nth 1 name))
- (mail-header-encode-parameter
- "directory" (file-name-directory (nth 2 name))))
+ (mail-header-encode-parameter
+ "name" (file-name-nondirectory (nth 2 name)))
+ (mail-header-encode-parameter "site" (nth 1 name))
+ (mail-header-encode-parameter
+ "directory" (file-name-directory (nth 2 name))))
+ (mml-insert-parameter
+ (concat "access-type="
+ (if (member (nth 0 name) '("ftp@" "anonymous@"))
+ "anon-ftp"
+ "ftp")))))
+ (when url
(mml-insert-parameter
- (concat "access-type="
- (if (member (nth 0 name) '("ftp@" "anonymous@"))
- "anon-ftp"
- "ftp")))))
- (when parameters
- (mml-insert-parameter-string
- cont '(expiration size permission))))
- (insert "\n\n")
- (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
- (insert "Content-ID: " (message-make-message-id) "\n")
- (insert "Content-Transfer-Encoding: "
- (or (cdr (assq 'encoding cont)) "binary"))
- (insert "\n\n")
- (insert (or (cdr (assq 'contents cont))))
- (insert "\n"))
- ((eq (car cont) 'multipart)
- (let* ((type (or (cdr (assq 'type cont)) "mixed"))
- (mml-generate-default-type (if (equal type "digest")
- "message/rfc822"
- "text/plain"))
- (handler (assoc type mml-generate-multipart-alist)))
- (if handler
- (funcall (cdr handler) cont)
- ;; No specific handler. Use default one.
- (let ((mml-boundary (mml-compute-boundary cont)))
- (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
- type mml-boundary))
- ;; Skip `multipart' and `type' elements.
- (setq cont (cddr cont))
- (while cont
- (insert "\n--" mml-boundary "\n")
- (mml-generate-mime-1 (pop cont)))
- (insert "\n--" mml-boundary "--\n")))))
- (t
- (error "Invalid element: %S" cont)))
- (if mml-generate-mime-postprocess-function
- (funcall mml-generate-mime-postprocess-function cont))))
+ (mail-header-encode-parameter "url" url)
+ "access-type=url"))
+ (when parameters
+ (mml-insert-parameter-string
+ cont '(expiration size permission))))
+ (insert "\n\n")
+ (insert "Content-Type: " (cdr (assq 'type cont)) "\n")
+ (insert "Content-ID: " (message-make-message-id) "\n")
+ (insert "Content-Transfer-Encoding: "
+ (or (cdr (assq 'encoding cont)) "binary"))
+ (insert "\n\n")
+ (insert (or (cdr (assq 'contents cont))))
+ (insert "\n"))
+ ((eq (car cont) 'multipart)
+ (let* ((type (or (cdr (assq 'type cont)) "mixed"))
+ (mml-generate-default-type (if (equal type "digest")
+ "message/rfc822"
+ "text/plain"))
+ (handler (assoc type mml-generate-multipart-alist)))
+ (if handler
+ (funcall (cdr handler) cont)
+ ;; No specific handler. Use default one.
+ (let ((mml-boundary (mml-compute-boundary cont)))
+ (insert (format "Content-Type: multipart/%s; boundary=\"%s\""
+ type mml-boundary)
+ (if (cdr (assq 'start cont))
+ (format "; start=\"%s\"\n" (cdr (assq 'start cont)))
+ "\n"))
+ (let ((cont cont) part)
+ (while (setq part (pop cont))
+ ;; Skip `multipart' and attributes.
+ (when (and (consp part) (consp (cdr part)))
+ (insert "\n--" mml-boundary "\n")
+ (mml-generate-mime-1 part))))
+ (insert "\n--" mml-boundary "--\n")))))
+ (t
+ (error "Invalid element: %S" cont)))
+ ;; handle sign & encrypt tags in a semi-smart way.
+ (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist))
+ (encrypt-item (assoc (cdr (assq 'encrypt cont))
+ mml-encrypt-alist))
+ sender recipients)
+ (when (or sign-item encrypt-item)
+ (when (setq sender (cdr (assq 'sender cont)))
+ (message-options-set 'mml-sender sender)
+ (message-options-set 'message-sender sender))
+ (if (setq recipients (cdr (assq 'recipients cont)))
+ (message-options-set 'message-recipients recipients))
+ (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item)))))
+ ;; check if: we're both signing & encrypting, both methods
+ ;; are the same (why would they be different?!), and that
+ ;; the signencrypt style allows for combined operation.
+ (if (and sign-item encrypt-item (equal (first sign-item)
+ (first encrypt-item))
+ (equal style 'combined))
+ (funcall (nth 1 encrypt-item) cont t)
+ ;; otherwise, revert to the old behavior.
+ (when sign-item
+ (funcall (nth 1 sign-item) cont))
+ (when encrypt-item
+ (funcall (nth 1 encrypt-item) cont)))))))))
(defun mml-compute-boundary (cont)
"Return a unique boundary that does not exist in CONT."
@@ -458,34 +608,40 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
"")
mml-base-boundary))
-(defun mml-insert-mime-headers (cont type charset encoding)
- (let (parameters disposition description)
+(defun mml-insert-mime-headers (cont type charset encoding flowed)
+ (let (parameters id disposition description)
(setq parameters
(mml-parameter-string
- cont '(name access-type expiration size permission)))
+ cont mml-content-type-parameters))
(when (or charset
parameters
- (not (equal type mml-generate-default-type)))
+ flowed
+ (not (equal type mml-generate-default-type))
+ mml-insert-mime-headers-always)
(when (consp charset)
(error
- "Can't encode a part with several charsets."))
+ "Can't encode a part with several charsets"))
(insert "Content-Type: " type)
(when charset
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
+ (when flowed
+ (insert "; format=flowed"))
(when parameters
(mml-insert-parameter-string
- cont '(name access-type expiration size permission)))
+ cont mml-content-type-parameters))
(insert "\n"))
+ (when (setq id (cdr (assq 'id cont)))
+ (insert "Content-ID: " id "\n"))
(setq parameters
(mml-parameter-string
- cont '(filename creation-date modification-date read-date)))
+ cont mml-content-disposition-parameters))
(when (or (setq disposition (cdr (assq 'disposition cont)))
parameters)
(insert "Content-Disposition: " (or disposition "inline"))
(when parameters
(mml-insert-parameter-string
- cont '(filename creation-date modification-date read-date)))
+ cont mml-content-disposition-parameters))
(insert "\n"))
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
@@ -542,25 +698,28 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
;;; Transforming MIME to MML
;;;
-(defun mime-to-mml ()
- "Translate the current buffer (which should be a message) into MML."
+(defun mime-to-mml (&optional handles)
+ "Translate the current buffer (which should be a message) into MML.
+If HANDLES is non-nil, use it instead reparsing the buffer."
;; First decode the head.
(save-restriction
(message-narrow-to-head)
(mail-decode-encoded-word-region (point-min) (point-max)))
- (let ((handles (mm-dissect-buffer t)))
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (delete-region (point) (point-max))
- (if (stringp (car handles))
- (mml-insert-mime handles)
- (mml-insert-mime handles t))
- (mm-destroy-parts handles))
+ (unless handles
+ (setq handles (mm-dissect-buffer t)))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (delete-region (point) (point-max))
+ (if (stringp (car handles))
+ (mml-insert-mime handles)
+ (mml-insert-mime handles t))
+ (mm-destroy-parts handles)
(save-restriction
(message-narrow-to-head)
;; Remove them, they are confusing.
(message-remove-header "Content-Type")
(message-remove-header "MIME-Version")
+ (message-remove-header "Content-Disposition")
(message-remove-header "Content-Transfer-Encoding")))
(defun mml-to-mime ()
@@ -568,6 +727,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(message-encode-message-body)
(save-restriction
(message-narrow-to-headers-or-head)
+ ;; Skip past any From_ headers.
+ (while (looking-at "From ")
+ (forward-line 1))
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer))))
@@ -589,17 +751,20 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(mml-insert-mml-markup handle buffer textp)))
(cond
(mmlp
- (insert-buffer buffer)
+ (insert-buffer-substring buffer)
(goto-char (point-max))
(insert "<#/mml>\n"))
((stringp (car handle))
(mapcar 'mml-insert-mime (cdr handle))
(insert "<#/multipart>\n"))
(textp
- (let ((text (mm-get-part handle))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (insert (mm-decode-string text charset)))
+ (let ((charset (mail-content-type-get
+ (mm-handle-type handle) 'charset))
+ (start (point)))
+ (if (eq charset 'gnus-decoded)
+ (mm-insert-part handle)
+ (insert (mm-decode-string (mm-get-part handle) charset)))
+ (mml-quote-region start (point)))
(goto-char (point-max)))
(t
(insert "<#/part>\n")))))
@@ -607,14 +772,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
"Take a MIME handle and insert an MML tag."
(if (stringp (car handle))
- (insert "<#multipart type=" (mm-handle-media-subtype handle)
- ">\n")
+ (progn
+ (insert "<#multipart type=" (mm-handle-media-subtype handle))
+ (let ((start (mm-handle-multipart-ctl-parameter handle 'start)))
+ (when start
+ (insert " start=\"" start "\"")))
+ (insert ">\n"))
(if mmlp
(insert "<#mml type=" (mm-handle-media-type handle))
(insert "<#part type=" (mm-handle-media-type handle)))
(dolist (elem (append (cdr (mm-handle-type handle))
(cdr (mm-handle-disposition handle))))
- (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))
+ (unless (symbolp (cdr elem))
+ (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
+ (when (mm-handle-id handle)
+ (insert " id=\"" (mm-handle-id handle) "\""))
(when (mm-handle-disposition handle)
(insert " disposition=" (car (mm-handle-disposition handle))))
(when buffer
@@ -641,8 +813,25 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
;;;
(defvar mml-mode-map
- (let ((map (make-sparse-keymap))
+ (let ((sign (make-sparse-keymap))
+ (encrypt (make-sparse-keymap))
+ (signpart (make-sparse-keymap))
+ (encryptpart (make-sparse-keymap))
+ (map (make-sparse-keymap))
(main (make-sparse-keymap)))
+ (define-key sign "p" 'mml-secure-message-sign-pgpmime)
+ (define-key sign "o" 'mml-secure-message-sign-pgp)
+ (define-key sign "s" 'mml-secure-message-sign-smime)
+ (define-key signpart "p" 'mml-secure-sign-pgpmime)
+ (define-key signpart "o" 'mml-secure-sign-pgp)
+ (define-key signpart "s" 'mml-secure-sign-smime)
+ (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
+ (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
+ (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
+ (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
+ (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
+ (define-key encryptpart "s" 'mml-secure-encrypt-smime)
+ (define-key map "\C-n" 'mml-unsecure-message)
(define-key map "f" 'mml-attach-file)
(define-key map "b" 'mml-attach-buffer)
(define-key map "e" 'mml-attach-external)
@@ -651,23 +840,43 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(define-key map "p" 'mml-insert-part)
(define-key map "v" 'mml-validate)
(define-key map "P" 'mml-preview)
+ (define-key map "s" sign)
+ (define-key map "S" signpart)
+ (define-key map "c" encrypt)
+ (define-key map "C" encryptpart)
;;(define-key map "n" 'mml-narrow-to-part)
- (define-key main "\M-m" map)
+ ;; `M-m' conflicts with `back-to-indentation'.
+ ;; (define-key main "\M-m" map)
+ (define-key main "\C-c\C-m" map)
main))
(easy-menu-define
mml-menu mml-mode-map ""
- '("MML"
- ("Attach"
- ["File" mml-attach-file t]
- ["Buffer" mml-attach-buffer t]
- ["External" mml-attach-external t])
- ("Insert"
- ["Multipart" mml-insert-multipart t]
- ["Part" mml-insert-part t])
+ `("Attachments"
+ ["Attach File..." mml-attach-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Attach a file at point"))]
+ ["Attach Buffer..." mml-attach-buffer t]
+ ["Attach External..." mml-attach-external t]
+ ["Insert Part..." mml-insert-part t]
+ ["Insert Multipart..." mml-insert-multipart t]
+ ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t]
+ ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t]
+ ["PGP Sign" mml-secure-message-sign-pgp t]
+ ["PGP Encrypt" mml-secure-message-encrypt-pgp t]
+ ["S/MIME Sign" mml-secure-message-sign-smime t]
+ ["S/MIME Encrypt" mml-secure-message-encrypt-smime t]
+ ("Secure MIME part"
+ ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t]
+ ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t]
+ ["PGP Sign Part" mml-secure-sign-pgp t]
+ ["PGP Encrypt Part" mml-secure-encrypt-pgp t]
+ ["S/MIME Sign Part" mml-secure-sign-smime t]
+ ["S/MIME Encrypt Part" mml-secure-encrypt-smime t])
+ ["Encrypt/Sign off" mml-unsecure-message t]
;;["Narrow" mml-narrow-to-part t]
- ["Quote" mml-quote-region t]
- ["Validate" mml-validate t]
+ ["Quote MML" mml-quote-region t]
+ ["Validate MML" mml-validate t]
["Preview" mml-preview t]))
(defvar mml-mode nil
@@ -675,20 +884,17 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(defun mml-mode (&optional arg)
"Minor mode for editing MML.
+MML is the MIME Meta Language, a minor mode for composing MIME articles.
+See Info node `(emacs-mime)Composing'.
\\{mml-mode-map}"
(interactive "P")
- (if (not (set (make-local-variable 'mml-mode)
- (if (null arg) (not mml-mode)
- (> (prefix-numeric-value arg) 0))))
- nil
- (set (make-local-variable 'mml-mode) t)
- (unless (assq 'mml-mode minor-mode-alist)
- (push `(mml-mode " MML") minor-mode-alist))
- (unless (assq 'mml-mode minor-mode-map-alist)
- (push (cons 'mml-mode mml-mode-map)
- minor-mode-map-alist)))
- (run-hooks 'mml-mode-hook))
+ (when (set (make-local-variable 'mml-mode)
+ (if (null arg) (not mml-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (gnus-add-minor-mode 'mml-mode " MML" mml-mode-map)
+ (easy-menu-add mml-menu mml-mode-map)
+ (run-hooks 'mml-mode-hook)))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
@@ -696,8 +902,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
;;;
(defun mml-minibuffer-read-file (prompt)
- (let ((file (read-file-name prompt nil nil t)))
- ;; Prevent some common errors. This is inspired by similar code in
+ (let* ((completion-ignored-extensions nil)
+ (file (read-file-name prompt nil nil t)))
+ ;; Prevent some common errors. This is inspired by similar code in
;; VM.
(when (file-directory-p file)
(error "%s is a directory, cannot attach" file))
@@ -728,6 +935,19 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(setq description nil))
description))
+(defun mml-minibuffer-read-disposition (type &optional default)
+ (let* ((default (or default
+ (if (string-match "^text/.*" type)
+ "inline"
+ "attachment")))
+ (disposition (completing-read "Disposition: "
+ '(("attachment") ("inline") (""))
+ nil
+ nil)))
+ (if (not (equal disposition ""))
+ disposition
+ default)))
+
(defun mml-quote-region (beg end)
"Quote the MML tags in the region."
(interactive "r")
@@ -755,7 +975,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(when value
;; Quote VALUE if it contains suspicious characters.
(when (string-match "[\"'\\~/*;() \t\n]" value)
- (setq value (prin1-to-string value)))
+ (setq value (with-output-to-string
+ (let (print-escape-nonascii)
+ (prin1 value)))))
(insert (format " %s=%s" key value)))))
(insert ">\n"))
@@ -768,7 +990,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
;;; Attachment functions.
-(defun mml-attach-file (file &optional type description)
+(defun mml-attach-file (file &optional type description disposition)
"Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with
`\\[message-send-and-exit]' or `\\[message-send]'.
@@ -779,10 +1001,14 @@ description of the attachment."
(interactive
(let* ((file (mml-minibuffer-read-file "Attach file: "))
(type (mml-minibuffer-read-type file))
- (description (mml-minibuffer-read-description)))
- (list file type description)))
- (mml-insert-empty-tag 'part 'type type 'filename file
- 'disposition "attachment" 'description description))
+ (description (mml-minibuffer-read-description))
+ (disposition (mml-minibuffer-read-disposition type)))
+ (list file type description disposition)))
+ (mml-insert-empty-tag 'part
+ 'type type
+ 'filename file
+ 'disposition (or disposition "attachment")
+ 'description description))
(defun mml-attach-buffer (buffer &optional type description)
"Attach a buffer to the outgoing MIME message.
@@ -823,48 +1049,126 @@ TYPE is the MIME type to use."
(mml-insert-tag 'part 'type type 'disposition "inline")
(forward-line -1))
+(defun mml-preview-insert-mail-followup-to ()
+ "Insert a Mail-Followup-To header before previewing an article.
+Should be adopted if code in `message-send-mail' is changed."
+ (when (and (message-mail-p)
+ (message-subscribed-p)
+ (not (mail-fetch-field "mail-followup-to"))
+ (message-make-mail-followup-to))
+ (message-position-on-field "Mail-Followup-To" "X-Draft-From")
+ (insert (message-make-mail-followup-to))))
+
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
If RAW, don't highlight the article."
(interactive "P")
- (let ((buf (current-buffer))
- (message-posting-charset (or (gnus-setup-posting-charset
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups")))
- message-posting-charset)))
- (switch-to-buffer (get-buffer-create
- (concat (if raw "*Raw MIME preview of "
- "*MIME preview of ") (buffer-name))))
- (erase-buffer)
- (insert-buffer buf)
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
- (replace-match "\n"))
- (let ((mail-header-separator "")) ;; mail-header-separator is removed.
- (mml-to-mime))
- (if raw
- (when (fboundp 'set-buffer-multibyte)
- (let ((s (buffer-string)))
- ;; Insert the content into unibyte buffer.
- (erase-buffer)
- (mm-disable-multibyte)
- (insert s)))
- (let ((gnus-newsgroup-charset (car message-posting-charset)))
- (run-hooks 'gnus-article-decode-hook)
- (let ((gnus-newsgroup-name "dummy"))
- (gnus-article-prepare-display))))
- ;; Disable article-mode-map.
- (use-local-map nil)
- (setq buffer-read-only t)
- (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
- (goto-char (point-min))))
+ (save-excursion
+ (let* ((buf (current-buffer))
+ (message-options message-options)
+ (message-this-is-mail (message-mail-p))
+ (message-this-is-news (message-news-p))
+ (message-posting-charset (or (gnus-setup-posting-charset
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Newsgroups")))
+ message-posting-charset)))
+ (message-options-set-recipient)
+ (switch-to-buffer (generate-new-buffer
+ (concat (if raw "*Raw MIME preview of "
+ "*MIME preview of ") (buffer-name))))
+ (when (boundp 'gnus-buffers)
+ (push (current-buffer) gnus-buffers))
+ (erase-buffer)
+ (insert-buffer-substring buf)
+ (mml-preview-insert-mail-followup-to)
+ (let ((message-deletable-headers (if (message-news-p)
+ nil
+ message-deletable-headers)))
+ (message-generate-headers
+ (copy-sequence (if (message-news-p)
+ message-required-news-headers
+ message-required-mail-headers))))
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
+ (replace-match "\n"))
+ (let ((mail-header-separator ""));; mail-header-separator is removed.
+ (mml-to-mime))
+ (if raw
+ (when (fboundp 'set-buffer-multibyte)
+ (let ((s (buffer-string)))
+ ;; Insert the content into unibyte buffer.
+ (erase-buffer)
+ (mm-disable-multibyte)
+ (insert s)))
+ (let ((gnus-newsgroup-charset (car message-posting-charset))
+ gnus-article-prepare-hook gnus-original-article-buffer)
+ (run-hooks 'gnus-article-decode-hook)
+ (let ((gnus-newsgroup-name "dummy")
+ (gnus-newsrc-hashtb (or gnus-newsrc-hashtb
+ (gnus-make-hashtable 5))))
+ (gnus-article-prepare-display))))
+ ;; Disable article-mode-map.
+ (use-local-map nil)
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook
+ (lambda ()
+ (mm-destroy-parts gnus-article-mime-handles)) nil t)
+ (setq buffer-read-only t)
+ (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
+ (local-set-key "=" (lambda () (interactive) (delete-other-windows)))
+ (local-set-key "\r"
+ (lambda ()
+ (interactive)
+ (widget-button-press (point))))
+ (local-set-key gnus-mouse-2
+ (lambda (event)
+ (interactive "@e")
+ (widget-button-press (widget-event-point event) event)))
+ (goto-char (point-min)))))
(defun mml-validate ()
"Validate the current MML document."
(interactive)
(mml-parse))
+(defun mml-tweak-part (cont)
+ "Tweak a MML part."
+ (let ((tweak (cdr (assq 'tweak cont)))
+ func)
+ (cond
+ (tweak
+ (setq func
+ (or (cdr (assoc tweak mml-tweak-function-alist))
+ (intern tweak))))
+ (mml-tweak-type-alist
+ (let ((alist mml-tweak-type-alist)
+ (type (or (cdr (assq 'type cont)) "text/plain")))
+ (while alist
+ (if (string-match (caar alist) type)
+ (setq func (cdar alist)
+ alist nil)
+ (setq alist (cdr alist)))))))
+ (if func
+ (funcall func cont)
+ cont)
+ (let ((alist mml-tweak-sexp-alist))
+ (while alist
+ (if (eval (caar alist))
+ (funcall (cdar alist) cont))
+ (setq alist (cdr alist)))))
+ cont)
+
+(defun mml-tweak-externalize-attachments (cont)
+ "Tweak attached files as external parts."
+ (let (filename-cons)
+ (when (and (eq (car cont) 'part)
+ (not (cdr (assq 'buffer cont)))
+ (and (setq filename-cons (assq 'filename cont))
+ (not (equal (cdr (assq 'nofile cont)) "yes"))))
+ (setcar cont 'external)
+ (setcar filename-cons 'name))))
+
(provide 'mml)
;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
new file mode 100644
index 00000000000..14d52e45ce4
--- /dev/null
+++ b/lisp/gnus/mml1991.el
@@ -0,0 +1,307 @@
+;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
+;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Sascha Lüdecke <sascha@meta-x.de>,
+;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
+;; Keywords PGP
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl)
+ (require 'mm-util))
+
+(autoload 'quoted-printable-decode-region "qp")
+(autoload 'quoted-printable-encode-region "qp")
+
+(defvar mml1991-use mml2015-use
+ "The package used for PGP.")
+
+(defvar mml1991-function-alist
+ '((mailcrypt mml1991-mailcrypt-sign
+ mml1991-mailcrypt-encrypt)
+ (gpg mml1991-gpg-sign
+ mml1991-gpg-encrypt)
+ (pgg mml1991-pgg-sign
+ mml1991-pgg-encrypt))
+ "Alist of PGP functions.")
+
+;;; mailcrypt wrapper
+
+(eval-and-compile
+ (autoload 'mc-sign-generic "mc-toplev"))
+
+(defvar mml1991-decrypt-function 'mailcrypt-decrypt)
+(defvar mml1991-verify-function 'mailcrypt-verify)
+
+(defun mml1991-mailcrypt-sign (cont)
+ (let ((text (current-buffer))
+ headers signature
+ (result-buffer (get-buffer-create "*GPG Result*")))
+ ;; Save MIME Content[^ ]+: headers from signing
+ (goto-char (point-min))
+ (while (looking-at "^Content[^ ]+:") (forward-line))
+ (unless (bobp)
+ (setq headers (buffer-string))
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (quoted-printable-decode-region (point-min) (point-max))
+ (with-temp-buffer
+ (setq signature (current-buffer))
+ (insert-buffer-substring text)
+ (unless (mc-sign-generic (message-options-get 'message-sender)
+ nil nil nil nil)
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Sign error")))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (quoted-printable-encode-region (point-min) (point-max))
+ (set-buffer text)
+ (delete-region (point-min) (point-max))
+ (if headers (insert headers))
+ (insert "\n")
+ (insert-buffer-substring signature)
+ (goto-char (point-max)))))
+
+(defun mml1991-mailcrypt-encrypt (cont &optional sign)
+ (let ((text (current-buffer))
+ (mc-pgp-always-sign
+ (or mc-pgp-always-sign
+ sign
+ (eq t (or (message-options-get 'message-sign-encrypt)
+ (message-options-set
+ 'message-sign-encrypt
+ (or (y-or-n-p "Sign the message? ")
+ 'not))))
+ 'never))
+ cipher
+ (result-buffer (get-buffer-create "*GPG Result*")))
+ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+ (goto-char (point-min))
+ (while (looking-at "^Content[^ ]+:") (forward-line))
+ (unless (bobp)
+ (delete-region (point-min) (point)))
+ (mm-with-unibyte-current-buffer
+ (with-temp-buffer
+ (setq cipher (current-buffer))
+ (insert-buffer-substring text)
+ (unless (mc-encrypt-generic
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ nil
+ (point-min) (point-max)
+ (message-options-get 'message-sender)
+ 'sign)
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Encrypt error")))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (set-buffer text)
+ (delete-region (point-min) (point-max))
+ ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+ ;;(insert "Version: 1\n\n")
+ (insert "\n")
+ (insert-buffer-substring cipher)
+ (goto-char (point-max))))))
+
+;;; gpg wrapper
+
+(eval-and-compile
+ (autoload 'gpg-sign-cleartext "gpg"))
+
+(defun mml1991-gpg-sign (cont)
+ (let ((text (current-buffer))
+ headers signature
+ (result-buffer (get-buffer-create "*GPG Result*")))
+ ;; Save MIME Content[^ ]+: headers from signing
+ (goto-char (point-min))
+ (while (looking-at "^Content[^ ]+:") (forward-line))
+ (unless (bobp)
+ (setq headers (buffer-string))
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (quoted-printable-decode-region (point-min) (point-max))
+ (with-temp-buffer
+ (unless (gpg-sign-cleartext text (setq signature (current-buffer))
+ result-buffer
+ nil
+ (message-options-get 'message-sender))
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Sign error")))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (quoted-printable-encode-region (point-min) (point-max))
+ (set-buffer text)
+ (delete-region (point-min) (point-max))
+ (if headers (insert headers))
+ (insert "\n")
+ (insert-buffer-substring signature)
+ (goto-char (point-max)))))
+
+(defun mml1991-gpg-encrypt (cont &optional sign)
+ (let ((text (current-buffer))
+ cipher
+ (result-buffer (get-buffer-create "*GPG Result*")))
+ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+ (goto-char (point-min))
+ (while (looking-at "^Content[^ ]+:") (forward-line))
+ (unless (bobp)
+ (delete-region (point-min) (point)))
+ (mm-with-unibyte-current-buffer
+ (with-temp-buffer
+ (flet ((gpg-encrypt-func
+ (sign plaintext ciphertext result recipients &optional
+ passphrase sign-with-key armor textmode)
+ (if sign
+ (gpg-sign-encrypt
+ plaintext ciphertext result recipients passphrase
+ sign-with-key armor textmode)
+ (gpg-encrypt
+ plaintext ciphertext result recipients passphrase
+ armor textmode))))
+ (unless (gpg-encrypt-func
+ sign
+ text (setq cipher (current-buffer))
+ result-buffer
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ nil
+ (message-options-get 'message-sender)
+ t t) ; armor & textmode
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer result-buffer)
+ (error "Encrypt error"))))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (set-buffer text)
+ (delete-region (point-min) (point-max))
+ ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+ ;;(insert "Version: 1\n\n")
+ (insert "\n")
+ (insert-buffer-substring cipher)
+ (goto-char (point-max))))))
+
+;; pgg wrapper
+
+(defvar pgg-output-buffer)
+(defvar pgg-errors-buffer)
+
+(defun mml1991-pgg-sign (cont)
+ (let (headers cte)
+ ;; Don't sign headers.
+ (goto-char (point-min))
+ (while (not (looking-at "^$"))
+ (forward-line))
+ (unless (eobp) ;; no headers?
+ (setq headers (buffer-substring (point-min) (point)))
+ (forward-line) ;; skip header/body separator
+ (delete-region (point-min) (point)))
+ (when (string-match "^Content-Transfer-Encoding: \\(.+\\)" headers)
+ (setq cte (intern (match-string 1 headers))))
+ (mm-decode-content-transfer-encoding cte)
+ (unless (let ((pgg-default-user-id
+ (or (message-options-get 'mml-sender)
+ pgg-default-user-id)))
+ (pgg-sign-region (point-min) (point-max) t))
+ (pop-to-buffer pgg-errors-buffer)
+ (error "Encrypt error"))
+ (delete-region (point-min) (point-max))
+ (mm-with-unibyte-current-buffer
+ (insert-buffer-substring pgg-output-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (mm-encode-content-transfer-encoding cte)
+ (goto-char (point-min))
+ (when headers
+ (insert headers))
+ (insert "\n"))
+ t))
+
+(defun mml1991-pgg-encrypt (cont &optional sign)
+ (let (cte)
+ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
+ (goto-char (point-min))
+ (while (looking-at "^Content[^ ]+:")
+ (when (looking-at "^Content-Transfer-Encoding: \\(.+\\)")
+ (setq cte (intern (match-string 1))))
+ (forward-line))
+ (unless (bobp)
+ (delete-region (point-min) (point)))
+ (mm-decode-content-transfer-encoding cte)
+ (unless (pgg-encrypt-region
+ (point-min) (point-max)
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ sign)
+ (pop-to-buffer pgg-errors-buffer)
+ (error "Encrypt error"))
+ (delete-region (point-min) (point-max))
+ ;;(insert "Content-Type: application/pgp-encrypted\n\n")
+ ;;(insert "Version: 1\n\n")
+ (insert "\n")
+ (insert-buffer-substring pgg-output-buffer)
+ t))
+
+;;;###autoload
+(defun mml1991-encrypt (cont &optional sign)
+ (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
+ (if func
+ (funcall func cont sign)
+ (error "Cannot find encrypt function"))))
+
+;;;###autoload
+(defun mml1991-sign (cont)
+ (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
+ (if func
+ (funcall func cont)
+ (error "Cannot find sign function"))))
+
+(provide 'mml1991)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706
+;;; mml1991.el ends here
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
new file mode 100644
index 00000000000..995e113e02f
--- /dev/null
+++ b/lisp/gnus/mml2015.el
@@ -0,0 +1,918 @@
+;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: PGP MIME MML
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; RFC 2015 is updated by RFC 3156, this file should be compatible
+;; with both.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'mm-decode)
+(require 'mm-util)
+(require 'mml)
+
+(defvar mml2015-use (or
+ (progn
+ (ignore-errors
+ (require 'pgg))
+ (and (fboundp 'pgg-sign-region)
+ 'pgg))
+ (progn
+ (ignore-errors
+ (require 'gpg))
+ (and (fboundp 'gpg-sign-detached)
+ 'gpg))
+ (progn (ignore-errors
+ (load "mc-toplev"))
+ (and (fboundp 'mc-encrypt-generic)
+ (fboundp 'mc-sign-generic)
+ (fboundp 'mc-cleanup-recipient-headers)
+ 'mailcrypt)))
+ "The package used for PGP/MIME.")
+
+;; Something is not RFC2015.
+(defvar mml2015-function-alist
+ '((mailcrypt mml2015-mailcrypt-sign
+ mml2015-mailcrypt-encrypt
+ mml2015-mailcrypt-verify
+ mml2015-mailcrypt-decrypt
+ mml2015-mailcrypt-clear-verify
+ mml2015-mailcrypt-clear-decrypt)
+ (gpg mml2015-gpg-sign
+ mml2015-gpg-encrypt
+ mml2015-gpg-verify
+ mml2015-gpg-decrypt
+ mml2015-gpg-clear-verify
+ mml2015-gpg-clear-decrypt)
+ (pgg mml2015-pgg-sign
+ mml2015-pgg-encrypt
+ mml2015-pgg-verify
+ mml2015-pgg-decrypt
+ mml2015-pgg-clear-verify
+ mml2015-pgg-clear-decrypt))
+ "Alist of PGP/MIME functions.")
+
+(defvar mml2015-result-buffer nil)
+
+(defcustom mml2015-unabbrev-trust-alist
+ '(("TRUST_UNDEFINED" . nil)
+ ("TRUST_NEVER" . nil)
+ ("TRUST_MARGINAL" . t)
+ ("TRUST_FULLY" . t)
+ ("TRUST_ULTIMATE" . t))
+ "Map GnuPG trust output values to a boolean saying if you trust the key."
+ :type '(repeat (cons (regexp :tag "GnuPG output regexp")
+ (boolean :tag "Trust key"))))
+
+;;; mailcrypt wrapper
+
+(eval-and-compile
+ (autoload 'mailcrypt-decrypt "mailcrypt")
+ (autoload 'mailcrypt-verify "mailcrypt")
+ (autoload 'mc-pgp-always-sign "mailcrypt")
+ (autoload 'mc-encrypt-generic "mc-toplev")
+ (autoload 'mc-cleanup-recipient-headers "mc-toplev")
+ (autoload 'mc-sign-generic "mc-toplev"))
+
+(eval-when-compile
+ (defvar mc-default-scheme)
+ (defvar mc-schemes))
+
+(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
+(defvar mml2015-verify-function 'mailcrypt-verify)
+
+(defun mml2015-format-error (err)
+ (if (stringp (cadr err))
+ (cadr err)
+ (format "%S" (cdr err))))
+
+(defun mml2015-mailcrypt-decrypt (handle ctl)
+ (catch 'error
+ (let (child handles result)
+ (unless (setq child (mm-find-part-by-type
+ (cdr handle)
+ "application/octet-stream" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (mm-insert-part child)
+ (setq result
+ (condition-case err
+ (funcall mml2015-decrypt-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil)))
+ (unless (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))
+ (setq handles (mm-dissect-buffer t)))
+ (mm-destroy-parts handle)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (concat "OK"
+ (let ((sig (with-current-buffer mml2015-result-buffer
+ (mml2015-gpg-extract-signature-details))))
+ (concat ", Signer: " sig))))
+ (if (listp (car handles))
+ handles
+ (list handles)))))
+
+(defun mml2015-mailcrypt-clear-decrypt ()
+ (let (result)
+ (setq result
+ (condition-case err
+ (funcall mml2015-decrypt-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil)))
+ (if (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-fix-micalg (alg)
+ (and alg
+ ;; Mutt/1.2.5i has seen sending micalg=php-sha1
+ (upcase (if (string-match "^p[gh]p-" alg)
+ (substring alg (match-end 0))
+ alg))))
+
+(defun mml2015-mailcrypt-verify (handle ctl)
+ (catch 'error
+ (let (part)
+ (unless (setq part (mm-find-raw-part-by-type
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
+ "application/pgp-signature")
+ t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
+ (insert (format "Hash: %s\n\n"
+ (or (mml2015-fix-micalg
+ (mm-handle-multipart-ctl-parameter
+ ctl 'micalg))
+ "SHA1")))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert part "\n")
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at "^-")
+ (insert "- "))
+ (forward-line)))
+ (unless (setq part (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (mm-insert-part part)
+ (goto-char (point-min))
+ (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
+ (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
+ (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
+ (replace-match "-----END PGP SIGNATURE-----" t t)))
+ (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (unless (condition-case err
+ (prog1
+ (funcall mml2015-verify-function)
+ (if (get-buffer " *mailcrypt stderr temp")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer " *mailcrypt stderr temp"
+ (buffer-string))))
+ (if (get-buffer " *mailcrypt stdout temp")
+ (kill-buffer " *mailcrypt stdout temp"))
+ (if (get-buffer " *mailcrypt stderr temp")
+ (kill-buffer " *mailcrypt stderr temp"))
+ (if (get-buffer " *mailcrypt status temp")
+ (kill-buffer " *mailcrypt status temp"))
+ (if (get-buffer mc-gpg-debug-buffer)
+ (kill-buffer mc-gpg-debug-buffer)))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ handle)))
+
+(defun mml2015-mailcrypt-clear-verify ()
+ (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (if (condition-case err
+ (prog1
+ (funcall mml2015-verify-function)
+ (if (get-buffer " *mailcrypt stderr temp")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer " *mailcrypt stderr temp"
+ (buffer-string))))
+ (if (get-buffer " *mailcrypt stdout temp")
+ (kill-buffer " *mailcrypt stdout temp"))
+ (if (get-buffer " *mailcrypt stderr temp")
+ (kill-buffer " *mailcrypt stderr temp"))
+ (if (get-buffer " *mailcrypt status temp")
+ (kill-buffer " *mailcrypt status temp"))
+ (if (get-buffer mc-gpg-debug-buffer)
+ (kill-buffer mc-gpg-debug-buffer)))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-mailcrypt-sign (cont)
+ (mc-sign-generic (message-options-get 'message-sender)
+ nil nil nil nil)
+ (let ((boundary (mml-compute-boundary cont))
+ hash point)
+ (goto-char (point-min))
+ (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
+ (error "Cannot find signed begin line"))
+ (goto-char (match-beginning 0))
+ (forward-line 1)
+ (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
+ (error "Cannot not find PGP hash"))
+ (setq hash (match-string 1))
+ (unless (re-search-forward "^$" nil t)
+ (error "Cannot not find PGP message"))
+ (forward-line 1)
+ (delete-region (point-min) (point))
+ (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+ boundary))
+ (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
+ (downcase hash)))
+ (insert (format "\n--%s\n" boundary))
+ (setq point (point))
+ (goto-char (point-max))
+ (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
+ (error "Cannot find signature part"))
+ (replace-match "-----END PGP MESSAGE-----" t t)
+ (goto-char (match-beginning 0))
+ (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
+ nil t)
+ (error "Cannot find signature part"))
+ (replace-match "-----BEGIN PGP MESSAGE-----" t t)
+ (goto-char (match-beginning 0))
+ (save-restriction
+ (narrow-to-region point (point))
+ (goto-char point)
+ (while (re-search-forward "^- -" nil t)
+ (replace-match "-" t t))
+ (goto-char (point-max)))
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/pgp-signature\n\n")
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))
+
+(defun mml2015-mailcrypt-encrypt (cont &optional sign)
+ (let ((mc-pgp-always-sign
+ (or mc-pgp-always-sign
+ sign
+ (eq t (or (message-options-get 'message-sign-encrypt)
+ (message-options-set
+ 'message-sign-encrypt
+ (or (y-or-n-p "Sign the message? ")
+ 'not))))
+ 'never)))
+ (mm-with-unibyte-current-buffer
+ (mc-encrypt-generic
+ (or (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (mc-cleanup-recipient-headers
+ (read-string "Recipients: "))))
+ nil nil nil
+ (message-options-get 'message-sender))))
+ (goto-char (point-min))
+ (unless (looking-at "-----BEGIN PGP MESSAGE-----")
+ (error "Fail to encrypt the message"))
+ (let ((boundary (mml-compute-boundary cont)))
+ (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+ boundary))
+ (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/pgp-encrypted\n\n")
+ (insert "Version: 1\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/octet-stream\n\n")
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))
+
+;;; gpg wrapper
+
+(eval-and-compile
+ (autoload 'gpg-decrypt "gpg")
+ (autoload 'gpg-verify "gpg")
+ (autoload 'gpg-verify-cleartext "gpg")
+ (autoload 'gpg-sign-detached "gpg")
+ (autoload 'gpg-sign-encrypt "gpg")
+ (autoload 'gpg-encrypt "gpg")
+ (autoload 'gpg-passphrase-read "gpg"))
+
+(defun mml2015-gpg-passphrase ()
+ (or (message-options-get 'gpg-passphrase)
+ (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
+
+(defun mml2015-gpg-decrypt-1 ()
+ (let ((cipher (current-buffer)) plain result)
+ (if (with-temp-buffer
+ (prog1
+ (gpg-decrypt cipher (setq plain (current-buffer))
+ mml2015-result-buffer nil)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string)))
+ (set-buffer cipher)
+ (erase-buffer)
+ (insert-buffer-substring plain)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))))
+ '(t)
+ ;; Some wrong with the return value, check plain text buffer.
+ (if (> (point-max) (point-min))
+ '(t)
+ nil))))
+
+(defun mml2015-gpg-decrypt (handle ctl)
+ (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
+ (mml2015-mailcrypt-decrypt handle ctl)))
+
+(defun mml2015-gpg-clear-decrypt ()
+ (let (result)
+ (setq result (mml2015-gpg-decrypt-1))
+ (if (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-gpg-pretty-print-fpr (fingerprint)
+ (let* ((result "")
+ (fpr-length (string-width fingerprint))
+ (n-slice 0)
+ slice)
+ (setq fingerprint (string-to-list fingerprint))
+ (while fingerprint
+ (setq fpr-length (- fpr-length 4))
+ (setq slice (butlast fingerprint fpr-length))
+ (setq fingerprint (nthcdr 4 fingerprint))
+ (setq n-slice (1+ n-slice))
+ (setq result
+ (concat
+ result
+ (case n-slice
+ (1 slice)
+ (otherwise (concat " " slice))))))
+ result))
+
+(defun mml2015-gpg-extract-signature-details ()
+ (goto-char (point-min))
+ (let* ((expired (re-search-forward
+ "^\\[GNUPG:\\] SIGEXPIRED$"
+ nil t))
+ (signer (and (re-search-forward
+ "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
+ nil t)
+ (cons (match-string 1) (match-string 2))))
+ (fprint (and (re-search-forward
+ "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
+ nil t)
+ (match-string 1)))
+ (trust (and (re-search-forward
+ "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
+ nil t)
+ (match-string 1)))
+ (trust-good-enough-p
+ (cdr (assoc trust mml2015-unabbrev-trust-alist))))
+ (cond ((and signer fprint)
+ (concat (cdr signer)
+ (unless trust-good-enough-p
+ (concat "\nUntrusted, Fingerprint: "
+ (mml2015-gpg-pretty-print-fpr fprint)))
+ (when expired
+ (format "\nWARNING: Signature from expired key (%s)"
+ (car signer)))))
+ ((re-search-forward
+ "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
+ (match-string 2))
+ (t
+ "From unknown user"))))
+
+(defun mml2015-gpg-verify (handle ctl)
+ (catch 'error
+ (let (part message signature info-is-set-p)
+ (unless (setq part (mm-find-raw-part-by-type
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
+ "application/pgp-signature")
+ t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (setq message (current-buffer))
+ (insert part)
+ ;; Convert <LF> to <CR><LF> in verify mode. Sign and
+ ;; clearsign use --textmode. The conversion is not necessary.
+ ;; In clearverify, the conversion is not necessary either.
+ (goto-char (point-min))
+ (end-of-line)
+ (while (not (eobp))
+ (unless (eq (char-before) ?\r)
+ (insert "\r"))
+ (forward-line)
+ (end-of-line))
+ (with-temp-buffer
+ (setq signature (current-buffer))
+ (unless (setq part (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (mm-insert-part part)
+ (unless (condition-case err
+ (prog1
+ (gpg-verify message signature mml2015-result-buffer)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string))))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Error.")
+ (setq info-is-set-p t)
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Quit.")
+ (setq info-is-set-p t)
+ nil))
+ (unless info-is-set-p
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))
+ (throw 'error handle)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (with-current-buffer mml2015-result-buffer
+ (mml2015-gpg-extract-signature-details))))
+ handle)))
+
+(defun mml2015-gpg-clear-verify ()
+ (if (condition-case err
+ (prog1
+ (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string))))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (with-current-buffer mml2015-result-buffer
+ (mml2015-gpg-extract-signature-details)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")))
+
+(defun mml2015-gpg-sign (cont)
+ (let ((boundary (mml-compute-boundary cont))
+ (text (current-buffer)) signature)
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (with-temp-buffer
+ (unless (gpg-sign-detached text (setq signature (current-buffer))
+ mml2015-result-buffer
+ nil
+ (message-options-get 'message-sender)
+ t t) ; armor & textmode
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Sign error")))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (set-buffer text)
+ (goto-char (point-min))
+ (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+ boundary))
+ ;;; FIXME: what is the micalg?
+ (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
+ (insert (format "\n--%s\n" boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s\n" boundary))
+ (insert "Content-Type: application/pgp-signature\n\n")
+ (insert-buffer-substring signature)
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max)))))
+
+(defun mml2015-gpg-encrypt (cont &optional sign)
+ (let ((boundary (mml-compute-boundary cont))
+ (text (current-buffer))
+ cipher)
+ (mm-with-unibyte-current-buffer
+ (with-temp-buffer
+ ;; set up a function to call the correct gpg encrypt routine
+ ;; with the right arguments. (FIXME: this should be done
+ ;; differently.)
+ (flet ((gpg-encrypt-func
+ (sign plaintext ciphertext result recipients &optional
+ passphrase sign-with-key armor textmode)
+ (if sign
+ (gpg-sign-encrypt
+ plaintext ciphertext result recipients passphrase
+ sign-with-key armor textmode)
+ (gpg-encrypt
+ plaintext ciphertext result recipients passphrase
+ armor textmode))))
+ (unless (gpg-encrypt-func
+ sign ; passed in when using signencrypt
+ text (setq cipher (current-buffer))
+ mml2015-result-buffer
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ nil
+ (message-options-get 'message-sender)
+ t t) ; armor & textmode
+ (unless (> (point-max) (point-min))
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Encrypt error"))))
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (set-buffer text)
+ (delete-region (point-min) (point-max))
+ (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+ boundary))
+ (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/pgp-encrypted\n\n")
+ (insert "Version: 1\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/octet-stream\n\n")
+ (insert-buffer-substring cipher)
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))))
+
+;;; pgg wrapper
+
+(eval-when-compile
+ (defvar pgg-errors-buffer)
+ (defvar pgg-output-buffer))
+
+(eval-and-compile
+ (autoload 'pgg-decrypt-region "pgg")
+ (autoload 'pgg-verify-region "pgg")
+ (autoload 'pgg-sign-region "pgg")
+ (autoload 'pgg-encrypt-region "pgg"))
+
+(defun mml2015-pgg-decrypt (handle ctl)
+ (catch 'error
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ child handles result decrypt-status)
+ (unless (setq child (mm-find-part-by-type
+ (cdr handle)
+ "application/octet-stream" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (mm-insert-part child)
+ (if (condition-case err
+ (prog1
+ (pgg-decrypt-region (point-min) (point-max))
+ (setq decrypt-status
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ decrypt-status))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (with-current-buffer pgg-output-buffer
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (setq handles (mm-dissect-buffer t))
+ (mm-destroy-parts handle)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat decrypt-status
+ (when (stringp (car handles))
+ "\n" (mm-handle-multipart-ctl-parameter
+ handles 'gnus-details))))
+ (if (listp (car handles))
+ handles
+ (list handles)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))))))
+
+(defun mml2015-pgg-clear-decrypt ()
+ (let ((pgg-errors-buffer mml2015-result-buffer))
+ (if (prog1
+ (pgg-decrypt-region (point-min) (point-max))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (with-current-buffer mml2015-result-buffer
+ (buffer-string))))
+ (progn
+ (erase-buffer)
+ (insert-buffer-substring pgg-output-buffer)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK"))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-pgg-verify (handle ctl)
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ signature-file part signature)
+ (if (or (null (setq part (mm-find-raw-part-by-type
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
+ "application/pgp-signature")
+ t)))
+ (null (setq signature (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))))
+ (progn
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ handle)
+ (with-temp-buffer
+ (insert part)
+ ;; Convert <LF> to <CR><LF> in verify mode. Sign and
+ ;; clearsign use --textmode. The conversion is not necessary.
+ ;; In clearverify, the conversion is not necessary either.
+ (goto-char (point-min))
+ (end-of-line)
+ (while (not (eobp))
+ (unless (eq (char-before) ?\r)
+ (insert "\r"))
+ (forward-line)
+ (end-of-line))
+ (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
+ (mm-insert-part signature))
+ (if (condition-case err
+ (prog1
+ (pgg-verify-region (point-min) (point-max)
+ signature-file t)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat (with-current-buffer pgg-output-buffer
+ (buffer-string))
+ (with-current-buffer pgg-errors-buffer
+ (buffer-string)))))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (progn
+ (delete-file signature-file)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (with-current-buffer pgg-errors-buffer
+ (mml2015-gpg-extract-signature-details))))
+ (delete-file signature-file)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")))))
+ handle)
+
+(defun mml2015-pgg-clear-verify ()
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ (text (buffer-string))
+ (coding-system buffer-file-coding-system))
+ (if (condition-case err
+ (prog1
+ (mm-with-unibyte-buffer
+ (insert (encode-coding-string text coding-system))
+ (pgg-verify-region (point-min) (point-max) nil t))
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (concat (with-current-buffer pgg-output-buffer
+ (buffer-string))
+ (with-current-buffer pgg-errors-buffer
+ (buffer-string)))))
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (mml2015-format-error err))
+ nil)
+ (quit
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details "Quit.")
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info
+ (with-current-buffer pgg-errors-buffer
+ (mml2015-gpg-extract-signature-details)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
+
+(defun mml2015-pgg-sign (cont)
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ (boundary (mml-compute-boundary cont))
+ (pgg-default-user-id (or (message-options-get 'mml-sender)
+ pgg-default-user-id)))
+ (unless (pgg-sign-region (point-min) (point-max))
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Sign error"))
+ (goto-char (point-min))
+ (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
+ boundary))
+ ;;; FIXME: what is the micalg?
+ (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
+ (insert (format "\n--%s\n" boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s\n" boundary))
+ (insert "Content-Type: application/pgp-signature\n\n")
+ (insert-buffer-substring pgg-output-buffer)
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))
+
+(defun mml2015-pgg-encrypt (cont &optional sign)
+ (let ((pgg-errors-buffer mml2015-result-buffer)
+ (boundary (mml-compute-boundary cont)))
+ (unless (pgg-encrypt-region (point-min) (point-max)
+ (split-string
+ (or
+ (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (read-string "Recipients: ")))
+ "[ \f\t\n\r\v,]+")
+ sign)
+ (pop-to-buffer mml2015-result-buffer)
+ (error "Encrypt error"))
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
+ boundary))
+ (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/pgp-encrypted\n\n")
+ (insert "Version: 1\n\n")
+ (insert (format "--%s\n" boundary))
+ (insert "Content-Type: application/octet-stream\n\n")
+ (insert-buffer-substring pgg-output-buffer)
+ (goto-char (point-max))
+ (insert (format "--%s--\n" boundary))
+ (goto-char (point-max))))
+
+;;; General wrapper
+
+(defun mml2015-clean-buffer ()
+ (if (gnus-buffer-live-p mml2015-result-buffer)
+ (with-current-buffer mml2015-result-buffer
+ (erase-buffer)
+ t)
+ (setq mml2015-result-buffer
+ (gnus-get-buffer-create "*MML2015 Result*"))
+ nil))
+
+(defsubst mml2015-clear-decrypt-function ()
+ (nth 6 (assq mml2015-use mml2015-function-alist)))
+
+(defsubst mml2015-clear-verify-function ()
+ (nth 5 (assq mml2015-use mml2015-function-alist)))
+
+;;;###autoload
+(defun mml2015-decrypt (handle ctl)
+ (mml2015-clean-buffer)
+ (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
+ (if func
+ (funcall func handle ctl)
+ handle)))
+
+;;;###autoload
+(defun mml2015-decrypt-test (handle ctl)
+ mml2015-use)
+
+;;;###autoload
+(defun mml2015-verify (handle ctl)
+ (mml2015-clean-buffer)
+ (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
+ (if func
+ (funcall func handle ctl)
+ handle)))
+
+;;;###autoload
+(defun mml2015-verify-test (handle ctl)
+ mml2015-use)
+
+;;;###autoload
+(defun mml2015-encrypt (cont &optional sign)
+ (mml2015-clean-buffer)
+ (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
+ (if func
+ (funcall func cont sign)
+ (error "Cannot find encrypt function"))))
+
+;;;###autoload
+(defun mml2015-sign (cont)
+ (mml2015-clean-buffer)
+ (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
+ (if func
+ (funcall func cont)
+ (error "Cannot find sign function"))))
+
+;;;###autoload
+(defun mml2015-self-encrypt ()
+ (mml2015-encrypt nil))
+
+(provide 'mml2015)
+
+;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
+;;; mml2015.el ends here
diff --git a/lisp/gnus/next-ur.xpm b/lisp/gnus/next-ur.xpm
index 8c823f2903b..bea13280b68 100644
--- a/lisp/gnus/next-ur.xpm
+++ b/lisp/gnus/next-ur.xpm
@@ -1,66 +1,35 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 36 1",
-" c Gray0",
-". c Gray6",
-"X c Gray9",
-"o c Gray12",
-"O c #23f323f323f3",
-"+ c Gray15",
-"@ c #2ff32ff32ff3",
-"# c #399939993999",
-"$ c #3fff3fff3fff",
-"% c #433243324332",
-"& c Gray28",
-"* c #4ccc4ccc4ccc",
-"= c #53ed53ed53ed",
-"- c #5ff05ff05ff0",
-"; c Gray40",
-": c #67e767e767e7",
-"> c #6ccc6ccc6ccc",
-", c #6fff6fff6fff",
-"< c Gray45",
-"1 c #77f277f277f2",
-"2 c #7bdb7bdb7bdb",
-"3 c #7ccc7ccc7ccc",
-"4 c Gray50",
-"5 c #866586658665",
-"6 c Gray56",
-"7 c Gray60",
-"8 c #9bd39bd39bd3",
-"9 c #9fff9fff9fff",
-"0 c Gray65",
-"q c #a7c7a7c7a7c7",
-"w c Gray70",
-"e c Gray75",
-"r c Gray81",
-"t c #dfffdfffdfff",
-"y c #efffefffefff",
-"u c Gray100",
-/* pixels */
-"wqewqewqewqewqewqewqewqe",
-"q6eq6eq6eq6eq6eq6eq6eq6e",
-"eeeeeeeeeeeeeeeeeeeeeeee",
-"wqewqewqewq82$.wqewqewqe",
-"q6eq6eq6e6@19u$-6eq6eq6e",
-"eeeeeeee==eyr$9@eeeeeeee",
-"wqewq82$ruuu or=qewqewqe",
-"q6e6@19uuuu94eue-eq6eq6e",
-"eeew&euuuuuruuuy18eeeeee",
-"wqew-8uuuuuuuuuu92wqewqe",
-"q6eq619uut44uuuuu$q6eq6e",
-"eeeeee29,-e@uuuuur=eeeee",
-"wqeee82$rye-$uuuuu=qewqe",
-"q6eq-19uu- e$uuuuue-eq6e",
-"ee==eyuuu -y99uuuuy18eee",
-"w&euuuuu,uuue4uuuuu92wqe",
-"q@euuuuuuuuut4tuuuueoq6e",
-"eq=u9$$$ruuuu4@$$r$;6eee",
-"wq=8,988%ruu8,98-+6qewqe",
-"q6e+wq888$et+wq888X6eq6e",
-"eee+88888.4-+88888@eeeee",
-"wqeO#6884,uu*5885<&qewqe",
-"q6eq@#**<uuut;**+&q6eq6e",
-"eeeeqOeeyuuuuteee=eeeeee"
-};
+static char * next_ur_xpm[] = {
+"24 24 8 1",
+". c None",
+" c #000000000000",
+"X c #A5A5A5A59595",
+"o c #C7C7C6C6C6C6",
+"O c #FFFF00000000",
+"+ c #9A9A6C6C4E4E",
+"@ c #E1E1E0E0E0E0",
+"# c #FFFFFFFFFFFF",
+" .. .. .. .. .. .. .. ..",
+"........................",
+"............X...........",
+" .. .. .. .XXX. .. .. ..",
+".........XXooOX.........",
+".......XXooo+O@X........",
+" .. XXXoooo++@@@X. .. ..",
+"....X@Xoooooo@@@X.......",
+"....X@@Xooo@@@@@@X......",
+" .. X@@XXoo@@@@@@@X.. ..",
+"....X@@Xoo@@@@@@@@@X....",
+"....X@Xo@@@XX@@@@@@oX...",
+" .. oXoo@XXooO@@@@@@X ..",
+"....oXoXXooo+OX@@@@Xo...",
+"....XXXoooo++@@X@@Xo....",
+" .. X@Xoooooo@@@XX .. ..",
+"....X@@Xooo@@@@@@X......",
+"....X@@XXoo@@@@@@@X.....",
+" .. X@@Xoo@@@@@@@@@X. ..",
+"....X@Xo@ @@@@@@@ X...",
+"... oXoo ## @@ @@ ## ...",
+" .. oXo #### @ #### ..",
+".....oX #### @@@ #### ..",
+".....oX@ ## @@@@X ## ..."};
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 653f89c9d99..669aa6904dd 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,5 +1,7 @@
;;; nnagent.el --- offline backend for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -121,68 +123,108 @@
(deffoo nnagent-request-set-mark (group action server)
(with-temp-buffer
(insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n"
- (nth 0 gnus-command-method) group action
- (or server (nth 1 gnus-command-method))))
+ (nth 0 gnus-command-method) group action
+ (or server (nth 1 gnus-command-method))))
(append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags")))
nil)
+(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old)
+ (let ((file (gnus-agent-article-name ".overview" group))
+ arts n first)
+ (save-excursion
+ (gnus-agent-load-alist group)
+ (setq arts (gnus-sorted-difference
+ articles (mapcar 'car gnus-agent-article-alist)))
+ ;; Assume that articles with smaller numbers than the first one
+ ;; Agent knows are gone.
+ (setq first (caar gnus-agent-article-alist))
+ (when first
+ (while (and arts (< (car arts) first))
+ (pop arts)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (nnheader-insert-nov-file file (car articles))
+ (goto-char (point-min))
+ (gnus-parse-without-error
+ (while (and arts (not (eobp)))
+ (setq n (read (current-buffer)))
+ (when (> n (car arts))
+ (beginning-of-line))
+ (while (and arts (> n (car arts)))
+ (insert (format
+ "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
+ (car arts) (car arts)))
+ (pop arts))
+ (when (and arts (= n (car arts)))
+ (pop arts))
+ (forward-line 1)))
+ (while arts
+ (insert (format
+ "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
+ (car arts) (car arts)))
+ (pop arts))
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles))
+ (car (last articles)))
+ t)
+ 'nov)))
+
+(deffoo nnagent-request-expire-articles (articles group &optional server force)
+ articles)
+
(deffoo nnagent-request-group (group &optional server dont-check)
(nnoo-parent-function 'nnagent 'nnml-request-group
- (list group (nnagent-server server) dont-check)))
+ (list group (nnagent-server server) dont-check)))
(deffoo nnagent-close-group (group &optional server)
(nnoo-parent-function 'nnagent 'nnml-close-group
- (list group (nnagent-server server))))
+ (list group (nnagent-server server))))
(deffoo nnagent-request-accept-article (group &optional server last)
(nnoo-parent-function 'nnagent 'nnml-request-accept-article
- (list group (nnagent-server server) last)))
+ (list group (nnagent-server server) last)))
(deffoo nnagent-request-article (id &optional group server buffer)
(nnoo-parent-function 'nnagent 'nnml-request-article
- (list id group (nnagent-server server) buffer)))
+ (list id group (nnagent-server server) buffer)))
(deffoo nnagent-request-create-group (group &optional server args)
(nnoo-parent-function 'nnagent 'nnml-request-create-group
- (list group (nnagent-server server) args)))
+ (list group (nnagent-server server) args)))
(deffoo nnagent-request-delete-group (group &optional force server)
(nnoo-parent-function 'nnagent 'nnml-request-delete-group
- (list group force (nnagent-server server))))
-
-(deffoo nnagent-request-expire-articles (articles group &optional server force)
- (nnoo-parent-function 'nnagent 'nnml-request-expire-articles
- (list articles group (nnagent-server server) force)))
+ (list group force (nnagent-server server))))
(deffoo nnagent-request-list (&optional server)
(nnoo-parent-function 'nnagent 'nnml-request-list
- (list (nnagent-server server))))
+ (list (nnagent-server server))))
(deffoo nnagent-request-list-newsgroups (&optional server)
(nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups
- (list (nnagent-server server))))
+ (list (nnagent-server server))))
(deffoo nnagent-request-move-article
(article group server accept-form &optional last)
(nnoo-parent-function 'nnagent 'nnml-request-move-article
- (list article group (nnagent-server server)
- accept-form last)))
+ (list article group (nnagent-server server)
+ accept-form last)))
(deffoo nnagent-request-rename-group (group new-name &optional server)
(nnoo-parent-function 'nnagent 'nnml-request-rename-group
- (list group new-name (nnagent-server server))))
+ (list group new-name (nnagent-server server))))
(deffoo nnagent-request-scan (&optional group server)
(nnoo-parent-function 'nnagent 'nnml-request-scan
- (list group (nnagent-server server))))
-
-(deffoo nnagent-retrieve-headers (sequence &optional group server fetch-old)
- (nnoo-parent-function 'nnagent 'nnml-retrieve-headers
- (list sequence group (nnagent-server server) fetch-old)))
+ (list group (nnagent-server server))))
(deffoo nnagent-set-status (article name value &optional group server)
(nnoo-parent-function 'nnagent 'nnml-set-status
- (list article name value group (nnagent-server server))))
+ (list article name value group (nnagent-server server))))
(deffoo nnagent-server-opened (&optional server)
(nnoo-parent-function 'nnagent 'nnml-server-opened
@@ -192,6 +234,10 @@
(nnoo-parent-function 'nnagent 'nnml-status-message
(list (nnagent-server server))))
+(deffoo nnagent-request-regenerate (server)
+ (nnoo-parent-function 'nnagent 'nnml-request-regenerate
+ (list (nnagent-server server))))
+
;; Use nnml functions for just about everything.
(nnoo-import nnagent
(nnml))
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index b3b67da5cbd..e69b6a0304a 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -1,10 +1,10 @@
;;; nnbabyl.el --- rmail mbox access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
@@ -51,6 +51,7 @@
(defvoo nnbabyl-get-new-mail t
"If non-nil, nnbabyl will check the incoming mail file and split the mail.")
+
(defvoo nnbabyl-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
@@ -287,7 +288,8 @@
(current-buffer))
(let ((nnml-current-directory nil))
(nnmail-expiry-target-group
- nnmail-expiry-target newsgroup))))
+ nnmail-expiry-target newsgroup)))
+ (nnbabyl-possibly-change-newsgroup newsgroup server))
(nnheader-message 5 "Deleting article %d in %s..."
(car articles) newsgroup)
(nnbabyl-delete-mail))
@@ -347,7 +349,10 @@
(while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
(delete-region (point) (progn (forward-line 1) (point)))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
(setq result
(if (stringp group)
(list (cons group (nnbabyl-active-number group)))
@@ -363,7 +368,10 @@
(insert-buffer-substring buf)
(when last
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
(save-buffer)
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
result))))
diff --git a/lisp/gnus/nndb.el b/lisp/gnus/nndb.el
new file mode 100644
index 00000000000..d29d16fa690
--- /dev/null
+++ b/lisp/gnus/nndb.el
@@ -0,0 +1,331 @@
+;;; nndb.el --- nndb access for Gnus
+
+;; Copyright (C) 1997, 1998, 2000, 2003 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
+;; Joe Hildebrand <joe.hildebrand@ilg.com>
+;; David Blacka <davidb@rwhois.net>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This was based upon Kai Grossjohan's shamessly snarfed code and
+;;; further modified by Joe Hildebrand. It has been updated for Red
+;;; Gnus.
+
+;; TODO:
+;;
+;; * Fix bug where server connection can be lost and impossible to regain
+;; This hasn't happened to me in a while; think it was fixed in Rgnus
+;;
+;; * make it handle different nndb servers seemlessly
+;;
+;; * Optimize expire if FORCE
+;;
+;; * Optimize move (only expire once)
+;;
+;; * Deal with add/deletion of groups
+;;
+;; * make the backend TOUCH an article when marked as expireable (will
+;; make article expire 'expiry' days after that moment).
+
+;;-
+;; Register nndb with known select methods.
+
+(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)
+
+;;; Code:
+
+(require 'nnmail)
+(require 'nnheader)
+(require 'nntp)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (unless (fboundp 'open-network-stream)
+ (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'cancel-timer "timer")
+ (autoload 'telnet "telnet" nil t)
+ (autoload 'telnet-send-input "telnet" nil t)
+ (autoload 'gnus-declare-backend "gnus-start"))
+
+;; Declare nndb as derived from nntp
+
+(nnoo-declare nndb nntp)
+
+;; Variables specific to nndb
+
+;;- currently not used but just in case...
+(defvoo nndb-deliver-program "nndel"
+ "*The program used to put a message in an NNDB group.")
+
+(defvoo nndb-server-side-expiry nil
+ "If t, expiry calculation will occur on the server side.")
+
+(defvoo nndb-set-expire-date-on-mark nil
+ "If t, the expiry date for a given article will be set to the time
+it was marked as expireable; otherwise the date will be the time the
+article was posted to nndb")
+
+;; Variables copied from nntp
+
+(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
+ "Like nntp-server-opened-hook."
+ nntp-server-opened-hook)
+
+(defvoo nndb-address "localhost"
+ "*The name of the NNDB server."
+ nntp-address)
+
+(defvoo nndb-port-number 9000
+ "*Port number to connect to."
+ nntp-port-number)
+
+;; change to 'news if you are actually using nndb for news
+(defvoo nndb-article-type 'mail)
+
+(defvoo nndb-status-string nil "" nntp-status-string)
+
+
+
+(defconst nndb-version "nndb 0.7"
+ "Version numbers of this version of NNDB.")
+
+
+;;; Interface functions.
+
+(nnoo-define-basics nndb)
+
+;;------------------------------------------------------------------
+
+;; this function turns the lisp list into a string list. There is
+;; probably a more efficient way to do this.
+(defun nndb-build-article-string (articles)
+ (let (art-string art)
+ (while articles
+ (setq art (pop articles))
+ (setq art-string (concat art-string art " ")))
+ art-string))
+
+(defun nndb-build-expire-rest-list (total expire)
+ (let (art rest)
+ (while total
+ (setq art (pop total))
+ (if (memq art expire)
+ ()
+ (push art rest)))
+ rest))
+
+
+;;
+(deffoo nndb-request-type (group &optional article)
+ nndb-article-type)
+
+;; nndb-request-update-info does not exist and is not needed
+
+;; nndb-request-update-mark does not exist; it should be used to TOUCH
+;; articles as they are marked exipirable
+(defun nndb-touch-article (group article)
+ (nntp-send-command nil "X-TOUCH" article))
+
+(deffoo nndb-request-update-mark
+ (group article mark)
+ "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
+ (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
+ (nndb-touch-article group article))
+ mark)
+
+;; nndb-request-create-group -- currently this isn't necessary; nndb
+;; creates groups on demand.
+
+;; todo -- use some other time than the creation time of the article
+;; best is time since article has been marked as expirable
+
+(defun nndb-request-expire-articles-local
+ (articles &optional group server force)
+ "Let gnus do the date check and issue the delete commands."
+ (let (msg art delete-list (num-delete 0) rest)
+ (nntp-possibly-change-group group server)
+ (while articles
+ (setq art (pop articles))
+ (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
+ (setq msg (nndb-status-message))
+ (if (string-match "^423" msg)
+ ()
+ (or (string-match "'\\(.+\\)'" msg)
+ (error "Not a valid response for X-DATE command: %s"
+ msg))
+ (if (nnmail-expired-article-p
+ group
+ (date-to-time (substring msg (match-beginning 1) (match-end 1)))
+ force)
+ (progn
+ (setq delete-list (concat delete-list " " (int-to-string art)))
+ (setq num-delete (1+ num-delete)))
+ (push art rest))))
+ (if (> (length delete-list) 0)
+ (progn
+ (nnheader-message 5 "Deleting %s article(s) from %s"
+ (int-to-string num-delete) group)
+ (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
+ )
+
+ (nnheader-message 5 "")
+ (nconc rest articles)))
+
+(defun nndb-get-remote-expire-response ()
+ (let (list)
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (looking-at "^[34]")
+ ;; x-expire returned error--presume no articles were expirable)
+ (setq list nil)
+ ;; otherwise, pull all of the following numbers into the list
+ (re-search-forward "follows\r?\n?" nil t)
+ (while (re-search-forward "^[0-9]+$" nil t)
+ (push (string-to-int (match-string 0)) list)))
+ list))
+
+(defun nndb-request-expire-articles-remote
+ (articles &optional group server force)
+ "Let the nndb backend expire articles"
+ (let (days art-string delete-list (num-delete 0))
+ (nntp-possibly-change-group group server)
+
+ ;; first calculate the wait period in days
+ (setq days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait))
+ ;; now handle the special cases
+ (cond (force
+ (setq days 0))
+ ((eq days 'never)
+ ;; This isn't an expirable group.
+ (setq days -1))
+ ((eq days 'immediate)
+ (setq days 0)))
+
+
+ ;; build article string
+ (setq art-string (concat days " " (nndb-build-article-string articles)))
+ (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
+
+ (setq delete-list (nndb-get-remote-expire-response))
+ (setq num-delete (length delete-list))
+ (if (> num-delete 0)
+ (nnheader-message 5 "Deleting %s article(s) from %s"
+ (int-to-string num-delete) group))
+
+ (nndb-build-expire-rest-list articles delete-list)))
+
+(deffoo nndb-request-expire-articles
+ (articles &optional group server force)
+ "Expires ARTICLES from GROUP on SERVER.
+If FORCE, delete regardless of exiration date, otherwise use normal
+expiry mechanism."
+ (if nndb-server-side-expiry
+ (nndb-request-expire-articles-remote articles group server force)
+ (nndb-request-expire-articles-local articles group server force)))
+
+(deffoo nndb-request-move-article
+ (article group server accept-form &optional last)
+ "Move ARTICLE (a number) from GROUP on SERVER.
+Evals ACCEPT-FORM in current buffer, where the article is.
+Optional LAST is ignored."
+ ;; we guess that the second arg in accept-form is the new group,
+ ;; which it will be for nndb, which is all that matters anyway
+ (let ((new-group (nth 1 accept-form)) result)
+ (nntp-possibly-change-group group server)
+
+ ;; use the move command for nndb-to-nndb moves
+ (if (string-match "^nndb" new-group)
+ (let ((new-group-name (gnus-group-real-name new-group)))
+ (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
+ (cons new-group article))
+ ;; else move normally
+ (let ((artbuf (get-buffer-create " *nndb move*")))
+ (and
+ (nndb-request-article article group server artbuf)
+ (save-excursion
+ (set-buffer artbuf)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (nndb-request-expire-articles (list article)
+ group
+ server
+ t))
+ result)
+ )))
+
+(deffoo nndb-request-accept-article (group server &optional last)
+ "The article in the current buffer is put into GROUP."
+ (nntp-possibly-change-group group server)
+ (let (art msg)
+ (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
+ (nnheader-insert "")
+ (nntp-send-buffer "^[23].*\n"))
+
+ (set-buffer nntp-server-buffer)
+ (setq msg (buffer-string))
+ (or (string-match "^\\([0-9]+\\)" msg)
+ (error "nndb: %s" msg))
+ (setq art (substring msg (match-beginning 1) (match-end 1)))
+ (nnheader-message 5 "nndb: accepted %s" art)
+ (list art)))
+
+(deffoo nndb-request-replace-article (article group buffer)
+ "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
+ (set-buffer buffer)
+ (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
+ (nnheader-insert "")
+ (nntp-send-buffer "^[23.*\n")
+ (list (int-to-string article))))
+
+ ; nndb-request-delete-group does not exist
+ ; todo -- maybe later
+
+ ; nndb-request-rename-group does not exist
+ ; todo -- maybe later
+
+;; -- standard compatability functions
+
+(deffoo nndb-status-message (&optional server)
+ "Return server status as a string."
+ (set-buffer nntp-server-buffer)
+ (buffer-string))
+
+;; Import stuff from nntp
+
+(nnoo-import nndb
+ (nntp))
+
+(provide 'nndb)
+
+;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
+;;; nndb.el ends here
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
new file mode 100644
index 00000000000..81d5443b640
--- /dev/null
+++ b/lisp/gnus/nndiary.el
@@ -0,0 +1,1712 @@
+;;; nndiary.el --- A diary backend for Gnus
+
+;; Copyright (C) 1999, 2000, 2001, 2003
+;; Free Software Foundation, Inc.
+
+;; Author: Didier Verna <didier@xemacs.org>
+;; Maintainer: Didier Verna <didier@xemacs.org>
+;; Created: Fri Jul 16 18:55:42 1999
+;; Keywords: calendar mail news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Commentary:
+
+;; Contents management by FCM version 0.1.
+
+;; Description:
+;; ===========
+
+;; This package implements NNDiary, a diary backend for Gnus. NNDiary is a
+;; mail backend, pretty similar to nnml in its functionnning (it has all the
+;; features of nnml, actually), but in which messages are treated as event
+;; reminders.
+
+;; Here is a typical scenario:
+;; - You've got a date with Andy Mc Dowell or Bruce Willis (select according
+;; to your sexual preference) in one month. You don't want to forget it.
+;; - Send a (special) diary message to yourself (see below).
+;; - Forget all about it and keep on getting and reading new mail, as usual.
+;; - From time to time, as you type `g' in the group buffer and as the date
+;; is getting closer, the message will pop up again, just like if it were
+;; new and unread.
+;; - Read your "new" messages, this one included, and start dreaming of the
+;; night you're gonna have.
+;; - Once the date is over (you actually fell asleep just after dinner), the
+;; message will be automatically deleted if it is marked as expirable.
+
+;; Some more notes on the diary backend:
+;; - NNDiary is a *real* mail backend. You *really* send real diary
+;; messsages. This means for instance that you can give appointements to
+;; anybody (provided they use Gnus and NNDiary) by sending the diary message
+;; to them as well.
+;; - However, since NNDiary also has a 'request-post method, you can also
+;; `C-u a' instead of `C-u m' on a diary group and the message won't actually
+;; be sent; just stored in the group.
+;; - The events you want to remember need not be punctual. You can set up
+;; reminders for regular dates (like once each week, each monday at 13:30
+;; and so on). Diary messages of this kind will never be deleted (unless
+;; you do it explicitely). But that, you guessed.
+
+
+;; Usage:
+;; =====
+
+;; 1/ NNDiary has two modes of operation: traditional (the default) and
+;; autonomous.
+;; a/ In traditional mode, NNDiary does not get new mail by itself. You
+;; have to move mails from your primary mail backend to nndiary
+;; groups.
+;; b/ In autonomous mode, NNDiary retrieves its own mail and handles it
+;; independantly of your primary mail backend. To use NNDiary in
+;; autonomous mode, you have several things to do:
+;; i/ Put (setq nndiary-get-new-mail t) in your gnusrc file.
+;; ii/ Diary messages contain several `X-Diary-*' special headers.
+;; You *must* arrange that these messages be split in a private
+;; folder *before* Gnus treat them. You need this because Gnus
+;; is not able yet to manage multiple backends for mail
+;; retrieval. Getting them from a separate source will
+;; compensate this misfeature to some extent, as we will see.
+;; As an example, here's my procmailrc entry to store diary files
+;; in ~/.nndiary (the default nndiary mail source file):
+;;
+;; :0 HD :
+;; * ^X-Diary
+;; .nndiary
+;; iii/ Customize the variables `nndiary-mail-sources' and
+;; `nndiary-split-methods'. These are replacements for the usual
+;; mail sources and split methods which, and will be used in
+;; autonomous mode. `nndiary-mail-sources' defaults to
+;; '(file :path "~/.nndiary").
+;; 2/ Install nndiary somewhere Emacs / Gnus can find it. Normally, you
+;; *don't* have to '(require 'nndiary) anywhere. Gnus will do so when
+;; appropriate as long as nndiary is somewhere in the load path.
+;; 3/ Now, customize the rest of nndiary. In particular, you should
+;; customize `nndiary-reminders', the list of times when you want to be
+;; reminded of your appointements (e.g. 3 weeks before, then 2 days
+;; before, then 1 hour before and that's it).
+;; 4/ You *must* use the group timestamp feature of Gnus. This adds a
+;; timestamp to each groups' parameters (please refer to the Gnus
+;; documentation ("Group Timestamp" info node) to see how it's done.
+;; 5/ Once you have done this, you may add a permanent nndiary virtual server
+;; (something like '(nndiary "")) to your `gnus-secondary-select-methods'.
+;; Yes, this server will be able to retrieve mails and split them when you
+;; type `g' in the group buffer, just as if it were your only mail backend.
+;; This is the benefit of using a private folder.
+;; 6/ Hopefully, almost everything (see the TODO section below) will work as
+;; expected when you restart Gnus: in the group buffer, `g' and `M-g' will
+;; also get your new diary mails, `F' will find your new diary groups etc.
+
+
+;; How to send diary messages:
+;; ==========================
+
+;; There are 7 special headers in diary messages. These headers are of the
+;; form `X-Diary-<something>', the <something> being one of `Minute', `Hour',
+;; `Dom', `Month', `Year', `Time-Zone' and `Dow'. `Dom' means "Day of Month",
+;; and `dow' means "Day of Week". These headers actually behave like crontab
+;; specifications and define the event date(s).
+
+;; For all headers but the `Time-Zone' one, a header value is either a
+;; star (meaning all possible values), or a list of fields (separated by a
+;; comma). A field is either an integer, or a range. A range is two integers
+;; separated by a dash. Possible integer values are 0-59 for `Minute', 0-23
+;; for `Hour', 1-31 for `Dom', `1-12' for Month, above 1971 for `Year' and 0-6
+;; for `Dow' (0 = sunday). As a special case, a star in either `Dom' or `Dow'
+;; doesn't mean "all possible values", but "use only the other field". Note
+;; that if both are star'ed, the use of either one gives the same result :-),
+
+;; The `Time-Zone' header is special in that it can have only one value (you
+;; bet ;-).
+;; A star doesn't mean "all possible values" (because it has no sense), but
+;; "the current local time zone".
+
+;; As an example, here's how you would say "Each Monday and each 1st of month,
+;; at 12:00, 20:00, 21:00, 22:00, 23:00 and 24:00, from 1999 to 2010" (I let
+;; you find what to do then):
+;;
+;; X-Diary-Minute: 0
+;; X-Diary-Hour: 12, 20-24
+;; X-Diary-Dom: 1
+;; X-Diary-Month: *
+;; X-Diary-Year: 1999-2010
+;; X-Diary-Dow: 1
+;; X-Diary-Time-Zone: *
+;;
+;;
+;; Sending a diary message is not different from sending any other kind of
+;; mail, except that such messages are identified by the presence of these
+;; special headers.
+
+
+
+;; Bugs / Todo:
+;; ===========
+
+;; * Respooling doesn't work because contrary to the request-scan function,
+;; Gnus won't allow me to override the split methods when calling the
+;; respooling backend functions.
+;; * There's a bug in the time zone mechanism with variable TZ locations.
+;; * We could allow a keyword like `ask' in X-Diary-* headers, that would mean
+;; "ask for value upon reception of the message".
+;; * We could add an optional header X-Diary-Reminders to specify a special
+;; reminders value for this message. Suggested by Jody Klymak.
+;; * We should check messages validity in other circumstances than just
+;; moving an article from sonwhere else (request-accept). For instance, when
+;; editing / saving and so on.
+
+
+;; Remarks:
+;; =======
+
+;; * nnoo.
+;; NNDiary is very similar to nnml. This makes the idea of using nnoo (to
+;; derive nndiary from nnml) natural. However, my experience with nnoo is
+;; that for reasonably complex backends like this one, noo is a burden
+;; rather than an help. It's tricky to use, not everything can be
+;; inherited, what can be inherited and when is not very clear, and you've
+;; got to be very careful because a little mistake can fuck up your your
+;; other backends, especially because their variables will be use instead of
+;; your real ones. Finally, I found it easier to just clone the needed
+;; parts of nnml, and tracking nnml updates is not a big deal.
+
+;; IMHO, nnoo is actually badly designed. A much simpler, and yet more
+;; powerful one would be to make *real* functions and variables for a new
+;; backend based on another. Lisp is a reflexive language so that's a very
+;; easy thing to do: inspect the function's form, replace occurences of
+;; <nnfrom> (even in strings) with <nnto>, and you're done.
+
+;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods:
+;; NNDiary has some experimental parts, in the sense Gnus normally uses only
+;; one mail backends for mail retreival and splitting. This backend is also
+;; an attempt to make it behave differently. For Gnus developpers: as you
+;; can see if you snarf into the code, that was not a very difficult thing
+;; to do. Something should be done about the respooling breakage though.
+
+
+;;; Code:
+
+(require 'nnoo)
+(require 'nnheader)
+(require 'nnmail)
+(eval-when-compile (require 'cl))
+
+(require 'gnus-start)
+(require 'gnus-sum)
+
+;; Compatibility Functions =================================================
+
+(eval-and-compile
+ (if (fboundp 'signal-error)
+ (defun nndiary-error (&rest args)
+ (apply #'signal-error 'nndiary args))
+ (defun nndiary-error (&rest args)
+ (apply #'error args))))
+
+
+;; Backend behavior customization ===========================================
+
+(defgroup nndiary nil
+ "The Gnus Diary backend."
+ :group 'gnus-diary)
+
+(defcustom nndiary-mail-sources
+ `((file :path ,(expand-file-name "~/.nndiary")))
+ "*NNDiary specific mail sources.
+This variable is used by nndiary in place of the standard `mail-sources'
+variable when `nndiary-get-new-mail' is set to non-nil. These sources
+must contain diary messages ONLY."
+ :group 'nndiary
+ :group 'mail-source
+ :type 'sexp)
+
+(defcustom nndiary-split-methods '(("diary" ""))
+ "*NNDiary specific split methods.
+This variable is used by nndiary in place of the standard
+`nnmail-split-methods' variable when `nndiary-get-new-mail' is set to
+non-nil."
+ :group 'nndiary
+ :group 'nnmail-split
+ :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
+ (function-item nnmail-split-fancy)
+ (function :tag "Other")))
+
+
+(defcustom nndiary-reminders '((0 . day))
+ "*Different times when you want to be reminded of your appointements.
+Diary articles will appear again, as if they'd been just received.
+
+Entries look like (3 . day) which means something like \"Please
+Hortense, would you be so kind as to remind me of my appointments 3 days
+before the date, thank you very much. Anda, hmmm... by the way, are you
+doing anything special tonight ?\".
+
+The units of measure are 'minute 'hour 'day 'week 'month and 'year (no,
+not 'century, sorry).
+
+NOTE: the units of measure actually express dates, not durations: if you
+use 'week, messages will pop up on Sundays at 00:00 (or Mondays if
+`nndiary-week-starts-on-monday' is non nil) and *not* 7 days before the
+appointement, if you use 'month, messages will pop up on the first day of
+each months, at 00:00 and so on.
+
+If you really want to specify a duration (like 24 hours exactly), you can
+use the equivalent in minutes (the smallest unit). A fuzz of 60 seconds
+maximum in the reminder is not that painful, I think. Although this
+scheme might appear somewhat weird at a first glance, it is very powerful.
+In order to make this clear, here are some examples:
+
+- '(0 . day): this is the default value of `nndiary-reminders'. It means
+ pop up the appointements of the day each morning at 00:00.
+
+- '(1 . day): this means pop up the appointements the day before, at 00:00.
+
+- '(6 . hour): for an appointement at 18:30, this would pop up the
+ appointement message at 12:00.
+
+- '(360 . minute): for an appointement at 18:30 and 15 seconds, this would
+ pop up the appointement message at 12:30."
+ :group 'nndiary
+ :type '(repeat (cons :format "%v\n"
+ (integer :format "%v")
+ (choice :format "%[%v(s)%] before...\n"
+ :value day
+ (const :format "%v" minute)
+ (const :format "%v" hour)
+ (const :format "%v" day)
+ (const :format "%v" week)
+ (const :format "%v" month)
+ (const :format "%v" year)))))
+
+(defcustom nndiary-week-starts-on-monday nil
+ "*Whether a week starts on monday (otherwise, sunday)."
+ :type 'boolean
+ :group 'nndiary)
+
+
+(defcustom nndiary-request-create-group-hooks nil
+ "*Hooks to run after `nndiary-request-create-group' is executed.
+The hooks will be called with the full group name as argument."
+ :group 'nndiary
+ :type 'hook)
+
+(defcustom nndiary-request-update-info-hooks nil
+ "*Hooks to run after `nndiary-request-update-info-group' is executed.
+The hooks will be called with the full group name as argument."
+ :group 'nndiary
+ :type 'hook)
+
+(defcustom nndiary-request-accept-article-hooks nil
+ "*Hooks to run before accepting an article.
+Executed near the beginning of `nndiary-request-accept-article'.
+The hooks will be called with the article in the current buffer."
+ :group 'nndiary
+ :type 'hook)
+
+(defcustom nndiary-check-directory-twice t
+ "*If t, check directories twice to avoid NFS failures."
+ :group 'nndiary
+ :type 'boolean)
+
+
+;; Backend declaration ======================================================
+
+;; Well, most of this is nnml clonage.
+
+(nnoo-declare nndiary)
+
+(defvoo nndiary-directory (nnheader-concat gnus-directory "diary/")
+ "Spool directory for the nndiary backend.")
+
+(defvoo nndiary-active-file
+ (expand-file-name "active" nndiary-directory)
+ "Active file for the nndiary backend.")
+
+(defvoo nndiary-newsgroups-file
+ (expand-file-name "newsgroups" nndiary-directory)
+ "Newsgroups description file for the nndiary backend.")
+
+(defvoo nndiary-get-new-mail nil
+ "Whether nndiary gets new mail and split it.
+Contrary to traditional mail backends, this variable can be set to t
+even if your primary mail backend also retreives mail. In such a case,
+NDiary uses its own mail-sources and split-methods.")
+
+(defvoo nndiary-nov-is-evil nil
+ "If non-nil, Gnus will never use nov databases for nndiary groups.
+Using nov databases will speed up header fetching considerably.
+This variable shouldn't be flipped much. If you have, for some reason,
+set this to t, and want to set it to nil again, you should always run
+the `nndiary-generate-nov-databases' command. The function will go
+through all nnml directories and generate nov databases for them
+all. This may very well take some time.")
+
+(defvoo nndiary-prepare-save-mail-hook nil
+ "*Hook run narrowed to an article before saving.")
+
+(defvoo nndiary-inhibit-expiry nil
+ "If non-nil, inhibit expiry.")
+
+
+
+(defconst nndiary-version "0.2-b14"
+ "Current Diary backend version.")
+
+(defun nndiary-version ()
+ "Current Diary backend version."
+ (interactive)
+ (message "NNDiary version %s" nndiary-version))
+
+(defvoo nndiary-nov-file-name ".overview")
+
+(defvoo nndiary-current-directory nil)
+(defvoo nndiary-current-group nil)
+(defvoo nndiary-status-string "" )
+(defvoo nndiary-nov-buffer-alist nil)
+(defvoo nndiary-group-alist nil)
+(defvoo nndiary-active-timestamp nil)
+(defvoo nndiary-article-file-alist nil)
+
+(defvoo nndiary-generate-active-function 'nndiary-generate-active-info)
+(defvoo nndiary-nov-buffer-file-name nil)
+(defvoo nndiary-file-coding-system nnmail-file-coding-system)
+
+(defconst nndiary-headers
+ '(("Minute" 0 59)
+ ("Hour" 0 23)
+ ("Dom" 1 31)
+ ("Month" 1 12)
+ ("Year" 1971)
+ ("Dow" 0 6)
+ ("Time-Zone" (("Y" -43200)
+
+ ("X" -39600)
+
+ ("W" -36000)
+
+ ("V" -32400)
+
+ ("U" -28800)
+ ("PST" -28800)
+
+ ("T" -25200)
+ ("MST" -25200)
+ ("PDT" -25200)
+
+ ("S" -21600)
+ ("CST" -21600)
+ ("MDT" -21600)
+
+ ("R" -18000)
+ ("EST" -18000)
+ ("CDT" -18000)
+
+ ("Q" -14400)
+ ("AST" -14400)
+ ("EDT" -14400)
+
+ ("P" -10800)
+ ("ADT" -10800)
+
+ ("O" -7200)
+
+ ("N" -3600)
+
+ ("Z" 0)
+ ("GMT" 0)
+ ("UT" 0)
+ ("UTC" 0)
+ ("WET" 0)
+
+ ("A" 3600)
+ ("CET" 3600)
+ ("MET" 3600)
+ ("MEZ" 3600)
+ ("BST" 3600)
+ ("WEST" 3600)
+
+ ("B" 7200)
+ ("EET" 7200)
+ ("CEST" 7200)
+ ("MEST" 7200)
+ ("MESZ" 7200)
+
+ ("C" 10800)
+
+ ("D" 14400)
+
+ ("E" 18000)
+
+ ("F" 21600)
+
+ ("G" 25200)
+
+ ("H" 28800)
+
+ ("I" 32400)
+ ("JST" 32400)
+
+ ("K" 36000)
+ ("GST" 36000)
+
+ ("L" 39600)
+
+ ("M" 43200)
+ ("NZST" 43200)
+
+ ("NZDT" 46800))))
+ ;; List of NNDiary headers that specify the time spec. Each header name is
+ ;; followed by either two integers (specifying a range of possible values
+ ;; for this header) or one list (specifying all the possible values for this
+ ;; header). In the latter case, the list does NOT include the unspecifyed
+ ;; spec (*).
+ ;; For time zone values, we have symbolic time zone names associated with
+ ;; the (relative) number of seconds ahead GMT.
+ )
+
+(defsubst nndiary-schedule ()
+ (let (head)
+ (condition-case arg
+ (mapcar
+ (lambda (elt)
+ (setq head (nth 0 elt))
+ (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt)))
+ nndiary-headers)
+ (t
+ (nnheader-report 'nndiary "X-Diary-%s header parse error: %s."
+ head (cdr arg))
+ nil))
+ ))
+
+;;; Interface functions =====================================================
+
+(nnoo-define-basics nndiary)
+
+(deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old)
+ (when (nndiary-possibly-change-directory group server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let* ((file nil)
+ (number (length sequence))
+ (count 0)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ beg article
+ (nndiary-check-directory-twice
+ (and nndiary-check-directory-twice
+ ;; To speed up, disable it in some case.
+ (or (not (numberp nnmail-large-newsgroup))
+ (<= number nnmail-large-newsgroup)))))
+ (if (stringp (car sequence))
+ 'headers
+ (if (nndiary-retrieve-headers-with-nov sequence fetch-old)
+ 'nov
+ (while sequence
+ (setq article (car sequence))
+ (setq file (nndiary-article-to-file article))
+ (when (and file
+ (file-exists-p file)
+ (not (file-directory-p file)))
+ (insert (format "221 %d Article retrieved.\n" article))
+ (setq beg (point))
+ (nnheader-insert-head file)
+ (goto-char beg)
+ (if (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (goto-char (point-max))
+ (insert "\n\n"))
+ (insert ".\n")
+ (delete-region (point) (point-max)))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (zerop (% count 20))
+ (nnheader-message 6 "nndiary: Receiving headers... %d%%"
+ (/ (* count 100) number))))
+
+ (and (numberp nnmail-large-newsgroup)
+ (> number nnmail-large-newsgroup)
+ (nnheader-message 6 "nndiary: Receiving headers...done"))
+
+ (nnheader-fold-continuation-lines)
+ 'headers))))))
+
+(deffoo nndiary-open-server (server &optional defs)
+ (nnoo-change-server 'nndiary server defs)
+ (when (not (file-exists-p nndiary-directory))
+ (ignore-errors (make-directory nndiary-directory t)))
+ (cond
+ ((not (file-exists-p nndiary-directory))
+ (nndiary-close-server)
+ (nnheader-report 'nndiary "Couldn't create directory: %s"
+ nndiary-directory))
+ ((not (file-directory-p (file-truename nndiary-directory)))
+ (nndiary-close-server)
+ (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory))
+ (t
+ (nnheader-report 'nndiary "Opened server %s using directory %s"
+ server nndiary-directory)
+ t)))
+
+(deffoo nndiary-request-regenerate (server)
+ (nndiary-possibly-change-directory nil server)
+ (nndiary-generate-nov-databases server)
+ t)
+
+(deffoo nndiary-request-article (id &optional group server buffer)
+ (nndiary-possibly-change-directory group server)
+ (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ path gpath group-num)
+ (if (stringp id)
+ (when (and (setq group-num (nndiary-find-group-number id))
+ (cdr
+ (assq (cdr group-num)
+ (nnheader-article-to-file-alist
+ (setq gpath
+ (nnmail-group-pathname
+ (car group-num)
+ nndiary-directory))))))
+ (setq path (concat gpath (int-to-string (cdr group-num)))))
+ (setq path (nndiary-article-to-file id)))
+ (cond
+ ((not path)
+ (nnheader-report 'nndiary "No such article: %s" id))
+ ((not (file-exists-p path))
+ (nnheader-report 'nndiary "No such file: %s" path))
+ ((file-directory-p path)
+ (nnheader-report 'nndiary "File is a directory: %s" path))
+ ((not (save-excursion (let ((nnmail-file-coding-system
+ nndiary-file-coding-system))
+ (nnmail-find-file path))))
+ (nnheader-report 'nndiary "Couldn't read file: %s" path))
+ (t
+ (nnheader-report 'nndiary "Article %s retrieved" id)
+ ;; We return the article number.
+ (cons (if group-num (car group-num) group)
+ (string-to-int (file-name-nondirectory path)))))))
+
+(deffoo nndiary-request-group (group &optional server dont-check)
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (cond
+ ((not (nndiary-possibly-change-directory group server))
+ (nnheader-report 'nndiary "Invalid group (no such directory)"))
+ ((not (file-exists-p nndiary-current-directory))
+ (nnheader-report 'nndiary "Directory %s does not exist"
+ nndiary-current-directory))
+ ((not (file-directory-p nndiary-current-directory))
+ (nnheader-report 'nndiary "%s is not a directory"
+ nndiary-current-directory))
+ (dont-check
+ (nnheader-report 'nndiary "Group %s selected" group)
+ t)
+ (t
+ (nnheader-re-read-dir nndiary-current-directory)
+ (nnmail-activate 'nndiary)
+ (let ((active (nth 1 (assoc group nndiary-group-alist))))
+ (if (not active)
+ (nnheader-report 'nndiary "No such group: %s" group)
+ (nnheader-report 'nndiary "Selected group %s" group)
+ (nnheader-insert "211 %d %d %d %s\n"
+ (max (1+ (- (cdr active) (car active))) 0)
+ (car active) (cdr active) group)))))))
+
+(deffoo nndiary-request-scan (&optional group server)
+ ;; Use our own mail sources and split methods while Gnus doesn't let us have
+ ;; multiple backends for retrieving mail.
+ (let ((mail-sources nndiary-mail-sources)
+ (nnmail-split-methods nndiary-split-methods))
+ (setq nndiary-article-file-alist nil)
+ (nndiary-possibly-change-directory group server)
+ (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group)))
+
+(deffoo nndiary-close-group (group &optional server)
+ (setq nndiary-article-file-alist nil)
+ t)
+
+(deffoo nndiary-request-create-group (group &optional server args)
+ (nndiary-possibly-change-directory nil server)
+ (nnmail-activate 'nndiary)
+ (cond
+ ((assoc group nndiary-group-alist)
+ t)
+ ((and (file-exists-p (nnmail-group-pathname group nndiary-directory))
+ (not (file-directory-p (nnmail-group-pathname
+ group nndiary-directory))))
+ (nnheader-report 'nndiary "%s is a file"
+ (nnmail-group-pathname group nndiary-directory)))
+ (t
+ (let (active)
+ (push (list group (setq active (cons 1 0)))
+ nndiary-group-alist)
+ (nndiary-possibly-create-directory group)
+ (nndiary-possibly-change-directory group server)
+ (let ((articles (nnheader-directory-articles nndiary-current-directory)))
+ (when articles
+ (setcar active (apply 'min articles))
+ (setcdr active (apply 'max articles))))
+ (nnmail-save-active nndiary-group-alist nndiary-active-file)
+ (run-hook-with-args 'nndiary-request-create-group-hooks
+ (gnus-group-prefixed-name group
+ (list "nndiary" server)))
+ t))
+ ))
+
+(deffoo nndiary-request-list (&optional server)
+ (save-excursion
+ (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (nnmail-find-file nndiary-active-file))
+ (setq nndiary-group-alist (nnmail-get-active))
+ t))
+
+(deffoo nndiary-request-newgroups (date &optional server)
+ (nndiary-request-list server))
+
+(deffoo nndiary-request-list-newsgroups (&optional server)
+ (save-excursion
+ (nnmail-find-file nndiary-newsgroups-file)))
+
+(deffoo nndiary-request-expire-articles (articles group &optional server force)
+ (nndiary-possibly-change-directory group server)
+ (let ((active-articles
+ (nnheader-directory-articles nndiary-current-directory))
+ article rest number)
+ (nnmail-activate 'nndiary)
+ ;; Articles not listed in active-articles are already gone,
+ ;; so don't try to expire them.
+ (setq articles (gnus-intersection articles active-articles))
+ (while articles
+ (setq article (nndiary-article-to-file (setq number (pop articles))))
+ (if (and (nndiary-deletable-article-p group number)
+ ;; Don't use nnmail-expired-article-p. Our notion of expiration
+ ;; is a bit peculiar ...
+ (or force (nndiary-expired-article-p article)))
+ (progn
+ ;; Allow a special target group.
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (nndiary-request-article number group server (current-buffer))
+ (let ((nndiary-current-directory nil))
+ (nnmail-expiry-target-group nnmail-expiry-target group)))
+ (nndiary-possibly-change-directory group server))
+ (nnheader-message 5 "Deleting article %s in %s" number group)
+ (condition-case ()
+ (funcall nnmail-delete-file-function article)
+ (file-error (push number rest)))
+ (setq active-articles (delq number active-articles))
+ (nndiary-nov-delete-article group number))
+ (push number rest)))
+ (let ((active (nth 1 (assoc group nndiary-group-alist))))
+ (when active
+ (setcar active (or (and active-articles
+ (apply 'min active-articles))
+ (1+ (cdr active)))))
+ (nnmail-save-active nndiary-group-alist nndiary-active-file))
+ (nndiary-save-nov)
+ (nconc rest articles)))
+
+(deffoo nndiary-request-move-article
+ (article group server accept-form &optional last)
+ (let ((buf (get-buffer-create " *nndiary move*"))
+ result)
+ (nndiary-possibly-change-directory group server)
+ (nndiary-update-file-alist)
+ (and
+ (nndiary-deletable-article-p group article)
+ (nndiary-request-article article group server)
+ (let (nndiary-current-directory
+ nndiary-current-group
+ nndiary-article-file-alist)
+ (save-excursion
+ (set-buffer buf)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result))
+ (progn
+ (nndiary-possibly-change-directory group server)
+ (condition-case ()
+ (funcall nnmail-delete-file-function
+ (nndiary-article-to-file article))
+ (file-error nil))
+ (nndiary-nov-delete-article group article)
+ (when last
+ (nndiary-save-nov)
+ (nnmail-save-active nndiary-group-alist nndiary-active-file))))
+ result))
+
+(deffoo nndiary-request-accept-article (group &optional server last)
+ (nndiary-possibly-change-directory group server)
+ (nnmail-check-syntax)
+ (run-hooks 'nndiary-request-accept-article-hooks)
+ (when (nndiary-schedule)
+ (let (result)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")))
+ (if (stringp group)
+ (and
+ (nnmail-activate 'nndiary)
+ (setq result
+ (car (nndiary-save-mail
+ (list (cons group (nndiary-active-number group))))))
+ (progn
+ (nnmail-save-active nndiary-group-alist nndiary-active-file)
+ (and last (nndiary-save-nov))))
+ (and
+ (nnmail-activate 'nndiary)
+ (if (and (not (setq result
+ (nnmail-article-group 'nndiary-active-number)))
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result (car (nndiary-save-mail result))))
+ (when last
+ (nnmail-save-active nndiary-group-alist nndiary-active-file)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-close))
+ (nndiary-save-nov))))
+ result))
+ )
+
+(deffoo nndiary-request-post (&optional server)
+ (nnmail-do-request-post 'nndiary-request-accept-article server))
+
+(deffoo nndiary-request-replace-article (article group buffer)
+ (nndiary-possibly-change-directory group)
+ (save-excursion
+ (set-buffer buffer)
+ (nndiary-possibly-create-directory group)
+ (let ((chars (nnmail-insert-lines))
+ (art (concat (int-to-string article) "\t"))
+ headers)
+ (when (ignore-errors
+ (nnmail-write-region
+ (point-min) (point-max)
+ (or (nndiary-article-to-file article)
+ (expand-file-name (int-to-string article)
+ nndiary-current-directory))
+ nil (if (nnheader-be-verbose 5) nil 'nomesg))
+ t)
+ (setq headers (nndiary-parse-head chars article))
+ ;; Replace the NOV line in the NOV file.
+ (save-excursion
+ (set-buffer (nndiary-open-nov group))
+ (goto-char (point-min))
+ (if (or (looking-at art)
+ (search-forward (concat "\n" art) nil t))
+ ;; Delete the old NOV line.
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point)))
+ ;; The line isn't here, so we have to find out where
+ ;; we should insert it. (This situation should never
+ ;; occur, but one likes to make sure...)
+ (while (and (looking-at "[0-9]+\t")
+ (< (string-to-int
+ (buffer-substring
+ (match-beginning 0) (match-end 0)))
+ article)
+ (zerop (forward-line 1)))))
+ (beginning-of-line)
+ (nnheader-insert-nov headers)
+ (nndiary-save-nov)
+ t)))))
+
+(deffoo nndiary-request-delete-group (group &optional force server)
+ (nndiary-possibly-change-directory group server)
+ (when force
+ ;; Delete all articles in GROUP.
+ (let ((articles
+ (directory-files
+ nndiary-current-directory t
+ (concat nnheader-numerical-short-files
+ "\\|" (regexp-quote nndiary-nov-file-name) "$")))
+ article)
+ (while articles
+ (setq article (pop articles))
+ (when (file-writable-p article)
+ (nnheader-message 5 "Deleting article %s in %s..." article group)
+ (funcall nnmail-delete-file-function article))))
+ ;; Try to delete the directory itself.
+ (ignore-errors (delete-directory nndiary-current-directory)))
+ ;; Remove the group from all structures.
+ (setq nndiary-group-alist
+ (delq (assoc group nndiary-group-alist) nndiary-group-alist)
+ nndiary-current-group nil
+ nndiary-current-directory nil)
+ ;; Save the active file.
+ (nnmail-save-active nndiary-group-alist nndiary-active-file)
+ t)
+
+(deffoo nndiary-request-rename-group (group new-name &optional server)
+ (nndiary-possibly-change-directory group server)
+ (let ((new-dir (nnmail-group-pathname new-name nndiary-directory))
+ (old-dir (nnmail-group-pathname group nndiary-directory)))
+ (when (ignore-errors
+ (make-directory new-dir t)
+ t)
+ ;; We move the articles file by file instead of renaming
+ ;; the directory -- there may be subgroups in this group.
+ ;; One might be more clever, I guess.
+ (let ((files (nnheader-article-to-file-alist old-dir)))
+ (while files
+ (rename-file
+ (concat old-dir (cdar files))
+ (concat new-dir (cdar files)))
+ (pop files)))
+ ;; Move .overview file.
+ (let ((overview (concat old-dir nndiary-nov-file-name)))
+ (when (file-exists-p overview)
+ (rename-file overview (concat new-dir nndiary-nov-file-name))))
+ (when (<= (length (directory-files old-dir)) 2)
+ (ignore-errors (delete-directory old-dir)))
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nndiary-group-alist)))
+ (when entry
+ (setcar entry new-name))
+ (setq nndiary-current-directory nil
+ nndiary-current-group nil)
+ ;; Save the new group alist.
+ (nnmail-save-active nndiary-group-alist nndiary-active-file)
+ t))))
+
+(deffoo nndiary-set-status (article name value &optional group server)
+ (nndiary-possibly-change-directory group server)
+ (let ((file (nndiary-article-to-file article)))
+ (cond
+ ((not (file-exists-p file))
+ (nnheader-report 'nndiary "File %s does not exist" file))
+ (t
+ (with-temp-file file
+ (nnheader-insert-file-contents file)
+ (nnmail-replace-status name value))
+ t))))
+
+
+;;; Interface optional functions ============================================
+
+(deffoo nndiary-request-update-info (group info &optional server)
+ (nndiary-possibly-change-directory group)
+ (let ((timestamp (gnus-group-parameter-value (gnus-info-params info)
+ 'timestamp t)))
+ (if (not timestamp)
+ (nnheader-report 'nndiary "Group %s doesn't have a timestamp" group)
+ ;; else
+ ;; Figure out which articles should be re-new'ed
+ (let ((articles (nndiary-flatten (gnus-info-read info) 0))
+ article file unread buf)
+ (save-excursion
+ (setq buf (nnheader-set-temp-buffer " *nndiary update*"))
+ (while (setq article (pop articles))
+ (setq file (concat nndiary-current-directory
+ (int-to-string article)))
+ (and (file-exists-p file)
+ (nndiary-renew-article-p file timestamp)
+ (push article unread)))
+ ;;(message "unread: %s" unread)
+ (sit-for 1)
+ (kill-buffer buf))
+ (setq unread (sort unread '<))
+ (and unread
+ (gnus-info-set-read info (gnus-update-read-articles
+ (gnus-info-group info) unread t)))
+ ))
+ (run-hook-with-args 'nndiary-request-update-info-hooks
+ (gnus-info-group info))
+ t))
+
+
+
+;;; Internal functions ======================================================
+
+(defun nndiary-article-to-file (article)
+ (nndiary-update-file-alist)
+ (let (file)
+ (if (setq file (cdr (assq article nndiary-article-file-alist)))
+ (expand-file-name file nndiary-current-directory)
+ ;; Just to make sure nothing went wrong when reading over NFS --
+ ;; check once more.
+ (if nndiary-check-directory-twice
+ (when (file-exists-p
+ (setq file (expand-file-name (number-to-string article)
+ nndiary-current-directory)))
+ (nndiary-update-file-alist t)
+ file)))))
+
+(defun nndiary-deletable-article-p (group article)
+ "Say whether ARTICLE in GROUP can be deleted."
+ (let (path)
+ (when (setq path (nndiary-article-to-file article))
+ (when (file-writable-p path)
+ (or (not nnmail-keep-last-article)
+ (not (eq (cdr (nth 1 (assoc group nndiary-group-alist)))
+ article)))))))
+
+;; Find an article number in the current group given the Message-ID.
+(defun nndiary-find-group-number (id)
+ (save-excursion
+ (set-buffer (get-buffer-create " *nndiary id*"))
+ (let ((alist nndiary-group-alist)
+ number)
+ ;; We want to look through all .overview files, but we want to
+ ;; start with the one in the current directory. It seems most
+ ;; likely that the article we are looking for is in that group.
+ (if (setq number (nndiary-find-id nndiary-current-group id))
+ (cons nndiary-current-group number)
+ ;; It wasn't there, so we look through the other groups as well.
+ (while (and (not number)
+ alist)
+ (or (string= (caar alist) nndiary-current-group)
+ (setq number (nndiary-find-id (caar alist) id)))
+ (or number
+ (setq alist (cdr alist))))
+ (and number
+ (cons (caar alist) number))))))
+
+(defun nndiary-find-id (group id)
+ (erase-buffer)
+ (let ((nov (expand-file-name nndiary-nov-file-name
+ (nnmail-group-pathname group
+ nndiary-directory)))
+ number found)
+ (when (file-exists-p nov)
+ (nnheader-insert-file-contents nov)
+ (while (and (not found)
+ (search-forward id nil t)) ; We find the ID.
+ ;; And the id is in the fourth field.
+ (if (not (and (search-backward "\t" nil t 4)
+ (not (search-backward"\t" (gnus-point-at-bol) t))))
+ (forward-line 1)
+ (beginning-of-line)
+ (setq found t)
+ ;; We return the article number.
+ (setq number
+ (ignore-errors (read (current-buffer))))))
+ number)))
+
+(defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old)
+ (if (or gnus-nov-is-evil nndiary-nov-is-evil)
+ nil
+ (let ((nov (expand-file-name nndiary-nov-file-name
+ nndiary-current-directory)))
+ (when (file-exists-p nov)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (nnheader-insert-file-contents nov)
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles))
+ (car (last articles)))
+ t))))))
+
+(defun nndiary-possibly-change-directory (group &optional server)
+ (when (and server
+ (not (nndiary-server-opened server)))
+ (nndiary-open-server server))
+ (if (not group)
+ t
+ (let ((pathname (nnmail-group-pathname group nndiary-directory))
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (when (not (equal pathname nndiary-current-directory))
+ (setq nndiary-current-directory pathname
+ nndiary-current-group group
+ nndiary-article-file-alist nil))
+ (file-exists-p nndiary-current-directory))))
+
+(defun nndiary-possibly-create-directory (group)
+ (let ((dir (nnmail-group-pathname group nndiary-directory)))
+ (unless (file-exists-p dir)
+ (make-directory (directory-file-name dir) t)
+ (nnheader-message 5 "Creating mail directory %s" dir))))
+
+(defun nndiary-save-mail (group-art)
+ "Called narrowed to an article."
+ (let (chars headers)
+ (setq chars (nnmail-insert-lines))
+ (nnmail-insert-xref group-art)
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nndiary-prepare-save-mail-hook)
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (replace-match "X-From-Line: ")
+ (forward-line 1))
+ ;; We save the article in all the groups it belongs in.
+ (let ((ga group-art)
+ first)
+ (while ga
+ (nndiary-possibly-create-directory (caar ga))
+ (let ((file (concat (nnmail-group-pathname
+ (caar ga) nndiary-directory)
+ (int-to-string (cdar ga)))))
+ (if first
+ ;; It was already saved, so we just make a hard link.
+ (funcall nnmail-crosspost-link-function first file t)
+ ;; Save the article.
+ (nnmail-write-region (point-min) (point-max) file nil
+ (if (nnheader-be-verbose 5) nil 'nomesg))
+ (setq first file)))
+ (setq ga (cdr ga))))
+ ;; Generate a nov line for this article. We generate the nov
+ ;; line after saving, because nov generation destroys the
+ ;; header.
+ (setq headers (nndiary-parse-head chars))
+ ;; Output the nov line to all nov databases that should have it.
+ (let ((ga group-art))
+ (while ga
+ (nndiary-add-nov (caar ga) (cdar ga) headers)
+ (setq ga (cdr ga))))
+ group-art))
+
+(defun nndiary-active-number (group)
+ "Compute the next article number in GROUP."
+ (let ((active (cadr (assoc group nndiary-group-alist))))
+ ;; The group wasn't known to nndiary, so we just create an active
+ ;; entry for it.
+ (unless active
+ ;; Perhaps the active file was corrupt? See whether
+ ;; there are any articles in this group.
+ (nndiary-possibly-create-directory group)
+ (nndiary-possibly-change-directory group)
+ (unless nndiary-article-file-alist
+ (setq nndiary-article-file-alist
+ (sort
+ (nnheader-article-to-file-alist nndiary-current-directory)
+ 'car-less-than-car)))
+ (setq active
+ (if nndiary-article-file-alist
+ (cons (caar nndiary-article-file-alist)
+ (caar (last nndiary-article-file-alist)))
+ (cons 1 0)))
+ (push (list group active) nndiary-group-alist))
+ (setcdr active (1+ (cdr active)))
+ (while (file-exists-p
+ (expand-file-name (int-to-string (cdr active))
+ (nnmail-group-pathname group nndiary-directory)))
+ (setcdr active (1+ (cdr active))))
+ (cdr active)))
+
+(defun nndiary-add-nov (group article headers)
+ "Add a nov line for the GROUP base."
+ (save-excursion
+ (set-buffer (nndiary-open-nov group))
+ (goto-char (point-max))
+ (mail-header-set-number headers article)
+ (nnheader-insert-nov headers)))
+
+(defsubst nndiary-header-value ()
+ (buffer-substring (match-end 0) (progn (end-of-line) (point))))
+
+(defun nndiary-parse-head (chars &optional number)
+ "Parse the head of the current buffer."
+ (save-excursion
+ (save-restriction
+ (unless (zerop (buffer-size))
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
+ (let ((headers (nnheader-parse-naked-head)))
+ (mail-header-set-chars headers chars)
+ (mail-header-set-number headers number)
+ headers))))
+
+(defun nndiary-open-nov (group)
+ (or (cdr (assoc group nndiary-nov-buffer-alist))
+ (let ((buffer (get-buffer-create (format " *nndiary overview %s*"
+ group))))
+ (save-excursion
+ (set-buffer buffer)
+ (set (make-local-variable 'nndiary-nov-buffer-file-name)
+ (expand-file-name
+ nndiary-nov-file-name
+ (nnmail-group-pathname group nndiary-directory)))
+ (erase-buffer)
+ (when (file-exists-p nndiary-nov-buffer-file-name)
+ (nnheader-insert-file-contents nndiary-nov-buffer-file-name)))
+ (push (cons group buffer) nndiary-nov-buffer-alist)
+ buffer)))
+
+(defun nndiary-save-nov ()
+ (save-excursion
+ (while nndiary-nov-buffer-alist
+ (when (buffer-name (cdar nndiary-nov-buffer-alist))
+ (set-buffer (cdar nndiary-nov-buffer-alist))
+ (when (buffer-modified-p)
+ (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name
+ nil 'nomesg))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist)))))
+
+;;;###autoload
+(defun nndiary-generate-nov-databases (&optional server)
+ "Generate NOV databases in all nndiary directories."
+ (interactive (list (or (nnoo-current-server 'nndiary) "")))
+ ;; Read the active file to make sure we don't re-use articles
+ ;; numbers in empty groups.
+ (nnmail-activate 'nndiary)
+ (unless (nndiary-server-opened server)
+ (nndiary-open-server server))
+ (setq nndiary-directory (expand-file-name nndiary-directory))
+ ;; Recurse down the directories.
+ (nndiary-generate-nov-databases-1 nndiary-directory nil t)
+ ;; Save the active file.
+ (nnmail-save-active nndiary-group-alist nndiary-active-file))
+
+(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active)
+ "Regenerate the NOV database in DIR."
+ (interactive "DRegenerate NOV in: ")
+ (setq dir (file-name-as-directory dir))
+ ;; Only scan this sub-tree if we haven't been here yet.
+ (unless (member (file-truename dir) seen)
+ (push (file-truename dir) seen)
+ ;; We descend recursively
+ (let ((dirs (directory-files dir t nil t))
+ dir)
+ (while (setq dir (pop dirs))
+ (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
+ (file-directory-p dir))
+ (nndiary-generate-nov-databases-1 dir seen))))
+ ;; Do this directory.
+ (let ((files (sort (nnheader-article-to-file-alist dir)
+ 'car-less-than-car)))
+ (if (not files)
+ (let* ((group (nnheader-file-to-group
+ (directory-file-name dir) nndiary-directory))
+ (info (cadr (assoc group nndiary-group-alist))))
+ (when info
+ (setcar info (1+ (cdr info)))))
+ (funcall nndiary-generate-active-function dir)
+ ;; Generate the nov file.
+ (nndiary-generate-nov-file dir files)
+ (unless no-active
+ (nnmail-save-active nndiary-group-alist nndiary-active-file))))))
+
+(eval-when-compile (defvar files))
+(defun nndiary-generate-active-info (dir)
+ ;; Update the active info for this group.
+ (let* ((group (nnheader-file-to-group
+ (directory-file-name dir) nndiary-directory))
+ (entry (assoc group nndiary-group-alist))
+ (last (or (caadr entry) 0)))
+ (setq nndiary-group-alist (delq entry nndiary-group-alist))
+ (push (list group
+ (cons (or (caar files) (1+ last))
+ (max last
+ (or (let ((f files))
+ (while (cdr f) (setq f (cdr f)))
+ (caar f))
+ 0))))
+ nndiary-group-alist)))
+
+(defun nndiary-generate-nov-file (dir files)
+ (let* ((dir (file-name-as-directory dir))
+ (nov (concat dir nndiary-nov-file-name))
+ (nov-buffer (get-buffer-create " *nov*"))
+ chars file headers)
+ (save-excursion
+ ;; Init the nov buffer.
+ (set-buffer nov-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (set-buffer nntp-server-buffer)
+ ;; Delete the old NOV file.
+ (when (file-exists-p nov)
+ (funcall nnmail-delete-file-function nov))
+ (while files
+ (unless (file-directory-p (setq file (concat dir (cdar files))))
+ (erase-buffer)
+ (nnheader-insert-file-contents file)
+ (narrow-to-region
+ (goto-char (point-min))
+ (progn
+ (search-forward "\n\n" nil t)
+ (setq chars (- (point-max) (point)))
+ (max 1 (1- (point)))))
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (setq headers (nndiary-parse-head chars (caar files)))
+ (save-excursion
+ (set-buffer nov-buffer)
+ (goto-char (point-max))
+ (nnheader-insert-nov headers)))
+ (widen))
+ (setq files (cdr files)))
+ (save-excursion
+ (set-buffer nov-buffer)
+ (nnmail-write-region 1 (point-max) nov nil 'nomesg)
+ (kill-buffer (current-buffer))))))
+
+(defun nndiary-nov-delete-article (group article)
+ (save-excursion
+ (set-buffer (nndiary-open-nov group))
+ (when (nnheader-find-nov-line article)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (when (bobp)
+ (let ((active (cadr (assoc group nndiary-group-alist)))
+ num)
+ (when active
+ (if (eobp)
+ (setf (car active) (1+ (cdr active)))
+ (when (and (setq num (ignore-errors (read (current-buffer))))
+ (numberp num))
+ (setf (car active) num)))))))
+ t))
+
+(defun nndiary-update-file-alist (&optional force)
+ (when (or (not nndiary-article-file-alist)
+ force)
+ (setq nndiary-article-file-alist
+ (nnheader-article-to-file-alist nndiary-current-directory))))
+
+
+(defun nndiary-string-to-int (str min &optional max)
+ ;; Like `string-to-int' but barf if STR is not exactly an integer, and not
+ ;; within the specified bounds.
+ ;; Signals are caught by `nndiary-schedule'.
+ (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str))
+ (nndiary-error "not an integer value")
+ ;; else
+ (let ((val (string-to-int str)))
+ (and (or (< val min)
+ (and max (> val max)))
+ (nndiary-error "value out of range"))
+ val)))
+
+(defun nndiary-parse-schedule-value (str min-or-values max)
+ ;; Parse the schedule string STR, or signal an error.
+ ;; Signals are caught by `nndary-schedule'.
+ (if (string-match "[ \t]*\\*[ \t]*" str)
+ ;; unspecifyed
+ nil
+ ;; specifyed
+ (if (listp min-or-values)
+ ;; min-or-values is values
+ ;; #### NOTE: this is actually only a hack for time zones.
+ (let ((val (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" str)
+ (match-string 1 str))))
+ (if (and val (setq val (assoc val min-or-values)))
+ (list (cadr val))
+ (nndiary-error "invalid syntax")))
+ ;; min-or-values is min
+ (mapcar
+ (lambda (val)
+ (let ((res (split-string val "-")))
+ (cond
+ ((= (length res) 1)
+ (nndiary-string-to-int (car res) min-or-values max))
+ ((= (length res) 2)
+ ;; don't know if crontab accepts this, but ensure
+ ;; that BEG is <= END
+ (let ((beg (nndiary-string-to-int (car res) min-or-values max))
+ (end (nndiary-string-to-int (cadr res) min-or-values max)))
+ (cond ((< beg end)
+ (cons beg end))
+ ((= beg end)
+ beg)
+ (t
+ (cons end beg)))))
+ (t
+ (nndiary-error "invalid syntax")))
+ ))
+ (split-string str ",")))
+ ))
+
+;; ### FIXME: remove this function if it's used only once.
+(defun nndiary-parse-schedule (head min-or-values max)
+ ;; Parse the cron-like value of header X-Diary-HEAD in current buffer.
+ ;; - Returns nil if `*'
+ ;; - Otherwise returns a list of integers and/or ranges (BEG . END)
+ ;; The exception is the Timze-Zone value which is always of the form (STR).
+ ;; Signals are caught by `nndary-schedule'.
+ (let ((header (format "^X-Diary-%s: \\(.*\\)$" head)))
+ (goto-char (point-min))
+ (if (not (re-search-forward header nil t))
+ (nndiary-error "header missing")
+ ;; else
+ (nndiary-parse-schedule-value (match-string 1) min-or-values max))
+ ))
+
+(defun nndiary-max (spec)
+ ;; Returns the max of specification SPEC, or nil for permanent schedules.
+ (unless (null spec)
+ (let ((elts spec)
+ (max 0)
+ elt)
+ (while (setq elt (pop elts))
+ (if (integerp elt)
+ (and (> elt max) (setq max elt))
+ (and (> (cdr elt) max) (setq max (cdr elt)))))
+ max)))
+
+(defun nndiary-flatten (spec min &optional max)
+ ;; flatten the spec by expanding ranges to all possible values.
+ (let (flat n)
+ (cond ((null spec)
+ ;; this happens when I flatten something else than one of my
+ ;; schedules (a list of read articles for instance).
+ (unless (null max)
+ (setq n min)
+ (while (<= n max)
+ (push n flat)
+ (setq n (1+ n)))))
+ (t
+ (let ((elts spec)
+ elt)
+ (while (setq elt (pop elts))
+ (if (integerp elt)
+ (push elt flat)
+ ;; else
+ (setq n (car elt))
+ (while (<= n (cdr elt))
+ (push n flat)
+ (setq n (1+ n))))))))
+ flat))
+
+(defun nndiary-unflatten (spec)
+ ;; opposite of flatten: build ranges if possible
+ (setq spec (sort spec '<))
+ (let (min max res)
+ (while (setq min (pop spec))
+ (setq max min)
+ (while (and (car spec) (= (car spec) (1+ max)))
+ (setq max (1+ max))
+ (pop spec))
+ (if (= max min)
+ (setq res (append res (list min)))
+ (setq res (append res (list (cons min max))))))
+ res))
+
+(defun nndiary-compute-reminders (date)
+ ;; Returns a list of times corresponding to the reminders of date DATE.
+ ;; See the comment in `nndiary-reminders' about rounding.
+ (let* ((reminders nndiary-reminders)
+ (date-elts (decode-time date))
+ ;; ### NOTE: out-of-range values are accepted by encode-time. This
+ ;; makes our life easier.
+ (monday (- (nth 3 date-elts)
+ (if nndiary-week-starts-on-monday
+ (if (zerop (nth 6 date-elts))
+ 6
+ (- (nth 6 date-elts) 1))
+ (nth 6 date-elts))))
+ reminder res)
+ ;; remove the DOW and DST entries
+ (setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts))
+ (while (setq reminder (pop reminders))
+ (push
+ (cond ((eq (cdr reminder) 'minute)
+ (subtract-time
+ (apply 'encode-time 0 (nthcdr 1 date-elts))
+ (seconds-to-time (* (car reminder) 60.0))))
+ ((eq (cdr reminder) 'hour)
+ (subtract-time
+ (apply 'encode-time 0 0 (nthcdr 2 date-elts))
+ (seconds-to-time (* (car reminder) 3600.0))))
+ ((eq (cdr reminder) 'day)
+ (subtract-time
+ (apply 'encode-time 0 0 0 (nthcdr 3 date-elts))
+ (seconds-to-time (* (car reminder) 86400.0))))
+ ((eq (cdr reminder) 'week)
+ (subtract-time
+ (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts))
+ (seconds-to-time (* (car reminder) 604800.0))))
+ ((eq (cdr reminder) 'month)
+ (subtract-time
+ (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts))
+ (seconds-to-time (* (car reminder) 18748800.0))))
+ ((eq (cdr reminder) 'year)
+ (subtract-time
+ (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts))
+ (seconds-to-time (* (car reminder) 400861056.0)))))
+ res))
+ (sort res 'time-less-p)))
+
+(defun nndiary-last-occurence (sched)
+ ;; Returns the last occurence of schedule SCHED as an Emacs time struct, or
+ ;; nil for permanent schedule or errors.
+ (let ((minute (nndiary-max (nth 0 sched)))
+ (hour (nndiary-max (nth 1 sched)))
+ (year (nndiary-max (nth 4 sched)))
+ (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
+ (current-time-zone))))
+ (when year
+ (or minute (setq minute 59))
+ (or hour (setq hour 23))
+ ;; I'll just compute all possible values and test them by decreasing
+ ;; order until one succeeds. This is probably quide rude, but I got
+ ;; bored in finding a good algorithm for doing that ;-)
+ ;; ### FIXME: remove identical entries.
+ (let ((dom-list (nth 2 sched))
+ (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>))
+ (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>))
+ (dow-list (nth 5 sched)))
+ ;; Special case: an asterisk in one of the days specifications means
+ ;; that only the other should be taken into account. If both are
+ ;; unspecified, you would get all possible days in both.
+ (cond ((null dow-list)
+ ;; this gets all days if dom-list is nil
+ (setq dom-list (nndiary-flatten dom-list 1 31)))
+ ((null dom-list)
+ ;; this also gets all days if dow-list is nil
+ (setq dow-list (nndiary-flatten dow-list 0 6)))
+ (t
+ (setq dom-list (nndiary-flatten dom-list 1 31))
+ (setq dow-list (nndiary-flatten dow-list 0 6))))
+ (or
+ (catch 'found
+ (while (setq year (pop year-list))
+ (let ((months month-list)
+ month)
+ (while (setq month (pop months))
+ ;; Now we must merge the Dows with the Doms. To do that, we
+ ;; have to know which day is the 1st one for this month.
+ ;; Maybe there's simpler, but decode-time(encode-time) will
+ ;; give us the answer.
+ (let ((first (nth 6 (decode-time
+ (encode-time 0 0 0 1 month year
+ time-zone))))
+ (max (cond ((= month 2)
+ (if (date-leap-year-p year) 29 28))
+ ((<= month 7)
+ (if (zerop (% month 2)) 30 31))
+ (t
+ (if (zerop (% month 2)) 31 30))))
+ (doms dom-list)
+ (dows dow-list)
+ day days)
+ ;; first, review the doms to see if they are valid.
+ (while (setq day (pop doms))
+ (and (<= day max)
+ (push day days)))
+ ;; second add all possible dows
+ (while (setq day (pop dows))
+ ;; days start at 1.
+ (setq day (1+ (- day first)))
+ (and (< day 0) (setq day (+ 7 day)))
+ (while (<= day max)
+ (push day days)
+ (setq day (+ 7 day))))
+ ;; Finally, if we have some days, they are valid
+ (when days
+ (sort days '>)
+ (throw 'found
+ (encode-time 0 minute hour
+ (car days) month year time-zone)))
+ )))))
+ ;; There's an upper limit, but we didn't find any last occurence.
+ ;; This means that the schedule is undecidable. This can happen if
+ ;; you happen to say something like "each Feb 31 until 2038".
+ (progn
+ (nnheader-report 'nndiary "Undecidable schedule")
+ nil))
+ ))))
+
+(defun nndiary-next-occurence (sched now)
+ ;; Returns the next occurence of schedule SCHED, starting from time NOW.
+ ;; If there's no next occurence, returns the last one (if any) which is then
+ ;; in the past.
+ (let* ((today (decode-time now))
+ (this-minute (nth 1 today))
+ (this-hour (nth 2 today))
+ (this-day (nth 3 today))
+ (this-month (nth 4 today))
+ (this-year (nth 5 today))
+ (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
+ (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
+ (dom-list (nth 2 sched))
+ (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<))
+ (years (if (nth 4 sched)
+ (sort (nndiary-flatten (nth 4 sched) 1971) '<)
+ t))
+ (dow-list (nth 5 sched))
+ (year (1- this-year))
+ (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
+ (current-time-zone))))
+ ;; Special case: an asterisk in one of the days specifications means that
+ ;; only the other should be taken into account. If both are unspecified,
+ ;; you would get all possible days in both.
+ (cond ((null dow-list)
+ ;; this gets all days if dom-list is nil
+ (setq dom-list (nndiary-flatten dom-list 1 31)))
+ ((null dom-list)
+ ;; this also gets all days if dow-list is nil
+ (setq dow-list (nndiary-flatten dow-list 0 6)))
+ (t
+ (setq dom-list (nndiary-flatten dom-list 1 31))
+ (setq dow-list (nndiary-flatten dow-list 0 6))))
+ ;; Remove past years.
+ (unless (eq years t)
+ (while (and (car years) (< (car years) this-year))
+ (pop years)))
+ (if years
+ ;; Because we might not be limited in years, we must guard against
+ ;; infinite loops. Appart from cases like Feb 31, there are probably
+ ;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
+ ;; decide this, so I assume that if we reach 10 years later, the
+ ;; schedule is undecidable.
+ (or
+ (catch 'found
+ (while (if (eq years t)
+ (and (setq year (1+ year))
+ (<= year (+ 10 this-year)))
+ (setq year (pop years)))
+ (let ((months month-list)
+ month)
+ ;; Remove past months for this year.
+ (and (= year this-year)
+ (while (and (car months) (< (car months) this-month))
+ (pop months)))
+ (while (setq month (pop months))
+ ;; Now we must merge the Dows with the Doms. To do that, we
+ ;; have to know which day is the 1st one for this month.
+ ;; Maybe there's simpler, but decode-time(encode-time) will
+ ;; give us the answer.
+ (let ((first (nth 6 (decode-time
+ (encode-time 0 0 0 1 month year
+ time-zone))))
+ (max (cond ((= month 2)
+ (if (date-leap-year-p year) 29 28))
+ ((<= month 7)
+ (if (zerop (% month 2)) 30 31))
+ (t
+ (if (zerop (% month 2)) 31 30))))
+ (doms dom-list)
+ (dows dow-list)
+ day days)
+ ;; first, review the doms to see if they are valid.
+ (while (setq day (pop doms))
+ (and (<= day max)
+ (push day days)))
+ ;; second add all possible dows
+ (while (setq day (pop dows))
+ ;; days start at 1.
+ (setq day (1+ (- day first)))
+ (and (< day 0) (setq day (+ 7 day)))
+ (while (<= day max)
+ (push day days)
+ (setq day (+ 7 day))))
+ ;; Aaaaaaall right. Now we have a valid list of DAYS for
+ ;; this month and this year.
+ (when days
+ (setq days (sort days '<))
+ ;; Remove past days for this year and this month.
+ (and (= year this-year)
+ (= month this-month)
+ (while (and (car days) (< (car days) this-day))
+ (pop days)))
+ (while (setq day (pop days))
+ (let ((hours hour-list)
+ hour)
+ ;; Remove past hours for this year, this month and
+ ;; this day.
+ (and (= year this-year)
+ (= month this-month)
+ (= day this-day)
+ (while (and (car hours)
+ (< (car hours) this-hour))
+ (pop hours)))
+ (while (setq hour (pop hours))
+ (let ((minutes minute-list)
+ minute)
+ ;; Remove past hours for this year, this month,
+ ;; this day and this hour.
+ (and (= year this-year)
+ (= month this-month)
+ (= day this-day)
+ (= hour this-hour)
+ (while (and (car minutes)
+ (< (car minutes) this-minute))
+ (pop minutes)))
+ (while (setq minute (pop minutes))
+ ;; Ouch! Here, we've got a complete valid
+ ;; schedule. It's a good one if it's in the
+ ;; future.
+ (let ((time (encode-time 0 minute hour day
+ month year
+ time-zone)))
+ (and (time-less-p now time)
+ (throw 'found time)))
+ ))))
+ ))
+ )))
+ ))
+ (nndiary-last-occurence sched))
+ ;; else
+ (nndiary-last-occurence sched))
+ ))
+
+(defun nndiary-expired-article-p (file)
+ (with-temp-buffer
+ (if (nnheader-insert-head file)
+ (let ((sched (nndiary-schedule)))
+ ;; An article has expired if its last schedule (if any) is in the
+ ;; past. A permanent schedule never expires.
+ (and sched
+ (setq sched (nndiary-last-occurence sched))
+ (time-less-p sched (current-time))))
+ ;; else
+ (nnheader-report 'nndiary "Could not read file %s" file)
+ nil)
+ ))
+
+(defun nndiary-renew-article-p (file timestamp)
+ (erase-buffer)
+ (if (nnheader-insert-head file)
+ (let ((now (current-time))
+ (sched (nndiary-schedule)))
+ ;; The article should be re-considered as unread if there's a reminder
+ ;; between the group timestamp and the current time.
+ (when (and sched (setq sched (nndiary-next-occurence sched now)))
+ (let ((reminders ;; add the next occurence itself at the end.
+ (append (nndiary-compute-reminders sched) (list sched))))
+ (while (and reminders (time-less-p (car reminders) timestamp))
+ (pop reminders))
+ ;; The reminders might be empty if the last date is in the past,
+ ;; or we've got at least the next occurence itself left. All past
+ ;; dates are renewed.
+ (or (not reminders)
+ (time-less-p (car reminders) now)))
+ ))
+ ;; else
+ (nnheader-report 'nndiary "Could not read file %s" file)
+ nil))
+
+;; The end... ===============================================================
+
+(mapcar
+ (lambda (elt)
+ (let ((header (intern (format "X-Diary-%s" (car elt)))))
+ ;; Required for building NOV databases and some other stuff
+ (add-to-list 'gnus-extra-headers header)
+ (add-to-list 'nnmail-extra-headers header)))
+ nndiary-headers)
+
+(unless (assoc "nndiary" gnus-valid-select-methods)
+ (gnus-declare-backend "nndiary" 'post-mail 'respool 'address))
+
+(provide 'nndiary)
+
+
+;;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203
+;;; nndiary.el ends here
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 85f13d9372d..47a3cbd0292 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -1,5 +1,5 @@
;;; nndoc.el --- single file access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -58,9 +58,16 @@ from the document.")
`((mmdf
(article-begin . "^\^A\^A\^A\^A\n")
(body-end . "^\^A\^A\^A\^A\n"))
- (exim-bounce
- (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n")
- (body-end-function . nndoc-exim-bounce-body-end-function))
+ (mime-digest
+ (article-begin . "")
+ (head-begin . "^ ?\n")
+ (head-end . "^ ?$")
+ (body-end . "")
+ (file-end . "")
+ (subtype digest guess))
+ (mime-parts
+ (generate-head-function . nndoc-generate-mime-parts-head)
+ (article-transform-function . nndoc-transform-mime-parts))
(nsmail
(article-begin . "^From - "))
(news
@@ -76,6 +83,9 @@ from the document.")
(body-end . "\^_")
(body-begin-function . nndoc-babyl-body-begin)
(head-begin-function . nndoc-babyl-head-begin))
+ (exim-bounce
+ (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n")
+ (body-end-function . nndoc-exim-bounce-body-end-function))
(rfc934
(article-begin . "^--.*\n+")
(body-end . "^--.*$")
@@ -91,16 +101,7 @@ from the document.")
(head-end . "^\t")
(generate-head-function . nndoc-generate-clari-briefs-head)
(article-transform-function . nndoc-transform-clari-briefs))
- (mime-digest
- (article-begin . "")
- (head-begin . "^ ?\n")
- (head-end . "^ ?$")
- (body-end . "")
- (file-end . "")
- (subtype digest guess))
- (mime-parts
- (generate-head-function . nndoc-generate-mime-parts-head)
- (article-transform-function . nndoc-transform-mime-parts))
+
(standard-digest
(first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
(article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
@@ -129,8 +130,10 @@ from the document.")
(article-transform-function . nndoc-transform-lanl-gov-announce)
(subtype preprints guess))
(rfc822-forward
- (article-begin . "^\n")
- (body-end-function . nndoc-rfc822-forward-body-end-function))
+ (article-begin . "^\n+")
+ (body-end-function . nndoc-rfc822-forward-body-end-function)
+ (generate-head-function . nndoc-rfc822-forward-generate-head)
+ (generate-article-function . nndoc-rfc822-forward-generate-article))
(outlook
(article-begin-function . nndoc-outlook-article-begin)
(body-end . "\0"))
@@ -393,7 +396,7 @@ from the document.")
(error "Document is not of any recognized type"))
(if result
(car entry)
- (cadar (sort results 'car-less-than-car)))))
+ (cadar (last (sort results 'car-less-than-car))))))
;;;
;;; Built-in type predicates and functions
@@ -468,7 +471,7 @@ from the document.")
(defun nndoc-forward-type-p ()
(when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+"
nil t)
- (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:"))
+ (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:\\|^>?From "))
t))
(defun nndoc-rfc934-type-p ()
@@ -491,6 +494,29 @@ from the document.")
(defun nndoc-rfc822-forward-body-end-function ()
(goto-char (point-max)))
+(defun nndoc-rfc822-forward-generate-article (article &optional head)
+ (let ((entry (cdr (assq article nndoc-dissection-alist)))
+ (begin (point))
+ encoding)
+ (with-current-buffer nndoc-current-buffer
+ (save-restriction
+ (message-narrow-to-head)
+ (setq encoding (message-fetch-field "content-transfer-encoding"))))
+ (insert-buffer-substring nndoc-current-buffer (car entry) (nth 3 entry))
+ (when encoding
+ (save-restriction
+ (narrow-to-region begin (point-max))
+ (mm-decode-content-transfer-encoding
+ (intern (downcase (mail-header-strip encoding))))))
+ (when head
+ (goto-char begin)
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))))
+ t)
+
+(defun nndoc-rfc822-forward-generate-head (article)
+ (nndoc-rfc822-forward-generate-article article 'head))
+
(defun nndoc-mime-parts-type-p ()
(let ((case-fold-search t)
(limit (search-forward "\n\n" nil t)))
@@ -771,7 +797,7 @@ from the document.")
"Go through the document and partition it into heads/bodies/articles."
(let ((i 0)
(first t)
- head-begin head-end body-begin body-end)
+ art-begin head-begin head-end body-begin body-end)
(setq nndoc-dissection-alist nil)
(save-excursion
(set-buffer nndoc-current-buffer)
@@ -787,8 +813,11 @@ from the document.")
;; Go through the file.
(while (if (and first nndoc-first-article)
(nndoc-search nndoc-first-article)
- (nndoc-article-begin))
- (setq first nil)
+ (if art-begin
+ (goto-char art-begin)
+ (nndoc-article-begin)))
+ (setq first nil
+ art-begin nil)
(cond (nndoc-head-begin-function
(funcall nndoc-head-begin-function))
(nndoc-head-begin
@@ -808,7 +837,8 @@ from the document.")
(funcall nndoc-body-end-function))
(and nndoc-body-end
(nndoc-search nndoc-body-end))
- (nndoc-article-begin)
+ (and (nndoc-article-begin)
+ (setq art-begin (point)))
(progn
(goto-char (point-max))
(when nndoc-file-end
@@ -890,7 +920,7 @@ PARENT is the message-ID of the parent summary line, or nil for none."
subtype "plain"))
;; Prepare the article and summary inserts.
(unless article-insert
- (setq article-insert (buffer-substring (point-min) (point-max))
+ (setq article-insert (buffer-string)
head-end head-begin))
;; Fix MIME-Version
(unless (string-match "MIME-Version:" article-insert)
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 517f08aacf4..9235bf72a29 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -1,5 +1,6 @@
;;; nndraft.el --- draft article access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -32,10 +33,7 @@
(require 'nnmh)
(require 'nnoo)
(require 'mm-util)
-(eval-when-compile
- (require 'cl)
- ;; This is just to shut up the byte-compiler.
- (fset 'nndraft-request-group 'ignore))
+(eval-when-compile (require 'cl))
(nnoo-declare nndraft
nnmh)
@@ -113,7 +111,7 @@
(when (and (file-exists-p newest)
(let ((nnmail-file-coding-system
(if (file-newer-than-file-p file auto)
- (if (equal group "drafts")
+ (if (member group '("drafts" "delayed"))
message-draft-coding-system
mm-text-coding-system)
mm-auto-save-coding-system)))
@@ -124,7 +122,7 @@
;; If there's a mail header separator in this file,
;; we remove it.
(when (re-search-forward
- (concat "^" mail-header-separator "$") nil t)
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
(replace-match "" t t)))
t))))
@@ -134,6 +132,9 @@
(when (nndraft-request-article article group server (current-buffer))
(message-remove-header "xref")
(message-remove-header "lines")
+ ;; Articles in nndraft:queue are considered as sent messages. The
+ ;; Date field should be the time when they are sent.
+ ;;(message-remove-header "date")
t))
(deffoo nndraft-request-update-info (group info &optional server)
@@ -151,6 +152,12 @@
nil))))
t)
+(defun nndraft-generate-headers ()
+ (save-excursion
+ (message-generate-headers
+ (message-headers-to-generate
+ message-required-headers message-draft-headers nil))))
+
(deffoo nndraft-request-associate-buffer (group)
"Associate the current buffer with some article in the draft group."
(nndraft-open-server "")
@@ -167,8 +174,45 @@
(setq buffer-file-name (expand-file-name file)
buffer-auto-save-file-name (make-auto-save-file-name))
(clear-visited-file-modtime)
+ (make-local-variable 'write-contents-hooks)
+ (push 'nndraft-generate-headers write-contents-hooks)
article))
+(deffoo nndraft-request-group (group &optional server dont-check)
+ (nndraft-possibly-change-group group)
+ (unless dont-check
+ (let* ((pathname (nnmail-group-pathname group nndraft-directory))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ dir file)
+ (nnheader-re-read-dir pathname)
+ (setq dir (mapcar (lambda (name) (string-to-int (substring name 1)))
+ (ignore-errors (directory-files
+ pathname nil "^#[0-9]+#$" t))))
+ (dolist (n dir)
+ (unless (file-exists-p
+ (setq file (expand-file-name (int-to-string n) pathname)))
+ (rename-file (nndraft-auto-save-file-name file) file)))))
+ (nnoo-parent-function 'nndraft
+ 'nnmh-request-group
+ (list group server dont-check)))
+
+(deffoo nndraft-request-move-article (article group server
+ accept-form &optional last)
+ (nndraft-possibly-change-group group)
+ (let ((buf (get-buffer-create " *nndraft move*"))
+ result)
+ (and
+ (nndraft-request-article article group server)
+ (save-excursion
+ (set-buffer buf)
+ (erase-buffer)
+ (insert-buffer-substring nntp-server-buffer)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (null (nndraft-request-expire-articles (list article) group server 'force))
+ result)))
+
(deffoo nndraft-request-expire-articles (articles group &optional server force)
(nndraft-possibly-change-group group)
(let* ((nnmh-allow-delete-final t)
@@ -201,8 +245,8 @@
(deffoo nndraft-request-replace-article (article group buffer)
(nndraft-possibly-change-group group)
(let ((nnmail-file-coding-system
- (if (equal group "drafts")
- mm-auto-save-coding-system
+ (if (member group '("drafts" "delayed"))
+ message-draft-coding-system
mm-text-coding-system)))
(nnoo-parent-function 'nndraft 'nnmh-request-replace-article
(list article group buffer))))
@@ -259,8 +303,7 @@
nnmh-request-group
nnmh-close-group
nnmh-request-list
- nnmh-request-newsgroups
- nnmh-request-move-article))
+ nnmh-request-newsgroups))
(provide 'nndraft)
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 715c3d890c4..7028e239a52 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -1,10 +1,10 @@
;;; nneething.el --- arbitrary file access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
@@ -64,7 +64,6 @@ included.")
(defvoo nneething-status-string "")
-(defvoo nneething-message-id-number 0)
(defvoo nneething-work-buffer " *nneething work*")
(defvoo nneething-group nil)
@@ -122,15 +121,27 @@ included.")
(let ((file (unless (stringp id)
(nneething-file-name id)))
(nntp-server-buffer (or buffer nntp-server-buffer)))
- (and (stringp file) ; We did not request by Message-ID.
+ (and (stringp file) ; We did not request by Message-ID.
(file-exists-p file) ; The file exists.
(not (file-directory-p file)) ; It's not a dir.
(save-excursion
- (nnmail-find-file file) ; Insert the file in the nntp buf.
+ (let ((nnmail-file-coding-system 'binary))
+ (nnmail-find-file file)) ; Insert the file in the nntp buf.
(unless (nnheader-article-p) ; Either it's a real article...
- (goto-char (point-min))
- (nneething-make-head
- file (current-buffer)) ; ... or we fake some headers.
+ (let ((type
+ (unless (file-directory-p file)
+ (or (cdr (assoc (concat "." (file-name-extension file))
+ mailcap-mime-extensions))
+ "text/plain")))
+ (charset
+ (mm-detect-mime-charset-region (point-min) (point-max)))
+ (encoding))
+ (unless (string-match "\\`text/" type)
+ (base64-encode-region (point-min) (point-max))
+ (setq encoding "base64"))
+ (goto-char (point-min))
+ (nneething-make-head file (current-buffer)
+ nil type charset encoding))
(insert "\n"))
t))))
@@ -234,7 +245,7 @@ included.")
prev)
(while map
(if (and (member (cadr (car map)) files)
- ;; We also remove files that have changed mod times.
+ ;; We also remove files that have changed mod times.
(equal (nth 5 (file-attributes
(nneething-file-name (cadr (car map)))))
(cadr (cdar map))))
@@ -272,13 +283,42 @@ included.")
(insert-buffer-substring nneething-work-buffer)
(goto-char (point-max))))
-(defun nneething-make-head (file &optional buffer)
+(defun nneething-encode-file-name (file &optional coding-system)
+ "Encode the name of the FILE in CODING-SYSTEM."
+ (let ((pos 0) buf)
+ (setq file (mm-encode-coding-string
+ file (or coding-system nnmail-pathname-coding-system)))
+ (while (string-match "[^-0-9a-zA-Z_:/.]" file pos)
+ (setq buf (cons (format "%%%02x" (aref file (match-beginning 0)))
+ (cons (substring file pos (match-beginning 0)) buf))
+ pos (match-end 0)))
+ (apply (function concat)
+ (nreverse (cons (substring file pos) buf)))))
+
+(defun nneething-decode-file-name (file &optional coding-system)
+ "Decode the name of the FILE is encoded in CODING-SYSTEM."
+ (let ((pos 0) buf)
+ (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos)
+ (setq buf (cons (string (string-to-number (match-string 1 file) 16))
+ (cons (substring file pos (match-beginning 0)) buf))
+ pos (match-end 0)))
+ (decode-coding-string
+ (apply (function concat)
+ (nreverse (cons (substring file pos) buf)))
+ (or coding-system nnmail-pathname-coding-system))))
+
+(defun nneething-get-file-name (id)
+ "Extract the file name from the message ID string."
+ (when (string-match "\\`<nneething-\\([^@]+\\)@.*>\\'" id)
+ (nneething-decode-file-name (match-string 1 id))))
+
+(defun nneething-make-head (file &optional buffer extra-msg
+ mime-type mime-charset mime-encoding)
"Create a head by looking at the file attributes of FILE."
(let ((atts (file-attributes file)))
(insert
- "Subject: " (file-name-nondirectory file) "\n"
- "Message-ID: <nneething-"
- (int-to-string (incf nneething-message-id-number))
+ "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n"
+ "Message-ID: <nneething-" (nneething-encode-file-name file)
"@" (system-name) ">\n"
(if (equal '(0 0) (nth 5 atts)) ""
(concat "Date: " (current-time-string (nth 5 atts)) "\n"))
@@ -297,6 +337,19 @@ included.")
(concat "Lines: " (int-to-string
(count-lines (point-min) (point-max)))
"\n"))
+ "")
+ (if mime-type
+ (concat "Content-Type: " mime-type
+ (if mime-charset
+ (concat "; charset="
+ (if (stringp mime-charset)
+ mime-charset
+ (symbol-name mime-charset)))
+ "")
+ (if mime-encoding
+ (concat "\nContent-Transfer-Encoding: " mime-encoding)
+ "")
+ "\nMIME-Version: 1.0\n")
""))))
(defun nneething-from-line (uid &optional file)
@@ -344,24 +397,28 @@ included.")
(nneething-make-head file) t)
(t
;; We examine the file.
- (nnheader-insert-head file)
- (if (nnheader-article-p)
- (delete-region
- (progn
- (goto-char (point-min))
- (or (and (search-forward "\n\n" nil t)
- (1- (point)))
- (point-max)))
- (point-max))
- (goto-char (point-min))
- (nneething-make-head file (current-buffer))
- (delete-region (point) (point-max)))
+ (condition-case ()
+ (progn
+ (nnheader-insert-head file)
+ (if (nnheader-article-p)
+ (delete-region
+ (progn
+ (goto-char (point-min))
+ (or (and (search-forward "\n\n" nil t)
+ (1- (point)))
+ (point-max)))
+ (point-max))
+ (goto-char (point-min))
+ (nneething-make-head file (current-buffer))
+ (delete-region (point) (point-max))))
+ (file-error
+ (nneething-make-head file (current-buffer) " (unreadable)")))
t))))
(defun nneething-file-name (article)
"Return the file name of ARTICLE."
(let ((dir (file-name-as-directory nneething-address))
- fname)
+ fname)
(if (numberp article)
(if (setq fname (cadr (assq article nneething-map)))
(expand-file-name fname dir)
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index b4699c4e5be..142202cb4d2 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -1,10 +1,12 @@
;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
-;; Author: Scott Byer <byer@mv.us.adobe.com>
+;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
+;; Scott Byer <byer@mv.us.adobe.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -33,14 +35,27 @@
(require 'nnmail)
(require 'nnoo)
(eval-when-compile (require 'cl))
+(require 'gnus)
(require 'gnus-util)
(require 'gnus-range)
+(eval-and-compile
+ (autoload 'gnus-article-unpropagatable-p "gnus-sum")
+ (autoload 'gnus-intersection "gnus-range"))
+
(nnoo-declare nnfolder)
(defvoo nnfolder-directory (expand-file-name message-directory)
"The name of the nnfolder directory.")
+(defvoo nnfolder-nov-directory nil
+ "The name of the nnfolder NOV directory.
+If nil, `nnfolder-directory' is used.")
+
+(defvoo nnfolder-marks-directory nil
+ "The name of the nnfolder MARKS directory.
+If nil, `nnfolder-directory' is used.")
+
(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
"The name of the active file.")
@@ -76,12 +91,13 @@ message, a huge time saver for large mailboxes.")
(defvoo nnfolder-save-buffer-hook nil
"Hook run before saving the nnfolder mbox buffer.")
+
(defvoo nnfolder-inhibit-expiry nil
"If non-nil, inhibit expiry.")
-(defconst nnfolder-version "nnfolder 1.0"
+(defconst nnfolder-version "nnfolder 2.0"
"nnfolder version.")
(defconst nnfolder-article-marker "X-Gnus-Article-Number: "
@@ -100,7 +116,37 @@ message, a huge time saver for large mailboxes.")
(defvoo nnfolder-file-coding-system mm-text-coding-system)
(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system
"Coding system for save nnfolder file.
-If nil, `nnfolder-file-coding-system' is used.")
+if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable
+
+(defvoo nnfolder-nov-is-evil nil
+ "If non-nil, Gnus will never generate and use nov databases for mail groups.
+Using nov databases will speed up header fetching considerably.
+This variable shouldn't be flipped much. If you have, for some reason,
+set this to t, and want to set it to nil again, you should always run
+the `nnfolder-generate-active-file' command. The function will go
+through all nnfolder directories and generate nov databases for them
+all. This may very well take some time.")
+
+(defvoo nnfolder-nov-file-suffix ".nov")
+
+(defvoo nnfolder-nov-buffer-alist nil)
+
+(defvar nnfolder-nov-buffer-file-name nil)
+
+(defvoo nnfolder-marks-is-evil nil
+ "If non-nil, Gnus will never generate and use marks file for mail groups.
+Using marks files makes it possible to backup and restore mail groups
+separately from `.newsrc.eld'. If you have, for some reason, set
+this to t, and want to set it to nil again, you should always remove
+the corresponding marks file (usually base nnfolder file name
+concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
+the group. Then the marks file will be regenerated properly by Gnus.")
+
+(defvoo nnfolder-marks nil)
+
+(defvoo nnfolder-marks-file-suffix ".mrk")
+
+(defvar nnfolder-marks-modtime (gnus-make-hashtable))
@@ -112,34 +158,82 @@ If nil, `nnfolder-file-coding-system' is used.")
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let (article start stop)
+ (let (article start stop num)
(nnfolder-possibly-change-group group server)
(when nnfolder-current-buffer
(set-buffer nnfolder-current-buffer)
(goto-char (point-min))
(if (stringp (car articles))
'headers
- (while (setq article (pop articles))
- (set-buffer nnfolder-current-buffer)
- (when (nnfolder-goto-article article)
- (setq start (point))
- (setq stop (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (set-buffer nntp-server-buffer)
- (insert (format "221 %d Article retrieved.\n" article))
- (insert-buffer-substring nnfolder-current-buffer start stop)
- (goto-char (point-max))
- (insert ".\n")))
-
- (set-buffer nntp-server-buffer)
- (nnheader-fold-continuation-lines)
- 'headers)))))
+ (if (nnfolder-retrieve-headers-with-nov articles fetch-old)
+ 'nov
+ (setq articles (gnus-sorted-intersection
+ ;; Is ARTICLES sorted?
+ (sort articles '<)
+ (nnfolder-existing-articles)))
+ (while (setq article (pop articles))
+ (set-buffer nnfolder-current-buffer)
+ (cond ((nnfolder-goto-article article)
+ (setq start (point))
+ (setq stop (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (set-buffer nntp-server-buffer)
+ (insert (format "221 %d Article retrieved.\n" article))
+ (insert-buffer-substring nnfolder-current-buffer
+ start stop)
+ (goto-char (point-max))
+ (insert ".\n"))
+
+ ;; If we couldn't find this article, skip over ranges
+ ;; of missing articles so we don't search the whole file
+ ;; for each of them.
+ ((numberp article)
+ (setq start (point))
+ (and
+ ;; Check that we are either at BOF or after an
+ ;; article with a lower number. We do this so we
+ ;; won't be confused by out-of-order article numbers,
+ ;; as caused by active file bogosity.
+ (cond
+ ((bobp))
+ ((search-backward (concat "\n" nnfolder-article-marker)
+ nil t)
+ (goto-char (match-end 0))
+ (setq num (string-to-int
+ (buffer-substring
+ (point) (gnus-point-at-eol))))
+ (goto-char start)
+ (< num article)))
+ ;; Check that we are before an article with a
+ ;; higher number.
+ (search-forward (concat "\n" nnfolder-article-marker)
+ nil t)
+ (progn
+ (setq num (string-to-int
+ (buffer-substring
+ (point) (gnus-point-at-eol))))
+ (> num article))
+ ;; Discard any article numbers before the one we're
+ ;; now looking at.
+ (while (and articles
+ (< (car articles) num))
+ (setq articles (cdr articles))))
+ (goto-char start))))
+ (set-buffer nntp-server-buffer)
+ (nnheader-fold-continuation-lines)
+ 'headers))))))
(deffoo nnfolder-open-server (server &optional defs)
(nnoo-change-server 'nnfolder server defs)
(nnmail-activate 'nnfolder t)
(gnus-make-directory nnfolder-directory)
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (and nnfolder-nov-directory
+ (gnus-make-directory nnfolder-nov-directory)))
+ (unless nnfolder-marks-is-evil
+ (and nnfolder-marks-directory
+ (gnus-make-directory nnfolder-marks-directory)))
(cond
((not (file-exists-p nnfolder-directory))
(nnfolder-close-server)
@@ -191,9 +285,8 @@ If nil, `nnfolder-file-coding-system' is used.")
(cons nnfolder-current-group
(if (search-forward (concat "\n" nnfolder-article-marker)
nil t)
- (string-to-int
- (buffer-substring
- (point) (progn (end-of-line) (point))))
+ (string-to-int (buffer-substring
+ (point) (gnus-point-at-eol)))
-1))))))))
(deffoo nnfolder-request-group (group &optional server dont-check)
@@ -313,13 +406,13 @@ If nil, `nnfolder-file-coding-system' is used.")
(let ((marker (concat "\n" nnfolder-article-marker))
(number "[0-9]+")
numbers)
-
(while (and (search-forward marker nil t)
(re-search-forward number nil t))
(let ((newnum (string-to-number (match-string 0))))
(if (nnmail-within-headers-p)
(push newnum numbers))))
- numbers))))
+ ;; The article numbers are increasing, so this result is sorted.
+ (nreverse numbers)))))
(deffoo nnfolder-request-expire-articles
(articles newsgroup &optional server force)
@@ -330,7 +423,7 @@ If nil, `nnfolder-file-coding-system' is used.")
;; The articles that really exist and will
;; be expired if they are old enough.
(maybe-expirable
- (gnus-intersection articles (nnfolder-existing-articles))))
+ (gnus-sorted-intersection articles (nnfolder-existing-articles))))
(nnmail-activate 'nnfolder)
(save-excursion
@@ -354,12 +447,15 @@ If nil, `nnfolder-file-coding-system' is used.")
(with-temp-buffer
(nnfolder-request-article (car maybe-expirable)
newsgroup server (current-buffer))
- (let ((nnml-current-directory nil))
+ (let ((nnfolder-current-directory nil))
(nnmail-expiry-target-group
- nnmail-expiry-target newsgroup))))
+ nnmail-expiry-target newsgroup)))
+ (nnfolder-possibly-change-group newsgroup server))
(nnheader-message 5 "Deleting article %d in %s..."
(car maybe-expirable) newsgroup)
(nnfolder-delete-mail)
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-nov-delete-article newsgroup (car maybe-expirable)))
;; Must remember which articles were actually deleted
(push (car maybe-expirable) deleted-articles)))
(setq maybe-expirable (cdr maybe-expirable)))
@@ -368,7 +464,7 @@ If nil, `nnfolder-file-coding-system' is used.")
(nnfolder-save-buffer)
(nnfolder-adjust-min-active newsgroup)
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- (gnus-sorted-complement articles (nreverse deleted-articles)))))
+ (gnus-sorted-difference articles (nreverse deleted-articles)))))
(deffoo nnfolder-request-move-article (article group server
accept-form &optional last)
@@ -386,8 +482,7 @@ If nil, `nnfolder-file-coding-system' is used.")
(concat "^" nnfolder-article-marker)
(save-excursion (and (search-forward "\n\n" nil t) (point)))
t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
+ (gnus-delete-line))
(setq result (eval accept-form))
(kill-buffer buf)
result)
@@ -397,6 +492,8 @@ If nil, `nnfolder-file-coding-system' is used.")
(goto-char (point-min))
(when (nnfolder-goto-article article)
(nnfolder-delete-mail))
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-nov-delete-article group article))
(when last
(nnfolder-save-buffer)
(nnfolder-adjust-min-active group)
@@ -414,33 +511,38 @@ If nil, `nnfolder-file-coding-system' is used.")
(replace-match "From ")
(while (progn (forward-line) (looking-at "[ \t]"))
(delete-char -1)))
- (and
- (nnfolder-request-list)
- (save-excursion
- (set-buffer buf)
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (goto-char (point-max)))
- (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
- (delete-region (point) (progn (forward-line 1) (point))))
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
- (setq result (if (stringp group)
- (list (cons group (nnfolder-active-number group)))
- (setq art-group
- (nnmail-article-group 'nnfolder-active-number))))
- (if (and (null result)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result
- (car (nnfolder-save-mail result)))))
- (when last
- (save-excursion
- (nnfolder-possibly-change-folder (or (caar art-group) group))
- (nnfolder-save-buffer)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-close)))))
+ (with-temp-buffer
+ (let ((nnmail-file-coding-system nnfolder-active-file-coding-system)
+ (nntp-server-buffer (current-buffer)))
+ (nnmail-find-file nnfolder-active-file)
+ (setq nnfolder-group-alist (nnmail-parse-active))))
+ (save-excursion
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (forward-line -1)
+ (goto-char (point-max)))
+ (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
+ (setq result (if (stringp group)
+ (list (cons group (nnfolder-active-number group)))
+ (setq art-group
+ (nnmail-article-group 'nnfolder-active-number))))
+ (if (and (null result)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result
+ (car (nnfolder-save-mail result)))))
+ (when last
+ (save-excursion
+ (nnfolder-possibly-change-folder (or (caar art-group) group))
+ (nnfolder-save-buffer)
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-close))))
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
(unless result
(nnheader-report 'nnfolder "Couldn't store article"))
@@ -451,15 +553,13 @@ If nil, `nnfolder-file-coding-system' is used.")
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
- (let (xfrom)
- (while (re-search-forward "^X-From-Line: \\(.*\\)$" nil t)
- (setq xfrom (match-string 1))
- (gnus-delete-line))
- (goto-char (point-min))
- (if xfrom
- (insert "From " xfrom "\n")
- (unless (looking-at "From ")
- (insert "From nobody " (current-time-string) "\n"))))
+ (if (not (looking-at "X-From-Line: "))
+ (insert "From nobody " (current-time-string) "\n")
+ (replace-match "From ")
+ (forward-line 1)
+ (while (looking-at "[ \t]")
+ (delete-char -1)
+ (forward-line 1)))
(nnfolder-normalize-buffer)
(set-buffer nnfolder-current-buffer)
(goto-char (point-min))
@@ -467,6 +567,15 @@ If nil, `nnfolder-file-coding-system' is used.")
nil
(nnfolder-delete-mail)
(insert-buffer-substring buffer)
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (save-excursion
+ (set-buffer buffer)
+ (let ((headers (nnfolder-parse-head article
+ (point-min) (point-max))))
+ (with-current-buffer (nnfolder-open-nov group)
+ (if (nnheader-find-nov-line article)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (nnheader-insert-nov headers)))))
(nnfolder-save-buffer)
t)))
@@ -476,8 +585,12 @@ If nil, `nnfolder-file-coding-system' is used.")
(if (not force)
() ; Don't delete the articles.
;; Delete the file that holds the group.
- (ignore-errors
- (delete-file (nnfolder-group-pathname group))))
+ (let ((data (nnfolder-group-pathname group))
+ (nov (nnfolder-group-nov-pathname group))
+ (mrk (nnfolder-group-marks-pathname group)))
+ (ignore-errors (delete-file data))
+ (ignore-errors (delete-file nov))
+ (ignore-errors (delete-file mrk))))
;; Remove the group from all structures.
(setq nnfolder-group-alist
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
@@ -493,11 +606,17 @@ If nil, `nnfolder-file-coding-system' is used.")
(set-buffer nnfolder-current-buffer)
(and (file-writable-p buffer-file-name)
(ignore-errors
- (rename-file
- buffer-file-name
- (let ((new-file (nnfolder-group-pathname new-name)))
- (gnus-make-directory (file-name-directory new-file))
- new-file))
+ (let ((new-file (nnfolder-group-pathname new-name)))
+ (gnus-make-directory (file-name-directory new-file))
+ (rename-file buffer-file-name new-file)
+ (when (file-exists-p (nnfolder-group-nov-pathname group))
+ (setq new-file (nnfolder-group-nov-pathname new-name))
+ (gnus-make-directory (file-name-directory new-file))
+ (rename-file (nnfolder-group-nov-pathname group) new-file))
+ (when (file-exists-p (nnfolder-group-marks-pathname group))
+ (setq new-file (nnfolder-group-marks-pathname new-name))
+ (gnus-make-directory (file-name-directory new-file))
+ (rename-file (nnfolder-group-marks-pathname group) new-file)))
t)
;; That went ok, so we change the internal structures.
(let ((entry (assoc group nnfolder-group-alist)))
@@ -510,7 +629,7 @@ If nil, `nnfolder-file-coding-system' is used.")
(kill-buffer (current-buffer))
t))))
-(defun nnfolder-request-regenerate (server)
+(deffoo nnfolder-request-regenerate (server)
(nnfolder-possibly-change-group nil server)
(nnfolder-generate-active-file)
t)
@@ -592,30 +711,26 @@ deleted. Point is left where the deleted region was."
(setq nnfolder-current-buffer nil
nnfolder-current-group nil))
;; Change group.
- (when (and group
- (not (equal group nnfolder-current-group)))
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (nnmail-activate 'nnfolder)
- (when (and (not (assoc group nnfolder-group-alist))
- (not (file-exists-p
- (nnfolder-group-pathname group))))
- ;; The group doesn't exist, so we create a new entry for it.
- (push (list group (cons 1 0)) nnfolder-group-alist)
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))
-
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (when (and group
+ (not (equal group nnfolder-current-group))
+ (progn
+ (nnmail-activate 'nnfolder)
+ (and (assoc group nnfolder-group-alist)
+ (file-exists-p (nnfolder-group-pathname group)))))
(if dont-check
(setq nnfolder-current-group group
nnfolder-current-buffer nil)
(let (inf file)
- ;; If we have to change groups, see if we don't already have the
- ;; folder in memory. If we do, verify the modtime and destroy
- ;; the folder if needed so we can rescan it.
+ ;; If we have to change groups, see if we don't already have
+ ;; the folder in memory. If we do, verify the modtime and
+ ;; destroy the folder if needed so we can rescan it.
(setq nnfolder-current-buffer
(nth 1 (assoc group nnfolder-buffer-alist)))
- ;; If the buffer is not live, make sure it isn't in the alist. If it
- ;; is live, verify that nobody else has touched the file since last
- ;; time.
+ ;; If the buffer is not live, make sure it isn't in the
+ ;; alist. If it is live, verify that nobody else has
+ ;; touched the file since last time.
(when (and nnfolder-current-buffer
(not (gnus-buffer-live-p nnfolder-current-buffer)))
(setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
@@ -684,7 +799,11 @@ deleted. Point is left where the deleted region was."
(nnfolder-possibly-change-folder (car group-art))
(let ((buffer-read-only nil))
(nnfolder-normalize-buffer)
- (insert-buffer-substring obuf beg end)))))
+ (insert-buffer-substring obuf beg end))
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (set-buffer obuf)
+ (nnfolder-add-nov (car group-art) (cdr group-art)
+ (nnfolder-parse-head nil beg end))))))
;; Did we save it anywhere?
save-list))
@@ -694,7 +813,8 @@ deleted. Point is left where the deleted region was."
(goto-char (point-max))
(skip-chars-backward "\n")
(delete-region (point) (point-max))
- (insert "\n\n"))
+ (unless (bobp)
+ (insert "\n\n")))
(defun nnfolder-insert-newsgroup-line (group-art)
(save-excursion
@@ -730,23 +850,25 @@ deleted. Point is left where the deleted region was."
(push (list group (nnfolder-read-folder group))
nnfolder-buffer-alist))))
-;; This method has a problem if you've accidentally let the active list get
-;; out of sync with the files. This could happen, say, if you've
-;; accidentally gotten new mail with something other than Gnus (but why
-;; would _that_ ever happen? :-). In that case, we will be in the middle of
-;; processing the file, ready to add new X-Gnus article number markers, and
-;; we'll run across a message with no ID yet - the active list _may_not_ be
-;; ready for us yet.
-
-;; To handle this, I'm modifying this routine to maintain the maximum ID seen
-;; so far, and when we hit a message with no ID, we will _manually_ scan the
-;; rest of the message looking for any more, possibly higher IDs. We'll
-;; assume the maximum that we find is the highest active. Note that this
-;; shouldn't cost us much extra time at all, but will be a lot less
-;; vulnerable to glitches between the mbox and the active file.
+;; This method has a problem if you've accidentally let the active
+;; list get out of sync with the files. This could happen, say, if
+;; you've accidentally gotten new mail with something other than Gnus
+;; (but why would _that_ ever happen? :-). In that case, we will be
+;; in the middle of processing the file, ready to add new X-Gnus
+;; article number markers, and we'll run across a message with no ID
+;; yet - the active list _may_not_ be ready for us yet.
+
+;; To handle this, I'm modifying this routine to maintain the maximum
+;; ID seen so far, and when we hit a message with no ID, we will
+;; _manually_ scan the rest of the message looking for any more,
+;; possibly higher IDs. We'll assume the maximum that we find is the
+;; highest active. Note that this shouldn't cost us much extra time
+;; at all, but will be a lot less vulnerable to glitches between the
+;; mbox and the active file.
(defun nnfolder-read-folder (group)
(let* ((file (nnfolder-group-pathname group))
+ (nov (nnfolder-group-nov-pathname group))
(buffer (set-buffer
(let ((nnheader-file-coding-system
nnfolder-file-coding-system))
@@ -776,51 +898,81 @@ deleted. Point is left where the deleted region was."
(scantime (assoc group nnfolder-scantime-alist))
(minid (lsh -1 -1))
maxid start end newscantime
+ novbuf articles newnum
buffer-read-only)
(buffer-disable-undo)
(setq maxid (cdr active))
+
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil
+ (and (file-exists-p nov)
+ (file-newer-than-file-p nov file)))
+ (unless (file-exists-p nov)
+ (gnus-make-directory (file-name-directory nov)))
+ (with-current-buffer
+ (setq novbuf (nnfolder-open-nov group))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (read novbuf) articles)
+ (forward-line 1))
+ (setq articles (nreverse articles))))
(goto-char (point-min))
- ;; Anytime the active number is 1 or 0, it is suspect. In that
- ;; case, search the file manually to find the active number. Or,
- ;; of course, if we're being paranoid. (This would also be the
- ;; place to build other lists from the header markers, such as
- ;; expunge lists, etc., if we ever desired to abandon the active
- ;; file entirely for mboxes.)
+ ;; Anytime the active number is 1 or 0, it is suspect. In
+ ;; that case, search the file manually to find the active
+ ;; number. Or, of course, if we're being paranoid. (This
+ ;; would also be the place to build other lists from the
+ ;; header markers, such as expunge lists, etc., if we ever
+ ;; desired to abandon the active file entirely for mboxes.)
(when (or nnfolder-ignore-active-file
+ novbuf
(< maxid 2))
(while (and (search-forward marker nil t)
- (re-search-forward number nil t))
- (let ((newnum (string-to-number (match-string 0))))
- (if (nnmail-within-headers-p)
- (setq maxid (max maxid newnum)
- minid (min minid newnum)))))
+ (looking-at number))
+ (setq newnum (string-to-number (match-string 0)))
+ (when (nnmail-within-headers-p)
+ (setq maxid (max maxid newnum)
+ minid (min minid newnum))
+ (when novbuf
+ (if (memq newnum articles)
+ (setq articles (delq newnum articles))
+ (let ((headers (nnfolder-parse-head newnum)))
+ (with-current-buffer novbuf
+ (nnheader-find-nov-line newnum)
+ (nnheader-insert-nov headers)))))))
+ (when (and novbuf articles)
+ (with-current-buffer novbuf
+ (dolist (article articles)
+ (when (nnheader-find-nov-line article)
+ (delete-region (point)
+ (progn (forward-line 1) (point)))))))
(setcar active (max 1 (min minid maxid)))
(setcdr active (max maxid (cdr active)))
(goto-char (point-min)))
- ;; As long as we trust that the user will only insert unmarked mail
- ;; at the end, go to the end and search backwards for the last
- ;; marker. Find the start of that message, and begin to search for
- ;; unmarked messages from there.
+ ;; As long as we trust that the user will only insert
+ ;; unmarked mail at the end, go to the end and search
+ ;; backwards for the last marker. Find the start of that
+ ;; message, and begin to search for unmarked messages from
+ ;; there.
(when (not (or nnfolder-distrust-mbox
(< maxid 2)))
(goto-char (point-max))
(unless (re-search-backward marker nil t)
(goto-char (point-min)))
- (when (nnmail-search-unix-mail-delim)
- (goto-char (point-min))))
+ ;;(when (nnmail-search-unix-mail-delim)
+ ;; (goto-char (point-min)))
+ )
- ;; Keep track of the active number on our own, and insert it back
- ;; into the active list when we're done. Also, prime the pump to
- ;; cut down on the number of searches we do.
+ ;; Keep track of the active number on our own, and insert it
+ ;; back into the active list when we're done. Also, prime
+ ;; the pump to cut down on the number of searches we do.
(unless (nnmail-search-unix-mail-delim)
(goto-char (point-max)))
(setq end (point-marker))
(while (not (= end (point-max)))
(setq start (marker-position end))
(goto-char end)
- ;; There may be more than one "From " line, so we skip past
+ ;; There may be more than one "From " line, so we skip past
;; them.
(while (looking-at delim)
(forward-line 1))
@@ -832,18 +984,31 @@ deleted. Point is left where the deleted region was."
(narrow-to-region start end)
(nnmail-insert-lines)
(nnfolder-insert-newsgroup-line
- (cons nil (nnfolder-active-number nnfolder-current-group)))
+ (cons nil
+ (setq newnum
+ (nnfolder-active-number group))))
+ (when novbuf
+ (let ((headers (nnfolder-parse-head newnum (point-min)
+ (point-max))))
+ (with-current-buffer novbuf
+ (goto-char (point-max))
+ (nnheader-insert-nov headers))))
(widen)))
(set-marker end nil)
- ;; Make absolutely sure that the active list reflects reality!
+ ;; Make absolutely sure that the active list reflects
+ ;; reality!
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
+
;; Set the scantime for this group.
(setq newscantime (visited-file-modtime))
(if scantime
(setcdr scantime (list newscantime))
- (push (list nnfolder-current-group newscantime)
+ (push (list group newscantime)
nnfolder-scantime-alist))
+ ;; Save nov.
+ (when novbuf
+ (nnfolder-save-nov))
(current-buffer))))))
;;;###autoload
@@ -852,23 +1017,33 @@ deleted. Point is left where the deleted region was."
This command does not work if you use short group names."
(interactive)
(nnmail-activate 'nnfolder)
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (dolist (file (directory-files (or nnfolder-nov-directory
+ nnfolder-directory)
+ t
+ (concat
+ (regexp-quote nnfolder-nov-file-suffix)
+ "$")))
+ (when (not (message-mail-file-mbox-p file))
+ (ignore-errors
+ (delete-file file)))))
(let ((files (directory-files nnfolder-directory))
- file)
+ file)
(while (setq file (pop files))
(when (and (not (backup-file-name-p file))
- (message-mail-file-mbox-p
+ (message-mail-file-mbox-p
(nnheader-concat nnfolder-directory file)))
- (let ((oldgroup (assoc file nnfolder-group-alist)))
- (if oldgroup
- (nnheader-message 5 "Refreshing group %s..." file)
- (nnheader-message 5 "Adding group %s..." file))
+ (let ((oldgroup (assoc file nnfolder-group-alist)))
+ (if oldgroup
+ (nnheader-message 5 "Refreshing group %s..." file)
+ (nnheader-message 5 "Adding group %s..." file))
(if oldgroup
(setq nnfolder-group-alist
(delq oldgroup (copy-sequence nnfolder-group-alist))))
- (push (list file (cons 1 0)) nnfolder-group-alist)
- (nnfolder-possibly-change-folder file)
- (nnfolder-possibly-change-group file)
- (nnfolder-close-group file))))
+ (push (list file (cons 1 0)) nnfolder-group-alist)
+ (nnfolder-possibly-change-folder file)
+ (nnfolder-possibly-change-group file)
+ (nnfolder-close-group file))))
(nnheader-message 5 "")))
(defun nnfolder-group-pathname (group)
@@ -883,6 +1058,12 @@ This command does not work if you use short group names."
;; If not, we translate dots into slashes.
(concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
+(defun nnfolder-group-nov-pathname (group)
+ "Make pathname for GROUP NOV."
+ (let ((nnfolder-directory
+ (or nnfolder-nov-directory nnfolder-directory)))
+ (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix)))
+
(defun nnfolder-save-buffer ()
"Save the buffer."
(when (buffer-modified-p)
@@ -891,7 +1072,9 @@ This command does not work if you use short group names."
(let ((coding-system-for-write
(or nnfolder-file-coding-system-for-write
nnfolder-file-coding-system)))
- (save-buffer))))
+ (save-buffer)))
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-save-nov)))
(defun nnfolder-save-active (group-alist active-file)
(let ((nnmail-active-file-coding-system
@@ -899,6 +1082,194 @@ This command does not work if you use short group names."
nnfolder-active-file-coding-system)))
(nnmail-save-active group-alist active-file)))
+(defun nnfolder-open-nov (group)
+ (or (cdr (assoc group nnfolder-nov-buffer-alist))
+ (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group))))
+ (save-excursion
+ (set-buffer buffer)
+ (set (make-local-variable 'nnfolder-nov-buffer-file-name)
+ (nnfolder-group-nov-pathname group))
+ (erase-buffer)
+ (when (file-exists-p nnfolder-nov-buffer-file-name)
+ (nnheader-insert-file-contents nnfolder-nov-buffer-file-name)))
+ (push (cons group buffer) nnfolder-nov-buffer-alist)
+ buffer)))
+
+(defun nnfolder-save-nov ()
+ (save-excursion
+ (while nnfolder-nov-buffer-alist
+ (when (buffer-name (cdar nnfolder-nov-buffer-alist))
+ (set-buffer (cdar nnfolder-nov-buffer-alist))
+ (when (buffer-modified-p)
+ (gnus-make-directory (file-name-directory
+ nnfolder-nov-buffer-file-name))
+ (nnmail-write-region 1 (point-max) nnfolder-nov-buffer-file-name
+ nil 'nomesg))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist)))))
+
+(defun nnfolder-nov-delete-article (group article)
+ (save-excursion
+ (set-buffer (nnfolder-open-nov group))
+ (when (nnheader-find-nov-line article)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ t))
+
+(defun nnfolder-retrieve-headers-with-nov (articles &optional fetch-old)
+ (if (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ nil
+ (let ((nov (nnfolder-group-nov-pathname nnfolder-current-group)))
+ (when (file-exists-p nov)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (nnheader-insert-file-contents nov)
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles))
+ (car (last articles)))
+ t))))))
+
+(defun nnfolder-parse-head (&optional number b e)
+ "Parse the head of the current buffer."
+ (let ((buf (current-buffer))
+ chars)
+ (save-excursion
+ (unless b
+ (setq b (if (nnmail-search-unix-mail-delim-backward)
+ (point) (point-min)))
+ (forward-line 1)
+ (setq e (if (nnmail-search-unix-mail-delim)
+ (point) (point-max))))
+ (setq chars (- e b))
+ (unless (zerop chars)
+ (goto-char b)
+ (if (search-forward "\n\n" e t) (setq e (1- (point)))))
+ (with-temp-buffer
+ (insert-buffer-substring buf b e)
+ (let ((headers (nnheader-parse-naked-head)))
+ (mail-header-set-chars headers chars)
+ (mail-header-set-number headers number)
+ headers)))))
+
+(defun nnfolder-add-nov (group article headers)
+ "Add a nov line for the GROUP base."
+ (save-excursion
+ (set-buffer (nnfolder-open-nov group))
+ (goto-char (point-max))
+ (mail-header-set-number headers article)
+ (nnheader-insert-nov headers)))
+
+(deffoo nnfolder-request-set-mark (group actions &optional server)
+ (when (and server
+ (not (nnfolder-server-opened server)))
+ (nnfolder-open-server server))
+ (unless nnfolder-marks-is-evil
+ (nnfolder-open-marks group server)
+ (dolist (action actions)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (assert (or (eq what 'add) (eq what 'del)) t
+ "Unknown request-set-mark action: %s" what)
+ (dolist (mark marks)
+ (setq nnfolder-marks (gnus-update-alist-soft
+ mark
+ (funcall (if (eq what 'add) 'gnus-range-add
+ 'gnus-remove-from-range)
+ (cdr (assoc mark nnfolder-marks)) range)
+ nnfolder-marks)))))
+ (nnfolder-save-marks group server))
+ nil)
+
+(deffoo nnfolder-request-update-info (group info &optional server)
+ ;; Change servers.
+ (when (and server
+ (not (nnfolder-server-opened server)))
+ (nnfolder-open-server server))
+ (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
+ (nnheader-message 8 "Updating marks for %s..." group)
+ (nnfolder-open-marks group server)
+ ;; Update info using `nnfolder-marks'.
+ (mapcar (lambda (pred)
+ (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nnfolder-marks))
+ (gnus-info-marks info))
+ t)))
+ gnus-article-mark-lists)
+ (let ((seen (cdr (assq 'read nnfolder-marks))))
+ (gnus-info-set-read info
+ (if (and (integerp (car seen))
+ (null (cdr seen)))
+ (list (cons (car seen) (car seen)))
+ seen)))
+ (nnheader-message 8 "Updating marks for %s...done" group))
+ info)
+
+(defun nnfolder-group-marks-pathname (group)
+ "Make pathname for GROUP NOV."
+ (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
+ (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
+
+(defun nnfolder-marks-changed-p (group)
+ (let ((file (nnfolder-group-marks-pathname group)))
+ (if (null (gnus-gethash file nnfolder-marks-modtime))
+ t ;; never looked at marks file, assume it has changed
+ (not (equal (gnus-gethash file nnfolder-marks-modtime)
+ (nth 5 (file-attributes file)))))))
+
+(defun nnfolder-save-marks (group server)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (nnfolder-group-marks-pathname group)))
+ (condition-case err
+ (progn
+ (with-temp-file file
+ (erase-buffer)
+ (gnus-prin1 nnfolder-marks)
+ (insert "\n"))
+ (gnus-sethash file
+ (nth 5 (file-attributes file))
+ nnfolder-marks-modtime))
+ (error (or (gnus-yes-or-no-p
+ (format "Could not write to %s (%s). Continue? " file err))
+ (error "Cannot write to %s (%s)" err))))))
+
+(defun nnfolder-open-marks (group server)
+ (let ((file (nnfolder-group-marks-pathname group)))
+ (if (file-exists-p file)
+ (condition-case err
+ (with-temp-buffer
+ (gnus-sethash file (nth 5 (file-attributes file))
+ nnfolder-marks-modtime)
+ (nnheader-insert-file-contents file)
+ (setq nnfolder-marks (read (current-buffer)))
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
+ (error (or (gnus-yes-or-no-p
+ (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
+ (error "Cannot read nnfolder marks file %s (%s)" file err))))
+ ;; User didn't have a .marks file. Probably first time
+ ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
+ (let ((info (gnus-get-info
+ (gnus-group-prefixed-name
+ group
+ (gnus-server-to-method (format "nnfolder:%s" server))))))
+ (nnheader-message 7 "Bootstrapping marks for %s..." group)
+ (setq nnfolder-marks (gnus-info-marks info))
+ (push (cons 'read (gnus-info-read info)) nnfolder-marks)
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
+ (nnfolder-save-marks group server)
+ (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
+
(provide 'nnfolder)
;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 8d8d4f900a9..f6903693dad 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -1,6 +1,6 @@
;;; nngateway.el --- posting news via mail gateways
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -65,7 +65,8 @@ parameter -- the gateway address.")
(insert mail-header-separator "\n")
(widen)
(let (message-required-mail-headers)
- (funcall message-send-mail-function))
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function)))
t))))
;;; Internal functions
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index bfe50364e62..0ff82c69523 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1,11 +1,11 @@
;;; nnheader.el --- header access macros for Gnus and its backends
;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000, 2001
+;; 1997, 1998, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
@@ -33,28 +33,60 @@
;; Requiring `gnus-util' at compile time creates a circular
;; dependency between nnheader.el and gnus-util.el.
-;(eval-when-compile (require 'gnus-util))
+;;(eval-when-compile (require 'gnus-util))
(require 'mail-utils)
(require 'mm-util)
+(require 'gnus-util)
(eval-and-compile
+ (autoload 'gnus-sorted-intersection "gnus-range")
(autoload 'gnus-intersection "gnus-range")
- (autoload 'gnus-sorted-complement "gnus-range"))
+ (autoload 'gnus-sorted-complement "gnus-range")
+ (autoload 'gnus-sorted-difference "gnus-range"))
+
+(defcustom gnus-verbose-backends 7
+ "Integer that says how verbose the Gnus backends should be.
+The higher the number, the more messages the Gnus backends will flash
+to say what it's doing. At zero, the Gnus backends will be totally
+mute; at five, they will display most important messages; and at ten,
+they will keep on jabbering all the time."
+ :group 'gnus-start
+ :type 'integer)
+
+(defcustom gnus-nov-is-evil nil
+ "If non-nil, Gnus backends will never output headers in the NOV format."
+ :group 'gnus-server
+ :type 'boolean)
(defvar nnheader-max-head-length 4096
- "*Max length of the head of articles.")
+ "*Max length of the head of articles.
+
+Value is an integer, nil, or t. nil means read in chunks of a file
+indefinitely until a complete head is found\; t means always read the
+entire file immediately, disregarding `nnheader-head-chop-length'.
+
+Integer values will in effect be rounded up to the nearest multiple of
+`nnheader-head-chop-length'.")
(defvar nnheader-head-chop-length 2048
"*Length of each read operation when trying to fetch HEAD headers.")
+(defvar nnheader-read-timeout
+ (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+ (symbol-name system-type))
+ 1.0 ; why?
+ 0.1)
+ "How long nntp should wait between checking for the end of output.
+Shorter values mean quicker response, but are more CPU intensive.")
+
(defvar nnheader-file-name-translation-alist
(let ((case-fold-search t))
(cond
- ((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
+ ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
(symbol-name system-type))
(append (mapcar (lambda (c) (cons c ?_))
'(?: ?* ?\" ?< ?> ??))
- (if (string-match "windows-nt\\|cygwin32"
+ (if (string-match "windows-nt\\|cygwin"
(symbol-name system-type))
nil
'((?+ . ?-)))))
@@ -65,12 +97,15 @@ on your system, you could say something like:
\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
+(defvar nnheader-directory-separator-character
+ (string-to-char (substring (file-name-as-directory ".") -1))
+ "*A character used to a directory separator.")
+
(eval-and-compile
(autoload 'nnmail-message-id "nnmail")
(autoload 'mail-position-on-field "sendmail")
(autoload 'message-remove-header "message")
(autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-delete-line "gnus-util" nil nil 'macro)
(autoload 'gnus-buffer-live-p "gnus-util"))
;;; Header access macros.
@@ -186,125 +221,140 @@ on your system, you could say something like:
(concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
(defsubst nnheader-fake-message-id-p (id)
- (save-match-data ; regular message-id's are <.*>
+ (save-match-data ; regular message-id's are <.*>
(string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
;; Parsing headers and NOV lines.
+(defsubst nnheader-remove-cr-followed-by-lf ()
+ (goto-char (point-max))
+ (while (search-backward "\r\n" nil t)
+ (delete-char 1)))
+
(defsubst nnheader-header-value ()
- (buffer-substring (match-end 0) (gnus-point-at-eol)))
+ (skip-chars-forward " \t")
+ (buffer-substring (point) (gnus-point-at-eol)))
-(defun nnheader-parse-head (&optional naked)
+(defun nnheader-parse-naked-head (&optional number)
+ ;; This function unfolds continuation lines in this buffer
+ ;; destructively. When this side effect is unwanted, use
+ ;; `nnheader-parse-head' instead of this function.
(let ((case-fold-search t)
- (cur (current-buffer))
(buffer-read-only nil)
- in-reply-to lines p ref)
- (goto-char (point-min))
- (when naked
- (insert "\n"))
- ;; Search to the beginning of the next header. Error messages
- ;; do not begin with 2 or 3.
+ (cur (current-buffer))
+ (p (point-min))
+ in-reply-to lines ref)
+ (nnheader-remove-cr-followed-by-lf)
+ (ietf-drums-unfold-fws)
+ (subst-char-in-region (point-min) (point-max) ?\t ? )
+ (goto-char p)
+ (insert "\n")
(prog1
- (when (or naked (re-search-forward "^[23][0-9]+ " nil t))
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and
- ;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance
- ;; don't always go hand in hand.
- (vector
- ;; Number.
- (if naked
- (progn
- (setq p (point-min))
- 0)
- (prog1
- (read cur)
- (end-of-line)
- (setq p (point))
- (narrow-to-region (point)
- (or (and (search-forward "\n.\n" nil t)
- (- (point) 2))
- (point)))))
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject: " nil t)
- (nnheader-header-value) "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (or (search-forward "\nfrom: " nil t)
- (search-forward "\nfrom:" nil t))
- (nnheader-header-value) "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate: " nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (if (search-forward "\nmessage-id:" nil t)
- (buffer-substring
- (1- (or (search-forward "<" (gnus-point-at-eol) t)
- (point)))
- (or (search-forward ">" (gnus-point-at-eol) t) (point)))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (nnheader-generate-fake-message-id)))
- ;; References.
- (progn
- (goto-char p)
- (if (search-forward "\nreferences: " nil t)
- (nnheader-header-value)
- ;; Get the references from the in-reply-to header if there
- ;; were no references and the in-reply-to header looks
- ;; promising.
- (if (and (search-forward "\nin-reply-to: " nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^\n>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^\n>]+>"
- in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- nil)))
- ;; Chars.
- 0
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
- lines 0)
- 0))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref: " nil t)
- (nnheader-header-value)))
-
- ;; Extra.
- (when nnmail-extra-headers
- (let ((extra nnmail-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ": ") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out))))
- (when naked
- (goto-char (point-min))
- (delete-char 1)))))
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and a
+ ;; case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance don't
+ ;; always go hand in hand.
+ (vector
+ ;; Number.
+ (or number 0)
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject:" nil t)
+ (nnheader-header-value) "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom:" nil t)
+ (nnheader-header-value) "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" (gnus-point-at-eol) t)
+ (point)))
+ (or (search-forward ">" (gnus-point-at-eol) t) (point)))
+ ;; If there was no message-id, we just fake one to make
+ ;; subsequent routines simpler.
+ (nnheader-generate-fake-message-id)))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences:" nil t)
+ (nnheader-header-value)
+ ;; Get the references from the in-reply-to header if
+ ;; there were no references and the in-reply-to header
+ ;; looks promising.
+ (if (and (search-forward "\nin-reply-to:" nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^\n>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^\n>]+>"
+ in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ nil)))
+ ;; Chars.
+ 0
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (read cur)))
+ lines 0)
+ 0))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref:" nil t)
+ (nnheader-header-value)))
+ ;; Extra.
+ (when nnmail-extra-headers
+ (let ((extra nnmail-extra-headers)
+ out)
+ (while extra
+ (goto-char p)
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out)))
+ (goto-char p)
+ (delete-char 1))))
+
+(defun nnheader-parse-head (&optional naked)
+ (let ((cur (current-buffer)) num beg end)
+ (when (if naked
+ (setq num 0
+ beg (point-min)
+ end (point-max))
+ (goto-char (point-min))
+ ;; Search to the beginning of the next header. Error
+ ;; messages do not begin with 2 or 3.
+ (when (re-search-forward "^[23][0-9]+ " nil t)
+ (end-of-line)
+ (setq num (read cur)
+ beg (point)
+ end (if (search-forward "\n.\n" nil t)
+ (- (point) 2)
+ (point)))))
+ (with-temp-buffer
+ (insert-buffer-substring cur beg end)
+ (nnheader-parse-naked-head num)))))
(defmacro nnheader-nov-skip-field ()
'(search-forward "\t" eol 'move))
@@ -389,6 +439,22 @@ on your system, you could say something like:
(delete-char 1))
(forward-line 1)))
+(defun nnheader-parse-overview-file (file)
+ "Parse FILE and return a list of headers."
+ (mm-with-unibyte-buffer
+ (nnheader-insert-file-contents file)
+ (goto-char (point-min))
+ (let (headers)
+ (while (not (eobp))
+ (push (nnheader-parse-nov) headers)
+ (forward-line 1))
+ (nreverse headers))))
+
+(defun nnheader-write-overview-file (file headers)
+ "Write HEADERS to FILE."
+ (with-temp-file file
+ (mapcar 'nnheader-insert-nov headers)))
+
(defun nnheader-insert-header (header)
(insert
"Subject: " (or (mail-header-subject header) "(none)") "\n"
@@ -432,7 +498,7 @@ the line could be found."
(prev (point-min))
num found)
(while (not found)
- (goto-char (/ (+ max min) 2))
+ (goto-char (+ min (/ (- max min) 2)))
(beginning-of-line)
(if (or (= (point) prev)
(eobp))
@@ -471,10 +537,7 @@ the line could be found."
;; Various cruft the backends and Gnus need to communicate.
(defvar nntp-server-buffer nil)
-(defvar gnus-verbose-backends 7
- "*A number that says how talkative the Gnus backends should be.")
-(defvar gnus-nov-is-evil nil
- "If non-nil, Gnus backends will never output headers in the NOV format.")
+(defvar nntp-process-response nil)
(defvar news-reply-yank-from nil)
(defvar news-reply-yank-message-id nil)
@@ -490,6 +553,7 @@ the line could be found."
(erase-buffer)
(kill-all-local-variables)
(setq case-fold-search t) ;Should ignore case.
+ (set (make-local-variable 'nntp-process-response) nil)
t))
;;; Various functions the backends use.
@@ -544,7 +608,7 @@ the line could be found."
;; This is invalid, but not all articles have Message-IDs.
()
(mail-position-on-field "References")
- (let ((begin (save-excursion (beginning-of-line) (point)))
+ (let ((begin (gnus-point-at-bol))
(fill-column 78)
(fill-prefix "\t"))
(when references
@@ -578,6 +642,12 @@ the line could be found."
(point-max)))
(goto-char (point-min)))
+(defun nnheader-remove-body ()
+ "Remove the body from an article in this current buffer."
+ (goto-char (point-min))
+ (when (re-search-forward "\n\r?\n" nil t)
+ (delete-region (point) (point-max))))
+
(defun nnheader-set-temp-buffer (name &optional noerase)
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
(set-buffer (get-buffer-create name))
@@ -609,11 +679,17 @@ the line could be found."
(string-match nnheader-numerical-short-files file)
(string-to-int (match-string 0 file))))
+(defvar nnheader-directory-files-is-safe
+ (or (eq system-type 'windows-nt)
+ (and (not (featurep 'xemacs))
+ (> emacs-major-version 20)))
+ "If non-nil, Gnus believes `directory-files' is safe.
+It has been reported numerous times that `directory-files' fails with
+an alarming frequency on NFS mounted file systems. If it is nil,
+`nnheader-directory-files-safe' is used.")
+
(defun nnheader-directory-files-safe (&rest args)
- ;; It has been reported numerous times that `directory-files'
- ;; fails with an alarming frequency on NFS mounted file systems.
- ;; This function executes that function twice and returns
- ;; the longest result.
+ "Execute `directory-files' twice and returns the longer result."
(let ((first (apply 'directory-files args))
(second (apply 'directory-files args)))
(if (> (length first) (length second))
@@ -623,14 +699,20 @@ the line could be found."
(defun nnheader-directory-articles (dir)
"Return a list of all article files in directory DIR."
(mapcar 'nnheader-file-to-number
- (nnheader-directory-files-safe
- dir nil nnheader-numerical-short-files t)))
+ (if nnheader-directory-files-is-safe
+ (directory-files
+ dir nil nnheader-numerical-short-files t)
+ (nnheader-directory-files-safe
+ dir nil nnheader-numerical-short-files t))))
(defun nnheader-article-to-file-alist (dir)
"Return an alist of article/file pairs in DIR."
(mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
- (nnheader-directory-files-safe
- dir nil nnheader-numerical-short-files t)))
+ (if nnheader-directory-files-is-safe
+ (directory-files
+ dir nil nnheader-numerical-short-files t)
+ (nnheader-directory-files-safe
+ dir nil nnheader-numerical-short-files t))))
(defun nnheader-fold-continuation-lines ()
"Fold continuation lines in the current buffer."
@@ -653,7 +735,8 @@ If FULL, translate everything."
;; We translate -- but only the file name. We leave the directory
;; alone.
(if (and (featurep 'xemacs)
- (memq system-type '(win32 w32 mswindows windows-nt cygwin)))
+ (memq system-type '(cygwin32 win32 w32 mswindows windows-nt
+ cygwin)))
;; This is needed on NT and stuff, because
;; file-name-nondirectory is not enough to split
;; file names, containing ':', e.g.
@@ -710,21 +793,8 @@ without formatting."
(apply 'insert format args))
t))
-(eval-and-compile
- (if (fboundp 'subst-char-in-string)
- (defsubst nnheader-replace-chars-in-string (string from to)
- (subst-char-in-string from to string))
- (defun nnheader-replace-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string))))
+(defsubst nnheader-replace-chars-in-string (string from to)
+ (mm-subst-char-in-string from to string))
(defun nnheader-replace-duplicate-chars-in-string (string from to)
"Replace characters in STRING from FROM to TO."
@@ -752,7 +822,7 @@ without formatting."
(expand-file-name
(file-name-as-directory top))))
(error "")))
- ?/ ?.))
+ nnheader-directory-separator-character ?.))
(defun nnheader-message (level &rest args)
"Message if the Gnus backends are talkative."
@@ -766,8 +836,8 @@ without formatting."
(or (not (numberp gnus-verbose-backends))
(<= level gnus-verbose-backends)))
-(defvar nnheader-pathname-coding-system 'binary
- "*Coding system for file names.")
+(defvar nnheader-pathname-coding-system 'iso-8859-1
+ "*Coding system for file name.")
(defun nnheader-group-pathname (group dir &optional file)
"Make file name for GROUP."
@@ -780,17 +850,12 @@ without formatting."
;; If not, we translate dots into slashes.
(expand-file-name (mm-encode-coding-string
(nnheader-replace-chars-in-string group ?. ?/)
- nnheader-pathname-coding-system)
+ nnheader-pathname-coding-system)
dir))))
(cond ((null file) "")
((numberp file) (int-to-string file))
(t file))))
-(defun nnheader-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))))
-
(defun nnheader-concat (dir &rest files)
"Concat DIR as directory to FILES."
(apply 'concat (file-name-as-directory dir) files))
@@ -798,19 +863,21 @@ without formatting."
(defun nnheader-ms-strip-cr ()
"Strip ^M from the end of all lines."
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\r$" nil t)
- (delete-backward-char 1))))
+ (nnheader-remove-cr-followed-by-lf)))
(defun nnheader-file-size (file)
"Return the file size of FILE or 0."
(or (nth 7 (file-attributes file)) 0))
-(defun nnheader-find-etc-directory (package &optional file)
- "Go through the path and find the \".../etc/PACKAGE\" directory.
-If FILE, find the \".../etc/PACKAGE\" file instead."
+(defun nnheader-find-etc-directory (package &optional file first)
+ "Go through `load-path' and find the \"../etc/PACKAGE\" directory.
+This function will look in the parent directory of each `load-path'
+entry, and look for the \"etc\" directory there.
+If FILE, find the \".../etc/PACKAGE\" file instead.
+If FIRST is non-nil, return the directory or the file found at the
+first. Otherwise, find the newest one, though it may take a time."
(let ((path load-path)
- dir result)
+ dir results)
;; We try to find the dir by looking at the load path,
;; stripping away the last component and adding "etc/".
(while path
@@ -822,10 +889,14 @@ If FILE, find the \".../etc/PACKAGE\" file instead."
"etc/" package
(if file "" "/"))))
(or file (file-directory-p dir)))
- (setq result dir
- path nil)
+ (progn
+ (or (member dir results)
+ (push dir results))
+ (setq path (if first nil (cdr path))))
(setq path (cdr path))))
- result))
+ (if (or first (not (cdr results)))
+ (car results)
+ (car (sort results 'file-newer-than-file-p)))))
(eval-when-compile
(defvar ange-ftp-path-format)
@@ -851,12 +922,32 @@ find-file-hooks, etc.
(let ((coding-system-for-read nnheader-file-coding-system))
(mm-insert-file-contents filename visit beg end replace)))
+(defun nnheader-insert-nov-file (file first)
+ (let ((size (nth 7 (file-attributes file)))
+ (cutoff (* 32 1024)))
+ (when size
+ (if (< size cutoff)
+ ;; If the file is small, we just load it.
+ (nnheader-insert-file-contents file)
+ ;; We start on the assumption that FIRST is pretty recent. If
+ ;; not, we just insert the rest of the file as well.
+ (let (current)
+ (nnheader-insert-file-contents file nil (- size cutoff) size)
+ (goto-char (point-min))
+ (delete-region (point) (or (search-forward "\n" nil 'move) (point)))
+ (setq current (ignore-errors (read (current-buffer))))
+ (if (and (numberp current)
+ (< current first))
+ t
+ (delete-region (point-min) (point-max))
+ (nnheader-insert-file-contents file)))))))
+
(defun nnheader-find-file-noselect (&rest args)
(let ((format-alist nil)
(auto-mode-alist (mm-auto-mode-alist))
(default-major-mode 'fundamental-mode)
(enable-local-variables nil)
- (after-insert-file-functions nil)
+ (after-insert-file-functions nil)
(enable-local-eval nil)
(find-file-hooks nil)
(coding-system-for-read nnheader-file-coding-system))
@@ -917,6 +1008,15 @@ find-file-hooks, etc.
(defalias 'nnheader-run-at-time 'run-at-time)
(defalias 'nnheader-cancel-timer 'cancel-timer)
(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
+(defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
+
+(defun nnheader-accept-process-output (process)
+ (accept-process-output
+ process
+ (truncate nnheader-read-timeout)
+ (truncate (* (- nnheader-read-timeout
+ (truncate nnheader-read-timeout))
+ 1000))))
(when (featurep 'xemacs)
(require 'nnheaderxm))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ec9d42ee042..fc33b9a48eb 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,6 +1,6 @@
;;; nnimap.el --- imap backend for Gnus
-
-;; Copyright (C) 1998,1999,2000,01,02,2004 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
@@ -56,13 +56,11 @@
;; o What about Gnus's article editing, can we support it? NO!
;; o Use \Draft to support the draft group??
;; o Duplicate suppression
+;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers
;;; Code:
-(eval-and-compile
- (require 'cl)
- (require 'imap))
-
+(require 'imap)
(require 'nnoo)
(require 'nnmail)
(require 'nnheader)
@@ -72,33 +70,55 @@
(require 'gnus-start)
(require 'gnus-int)
+(eval-when-compile (require 'cl))
+
(nnoo-declare nnimap)
-(defconst nnimap-version "nnimap 0.131")
+(defconst nnimap-version "nnimap 1.0")
+
+(defgroup nnimap nil
+ "Reading IMAP mail with Gnus."
+ :group 'gnus)
(defvoo nnimap-address nil
"Address of physical IMAP server. If nil, use the virtual server's name.")
(defvoo nnimap-server-port nil
"Port number on physical IMAP server.
-If nil, defaults to 993 for SSL connections and 143 otherwise.")
+If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.")
;; Splitting variables
-(defvar nnimap-split-crosspost t
+(defcustom nnimap-split-crosspost t
"If non-nil, do crossposting if several split methods match the mail.
-If nil, the first match found will be used.")
+If nil, the first match found will be used."
+ :group 'nnimap
+ :type 'boolean)
-(defvar nnimap-split-inbox nil
- "*Name of mailbox to split mail from.
+(defcustom nnimap-split-inbox nil
+ "Name of mailbox to split mail from.
Mail is read from this mailbox and split according to rules in
-`nnimap-split-rules'.
+`nnimap-split-rule'.
+
+This can be a string or a list of strings."
+ :group 'nnimap
+ :type '(choice (string)
+ (repeat string)))
+
+(define-widget 'nnimap-strict-function 'function
+ "This widget only matches values that are functionp.
+
+Warning: This means that a value that is the symbol of a not yet
+loaded function will not match. Use with care."
+ :match 'nnimap-strict-function-match)
-This can be a string or a list of strings.")
+(defun nnimap-strict-function-match (widget value)
+ "Ignoring WIDGET, match if VALUE is a function."
+ (functionp value))
-(defvar nnimap-split-rule nil
- "*Mail will be split according to these rules.
+(defcustom nnimap-split-rule nil
+ "Mail will be split according to these rules.
Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
@@ -110,10 +130,10 @@ this:
\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\")
(\"INBOX.junk\" \"Subject:.*buy\")))
-As you can see, `nnimap-split-rule' is a list of lists, where the first
-element in each \"rule\" is the name of the IMAP mailbox, and the
-second is a regexp that nnimap will try to match on the header to find
-a fit.
+As you can see, `nnimap-split-rule' is a list of lists, where the
+first element in each \"rule\" is the name of the IMAP mailbox (or the
+symbol `junk' if you want to remove the mail), and the second is a
+regexp that nnimap will try to match on the header to find a fit.
The second element can also be a function. In that case, it will be
called narrowed to the headers with the first element of the rule as
@@ -130,27 +150,104 @@ the syntax of this variable have been extended along the lines of:
\(setq nnimap-split-rule
'((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\")
- (\"junk\" \"From:.*Simon\")))
- (\"my2server\" (\"INBOX\" nnimap-split-fancy))
- (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\")
- (\"junk\" my-junk-func)))))
+ (\"junk\" \"From:.*Simon\")))
+ (\"my2server\" (\"INBOX\" nnimap-split-fancy))
+ (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\")
+ (\"junk\" my-junk-func)))))
The virtual server name is in fact a regexp, so that the same rules
may apply to several servers. In the example, the servers
\"my3server\" and \"my4server\" both use the same rules. Similarly,
the inbox string is also a regexp. The actual splitting rules are as
before, either a function, or a list with group/regexp or
-group/function elements.")
-
-(defvar nnimap-split-predicate "UNSEEN UNDELETED"
+group/function elements."
+ :group 'nnimap
+ :type '(choice :tag "Rule type"
+ (repeat :menu-tag "Single-server"
+ :tag "Single-server list"
+ (list (string :tag "Mailbox")
+ (choice :tag "Predicate"
+ (regexp :tag "A regexp")
+ (nnimap-strict-function :tag "A function"))))
+ (choice :menu-tag "A function"
+ :tag "A function"
+ (function-item nnimap-split-fancy)
+ (function-item nnmail-split-fancy)
+ (nnimap-strict-function :tag "User-defined function"))
+ (repeat :menu-tag "Multi-server (extended)"
+ :tag "Multi-server list"
+ (list (regexp :tag "Server regexp")
+ (list (regexp :tag "Incoming Mailbox regexp")
+ (repeat :tag "Rules for matching server(s) and mailbox(es)"
+ (list (string :tag "Destination mailbox")
+ (choice :tag "Predicate"
+ (regexp :tag "A Regexp")
+ (nnimap-strict-function :tag "A Function")))))))))
+
+(defcustom nnimap-split-predicate "UNSEEN UNDELETED"
"The predicate used to find articles to split.
If you use another IMAP client to peek on articles but always would
like nnimap to split them once it's started, you could change this to
\"UNDELETED\". Other available predicates are available in
-RFC2060 section 6.4.4.")
+RFC2060 section 6.4.4."
+ :group 'nnimap
+ :type 'string)
+
+(defcustom nnimap-split-fancy nil
+ "Like the variable `nnmail-split-fancy'."
+ :group 'nnimap
+ :type 'sexp)
+
+(defvar nnimap-split-download-body-default nil
+ "Internal variable with default value for `nnimap-split-download-body'.")
+
+(defcustom nnimap-split-download-body 'default
+ "Whether to download entire articles during splitting.
+This is generally not required, and will slow things down considerably.
+You may need it if you want to use an advanced splitting function that
+analyses the body before splitting the article.
+If this variable is nil, bodies will not be downloaded; if this
+variable is the symbol `default' the default behaviour is
+used (which currently is nil, unless you use a statistical
+spam.el test); if this variable is another non-nil value bodies
+will be downloaded."
+ :group 'nnimap
+ :type '(choice (const :tag "Let system decide" deault)
+ boolean))
+
+;; Performance / bug workaround variables
+
+(defcustom nnimap-close-asynchronous t
+ "Close mailboxes asynchronously in `nnimap-close-group'.
+This means that errors cought by nnimap when closing the mailbox will
+not prevent Gnus from updating the group status, which may be harmful.
+However, it increases speed."
+ :type 'boolean
+ :group 'nnimap)
+
+(defcustom nnimap-dont-close t
+ "Never close mailboxes.
+This increases the speed of closing mailboxes (quiting group) but may
+decrease the speed of selecting another mailbox later. Re-selecting
+the same mailbox will be faster though."
+ :type 'boolean
+ :group 'nnimap)
+
+(defcustom nnimap-retrieve-groups-asynchronous t
+ "Send asynchronous STATUS commands for each mailbox before checking mail.
+If you have mailboxes that rarely receives mail, this speeds up new
+mail checking. It works by first sending STATUS commands for each
+mailbox, and then only checking groups which has a modified UIDNEXT
+more carefully for new mail.
-(defvar nnimap-split-fancy nil
- "Like `nnmail-split-fancy', which see.")
+In summary, the default is O((1-p)*k+p*n) and changing it to nil makes
+it O(n). If p is small, then the default is probably faster."
+ :type 'boolean
+ :group 'nnimap)
+
+(defvoo nnimap-need-unselect-to-notice-new-mail nil
+ "Unselect mailboxes before looking for new mail in them.
+Some servers seem to need this under some circumstances.")
;; Authorization / Privacy variables
@@ -165,14 +262,16 @@ handle.
Change this if
-1) you want to connect with SSL. The SSL integration with IMAP is
- brain-dead so you'll have to tell it specifically.
+1) you want to connect with TLS/SSL. The TLS/SSL integration
+ with IMAP is suboptimal so you'll have to tell it
+ specifically.
2) your server is more capable than your environment -- i.e. your
server accept Kerberos login's but you haven't installed the
`imtest' program or your machine isn't configured for Kerberos.
-Possible choices: kerberos4, ssl, network")
+Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell.
+See also `imap-streams' and `imap-stream-alist'.")
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
@@ -186,7 +285,8 @@ connect to a server that accept Kerberos login's but you haven't
installed the `imtest' program or your machine isn't configured for
Kerberos.
-Possible choices: kerberos4, cram-md5, login, anonymous.")
+Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous.
+See also `imap-authenticators' and `imap-authenticator-alist'")
(defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
"Directory to keep NOV cache files for nnimap groups.
@@ -203,9 +303,12 @@ typical complete file name would be
(defvoo nnimap-nov-file-name-suffix ".novcache"
"Suffix for NOV cache base filename.")
-(defvoo nnimap-nov-is-evil nil
- "If non-nil, nnimap will never generate or use a local nov database for this backend.
-Using nov databases will speed up header fetching considerably.
+(defvoo nnimap-nov-is-evil gnus-agent
+ "If non-nil, never generate or use a local nov database for this backend.
+Using nov databases should speed up header fetching considerably.
+However, it will invoke a UID SEARCH UID command on the server, and
+some servers implement this command inefficiently by opening each and
+every message in the group, thus making it quite slow.
Unlike other backends, you do not need to take special care if you
flip this variable.")
@@ -238,7 +341,8 @@ There are two wildcards * and %. * matches everything, % matches
everything in the current hierarchy.")
(defvoo nnimap-news-groups nil
- "IMAP support a news-like mode, also known as bulletin board mode, where replies is sent via IMAP instead of SMTP.
+ "IMAP support a news-like mode, also known as bulletin board mode,
+where replies is sent via IMAP instead of SMTP.
This variable should contain a regexp matching groups where you wish
replies to be stored to the mailbox directly.
@@ -253,6 +357,22 @@ news-like mailboxes. If you wish to have a group with todo items or
similar which you wouldn't want to set up a mailing list for, you can
use this to make replies go directly to the group.")
+(defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s"
+ "IMAP search command to use for articles that are to be expired.
+The first %s is replaced by a UID set of articles to search on,
+and the second %s is replaced by a date criterium.
+
+One useful (and perhaps the only useful) value to change this to would
+be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header
+instead of the internal date of messages. See section 6.4.4 of RFC
+2060 for more information on valid strings.")
+
+(defvoo nnimap-importantize-dormant t
+ "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
+Note that within Gnus, dormant articles will still (only) be
+marked as ticked. This is to make \"dormant\" articles stand out,
+just like \"ticked\" articles, in other IMAP clients.")
+
(defvoo nnimap-server-address nil
"Obsolete. Use `nnimap-address'.")
@@ -284,11 +404,15 @@ use this to make replies go directly to the group.")
If this is 'imap-mailbox-lsub, then use a server-side subscription list to
restrict visible folders.")
+(defcustom nnimap-debug nil
+ "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
+ :group 'nnimap
+ :type 'boolean)
+
;; Internal variables:
-(defvar nnimap-debug nil
- "Name of buffer to record debugging info.
-For example: (setq nnimap-debug \"*nnimap-debug*\")")
+(defvar nnimap-debug-buffer "*nnimap-debug*")
+(defvar nnimap-mailbox-info (gnus-make-hashtable 997))
(defvar nnimap-current-move-server nil)
(defvar nnimap-current-move-group nil)
(defvar nnimap-current-move-article nil)
@@ -296,13 +420,9 @@ For example: (setq nnimap-debug \"*nnimap-debug*\")")
(defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
(defvar nnimap-progress-how-often 20)
(defvar nnimap-counter)
-(defvar nnimap-callback-callback-function nil
- "Gnus callback the nnimap asynchronous callback should call.")
-(defvar nnimap-callback-buffer nil
- "Which buffer the asynchronous article prefetch callback should work in.")
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
-(defvar nnimap-current-server nil) ;; Current server
-(defvar nnimap-server-buffer nil) ;; Current servers' buffer
+(defvar nnimap-current-server nil) ;; Current server
+(defvar nnimap-server-buffer nil) ;; Current servers' buffer
@@ -328,13 +448,13 @@ If SERVER is nil, uses the current server."
(new-uidvalidity (imap-mailbox-get 'uidvalidity))
(old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
(dir (file-name-as-directory (expand-file-name nnimap-directory)))
- (nameuid (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group "." old-uidvalidity
- nnimap-nov-file-name-suffix) t))
- (file (if (or nnmail-use-long-file-names
+ (nameuid (nnheader-translate-file-chars
+ (concat nnimap-nov-file-name
+ (if (equal server "")
+ "unnamed"
+ server) "." group "." old-uidvalidity
+ nnimap-nov-file-name-suffix) t))
+ (file (if (or nnmail-use-long-file-names
(file-exists-p (expand-file-name nameuid dir)))
(expand-file-name nameuid dir)
(expand-file-name
@@ -354,16 +474,18 @@ If SERVER is nil, uses the current server."
(defun nnimap-before-find-minmax-bugworkaround ()
"Function called before iterating through mailboxes with
`nnimap-find-minmax-uid'."
- ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
- ;; currently selected mailbox without a re-select/examine.
- (or (null (imap-current-mailbox nnimap-server-buffer))
- (imap-mailbox-unselect nnimap-server-buffer)))
+ (when nnimap-need-unselect-to-notice-new-mail
+ ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
+ ;; currently selected mailbox without a re-select/examine.
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer))))
(defun nnimap-find-minmax-uid (group &optional examine)
"Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
- (when (imap-mailbox-select group examine)
+ (when (or (string= group (imap-current-mailbox))
+ (imap-mailbox-select group examine))
(let (minuid maxuid)
(when (> (imap-mailbox-get 'exists) 0)
(imap-fetch "1,*" "UID" nil 'nouidfetch)
@@ -383,6 +505,8 @@ If EXAMINE is non-nil the group is selected read-only."
(if (or (nnimap-verify-uidvalidity
group (or server nnimap-current-server))
(zerop (imap-mailbox-get 'exists group))
+ t ;; for OGnus to see if ignoring uidvalidity
+ ;; changes has any bad effects.
(yes-or-no-p
(format
"nnimap: Group %s is not uidvalid. Continue? " group)))
@@ -428,10 +552,7 @@ If EXAMINE is non-nil the group is selected read-only."
(with-temp-buffer
(buffer-disable-undo)
(insert headers)
- (nnheader-ms-strip-cr)
- (nnheader-fold-continuation-lines)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((head (nnheader-parse-head 'naked)))
+ (let ((head (nnheader-parse-naked-head)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
(mail-header-set-lines head lines)
@@ -456,44 +577,44 @@ If EXAMINE is non-nil the group is selected read-only."
articles)))))
(mapcar (lambda (msgid)
(imap-search
- (format "HEADER Message-Id %s" msgid)))
+ (format "HEADER Message-Id \"%s\"" msgid)))
articles))))
(defun nnimap-group-overview-filename (group server)
"Make file name for GROUP on SERVER."
(let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
- (uidvalidity (gnus-group-get-parameter
- (gnus-group-prefixed-name
- group (gnus-server-to-method
- (format "nnimap:%s" server)))
- 'uidvalidity))
- (name (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group nnimap-nov-file-name-suffix) t))
- (nameuid (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group "." uidvalidity
- nnimap-nov-file-name-suffix) t))
- (oldfile (if (or nnmail-use-long-file-names
- (file-exists-p (expand-file-name name dir)))
- (expand-file-name name dir)
- (expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string name ?. ?/)
- nnmail-pathname-coding-system)
- dir)))
- (newfile (if (or nnmail-use-long-file-names
- (file-exists-p (expand-file-name nameuid dir)))
- (expand-file-name nameuid dir)
- (expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string nameuid ?. ?/)
- nnmail-pathname-coding-system)
- dir))))
+ (uidvalidity (gnus-group-get-parameter
+ (gnus-group-prefixed-name
+ group (gnus-server-to-method
+ (format "nnimap:%s" server)))
+ 'uidvalidity))
+ (name (nnheader-translate-file-chars
+ (concat nnimap-nov-file-name
+ (if (equal server "")
+ "unnamed"
+ server) "." group nnimap-nov-file-name-suffix) t))
+ (nameuid (nnheader-translate-file-chars
+ (concat nnimap-nov-file-name
+ (if (equal server "")
+ "unnamed"
+ server) "." group "." uidvalidity
+ nnimap-nov-file-name-suffix) t))
+ (oldfile (if (or nnmail-use-long-file-names
+ (file-exists-p (expand-file-name name dir)))
+ (expand-file-name name dir)
+ (expand-file-name
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string name ?. ?/)
+ nnmail-pathname-coding-system)
+ dir)))
+ (newfile (if (or nnmail-use-long-file-names
+ (file-exists-p (expand-file-name nameuid dir)))
+ (expand-file-name nameuid dir)
+ (expand-file-name
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string nameuid ?. ?/)
+ nnmail-pathname-coding-system)
+ dir))))
(when (and (file-exists-p oldfile) (not (file-exists-p newfile)))
(message "nnimap: Upgrading novcache filename...")
(sit-for 1)
@@ -540,7 +661,7 @@ If EXAMINE is non-nil the group is selected read-only."
(> nnimap-length nnmail-large-newsgroup)
(nnheader-message 6 "nnimap: Retrieving headers...done")))))
-(defun nnimap-use-nov-p (group server)
+(defun nnimap-dont-use-nov-p (group server)
(or gnus-nov-is-evil nnimap-nov-is-evil
(unless (and (gnus-make-directory
(file-name-directory
@@ -554,7 +675,7 @@ If EXAMINE is non-nil the group is selected read-only."
(when (nnimap-possibly-change-group group server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (if (nnimap-use-nov-p group server)
+ (if (nnimap-dont-use-nov-p group server)
(nnimap-retrieve-headers-from-server
(gnus-compress-sequence articles) group server)
(let (uids cached low high)
@@ -577,8 +698,8 @@ If EXAMINE is non-nil the group is selected read-only."
;; remove nov's for articles which has expired on server
(goto-char (point-min))
(dolist (uid (gnus-set-difference articles uids))
- (when (re-search-forward (format "^%d\t" uid) nil t)
- (gnus-delete-line)))))
+ (when (re-search-forward (format "^%d\t" uid) nil t)
+ (gnus-delete-line)))))
;; nothing cached, fetch whole range from server
(nnimap-retrieve-headers-from-server
(cons low high) group server))
@@ -601,9 +722,11 @@ If EXAMINE is non-nil the group is selected read-only."
(port (if nnimap-server-port
(int-to-string nnimap-server-port)
"imap"))
- (alist (gnus-netrc-machine list (or nnimap-server-address
- nnimap-address server)
- port "imap"))
+ (alist (or (gnus-netrc-machine list server port "imap")
+ (gnus-netrc-machine list
+ (or nnimap-server-address
+ nnimap-address)
+ port "imap")))
(user (gnus-netrc-get alist "login"))
(passwd (gnus-netrc-get alist "password")))
(if (imap-authenticate user passwd nnimap-server-buffer)
@@ -629,10 +752,17 @@ If EXAMINE is non-nil the group is selected read-only."
(cadr (assq 'nnimap-server-address defs))) defs)
(push (list 'nnimap-address server) defs)))
(nnoo-change-server 'nnimap server defs)
+ (or nnimap-server-buffer
+ (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
(with-current-buffer (get-buffer-create nnimap-server-buffer)
(nnoo-change-server 'nnimap server defs))
(or (and nnimap-server-buffer
- (imap-opened nnimap-server-buffer))
+ (imap-opened nnimap-server-buffer)
+ (if (with-current-buffer nnimap-server-buffer
+ (memq imap-state '(auth select examine)))
+ t
+ (imap-close nnimap-server-buffer)
+ (nnimap-open-connection server)))
(nnimap-open-connection server))))
(deffoo nnimap-server-opened (&optional server)
@@ -683,48 +813,61 @@ function is generally only called when Gnus is shutting down."
'identity)
(or string "")))
-(defun nnimap-callback ()
- (remove-hook 'imap-fetch-data-hook 'nnimap-callback)
- (with-current-buffer nnimap-callback-buffer
- (insert
- (with-current-buffer nnimap-server-buffer
- (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))
- (imap-message-get (imap-current-message) 'RFC822)))))
- (nnheader-ms-strip-cr)
- (funcall nnimap-callback-callback-function t)))
+(defun nnimap-make-callback (article gnus-callback buffer)
+ "Return a callback function."
+ `(lambda ()
+ (nnimap-callback ,article ,gnus-callback ,buffer)))
+
+(defun nnimap-callback (article gnus-callback buffer)
+ (when (eq article (imap-current-message))
+ (remove-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article gnus-callback buffer))
+ (with-current-buffer buffer
+ (insert
+ (with-current-buffer nnimap-server-buffer
+ (nnimap-demule
+ (if (imap-capability 'IMAP4rev1)
+ ;; xxx don't just use car? alist doesn't contain
+ ;; anything else now, but it might...
+ (nth 2 (car (imap-message-get article 'BODYDETAIL)))
+ (imap-message-get article 'RFC822)))))
+ (nnheader-ms-strip-cr)
+ (funcall gnus-callback t))))
(defun nnimap-request-article-part (article part prop &optional
- group server to-buffer detail)
+ group server to-buffer detail)
(when (nnimap-possibly-change-group group server)
(let ((article (if (stringp article)
(car-safe (imap-search
- (format "HEADER Message-Id %s" article)
+ (format "HEADER Message-Id \"%s\"" article)
nnimap-server-buffer))
article)))
(when article
- (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (let ((data (imap-fetch article part prop nil
- nnimap-server-buffer)))
- (insert (nnimap-demule (if detail
- (nth 2 (car data))
- data))))
- (nnheader-ms-strip-cr)
- (gnus-message 10 "nnimap: Fetching (part of) article %d...done"
- article)
+ (let ((data (imap-fetch article part prop nil
+ nnimap-server-buffer)))
+ (insert (nnimap-demule (if detail
+ (nth 2 (car data))
+ data))))
+ (nnheader-ms-strip-cr)
+ (gnus-message
+ 10 "nnimap: Fetching (part of) article %d from %s...done"
+ article (or group imap-current-mailbox gnus-newsgroup-name))
(if (bobp)
- (nnheader-report 'nnimap "No such article: %s"
+ (nnheader-report 'nnimap "No such article %d in %s: %s"
+ article (or group imap-current-mailbox
+ gnus-newsgroup-name)
(imap-error-text nnimap-server-buffer))
(cons group article)))
- (add-hook 'imap-fetch-data-hook 'nnimap-callback)
- (setq nnimap-callback-callback-function nnheader-callback-function
- nnimap-callback-buffer nntp-server-buffer)
+ (add-hook 'imap-fetch-data-hook
+ (nnimap-make-callback article
+ nnheader-callback-function
+ nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
@@ -772,20 +915,35 @@ function is generally only called when Gnus is shutting down."
(nnheader-report 'nnimap "Group %s selected" group)
t)))))
+(defun nnimap-update-unseen (group &optional server)
+ "Update the unseen count in `nnimap-mailbox-info'."
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
+ nnimap-mailbox-info)))
+ (list (nth 0 old) (nth 1 old)
+ (imap-mailbox-status group 'unseen nnimap-server-buffer)
+ (nth 3 old)))
+ nnimap-mailbox-info))
+
(defun nnimap-close-group (group &optional server)
(with-current-buffer nnimap-server-buffer
(when (and (imap-opened)
(nnimap-possibly-change-group group server))
+ (nnimap-update-unseen group server)
(case nnimap-expunge-on-close
- ('always (imap-mailbox-expunge)
- (imap-mailbox-close))
- ('ask (if (and (imap-search "DELETED")
- (gnus-y-or-n-p (format
- "Expunge articles in group `%s'? "
- imap-current-mailbox)))
- (progn (imap-mailbox-expunge)
- (imap-mailbox-close))
- (imap-mailbox-unselect)))
+ (always (progn
+ (imap-mailbox-expunge nnimap-close-asynchronous)
+ (unless nnimap-dont-close
+ (imap-mailbox-close nnimap-close-asynchronous))))
+ (ask (if (and (imap-search "DELETED")
+ (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
+ imap-current-mailbox)))
+ (progn
+ (imap-mailbox-expunge nnimap-close-asynchronous)
+ (unless nnimap-dont-close
+ (imap-mailbox-close nnimap-close-asynchronous)))
+ (imap-mailbox-unselect)))
(t (imap-mailbox-unselect)))
(not imap-current-mailbox))))
@@ -812,9 +970,9 @@ function is generally only called when Gnus is shutting down."
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
(with-current-buffer nntp-server-buffer
- (insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))))
+ (insert (format "\"%s\" %d %d y\n"
+ mbx (or (nth 2 info) 0)
+ (max 1 (or (nth 1 info) 1)))))))))))
(gnus-message 5 "nnimap: Generating active list%s...done"
(if (> (length server) 0) (concat " for " server) ""))
t))
@@ -822,8 +980,8 @@ function is generally only called when Gnus is shutting down."
(deffoo nnimap-request-post (&optional server)
(let ((success t))
(dolist (mbx (message-unquote-tokens
- (message-tokenize-header
- (message-fetch-field "Newsgroups") ", ")) success)
+ (message-tokenize-header
+ (message-fetch-field "Newsgroups") ", ")) success)
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
@@ -840,26 +998,102 @@ function is generally only called when Gnus is shutting down."
;; Optional backend functions
+(defun nnimap-string-lessp-numerical (s1 s2)
+ "Return t if first arg string is less than second in numerical order."
+ (cond ((string= s1 s2)
+ nil)
+ ((> (length s1) (length s2))
+ nil)
+ ((< (length s1) (length s2))
+ t)
+ ((< (string-to-number (substring s1 0 1))
+ (string-to-number (substring s2 0 1)))
+ t)
+ ((> (string-to-number (substring s1 0 1))
+ (string-to-number (substring s2 0 1)))
+ nil)
+ (t
+ (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1)))))
+
(deffoo nnimap-retrieve-groups (groups &optional server)
(when (nnimap-possibly-change-server server)
(gnus-message 5 "nnimap: Checking mailboxes...")
(with-current-buffer nntp-server-buffer
(erase-buffer)
(nnimap-before-find-minmax-bugworkaround)
- (dolist (group groups)
- (gnus-message 7 "nnimap: Checking mailbox %s" group)
- (or (member "\\NoSelect"
- (imap-mailbox-get 'list-flags group nnimap-server-buffer))
- (let ((info (nnimap-find-minmax-uid group 'examine)))
- (insert (format "\"%s\" %d %d y\n" group
- (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1))))))))
+ (let (asyncgroups slowgroups)
+ (if (null nnimap-retrieve-groups-asynchronous)
+ (setq slowgroups groups)
+ (dolist (group groups)
+ (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
+ (add-to-list (if (gnus-gethash-safe
+ (gnus-group-prefixed-name group server)
+ nnimap-mailbox-info)
+ 'asyncgroups
+ 'slowgroups)
+ (list group (imap-mailbox-status-asynch
+ group '(uidvalidity uidnext unseen)
+ nnimap-server-buffer))))
+ (dolist (asyncgroup asyncgroups)
+ (let ((group (nth 0 asyncgroup))
+ (tag (nth 1 asyncgroup))
+ new old)
+ (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
+ (if (or (not (string=
+ (nth 0 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))
+ (imap-mailbox-get 'uidvalidity group
+ nnimap-server-buffer)))
+ (not (string=
+ (nth 1 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))
+ (imap-mailbox-get 'uidnext group
+ nnimap-server-buffer))))
+ (push (list group) slowgroups)
+ (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
+ group server)
+ nnimap-mailbox-info))))))))
+ (dolist (group slowgroups)
+ (if nnimap-retrieve-groups-asynchronous
+ (setq group (car group)))
+ (gnus-message 7 "nnimap: Mailbox %s modified" group)
+ (imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
+ (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
+ nnimap-server-buffer))
+ (let* ((info (nnimap-find-minmax-uid group 'examine))
+ (str (format "\"%s\" %d %d y\n" group
+ (or (nth 2 info) 0)
+ (max 1 (or (nth 1 info) 1)))))
+ (when (> (or (imap-mailbox-get 'recent group
+ nnimap-server-buffer) 0)
+ 0)
+ (push (list (cons group 0)) nnmail-split-history))
+ (insert str)
+ (when nnimap-retrieve-groups-asynchronous
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ (list (or (imap-mailbox-get
+ 'uidvalidity group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'uidvalidity nnimap-server-buffer))
+ (or (imap-mailbox-get
+ 'uidnext group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'uidnext nnimap-server-buffer))
+ (or (imap-mailbox-get
+ 'unseen group nnimap-server-buffer)
+ (imap-mailbox-status
+ group 'unseen nnimap-server-buffer))
+ str)
+ nnimap-mailbox-info)))))))
(gnus-message 5 "nnimap: Checking mailboxes...done")
'active))
(deffoo nnimap-request-update-info-internal (group info &optional server)
(when (nnimap-possibly-change-group group server)
- (when info;; xxx what does this mean? should we create a info?
+ (when info ;; xxx what does this mean? should we create a info?
(with-current-buffer nnimap-server-buffer
(gnus-message 5 "nnimap: Updating info for %s..."
(gnus-info-group info))
@@ -887,12 +1121,13 @@ function is generally only called when Gnus is shutting down."
(gnus-info-set-read info seen)))
(mapcar (lambda (pred)
- (when (and (nnimap-mark-permanent-p (cdr pred))
- (member (nnimap-mark-to-flag (cdr pred))
- (imap-mailbox-get 'flags)))
+ (when (or (eq (cdr pred) 'recent)
+ (and (nnimap-mark-permanent-p (cdr pred))
+ (member (nnimap-mark-to-flag (cdr pred))
+ (imap-mailbox-get 'flags))))
(gnus-info-set-marks
info
- (nnimap-update-alist-soft
+ (gnus-update-alist-soft
(cdr pred)
(gnus-compress-sequence
(imap-search (nnimap-mark-to-predicate (cdr pred))))
@@ -900,17 +1135,18 @@ function is generally only called when Gnus is shutting down."
t)))
gnus-article-mark-lists)
- ;; nnimap mark dormant article as ticked too (for other clients)
- ;; so we remove that mark for gnus since we support dormant
- (gnus-info-set-marks
- info
- (nnimap-update-alist-soft
- 'tick
- (gnus-remove-from-range
- (cdr-safe (assoc 'tick (gnus-info-marks info)))
- (cdr-safe (assoc 'dormant (gnus-info-marks info))))
- (gnus-info-marks info))
- t)
+ (when nnimap-importantize-dormant
+ ;; nnimap mark dormant article as ticked too (for other clients)
+ ;; so we remove that mark for gnus since we support dormant
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ 'tick
+ (gnus-remove-from-range
+ (cdr-safe (assoc 'tick (gnus-info-marks info)))
+ (cdr-safe (assoc 'dormant (gnus-info-marks info))))
+ (gnus-info-marks info))
+ t))
(gnus-message 5 "nnimap: Updating info for %s...done"
(gnus-info-group info))
@@ -932,11 +1168,22 @@ function is generally only called when Gnus is shutting down."
(what (nth 1 action))
(cmdmarks (nth 2 action))
marks)
+ ;; bookmark can't be stored (not list/range
+ (setq cmdmarks (delq 'bookmark cmdmarks))
+ ;; killed can't be stored (not list/range
+ (setq cmdmarks (delq 'killed cmdmarks))
+ ;; unsent are for nndraft groups only
+ (setq cmdmarks (delq 'unsent cmdmarks))
;; cache flags are pointless on the server
(setq cmdmarks (delq 'cache cmdmarks))
- ;; flag dormant articles as ticked
- (if (memq 'dormant cmdmarks)
- (setq cmdmarks (cons 'tick cmdmarks)))
+ ;; seen flags are local to each gnus
+ (setq cmdmarks (delq 'seen cmdmarks))
+ ;; recent marks can't be set
+ (setq cmdmarks (delq 'recent cmdmarks))
+ (when nnimap-importantize-dormant
+ ;; flag dormant articles as ticked
+ (if (memq 'dormant cmdmarks)
+ (setq cmdmarks (cons 'tick cmdmarks))))
;; remove stuff we are forbidden to store
(mapcar (lambda (mark)
(if (imap-message-flag-permanent-p
@@ -960,7 +1207,7 @@ function is generally only called when Gnus is shutting down."
nil)
(defun nnimap-split-fancy ()
- "Like nnmail-split-fancy, but uses nnimap-split-fancy."
+ "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'."
(let ((nnmail-split-fancy nnimap-split-fancy))
(nnmail-split-fancy)))
@@ -982,7 +1229,10 @@ function is generally only called when Gnus is shutting down."
(goto-char (point-min))
(when (and (if (stringp regexp)
(progn
- (setq regrepp (string-match "\\\\[0-9&]" group))
+ (if (not (stringp group))
+ (setq group (eval group))
+ (setq regrepp
+ (string-match "\\\\[0-9&]" group)))
(re-search-forward regexp nil t))
(funcall regexp group))
;; Don't enter the article into the same group twice.
@@ -1004,7 +1254,7 @@ function is generally only called when Gnus is shutting down."
(defun nnimap-split-find-rule (server inbox)
(if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))
- (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
+ (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
;; extended format
(cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match
server nnimap-split-rule))))
@@ -1021,33 +1271,56 @@ function is generally only called when Gnus is shutting down."
(let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
;; iterate over inboxes
(while (and (setq inbox (pop inboxes))
- (nnimap-possibly-change-group inbox));; SELECT
+ (nnimap-possibly-change-group inbox)) ;; SELECT
;; find split rule for this server / inbox
(when (setq rule (nnimap-split-find-rule server inbox))
;; iterate over articles
(dolist (article (imap-search nnimap-split-predicate))
- (when (nnimap-request-head article)
+ (when (if (if (eq nnimap-split-download-body 'default)
+ nnimap-split-download-body-default
+ nnimap-split-download-body)
+ (and (nnimap-request-article article)
+ (with-current-buffer nntp-server-buffer (mail-narrow-to-head)))
+ (nnimap-request-head article))
;; copy article to right group(s)
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
- (if (imap-message-copy (number-to-string article)
- to-group nil 'nocopyuid)
- (progn
- (message "IMAP split moved %s:%s:%d to %s" server inbox
- article to-group)
- (setq removeorig t)
- ;; Add the group-art list to the history list.
- (push (list (cons to-group 0)) nnmail-split-history))
- (message "IMAP split failed to move %s:%s:%d to %s" server
- inbox article to-group)))
+ (cond ((eq to-group 'junk)
+ (message "IMAP split removed %s:%s:%d" server inbox
+ article)
+ (setq removeorig t))
+ ((imap-message-copy (number-to-string article)
+ to-group nil 'nocopyuid)
+ (message "IMAP split moved %s:%s:%d to %s" server
+ inbox article to-group)
+ (setq removeorig t)
+ (when nnmail-cache-accepted-message-ids
+ (with-current-buffer nntp-server-buffer
+ (let (msgid)
+ (and (setq msgid
+ (nnmail-fetch-field "message-id"))
+ (nnmail-cache-insert msgid
+ to-group
+ (nnmail-fetch-field "subject"))))))
+ ;; Add the group-art list to the history list.
+ (push (list (cons to-group 0)) nnmail-split-history))
+ (t
+ (message "IMAP split failed to move %s:%s:%d to %s"
+ server inbox article to-group))))
+ (if (if (eq nnimap-split-download-body 'default)
+ nnimap-split-download-body-default
+ nnimap-split-download-body)
+ (widen))
;; remove article if it was successfully copied somewhere
(and removeorig
(imap-message-flags-add (format "%d" article)
"\\Seen \\Deleted")))))
- (when (imap-mailbox-select inbox);; just in case
+ (when (imap-mailbox-select inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
(imap-mailbox-expunge)
(imap-mailbox-close)))
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-close))
t))))
(deffoo nnimap-request-scan (&optional group server)
@@ -1062,7 +1335,7 @@ function is generally only called when Gnus is shutting down."
(nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
+ (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
nnimap-server-buffer))
(or (catch 'found
(dolist (mailbox (imap-mailbox-get 'list-flags mbx
@@ -1072,9 +1345,9 @@ function is generally only called when Gnus is shutting down."
nil)
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
- (insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))
+ (insert (format "\"%s\" %d %d y\n"
+ mbx (or (nth 2 info) 0)
+ (max 1 (or (nth 1 info) 1)))))))))
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
(if (> (length server) 0) " on " "") server))
t))
@@ -1082,7 +1355,9 @@ function is generally only called when Gnus is shutting down."
(deffoo nnimap-request-create-group (group &optional server args)
(when (nnimap-possibly-change-server server)
(or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
- (imap-mailbox-create group nnimap-server-buffer))))
+ (imap-mailbox-create group nnimap-server-buffer)
+ (nnheader-report 'nnimap "%S"
+ (imap-error-text nnimap-server-buffer)))))
(defun nnimap-time-substract (time1 time2)
"Return TIME for TIME1 - TIME2."
@@ -1108,36 +1383,53 @@ function is generally only called when Gnus is shutting down."
(gnus-message 5 "nnimap: Marking article %d for deletion..."
imap-current-message))
+(defun nnimap-expiry-target (arts group server)
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (dolist (art arts)
+ (nnimap-request-article art group server (current-buffer))
+ ;; hints for optimization in `nnimap-request-accept-article'
+ (let ((nnimap-current-move-article art)
+ (nnimap-current-move-group group)
+ (nnimap-current-move-server server))
+ (nnmail-expiry-target-group nnmail-expiry-target group))))
+ ;; It is not clear if `nnmail-expiry-target' somehow cause the
+ ;; current group to be changed or not, so we make sure here.
+ (nnimap-possibly-change-group group server)))
+
;; Notice that we don't actually delete anything, we just mark them deleted.
(deffoo nnimap-request-expire-articles (articles group &optional server force)
(let ((artseq (gnus-compress-sequence articles)))
(when (and artseq (nnimap-possibly-change-group group server))
(with-current-buffer nnimap-server-buffer
- (if force
- (and (imap-message-flags-add
- (imap-range-to-message-set artseq) "\\Deleted")
- (setq articles nil))
- (let ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait)))
- (cond ((eq days 'immediate)
- (and (imap-message-flags-add
- (imap-range-to-message-set artseq) "\\Deleted")
- (setq articles nil)))
- ((numberp days)
- (let ((oldarts (imap-search
- (format "UID %s NOT SINCE %s"
- (imap-range-to-message-set artseq)
- (nnimap-date-days-ago days))))
- (imap-fetch-data-hook
- '(nnimap-request-expire-articles-progress)))
- (and oldarts
- (imap-message-flags-add
- (imap-range-to-message-set
- (gnus-compress-sequence oldarts))
- "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts)))))))))))
+ (let ((days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait)))
+ (cond ((or force (eq days 'immediate))
+ (let ((oldarts (imap-search
+ (concat "UID "
+ (imap-range-to-message-set artseq)))))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts))))))
+ ((numberp days)
+ (let ((oldarts (imap-search
+ (format nnimap-expunge-search-string
+ (imap-range-to-message-set artseq)
+ (nnimap-date-days-ago days))))
+ (imap-fetch-data-hook
+ '(nnimap-request-expire-articles-progress)))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set
+ (gnus-compress-sequence oldarts)) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts)))))))))))
;; return articles not deleted
articles)
@@ -1158,7 +1450,9 @@ function is generally only called when Gnus is shutting down."
(setq result (eval accept-form))
(kill-buffer buf)
result)
- (nnimap-request-expire-articles (list article) group server t))
+ (imap-message-flags-add
+ (imap-range-to-message-set (list article))
+ "\\Deleted" 'silent nnimap-server-buffer))
result))))
(deffoo nnimap-request-accept-article (group &optional server last)
@@ -1178,13 +1472,19 @@ function is generally only called when Gnus is shutting down."
;; remove any 'From blabla' lines, some IMAP servers
;; reject the entire message otherwise.
(when (looking-at "^From[^:]")
- (kill-region (point) (progn (forward-line) (point))))
+ (delete-region (point) (progn (forward-line) (point))))
;; turn into rfc822 format (\r\n eol's)
(while (search-forward "\n" nil t)
- (replace-match "\r\n")))
- ;; this 'or' is for Cyrus server bug
- (or (null (imap-current-mailbox nnimap-server-buffer))
- (imap-mailbox-unselect nnimap-server-buffer))
+ (replace-match "\r\n"))
+ (when nnmail-cache-accepted-message-ids
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject"))))
+ (when (and last nnmail-cache-accepted-message-ids)
+ (nnmail-cache-close))
+ ;; this 'or' is for Cyrus server bug
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer))
(imap-message-append group (current-buffer) nil nil
nnimap-server-buffer)))
(cons group (nth 1 uid))
@@ -1205,7 +1505,7 @@ function is generally only called when Gnus is shutting down."
(defun nnimap-expunge (mailbox server)
(when (nnimap-possibly-change-group mailbox server)
- (imap-mailbox-expunge nnimap-server-buffer)))
+ (imap-mailbox-expunge nil nnimap-server-buffer)))
(defun nnimap-acl-get (mailbox server)
(when (nnimap-possibly-change-server server)
@@ -1253,12 +1553,13 @@ function is generally only called when Gnus is shutting down."
(mapcar
(lambda (pair) ; cdr is the mark
(or (assoc (cdr pair)
- '((read . "SEEN")
- (tick . "FLAGGED")
- (draft . "DRAFT")
- (reply . "ANSWERED")))
- (cons (cdr pair)
- (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
+ '((read . "SEEN")
+ (tick . "FLAGGED")
+ (draft . "DRAFT")
+ (recent . "RECENT")
+ (reply . "ANSWERED")))
+ (cons (cdr pair)
+ (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
(cons '(read . read) gnus-article-mark-lists)))
(defun nnimap-mark-to-predicate (pred)
@@ -1271,12 +1572,13 @@ to be used within a IMAP SEARCH query."
(mapcar
(lambda (pair)
(or (assoc (cdr pair)
- '((read . "\\Seen")
- (tick . "\\Flagged")
- (draft . "\\Draft")
- (reply . "\\Answered")))
- (cons (cdr pair)
- (format "gnus-%s" (symbol-name (cdr pair))))))
+ '((read . "\\Seen")
+ (tick . "\\Flagged")
+ (draft . "\\Draft")
+ (recent . "\\Recent")
+ (reply . "\\Answered")))
+ (cons (cdr pair)
+ (format "gnus-%s" (symbol-name (cdr pair))))))
(cons '(read . read) gnus-article-mark-lists)))
(defun nnimap-mark-to-flag-1 (preds)
@@ -1306,86 +1608,67 @@ be used in a STORE FLAGS command."
"Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
(imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
-(defun nnimap-remassoc (key alist)
- "Delete by side effect any elements of LIST whose car is `equal' to KEY.
-The modified LIST is returned. If the first member
-of LIST has a car that is `equal' to KEY, there is no way to remove it
-by side effect; therefore, write `(setq foo (remassoc key foo))' to be
-sure of changing the value of `foo'."
- (when alist
- (if (equal key (caar alist))
- (cdr alist)
- (setcdr alist (nnimap-remassoc key (cdr alist)))
- alist)))
-
-(defun nnimap-update-alist-soft (key value alist)
- (if value
- (cons (cons key value) (nnimap-remassoc key alist))
- (nnimap-remassoc key alist)))
-
(when nnimap-debug
(require 'trace)
- (buffer-disable-undo (get-buffer-create nnimap-debug))
- (mapcar (lambda (f) (trace-function-background f nnimap-debug))
- '(
- nnimap-possibly-change-server
- nnimap-verify-uidvalidity
- nnimap-find-minmax-uid
- nnimap-before-find-minmax-bugworkaround
- nnimap-possibly-change-group
- ;;nnimap-replace-whitespace
- nnimap-retrieve-headers-progress
- nnimap-retrieve-which-headers
- nnimap-group-overview-filename
- nnimap-retrieve-headers-from-file
- nnimap-retrieve-headers-from-server
- nnimap-retrieve-headers
- nnimap-open-connection
- nnimap-open-server
- nnimap-server-opened
- nnimap-close-server
- nnimap-request-close
- nnimap-status-message
- ;;nnimap-demule
- nnimap-request-article-part
- nnimap-request-article
- nnimap-request-head
- nnimap-request-body
- nnimap-request-group
- nnimap-close-group
- nnimap-pattern-to-list-arguments
- nnimap-request-list
- nnimap-request-post
- nnimap-retrieve-groups
- nnimap-request-update-info-internal
- nnimap-request-type
- nnimap-request-set-mark
- nnimap-split-to-groups
- nnimap-split-find-rule
- nnimap-split-find-inbox
- nnimap-split-articles
- nnimap-request-scan
- nnimap-request-newgroups
- nnimap-request-create-group
- nnimap-time-substract
- nnimap-date-days-ago
- nnimap-request-expire-articles-progress
- nnimap-request-expire-articles
- nnimap-request-move-article
- nnimap-request-accept-article
- nnimap-request-delete-group
- nnimap-request-rename-group
- gnus-group-nnimap-expunge
- gnus-group-nnimap-edit-acl
- gnus-group-nnimap-edit-acl-done
- nnimap-group-mode-hook
- nnimap-mark-to-predicate
- nnimap-mark-to-flag-1
- nnimap-mark-to-flag
- nnimap-mark-permanent-p
- nnimap-remassoc
- nnimap-update-alist-soft
- )))
+ (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
+ (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
+ '(
+ nnimap-possibly-change-server
+ nnimap-verify-uidvalidity
+ nnimap-find-minmax-uid
+ nnimap-before-find-minmax-bugworkaround
+ nnimap-possibly-change-group
+ ;;nnimap-replace-whitespace
+ nnimap-retrieve-headers-progress
+ nnimap-retrieve-which-headers
+ nnimap-group-overview-filename
+ nnimap-retrieve-headers-from-file
+ nnimap-retrieve-headers-from-server
+ nnimap-retrieve-headers
+ nnimap-open-connection
+ nnimap-open-server
+ nnimap-server-opened
+ nnimap-close-server
+ nnimap-request-close
+ nnimap-status-message
+ ;;nnimap-demule
+ nnimap-request-article-part
+ nnimap-request-article
+ nnimap-request-head
+ nnimap-request-body
+ nnimap-request-group
+ nnimap-close-group
+ nnimap-pattern-to-list-arguments
+ nnimap-request-list
+ nnimap-request-post
+ nnimap-retrieve-groups
+ nnimap-request-update-info-internal
+ nnimap-request-type
+ nnimap-request-set-mark
+ nnimap-split-to-groups
+ nnimap-split-find-rule
+ nnimap-split-find-inbox
+ nnimap-split-articles
+ nnimap-request-scan
+ nnimap-request-newgroups
+ nnimap-request-create-group
+ nnimap-time-substract
+ nnimap-date-days-ago
+ nnimap-request-expire-articles-progress
+ nnimap-request-expire-articles
+ nnimap-request-move-article
+ nnimap-request-accept-article
+ nnimap-request-delete-group
+ nnimap-request-rename-group
+ gnus-group-nnimap-expunge
+ gnus-group-nnimap-edit-acl
+ gnus-group-nnimap-edit-acl-done
+ nnimap-group-mode-hook
+ nnimap-mark-to-predicate
+ nnimap-mark-to-flag-1
+ nnimap-mark-to-flag
+ nnimap-mark-permanent-p
+ )))
(provide 'nnimap)
diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el
index 1cd1d1d1789..f68bb8b5f55 100644
--- a/lisp/gnus/nnkiboze.el
+++ b/lisp/gnus/nnkiboze.el
@@ -1,6 +1,6 @@
;;; nnkiboze.el --- select virtual news access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -109,10 +109,12 @@
(setq num (string-to-int (match-string 2 xref))
group (match-string 1 xref))
(or (with-current-buffer buffer
- (gnus-cache-request-article num group))
+ (or (and gnus-use-cache (gnus-cache-request-article num group))
+ (gnus-agent-request-article num group)))
(gnus-request-article num group buffer)))))
(deffoo nnkiboze-request-scan (&optional group server)
+ (nnkiboze-possibly-change-group group)
(nnkiboze-generate-group (concat "nnkiboze:" group)))
(deffoo nnkiboze-request-group (group &optional server dont-check)
@@ -227,11 +229,11 @@ Finds out what articles are to be part of the nnkiboze groups."
(defun nnkiboze-generate-group (group &optional inhibit-list-groups)
(let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
(newsrc-file (concat nnkiboze-directory
- (nnheader-translate-file-chars
- (concat group ".newsrc"))))
+ (nnheader-translate-file-chars
+ (concat group ".newsrc"))))
(nov-file (concat nnkiboze-directory
- (nnheader-translate-file-chars
- (concat group ".nov"))))
+ (nnheader-translate-file-chars
+ (concat group ".nov"))))
method nnkiboze-newsrc gname newsrc active
ginfo lowest glevel orig-info nov-buffer
;; Bind various things to nil to make group entry faster.
@@ -242,112 +244,116 @@ Finds out what articles are to be part of the nnkiboze groups."
(gnus-score-use-all-scores nil)
(gnus-use-scoring t)
(gnus-verbose (min gnus-verbose 3))
- gnus-select-group-hook gnus-summary-prepare-hook
+ gnus-select-group-hook gnus-summary-prepare-hook
gnus-thread-sort-functions gnus-show-threads
gnus-visual gnus-suppress-duplicates num-unread)
(unless info
(error "No such group: %s" group))
;; Load the kiboze newsrc file for this group.
- (when (file-exists-p newsrc-file)
- (load newsrc-file))
- (let ((coding-system-for-write nnkiboze-file-coding-system))
- (with-temp-file nov-file
- (when (file-exists-p nov-file)
- (insert-file-contents nov-file))
- (setq nov-buffer (current-buffer))
- ;; Go through the active hashtb and add new all groups that match the
- ;; kiboze regexp.
- (mapatoms
- (lambda (group)
- (and (string-match nnkiboze-regexp
- (setq gname (symbol-name group))) ; Match
- (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
- (numberp (car (symbol-value group))) ; It is active
- (or (> nnkiboze-level 7)
- (and (setq glevel (nth 1 (nth 2 (gnus-gethash
- gname gnus-newsrc-hashtb))))
- (>= nnkiboze-level glevel)))
- (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
- (push (cons gname (1- (car (symbol-value group))))
- nnkiboze-newsrc)))
- gnus-active-hashtb)
- ;; `newsrc' is set to the list of groups that possibly are
- ;; component groups to this kiboze group. This list has elements
- ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
- ;; number that has been kibozed in GROUP in this kiboze group.
- (setq newsrc nnkiboze-newsrc)
- (while newsrc
- (if (not (setq active (gnus-gethash
- (caar newsrc) gnus-active-hashtb)))
- ;; This group isn't active after all, so we remove it from
- ;; the list of component groups.
- (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
- (setq lowest (cdar newsrc))
- ;; Ok, we have a valid component group, so we jump to it.
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-jump-to-group (caar newsrc))
- (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
- (setq ginfo (gnus-get-info (gnus-group-group-name))
- orig-info (gnus-copy-sequence ginfo)
- num-unread (car (gnus-gethash (caar newsrc)
- gnus-newsrc-hashtb)))
- (unwind-protect
- (progn
- ;; We set all list of article marks to nil. Since we operate
- ;; on copies of the real lists, we can destroy anything we
- ;; want here.
- (when (nth 3 ginfo)
- (setcar (nthcdr 3 ginfo) nil))
- ;; We set the list of read articles to be what we expect for
- ;; this kiboze group -- either nil or `(1 . LOWEST)'.
- (when ginfo
- (setcar (nthcdr 2 ginfo)
- (and (not (= lowest 1)) (cons 1 lowest))))
- (when (and (or (not ginfo)
- (> (length (gnus-list-of-unread-articles
- (car ginfo)))
- 0))
- (progn
- (ignore-errors
- (gnus-group-select-group nil))
- (eq major-mode 'gnus-summary-mode)))
- ;; We are now in the group where we want to be.
- (setq method (gnus-find-method-for-group
- gnus-newsgroup-name))
- (when (eq method gnus-select-method)
- (setq method nil))
- ;; We go through the list of scored articles.
- (while gnus-newsgroup-scored
- (when (> (caar gnus-newsgroup-scored) lowest)
- ;; If it has a good score, then we enter this article
- ;; into the kiboze group.
- (nnkiboze-enter-nov
- nov-buffer
- (gnus-summary-article-header
- (caar gnus-newsgroup-scored))
- gnus-newsgroup-name))
- (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
- ;; That's it. We exit this group.
- (when (eq major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))))
- ;; Restore the proper info.
- (when ginfo
- (setcdr ginfo (cdr orig-info)))
- (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb)
- num-unread)))
- (setcdr (car newsrc) (car active))
- (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
- (setq newsrc (cdr newsrc)))))
- ;; We save the kiboze newsrc for this group.
- (with-temp-file newsrc-file
- (insert "(setq nnkiboze-newsrc '")
- (gnus-prin1 nnkiboze-newsrc)
- (insert ")\n")))
+ (mm-with-unibyte
+ (when (file-exists-p newsrc-file)
+ (load newsrc-file))
+ (let ((coding-system-for-write nnkiboze-file-coding-system))
+ (gnus-make-directory (file-name-directory nov-file))
+ (with-temp-file nov-file
+ (when (file-exists-p nov-file)
+ (insert-file-contents nov-file))
+ (setq nov-buffer (current-buffer))
+ ;; Go through the active hashtb and add new all groups that match the
+ ;; kiboze regexp.
+ (mapatoms
+ (lambda (group)
+ (and (string-match nnkiboze-regexp
+ (setq gname (symbol-name group))) ; Match
+ (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
+ (numberp (car (symbol-value group))) ; It is active
+ (or (> nnkiboze-level 7)
+ (and (setq glevel
+ (nth 1 (nth 2 (gnus-gethash
+ gname gnus-newsrc-hashtb))))
+ (>= nnkiboze-level glevel)))
+ (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
+ (push (cons gname (1- (car (symbol-value group))))
+ nnkiboze-newsrc)))
+ gnus-active-hashtb)
+ ;; `newsrc' is set to the list of groups that possibly are
+ ;; component groups to this kiboze group. This list has elements
+ ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
+ ;; number that has been kibozed in GROUP in this kiboze group.
+ (setq newsrc nnkiboze-newsrc)
+ (while newsrc
+ (if (not (setq active (gnus-gethash
+ (caar newsrc) gnus-active-hashtb)))
+ ;; This group isn't active after all, so we remove it from
+ ;; the list of component groups.
+ (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
+ (setq lowest (cdar newsrc))
+ ;; Ok, we have a valid component group, so we jump to it.
+ (switch-to-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group (caar newsrc))
+ (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
+ (setq ginfo (gnus-get-info (gnus-group-group-name))
+ orig-info (gnus-copy-sequence ginfo)
+ num-unread (car (gnus-gethash (caar newsrc)
+ gnus-newsrc-hashtb)))
+ (unwind-protect
+ (progn
+ ;; We set all list of article marks to nil. Since we operate
+ ;; on copies of the real lists, we can destroy anything we
+ ;; want here.
+ (when (nth 3 ginfo)
+ (setcar (nthcdr 3 ginfo) nil))
+ ;; We set the list of read articles to be what we expect for
+ ;; this kiboze group -- either nil or `(1 . LOWEST)'.
+ (when ginfo
+ (setcar (nthcdr 2 ginfo)
+ (and (not (= lowest 1)) (cons 1 lowest))))
+ (when (and (or (not ginfo)
+ (> (length (gnus-list-of-unread-articles
+ (car ginfo)))
+ 0))
+ (progn
+ (ignore-errors
+ (gnus-group-select-group nil))
+ (eq major-mode 'gnus-summary-mode)))
+ ;; We are now in the group where we want to be.
+ (setq method (gnus-find-method-for-group
+ gnus-newsgroup-name))
+ (when (eq method gnus-select-method)
+ (setq method nil))
+ ;; We go through the list of scored articles.
+ (while gnus-newsgroup-scored
+ (when (> (caar gnus-newsgroup-scored) lowest)
+ ;; If it has a good score, then we enter this article
+ ;; into the kiboze group.
+ (nnkiboze-enter-nov
+ nov-buffer
+ (gnus-summary-article-header
+ (caar gnus-newsgroup-scored))
+ gnus-newsgroup-name))
+ (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
+ ;; That's it. We exit this group.
+ (when (eq major-mode 'gnus-summary-mode)
+ (kill-buffer (current-buffer)))))
+ ;; Restore the proper info.
+ (when ginfo
+ (setcdr ginfo (cdr orig-info)))
+ (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb)
+ num-unread)))
+ (setcdr (car newsrc) (cdr active))
+ (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
+ (setq newsrc (cdr newsrc)))))
+ ;; We save the kiboze newsrc for this group.
+ (gnus-make-directory (file-name-directory newsrc-file))
+ (with-temp-file newsrc-file
+ (insert "(setq nnkiboze-newsrc '")
+ (gnus-prin1 nnkiboze-newsrc)
+ (insert ")\n")))
(unless inhibit-list-groups
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-group-list-groups)))
- t)
+ t))
(defun nnkiboze-enter-nov (buffer header group)
(save-excursion
diff --git a/lisp/gnus/nnlistserv.el b/lisp/gnus/nnlistserv.el
index b6ce46c82f2..770bb02d01e 100644
--- a/lisp/gnus/nnlistserv.el
+++ b/lisp/gnus/nnlistserv.el
@@ -24,18 +24,13 @@
;;; Commentary:
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
;;; Code:
(eval-when-compile (require 'cl))
(require 'nnoo)
-(eval-when-compile
- (ignore-errors
- (require 'nnweb)) ; requires W3
- (autoload 'url-insert-file-contents "nnweb"))
+(require 'mm-url)
+(require 'nnweb)
(nnoo-declare nnlistserv
nnweb)
@@ -98,7 +93,7 @@
(when (funcall (nnweb-definition 'search) page)
;; Go through all the article hits on this page.
(goto-char (point-min))
- (nnweb-decode-entities)
+ (mm-url-decode-entities)
(goto-char (point-min))
(while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
(setq url (match-string 1)
@@ -124,7 +119,7 @@
(let ((case-fold-search t)
(headers '(sent name email subject id))
sent name email subject id)
- (nnweb-decode-entities)
+ (mm-url-decode-entities)
(while headers
(goto-char (point-min))
(re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t)
@@ -135,7 +130,7 @@
(goto-char (point-max))
(search-backward "<!-- body" nil t)
(delete-region (point-max) (progn (beginning-of-line) (point)))
- (nnweb-remove-markup)
+ (mm-url-remove-markup)
(goto-char (point-min))
(insert (format "From: %s <%s>\n" name email)
(format "Subject: %s\n" subject)
@@ -143,7 +138,7 @@
(format "Date: %s\n\n" sent))))
(defun nnlistserv-kk-search (search)
- (url-insert-file-contents
+ (mm-url-insert
(concat (format (nnweb-definition 'address) search)
(nnweb-definition 'index)))
t)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 5153921a8da..bebf7ceaf07 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1,5 +1,5 @@
;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -28,6 +28,7 @@
(eval-when-compile (require 'cl))
+(require 'gnus) ; for macro gnus-kill-buffer, at least
(require 'nnheader)
(require 'message)
(require 'custom)
@@ -36,8 +37,8 @@
(require 'mm-util)
(eval-and-compile
- (autoload 'gnus-error "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util"))
+ (autoload 'gnus-add-buffer "gnus")
+ (autoload 'gnus-kill-buffer "gnus"))
(defgroup nnmail nil
"Reading mail with Gnus."
@@ -76,8 +77,7 @@
"Various mail options."
:group 'nnmail)
-(defcustom nnmail-split-methods
- '(("mail.misc" ""))
+(defcustom nnmail-split-methods '(("mail.misc" ""))
"*Incoming mail will be split according to this variable.
If you'd like, for instance, one mail group for mail from the
@@ -86,8 +86,8 @@ else, you could do something like this:
(setq nnmail-split-methods
'((\"mail.4ad\" \"From:.*4ad\")
- (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
- (\"mail.misc\" \"\")))
+ (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
+ (\"mail.misc\" \"\")))
As you can see, this variable is a list of lists, where the first
element in each \"rule\" is the name of the group (which, by the way,
@@ -104,7 +104,8 @@ The last element should always have \"\" as the regexp.
This variable can also have a function as its value."
:group 'nnmail-split
- :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
+ :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
+ (choice regexp function)))
(function-item nnmail-split-fancy)
(function :tag "Other")))
@@ -115,6 +116,22 @@ If nil, the first match found will be used."
:group 'nnmail-split
:type 'boolean)
+(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
+ "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
+This can also be a list of regexps."
+ :group 'nnmail-split
+ :type '(choice (const :tag "none" nil)
+ (regexp :value ".*")
+ (repeat :value (".*") regexp)))
+
+(defcustom nnmail-cache-ignore-groups nil
+ "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
+This can also be a list of regexps."
+ :group 'nnmail-split
+ :type '(choice (const :tag "none" nil)
+ (regexp :value ".*")
+ (repeat :value (".*") regexp)))
+
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
(defcustom nnmail-keep-last-article nil
"If non-nil, nnmail will never delete/move a group's last article.
@@ -145,22 +162,22 @@ number of days) -- this doesn't have to be an integer. This variable
can also be `immediate' and `never'."
:group 'nnmail-expire
:type '(choice (const immediate)
- (integer :tag "days")
+ (number :tag "days")
(const never)))
(defcustom nnmail-expiry-wait-function nil
"Variable that holds function to specify how old articles should be before they are expired.
- The function will be called with the name of the group that the
-expiry is to be performed in, and it should return an integer that
-says how many days an article can be stored before it is considered
-\"old\". It can also return the values `never' and `immediate'.
+The function will be called with the name of the group that the expiry
+is to be performed in, and it should return an integer that says how
+many days an article can be stored before it is considered \"old\".
+It can also return the values `never' and `immediate'.
Eg.:
\(setq nnmail-expiry-wait-function
(lambda (newsgroup)
- (cond ((string-match \"private\" newsgroup) 31)
- ((string-match \"junk\" newsgroup) 1)
+ (cond ((string-match \"private\" newsgroup) 31)
+ ((string-match \"junk\" newsgroup) 1)
((string-match \"important\" newsgroup) 'never)
(t 7))))"
:group 'nnmail-expire
@@ -176,13 +193,47 @@ called in a buffer narrowed to the message in question. The function
receives one argument, the name of the group the message comes from.
The return value should be `delete' or a group name (a string)."
:version "21.1"
- :group 'nnmail-expire
- :type '(choice (const delete)
- (function :format "%v" nnmail-)
- string))
+ :group 'nnmail-expire
+ :type '(choice (const delete)
+ (function :format "%v" nnmail-)
+ string))
+
+(defcustom nnmail-fancy-expiry-targets nil
+ "Determine expiry target based on articles using fancy techniques.
+
+This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If
+`nnmail-expiry-target' is set to the function
+`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
+the message will be expired to a group determined by invoking
+`format-time-string' with TARGET used as the format string and the
+time extracted from the articles' Date header (if missing the current
+time is used).
+
+In the special cases that HEADER is the symbol `to-from', the regexp
+will try to match against both the From and the To header.
+
+Example:
+
+\(setq nnmail-fancy-expiry-targets
+ '((to-from \"boss\" \"nnfolder:Work\")
+ (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
+ (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
+
+In this case, articles containing the string \"boss\" in the To or the
+From header will be expired to the group \"nnfolder:Work\";
+articles containing the sting \"IMPORTANT\" in the Subject header will
+be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
+everything else will be expired to \"nnfolder:Archive-YYYY\"."
+ :group 'nnmail-expire
+ :type '(repeat (list (choice :tag "Match against"
+ (string :tag "Header")
+ (const to-from))
+ regexp
+ (string :tag "Target group format string"))))
(defcustom nnmail-cache-accepted-message-ids nil
- "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
+ "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
+If non-nil, also update the cache when copy or move articles."
:group 'nnmail
:type 'boolean)
@@ -237,9 +288,9 @@ running (\"xwatch\", etc.)
Eg.
\(add-hook 'nnmail-read-incoming-hook
- (lambda ()
- (call-process \"/local/bin/mailsend\" nil nil nil
- \"read\" nnmail-spool-file)))
+ (lambda ()
+ (call-process \"/local/bin/mailsend\" nil nil nil
+ \"read\" nnmail-spool-file)))
If you have xwatch running, this will alert it that mail has been
read.
@@ -299,12 +350,82 @@ discarded after running the split process."
:group 'nnmail-split
:type 'hook)
+(defcustom nnmail-spool-hook nil
+ "*A hook called when a new article is spooled."
+ :group 'nnmail
+ :type 'hook)
+
(defcustom nnmail-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+ "*The number of articles which indicates a large newsgroup or nil.
+If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status."
:group 'nnmail-various
- :type 'integer)
+ :type '(choice (const :tag "infinite" nil)
+ (number :tag "count")))
+
+(define-widget 'nnmail-lazy 'default
+ "Base widget for recursive datastructures.
+
+This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility."
+ :format "%{%t%}: %v"
+ :convert-widget 'widget-value-convert-widget
+ :value-create (lambda (widget)
+ (let ((value (widget-get widget :value))
+ (type (widget-get widget :type)))
+ (widget-put widget :children
+ (list (widget-create-child-value
+ widget (widget-convert type) value)))))
+ :value-delete 'widget-children-value-delete
+ :value-get (lambda (widget)
+ (widget-value (car (widget-get widget :children))))
+ :value-inline (lambda (widget)
+ (widget-apply (car (widget-get widget :children))
+ :value-inline))
+ :default-get (lambda (widget)
+ (widget-default-get
+ (widget-convert (widget-get widget :type))))
+ :match (lambda (widget value)
+ (widget-apply (widget-convert (widget-get widget :type))
+ :match value))
+ :validate (lambda (widget)
+ (widget-apply (car (widget-get widget :children)) :validate)))
+
+(define-widget 'nnmail-split-fancy 'nnmail-lazy
+ "Widget for customizing splits in the variable of the same name."
+ :tag "Split"
+ :type '(menu-choice :value (any ".*value.*" "misc")
+ :tag "Type"
+ (string :tag "Destination")
+ (list :tag "Use first match (|)" :value (|)
+ (const :format "" |)
+ (editable-list :inline t nnmail-split-fancy))
+ (list :tag "Use all matches (&)" :value (&)
+ (const :format "" &)
+ (editable-list :inline t nnmail-split-fancy))
+ (list :tag "Function with fixed arguments (:)"
+ :value (: nil)
+ (const :format "" :value :)
+ function
+ (editable-list :inline t (sexp :tag "Arg"))
+ )
+ (list :tag "Function with split arguments (!)"
+ :value (! nil)
+ (const :format "" !)
+ function
+ (editable-list :inline t nnmail-split-fancy))
+ (list :tag "Field match"
+ (choice :tag "Field"
+ regexp symbol)
+ (choice :tag "Match"
+ regexp
+ (symbol :value mail))
+ (repeat :inline t
+ :tag "Restrictions"
+ (group :inline t
+ (const :format "" -)
+ regexp))
+ nnmail-split-fancy)
+ (const :tag "Junk (delete mail)" junk)))
(defcustom nnmail-split-fancy "mail.misc"
"Incoming mail can be split according to this fancy variable.
@@ -336,6 +457,12 @@ GROUP: Mail will be stored in GROUP (a string).
return value FUNCTION should be a split, which is then recursively
processed.
+junk: Mail will be deleted. Use with care! Do not submerge in water!
+ Example:
+ (setq nnmail-split-fancy
+ '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
+ ...other.rules.omitted...))
+
FIELD must match a complete field name. VALUE must match a complete
word according to the `nnmail-split-fancy-syntax-table' syntax table.
You can use \".*\" in the regexps to match partial field names or words.
@@ -363,20 +490,19 @@ Example:
;; Other mailing lists...
(any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
(any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
- ;; Both lists below have the same suffix, so prevent
- ;; cross-posting to mkpkg.list of messages posted only to
- ;; the bugs- list, but allow cross-posting when the
- ;; message was really cross-posted.
- (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
- (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
- ;;
+ ;; Both lists below have the same suffix, so prevent
+ ;; cross-posting to mkpkg.list of messages posted only to
+ ;; the bugs- list, but allow cross-posting when the
+ ;; message was really cross-posted.
+ (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
+ (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
+ ;;
;; People...
(any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
;; Unmatched mail goes to the catch all group.
\"misc.misc\"))"
:group 'nnmail-split
- ;; Sigh!
- :type 'sexp)
+ :type 'nnmail-split-fancy)
(defcustom nnmail-split-abbrev-alist
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
@@ -418,7 +544,7 @@ parameter. It should return nil, `warn' or `delete'."
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers nil
+(defcustom nnmail-extra-headers '(To Newsgroups)
"*Extra headers to parse."
:version "21.1"
:group 'nnmail
@@ -430,18 +556,46 @@ parameter. It should return nil, `warn' or `delete'."
:group 'nnmail
:type 'integer)
+(defcustom nnmail-mail-splitting-charset nil
+ "Default charset to be used when splitting incoming mail."
+ :group 'nnmail
+ :type 'symbol)
+
+(defcustom nnmail-mail-splitting-decodes nil
+ "Whether the nnmail splitting functionality should MIME decode headers."
+ :group 'nnmail
+ :type 'boolean)
+
+(defcustom nnmail-split-fancy-match-partial-words nil
+ "Whether to match partial words when fancy splitting.
+Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
+by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
+ surrounded
+by anything."
+ :group 'nnmail
+ :type 'boolean)
+
+(defcustom nnmail-split-lowercase-expanded t
+ "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
+This avoids the creation of multiple groups when users send to an address
+using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
+ :group 'nnmail
+ :type 'boolean)
+
;;; Internal variables.
+(defvar nnmail-article-buffer " *nnmail incoming*"
+ "The buffer used for splitting incoming mails.")
+
(defvar nnmail-split-history nil
"List of group/article elements that say where the previous split put messages.")
-(defvar nnmail-split-fancy-syntax-table nil
+(defvar nnmail-split-fancy-syntax-table
+ (let ((table (make-syntax-table)))
+ ;; support the %-hack
+ (modify-syntax-entry ?\% "." table)
+ table)
"Syntax table used by `nnmail-split-fancy'.")
-(unless (syntax-table-p nnmail-split-fancy-syntax-table)
- (setq nnmail-split-fancy-syntax-table
- (copy-syntax-table (standard-syntax-table)))
- ;; support the %-hack
- (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
(defvar nnmail-prepare-save-mail-hook nil
"Hook called before saving mail.")
@@ -451,11 +605,6 @@ parameter. It should return nil, `warn' or `delete'."
-(defconst nnmail-version "nnmail 1.0"
- "nnmail version.")
-
-
-
(defun nnmail-request-post (&optional server)
(mail-send-and-exit nil))
@@ -474,7 +623,7 @@ parameter. It should return nil, `warn' or `delete'."
(set-buffer nntp-server-buffer)
(delete-region (point-min) (point-max))
(let ((format-alist nil)
- (after-insert-file-functions nil))
+ (after-insert-file-functions nil))
(condition-case ()
(let ((coding-system-for-read nnmail-file-coding-system)
(auto-mode-alist (mm-auto-mode-alist))
@@ -529,8 +678,8 @@ nn*-request-list should have been called before calling this function."
(setq group (read buffer))
(unless (stringp group)
(setq group (symbol-name group)))
- (if (and (numberp (setq max (read nntp-server-buffer)))
- (numberp (setq min (read nntp-server-buffer))))
+ (if (and (numberp (setq max (read buffer)))
+ (numberp (setq min (read buffer))))
(push (list group (cons min max))
group-assoc)))
(error nil))
@@ -715,7 +864,9 @@ If SOURCE is a directory spec, try to return the group name component."
(if (not (and (re-search-forward "^From " nil t)
(goto-char (match-beginning 0))))
;; Possibly wrong format?
- (error "Error, unknown mail format! (Possibly corrupted.)")
+ (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
+ (if (buffer-file-name) "file" "buffer")
+ (or (buffer-file-name) (buffer-name)))
;; Carry on until the bitter end.
(while (not (eobp))
(setq start (point)
@@ -887,7 +1038,7 @@ If SOURCE is a directory spec, try to return the group name component."
group artnum-func)
"Go through the entire INCOMING file and pick out each individual mail.
FUNC will be called with the buffer narrowed to each mail."
- (let (;; If this is a group-specific split, we bind the split
+ (let ( ;; If this is a group-specific split, we bind the split
;; methods to just this group.
(nnmail-split-methods (if (and group
(not nnmail-resplit-incoming))
@@ -895,7 +1046,7 @@ FUNC will be called with the buffer narrowed to each mail."
nnmail-split-methods)))
(save-excursion
;; Insert the incoming file.
- (set-buffer (get-buffer-create " *nnmail incoming*"))
+ (set-buffer (get-buffer-create nnmail-article-buffer))
(erase-buffer)
(let ((coding-system-for-read nnmail-incoming-coding-system))
(mm-insert-file-contents incoming))
@@ -923,10 +1074,9 @@ FUNC will be called with the buffer narrowed to each mail."
(defun nnmail-article-group (func &optional trace)
"Look at the headers and return an alist of groups that match.
FUNC will be called with the group name to determine the article number."
- (let ((methods nnmail-split-methods)
+ (let ((methods (or nnmail-split-methods '(("bogus" ""))))
(obuf (current-buffer))
- (beg (point-min))
- end group-art method grp)
+ group-art method grp)
(if (and (sequencep methods)
(= (length methods) 1))
;; If there is only just one group to put everything in, we
@@ -935,13 +1085,21 @@ FUNC will be called with the group name to determine the article number."
(list (cons (caar methods) (funcall func (caar methods)))))
;; We do actual comparison.
(save-excursion
- ;; Find headers.
- (goto-char beg)
- (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
+ ;; Copy the article into the work buffer.
(set-buffer nntp-server-buffer)
(erase-buffer)
- ;; Copy the headers into the work buffer.
- (insert-buffer-substring obuf beg end)
+ (insert-buffer-substring obuf)
+ ;; Narrow to headers.
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (point)
+ (point-max)))
+ (goto-char (point-min))
+ ;; Decode MIME headers and charsets.
+ (when nnmail-mail-splitting-decodes
+ (let ((mail-parse-charset nnmail-mail-splitting-charset))
+ (mail-decode-encoded-word-region (point-min) (point-max))))
;; Fold continuation lines.
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
@@ -954,7 +1112,7 @@ FUNC will be called with the group name to determine the article number."
(while (not (eobp))
(unless (< (move-to-column nnmail-split-header-length-limit)
nnmail-split-header-length-limit)
- (delete-region (point) (progn (end-of-line) (point))))
+ (delete-region (point) (gnus-point-at-eol)))
(forward-line 1))
;; Allow washing.
(goto-char (point-min))
@@ -971,8 +1129,8 @@ FUNC will be called with the group name to determine the article number."
(or (funcall nnmail-split-methods)
'("bogus"))
(error
- (nnheader-message 5
- "Error in `nnmail-split-methods'; using `bogus' mail group")
+ (nnheader-message
+ 5 "Error in `nnmail-split-methods'; using `bogus' mail group")
(sit-for 1)
'("bogus")))))
(setq split (gnus-remove-duplicates split))
@@ -1017,19 +1175,22 @@ FUNC will be called with the group name to determine the article number."
(unless group-art
(setq group-art
(list (cons (car method)
- (funcall func (car method)))))))))
+ (funcall func (car method))))))))
+ ;; Fall back on "bogus" if all else fails.
+ (unless group-art
+ (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
;; Produce a trace if non-empty.
(when (and trace nnmail-split-trace)
- (let ((trace (nreverse nnmail-split-trace))
- (restore (current-buffer)))
+ (let ((restore (current-buffer)))
(nnheader-set-temp-buffer "*Split Trace*")
(gnus-add-buffer)
- (while trace
- (insert (car trace) "\n")
- (setq trace (cdr trace)))
+ (dolist (trace (nreverse nnmail-split-trace))
+ (prin1 trace (current-buffer))
+ (insert "\n"))
(goto-char (point-min))
(gnus-configure-windows 'split-trace)
(set-buffer restore)))
+ (widen)
;; See whether the split methods returned `junk'.
(if (equal group-art '(junk))
nil
@@ -1091,14 +1252,21 @@ Return the number of characters in the body."
(defun nnmail-remove-list-identifiers ()
"Remove list identifiers from Subject headers."
- (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
- (mapconcat 'identity nnmail-list-identifiers " *\\|"))))
+ (let ((regexp
+ (if (consp nnmail-list-identifiers)
+ (mapconcat 'identity nnmail-list-identifiers " *\\|")
+ nnmail-list-identifiers)))
(when regexp
(goto-char (point-min))
- (when (re-search-forward
- (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)")
- nil t)
- (delete-region (match-beginning 2) (match-end 0))))))
+ (while (re-search-forward
+ (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
+ nil t)
+ (delete-region (match-beginning 2) (match-end 0))
+ (beginning-of-line))
+ (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
+ nil t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (beginning-of-line)))))
(defun nnmail-remove-tabs ()
"Translate TAB characters into SPACE characters."
@@ -1113,17 +1281,39 @@ Return the number of characters in the body."
(beginning-of-line)
(insert "X-Gnus-Broken-Eudora-"))
(goto-char (point-min))
- (when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t)
- (replace-match "" t t nil 1))))
+ (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
+ (replace-match "\\1" t))))
(custom-add-option 'nnmail-prepare-incoming-header-hook
'nnmail-fix-eudora-headers)
;;; Utility functions
+(defun nnmail-do-request-post (accept-func &optional server)
+ "Utility function to directly post a message to an nnmail-derived group.
+Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
+to actually put the message in the right group."
+ (let ((success t))
+ (dolist (mbx (message-unquote-tokens
+ (message-tokenize-header
+ (message-fetch-field "Newsgroups") ", ")) success)
+ (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
+ (or (gnus-active to-newsgroup)
+ (gnus-activate-group to-newsgroup)
+ (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
+ to-newsgroup))
+ (or (and (gnus-request-create-group
+ to-newsgroup gnus-command-method)
+ (gnus-activate-group to-newsgroup nil nil
+ gnus-command-method))
+ (error "Couldn't create group %s" to-newsgroup)))
+ (error "No such group: %s" to-newsgroup))
+ (unless (funcall accept-func mbx (nth 1 gnus-command-method))
+ (setq success nil))))))
+
(defun nnmail-split-fancy ()
"Fancy splitting method.
-See the documentation for the variable `nnmail-split-fancy' for documentation."
+See the documentation for the variable `nnmail-split-fancy' for details."
(let ((syntab (syntax-table)))
(unwind-protect
(progn
@@ -1145,7 +1335,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
;; A group name. Do the \& and \N subs into the string.
((stringp split)
(when nnmail-split-tracing
- (push (format "\"%s\"" split) nnmail-split-trace))
+ (push split nnmail-split-trace))
(list (nnmail-expand-newtext split)))
;; Junk the message.
@@ -1168,6 +1358,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
;; Builtin : operation.
((eq (car split) ':)
+ (when nnmail-split-tracing
+ (push split nnmail-split-trace))
(nnmail-split-it (save-excursion (eval (cdr split)))))
;; Builtin ! operation.
@@ -1184,13 +1376,13 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(while (and (goto-char end-point)
(re-search-backward (cdr cached-pair) nil t))
(when nnmail-split-tracing
- (push (cdr cached-pair) nnmail-split-trace))
+ (push split nnmail-split-trace))
(let ((split-rest (cddr split))
(end (match-end 0))
- ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So,
- ;; start-of-value is the point just before the
- ;; beginning of the value, whereas after-header-name is
- ;; the point just after the field name.
+ ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
+ ;; So, start-of-value is the point just before the
+ ;; beginning of the value, whereas after-header-name
+ ;; is the point just after the field name.
(start-of-value (match-end 1))
(after-header-name (match-end 2)))
;; Start the next search just before the beginning of the
@@ -1218,7 +1410,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
;; correct match positions.
(re-search-backward value start-of-value))
(dolist (sp (nnmail-split-it (car split-rest)))
- (unless (memq sp split-result)
+ (unless (member sp split-result)
(push sp split-result))))))
split-result))
@@ -1226,25 +1418,36 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(t
(let* ((field (nth 0 split))
(value (nth 1 split))
- partial regexp)
+ partial-front
+ partial-rear
+ regexp)
(if (symbolp value)
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
(if (and (>= (length value) 2)
(string= ".*" (substring value 0 2)))
(setq value (substring value 2)
- partial ""))
+ partial-front ""))
+ ;; Same trick for the rear of the regexp
+ (if (and (>= (length value) 2)
+ (string= ".*" (substring value -2)))
+ (setq value (substring value 0 -2)
+ partial-rear ""))
+ (when nnmail-split-fancy-match-partial-words
+ (setq partial-front ""
+ partial-rear ""))
(setq regexp (concat "^\\(\\("
(if (symbolp field)
(cdr (assq field nnmail-split-abbrev-alist))
field)
"\\):.*\\)"
- (or partial "\\<")
+ (or partial-front "\\<")
"\\("
value
- "\\)\\>"))
+ "\\)"
+ (or partial-rear "\\>")))
(push (cons split regexp) nnmail-split-cache)
;; Now that it's in the cache, just call nnmail-split-it again
- ;; on the same split, which will find it immediately in the cache.
+ ;; on the same split, which will find it immediately in the cache.
(nnmail-split-it split))))))
(defun nnmail-expand-newtext (newtext)
@@ -1273,7 +1476,10 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(setq N 0)
(setq N (- c ?0)))
(when (match-beginning N)
- (push (buffer-substring (match-beginning N) (match-end N))
+ (push (if nnmail-split-lowercase-expanded
+ (downcase (buffer-substring (match-beginning N)
+ (match-end N)))
+ (buffer-substring (match-beginning N) (match-end N)))
expanded))))
(setq pos (1+ pos)))
(if did-expand
@@ -1329,6 +1535,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(set-buffer
(setq nnmail-cache-buffer
(get-buffer-create " *nnmail message-id cache*")))
+ (gnus-add-buffer)
(when (file-exists-p nnmail-message-id-cache-file)
(nnheader-insert-file-contents nnmail-message-id-cache-file))
(set-buffer-modified-p nil)
@@ -1355,52 +1562,54 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
nnmail-message-id-cache-file nil 'silent)
(set-buffer-modified-p nil)
(setq nnmail-cache-buffer nil)
- (kill-buffer (current-buffer)))))
+ (gnus-kill-buffer (current-buffer)))))
;; Compiler directives.
(defvar group)
(defvar group-art-list)
(defvar group-art)
-(defun nnmail-cache-insert (id)
- (when nnmail-treat-duplicates
- ;; Store some information about the group this message is written
- ;; to. This function might have been called from various places.
- ;; Sometimes, a function up in the calling sequence has an
- ;; argument GROUP which is bound to a string, the group name. At
- ;; other times, there is a function up in the calling sequence
- ;; which has an argument GROUP-ART which is a list of pairs, and
- ;; the car of a pair is a group name. Should we check that the
- ;; length of the list is equal to 1? -- kai
- (let ((g nil))
- (cond ((and (boundp 'group) group)
- (setq g group))
- ((and (boundp 'group-art-list) group-art-list
- (listp group-art-list))
- (setq g (caar group-art-list)))
- ((and (boundp 'group-art) group-art (listp group-art))
- (setq g (caar group-art)))
- (t (setq g "")))
+(defun nnmail-cache-insert (id grp &optional subject sender)
+ (when (stringp id)
+ ;; this will handle cases like `B r' where the group is nil
+ (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
+ (run-hook-with-args 'nnmail-spool-hook
+ id grp subject sender))
+ (when nnmail-treat-duplicates
+ ;; Store some information about the group this message is written
+ ;; to. This is passed in as the grp argument -- all locations this
+ ;; has been called from have been checked and the group is available.
+ ;; The only ambiguous case is nnmail-check-duplication which will only
+ ;; pass the first (of possibly >1) group which matches. -Josh
(unless (gnus-buffer-live-p nnmail-cache-buffer)
- (nnmail-cache-open))
+ (nnmail-cache-open))
(save-excursion
- (set-buffer nnmail-cache-buffer)
- (goto-char (point-max))
- (if (and g (not (string= "" g))
- (gnus-methods-equal-p gnus-command-method
- (nnmail-cache-primary-mail-backend)))
- (insert id "\t" g "\n")
- (insert id "\n"))))))
-
+ (set-buffer nnmail-cache-buffer)
+ (goto-char (point-max))
+ (if (and grp (not (string= "" grp))
+ (gnus-methods-equal-p gnus-command-method
+ (nnmail-cache-primary-mail-backend)))
+ (let ((regexp (if (consp nnmail-cache-ignore-groups)
+ (mapconcat 'identity nnmail-cache-ignore-groups
+ "\\|")
+ nnmail-cache-ignore-groups)))
+ (unless (and regexp (string-match regexp grp))
+ (insert id "\t" grp "\n")))
+ (insert id "\n"))))))
+
(defun nnmail-cache-primary-mail-backend ()
(let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
- (be nil)
- (res nil))
+ (be nil)
+ (res nil)
+ (get-new-mail nil))
(while (and (null res) be-list)
(setq be (car be-list))
(setq be-list (cdr be-list))
(when (and (gnus-method-option-p be 'respool)
- (eval (intern (format "%s-get-new-mail" (car be)))))
- (setq res be)))
+ (setq get-new-mail
+ (intern (format "%s-get-new-mail" (car be))))
+ (boundp get-new-mail)
+ (symbol-value get-new-mail))
+ (setq res be)))
res))
;; Fetch the group name corresponding to the message id stored in the
@@ -1411,29 +1620,44 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(set-buffer nnmail-cache-buffer)
(goto-char (point-max))
(when (search-backward id nil t)
- (beginning-of-line)
- (skip-chars-forward "^\n\r\t")
- (unless (eolp)
- (forward-char 1)
- (buffer-substring (point)
- (progn (end-of-line) (point))))))))
+ (beginning-of-line)
+ (skip-chars-forward "^\n\r\t")
+ (unless (looking-at "[\r\n]")
+ (forward-char 1)
+ (buffer-substring (point) (gnus-point-at-eol)))))))
;; Function for nnmail-split-fancy: look up all references in the
;; cache and if a match is found, return that group.
(defun nnmail-split-fancy-with-parent ()
+ "Split this message into the same group as its parent.
+This function can be used as an entry in `nnmail-split-fancy', for
+example like this: (: nnmail-split-fancy-with-parent)
+For a message to be split, it looks for the parent message in the
+References or In-Reply-To header and then looks in the message id
+cache file (given by the variable `nnmail-message-id-cache-file') to
+see which group that message was put in. This group is returned.
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
(let* ((refstr (or (message-fetch-field "references")
- (message-fetch-field "in-reply-to")))
- (references nil)
- (res nil))
+ (message-fetch-field "in-reply-to")))
+ (references nil)
+ (res nil)
+ (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
+ (mapconcat
+ (lambda (x) (format "\\(%s\\)" x))
+ nnmail-split-fancy-with-parent-ignore-groups
+ "\\|")
+ nnmail-split-fancy-with-parent-ignore-groups)))
(when refstr
(setq references (nreverse (gnus-split-references refstr)))
(unless (gnus-buffer-live-p nnmail-cache-buffer)
- (nnmail-cache-open))
+ (nnmail-cache-open))
(mapcar (lambda (x)
- (setq res (or (nnmail-cache-fetch-group x) res))
- (when (string= "drafts" res)
- (setq res nil)))
- references)
+ (setq res (or (nnmail-cache-fetch-group x) res))
+ (when (or (member res '("delayed" "drafts" "queue"))
+ (and regexp res (string-match regexp res)))
+ (setq res nil)))
+ references)
res)))
(defun nnmail-cache-id-exists-p (id)
@@ -1458,7 +1682,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(cond
((memq nnmail-treat-duplicates '(warn delete))
nnmail-treat-duplicates)
- ((nnheader-functionp nnmail-treat-duplicates)
+ ((functionp nnmail-treat-duplicates)
(funcall nnmail-treat-duplicates message-id))
(t
nnmail-treat-duplicates))))
@@ -1475,7 +1699,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
((not duplication)
(funcall func (setq group-art
(nreverse (nnmail-article-group artnum-func))))
- (nnmail-cache-insert message-id))
+ (nnmail-cache-insert message-id (caar group-art)))
((eq action 'delete)
(setq group-art nil))
((eq action 'warn)
@@ -1542,12 +1766,11 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(setq source (append source
(list
:predicate
- `(lambda (file)
- (string-match
- ,(concat
- (regexp-quote (concat group suffix))
- "$")
- file)))))))
+ (gnus-byte-compile
+ `(lambda (file)
+ (string-equal
+ ,(concat group suffix)
+ (file-name-nondirectory file)))))))))
(when nnmail-fetched-sources
(if (member source nnmail-fetched-sources)
(setq source nil)
@@ -1568,14 +1791,15 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(when (setq new
(mail-source-fetch
source
- `(lambda (file orig-file)
- (nnmail-split-incoming
- file ',(intern (format "%s-save-mail" method))
- ',spool-func
- (if (equal file orig-file)
- nil
- (nnmail-get-split-group orig-file ',source))
- ',(intern (format "%s-active-number" method))))))
+ (gnus-byte-compile
+ `(lambda (file orig-file)
+ (nnmail-split-incoming
+ file ',(intern (format "%s-save-mail" method))
+ ',spool-func
+ (if (equal file orig-file)
+ nil
+ (nnmail-get-split-group orig-file ',source))
+ ',(intern (format "%s-active-number" method)))))))
(incf total new)
(incf i)))
;; If we did indeed read any incoming spools, we save all info.
@@ -1611,7 +1835,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
;; We expire all articles on sight.
t)
((equal time '(0 0))
- ;; This is an ange-ftp group, and we don't have any dates.
+ ;; This is an ange-ftp group, and we don't have any dates.
nil)
((numberp days)
(setq days (days-to-time days))
@@ -1619,10 +1843,46 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
(ignore-errors (time-less-p days (time-since time))))))))
(defun nnmail-expiry-target-group (target group)
- (when (nnheader-functionp target)
- (setq target (funcall target group)))
- (unless (eq target 'delete)
- (gnus-request-accept-article target nil nil t)))
+ ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears
+ ;; that buffer if the nnfolder group isn't selected.
+ (let (nnmail-cache-accepted-message-ids)
+ ;; Don't enter Message-IDs into cache.
+ ;; Let users hack it in TARGET function.
+ (when (functionp target)
+ (setq target (funcall target group)))
+ (unless (eq target 'delete)
+ (when (or (gnus-request-group target)
+ (gnus-request-create-group target))
+ (let ((group-art (gnus-request-accept-article target nil nil t)))
+ (when (consp group-art)
+ (gnus-group-mark-article-read target (cdr group-art))))))))
+
+(defun nnmail-fancy-expiry-target (group)
+ "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
+ (let* (header
+ (case-fold-search nil)
+ (from (or (message-fetch-field "from") ""))
+ (to (or (message-fetch-field "to") ""))
+ (date (date-to-time
+ (or (message-fetch-field "date") (current-time-string))))
+ (target 'delete))
+ (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
+ (setq header (car regexp-target-pair))
+ (cond
+ ;; If the header is to-from then match against the
+ ;; To or From header
+ ((and (equal header 'to-from)
+ (or (string-match (cadr regexp-target-pair) from)
+ (and (string-match message-dont-reply-to-names from)
+ (string-match (cadr regexp-target-pair) to))))
+ (setq target (format-time-string (caddr regexp-target-pair) date)))
+ ((and (not (equal header 'to-from))
+ (string-match (cadr regexp-target-pair)
+ (or
+ (message-fetch-field header)
+ "")))
+ (setq target
+ (format-time-string (caddr regexp-target-pair) date)))))))
(defun nnmail-check-syntax ()
"Check (and modify) the syntax of the message in the current buffer."
@@ -1719,7 +1979,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
"Remove all instances of GROUP from `nnmail-split-history'."
(let ((history nnmail-split-history))
(while history
- (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
+ (setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
(car history)))
(pop history))
(setq nnmail-split-history (delq nil nnmail-split-history))))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
new file mode 100644
index 00000000000..25cbbc8db48
--- /dev/null
+++ b/lisp/gnus/nnmaildir.el
@@ -0,0 +1,1627 @@
+;;; nnmaildir.el --- maildir backend for Gnus
+;; Public domain.
+
+;; Author: Paul Jarc <prj@po.cwru.edu>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
+;; and in the maildir(5) man page from qmail (available at
+;; <URL:http://www.qmail.org/man/man5/maildir.html>). nnmaildir also stores
+;; extra information in the .nnmaildir/ directory within a maildir.
+;;
+;; Some goals of nnmaildir:
+;; * Everything Just Works, and correctly. E.g., NOV data is automatically
+;; regenerated when stale; no need for manually running
+;; *-generate-nov-databases.
+;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
+;; SIGKILL will never corrupt its data in the filesystem.
+;; * Allow concurrent operation as much as possible. If files change out
+;; from under us, adapt to the changes or degrade gracefully.
+;; * We use the filesystem as a database, so that, e.g., it's easy to
+;; manipulate marks from outside Gnus.
+;; * All information about a group is stored in the maildir, for easy backup,
+;; copying, restoring, etc.
+;;
+;; Todo:
+;; * Add a hook for when moving messages from new/ to cur/, to support
+;; nnmail's duplicate detection.
+;; * Improve generated Xrefs, so crossposts are detectable.
+;; * Improve code readability.
+
+;;; Code:
+
+;; eval this before editing
+[(progn
+ (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
+ (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
+ )
+]
+
+(eval-and-compile
+ (require 'nnheader)
+ (require 'gnus)
+ (require 'gnus-util)
+ (require 'gnus-range)
+ (require 'gnus-start)
+ (require 'gnus-int)
+ (require 'message))
+(eval-when-compile
+ (require 'cl)
+ (require 'nnmail))
+
+(defconst nnmaildir-version "Gnus")
+
+(defvar nnmaildir-article-file-name nil
+ "*The filename of the most recently requested article. This variable is set
+by nnmaildir-request-article.")
+
+;; The filename of the article being moved/copied:
+(defvar nnmaildir--file nil)
+
+;; Variables to generate filenames of messages being delivered:
+(defvar nnmaildir--delivery-time "")
+(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
+(defvar nnmaildir--delivery-count nil)
+
+;; An obarry containing symbols whose names are server names and whose values
+;; are servers:
+(defvar nnmaildir--servers (make-vector 3 0))
+;; The current server:
+(defvar nnmaildir--cur-server nil)
+
+;; A copy of nnmail-extra-headers
+(defvar nnmaildir--extra nil)
+
+;; A NOV structure looks like this (must be prin1-able, so no defstruct):
+["subject\tfrom\tdate"
+ "references\tchars\lines"
+ "To: you\tIn-Reply-To: <your.mess@ge>"
+ (12345 67890) ;; modtime of the corresponding article file
+ (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
+(defconst nnmaildir--novlen 5)
+(defmacro nnmaildir--nov-new (beg mid end mtime extra)
+ `(vector ,beg ,mid ,end ,mtime ,extra))
+(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
+(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
+(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
+(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
+(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
+(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value))
+(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value))
+(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value))
+(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
+(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
+
+(defstruct nnmaildir--art
+ (prefix nil :type string) ;; "time.pid.host"
+ (suffix nil :type string) ;; ":2,flags"
+ (num nil :type natnum) ;; article number
+ (msgid nil :type string) ;; "<mess.age@id>"
+ (nov nil :type vector)) ;; cached nov structure, or nil
+
+(defstruct nnmaildir--grp
+ (name nil :type string) ;; "group.name"
+ (new nil :type list) ;; new/ modtime
+ (cur nil :type list) ;; cur/ modtime
+ (min 1 :type natnum) ;; minimum article number
+ (count 0 :type natnum) ;; count of articles
+ (nlist nil :type list) ;; list of articles, ordered descending by number
+ (flist nil :type vector) ;; obarray mapping filename prefix->article
+ (mlist nil :type vector) ;; obarray mapping message-id->article
+ (cache nil :type vector) ;; nov cache
+ (index nil :type natnum) ;; index of next cache entry to replace
+ (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
+ ; ("Mark Mod Time Hash")
+
+(defstruct nnmaildir--srv
+ (address nil :type string) ;; server address string
+ (method nil :type list) ;; (nnmaildir "address" ...)
+ (prefix nil :type string) ;; "nnmaildir+address:"
+ (dir nil :type string) ;; "/expanded/path/to/server/dir/"
+ (ls nil :type function) ;; directory-files function
+ (groups nil :type vector) ;; obarray mapping group name->group
+ (curgrp nil :type nnmaildir--grp) ;; current group, or nil
+ (error nil :type string) ;; last error message, or nil
+ (mtime nil :type list) ;; modtime of dir
+ (gnm nil) ;; flag: split from mail-sources?
+ (target-prefix nil :type string)) ;; symlink target prefix
+
+(defun nnmaildir--expired-article (group article)
+ (setf (nnmaildir--art-nov article) nil)
+ (let ((flist (nnmaildir--grp-flist group))
+ (mlist (nnmaildir--grp-mlist group))
+ (min (nnmaildir--grp-min group))
+ (count (1- (nnmaildir--grp-count group)))
+ (prefix (nnmaildir--art-prefix article))
+ (msgid (nnmaildir--art-msgid article))
+ (new-nlist nil)
+ (nlist-pre '(nil . nil))
+ nlist-post num)
+ (unless (zerop count)
+ (setq nlist-post (nnmaildir--grp-nlist group)
+ num (nnmaildir--art-num article))
+ (if (eq num (caar nlist-post))
+ (setq new-nlist (cdr nlist-post))
+ (setq new-nlist nlist-post
+ nlist-pre nlist-post
+ nlist-post (cdr nlist-post))
+ (while (/= num (caar nlist-post))
+ (setq nlist-pre nlist-post
+ nlist-post (cdr nlist-post)))
+ (setq nlist-post (cdr nlist-post))
+ (if (eq num min)
+ (setq min (caar nlist-pre)))))
+ (let ((inhibit-quit t))
+ (setf (nnmaildir--grp-min group) min)
+ (setf (nnmaildir--grp-count group) count)
+ (setf (nnmaildir--grp-nlist group) new-nlist)
+ (setcdr nlist-pre nlist-post)
+ (unintern prefix flist)
+ (unintern msgid mlist))))
+
+(defun nnmaildir--nlist-art (group num)
+ (let ((entry (assq num (nnmaildir--grp-nlist group))))
+ (if entry
+ (cdr entry))))
+(defmacro nnmaildir--flist-art (list file)
+ `(symbol-value (intern-soft ,file ,list)))
+(defmacro nnmaildir--mlist-art (list msgid)
+ `(symbol-value (intern-soft ,msgid ,list)))
+
+(defun nnmaildir--pgname (server gname)
+ (let ((prefix (nnmaildir--srv-prefix server)))
+ (if prefix (concat prefix gname)
+ (setq gname (gnus-group-prefixed-name gname
+ (nnmaildir--srv-method server)))
+ (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
+ gname)))
+
+(defun nnmaildir--param (pgname param)
+ (setq param (gnus-group-find-parameter pgname param 'allow-list))
+ (if (vectorp param) (setq param (aref param 0)))
+ (eval param))
+
+(defmacro nnmaildir--with-nntp-buffer (&rest body)
+ `(save-excursion
+ (set-buffer nntp-server-buffer)
+ ,@body))
+(defmacro nnmaildir--with-work-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir work*"))
+ ,@body))
+(defmacro nnmaildir--with-nov-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir nov*"))
+ ,@body))
+(defmacro nnmaildir--with-move-buffer (&rest body)
+ `(save-excursion
+ (set-buffer (get-buffer-create " *nnmaildir move*"))
+ ,@body))
+
+(defmacro nnmaildir--subdir (dir subdir)
+ `(file-name-as-directory (concat ,dir ,subdir)))
+(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
+ `(nnmaildir--subdir ,srv-dir ,gname))
+(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
+(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
+(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
+(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
+(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
+(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
+(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
+(defmacro nnmaildir--num-file (dir) `(concat ,dir ":"))
+
+(defmacro nnmaildir--unlink (file-arg)
+ `(let ((file ,file-arg))
+ (if (file-attributes file) (delete-file file))))
+(defun nnmaildir--mkdir (dir)
+ (or (file-exists-p (file-name-as-directory dir))
+ (make-directory-internal (directory-file-name dir))))
+(defun nnmaildir--delete-dir-files (dir ls)
+ (when (file-attributes dir)
+ (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
+ (delete-directory dir)))
+
+(defun nnmaildir--group-maxnum (server group)
+ (if (zerop (nnmaildir--grp-count group)) 0
+ (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
+ (nnmaildir--grp-name group))))
+ (setq x (nnmaildir--nndir x)
+ x (nnmaildir--num-dir x)
+ x (nnmaildir--num-file x)
+ x (file-attributes x))
+ (if x (1- (nth 1 x)) 0))))
+
+;; Make the given server, if non-nil, be the current server. Then make the
+;; given group, if non-nil, be the current group of the current server. Then
+;; return the group object for the current group.
+(defun nnmaildir--prepare (server group)
+ (let (x groups)
+ (catch 'return
+ (if (null server)
+ (unless (setq server nnmaildir--cur-server)
+ (throw 'return nil))
+ (unless (setq server (intern-soft server nnmaildir--servers))
+ (throw 'return nil))
+ (setq server (symbol-value server)
+ nnmaildir--cur-server server))
+ (unless (setq groups (nnmaildir--srv-groups server))
+ (throw 'return nil))
+ (unless (nnmaildir--srv-method server)
+ (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
+ x (gnus-server-to-method x))
+ (unless x (throw 'return nil))
+ (setf (nnmaildir--srv-method server) x))
+ (if (null group)
+ (unless (setq group (nnmaildir--srv-curgrp server))
+ (throw 'return nil))
+ (unless (setq group (intern-soft group groups))
+ (throw 'return nil))
+ (setq group (symbol-value group)))
+ group)))
+
+(defun nnmaildir--tab-to-space (string)
+ (let ((pos 0))
+ (while (string-match "\t" string pos)
+ (aset string (match-beginning 0) ? )
+ (setq pos (match-end 0))))
+ string)
+
+(defun nnmaildir--update-nov (server group article)
+ (let ((nnheader-file-coding-system 'binary)
+ (srv-dir (nnmaildir--srv-dir server))
+ (storage-version 1) ;; [version article-number msgid [...nov...]]
+ dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
+ nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
+ deactivate-mark)
+ (catch 'return
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname server gname)
+ dir (nnmaildir--srvgrp-dir srv-dir gname)
+ msgdir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir))
+ prefix (nnmaildir--art-prefix article)
+ suffix (nnmaildir--art-suffix article)
+ file (concat msgdir prefix suffix)
+ attr (file-attributes file))
+ (unless attr
+ (nnmaildir--expired-article group article)
+ (throw 'return nil))
+ (setq mtime (nth 5 attr)
+ attr (nth 7 attr)
+ nov (nnmaildir--art-nov article)
+ dir (nnmaildir--nndir dir)
+ novdir (nnmaildir--nov-dir dir)
+ novfile (concat novdir prefix))
+ (unless (equal nnmaildir--extra nnmail-extra-headers)
+ (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
+ (nnmaildir--with-nov-buffer
+ ;; First we'll check for already-parsed NOV data.
+ (cond ((not (file-exists-p novfile))
+ ;; The NOV file doesn't exist; we have to parse the message.
+ (setq nov nil))
+ ((not nov)
+ ;; The file exists, but the data isn't in memory; read the file.
+ (erase-buffer)
+ (nnheader-insert-file-contents novfile)
+ (setq nov (read (current-buffer)))
+ (if (not (and (vectorp nov)
+ (/= 0 (length nov))
+ (equal storage-version (aref nov 0))))
+ ;; This NOV data seems to be in the wrong format.
+ (setq nov nil)
+ (unless (nnmaildir--art-num article)
+ (setf (nnmaildir--art-num article) (aref nov 1)))
+ (unless (nnmaildir--art-msgid article)
+ (setf (nnmaildir--art-msgid article) (aref nov 2)))
+ (setq nov (aref nov 3)))))
+ ;; Now check whether the already-parsed data (if we have any) is
+ ;; usable: if the message has been edited or if nnmail-extra-headers
+ ;; has been augmented since this data was parsed from the message,
+ ;; then we have to reparse. Otherwise it's up-to-date.
+ (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov)))
+ ;; The timestamp matches. Now check nnmail-extra-headers.
+ (setq old-extra (nnmaildir--nov-get-extra nov))
+ (when (equal nnmaildir--extra old-extra) ;; common case
+ ;; Save memory; use a single copy of the list value.
+ (nnmaildir--nov-set-extra nov nnmaildir--extra)
+ (throw 'return nov))
+ ;; They're not equal, but maybe the new is a subset of the old.
+ (if (null nnmaildir--extra)
+ ;; The empty set is a subset of every set.
+ (throw 'return nov))
+ (if (not (memq nil (mapcar (lambda (e) (memq e old-extra))
+ nnmaildir--extra)))
+ (throw 'return nov)))
+ ;; Parse the NOV data out of the message.
+ (erase-buffer)
+ (nnheader-insert-file-contents file)
+ (insert "\n")
+ (goto-char (point-min))
+ (save-restriction
+ (if (search-forward "\n\n" nil 'noerror)
+ (progn
+ (setq nov-mid (count-lines (point) (point-max)))
+ (narrow-to-region (point-min) (1- (point))))
+ (setq nov-mid 0))
+ (goto-char (point-min))
+ (delete-char 1)
+ (setq nov (nnheader-parse-naked-head)
+ field (or (mail-header-lines nov) 0)))
+ (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
+ (setq nov-mid field))
+ (setq nov-mid (number-to-string nov-mid)
+ nov-mid (concat (number-to-string attr) "\t" nov-mid))
+ (save-match-data
+ (setq field (or (mail-header-references nov) ""))
+ (nnmaildir--tab-to-space field)
+ (setq nov-mid (concat field "\t" nov-mid)
+ nov-beg (mapconcat
+ (lambda (f) (nnmaildir--tab-to-space (or f "")))
+ (list (mail-header-subject nov)
+ (mail-header-from nov)
+ (mail-header-date nov)) "\t")
+ nov-end (mapconcat
+ (lambda (extra)
+ (setq field (symbol-name (car extra))
+ val (cdr extra))
+ (nnmaildir--tab-to-space field)
+ (nnmaildir--tab-to-space val)
+ (concat field ": " val))
+ (mail-header-extra nov) "\t")))
+ (setq msgid (mail-header-id nov))
+ (if (or (null msgid) (nnheader-fake-message-id-p msgid))
+ (setq msgid (concat "<" prefix "@nnmaildir>")))
+ (nnmaildir--tab-to-space msgid)
+ ;; The data is parsed; create an nnmaildir NOV structure.
+ (setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime
+ nnmaildir--extra)
+ num (nnmaildir--art-num article))
+ (unless num
+ ;; Allocate a new article number.
+ (erase-buffer)
+ (setq numdir (nnmaildir--num-dir dir)
+ file (nnmaildir--num-file numdir)
+ num -1)
+ (nnmaildir--mkdir numdir)
+ (write-region "" nil file nil 'no-message)
+ (while file
+ ;; Get the number of links to file.
+ (setq attr (nth 1 (file-attributes file)))
+ (if (= attr num)
+ ;; We've already tried this number, in the previous loop
+ ;; iteration, and failed.
+ (signal 'error `("Corrupt internal nnmaildir data" ,numdir)))
+ ;; If attr is 123, try to link file to "123". This atomically
+ ;; increases the link count and creates the "123" link, failing
+ ;; if that link was already created by another Gnus, just after
+ ;; we stat()ed file.
+ (condition-case nil
+ (progn
+ (add-name-to-file file (concat numdir (format "%x" attr)))
+ (setq file nil)) ;; Stop looping.
+ (file-already-exists nil))
+ (setq num attr))
+ (setf (nnmaildir--art-num article) num))
+ ;; Store this new NOV data in a file
+ (erase-buffer)
+ (prin1 (vector storage-version num msgid nov) (current-buffer))
+ (setq file (concat novfile ":"))
+ (nnmaildir--unlink file)
+ (write-region (point-min) (point-max) file nil 'no-message nil 'excl))
+ (rename-file file novfile 'replace)
+ (setf (nnmaildir--art-msgid article) msgid)
+ nov)))
+
+(defun nnmaildir--cache-nov (group article nov)
+ (let ((cache (nnmaildir--grp-cache group))
+ (index (nnmaildir--grp-index group))
+ goner)
+ (unless (nnmaildir--art-nov article)
+ (setq goner (aref cache index))
+ (if goner (setf (nnmaildir--art-nov goner) nil))
+ (aset cache index article)
+ (setf (nnmaildir--grp-index group) (% (1+ index) (length cache))))
+ (setf (nnmaildir--art-nov article) nov)))
+
+(defun nnmaildir--grp-add-art (server group article)
+ (let ((nov (nnmaildir--update-nov server group article))
+ count num min nlist nlist-cdr insert-nlist)
+ (when nov
+ (setq count (1+ (nnmaildir--grp-count group))
+ num (nnmaildir--art-num article)
+ min (if (= count 1) num
+ (min num (nnmaildir--grp-min group)))
+ nlist (nnmaildir--grp-nlist group))
+ (if (or (null nlist) (> num (caar nlist)))
+ (setq nlist (cons (cons num article) nlist))
+ (setq insert-nlist t
+ nlist-cdr (cdr nlist))
+ (while (and nlist-cdr (< num (caar nlist-cdr)))
+ (setq nlist nlist-cdr
+ nlist-cdr (cdr nlist))))
+ (let ((inhibit-quit t))
+ (setf (nnmaildir--grp-count group) count)
+ (setf (nnmaildir--grp-min group) min)
+ (if insert-nlist
+ (setcdr nlist (cons (cons num article) nlist-cdr))
+ (setf (nnmaildir--grp-nlist group) nlist))
+ (set (intern (nnmaildir--art-prefix article)
+ (nnmaildir--grp-flist group))
+ article)
+ (set (intern (nnmaildir--art-msgid article)
+ (nnmaildir--grp-mlist group))
+ article)
+ (set (intern (nnmaildir--grp-name group)
+ (nnmaildir--srv-groups server))
+ group))
+ (nnmaildir--cache-nov group article nov)
+ t)))
+
+(defun nnmaildir--group-ls (server pgname)
+ (or (nnmaildir--param pgname 'directory-files)
+ (nnmaildir--srv-ls server)))
+
+(defun nnmaildir-article-number-to-file-name
+ (number group-name server-address-string)
+ (let ((group (nnmaildir--prepare server-address-string group-name))
+ article dir pgname)
+ (catch 'return
+ (unless group
+ ;; The given group or server does not exist.
+ (throw 'return nil))
+ (setq article (nnmaildir--nlist-art group number))
+ (unless article
+ ;; The given article number does not exist in this group.
+ (throw 'return nil))
+ (setq pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir group-name)
+ dir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir)))
+ (concat dir (nnmaildir--art-prefix article)
+ (nnmaildir--art-suffix article)))))
+
+(defun nnmaildir-article-number-to-base-name
+ (number group-name server-address-string)
+ (let ((x (nnmaildir--prepare server-address-string group-name)))
+ (when x
+ (setq x (nnmaildir--nlist-art x number))
+ (and x (cons (nnmaildir--art-prefix x)
+ (nnmaildir--art-suffix x))))))
+
+(defun nnmaildir-base-name-to-article-number
+ (base-name group-name server-address-string)
+ (let ((x (nnmaildir--prepare server-address-string group-name)))
+ (when x
+ (setq x (nnmaildir--grp-flist x)
+ x (nnmaildir--flist-art x base-name))
+ (and x (nnmaildir--art-num x)))))
+
+(defun nnmaildir--nlist-iterate (nlist ranges func)
+ (let (entry high low nlist2)
+ (if (eq ranges 'all)
+ (setq ranges `((1 . ,(caar nlist)))))
+ (while ranges
+ (setq entry (car ranges) ranges (cdr ranges))
+ (while (and ranges (eq entry (car ranges)))
+ (setq ranges (cdr ranges))) ;; skip duplicates
+ (if (numberp entry)
+ (setq low entry
+ high entry)
+ (setq low (car entry)
+ high (cdr entry)))
+ (setq nlist2 nlist) ;; Don't assume any sorting of ranges
+ (catch 'iterate-loop
+ (while nlist2
+ (if (<= (caar nlist2) high) (throw 'iterate-loop nil))
+ (setq nlist2 (cdr nlist2))))
+ (catch 'iterate-loop
+ (while nlist2
+ (setq entry (car nlist2) nlist2 (cdr nlist2))
+ (if (< (car entry) low) (throw 'iterate-loop nil))
+ (funcall func (cdr entry)))))))
+
+(defun nnmaildir--up2-1 (n)
+ (if (zerop n) 1 (1- (lsh 1 (1+ (logb n))))))
+
+(defun nnmaildir--system-name ()
+ (gnus-replace-in-string
+ (gnus-replace-in-string
+ (gnus-replace-in-string
+ (system-name)
+ "\\\\" "\\134" 'literal)
+ "/" "\\057" 'literal)
+ ":" "\\072" 'literal))
+
+(defun nnmaildir-request-type (group &optional article)
+ 'mail)
+
+(defun nnmaildir-status-message (&optional server)
+ (nnmaildir--prepare server nil)
+ (nnmaildir--srv-error nnmaildir--cur-server))
+
+(defun nnmaildir-server-opened (&optional server)
+ (and nnmaildir--cur-server
+ (if server
+ (string-equal server (nnmaildir--srv-address nnmaildir--cur-server))
+ t)
+ (nnmaildir--srv-groups nnmaildir--cur-server)
+ t))
+
+(defun nnmaildir-open-server (server &optional defs)
+ (let ((x server)
+ dir size)
+ (catch 'return
+ (setq server (intern-soft x nnmaildir--servers))
+ (if server
+ (and (setq server (symbol-value server))
+ (nnmaildir--srv-groups server)
+ (setq nnmaildir--cur-server server)
+ (throw 'return t))
+ (setq server (make-nnmaildir--srv :address x))
+ (let ((inhibit-quit t))
+ (set (intern x nnmaildir--servers) server)))
+ (setq dir (assq 'directory defs))
+ (unless dir
+ (setf (nnmaildir--srv-error server)
+ "You must set \"directory\" in the select method")
+ (throw 'return nil))
+ (setq dir (cadr dir)
+ dir (eval dir)
+ dir (expand-file-name dir)
+ dir (file-name-as-directory dir))
+ (unless (file-exists-p dir)
+ (setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
+ (throw 'return nil))
+ (setf (nnmaildir--srv-dir server) dir)
+ (setq x (assq 'directory-files defs))
+ (if (null x)
+ (setq x (if nnheader-directory-files-is-safe 'directory-files
+ 'nnheader-directory-files-safe))
+ (setq x (cadr x))
+ (unless (functionp x)
+ (setf (nnmaildir--srv-error server)
+ (concat "Not a function: " (prin1-to-string x)))
+ (throw 'return nil)))
+ (setf (nnmaildir--srv-ls server) x)
+ (setq size (length (funcall x dir nil "\\`[^.]" 'nosort))
+ size (nnmaildir--up2-1 size))
+ (and (setq x (assq 'get-new-mail defs))
+ (setq x (cdr x))
+ (car x)
+ (setf (nnmaildir--srv-gnm server) t)
+ (require 'nnmail))
+ (setq x (assq 'target-prefix defs))
+ (if x
+ (progn
+ (setq x (cadr x)
+ x (eval x))
+ (setf (nnmaildir--srv-target-prefix server) x))
+ (setq x (assq 'create-directory defs))
+ (if x
+ (progn
+ (setq x (cadr x)
+ x (eval x)
+ x (file-name-as-directory x))
+ (setf (nnmaildir--srv-target-prefix server) x))
+ (setf (nnmaildir--srv-target-prefix server) "")))
+ (setf (nnmaildir--srv-groups server) (make-vector size 0))
+ (setq nnmaildir--cur-server server)
+ t)))
+
+(defun nnmaildir--parse-filename (file)
+ (let ((prefix (car file))
+ timestamp len)
+ (if (string-match "\\`\\([0-9]+\\)\\(\\..*\\)\\'" prefix)
+ (progn
+ (setq timestamp (concat "0000" (match-string 1 prefix))
+ len (- (length timestamp) 4))
+ (vector (string-to-number (substring timestamp 0 len))
+ (string-to-number (substring timestamp len))
+ (match-string 2 prefix)
+ file))
+ file)))
+
+(defun nnmaildir--sort-files (a b)
+ (catch 'return
+ (if (consp a)
+ (throw 'return (and (consp b) (string-lessp (car a) (car b)))))
+ (if (consp b) (throw 'return t))
+ (if (< (aref a 0) (aref b 0)) (throw 'return t))
+ (if (> (aref a 0) (aref b 0)) (throw 'return nil))
+ (if (< (aref a 1) (aref b 1)) (throw 'return t))
+ (if (> (aref a 1) (aref b 1)) (throw 'return nil))
+ (string-lessp (aref a 2) (aref b 2))))
+
+(defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls)
+ (catch 'return
+ (let ((36h-ago (- (car (current-time)) 2))
+ absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
+ files num dir flist group x)
+ (setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
+ nndir (nnmaildir--nndir absdir))
+ (unless (file-exists-p absdir)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such directory: " absdir))
+ (throw 'return nil))
+ (setq tdir (nnmaildir--tmp absdir)
+ ndir (nnmaildir--new absdir)
+ cdir (nnmaildir--cur absdir)
+ nattr (file-attributes ndir)
+ cattr (file-attributes cdir))
+ (unless (and (file-exists-p tdir) nattr cattr)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Not a maildir: " absdir))
+ (throw 'return nil))
+ (setq group (nnmaildir--prepare nil gname)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname))
+ (if group
+ (setq isnew nil)
+ (setq isnew t
+ group (make-nnmaildir--grp :name gname :index 0))
+ (nnmaildir--mkdir nndir)
+ (nnmaildir--mkdir (nnmaildir--nov-dir nndir))
+ (nnmaildir--mkdir (nnmaildir--marks-dir nndir))
+ (write-region "" nil (concat nndir "markfile") nil 'no-message))
+ (setq read-only (nnmaildir--param pgname 'read-only)
+ ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
+ (unless read-only
+ (setq x (nth 11 (file-attributes tdir)))
+ (unless (and (= x (nth 11 nattr)) (= x (nth 11 cattr)))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Maildir spans filesystems: " absdir))
+ (throw 'return nil))
+ (mapcar
+ (lambda (file)
+ (setq x (file-attributes file))
+ (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago))
+ (delete-file file)))
+ (funcall ls tdir 'full "\\`[^.]" 'nosort)))
+ (or scan-msgs
+ isnew
+ (throw 'return t))
+ (setq nattr (nth 5 nattr))
+ (if (equal nattr (nnmaildir--grp-new group))
+ (setq nattr nil))
+ (if read-only (setq dir (and (or isnew nattr) ndir))
+ (when (or isnew nattr)
+ (mapcar
+ (lambda (file)
+ (let ((path (concat ndir file)))
+ (and (time-less-p (nth 5 (file-attributes path)) (current-time))
+ (rename-file path (concat cdir file ":2,")))))
+ (funcall ls ndir nil "\\`[^.]" 'nosort))
+ (setf (nnmaildir--grp-new group) nattr))
+ (setq cattr (nth 5 (file-attributes cdir)))
+ (if (equal cattr (nnmaildir--grp-cur group))
+ (setq cattr nil))
+ (setq dir (and (or isnew cattr) cdir)))
+ (unless dir (throw 'return t))
+ (setq files (funcall ls dir nil "\\`[^.]" 'nosort)
+ files (save-match-data
+ (mapcar
+ (lambda (f)
+ (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" f)
+ (cons (match-string 1 f) (match-string 2 f)))
+ files)))
+ (when isnew
+ (setq num (nnmaildir--up2-1 (length files)))
+ (setf (nnmaildir--grp-flist group) (make-vector num 0))
+ (setf (nnmaildir--grp-mlist group) (make-vector num 0))
+ (setf (nnmaildir--grp-mmth group) (make-vector 1 0))
+ (setq num (nnmaildir--param pgname 'nov-cache-size))
+ (if (numberp num) (if (< num 1) (setq num 1))
+ (setq num 16
+ cdir (nnmaildir--marks-dir nndir)
+ ndir (nnmaildir--subdir cdir "tick")
+ cdir (nnmaildir--subdir cdir "read"))
+ (mapcar
+ (lambda (file)
+ (setq file (car file))
+ (if (or (not (file-exists-p (concat cdir file)))
+ (file-exists-p (concat ndir file)))
+ (setq num (1+ num))))
+ files))
+ (setf (nnmaildir--grp-cache group) (make-vector num nil))
+ (let ((inhibit-quit t))
+ (set (intern gname groups) group))
+ (or scan-msgs (throw 'return t)))
+ (setq flist (nnmaildir--grp-flist group)
+ files (mapcar
+ (lambda (file)
+ (and (null (nnmaildir--flist-art flist (car file)))
+ file))
+ files)
+ files (delq nil files)
+ files (mapcar 'nnmaildir--parse-filename files)
+ files (sort files 'nnmaildir--sort-files))
+ (mapcar
+ (lambda (file)
+ (setq file (if (consp file) file (aref file 3))
+ x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
+ (nnmaildir--grp-add-art nnmaildir--cur-server group x))
+ files)
+ (if read-only (setf (nnmaildir--grp-new group) nattr)
+ (setf (nnmaildir--grp-cur group) cattr)))
+ t))
+
+(defun nnmaildir-request-scan (&optional scan-group server)
+ (let ((coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ (nnmaildir-get-new-mail t)
+ (nnmaildir-group-alist nil)
+ (nnmaildir-active-file nil)
+ x srv-ls srv-dir method groups target-prefix group dirs grp-dir seen
+ deactivate-mark)
+ (nnmaildir--prepare server nil)
+ (setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server)
+ srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ method (nnmaildir--srv-method nnmaildir--cur-server)
+ groups (nnmaildir--srv-groups nnmaildir--cur-server)
+ target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
+ (nnmaildir--with-work-buffer
+ (save-match-data
+ (if (stringp scan-group)
+ (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls)
+ (if (nnmaildir--srv-gnm nnmaildir--cur-server)
+ (nnmail-get-new-mail 'nnmaildir nil nil scan-group))
+ (unintern scan-group groups))
+ (setq x (nth 5 (file-attributes srv-dir))
+ scan-group (null scan-group))
+ (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server))
+ (if scan-group
+ (mapatoms (lambda (sym)
+ (nnmaildir--scan (symbol-name sym) t groups
+ method srv-dir srv-ls))
+ groups))
+ (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
+ dirs (if (zerop (length target-prefix))
+ dirs
+ (gnus-remove-if
+ (lambda (dir)
+ (and (>= (length dir) (length target-prefix))
+ (string= (substring dir 0
+ (length target-prefix))
+ target-prefix)))
+ dirs))
+ seen (nnmaildir--up2-1 (length dirs))
+ seen (make-vector seen 0))
+ (mapcar
+ (lambda (grp-dir)
+ (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
+ srv-ls)
+ (intern grp-dir seen)))
+ dirs)
+ (setq x nil)
+ (mapatoms (lambda (group)
+ (setq group (symbol-name group))
+ (unless (intern-soft group seen)
+ (setq x (cons group x))))
+ groups)
+ (mapcar (lambda (grp) (unintern grp groups)) x)
+ (setf (nnmaildir--srv-mtime nnmaildir--cur-server)
+ (nth 5 (file-attributes srv-dir))))
+ (and scan-group
+ (nnmaildir--srv-gnm nnmaildir--cur-server)
+ (nnmail-get-new-mail 'nnmaildir nil nil))))))
+ t)
+
+(defun nnmaildir-request-list (&optional server)
+ (nnmaildir-request-scan 'find-new-groups server)
+ (let (pgname ro deactivate-mark)
+ (nnmaildir--prepare server nil)
+ (nnmaildir--with-nntp-buffer
+ (erase-buffer)
+ (mapatoms (lambda (group)
+ (setq pgname (symbol-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server pgname)
+ group (symbol-value group)
+ ro (nnmaildir--param pgname 'read-only))
+ (insert (nnmaildir--grp-name group) " ")
+ (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+ nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--grp-min group) nntp-server-buffer)
+ (insert " " (if ro "n" "y") "\n"))
+ (nnmaildir--srv-groups nnmaildir--cur-server))))
+ t)
+
+(defun nnmaildir-request-newgroups (date &optional server)
+ (nnmaildir-request-list server))
+
+(defun nnmaildir-retrieve-groups (groups &optional server)
+ (let (group deactivate-mark)
+ (nnmaildir--prepare server nil)
+ (nnmaildir--with-nntp-buffer
+ (erase-buffer)
+ (mapcar
+ (lambda (gname)
+ (setq group (nnmaildir--prepare nil gname))
+ (if (null group) (insert "411 no such news group\n")
+ (insert "211 ")
+ (princ (nnmaildir--grp-count group) nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--grp-min group) nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+ nntp-server-buffer)
+ (insert " " gname "\n")))
+ groups)))
+ 'group)
+
+(defun nnmaildir-request-update-info (gname info &optional server)
+ (let ((group (nnmaildir--prepare server gname))
+ pgname flist always-marks never-marks old-marks dotfile num dir
+ markdirs marks mark ranges markdir article read end new-marks ls
+ old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ flist (nnmaildir--grp-flist group))
+ (when (zerop (nnmaildir--grp-count group))
+ (gnus-info-set-read info nil)
+ (gnus-info-set-marks info nil 'extend)
+ (throw 'return info))
+ (setq old-marks (cons 'read (gnus-info-read info))
+ old-marks (cons old-marks (gnus-info-marks info))
+ always-marks (nnmaildir--param pgname 'always-marks)
+ never-marks (nnmaildir--param pgname 'never-marks)
+ existing (nnmaildir--grp-nlist group)
+ existing (mapcar 'car existing)
+ existing (nreverse existing)
+ existing (gnus-compress-sequence existing 'always-list)
+ missing (list (cons 1 (nnmaildir--group-maxnum
+ nnmaildir--cur-server group)))
+ missing (gnus-range-difference missing existing)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ dir (nnmaildir--nndir dir)
+ dir (nnmaildir--marks-dir dir)
+ ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+ markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
+ new-mmth (nnmaildir--up2-1 (length markdirs))
+ new-mmth (make-vector new-mmth 0)
+ old-mmth (nnmaildir--grp-mmth group))
+ (mapcar
+ (lambda (mark)
+ (setq markdir (nnmaildir--subdir dir mark)
+ mark-sym (intern mark)
+ ranges nil)
+ (catch 'got-ranges
+ (if (memq mark-sym never-marks) (throw 'got-ranges nil))
+ (when (memq mark-sym always-marks)
+ (setq ranges existing)
+ (throw 'got-ranges nil))
+ (setq mtime (nth 5 (file-attributes markdir)))
+ (set (intern mark new-mmth) mtime)
+ (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
+ (setq ranges (assq mark-sym old-marks))
+ (if ranges (setq ranges (cdr ranges)))
+ (throw 'got-ranges nil))
+ (mapcar
+ (lambda (prefix)
+ (setq article (nnmaildir--flist-art flist prefix))
+ (if article
+ (setq ranges
+ (gnus-add-to-range ranges
+ `(,(nnmaildir--art-num article))))))
+ (funcall ls markdir nil "\\`[^.]" 'nosort)))
+ (if (eq mark-sym 'read) (setq read ranges)
+ (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
+ markdirs)
+ (gnus-info-set-read info (gnus-range-add read missing))
+ (gnus-info-set-marks info marks 'extend)
+ (setf (nnmaildir--grp-mmth group) new-mmth)
+ info)))
+
+(defun nnmaildir-request-group (gname &optional server fast)
+ (let ((group (nnmaildir--prepare server gname))
+ deactivate-mark)
+ (catch 'return
+ (unless group
+ ;; (insert "411 no such news group\n")
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group)
+ (if fast (throw 'return t))
+ (nnmaildir--with-nntp-buffer
+ (erase-buffer)
+ (insert "211 ")
+ (princ (nnmaildir--grp-count group) nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--grp-min group) nntp-server-buffer)
+ (insert " ")
+ (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
+ nntp-server-buffer)
+ (insert " " gname "\n")
+ t))))
+
+(defun nnmaildir-request-create-group (gname &optional server args)
+ (nnmaildir--prepare server nil)
+ (catch 'return
+ (let ((target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
+ srv-dir dir groups)
+ (when (zerop (length gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Invalid (empty) group name")
+ (throw 'return nil))
+ (when (eq (aref "." 0) (aref gname 0))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Group names may not start with \".\"")
+ (throw 'return nil))
+ (when (save-match-data (string-match "[\0/\t]" gname))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Illegal characters (null, tab, or /) in group name: "
+ gname))
+ (throw 'return nil))
+ (setq groups (nnmaildir--srv-groups nnmaildir--cur-server))
+ (when (intern-soft gname groups)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Group already exists: " gname))
+ (throw 'return nil))
+ (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
+ (if (file-name-absolute-p target-prefix)
+ (setq dir (expand-file-name target-prefix))
+ (setq dir srv-dir
+ dir (file-truename dir)
+ dir (concat dir target-prefix)))
+ (setq dir (nnmaildir--subdir dir gname))
+ (nnmaildir--mkdir dir)
+ (nnmaildir--mkdir (nnmaildir--tmp dir))
+ (nnmaildir--mkdir (nnmaildir--new dir))
+ (nnmaildir--mkdir (nnmaildir--cur dir))
+ (unless (string= target-prefix "")
+ (make-symbolic-link (concat target-prefix gname)
+ (concat srv-dir gname)))
+ (nnmaildir-request-scan 'find-new-groups))))
+
+(defun nnmaildir-request-rename-group (gname new-name &optional server)
+ (let ((group (nnmaildir--prepare server gname))
+ (coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ srv-dir x groups)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (when (zerop (length new-name))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Invalid (empty) group name")
+ (throw 'return nil))
+ (when (eq (aref "." 0) (aref new-name 0))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Group names may not start with \".\"")
+ (throw 'return nil))
+ (when (save-match-data (string-match "[\0/\t]" new-name))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Illegal characters (null, tab, or /) in group name: "
+ new-name))
+ (throw 'return nil))
+ (if (string-equal gname new-name) (throw 'return t))
+ (when (intern-soft new-name
+ (nnmaildir--srv-groups nnmaildir--cur-server))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Group already exists: " new-name))
+ (throw 'return nil))
+ (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
+ (condition-case err
+ (rename-file (concat srv-dir gname)
+ (concat srv-dir new-name))
+ (error
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Error renaming link: " (prin1-to-string err)))
+ (throw 'return nil)))
+ (setq x (nnmaildir--srv-groups nnmaildir--cur-server)
+ groups (make-vector (length x) 0))
+ (mapatoms (lambda (sym)
+ (unless (eq (symbol-value sym) group)
+ (set (intern (symbol-name sym) groups)
+ (symbol-value sym))))
+ x)
+ (setq group (copy-sequence group))
+ (setf (nnmaildir--grp-name group) new-name)
+ (set (intern new-name groups) group)
+ (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups)
+ t)))
+
+(defun nnmaildir-request-delete-group (gname force &optional server)
+ (let ((group (nnmaildir--prepare server gname))
+ pgname grp-dir target dir ls deactivate-mark)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ grp-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ target (car (file-attributes (concat grp-dir gname)))
+ grp-dir (nnmaildir--srvgrp-dir grp-dir gname))
+ (unless (or force (stringp target))
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Not a symlink: " gname))
+ (throw 'return nil))
+ (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server))
+ (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil))
+ (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server))
+ (if (not force)
+ (progn
+ (setq grp-dir (directory-file-name grp-dir))
+ (nnmaildir--unlink grp-dir))
+ (setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname))
+ (if (nnmaildir--param pgname 'read-only)
+ (progn (delete-directory (nnmaildir--tmp grp-dir))
+ (nnmaildir--unlink (nnmaildir--new grp-dir))
+ (delete-directory (nnmaildir--cur grp-dir)))
+ (nnmaildir--delete-dir-files (nnmaildir--tmp grp-dir) ls)
+ (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls)
+ (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls))
+ (setq dir (nnmaildir--nndir grp-dir))
+ (mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls))
+ `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir)
+ ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
+ 'nosort)))
+ (setq dir (nnmaildir--nndir grp-dir))
+ (nnmaildir--unlink (concat dir "markfile"))
+ (nnmaildir--unlink (concat dir "markfile{new}"))
+ (delete-directory (nnmaildir--marks-dir dir))
+ (delete-directory dir)
+ (if (not (stringp target))
+ (delete-directory grp-dir)
+ (setq grp-dir (directory-file-name grp-dir)
+ dir target)
+ (unless (eq (aref "/" 0) (aref dir 0))
+ (setq dir (concat (file-truename
+ (nnmaildir--srv-dir nnmaildir--cur-server))
+ dir)))
+ (delete-directory dir)
+ (nnmaildir--unlink grp-dir)))
+ t)))
+
+(defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
+ (let ((group (nnmaildir--prepare server gname))
+ srv-dir dir nlist mlist article num start stop nov nlist2 insert-nov
+ deactivate-mark)
+ (setq insert-nov
+ (lambda (article)
+ (setq nov (nnmaildir--update-nov nnmaildir--cur-server group
+ article))
+ (when nov
+ (nnmaildir--cache-nov group article nov)
+ (setq num (nnmaildir--art-num article))
+ (princ num nntp-server-buffer)
+ (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
+ (nnmaildir--art-msgid article) "\t"
+ (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir "
+ gname ":")
+ (princ num nntp-server-buffer)
+ (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (if gname (concat "No such group: " gname) "No current group"))
+ (throw 'return nil))
+ (nnmaildir--with-nntp-buffer
+ (erase-buffer)
+ (setq mlist (nnmaildir--grp-mlist group)
+ nlist (nnmaildir--grp-nlist group)
+ gname (nnmaildir--grp-name group)
+ srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir srv-dir gname))
+ (cond
+ ((null nlist))
+ ((and fetch-old (not (numberp fetch-old)))
+ (nnmaildir--nlist-iterate nlist 'all insert-nov))
+ ((null articles))
+ ((stringp (car articles))
+ (mapcar
+ (lambda (msgid)
+ (setq article (nnmaildir--mlist-art mlist msgid))
+ (if article (funcall insert-nov article)))
+ articles))
+ (t
+ (if fetch-old
+ ;; Assume the article range list is sorted ascending
+ (setq stop (car articles)
+ start (car (last articles))
+ stop (if (numberp stop) stop (car stop))
+ start (if (numberp start) start (cdr start))
+ stop (- stop fetch-old)
+ stop (if (< stop 1) 1 stop)
+ articles (list (cons stop start))))
+ (nnmaildir--nlist-iterate nlist articles insert-nov)))
+ (sort-numeric-fields 1 (point-min) (point-max))
+ 'nov))))
+
+(defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
+ (let ((group (nnmaildir--prepare server gname))
+ (case-fold-search t)
+ list article dir pgname deactivate-mark)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (if gname (concat "No such group: " gname) "No current group"))
+ (throw 'return nil))
+ (if (numberp num-msgid)
+ (setq article (nnmaildir--nlist-art group num-msgid))
+ (setq list (nnmaildir--grp-mlist group)
+ article (nnmaildir--mlist-art list num-msgid))
+ (if article (setq num-msgid (nnmaildir--art-num article))
+ (catch 'found
+ (mapatoms
+ (lambda (group-sym)
+ (setq group (symbol-value group-sym)
+ list (nnmaildir--grp-mlist group)
+ article (nnmaildir--mlist-art list num-msgid))
+ (when article
+ (setq num-msgid (nnmaildir--art-num article))
+ (throw 'found nil)))
+ (nnmaildir--srv-groups nnmaildir--cur-server))))
+ (unless article
+ (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
+ (throw 'return nil)))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ dir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir))
+ nnmaildir-article-file-name
+ (concat dir
+ (nnmaildir--art-prefix article)
+ (nnmaildir--art-suffix article)))
+ (unless (file-exists-p nnmaildir-article-file-name)
+ (nnmaildir--expired-article group article)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Article has expired")
+ (throw 'return nil))
+ (save-excursion
+ (set-buffer (or to-buffer nntp-server-buffer))
+ (erase-buffer)
+ (nnheader-insert-file-contents nnmaildir-article-file-name))
+ (cons gname num-msgid))))
+
+(defun nnmaildir-request-post (&optional server)
+ (let (message-required-mail-headers)
+ (funcall message-send-mail-function)))
+
+(defun nnmaildir-request-replace-article (number gname buffer)
+ (let ((group (nnmaildir--prepare nil gname))
+ (coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ dir file article suffix tmpfile deactivate-mark)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
+ 'read-only)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Read-only group: " group))
+ (throw 'return nil))
+ (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ article (nnmaildir--nlist-art group number))
+ (unless article
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such article: " (number-to-string number)))
+ (throw 'return nil))
+ (setq suffix (nnmaildir--art-suffix article)
+ file (nnmaildir--art-prefix article)
+ tmpfile (concat (nnmaildir--tmp dir) file))
+ (when (file-exists-p tmpfile)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " tmpfile))
+ (throw 'return nil))
+ (save-excursion
+ (set-buffer buffer)
+ (write-region (point-min) (point-max) tmpfile nil 'no-message nil
+ 'excl))
+ (unix-sync) ;; no fsync :(
+ (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace)
+ t)))
+
+(defun nnmaildir-request-move-article (article gname server accept-form
+ &optional last)
+ (let ((group (nnmaildir--prepare server gname))
+ pgname suffix result nnmaildir--file deactivate-mark)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ article (nnmaildir--nlist-art group article))
+ (unless article
+ (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
+ (throw 'return nil))
+ (setq suffix (nnmaildir--art-suffix article)
+ nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+ nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
+ nnmaildir--file (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new nnmaildir--file)
+ (nnmaildir--cur nnmaildir--file))
+ nnmaildir--file (concat nnmaildir--file
+ (nnmaildir--art-prefix article)
+ suffix))
+ (unless (file-exists-p nnmaildir--file)
+ (nnmaildir--expired-article group article)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ "Article has expired")
+ (throw 'return nil))
+ (nnmaildir--with-move-buffer
+ (erase-buffer)
+ (nnheader-insert-file-contents nnmaildir--file)
+ (setq result (eval accept-form)))
+ (unless (or (null result) (nnmaildir--param pgname 'read-only))
+ (nnmaildir--unlink nnmaildir--file)
+ (nnmaildir--expired-article group article))
+ result)))
+
+(defun nnmaildir-request-accept-article (gname &optional server last)
+ (let ((group (nnmaildir--prepare server gname))
+ (coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ srv-dir dir file time tmpfile curfile 24h article)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (throw 'return nil))
+ (setq gname (nnmaildir--grp-name group))
+ (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
+ 'read-only)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Read-only group: " gname))
+ (throw 'return nil))
+ (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir srv-dir gname)
+ time (current-time)
+ file (format-time-string "%s." time))
+ (unless (string-equal nnmaildir--delivery-time file)
+ (setq nnmaildir--delivery-time file
+ nnmaildir--delivery-count 0))
+ (when (and (consp (cdr time))
+ (consp (cddr time)))
+ (setq file (concat file "M" (number-to-string (caddr time)))))
+ (setq file (concat file nnmaildir--delivery-pid)
+ file (concat file "Q" (number-to-string nnmaildir--delivery-count))
+ file (concat file "." (nnmaildir--system-name))
+ tmpfile (concat (nnmaildir--tmp dir) file)
+ curfile (concat (nnmaildir--cur dir) file ":2,"))
+ (when (file-exists-p tmpfile)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " tmpfile))
+ (throw 'return nil))
+ (when (file-exists-p curfile)
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "File exists: " curfile))
+ (throw 'return nil))
+ (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count)
+ 24h (run-with-timer 86400 nil
+ (lambda ()
+ (nnmaildir--unlink tmpfile)
+ (setf (nnmaildir--srv-error
+ nnmaildir--cur-server)
+ "24-hour timer expired")
+ (throw 'return nil))))
+ (condition-case nil
+ (add-name-to-file nnmaildir--file tmpfile)
+ (error
+ (write-region (point-min) (point-max) tmpfile nil 'no-message nil
+ 'excl)
+ (unix-sync))) ;; no fsync :(
+ (cancel-timer 24h)
+ (condition-case err
+ (add-name-to-file tmpfile curfile)
+ (error
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "Error linking: " (prin1-to-string err)))
+ (nnmaildir--unlink tmpfile)
+ (throw 'return nil)))
+ (nnmaildir--unlink tmpfile)
+ (setq article (make-nnmaildir--art :prefix file :suffix ":2,"))
+ (if (nnmaildir--grp-add-art nnmaildir--cur-server group article)
+ (cons gname (nnmaildir--art-num article))))))
+
+(defun nnmaildir-save-mail (group-art)
+ (catch 'return
+ (unless group-art
+ (throw 'return nil))
+ (let (ga gname x groups nnmaildir--file deactivate-mark)
+ (save-excursion
+ (goto-char (point-min))
+ (save-match-data
+ (while (looking-at "From ")
+ (replace-match "X-From-Line: ")
+ (forward-line 1))))
+ (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)
+ ga (car group-art) group-art (cdr group-art)
+ gname (car ga))
+ (or (intern-soft gname groups)
+ (nnmaildir-request-create-group gname)
+ (throw 'return nil)) ;; not that nnmail bothers to check :(
+ (unless (nnmaildir-request-accept-article gname)
+ (throw 'return nil))
+ (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
+ nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
+ x (nnmaildir--prepare nil gname)
+ x (nnmaildir--grp-nlist x)
+ x (cdar x)
+ nnmaildir--file (concat nnmaildir--file
+ (nnmaildir--art-prefix x)
+ (nnmaildir--art-suffix x)))
+ (delq nil
+ (mapcar
+ (lambda (ga)
+ (setq gname (car ga))
+ (and (or (intern-soft gname groups)
+ (nnmaildir-request-create-group gname))
+ (nnmaildir-request-accept-article gname)
+ ga))
+ group-art)))))
+
+(defun nnmaildir-active-number (gname)
+ 0)
+
+(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
+ (let ((no-force (not force))
+ (group (nnmaildir--prepare server gname))
+ pgname time boundary bound-iter high low target dir nlist nlist2
+ stop article didnt nnmaildir--file nnmaildir-article-file-name
+ deactivate-mark)
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (if gname (concat "No such group: " gname) "No current group"))
+ (throw 'return (gnus-uncompress-range ranges)))
+ (setq gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname))
+ (if (nnmaildir--param pgname 'read-only)
+ (throw 'return (gnus-uncompress-range ranges)))
+ (setq time (nnmaildir--param pgname 'expire-age))
+ (unless time
+ (setq time (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function gname))
+ nnmail-expiry-wait))
+ (if (eq time 'immediate)
+ (setq time 0)
+ (if (numberp time)
+ (setq time (* time 86400)))))
+ (when no-force
+ (unless (integerp time) ;; handle 'never
+ (throw 'return (gnus-uncompress-range ranges)))
+ (setq boundary (current-time)
+ high (- (car boundary) (/ time 65536))
+ low (- (cadr boundary) (% time 65536)))
+ (if (< low 0)
+ (setq low (+ low 65536)
+ high (1- high)))
+ (setcar (cdr boundary) low)
+ (setcar boundary high))
+ (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ dir (nnmaildir--cur dir)
+ nlist (nnmaildir--grp-nlist group)
+ ranges (reverse ranges))
+ (nnmaildir--with-move-buffer
+ (nnmaildir--nlist-iterate
+ nlist ranges
+ (lambda (article)
+ (setq nnmaildir--file (nnmaildir--art-prefix article)
+ nnmaildir--file (concat dir nnmaildir--file
+ (nnmaildir--art-suffix article))
+ time (file-attributes nnmaildir--file))
+ (cond
+ ((null time)
+ (nnmaildir--expired-article group article))
+ ((and no-force
+ (progn
+ (setq time (nth 5 time)
+ bound-iter boundary)
+ (while (and bound-iter time
+ (= (car bound-iter) (car time)))
+ (setq bound-iter (cdr bound-iter)
+ time (cdr time)))
+ (and bound-iter time
+ (car-less-than-car bound-iter time))))
+ (setq didnt (cons (nnmaildir--art-num article) didnt)))
+ (t
+ (setq nnmaildir-article-file-name nnmaildir--file
+ target (if force nil
+ (save-excursion
+ (save-restriction
+ (nnmaildir--param pgname 'expire-group)))))
+ (when (and (stringp target)
+ (not (string-equal target pgname))) ;; Move it.
+ (erase-buffer)
+ (nnheader-insert-file-contents nnmaildir--file)
+ (gnus-request-accept-article target nil nil 'no-encode))
+ (if (equal target pgname)
+ ;; Leave it here.
+ (setq didnt (cons (nnmaildir--art-num article) didnt))
+ (nnmaildir--unlink nnmaildir--file)
+ (nnmaildir--expired-article group article))))))
+ (erase-buffer))
+ didnt)))
+
+(defun nnmaildir-request-set-mark (gname actions &optional server)
+ (let ((group (nnmaildir--prepare server gname))
+ (coding-system-for-write nnheader-file-coding-system)
+ (buffer-file-coding-system nil)
+ (file-coding-system-alist nil)
+ del-mark del-action add-action set-action marksdir markfile nlist
+ ranges begin end article all-marks todo-marks did-marks mdir mfile
+ pgname ls permarkfile deactivate-mark)
+ (setq del-mark
+ (lambda (mark)
+ (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
+ mfile (concat mfile (nnmaildir--art-prefix article)))
+ (nnmaildir--unlink mfile))
+ del-action (lambda (article) (mapcar del-mark todo-marks))
+ add-action
+ (lambda (article)
+ (mapcar
+ (lambda (mark)
+ (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
+ permarkfile (concat mdir ":")
+ mfile (concat mdir (nnmaildir--art-prefix article)))
+ (unless (memq mark did-marks)
+ (setq did-marks (cons mark did-marks))
+ (nnmaildir--mkdir mdir)
+ (unless (file-attributes permarkfile)
+ (condition-case nil
+ (add-name-to-file markfile permarkfile)
+ (file-error
+ ;; AFS can't make hard links in separate directories
+ (write-region "" nil permarkfile nil 'no-message)))))
+ (unless (file-exists-p mfile)
+ (add-name-to-file permarkfile mfile)))
+ todo-marks))
+ set-action (lambda (article)
+ (funcall add-action)
+ (mapcar (lambda (mark)
+ (unless (memq mark todo-marks)
+ (funcall del-mark mark)))
+ all-marks)))
+ (catch 'return
+ (unless group
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ (mapcar (lambda (action)
+ (setq ranges (gnus-range-add ranges (car action))))
+ actions)
+ (throw 'return ranges))
+ (setq nlist (nnmaildir--grp-nlist group)
+ marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
+ marksdir (nnmaildir--srvgrp-dir marksdir gname)
+ marksdir (nnmaildir--nndir marksdir)
+ markfile (concat marksdir "markfile")
+ marksdir (nnmaildir--marks-dir marksdir)
+ gname (nnmaildir--grp-name group)
+ pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+ all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
+ all-marks (mapcar 'intern all-marks))
+ (mapcar
+ (lambda (action)
+ (setq ranges (car action)
+ todo-marks (caddr action))
+ (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks)
+ (if (numberp (cdr ranges)) (setq ranges (list ranges)))
+ (nnmaildir--nlist-iterate nlist ranges
+ (cond ((eq 'del (cadr action)) del-action)
+ ((eq 'add (cadr action)) add-action)
+ (t set-action))))
+ actions)
+ nil)))
+
+(defun nnmaildir-close-group (gname &optional server)
+ (let ((group (nnmaildir--prepare server gname))
+ pgname ls dir msgdir files flist dirs)
+ (if (null group)
+ (progn
+ (setf (nnmaildir--srv-error nnmaildir--cur-server)
+ (concat "No such group: " gname))
+ nil)
+ (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
+ ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
+ dir (nnmaildir--srv-dir nnmaildir--cur-server)
+ dir (nnmaildir--srvgrp-dir dir gname)
+ msgdir (if (nnmaildir--param pgname 'read-only)
+ (nnmaildir--new dir) (nnmaildir--cur dir))
+ dir (nnmaildir--nndir dir)
+ dirs (cons (nnmaildir--nov-dir dir)
+ (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
+ 'nosort))
+ dirs (mapcar
+ (lambda (dir)
+ (cons dir (funcall ls dir nil "\\`[^.]" 'nosort)))
+ dirs)
+ files (funcall ls msgdir nil "\\`[^.]" 'nosort)
+ flist (nnmaildir--up2-1 (length files))
+ flist (make-vector flist 0))
+ (save-match-data
+ (mapcar
+ (lambda (file)
+ (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
+ (intern (match-string 1 file) flist))
+ files))
+ (mapcar
+ (lambda (dir)
+ (setq files (cdr dir)
+ dir (file-name-as-directory (car dir)))
+ (mapcar
+ (lambda (file)
+ (unless (or (intern-soft file flist) (string= file ":"))
+ (setq file (concat dir file))
+ (delete-file file)))
+ files))
+ dirs)
+ t)))
+
+(defun nnmaildir-close-server (&optional server)
+ (let (flist ls dirs dir files file x)
+ (nnmaildir--prepare server nil)
+ (when nnmaildir--cur-server
+ (setq server nnmaildir--cur-server
+ nnmaildir--cur-server nil)
+ (unintern (nnmaildir--srv-address server) nnmaildir--servers)))
+ t)
+
+(defun nnmaildir-request-close ()
+ (let (servers buffer)
+ (mapatoms (lambda (server)
+ (setq servers (cons (symbol-name server) servers)))
+ nnmaildir--servers)
+ (mapcar 'nnmaildir-close-server servers)
+ (setq buffer (get-buffer " *nnmaildir work*"))
+ (if buffer (kill-buffer buffer))
+ (setq buffer (get-buffer " *nnmaildir nov*"))
+ (if buffer (kill-buffer buffer))
+ (setq buffer (get-buffer " *nnmaildir move*"))
+ (if buffer (kill-buffer buffer)))
+ t)
+
+(provide 'nnmaildir)
+
+;; Local Variables:
+;; indent-tabs-mode: t
+;; fill-column: 77
+;; End:
+
+;;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849
+;;; nnmaildir.el ends here
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 099d82c3c29..a1957fa0dcd 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -1,10 +1,10 @@
;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
@@ -30,6 +30,7 @@
(require 'message)
(require 'nnmail)
(require 'nnoo)
+(require 'gnus-range)
(eval-when-compile (require 'cl))
(nnoo-declare nnmbox)
@@ -54,7 +55,7 @@
(defvoo nnmbox-current-group nil
"Current nnmbox news group directory.")
-(defconst nnmbox-mbox-buffer nil)
+(defvar nnmbox-mbox-buffer nil)
(defvoo nnmbox-status-string "")
@@ -66,6 +67,8 @@
(defvoo nnmbox-active-file-coding-system mm-binary-coding-system)
(defvoo nnmbox-active-file-coding-system-for-write nil)
+(defvar nnmbox-group-building-active-articles nil)
+(defvar nnmbox-group-active-articles nil)
;;; Interface functions
@@ -78,15 +81,12 @@
(erase-buffer)
(let ((number (length sequence))
(count 0)
- article art-string start stop)
+ article start stop)
(nnmbox-possibly-change-newsgroup newsgroup server)
(while sequence
(setq article (car sequence))
- (setq art-string (nnmbox-article-string article))
(set-buffer nnmbox-mbox-buffer)
- (when (or (search-forward art-string nil t)
- (progn (goto-char (point-min))
- (search-forward art-string nil t)))
+ (when (nnmbox-find-article article)
(setq start
(save-excursion
(re-search-backward
@@ -148,8 +148,7 @@
(nnmbox-possibly-change-newsgroup newsgroup server)
(save-excursion
(set-buffer nnmbox-mbox-buffer)
- (goto-char (point-min))
- (when (search-forward (nnmbox-article-string article) nil t)
+ (when (nnmbox-find-article article)
(let (start stop)
(re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
(setq start (point))
@@ -170,7 +169,7 @@
(forward-line 1))
(if (numberp article)
(cons nnmbox-current-group article)
- (nnmbox-article-group-number)))))))
+ (nnmbox-article-group-number nil)))))))
(deffoo nnmbox-request-group (group &optional server dont-check)
(nnmbox-possibly-change-newsgroup nil server)
@@ -254,8 +253,7 @@
(save-excursion
(set-buffer nnmbox-mbox-buffer)
(while (and articles is-old)
- (goto-char (point-min))
- (when (search-forward (nnmbox-article-string (car articles)) nil t)
+ (when (nnmbox-find-article (car articles))
(if (setq is-old
(nnmail-expired-article-p
newsgroup
@@ -269,7 +267,8 @@
(current-buffer))
(let ((nnml-current-directory nil))
(nnmail-expiry-target-group
- nnmail-expiry-target newsgroup))))
+ nnmail-expiry-target newsgroup)))
+ (nnmbox-possibly-change-newsgroup newsgroup server))
(nnheader-message 5 "Deleting article %d in %s..."
(car articles) newsgroup)
(nnmbox-delete-mail))
@@ -278,12 +277,9 @@
(nnmbox-save-buffer)
;; Find the lowest active article in this group.
(let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
- (goto-char (point-min))
- (while (and (not (search-forward
- (nnmbox-article-string (car active)) nil t))
+ (while (and (not (nnmbox-find-article (car active)))
(<= (car active) (cdr active)))
- (setcar active (1+ (car active)))
- (goto-char (point-min))))
+ (setcar active (1+ (car active)))))
(nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
(nconc rest articles))))
@@ -301,16 +297,14 @@
(while (re-search-forward
"^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
+ (gnus-delete-line))
(setq result (eval accept-form))
(kill-buffer buf)
result)
(save-excursion
(nnmbox-possibly-change-newsgroup group server)
(set-buffer nnmbox-mbox-buffer)
- (goto-char (point-min))
- (when (search-forward (nnmbox-article-string article) nil t)
+ (when (nnmbox-find-article article)
(nnmbox-delete-mail))
(and last (nnmbox-save-buffer))))
result))
@@ -337,7 +331,10 @@
(while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
(delete-region (point) (progn (forward-line 1) (point))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
(setq result (if (stringp group)
(list (cons group (nnmbox-active-number group)))
(nnmail-article-group 'nnmbox-active-number)))
@@ -360,8 +357,7 @@
(nnmbox-possibly-change-newsgroup group)
(save-excursion
(set-buffer nnmbox-mbox-buffer)
- (goto-char (point-min))
- (if (not (search-forward (nnmbox-article-string article) nil t))
+ (if (not (nnmbox-find-article article))
nil
(nnmbox-delete-mail t t)
(insert-buffer-substring buffer)
@@ -405,6 +401,9 @@
(setq found t))
(when found
(nnmbox-save-buffer))))
+ (let ((entry (assoc group nnmbox-group-active-articles)))
+ (when entry
+ (setcar entry new-name)))
(let ((entry (assoc group nnmbox-group-alist)))
(when entry
(setcar entry new-name))
@@ -421,10 +420,12 @@
;; delimiter line.
(defun nnmbox-delete-mail (&optional force leave-delim)
;; Delete the current X-Gnus-Newsgroup line.
+ ;; First delete record of active article, unless the article is being
+ ;; replaced, indicated by FORCE being non-nil.
+ (if (not force)
+ (nnmbox-record-deleted-article (nnmbox-article-group-number t)))
(or force
- (delete-region
- (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
+ (gnus-delete-line))
;; Beginning of the article.
(save-excursion
(save-restriction
@@ -442,7 +443,7 @@
(match-beginning 0)))
(point-max))))
(goto-char (point-min))
- ;; Only delete the article if no other groups owns it as well.
+ ;; Only delete the article if no other group owns it as well.
(when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
(delete-region (point-min) (point-max))))))
@@ -452,14 +453,7 @@
(nnmbox-open-server server))
(when (or (not nnmbox-mbox-buffer)
(not (buffer-name nnmbox-mbox-buffer)))
- (save-excursion
- (set-buffer (setq nnmbox-mbox-buffer
- (let ((nnheader-file-coding-system
- nnmbox-file-coding-system))
- (nnheader-find-file-noselect
- nnmbox-mbox-file nil t))))
- (mm-enable-multibyte)
- (buffer-disable-undo)))
+ (nnmbox-read-mbox))
(when (not nnmbox-group-alist)
(nnmail-activate 'nnmbox))
(if newsgroup
@@ -473,15 +467,86 @@
(int-to-string article) " ")
(concat "\nMessage-ID: " article)))
-(defun nnmbox-article-group-number ()
+(defun nnmbox-article-group-number (this-line)
(save-excursion
- (goto-char (point-min))
+ (if this-line
+ (beginning-of-line)
+ (goto-char (point-min)))
(when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
nil t)
(cons (buffer-substring (match-beginning 1) (match-end 1))
(string-to-int
(buffer-substring (match-beginning 2) (match-end 2)))))))
+(defun nnmbox-in-header-p (pos)
+ "Return non-nil if POS is in the header of an article."
+ (save-excursion
+ (goto-char pos)
+ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+ (search-forward "\n\n" nil t)
+ (< pos (point))))
+
+(defun nnmbox-find-article (article)
+ "Leaves point on the relevant X-Gnus-Newsgroup line if found."
+ ;; Check that article is in the active range first, to avoid an
+ ;; expensive exhaustive search if it isn't.
+ (if (and (numberp article)
+ (not (nnmbox-is-article-active-p article)))
+ nil
+ (let ((art-string (nnmbox-article-string article))
+ (found nil))
+ ;; There is the possibility that the X-Gnus-Newsgroup line appears
+ ;; in the body of an article (for instance, if an article has been
+ ;; forwarded from someone using Gnus as their mailer), so check
+ ;; that the line is actually part of the article header.
+ (or (and (search-forward art-string nil t)
+ (nnmbox-in-header-p (point)))
+ (progn
+ (goto-char (point-min))
+ (while (and (not found)
+ (search-forward art-string nil t))
+ (setq found (nnmbox-in-header-p (point))))
+ found)))))
+
+(defun nnmbox-record-active-article (group-art)
+ (let* ((group (car group-art))
+ (article (cdr group-art))
+ (entry
+ (or (assoc group nnmbox-group-active-articles)
+ (progn
+ (push (list group)
+ nnmbox-group-active-articles)
+ (car nnmbox-group-active-articles)))))
+ ;; add article to index, either by building complete list
+ ;; in reverse order, or as a list of ranges.
+ (if (not nnmbox-group-building-active-articles)
+ (setcdr entry (gnus-add-to-range (cdr entry) (list article)))
+ (when (memq article (cdr entry))
+ (switch-to-buffer nnmbox-mbox-buffer)
+ (error "Article %s:%d already exists!" group article))
+ (when (and (cadr entry) (< article (cadr entry)))
+ (switch-to-buffer nnmbox-mbox-buffer)
+ (error "Article %s:%d out of order" group article))
+ (setcdr entry (cons article (cdr entry))))))
+
+(defun nnmbox-record-deleted-article (group-art)
+ (let* ((group (car group-art))
+ (article (cdr group-art))
+ (entry
+ (or (assoc group nnmbox-group-active-articles)
+ (progn
+ (push (list group)
+ nnmbox-group-active-articles)
+ (car nnmbox-group-active-articles)))))
+ ;; remove article from index
+ (setcdr entry (gnus-remove-from-range (cdr entry) (list article)))))
+
+(defun nnmbox-is-article-active-p (article)
+ (gnus-member-of-range
+ article
+ (cdr (assoc nnmbox-current-group
+ nnmbox-group-active-articles))))
+
(defun nnmbox-save-mail (group-art)
"Called narrowed to an article."
(let ((delim (concat "^" message-unix-mail-delimiter)))
@@ -498,6 +563,10 @@
(nnmail-insert-lines)
(nnmail-insert-xref group-art)
(nnmbox-insert-newsgroup-line group-art)
+ (let ((alist group-art))
+ (while alist
+ (nnmbox-record-active-article (car alist))
+ (setq alist (cdr alist))))
(run-hooks 'nnmail-prepare-save-mail-hook)
(run-hooks 'nnmbox-prepare-save-mail-hook)
group-art))
@@ -530,7 +599,9 @@
(when (not (file-exists-p nnmbox-mbox-file))
(let ((nnmail-file-coding-system
(or nnmbox-file-coding-system-for-write
- nnmbox-file-coding-system)))
+ nnmbox-file-coding-system))
+ (dir (file-name-directory nnmbox-mbox-file)))
+ (and dir (gnus-make-directory dir))
(nnmail-write-region (point-min) (point-min)
nnmbox-mbox-file t 'nomesg))))
@@ -546,17 +617,17 @@
(save-excursion
(let ((delim (concat "^" message-unix-mail-delimiter))
(alist nnmbox-group-alist)
- start end number)
+ (nnmbox-group-building-active-articles t)
+ start end end-header number)
(set-buffer (setq nnmbox-mbox-buffer
(let ((nnheader-file-coding-system
nnmbox-file-coding-system))
(nnheader-find-file-noselect
- nnmbox-mbox-file nil t))))
+ nnmbox-mbox-file t t))))
(mm-enable-multibyte)
(buffer-disable-undo)
- ;; Go through the group alist and compare against
- ;; the mbox file.
+ ;; Go through the group alist and compare against the mbox file.
(while alist
(goto-char (point-max))
(when (and (re-search-backward
@@ -570,29 +641,57 @@
(setcdr (cadar alist) number))
(setq alist (cdr alist)))
+ ;; Examine all articles for our private X-Gnus-Newsgroup
+ ;; headers. This is done primarily as a consistency check, but
+ ;; it is convenient for building an index of the articles
+ ;; present, to avoid costly searches for missing articles
+ ;; (eg. when expiring articles).
(goto-char (point-min))
+ (setq nnmbox-group-active-articles nil)
(while (re-search-forward delim nil t)
(setq start (match-beginning 0))
- (unless (search-forward
- "\nX-Gnus-Newsgroup: "
- (save-excursion
- (setq end
- (or
- (and
- ;; skip to end of headers first, since mail
- ;; which has been respooled has additional
- ;; "From nobody" lines.
- (search-forward "\n\n" nil t)
- (re-search-forward delim nil t)
- (match-beginning 0))
- (point-max))))
- t)
+ (save-excursion
+ (search-forward "\n\n" nil t)
+ (setq end-header (point))
+ (setq end (or (and
+ (re-search-forward delim nil t)
+ (match-beginning 0))
+ (point-max))))
+ (if (search-forward "\nX-Gnus-Newsgroup: " end-header t)
+ ;; Build a list of articles in each group, remembering
+ ;; that each article may be in more than one group.
+ (progn
+ (nnmbox-record-active-article (nnmbox-article-group-number t))
+ (while (search-forward "\nX-Gnus-Newsgroup: " end-header t)
+ (nnmbox-record-active-article (nnmbox-article-group-number t))))
+ ;; The article is either new, or for some other reason
+ ;; hasn't got our private headers, so add them now. The
+ ;; only situation I've encountered when the X-Gnus-Newsgroup
+ ;; header is missing is if the article contains a forwarded
+ ;; message which does contain that header line (earlier
+ ;; versions of Gnus didn't restrict their search to the
+ ;; headers). In this case, there is an Xref line which
+ ;; provides the relevant information to construct the
+ ;; missing header(s).
(save-excursion
(save-restriction
(narrow-to-region start end)
- (nnmbox-save-mail
- (nnmail-article-group 'nnmbox-active-number)))))
- (goto-char end))))))
+ (if (re-search-forward "\nXref: [^ ]+" end-header t)
+ ;; generate headers from Xref:
+ (let (alist)
+ (while (re-search-forward " \\([^:]+\\):\\([0-9]+\\)" end-header t)
+ (push (cons (match-string 1)
+ (string-to-int (match-string 2))) alist))
+ (nnmbox-insert-newsgroup-line alist))
+ ;; this is really a new article
+ (nnmbox-save-mail
+ (nnmail-article-group 'nnmbox-active-number))))))
+ (goto-char end))
+ ;; put article lists in order
+ (setq alist nnmbox-group-active-articles)
+ (while alist
+ (setcdr (car alist) (gnus-compress-sequence (nreverse (cdar alist))))
+ (setq alist (cdr alist)))))))
(provide 'nnmbox)
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 301a3492853..37f0bb353e8 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -1,10 +1,10 @@
;;; nnmh.el --- mhspool access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
@@ -41,16 +41,16 @@
(nnoo-declare nnmh)
(defvoo nnmh-directory message-directory
- "*Mail spool directory.")
+ "Mail spool directory.")
(defvoo nnmh-get-new-mail t
- "*If non-nil, nnmh will check the incoming mail file and split the mail.")
+ "If non-nil, nnmh will check the incoming mail file and split the mail.")
(defvoo nnmh-prepare-save-mail-hook nil
- "*Hook run narrowed to an article before saving.")
+ "Hook run narrowed to an article before saving.")
(defvoo nnmh-be-safe nil
- "*If non-nil, nnmh will check all articles to make sure whether they are new or not.
+ "If non-nil, nnmh will check all articles to make sure whether they are new or not.
Go through the .nnmh-articles file and compare with the actual
articles in this folder. The articles that are \"new\" will be marked
as unread by Gnus.")
@@ -239,10 +239,12 @@ as unread by Gnus.")
(file-truename (file-name-as-directory
(expand-file-name nnmh-toplev))))
dir)
- (nnheader-replace-chars-in-string
- (mm-decode-coding-string (substring dir (match-end 0))
- nnmail-pathname-coding-system)
- ?/ ?.))
+ (mm-string-as-multibyte
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string
+ (substring dir (match-end 0))
+ ?/ ?.)
+ nnmail-pathname-coding-system)))
(apply 'max files)
(apply 'min files)))))))
t)
@@ -288,8 +290,8 @@ as unread by Gnus.")
(deffoo nnmh-close-group (group &optional server)
t)
-(deffoo nnmh-request-move-article
- (article group server accept-form &optional last)
+(deffoo nnmh-request-move-article (article group server
+ accept-form &optional last)
(let ((buf (get-buffer-create " *nnmh move*"))
result)
(and
@@ -314,7 +316,10 @@ as unread by Gnus.")
(nnmh-possibly-change-directory group server)
(nnmail-check-syntax)
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
(nnheader-init-server-buffer)
(prog1
(if (stringp group)
@@ -422,7 +427,7 @@ as unread by Gnus.")
(file-name-coding-system nnmail-pathname-coding-system))
(if (file-directory-p pathname)
(setq nnmh-current-directory pathname)
- (error "No such newsgroup: %s" newsgroup)))))
+ (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory)))))
(defun nnmh-possibly-create-directory (group)
(let (dir dirs)
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 90902f31aac..cb820b094c1 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1,9 +1,10 @@
;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003
;; Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
@@ -31,12 +32,14 @@
;;; Code:
+(require 'gnus)
(require 'nnheader)
(require 'nnmail)
(require 'nnoo)
(eval-when-compile (require 'cl))
+
(eval-and-compile
- (autoload 'gnus-sorted-intersection "gnus-range"))
+ (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
(nnoo-declare nnml)
@@ -55,7 +58,7 @@
"If non-nil, nnml will check the incoming mail file and split the mail.")
(defvoo nnml-nov-is-evil nil
- "If non-nil, Gnus will never generate and use nov databases for mail groups.
+ "If non-nil, Gnus will never generate and use nov databases for mail spools.
Using nov databases will speed up header fetching considerably.
This variable shouldn't be flipped much. If you have, for some reason,
set this to t, and want to set it to nil again, you should always run
@@ -63,12 +66,23 @@ the `nnml-generate-nov-databases' command. The function will go
through all nnml directories and generate nov databases for them
all. This may very well take some time.")
+(defvoo nnml-marks-is-evil nil
+ "If non-nil, Gnus will never generate and use marks file for mail spools.
+Using marks files makes it possible to backup and restore mail groups
+separately from `.newsrc.eld'. If you have, for some reason, set this
+to t, and want to set it to nil again, you should always remove the
+corresponding marks file (usually named `.marks' in the nnml group
+directory, but see `nnml-marks-file-name') for the group. Then the
+marks file will be regenerated properly by Gnus.")
+
(defvoo nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
(defvoo nnml-inhibit-expiry nil
"If non-nil, inhibit expiry.")
+(defvoo nnml-use-compressed-files nil
+ "If non-nil, allow using compressed message files.")
@@ -76,6 +90,7 @@ all. This may very well take some time.")
"nnml version.")
(defvoo nnml-nov-file-name ".overview")
+(defvoo nnml-marks-file-name ".marks")
(defvoo nnml-current-directory nil)
(defvoo nnml-current-group nil)
@@ -91,8 +106,11 @@ all. This may very well take some time.")
(defvoo nnml-file-coding-system nnmail-file-coding-system)
-
+(defvoo nnml-marks nil)
+
+(defvar nnml-marks-modtime (gnus-make-hashtable))
+
;;; Interface functions.
(nnoo-define-basics nnml)
@@ -102,11 +120,11 @@ all. This may very well take some time.")
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let ((file nil)
- (number (length sequence))
- (count 0)
- (file-name-coding-system nnmail-pathname-coding-system)
- beg article)
+ (let* ((file nil)
+ (number (length sequence))
+ (count 0)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ beg article)
(if (stringp (car sequence))
'headers
(if (nnml-retrieve-headers-with-nov sequence fetch-old)
@@ -121,7 +139,7 @@ all. This may very well take some time.")
(setq beg (point))
(nnheader-insert-head file)
(goto-char beg)
- (if (search-forward "\n\n" nil t)
+ (if (re-search-forward "\n\r?\n" nil t)
(forward-char -1)
(goto-char (point-max))
(insert "\n\n"))
@@ -158,9 +176,9 @@ all. This may very well take some time.")
server nnml-directory)
t)))
-(defun nnml-request-regenerate (server)
+(deffoo nnml-request-regenerate (server)
(nnml-possibly-change-directory nil server)
- (nnml-generate-nov-databases)
+ (nnml-generate-nov-databases server)
t)
(deffoo nnml-request-article (id &optional group server buffer)
@@ -245,7 +263,7 @@ all. This may very well take some time.")
nnml-group-alist)
(nnml-possibly-create-directory group)
(nnml-possibly-change-directory group server)
- (let ((articles (nnheader-directory-articles nnml-current-directory)))
+ (let ((articles (nnml-directory-articles nnml-current-directory)))
(when articles
(setcar active (apply 'min articles))
(setcdr active (apply 'max articles))))
@@ -270,7 +288,7 @@ all. This may very well take some time.")
(deffoo nnml-request-expire-articles (articles group &optional server force)
(nnml-possibly-change-directory group server)
(let ((active-articles
- (nnheader-directory-articles nnml-current-directory))
+ (nnml-directory-articles nnml-current-directory))
(is-old t)
article rest mod-time number)
(nnmail-activate 'nnml)
@@ -281,30 +299,32 @@ all. This may very well take some time.")
(setq articles (gnus-sorted-intersection articles active-articles))
(while (and articles is-old)
- (when (setq article (nnml-article-to-file (setq number (pop articles))))
- (when (setq mod-time (nth 5 (file-attributes article)))
- (if (and (nnml-deletable-article-p group number)
- (setq is-old
- (nnmail-expired-article-p group mod-time force
- nnml-inhibit-expiry)))
- (progn
- ;; Allow a special target group.
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nnml-request-article number group server
- (current-buffer))
- (let ((nnml-current-directory nil))
- (nnmail-expiry-target-group
- nnmail-expiry-target group))))
- (nnheader-message 5 "Deleting article %s in %s"
- number group)
- (condition-case ()
- (funcall nnmail-delete-file-function article)
- (file-error
- (push number rest)))
- (setq active-articles (delq number active-articles))
- (nnml-nov-delete-article group number))
- (push number rest)))))
+ (if (and (setq article (nnml-article-to-file
+ (setq number (pop articles))))
+ (setq mod-time (nth 5 (file-attributes article)))
+ (nnml-deletable-article-p group number)
+ (setq is-old (nnmail-expired-article-p group mod-time force
+ nnml-inhibit-expiry)))
+ (progn
+ ;; Allow a special target group.
+ (unless (eq nnmail-expiry-target 'delete)
+ (with-temp-buffer
+ (nnml-request-article number group server (current-buffer))
+ (let (nnml-current-directory
+ nnml-current-group
+ nnml-article-file-alist)
+ (nnmail-expiry-target-group nnmail-expiry-target group)))
+ ;; Maybe directory is changed during nnmail-expiry-target-group.
+ (nnml-possibly-change-directory group server))
+ (nnheader-message 5 "Deleting article %s in %s"
+ number group)
+ (condition-case ()
+ (funcall nnmail-delete-file-function article)
+ (file-error
+ (push number rest)))
+ (setq active-articles (delq number active-articles))
+ (nnml-nov-delete-article group number))
+ (push number rest)))
(let ((active (nth 1 (assoc group nnml-group-alist))))
(when active
(setcar active (or (and active-articles
@@ -349,7 +369,10 @@ all. This may very well take some time.")
(nnmail-check-syntax)
(let (result)
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ group
+ (nnmail-fetch-field "subject")
+ (nnmail-fetch-field "from")))
(if (stringp group)
(and
(nnmail-activate 'nnml)
@@ -371,6 +394,9 @@ all. This may very well take some time.")
(nnml-save-nov))))
result))
+(deffoo nnml-request-post (&optional server)
+ (nnmail-do-request-post 'nnml-request-accept-article server))
+
(deffoo nnml-request-replace-article (article group buffer)
(nnml-possibly-change-directory group)
(save-excursion
@@ -395,8 +421,7 @@ all. This may very well take some time.")
(if (or (looking-at art)
(search-forward (concat "\n" art) nil t))
;; Delete the old NOV line.
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))
+ (gnus-delete-line)
;; The line isn't here, so we have to find out where
;; we should insert it. (This situation should never
;; occur, but one likes to make sure...)
@@ -419,7 +444,8 @@ all. This may very well take some time.")
(directory-files
nnml-current-directory t
(concat nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$")))
+ "\\|" (regexp-quote nnml-nov-file-name) "$"
+ "\\|" (regexp-quote nnml-marks-file-name) "$")))
article)
(while articles
(setq article (pop articles))
@@ -457,6 +483,10 @@ all. This may very well take some time.")
(let ((overview (concat old-dir nnml-nov-file-name)))
(when (file-exists-p overview)
(rename-file overview (concat new-dir nnml-nov-file-name))))
+ ;; Move .marks file.
+ (let ((marks (concat old-dir nnml-marks-file-name)))
+ (when (file-exists-p marks)
+ (rename-file marks (concat new-dir nnml-marks-file-name))))
(when (<= (length (directory-files old-dir)) 2)
(ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
@@ -487,15 +517,19 @@ all. This may very well take some time.")
(defun nnml-article-to-file (article)
(nnml-update-file-alist)
(let (file)
- (if (setq file (cdr (assq article nnml-article-file-alist)))
+ (if (setq file
+ (if nnml-use-compressed-files
+ (cdr (assq article nnml-article-file-alist))
+ (number-to-string article)))
(expand-file-name file nnml-current-directory)
- ;; Just to make sure nothing went wrong when reading over NFS --
- ;; check once more.
- (when (file-exists-p
- (setq file (expand-file-name (number-to-string article)
- nnml-current-directory)))
- (nnml-update-file-alist t)
- file))))
+ (when (not nnheader-directory-files-is-safe)
+ ;; Just to make sure nothing went wrong when reading over NFS --
+ ;; check once more.
+ (when (file-exists-p
+ (setq file (expand-file-name (number-to-string article)
+ nnml-current-directory)))
+ (nnml-update-file-alist t)
+ file)))))
(defun nnml-deletable-article-p (group article)
"Say whether ARTICLE in GROUP can be deleted."
@@ -517,7 +551,7 @@ all. This may very well take some time.")
;; likely that the article we are looking for is in that group.
(if (setq number (nnml-find-id nnml-current-group id))
(cons nnml-current-group number)
- ;; It wasn't there, so we look through the other groups as well.
+ ;; It wasn't there, so we look through the other groups as well.
(while (and (not number)
alist)
(or (string= (caar alist) nnml-current-group)
@@ -587,8 +621,12 @@ all. This may very well take some time.")
(defun nnml-save-mail (group-art)
"Called narrowed to an article."
- (let (chars headers)
+ (let (chars headers extension)
(setq chars (nnmail-insert-lines))
+ (setq extension
+ (and nnml-use-compressed-files
+ (> chars 1000)
+ ".gz"))
(nnmail-insert-xref group-art)
(run-hooks 'nnmail-prepare-save-mail-hook)
(run-hooks 'nnml-prepare-save-mail-hook)
@@ -603,7 +641,8 @@ all. This may very well take some time.")
(nnml-possibly-create-directory (caar ga))
(let ((file (concat (nnmail-group-pathname
(caar ga) nnml-directory)
- (int-to-string (cdar ga)))))
+ (int-to-string (cdar ga))
+ extension)))
(if first
;; It was already saved, so we just make a hard link.
(funcall nnmail-crosspost-link-function first file t)
@@ -636,7 +675,7 @@ all. This may very well take some time.")
(unless nnml-article-file-alist
(setq nnml-article-file-alist
(sort
- (nnheader-article-to-file-alist nnml-current-directory)
+ (nnml-current-group-article-to-file-alist)
'car-less-than-car)))
(setq active
(if nnml-article-file-alist
@@ -660,7 +699,7 @@ all. This may very well take some time.")
(nnheader-insert-nov headers)))
(defsubst nnml-header-value ()
- (buffer-substring (match-end 0) (progn (end-of-line) (point))))
+ (buffer-substring (match-end 0) (gnus-point-at-eol)))
(defun nnml-parse-head (chars &optional number)
"Parse the head of the current buffer."
@@ -669,30 +708,30 @@ all. This may very well take some time.")
(unless (zerop (buffer-size))
(narrow-to-region
(goto-char (point-min))
- (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Remove any tabs; they are too confusing.
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (let ((headers (nnheader-parse-head t)))
+ (if (re-search-forward "\n\r?\n" nil t)
+ (1- (point))
+ (point-max))))
+ (let ((headers (nnheader-parse-naked-head)))
(mail-header-set-chars headers chars)
(mail-header-set-number headers number)
headers))))
+(defun nnml-get-nov-buffer (group)
+ (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))
+ (save-excursion
+ (set-buffer buffer)
+ (set (make-local-variable 'nnml-nov-buffer-file-name)
+ (expand-file-name
+ nnml-nov-file-name
+ (nnmail-group-pathname group nnml-directory)))
+ (erase-buffer)
+ (when (file-exists-p nnml-nov-buffer-file-name)
+ (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
+ buffer))
+
(defun nnml-open-nov (group)
(or (cdr (assoc group nnml-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))
- (save-excursion
- (set-buffer buffer)
- (set (make-local-variable 'nnml-nov-buffer-file-name)
- (expand-file-name
- nnml-nov-file-name
- (nnmail-group-pathname group nnml-directory)))
- (erase-buffer)
- (when (file-exists-p nnml-nov-buffer-file-name)
- (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
+ (let ((buffer (nnml-get-nov-buffer group)))
(push (cons group buffer) nnml-nov-buffer-alist)
buffer)))
@@ -709,13 +748,14 @@ all. This may very well take some time.")
(setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
;;;###autoload
-(defun nnml-generate-nov-databases ()
+(defun nnml-generate-nov-databases (&optional server)
"Generate NOV databases in all nnml directories."
- (interactive)
+ (interactive (list (or (nnoo-current-server 'nnml) "")))
;; Read the active file to make sure we don't re-use articles
;; numbers in empty groups.
(nnmail-activate 'nnml)
- (nnml-open-server (or (nnoo-current-server 'nnml) ""))
+ (unless (nnml-server-opened server)
+ (nnml-open-server server))
(setq nnml-directory (expand-file-name nnml-directory))
;; Recurse down the directories.
(nnml-generate-nov-databases-1 nnml-directory nil t)
@@ -754,15 +794,18 @@ all. This may very well take some time.")
(eval-when-compile (defvar files))
(defun nnml-generate-active-info (dir)
;; Update the active info for this group.
- (let ((group (nnheader-file-to-group
- (directory-file-name dir) nnml-directory)))
- (setq nnml-group-alist
- (delq (assoc group nnml-group-alist) nnml-group-alist))
+ (let* ((group (nnheader-file-to-group
+ (directory-file-name dir) nnml-directory))
+ (entry (assoc group nnml-group-alist))
+ (last (or (caadr entry) 0)))
+ (setq nnml-group-alist (delq entry nnml-group-alist))
(push (list group
- (cons (caar files)
- (let ((f files))
- (while (cdr f) (setq f (cdr f)))
- (caar f))))
+ (cons (or (caar files) (1+ last))
+ (max last
+ (or (let ((f files))
+ (while (cdr f) (setq f (cdr f)))
+ (caar f))
+ 0))))
nnml-group-alist)))
(defun nnml-generate-nov-file (dir files)
@@ -786,7 +829,7 @@ all. This may very well take some time.")
(narrow-to-region
(goto-char (point-min))
(progn
- (search-forward "\n\n" nil t)
+ (re-search-forward "\n\r?\n" nil t)
(setq chars (- (point-max) (point)))
(max (point-min) (1- (point)))))
(unless (zerop (buffer-size))
@@ -820,10 +863,158 @@ all. This may very well take some time.")
t))
(defun nnml-update-file-alist (&optional force)
- (when (or (not nnml-article-file-alist)
- force)
- (setq nnml-article-file-alist
- (nnheader-article-to-file-alist nnml-current-directory))))
+ (when nnml-use-compressed-files
+ (when (or (not nnml-article-file-alist)
+ force)
+ (setq nnml-article-file-alist
+ (nnml-current-group-article-to-file-alist)))))
+
+(defun nnml-directory-articles (dir)
+ "Return a list of all article files in a directory.
+Use the nov database for that directory if available."
+ (if (or gnus-nov-is-evil nnml-nov-is-evil
+ (not (file-exists-p
+ (expand-file-name nnml-nov-file-name dir))))
+ (nnheader-directory-articles dir)
+ ;; build list from .overview if available
+ ;; We would use nnml-open-nov, except that nnml-nov-buffer-alist is
+ ;; defvoo'd, and we might get called when it hasn't been swapped in.
+ (save-excursion
+ (let ((list nil)
+ art
+ (buffer (nnml-get-nov-buffer nnml-current-group)))
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq art (read (current-buffer)))
+ (push art list)
+ (forward-line 1))
+ list))))
+
+(defun nnml-current-group-article-to-file-alist ()
+ "Return an alist of article/file pairs in the current group.
+Use the nov database for the current group if available."
+ (if (or nnml-use-compressed-files
+ gnus-nov-is-evil
+ nnml-nov-is-evil
+ (not (file-exists-p
+ (expand-file-name nnml-nov-file-name
+ nnml-current-directory))))
+ (nnheader-article-to-file-alist nnml-current-directory)
+ ;; build list from .overview if available
+ (save-excursion
+ (let ((alist nil)
+ (buffer (nnml-get-nov-buffer nnml-current-group))
+ art)
+ (set-buffer buffer)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq art (read (current-buffer)))
+ ;; assume file name is unadorned (ie. not compressed etc)
+ (push (cons art (int-to-string art)) alist)
+ (forward-line 1))
+ alist))))
+
+(deffoo nnml-request-set-mark (group actions &optional server)
+ (nnml-possibly-change-directory group server)
+ (unless nnml-marks-is-evil
+ (nnml-open-marks group server)
+ (dolist (action actions)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (assert (or (eq what 'add) (eq what 'del)) t
+ "Unknown request-set-mark action: %s" what)
+ (dolist (mark marks)
+ (setq nnml-marks (gnus-update-alist-soft
+ mark
+ (funcall (if (eq what 'add) 'gnus-range-add
+ 'gnus-remove-from-range)
+ (cdr (assoc mark nnml-marks)) range)
+ nnml-marks)))))
+ (nnml-save-marks group server))
+ nil)
+
+(deffoo nnml-request-update-info (group info &optional server)
+ (nnml-possibly-change-directory group server)
+ (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group))
+ (nnheader-message 8 "Updating marks for %s..." group)
+ (nnml-open-marks group server)
+ ;; Update info using `nnml-marks'.
+ (mapcar (lambda (pred)
+ (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nnml-marks))
+ (gnus-info-marks info))
+ t)))
+ gnus-article-mark-lists)
+ (let ((seen (cdr (assq 'read nnml-marks))))
+ (gnus-info-set-read info
+ (if (and (integerp (car seen))
+ (null (cdr seen)))
+ (list (cons (car seen) (car seen)))
+ seen)))
+ (nnheader-message 8 "Updating marks for %s...done" group))
+ info)
+
+(defun nnml-marks-changed-p (group)
+ (let ((file (expand-file-name nnml-marks-file-name
+ (nnmail-group-pathname group nnml-directory))))
+ (if (null (gnus-gethash file nnml-marks-modtime))
+ t ;; never looked at marks file, assume it has changed
+ (not (equal (gnus-gethash file nnml-marks-modtime)
+ (nth 5 (file-attributes file)))))))
+
+(defun nnml-save-marks (group server)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (expand-file-name nnml-marks-file-name
+ (nnmail-group-pathname group nnml-directory))))
+ (condition-case err
+ (progn
+ (nnml-possibly-create-directory group)
+ (with-temp-file file
+ (erase-buffer)
+ (gnus-prin1 nnml-marks)
+ (insert "\n"))
+ (gnus-sethash file
+ (nth 5 (file-attributes file))
+ nnml-marks-modtime))
+ (error (or (gnus-yes-or-no-p
+ (format "Could not write to %s (%s). Continue? " file err))
+ (error "Cannot write to %s (%s)" err))))))
+
+(defun nnml-open-marks (group server)
+ (let ((file (expand-file-name
+ nnml-marks-file-name
+ (nnmail-group-pathname group nnml-directory))))
+ (if (file-exists-p file)
+ (condition-case err
+ (with-temp-buffer
+ (gnus-sethash file (nth 5 (file-attributes file))
+ nnml-marks-modtime)
+ (nnheader-insert-file-contents file)
+ (setq nnml-marks (read (current-buffer)))
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nnml-marks (gnus-remassoc el nnml-marks))))
+ (error (or (gnus-yes-or-no-p
+ (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
+ (error "Cannot read nnml marks file %s (%s)" file err))))
+ ;; User didn't have a .marks file. Probably first time
+ ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
+ (let ((info (gnus-get-info
+ (gnus-group-prefixed-name
+ group
+ (gnus-server-to-method (format "nnml:%s" server))))))
+ (nnheader-message 7 "Bootstrapping marks for %s..." group)
+ (setq nnml-marks (gnus-info-marks info))
+ (push (cons 'read (gnus-info-read info)) nnml-marks)
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nnml-marks (gnus-remassoc el nnml-marks)))
+ (nnml-save-marks group server)
+ (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
(provide 'nnml)
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
new file mode 100644
index 00000000000..f9ed8e5ec88
--- /dev/null
+++ b/lisp/gnus/nnnil.el
@@ -0,0 +1,83 @@
+;;; nnnil.el --- empty backend for Gnus
+;; Public domain.
+
+;; Author: Paul Jarc <prj@po.cwru.edu>
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; nnnil is a Gnus backend that provides no groups or articles. It's useful
+;; as a primary select method when you want all your real select methods to
+;; be secondary or foreign.
+
+;;; Code:
+
+(eval-and-compile
+ (require 'nnheader))
+
+(defvar nnnil-status-string "")
+
+(defun nnnil-retrieve-headers (articles &optional group server fetch-old)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer))
+ 'nov)
+
+(defun nnnil-open-server (server &optional definitions)
+ t)
+
+(defun nnnil-close-server (&optional server)
+ t)
+
+(defun nnnil-request-close ()
+ t)
+
+(defun nnnil-server-opened (&optional server)
+ t)
+
+(defun nnnil-status-message (&optional server)
+ nnnil-status-string)
+
+(defun nnnil-request-article (article &optional group server to-buffer)
+ (setq nnnil-status-string "No such group")
+ nil)
+
+(defun nnnil-request-group (group &optional server fast)
+ (let (deactivate-mark)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert "411 no such news group\n")))
+ (setq nnnil-status-string "No such group")
+ nil)
+
+(defun nnnil-close-group (group &optional server)
+ t)
+
+(defun nnnil-request-list (&optional server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer))
+ t)
+
+(defun nnnil-request-post (&optional server)
+ (setq nnnil-status-string "Read-only server")
+ nil)
+
+(provide 'nnnil)
+
+;;; arch-tag: a982a1a3-bc5e-4fb1-a233-d7657a3e3257
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index f2baa64267b..0fd980e56ce 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -1,6 +1,6 @@
;;; nnoo.el --- OO Gnus Backends
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -38,7 +38,7 @@
"The same as `defvar', only takes list of variables to MAP to."
`(prog1
,(if doc
- `(defvar ,var ,init ,doc)
+ `(defvar ,var ,init ,(concat doc "\n\nThis is a Gnus server variable. See Info node `(gnus)Select Methods'."))
`(defvar ,var ,init))
(nnoo-define ',var ',map)))
(put 'defvoo 'lisp-indent-function 2)
@@ -201,8 +201,8 @@
(while (setq def (pop defs))
(unless (assq (car def) bvariables)
(nconc bvariables
- (list (cons (car def) (and (boundp (car def))
- (symbol-value (car def)))))))
+ (list (cons (car def) (and (boundp (car def))
+ (symbol-value (car def)))))))
(if (equal server "*internal-non-initialized-backend*")
(set (car def) (symbol-value (cadr def)))
(set (car def) (cadr def)))))
@@ -254,7 +254,7 @@
(setcdr bstate (delq defs (cdr bstate)))
(pop defs)
(while defs
- (set (car (pop defs)) nil)))))
+ (set (car (pop defs)) nil)))))
t)
(defun nnoo-close (backend)
@@ -304,6 +304,20 @@ All functions will return nil and report an error."
(&rest args)
(nnheader-report ',backend ,(format "%s-%s not implemented"
backend function))))))))
+
+(defun nnoo-set (server &rest args)
+ (let ((parents (nnoo-parents (car server)))
+ (nnoo-parent-backend (car server)))
+ (while parents
+ (nnoo-change-server (caar parents)
+ (cadr server)
+ (cdar parents))
+ (pop parents)))
+ (nnoo-change-server (car server)
+ (cadr server) (cddr server))
+ (while args
+ (set (pop args) (pop args))))
+
(provide 'nnoo)
;;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
new file mode 100644
index 00000000000..9b4825c53f9
--- /dev/null
+++ b/lisp/gnus/nnrss.el
@@ -0,0 +1,771 @@
+;;; nnrss.el --- interfacing with RSS
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: RSS
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'nnoo)
+(require 'nnmail)
+(require 'message)
+(require 'mm-util)
+(require 'gnus-util)
+(require 'time-date)
+(require 'rfc2231)
+(require 'mm-url)
+(eval-when-compile
+ (ignore-errors
+ (require 'xml)))
+(eval '(require 'xml))
+
+(nnoo-declare nnrss)
+
+(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
+ "Where nnrss will save its files.")
+
+;; (group max rss-url)
+(defvoo nnrss-server-data nil)
+
+;; (num timestamp url subject author date extra)
+(defvoo nnrss-group-data nil)
+(defvoo nnrss-group-max 0)
+(defvoo nnrss-group-min 1)
+(defvoo nnrss-group nil)
+(defvoo nnrss-group-hashtb nil)
+(defvoo nnrss-status-string "")
+
+(defconst nnrss-version "nnrss 1.0")
+
+(defvar nnrss-group-alist '()
+ "List of RSS addresses.")
+
+(defvar nnrss-use-local nil)
+
+(defvar nnrss-description-field 'X-Gnus-Description
+ "Field name used for DESCRIPTION.
+To use the description in headers, put this name into `nnmail-extra-headers'.")
+
+(defvar nnrss-url-field 'X-Gnus-Url
+ "Field name used for URL.
+To use the description in headers, put this name into `nnmail-extra-headers'.")
+
+(defvar nnrss-content-function nil
+ "A function which is called in `nnrss-request-article'.
+The arguments are (ENTRY GROUP ARTICLE).
+ENTRY is the record of the current headline. GROUP is the group name.
+ARTICLE is the article number of the current headline.")
+
+(nnoo-define-basics nnrss)
+
+;;; Interface functions
+
+(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old)
+ (nnrss-possibly-change-group group server)
+ (let (e)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (dolist (article articles)
+ (if (setq e (assq article nnrss-group-data))
+ (insert (number-to-string (car e)) "\t" ;; number
+ (if (nth 3 e)
+ (nnrss-format-string (nth 3 e)) "")
+ "\t" ;; subject
+ (if (nth 4 e)
+ (nnrss-format-string (nth 4 e))
+ "(nobody)")
+ "\t" ;;from
+ (or (nth 5 e) "")
+ "\t" ;; date
+ (format "<%d@%s.nnrss>" (car e) group)
+ "\t" ;; id
+ "\t" ;; refs
+ "-1" "\t" ;; chars
+ "-1" "\t" ;; lines
+ "" "\t" ;; Xref
+ (if (and (nth 6 e)
+ (memq nnrss-description-field
+ nnmail-extra-headers))
+ (concat (symbol-name nnrss-description-field)
+ ": "
+ (nnrss-format-string (nth 6 e))
+ "\t")
+ "")
+ (if (and (nth 2 e)
+ (memq nnrss-url-field
+ nnmail-extra-headers))
+ (concat (symbol-name nnrss-url-field)
+ ": "
+ (nnrss-format-string (nth 2 e))
+ "\t")
+ "")
+ "\n")))))
+ 'nov)
+
+(deffoo nnrss-request-group (group &optional server dont-check)
+ (nnrss-possibly-change-group group server)
+ (if dont-check
+ t
+ (nnrss-check-group group server)
+ (nnheader-report 'nnrss "Opened group %s" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
+ (prin1-to-string group)
+ t)))
+
+(deffoo nnrss-close-group (group &optional server)
+ t)
+
+(deffoo nnrss-request-article (article &optional group server buffer)
+ (nnrss-possibly-change-group group server)
+ (let ((e (assq article nnrss-group-data))
+ (boundary "=-=-=-=-=-=-=-=-=-")
+ (nntp-server-buffer (or buffer nntp-server-buffer))
+ post err)
+ (when e
+ (catch 'error
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (goto-char (point-min))
+ (insert "Mime-Version: 1.0\nContent-Type: multipart/alternative; boundary=\"" boundary "\"\n")
+ (if group
+ (insert "Newsgroups: " group "\n"))
+ (if (nth 3 e)
+ (insert "Subject: " (nnrss-format-string (nth 3 e)) "\n"))
+ (if (nth 4 e)
+ (insert "From: " (nnrss-format-string (nth 4 e)) "\n"))
+ (if (nth 5 e)
+ (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
+ (insert "Message-ID: " (format "<%d@%s.nnrss>" (car e) group) "\n")
+ (insert "\n")
+ (let ((text (if (nth 6 e)
+ (nnrss-string-as-multibyte (nth 6 e))))
+ (link (if (nth 2 e)
+ (nth 2 e))))
+ (insert "\n\n--" boundary "\nContent-Type: text/plain\n\n")
+ (let ((point (point)))
+ (if text
+ (progn (insert text)
+ (goto-char point)
+ (while (re-search-forward "\n" nil t)
+ (replace-match " "))
+ (goto-char (point-max))
+ (insert "\n\n")))
+ (if link
+ (insert link)))
+ (insert "\n\n--" boundary "\nContent-Type: text/html\n\n")
+ (let ((point (point)))
+ (if text
+ (progn (insert "<html><head></head><body>\n" text "\n</body></html>")
+ (goto-char point)
+ (while (re-search-forward "\n" nil t)
+ (replace-match " "))
+ (goto-char (point-max))
+ (insert "\n\n")))
+ (if link
+ (insert "<p><a href=\"" link "\">link</a></p>\n"))))
+ (if nnrss-content-function
+ (funcall nnrss-content-function e group article)))))
+ (cond
+ (err
+ (nnheader-report 'nnrss err))
+ ((not e)
+ (nnheader-report 'nnrss "no such id: %d" article))
+ (t
+ (nnheader-report 'nnrss "article %s retrieved" (car e))
+ ;; we return the article number.
+ (cons nnrss-group (car e))))))
+
+(deffoo nnrss-request-list (&optional server)
+ (nnrss-possibly-change-group nil server)
+ (nnrss-generate-active)
+ t)
+
+(deffoo nnrss-open-server (server &optional defs connectionless)
+ (nnrss-read-server-data server)
+ (nnoo-change-server 'nnrss server defs)
+ t)
+
+(deffoo nnrss-request-expire-articles
+ (articles group &optional server force)
+ (nnrss-possibly-change-group group server)
+ (let (e days not-expirable changed)
+ (dolist (art articles)
+ (if (and (setq e (assq art nnrss-group-data))
+ (nnmail-expired-article-p
+ group
+ (if (listp (setq days (nth 1 e))) days
+ (days-to-time (- days (time-to-days '(0 0)))))
+ force))
+ (setq nnrss-group-data (delq e nnrss-group-data)
+ changed t)
+ (push art not-expirable)))
+ (if changed
+ (nnrss-save-group-data group server))
+ not-expirable))
+
+(deffoo nnrss-request-delete-group (group &optional force server)
+ (nnrss-possibly-change-group group server)
+ (setq nnrss-server-data
+ (delq (assoc group nnrss-server-data) nnrss-server-data))
+ (nnrss-save-server-data server)
+ (let ((file (expand-file-name
+ (nnrss-translate-file-chars
+ (concat group (and server
+ (not (equal server ""))
+ "-")
+ server ".el")) nnrss-directory)))
+ (ignore-errors
+ (delete-file file)))
+ t)
+
+(deffoo nnrss-request-list-newsgroups (&optional server)
+ (nnrss-possibly-change-group nil server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (dolist (elem nnrss-group-alist)
+ (if (third elem)
+ (insert (car elem) "\t" (third elem) "\n"))))
+ t)
+
+(nnoo-define-skeleton nnrss)
+
+;;; Internal functions
+(eval-when-compile (defun xml-rpc-method-call (&rest args)))
+(defun nnrss-fetch (url &optional local)
+ "Fetch the url and put it in a the expected lisp structure."
+ (with-temp-buffer
+ ;some CVS versions of url.el need this to close the connection quickly
+ (let* (xmlform htmlform)
+ ;; bit o' work necessary for w3 pre-cvs and post-cvs
+ (if local
+ (let ((coding-system-for-read 'binary))
+ (insert-file-contents url))
+ (mm-url-insert url))
+
+;; Because xml-parse-region can't deal with anything that isn't
+;; xml and w3-parse-buffer can't deal with some xml, we have to
+;; parse with xml-parse-region first and, if that fails, parse
+;; with w3-parse-buffer. Yuck. Eventually, someone should find out
+;; why w3-parse-buffer fails to parse some well-formed xml and
+;; fix it.
+
+ (condition-case err
+ (setq xmlform (xml-parse-region (point-min) (point-max)))
+ (error (if (fboundp 'w3-parse-buffer)
+ (setq htmlform (caddar (w3-parse-buffer
+ (current-buffer))))
+ (message "nnrss: Not valid XML and w3 parse not available (%s)"
+ url))))
+ (if htmlform
+ htmlform
+ xmlform))))
+
+(defun nnrss-possibly-change-group (&optional group server)
+ (when (and server
+ (not (nnrss-server-opened server)))
+ (nnrss-open-server server))
+ (when (and group (not (equal group nnrss-group)))
+ (nnrss-read-group-data group server)
+ (setq nnrss-group group)))
+
+(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
+
+(defun nnrss-generate-active ()
+ (if (y-or-n-p "fetch extra categories? ")
+ (dolist (func nnrss-extra-categories)
+ (funcall func)))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (dolist (elem nnrss-group-alist)
+ (insert (prin1-to-string (car elem)) " 0 1 y\n"))
+ (dolist (elem nnrss-server-data)
+ (unless (assoc (car elem) nnrss-group-alist)
+ (insert (prin1-to-string (car elem)) " 0 1 y\n")))))
+
+;;; data functions
+
+(defun nnrss-read-server-data (server)
+ (setq nnrss-server-data nil)
+ (let ((file (expand-file-name
+ (nnrss-translate-file-chars
+ (concat "nnrss" (and server
+ (not (equal server ""))
+ "-")
+ server
+ ".el"))
+ nnrss-directory)))
+ (when (file-exists-p file)
+ (with-temp-buffer
+ (let ((coding-system-for-read 'binary)
+ emacs-lisp-mode-hook)
+ (insert-file-contents file)
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (eval-buffer))))))
+
+(defun nnrss-save-server-data (server)
+ (gnus-make-directory nnrss-directory)
+ (let ((file (expand-file-name
+ (nnrss-translate-file-chars
+ (concat "nnrss" (and server
+ (not (equal server ""))
+ "-")
+ server ".el"))
+ nnrss-directory)))
+ (let ((coding-system-for-write 'binary)
+ print-level print-length)
+ (with-temp-file file
+ (insert "(setq nnrss-group-alist '"
+ (prin1-to-string nnrss-group-alist)
+ ")\n")
+ (insert "(setq nnrss-server-data '"
+ (prin1-to-string nnrss-server-data)
+ ")\n")))))
+
+(defun nnrss-read-group-data (group server)
+ (setq nnrss-group-data nil)
+ (setq nnrss-group-hashtb (gnus-make-hashtable))
+ (let ((pair (assoc group nnrss-server-data)))
+ (setq nnrss-group-max (or (cadr pair) 0))
+ (setq nnrss-group-min (+ nnrss-group-max 1)))
+ (let ((file (expand-file-name
+ (nnrss-translate-file-chars
+ (concat group (and server
+ (not (equal server ""))
+ "-")
+ server ".el"))
+ nnrss-directory)))
+ (when (file-exists-p file)
+ (with-temp-buffer
+ (let ((coding-system-for-read 'binary)
+ emacs-lisp-mode-hook)
+ (insert-file-contents file)
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (eval-buffer)))
+ (dolist (e nnrss-group-data)
+ (gnus-sethash (nth 2 e) e nnrss-group-hashtb)
+ (if (and (car e) (> nnrss-group-min (car e)))
+ (setq nnrss-group-min (car e)))
+ (if (and (car e) (< nnrss-group-max (car e)))
+ (setq nnrss-group-max (car e)))))))
+
+(defun nnrss-save-group-data (group server)
+ (gnus-make-directory nnrss-directory)
+ (let ((file (expand-file-name
+ (nnrss-translate-file-chars
+ (concat group (and server
+ (not (equal server ""))
+ "-")
+ server ".el"))
+ nnrss-directory)))
+ (let ((coding-system-for-write 'binary)
+ print-level print-length)
+ (with-temp-file file
+ (insert "(setq nnrss-group-data '"
+ (prin1-to-string nnrss-group-data)
+ ")\n")))))
+
+;;; URL interface
+
+(defun nnrss-no-cache (url)
+ "")
+
+(defun nnrss-insert-w3 (url)
+ (mm-with-unibyte-current-buffer
+ (mm-url-insert url)))
+
+(defun nnrss-decode-entities-unibyte-string (string)
+ (if string
+ (mm-with-unibyte-buffer
+ (insert string)
+ (mm-url-decode-entities-nbsp)
+ (buffer-string))))
+
+(defalias 'nnrss-insert 'nnrss-insert-w3)
+
+(if (featurep 'xemacs)
+ (defalias 'nnrss-string-as-multibyte 'identity)
+ (defalias 'nnrss-string-as-multibyte 'string-as-multibyte))
+
+;;; Snarf functions
+
+(defun nnrss-check-group (group server)
+ (let (file xml subject url extra changed author
+ date rss-ns rdf-ns content-ns dc-ns)
+ (if (and nnrss-use-local
+ (file-exists-p (setq file (expand-file-name
+ (nnrss-translate-file-chars
+ (concat group ".xml"))
+ nnrss-directory))))
+ (setq xml (nnrss-fetch file t))
+ (setq url (or (nth 2 (assoc group nnrss-server-data))
+ (second (assoc group nnrss-group-alist))))
+ (unless url
+ (setq url
+ (cdr
+ (assoc 'href
+ (nnrss-discover-feed
+ (read-string
+ (format "URL to search for %s: " group) "http://")))))
+ (let ((pair (assoc group nnrss-server-data)))
+ (if pair
+ (setcdr (cdr pair) (list url))
+ (push (list group nnrss-group-max url) nnrss-server-data)))
+ (setq changed t))
+ (setq xml (nnrss-fetch url)))
+ ;; See
+ ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html
+ ;; for more RSS namespaces.
+ (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/")
+ rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
+ rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")
+ content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/"))
+ (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
+ (when (and (listp item)
+ (eq (intern (concat rss-ns "item")) (car item))
+ (setq url (nnrss-decode-entities-unibyte-string
+ (nnrss-node-text rss-ns 'link (cddr item))))
+ (not (gnus-gethash url nnrss-group-hashtb)))
+ (setq subject (nnrss-node-text rss-ns 'title item))
+ (setq extra (or (nnrss-node-text content-ns 'encoded item)
+ (nnrss-node-text rss-ns 'description item)))
+ (setq author (or (nnrss-node-text rss-ns 'author item)
+ (nnrss-node-text dc-ns 'creator item)
+ (nnrss-node-text dc-ns 'contributor item)))
+ (setq date (or (nnrss-node-text dc-ns 'date item)
+ (nnrss-node-text rss-ns 'pubDate item)
+ (message-make-date)))
+ (push
+ (list
+ (incf nnrss-group-max)
+ (current-time)
+ url
+ (and subject (nnrss-decode-entities-unibyte-string subject))
+ (and author (nnrss-decode-entities-unibyte-string author))
+ date
+ (and extra (nnrss-decode-entities-unibyte-string extra)))
+ nnrss-group-data)
+ (gnus-sethash url (car nnrss-group-data) nnrss-group-hashtb)
+ (setq changed t)))
+ (when changed
+ (nnrss-save-group-data group server)
+ (let ((pair (assoc group nnrss-server-data)))
+ (if pair
+ (setcar (cdr pair) nnrss-group-max)
+ (push (list group nnrss-group-max) nnrss-server-data)))
+ (nnrss-save-server-data server))))
+
+(defun nnrss-generate-download-script ()
+ "Generate a download script in the current buffer.
+It is useful when `(setq nnrss-use-local t)'."
+ (interactive)
+ (insert "#!/bin/sh\n")
+ (insert "WGET=wget\n")
+ (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
+ (dolist (elem nnrss-server-data)
+ (let ((url (or (nth 2 elem)
+ (second (assoc (car elem) nnrss-group-alist)))))
+ (insert "$WGET -q -O \"$RSSDIR\"/'"
+ (nnrss-translate-file-chars (concat (car elem) ".xml"))
+ "' '" url "'\n"))))
+
+(defun nnrss-translate-file-chars (name)
+ (let ((nnheader-file-name-translation-alist
+ (append nnheader-file-name-translation-alist '((?' . ?_)))))
+ (nnheader-translate-file-chars name)))
+
+(defvar nnrss-moreover-url
+ "http://w.moreover.com/categories/category_list_rss.html"
+ "The url of moreover.com categories.")
+
+(defun nnrss-snarf-moreover-categories ()
+ "Snarf RSS links from moreover.com."
+ (interactive)
+ (let (category name url changed)
+ (with-temp-buffer
+ (nnrss-insert nnrss-moreover-url)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
+ (if (match-string 1)
+ (setq category (match-string 1))
+ (setq url (match-string 2)
+ name (mm-url-decode-entities-string
+ (rfc2231-decode-encoded-string
+ (match-string 3))))
+ (if category
+ (setq name (concat category "." name)))
+ (unless (assoc name nnrss-server-data)
+ (setq changed t)
+ (push (list name 0 url) nnrss-server-data)))))
+ (if changed
+ (nnrss-save-server-data ""))))
+
+(defun nnrss-format-string (string)
+ (gnus-replace-in-string (nnrss-string-as-multibyte string) " *\n *" " "))
+
+(defun nnrss-node-text (namespace local-name element)
+ (let* ((node (assq (intern (concat namespace (symbol-name local-name)))
+ element))
+ (text (if (and node (listp node))
+ (nnrss-node-just-text node)
+ node))
+ (cleaned-text (if text (gnus-replace-in-string
+ text "^[\000-\037\177]+\\|^ +\\| +$" ""))))
+ (if (string-equal "" cleaned-text)
+ nil
+ cleaned-text)))
+
+(defun nnrss-node-just-text (node)
+ (if (and node (listp node))
+ (mapconcat 'nnrss-node-just-text (cddr node) " ")
+ node))
+
+(defun nnrss-find-el (tag data &optional found-list)
+ "Find the all matching elements in the data. Careful with this on
+large documents!"
+ (if (listp data)
+ (mapcar (lambda (bit)
+ (if (car-safe bit)
+ (progn (if (equal tag (car bit))
+ (setq found-list
+ (append found-list
+ (list bit))))
+ (if (and (listp (car-safe (caddr bit)))
+ (not (stringp (caddr bit))))
+ (setq found-list
+ (append found-list
+ (nnrss-find-el
+ tag (caddr bit))))
+ (setq found-list
+ (append found-list
+ (nnrss-find-el
+ tag (cddr bit))))))))
+ data))
+ found-list)
+
+(defun nnrss-rsslink-p (el)
+ "Test if the element we are handed is an RSS autodiscovery link."
+ (and (eq (car-safe el) 'link)
+ (string-equal (cdr (assoc 'rel (cadr el))) "alternate")
+ (or (string-equal (cdr (assoc 'type (cadr el)))
+ "application/rss+xml")
+ (string-equal (cdr (assoc 'type (cadr el))) "text/xml"))))
+
+(defun nnrss-get-rsslinks (data)
+ "Extract the <link> elements that are links to RSS from the parsed data."
+ (delq nil (mapcar
+ (lambda (el)
+ (if (nnrss-rsslink-p el) el))
+ (nnrss-find-el 'link data))))
+
+(defun nnrss-extract-hrefs (data)
+ "Recursively extract hrefs from a page's source. DATA should be
+the output of xml-parse-region or w3-parse-buffer."
+ (mapcar (lambda (ahref)
+ (cdr (assoc 'href (cadr ahref))))
+ (nnrss-find-el 'a data)))
+
+(defmacro nnrss-match-macro (base-uri item
+ onsite-list offsite-list)
+ `(cond ((or (string-match (concat "^" ,base-uri) ,item)
+ (not (string-match "://" ,item)))
+ (setq ,onsite-list (append ,onsite-list (list ,item))))
+ (t (setq ,offsite-list (append ,offsite-list (list ,item))))))
+
+(defun nnrss-order-hrefs (base-uri hrefs)
+ "Given a list of hrefs, sort them using the following priorities:
+ 1. links ending in .rss
+ 2. links ending in .rdf
+ 3. links ending in .xml
+ 4. links containing the above
+ 5. offsite links
+
+BASE-URI is used to determine the location of the links and
+whether they are `offsite' or `onsite'."
+ (let (rss-onsite-end rdf-onsite-end xml-onsite-end
+ rss-onsite-in rdf-onsite-in xml-onsite-in
+ rss-offsite-end rdf-offsite-end xml-offsite-end
+ rss-offsite-in rdf-offsite-in xml-offsite-in)
+ (mapcar (lambda (href)
+ (if (not (null href))
+ (cond ((string-match "\\.rss$" href)
+ (nnrss-match-macro
+ base-uri href rss-onsite-end rss-offsite-end))
+ ((string-match "\\.rdf$" href)
+ (nnrss-match-macro
+ base-uri href rdf-onsite-end rdf-offsite-end))
+ ((string-match "\\.xml$" href)
+ (nnrss-match-macro
+ base-uri href xml-onsite-end xml-offsite-end))
+ ((string-match "rss" href)
+ (nnrss-match-macro
+ base-uri href rss-onsite-in rss-offsite-in))
+ ((string-match "rdf" href)
+ (nnrss-match-macro
+ base-uri href rdf-onsite-in rdf-offsite-in))
+ ((string-match "xml" href)
+ (nnrss-match-macro
+ base-uri href xml-onsite-in xml-offsite-in)))))
+ hrefs)
+ (append
+ rss-onsite-end rdf-onsite-end xml-onsite-end
+ rss-onsite-in rdf-onsite-in xml-onsite-in
+ rss-offsite-end rdf-offsite-end xml-offsite-end
+ rss-offsite-in rdf-offsite-in xml-offsite-in)))
+
+(defun nnrss-discover-feed (url)
+ "Given a page, find an RSS feed using Mark Pilgrim's
+`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)."
+
+ (let ((parsed-page (nnrss-fetch url)))
+
+;; 1. if this url is the rss, use it.
+ (if (nnrss-rss-p parsed-page)
+ (let ((rss-ns (nnrss-get-namespace-prefix parsed-page "http://purl.org/rss/1.0/")))
+ (nnrss-rss-title-description rss-ns parsed-page url))
+
+;; 2. look for the <link rel="alternate"
+;; type="application/rss+xml" and use that if it is there.
+ (let ((links (nnrss-get-rsslinks parsed-page)))
+ (if links
+ (let* ((xml (nnrss-fetch
+ (cdr (assoc 'href (cadar links)))))
+ (rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")))
+ (nnrss-rss-title-description rss-ns xml (cdr (assoc 'href (cadar links)))))
+
+;; 3. look for links on the site in the following order:
+;; - onsite links ending in .rss, .rdf, or .xml
+;; - onsite links containing any of the above
+;; - offsite links ending in .rss, .rdf, or .xml
+;; - offsite links containing any of the above
+ (let* ((base-uri (progn (string-match ".*://[^/]+/?" url)
+ (match-string 0 url)))
+ (hrefs (nnrss-order-hrefs
+ base-uri (nnrss-extract-hrefs parsed-page)))
+ (rss-link nil))
+ (while (and (eq rss-link nil) (not (eq hrefs nil)))
+ (let ((href-data (nnrss-fetch (car hrefs))))
+ (if (nnrss-rss-p href-data)
+ (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/")))
+ (setq rss-link (nnrss-rss-title-description
+ rss-ns href-data (car hrefs))))
+ (setq hrefs (cdr hrefs)))))
+ (if rss-link rss-link
+
+;; 4. check syndic8
+ (nnrss-find-rss-via-syndic8 url))))))))
+
+(defun nnrss-find-rss-via-syndic8 (url)
+ "query syndic8 for the rss feeds it has for the url."
+ (if (not (locate-library "xml-rpc"))
+ (progn
+ (message "XML-RPC is not available... not checking Syndic8.")
+ nil)
+ (require 'xml-rpc)
+ (let ((feedid (xml-rpc-method-call
+ "http://www.syndic8.com/xmlrpc.php"
+ 'syndic8.FindSites
+ url)))
+ (when feedid
+ (let* ((feedinfo (xml-rpc-method-call
+ "http://www.syndic8.com/xmlrpc.php"
+ 'syndic8.GetFeedInfo
+ feedid))
+ (urllist
+ (delq nil
+ (mapcar
+ (lambda (listinfo)
+ (if (string-equal
+ (cdr (assoc "status" listinfo))
+ "Syndicated")
+ (cons
+ (cdr (assoc "sitename" listinfo))
+ (list
+ (cons 'title
+ (cdr (assoc
+ "sitename" listinfo)))
+ (cons 'href
+ (cdr (assoc
+ "dataurl" listinfo)))))))
+ feedinfo))))
+ (if (not (> (length urllist) 1))
+ (cdar urllist)
+ (let ((completion-ignore-case t)
+ (selection
+ (mapcar (lambda (listinfo)
+ (cons (cdr (assoc "sitename" listinfo))
+ (string-to-int
+ (cdr (assoc "feedid" listinfo)))))
+ feedinfo)))
+ (cdr (assoc
+ (completing-read
+ "Multiple feeds found. Select one: "
+ selection nil t) urllist)))))))))
+
+(defun nnrss-rss-p (data)
+ "Test if data is an RSS feed. Simply ensures that the first
+element is rss or rdf."
+ (or (eq (caar data) 'rss)
+ (eq (caar data) 'rdf:RDF)))
+
+(defun nnrss-rss-title-description (rss-namespace data url)
+ "Return the title of an RSS feed."
+ (if (nnrss-rss-p data)
+ (let ((description (intern (concat rss-namespace "description")))
+ (title (intern (concat rss-namespace "title")))
+ (channel (nnrss-find-el (intern (concat rss-namespace "channel"))
+ data)))
+ (list
+ (cons 'description (caddr (nth 0 (nnrss-find-el description channel))))
+ (cons 'title (caddr (nth 0 (nnrss-find-el title channel))))
+ (cons 'href url)))))
+
+(defun nnrss-get-namespace-prefix (el uri)
+ "Given EL (containing a parsed element) and URI (containing a string
+that gives the URI for which you want to retrieve the namespace
+prefix), return the prefix."
+ (let* ((prefix (car (rassoc uri (cadar el))))
+ (nslist (if prefix
+ (split-string (symbol-name prefix) ":")))
+ (ns (cond ((eq (length nslist) 1) ; no prefix given
+ "")
+ ((eq (length nslist) 2) ; extract prefix
+ (cadr nslist)))))
+ (if (and ns (not (eq ns "")))
+ (concat ns ":")
+ ns)))
+
+(provide 'nnrss)
+
+
+;;; nnrss.el ends here
+
+;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267
diff --git a/lisp/gnus/nnslashdot.el b/lisp/gnus/nnslashdot.el
index b2730e561f4..f4b3cf0db67 100644
--- a/lisp/gnus/nnslashdot.el
+++ b/lisp/gnus/nnslashdot.el
@@ -1,5 +1,5 @@
;;; nnslashdot.el --- interfacing with Slashdot
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -23,9 +23,6 @@
;;; Commentary:
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
;;; Code:
(eval-when-compile (require 'cl))
@@ -36,11 +33,7 @@
(require 'gnus)
(require 'nnmail)
(require 'mm-util)
-(eval-when-compile
- (ignore-errors
- (require 'nnweb)))
-;; Report failure to find w3 at load time if appropriate.
-(eval '(require 'nnweb))
+(require 'mm-url)
(nnoo-declare nnslashdot)
@@ -60,6 +53,9 @@
(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml"
"Where nnslashdot will fetch the stories from.")
+(defvoo nnslashdot-use-front-page nil
+ "Use the front page in addition to the backslash page.")
+
(defvoo nnslashdot-threshold -1
"The article threshold.")
@@ -105,12 +101,13 @@
(let ((case-fold-search t))
(erase-buffer)
(when (= start 1)
- (nnweb-insert (format nnslashdot-article-url
- (nnslashdot-sid-strip sid)) t)
+ (mm-url-insert (format nnslashdot-article-url sid) t)
(goto-char (point-min))
+ (if (eobp)
+ (error "Couldn't open connection to slashdot"))
(re-search-forward "Posted by[ \t\r\n]+")
(when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)")
- (setq from (nnweb-decode-entities-string (match-string 2))))
+ (setq from (mm-url-decode-entities-string (match-string 2))))
(search-forward "on ")
(setq date (nnslashdot-date-to-date
(buffer-substring (point) (1- (search-forward "<")))))
@@ -122,15 +119,14 @@
1
(make-full-mail-header
1 group from date
- (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>")
+ (concat "<" sid "%1@slashdot>")
"" 0 lines nil nil))
headers)
(setq start (if nnslashdot-threaded 2 (pop articles))))
(while (and start (<= start last))
(setq point (goto-char (point-max)))
- (nnweb-insert
- (format nnslashdot-comments-url
- (nnslashdot-sid-strip sid)
+ (mm-url-insert
+ (format nnslashdot-comments-url sid
nnslashdot-threshold 0 (- start 2))
t)
(when (and nnslashdot-threaded first-comments)
@@ -154,20 +150,26 @@
(setq changed t))
(when (string-match "^Re: *" subject)
(setq subject (concat "Re: " (substring subject (match-end 0)))))
- (setq subject (nnweb-decode-entities-string subject))
+ (setq subject (mm-url-decode-entities-string subject))
(search-forward "<BR>")
- (if (looking-at
- "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
- (progn
- (goto-char (- (match-end 0) 5))
- (setq from (concat
- (nnweb-decode-entities-string (match-string 1))
- " <" (match-string 3) ">")))
- (setq from "")
- (when (looking-at "by \\([^<>]*\\) on ")
- (goto-char (- (match-end 0) 5))
- (setq from (nnweb-decode-entities-string (match-string 1)))))
- (search-forward " on ")
+ (cond
+ ((looking-at
+ "by[ \t\n]+<a[^>]+>\\([^<]+\\)</a>[ \t\n]*(\\(<[^>]+>\\)*\\([^<>)]+\\))")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 3) ">")))
+ ((looking-at "by[ \t\n]+<a[^>]+>\\([^<(]+\\) (\\([0-9]+\\))</a>")
+ (goto-char (- (match-end 0) 5))
+ (setq from (concat
+ (mm-url-decode-entities-string (match-string 1))
+ " <" (match-string 2) ">")))
+ ((looking-at "by \\([^<>]*\\)[\t\n\r ]+on ")
+ (goto-char (- (match-end 0) 5))
+ (setq from (mm-url-decode-entities-string (match-string 1))))
+ (t
+ (setq from "")))
+ (search-forward "on ")
(setq date
(nnslashdot-date-to-date
(buffer-substring (point) (progn (skip-chars-forward "^()<>\n\r") (point)))))
@@ -187,10 +189,9 @@
article
(concat subject " (" score ")")
from date
- (concat "<" (nnslashdot-sid-strip sid) "%" cid "@slashdot>")
+ (concat "<" sid "%" cid "@slashdot>")
(if parent
- (concat "<" (nnslashdot-sid-strip sid) "%"
- parent "@slashdot>")
+ (concat "<" sid "%" parent "@slashdot>")
"")
0 lines nil nil))
headers)
@@ -260,7 +261,7 @@
(point)
(progn
(re-search-forward
- "&lt;&nbsp;[ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article")
+ "<IFRAME\\|<SCRIPT LANGUAGE=\"JAVASCRIPT\">\\|<!-- no ad 6 -->\\|&lt;&nbsp;[ \t\r\n]*<A HREF=\"\\(\\(http:\\)?//slashdot\\.org\\)?/article")
(match-beginning 0)))))
(setq cid (cdr (assq article
(nth 4 (assoc group nnslashdot-groups)))))
@@ -300,19 +301,22 @@
(deffoo nnslashdot-request-list (&optional server)
(nnslashdot-possibly-change-server nil server)
(let ((number 0)
+ (first nnslashdot-use-front-page)
sid elem description articles gname)
(condition-case why
;; First we do the Ultramode to get info on all the latest groups.
(progn
(mm-with-unibyte-buffer
- (nnweb-insert nnslashdot-backslash-url t)
+ (mm-url-insert nnslashdot-backslash-url t)
(goto-char (point-min))
+ (if (eobp)
+ (error "Couldn't open connection to slashdot"))
(while (search-forward "<story>" nil t)
(narrow-to-region (point) (search-forward "</story>"))
(goto-char (point-min))
(re-search-forward "<title>\\([^<]+\\)</title>")
(setq description
- (nnweb-decode-entities-string (match-string 1)))
+ (mm-url-decode-entities-string (match-string 1)))
(re-search-forward "<url>\\([^<]+\\)</url>")
(setq sid (match-string 1))
(string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid)
@@ -327,20 +331,22 @@
(goto-char (point-max))
(widen)))
;; Then do the older groups.
- (while (> (- nnslashdot-group-number number) 0)
+ (while (or first
+ (> (- nnslashdot-group-number number) 0))
+ (setq first nil)
(mm-with-unibyte-buffer
(let ((case-fold-search t))
- (nnweb-insert (format nnslashdot-active-url number) t)
+ (mm-url-insert (format nnslashdot-active-url number) t)
(goto-char (point-min))
(while (re-search-forward
- "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>"
+ "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)</a>"
nil t)
(setq sid (match-string 1)
description
- (nnweb-decode-entities-string (match-string 2)))
+ (mm-url-decode-entities-string (match-string 2)))
(forward-line 1)
- (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t)
- (setq articles (string-to-number (match-string 1))))
+ (when (re-search-forward "with \\([0-9]+\\) comment" nil t)
+ (setq articles (1+ (string-to-number (match-string 1)))))
(setq gname (concat description " (" sid ")"))
(if (setq elem (assoc gname nnslashdot-groups))
(setcar (cdr elem) articles)
@@ -359,7 +365,7 @@
(deffoo nnslashdot-request-post (&optional server)
(nnslashdot-possibly-change-server nil server)
- (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups")))
+ (let ((sid (message-fetch-field "newsgroups"))
(subject (message-fetch-field "subject"))
(references (car (last (split-string
(message-fetch-field "references")))))
@@ -394,7 +400,7 @@
(message-goto-body)
(setq body (buffer-substring (point) (point-max)))
(erase-buffer)
- (nnweb-fetch-form
+ (mm-url-fetch-form
"http://slashdot.org/comments.pl"
`(("sid" . ,sid)
("pid" . ,pid)
@@ -499,14 +505,13 @@
(set-buffer nntp-server-buffer)
(erase-buffer)
(dolist (elem nnslashdot-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
+ (when (numberp (cadr elem))
+ (insert (prin1-to-string (car elem))
+ " " (number-to-string (cadr elem)) " 1 y\n")))))
(defun nnslashdot-lose (why)
(error "Slashdot HTML has changed; please get a new version of nnslashdot"))
-(defalias 'nnslashdot-sid-strip 'identity)
-
(provide 'nnslashdot)
;;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3
diff --git a/lisp/gnus/nnsoup.el b/lisp/gnus/nnsoup.el
index 2e877190cea..9c69b1d3c63 100644
--- a/lisp/gnus/nnsoup.el
+++ b/lisp/gnus/nnsoup.el
@@ -1,10 +1,10 @@
;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
@@ -337,7 +337,7 @@ backend for the messages.")
(delete-file (nnsoup-file prefix t)))
t)
(setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
- (setq articles (gnus-sorted-complement articles range-list))))
+ (setq articles (gnus-sorted-difference articles range-list))))
(when (not mod-time)
(setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
(if (cddr total-infolist)
@@ -656,20 +656,20 @@ backend for the messages.")
(and areas (car areas))))
(defvar nnsoup-old-functions
- (list message-send-mail-function message-send-news-function))
+ (list message-send-mail-real-function message-send-news-function))
;;;###autoload
(defun nnsoup-set-variables ()
"Use the SOUP methods for posting news and mailing mail."
(interactive)
(setq message-send-news-function 'nnsoup-request-post)
- (setq message-send-mail-function 'nnsoup-request-mail))
+ (setq message-send-mail-real-function 'nnsoup-request-mail))
;;;###autoload
(defun nnsoup-revert-variables ()
"Revert posting and mailing methods to the standard Emacs methods."
(interactive)
- (setq message-send-mail-function (car nnsoup-old-functions))
+ (setq message-send-mail-real-function (car nnsoup-old-functions))
(setq message-send-news-function (cadr nnsoup-old-functions)))
(defun nnsoup-store-reply (kind)
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 6a50fb787a7..eaf5159be8f 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -1,11 +1,11 @@
;;; nnspool.el --- spool access for GNU Emacs
;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 2000, 2002
+;; 2000, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
@@ -50,7 +50,10 @@ If you are using Cnews, you probably should set this variable to nil.")
(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
"Local news nov directory.")
-(defvoo nnspool-lib-dir "/usr/lib/news/"
+(defvoo nnspool-lib-dir
+ (if (file-exists-p "/usr/lib/news/active")
+ "/usr/lib/news/"
+ "/var/lib/news/")
"Where the local news library files are stored.")
(defvoo nnspool-active-file (concat nnspool-lib-dir "active")
@@ -69,8 +72,8 @@ If you are using Cnews, you probably should set this variable to nil.")
"Local news active date file.")
(defvoo nnspool-large-newsgroup 50
- "The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+ "The number of articles which indicates a large newsgroup.
+If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status.")
(defvoo nnspool-nov-is-evil nil
@@ -361,7 +364,7 @@ there.")
(let ((nov (nnheader-group-pathname
nnspool-current-group nnspool-nov-directory ".overview"))
(arts articles)
- (nnheader-file-coding-system nnspool-file-coding-system)
+ (nnheader-file-coding-system nnspool-file-coding-system)
last)
(if (not (file-exists-p nov))
()
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 5722ba8456a..6b312de24e4 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -9,18 +9,18 @@
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
@@ -65,61 +65,82 @@ You probably don't want to do that, though.")
(defvoo nntp-open-connection-function 'nntp-open-network-stream
"*Function used for connecting to a remote system.
-It will be called with the buffer to output in.
+It will be called with the buffer to output in as argument.
-Two pre-made functions are `nntp-open-network-stream', which is the
-default, and simply connects to some port or other on the remote
-system (see nntp-port-number). The other are `nntp-open-rlogin',
-which does an rlogin on the remote system, and then does a telnet to
-the NNTP server available there (see nntp-rlogin-parameters) and
-`nntp-open-telnet' which telnets to a remote system, logs in and does
-the same.")
+Currently, five such functions are provided (please refer to their
+respective doc string for more information), three of them establishing
+direct connections to the nntp server, and two of them using an indirect
+host.
-(defvoo nntp-rlogin-program "rsh"
- "*Program used to log in on remote machines.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
+Direct connections:
+- `nntp-open-network-stream' (the default),
+- `nntp-open-ssl-stream',
+- `nntp-open-tls-stream',
+- `nntp-open-telnet-stream'.
-(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-rlogin'.
-That function may be used as `nntp-open-connection-function'. In that
-case, this list will be used as the parameter list given to rsh.")
+Indirect connections:
+- `nntp-open-via-rlogin-and-telnet',
+- `nntp-open-via-telnet-and-telnet'.")
-(defvoo nntp-rlogin-user-name nil
- "*User name on remote system when using the rlogin connect method.")
+(defvoo nntp-pre-command nil
+ "*Pre-command to use with the various nntp-open-via-* methods.
+This is where you would put \"runsocks\" or stuff like that.")
-(defvoo nntp-telnet-parameters
- '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-telnet'.
-That function may be used as `nntp-open-connection-function'. In that
-case, this list will be executed as a command after logging in
-via telnet.")
+(defvoo nntp-telnet-command "telnet"
+ "*Telnet command used to connect to the nntp server.
+This command is used by the various nntp-open-via-* methods.")
-(defvoo nntp-telnet-user-name nil
- "User name to log in via telnet with.")
+(defvoo nntp-telnet-switches '("-8")
+ "*Switches given to the telnet command `nntp-telnet-command'.")
-(defvoo nntp-telnet-passwd nil
- "Password to use to log in via telnet with.")
+(defvoo nntp-end-of-line "\r\n"
+ "*String to use on the end of lines when talking to the NNTP server.
+This is \"\\r\\n\" by default, but should be \"\\n\" when
+using and indirect connection method (nntp-open-via-*).")
-(defvoo nntp-open-telnet-envuser nil
- "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
+(defvoo nntp-via-rlogin-command "rsh"
+ "*Rlogin command used to connect to an intermediate host.
+This command is used by the `nntp-open-via-rlogin-and-telnet' method.
+The default is \"rsh\", but \"ssh\" is a popular alternative.")
-(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
- "*Regular expression to match the shell prompt on the remote machine.")
+(defvoo nntp-via-rlogin-command-switches nil
+ "*Switches given to the rlogin command `nntp-via-rlogin-command'.
+If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
+\(\"-C\") in order to compress all data connections, otherwise set this
+to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet
+command requires a pseudo-tty allocation on an intermediate host.")
-(defvoo nntp-telnet-command "telnet"
- "Command used to start telnet.")
+(defvoo nntp-via-telnet-command "telnet"
+ "*Telnet command used to connect to an intermediate host.
+This command is used by the `nntp-open-via-telnet-and-telnet' method.")
-(defvoo nntp-telnet-switches '("-8")
- "Switches given to the telnet command.")
+(defvoo nntp-via-telnet-switches '("-8")
+ "*Switches given to the telnet command `nntp-via-telnet-command'.")
-(defvoo nntp-end-of-line "\r\n"
- "String to use on the end of lines when talking to the NNTP server.
-This is \"\\r\\n\" by default, but should be \"\\n\" when
-using rlogin or telnet to communicate with the server.")
+(defvoo nntp-via-user-name nil
+ "*User name to log in on an intermediate host with.
+This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
+
+(defvoo nntp-via-user-password nil
+ "*Password to use to log in on an intermediate host with.
+This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
+
+(defvoo nntp-via-address nil
+ "*Address of an intermediate host to connect to.
+This variable is used by the `nntp-open-via-rlogin-and-telnet' and
+`nntp-open-via-telnet-and-telnet' methods.")
+
+(defvoo nntp-via-envuser nil
+ "*Whether both telnet client and server support the ENVIRON option.
+If non-nil, there will be no prompt for a login name.")
+
+(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
+ "*Regular expression to match the shell prompt on an intermediate host.
+This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
(defvoo nntp-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+ "*The number of articles which indicates a large newsgroup.
+If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status.")
(defvoo nntp-maximum-request 400
@@ -174,8 +195,7 @@ server there that you can connect to. See also
(string :format "Login: %v"))
(cons :format "%v"
(const :format "" "password")
- (string :format "Password: %v"))))))
- :group 'nntp)
+ (string :format "Password: %v")))))))
@@ -184,6 +204,10 @@ server there that you can connect to. See also
If this variable is nil, which is the default, no timers are set.
NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
+(defvoo nntp-prepare-post-hook nil
+ "*Hook run just before posting an article. It is supposed to be used
+to insert Cancel-Lock headers.")
+
;;; Internal variables.
(defvar nntp-record-commands nil
@@ -224,16 +248,13 @@ noticing asynchronous data.")
(defvar nntp-async-timer nil)
(defvar nntp-async-process-list nil)
-(defvar nntp-ssl-program
+(defvar nntp-ssl-program
"openssl s_client -quiet -ssl3 -connect %s:%p"
"A string containing commands for SSL connections.
Within a string, %s is replaced with the server address and %p with
port number on server. The program should accept IMAP commands on
stdin and return responses to stdout.")
-(eval-and-compile
- (autoload 'mail-source-read-passwd "mail-source"))
-
;;; Internal functions.
@@ -247,7 +268,9 @@ stdin and return responses to stdout.")
nntp-last-command string)
(when nntp-record-commands
(nntp-record-command string))
- (process-send-string process (concat string nntp-end-of-line)))
+ (process-send-string process (concat string nntp-end-of-line))
+ (or (memq (process-status process) '(open run))
+ (nntp-report "Server closed connection")))
(defun nntp-record-command (string)
"Record the command STRING."
@@ -259,6 +282,27 @@ stdin and return responses to stdout.")
"." (format "%03d" (/ (nth 2 time) 1000))
" " nntp-address " " string "\n"))))
+(defun nntp-report (&rest args)
+ "Report an error from the nntp backend. The first string in ARGS
+can be a format string. For some commands, the failed command may be
+retried once before actually displaying the error report."
+
+ (when nntp-record-commands
+ (nntp-record-command "*** CALLED nntp-report ***"))
+
+ (nnheader-report 'nntp args)
+
+ (apply 'error args))
+
+(defun nntp-report-1 (&rest args)
+ "Throws out to nntp-with-open-group-error so that the connection may
+be restored and the command retried."
+
+ (when nntp-record-commands
+ (nntp-record-command "*** CONNECTION LOST ***"))
+
+ (throw 'nntp-with-open-group-error t))
+
(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
"Wait for WAIT-FOR to arrive from PROCESS."
(save-excursion
@@ -269,6 +313,8 @@ stdin and return responses to stdout.")
(memq (process-status process) '(open run)))
(when (looking-at "480")
(nntp-handle-authinfo process))
+ (when (looking-at "^.*\n")
+ (delete-region (point) (progn (forward-line 1) (point))))
(nntp-accept-process-output process)
(goto-char (point-min)))
(prog1
@@ -278,27 +324,31 @@ stdin and return responses to stdout.")
(nntp-snarf-error-message)
nil))
((not (memq (process-status process) '(open run)))
- (nnheader-report 'nntp "Server closed connection"))
+ (nntp-report "Server closed connection"))
(t
(goto-char (point-max))
- (let ((limit (point-min)))
+ (let ((limit (point-min))
+ response)
(while (not (re-search-backward wait-for limit t))
(nntp-accept-process-output process)
;; We assume that whatever we wait for is less than 1000
;; characters long.
(setq limit (max (- (point-max) 1000) (point-min)))
- (goto-char (point-max))))
+ (goto-char (point-max)))
+ (setq response (match-string 0))
+ (with-current-buffer nntp-server-buffer
+ (setq nntp-process-response response)))
(nntp-decode-text (not decode))
(unless discard
(save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (insert-buffer-substring (process-buffer process))
+ (set-buffer buffer)
+ (goto-char (point-max))
+ (insert-buffer-substring (process-buffer process))
;; Nix out "nntp reading...." message.
(when nntp-have-messaged
(setq nntp-have-messaged nil)
- (nnheader-message 5 ""))
- t))))
+ (nnheader-message 5 ""))))
+ t))
(unless discard
(erase-buffer)))))
@@ -312,7 +362,7 @@ stdin and return responses to stdout.")
(let ((alist nntp-connection-alist)
(buffer (if (stringp buffer) (get-buffer buffer) buffer))
process entry)
- (while (setq entry (pop alist))
+ (while (and alist (setq entry (pop alist)))
(when (eq buffer (cadr entry))
(setq process (car entry)
alist nil)))
@@ -338,32 +388,33 @@ stdin and return responses to stdout.")
"Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
(let ((process (or (nntp-find-connection buffer)
(nntp-open-connection buffer))))
- (if (not process)
- (nnheader-report 'nntp "Couldn't open connection to %s" address)
- (unless (or nntp-inhibit-erase nnheader-callback-function)
- (save-excursion
- (set-buffer (process-buffer process))
- (erase-buffer)))
- (condition-case err
- (progn
- (when command
- (nntp-send-string process command))
- (cond
- ((eq callback 'ignore)
- t)
- ((and callback wait-for)
- (nntp-async-wait process wait-for buffer decode callback)
- t)
- (wait-for
- (nntp-wait-for process wait-for buffer decode))
- (t t)))
- (error
- (nnheader-report 'nntp "Couldn't open connection to %s: %s"
- address err))
- (quit
- (message "Quit retrieving data from nntp")
- (signal 'quit nil)
- nil)))))
+ (if process
+ (progn
+ (unless (or nntp-inhibit-erase nnheader-callback-function)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (erase-buffer)))
+ (condition-case err
+ (progn
+ (when command
+ (nntp-send-string process command))
+ (cond
+ ((eq callback 'ignore)
+ t)
+ ((and callback wait-for)
+ (nntp-async-wait process wait-for buffer decode callback)
+ t)
+ (wait-for
+ (nntp-wait-for process wait-for buffer decode))
+ (t t)))
+ (error
+ (nnheader-report 'nntp "Couldn't open connection to %s: %s"
+ address err))
+ (quit
+ (message "Quit retrieving data from nntp")
+ (signal 'quit nil)
+ nil)))
+ (nnheader-report 'nntp "Couldn't open connection to %s" address))))
(defsubst nntp-send-command (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
@@ -372,17 +423,56 @@ stdin and return responses to stdout.")
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)))
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function))
+ (let* ((command (mapconcat 'identity strings " "))
+ (process (nntp-find-connection nntp-server-buffer))
+ (buffer (and process (process-buffer process)))
+ (pos (and buffer (with-current-buffer buffer (point)))))
+ (if process
+ (prog1
+ (nntp-retrieve-data command
+ nntp-address nntp-port-number
+ nntp-server-buffer
+ wait-for nnheader-callback-function)
+ ;; If nothing to wait for, still remove possibly echo'ed commands.
+ ;; We don't have echos if nntp-open-connection-function
+ ;; is `nntp-open-network-stream', so we skip this in that case.
+ (unless (or wait-for
+ (equal nntp-open-connection-function
+ 'nntp-open-network-stream))
+ (nntp-accept-response)
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1)
+ (gnus-point-at-bol))))
+ )))
+ (nnheader-report 'nntp "Couldn't open connection to %s."
+ nntp-address))))
(defun nntp-send-command-nodelete (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function))
+ (let* ((command (mapconcat 'identity strings " "))
+ (process (nntp-find-connection nntp-server-buffer))
+ (buffer (and process (process-buffer process)))
+ (pos (and buffer (with-current-buffer buffer (point)))))
+ (if process
+ (prog1
+ (nntp-retrieve-data command
+ nntp-address nntp-port-number
+ nntp-server-buffer
+ wait-for nnheader-callback-function)
+ ;; If nothing to wait for, still remove possibly echo'ed commands
+ (unless wait-for
+ (nntp-accept-response)
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1)
+ (gnus-point-at-bol)))))))
+ (nnheader-report 'nntp "Couldn't open connection to %s."
+ nntp-address))))
(defun nntp-send-command-and-decode (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
@@ -391,10 +481,28 @@ stdin and return responses to stdout.")
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)))
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function t))
+ (let* ((command (mapconcat 'identity strings " "))
+ (process (nntp-find-connection nntp-server-buffer))
+ (buffer (and process (process-buffer process)))
+ (pos (and buffer (with-current-buffer buffer (point)))))
+ (if process
+ (prog1
+ (nntp-retrieve-data command
+ nntp-address nntp-port-number
+ nntp-server-buffer
+ wait-for nnheader-callback-function t)
+ ;; If nothing to wait for, still remove possibly echo'ed commands
+ (unless wait-for
+ (nntp-accept-response)
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char pos)
+ (if (looking-at (regexp-quote command))
+ (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
+ )))
+ (nnheader-report 'nntp "Couldn't open connection to %s."
+ nntp-address))))
+
(defun nntp-send-buffer (wait-for)
"Send the current buffer to server and wait until WAIT-FOR returns."
@@ -436,208 +544,288 @@ stdin and return responses to stdout.")
(t
nil)))
+(eval-when-compile
+ (defvar nntp-with-open-group-internal nil)
+ (defvar nntp-report-n nil))
+
+(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
+ "Protect against servers that don't like clients that keep idle connections opens.
+The problem being that these servers may either close a connection or
+simply ignore any further requests on a connection. Closed
+connections are not detected until accept-process-output has updated
+the process-status. Dropped connections are not detected until the
+connection timeouts (which may be several minutes) or
+nntp-connection-timeout has expired. When these occur
+nntp-with-open-group, opens a new connection then re-issues the NNTP
+command whose response triggered the error."
+ (when (and (listp connectionless)
+ (not (eq connectionless nil)))
+ (setq forms (cons connectionless forms)
+ connectionless nil))
+ `(letf ((nntp-report-n (symbol-function 'nntp-report))
+ ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
+ (nntp-with-open-group-internal nil))
+ (while (catch 'nntp-with-open-group-error
+ ;; Open the connection to the server
+ ;; NOTE: Existing connections are NOT tested.
+ (nntp-possibly-change-group ,group ,server ,connectionless)
+
+ (let ((timer
+ (and nntp-connection-timeout
+ (nnheader-run-at-time
+ nntp-connection-timeout nil
+ '(lambda ()
+ (let ((process (nntp-find-connection
+ nntp-server-buffer))
+ (buffer (and process
+ (process-buffer process))))
+ ;; When I an able to identify the
+ ;; connection to the server AND I've
+ ;; received NO reponse for
+ ;; nntp-connection-timeout seconds.
+ (when (and buffer (eq 0 (buffer-size buffer)))
+ ;; Close the connection. Take no
+ ;; other action as the accept input
+ ;; code will handle the closed
+ ;; connection.
+ (nntp-kill-buffer buffer))))))))
+ (unwind-protect
+ (setq nntp-with-open-group-internal
+ (condition-case nil
+ (progn ,@forms)
+ (quit
+ (nntp-close-server)
+ (signal 'quit nil))))
+ (when timer
+ (nnheader-cancel-timer timer)))
+ nil))
+ (setf (symbol-function 'nntp-report) nntp-report-n))
+ nntp-with-open-group-internal))
+
(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
"Retrieve the headers of ARTICLES."
- (nntp-possibly-change-group group server)
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)
- (if (and (not gnus-nov-is-evil)
- (not nntp-nov-is-evil)
- (nntp-retrieve-headers-with-xover articles fetch-old))
- ;; We successfully retrieved the headers via XOVER.
- 'nov
- ;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- article)
- ;; Send HEAD commands.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "HEAD" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving headers...done"))
-
- ;; Now all of replies are received. Fold continuation lines.
- (nnheader-fold-continuation-lines)
- ;; Remove all "\r"'s.
- (nnheader-strip-cr)
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'headers))))
+ (nntp-with-open-group
+ group server
+ (save-excursion
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ (erase-buffer)
+ (if (and (not gnus-nov-is-evil)
+ (not nntp-nov-is-evil)
+ (nntp-retrieve-headers-with-xover articles fetch-old))
+ ;; We successfully retrieved the headers via XOVER.
+ 'nov
+ ;; XOVER didn't work, so we do it the hard, slow and inefficient
+ ;; way.
+ (let ((number (length articles))
+ (articles articles)
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ article)
+ ;; Send HEAD commands.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "HEAD" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving headers...done"))
+
+ ;; Now all of replies are received. Fold continuation lines.
+ (nnheader-fold-continuation-lines)
+ ;; Remove all "\r"'s.
+ (nnheader-strip-cr)
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'headers)))))
(deffoo nntp-retrieve-groups (groups &optional server)
"Retrieve group info on GROUPS."
- (nntp-possibly-change-group nil server)
- (when (nntp-find-connection-buffer nntp-server-buffer)
- (save-excursion
- ;; Erase nntp-server-buffer before nntp-inhibit-erase.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- ;; The first time this is run, this variable is `try'. So we
- ;; try.
- (when (eq nntp-server-list-active-group 'try)
- (nntp-try-list-active (car groups)))
- (erase-buffer)
- (let ((count 0)
- (received 0)
- (last-point (point-min))
- (nntp-inhibit-erase t)
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
- (while groups
- ;; Send the command to the server.
- (nntp-send-command nil command (pop groups))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null groups) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- ;; Search `blue moon' in this file for the
- ;; reason why set-buffer here.
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (incf received))
- (setq last-point (point))
- (< received count))
- (nntp-accept-response))))
-
- ;; Wait for the reply from the final command.
- (set-buffer buf)
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (when (looking-at "^[23]")
- (while (progn
- (set-buffer buf)
- (goto-char (point-max))
- (if (not nntp-server-list-active-group)
- (not (re-search-backward "\r?\n" (- (point) 3) t))
- (not (re-search-backward "^\\.\r?\n" (- (point) 4) t))))
- (nntp-accept-response)))
-
- ;; Now all replies are received. We remove CRs.
- (set-buffer buf)
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
-
- (if (not nntp-server-list-active-group)
- (progn
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'group)
- ;; We have read active entries, so we just delete the
- ;; superfluous gunk.
- (goto-char (point-min))
- (while (re-search-forward "^[.2-5]" nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'active)))))
+ (nntp-with-open-group
+ nil server
+ (when (nntp-find-connection-buffer nntp-server-buffer)
+ (catch 'done
+ (save-excursion
+ ;; Erase nntp-server-buffer before nntp-inhibit-erase.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+ ;; The first time this is run, this variable is `try'. So we
+ ;; try.
+ (when (eq nntp-server-list-active-group 'try)
+ (nntp-try-list-active (car groups)))
+ (erase-buffer)
+ (let ((count 0)
+ (groups groups)
+ (received 0)
+ (last-point (point-min))
+ (nntp-inhibit-erase t)
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (command (if nntp-server-list-active-group
+ "LIST ACTIVE" "GROUP")))
+ (while groups
+ ;; Timeout may have killed the buffer.
+ (unless (gnus-buffer-live-p buf)
+ (nnheader-report 'nntp "Connection to %s is closed." server)
+ (throw 'done nil))
+ ;; Send the command to the server.
+ (nntp-send-command nil command (pop groups))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null groups) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (and (gnus-buffer-live-p buf)
+ (progn
+ ;; Search `blue moon' in this file for the
+ ;; reason why set-buffer here.
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (incf received))
+ (setq last-point (point))
+ (< received count)))
+ (nntp-accept-response))))
+
+ ;; Wait for the reply from the final command.
+ (unless (gnus-buffer-live-p buf)
+ (nnheader-report 'nntp "Connection to %s is closed." server)
+ (throw 'done nil))
+ (set-buffer buf)
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (and (gnus-buffer-live-p buf)
+ (progn
+ (set-buffer buf)
+ (goto-char (point-max))
+ (if (not nntp-server-list-active-group)
+ (not (re-search-backward "\r?\n"
+ (- (point) 3) t))
+ (not (re-search-backward "^\\.\r?\n"
+ (- (point) 4) t)))))
+ (nntp-accept-response)))
+
+ ;; Now all replies are received. We remove CRs.
+ (unless (gnus-buffer-live-p buf)
+ (nnheader-report 'nntp "Connection to %s is closed." server)
+ (throw 'done nil))
+ (set-buffer buf)
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+
+ (if (not nntp-server-list-active-group)
+ (progn
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'group)
+ ;; We have read active entries, so we just delete the
+ ;; superfluous gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ 'active)))))))
(deffoo nntp-retrieve-articles (articles &optional group server)
- (nntp-possibly-change-group group server)
- (save-excursion
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- (map (apply 'vector articles))
- (point 1)
- article)
- (set-buffer buf)
- (erase-buffer)
- ;; Send ARTICLE command.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "ARTICLE" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (aset map received (cons (aref map received) (point)))
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving articles... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving articles...done"))
-
- ;; Now we have all the responses. We go through the results,
- ;; wash it and copy it over to the server buffer.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq last-point (point-min))
- (mapcar
- (lambda (entry)
- (narrow-to-region
- (setq point (goto-char (point-max)))
- (progn
- (insert-buffer-substring buf last-point (cdr entry))
- (point-max)))
- (setq last-point (cdr entry))
- (nntp-decode-text)
- (widen)
- (cons (car entry) point))
- map))))
+ (nntp-with-open-group
+ group server
+ (save-excursion
+ (let ((number (length articles))
+ (articles articles)
+ (count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf (nntp-find-connection-buffer nntp-server-buffer))
+ (nntp-inhibit-erase t)
+ (map (apply 'vector articles))
+ (point 1)
+ article)
+ (set-buffer buf)
+ (erase-buffer)
+ ;; Send ARTICLE command.
+ (while (setq article (pop articles))
+ (nntp-send-command
+ nil
+ "ARTICLE" (if (numberp article)
+ (int-to-string article)
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ article))
+ (incf count)
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (set-buffer buf)
+ (goto-char last-point)
+ ;; Count replies.
+ (while (nntp-next-result-arrived-p)
+ (aset map received (cons (aref map received) (point)))
+ (setq last-point (point))
+ (incf received))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (nnheader-message 6 "NNTP: Receiving articles... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (nnheader-message 6 "NNTP: Receiving articles...done"))
+
+ ;; Now we have all the responses. We go through the results,
+ ;; wash it and copy it over to the server buffer.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq last-point (point-min))
+ (mapcar
+ (lambda (entry)
+ (narrow-to-region
+ (setq point (goto-char (point-max)))
+ (progn
+ (insert-buffer-substring buf last-point (cdr entry))
+ (point-max)))
+ (setq last-point (cdr entry))
+ (nntp-decode-text)
+ (widen)
+ (cons (car entry) point))
+ map)))))
(defun nntp-try-list-active (group)
(nntp-list-active-group group)
@@ -652,47 +840,53 @@ stdin and return responses to stdout.")
(deffoo nntp-list-active-group (group &optional server)
"Return the active info on GROUP (which can be a regexp)."
- (nntp-possibly-change-group nil server)
- (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)))
(deffoo nntp-request-group-articles (group &optional server)
"Return the list of existing articles in GROUP."
- (nntp-possibly-change-group nil server)
- (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)))
(deffoo nntp-request-article (article &optional group server buffer command)
- (nntp-possibly-change-group group server)
- (when (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "ARTICLE"
- (if (numberp article) (int-to-string article) article))
- (if (and buffer
- (not (equal buffer nntp-server-buffer)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number))
- (nntp-find-group-and-number))))
+ (nntp-with-open-group
+ group server
+ (when (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "ARTICLE"
+ (if (numberp article) (int-to-string article) article))
+ (if (and buffer
+ (not (equal buffer nntp-server-buffer)))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer buffer (point-min) (point-max))
+ (nntp-find-group-and-number group))
+ (nntp-find-group-and-number group)))))
(deffoo nntp-request-head (article &optional group server)
- (nntp-possibly-change-group group server)
- (when (nntp-send-command
- "\r?\n\\.\r?\n" "HEAD"
- (if (numberp article) (int-to-string article) article))
- (prog1
- (nntp-find-group-and-number)
- (nntp-decode-text))))
+ (nntp-with-open-group
+ group server
+ (when (nntp-send-command
+ "\r?\n\\.\r?\n" "HEAD"
+ (if (numberp article) (int-to-string article) article))
+ (prog1
+ (nntp-find-group-and-number group)
+ (nntp-decode-text)))))
(deffoo nntp-request-body (article &optional group server)
- (nntp-possibly-change-group group server)
- (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "BODY"
- (if (numberp article) (int-to-string article) article)))
+ (nntp-with-open-group
+ group server
+ (nntp-send-command-and-decode
+ "\r?\n\\.\r?\n" "BODY"
+ (if (numberp article) (int-to-string article) article))))
(deffoo nntp-request-group (group &optional server dont-check)
- (nntp-possibly-change-group nil server)
- (when (nntp-send-command "^[245].*\n" "GROUP" group)
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (setcar (cddr entry) group))))
+ (nntp-with-open-group
+ nil server
+ (when (nntp-send-command "^[245].*\n" "GROUP" group)
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (setcar (cddr entry) group)))))
(deffoo nntp-close-group (group &optional server)
t)
@@ -750,38 +944,58 @@ stdin and return responses to stdout.")
(nntp-kill-buffer (process-buffer process)))))
(deffoo nntp-request-list (&optional server)
- (nntp-possibly-change-group nil server)
- (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")))
(deffoo nntp-request-list-newsgroups (&optional server)
- (nntp-possibly-change-group nil server)
- (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))
+ (nntp-with-open-group
+ nil server
+ (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")))
(deffoo nntp-request-newgroups (date &optional server)
- (nntp-possibly-change-group nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let* ((time (date-to-time date))
- (ls (- (cadr time) (nth 8 (decode-time time)))))
- (cond ((< ls 0)
- (setcar time (1- (car time)))
- (setcar (cdr time) (+ ls 65536)))
- ((>= ls 65536)
- (setcar time (1+ (car time)))
- (setcar (cdr time) (- ls 65536)))
- (t
- (setcar (cdr time) ls)))
- (prog1
- (nntp-send-command
- "^\\.\r?\n" "NEWGROUPS"
- (format-time-string "%y%m%d %H%M%S" time)
- "GMT")
- (nntp-decode-text)))))
+ (nntp-with-open-group
+ nil server
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let* ((time (date-to-time date))
+ (ls (- (cadr time) (nth 8 (decode-time time)))))
+ (cond ((< ls 0)
+ (setcar time (1- (car time)))
+ (setcar (cdr time) (+ ls 65536)))
+ ((>= ls 65536)
+ (setcar time (1+ (car time)))
+ (setcar (cdr time) (- ls 65536)))
+ (t
+ (setcar (cdr time) ls)))
+ (prog1
+ (nntp-send-command
+ "^\\.\r?\n" "NEWGROUPS"
+ (format-time-string "%y%m%d %H%M%S" time)
+ "GMT")
+ (nntp-decode-text))))))
(deffoo nntp-request-post (&optional server)
- (nntp-possibly-change-group nil server)
- (when (nntp-send-command "^[23].*\r?\n" "POST")
- (nntp-send-buffer "^[23].*\n")))
+ (nntp-with-open-group
+ nil server
+ (when (nntp-send-command "^[23].*\r?\n" "POST")
+ (let ((response (with-current-buffer nntp-server-buffer
+ nntp-process-response))
+ server-id)
+ (when (and response
+ (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
+ response))
+ (setq server-id (match-string 1 response))
+ (narrow-to-region (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (unless (mail-fetch-field "Message-ID")
+ (goto-char (point-min))
+ (insert "Message-ID: " server-id "\n"))
+ (widen))
+ (run-hooks 'nntp-prepare-post-hook)
+ (nntp-send-buffer "^[23].*\n")))))
(deffoo nntp-request-type (group article)
'news)
@@ -824,9 +1038,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(or passwd
nntp-authinfo-password
(setq nntp-authinfo-password
- (mail-source-read-passwd
- (format "NNTP (%s@%s) password: "
- user nntp-address))))))))))
+ (read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address))))))))))
(defun nntp-send-nosy-authinfo ()
"Send the AUTHINFO to the nntp server."
@@ -835,8 +1048,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
(when t ;???Should check if AUTHINFO succeeded
(nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (mail-source-read-passwd "NNTP (%s@%s) password: "
- user nntp-address))))))
+ (read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address)))))))
(defun nntp-send-authinfo-from-file ()
"Send the AUTHINFO to the nntp server.
@@ -850,7 +1063,7 @@ password contained in '~/.nntp-authinfo'."
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
"^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (progn (end-of-line) (point)))))))
+ (buffer-substring (point) (gnus-point-at-eol))))))
;;; Internal functions.
@@ -895,7 +1108,7 @@ password contained in '~/.nntp-authinfo'."
(process
(condition-case ()
(let ((coding-system-for-read nntp-coding-system-for-read)
- (coding-system-for-write nntp-coding-system-for-write))
+ (coding-system-for-write nntp-coding-system-for-write))
(funcall nntp-open-connection-function pbuffer))
(error nil)
(quit
@@ -905,11 +1118,13 @@ password contained in '~/.nntp-authinfo'."
nil))))
(when timer
(nnheader-cancel-timer timer))
+ (unless process
+ (nntp-kill-buffer pbuffer))
(when (and (buffer-name pbuffer)
process)
(process-kill-without-query process)
- (nntp-wait-for process "^.*\n" buffer nil t)
- (if (memq (process-status process) '(open run))
+ (if (and (nntp-wait-for process "^2.*\n" buffer nil t)
+ (memq (process-status process) '(open run)))
(prog1
(caar (push (list process buffer nil) nntp-connection-alist))
(push process nntp-connection-list)
@@ -927,19 +1142,35 @@ password contained in '~/.nntp-authinfo'."
(defun nntp-open-network-stream (buffer)
(open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+(autoload 'format-spec "format")
+(autoload 'format-spec-make "format")
+(autoload 'open-tls-stream "tls")
+
(defun nntp-open-ssl-stream (buffer)
(let* ((process-connection-type nil)
- (proc (start-process "nntpd" buffer
+ (proc (start-process "nntpd" buffer
shell-file-name
shell-command-switch
- (format-spec nntp-ssl-program
+ (format-spec nntp-ssl-program
(format-spec-make
?s nntp-address
?p nntp-port-number)))))
(process-kill-without-query proc)
(save-excursion
(set-buffer buffer)
- (nntp-wait-for-string "^\r*20[01]")
+ (let ((nntp-connection-alist (list proc buffer nil)))
+ (nntp-wait-for-string "^\r*20[01]"))
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
+
+(defun nntp-open-tls-stream (buffer)
+ (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
+ (process-kill-without-query proc)
+ (save-excursion
+ (set-buffer buffer)
+ (let ((nntp-connection-alist (list proc buffer nil)))
+ (nntp-wait-for-string "^\r*20[01]"))
(beginning-of-line)
(delete-region (point-min) (point))
proc)))
@@ -1027,6 +1258,9 @@ password contained in '~/.nntp-authinfo'."
(goto-char (point-max))
(when (re-search-backward
nntp-process-wait-for nntp-process-start-point t)
+ (let ((response (match-string 0)))
+ (with-current-buffer nntp-server-buffer
+ (setq nntp-process-response response)))
(nntp-async-stop process)
;; convert it.
(when (gnus-buffer-exists-p nntp-process-to-buffer)
@@ -1060,7 +1294,7 @@ password contained in '~/.nntp-authinfo'."
(nnheader-report 'nntp message)
message))
-(defun nntp-accept-process-output (process &optional timeout)
+(defun nntp-accept-process-output (process)
"Wait for output from PROCESS and message some dots."
(save-excursion
(set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
@@ -1070,7 +1304,14 @@ password contained in '~/.nntp-authinfo'."
(unless (< len 10)
(setq nntp-have-messaged t)
(nnheader-message 7 "nntp read: %dk" len)))
- (accept-process-output process (or timeout 1))))
+ (nnheader-accept-process-output process)
+ ;; accept-process-output may update status of process to indicate
+ ;; that the server has closed the connection. This MUST be
+ ;; handled here as the buffer restored by the save-excursion may
+ ;; be the process's former output buffer (i.e. now killed)
+ (or (and process
+ (memq (process-status process) '(open run)))
+ (nntp-report "Server closed connection"))))
(defun nntp-accept-response ()
"Wait for output from the process that outputs to BUFFER."
@@ -1088,13 +1329,18 @@ password contained in '~/.nntp-authinfo'."
(when group
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (when (not (equal group (caddr entry)))
- (save-excursion
- (set-buffer (process-buffer (car entry)))
- (erase-buffer)
- (nntp-send-command "^[245].*\n" "GROUP" group)
- (setcar (cddr entry) group)
- (erase-buffer))))))
+ (cond ((not entry)
+ (nntp-report "Server closed connection"))
+ ((not (equal group (caddr entry)))
+ (save-excursion
+ (set-buffer (process-buffer (car entry)))
+ (erase-buffer)
+ (nntp-send-command "^[245].*\n" "GROUP" group)
+ (setcar (cddr entry) group)
+ (erase-buffer)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer))))))))
(defun nntp-decode-text (&optional cr-only)
"Decode the text in the current buffer."
@@ -1178,7 +1424,7 @@ password contained in '~/.nntp-authinfo'."
in-process-buffer-p
(buf nntp-server-buffer)
(process-buffer (nntp-find-connection-buffer nntp-server-buffer))
- first)
+ first last status)
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
;; won't know that until we try.
@@ -1191,8 +1437,8 @@ password contained in '~/.nntp-authinfo'."
(setq articles (cdr articles)))
(setq in-process-buffer-p (stringp nntp-server-xover))
- (nntp-send-xover-command first (car articles))
- (setq articles (cdr articles))
+ (nntp-send-xover-command first (setq last (car articles)))
+ (setq articles (cdr articles))
(when (and nntp-server-xover in-process-buffer-p)
;; Don't count tried request.
@@ -1201,7 +1447,7 @@ password contained in '~/.nntp-authinfo'."
;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks.
(when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
+ (= 1 (% count nntp-maximum-request)))
(nntp-accept-response)
;; On some Emacs versions the preceding function has a
@@ -1212,30 +1458,49 @@ password contained in '~/.nntp-authinfo'."
(while (progn
(goto-char (or last-point (point-min)))
;; Count replies.
- (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t)
- (incf received))
+ (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
+ nil t)
+ (incf received)
+ (setq status (match-string 1))
+ (if (string-match "^[45]" status)
+ (setq status 'error)
+ (setq status 'ok)))
(setq last-point (point))
- (< received count))
+ (or (< received count)
+ (if (eq status 'error)
+ nil
+ ;; I haven't started reading the final response
+ (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n"))))))
+ ;; I haven't read the end of the final response
(nntp-accept-response)
- (set-buffer process-buffer))
- (set-buffer buf))))
+ (set-buffer process-buffer))))
+
+ ;; Some nntp servers seem to have an extension to the XOVER
+ ;; extension. On these servers, requesting an article range
+ ;; preceeding the active range does not return an error as
+ ;; specified in the RFC. What we instead get is the NOV entry
+ ;; for the first available article. Obviously, a client can
+ ;; use that entry to avoid making unnecessary requests. The
+ ;; only problem is for a client that assumes that the response
+ ;; will always be within the requested ranage. For such a
+ ;; client, we can get N copies of the same entry (one for each
+ ;; XOVER command sent to the server).
+
+ (when (<= count 1)
+ (goto-char (point-min))
+ (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
+ (let ((low-limit (string-to-int
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (while (and articles (<= (car articles) low-limit))
+ (setq articles (cdr articles))))))
+ (set-buffer buf))
(when nntp-server-xover
(when in-process-buffer-p
- (set-buffer process-buffer)
- ;; Wait for the reply from the final command.
- (goto-char (point-max))
- (while (not (re-search-backward "^[0-9][0-9][0-9] " nil t))
- (nntp-accept-response)
- (set-buffer process-buffer)
- (goto-char (point-max)))
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)
- (set-buffer process-buffer)))
(set-buffer buf)
(goto-char (point-max))
(insert-buffer-substring process-buffer)
@@ -1288,19 +1553,114 @@ password contained in '~/.nntp-authinfo'."
(set-buffer nntp-server-buffer)
(erase-buffer)
(setq nntp-server-xover nil)))
- nntp-server-xover))))
+ nntp-server-xover))))
-;;; Alternative connection methods.
+(defun nntp-find-group-and-number (&optional group)
+ (save-excursion
+ (save-restriction
+ (set-buffer nntp-server-buffer)
+ (narrow-to-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+ (goto-char (point-min))
+ ;; We first find the number by looking at the status line.
+ (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
+ (string-to-int
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ newsgroups xref)
+ (and number (zerop number) (setq number nil))
+ (if number
+ ;; Then we find the group name.
+ (setq group
+ (cond
+ ;; If there is only one group in the Newsgroups
+ ;; header, then it seems quite likely that this
+ ;; article comes from that group, I'd say.
+ ((and (setq newsgroups
+ (mail-fetch-field "newsgroups"))
+ (not (string-match "," newsgroups)))
+ newsgroups)
+ ;; If there is more than one group in the
+ ;; Newsgroups header, then the Xref header should
+ ;; be filled out. We hazard a guess that the group
+ ;; that has this article number in the Xref header
+ ;; is the one we are looking for. This might very
+ ;; well be wrong if this article happens to have
+ ;; the same number in several groups, but that's
+ ;; life.
+ ((and (setq xref (mail-fetch-field "xref"))
+ number
+ (string-match
+ (format "\\([^ :]+\\):%d" number) xref))
+ (match-string 1 xref))
+ (t "")))
+ (cond
+ ((and (setq xref (mail-fetch-field "xref"))
+ (string-match
+ (if group
+ (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
+ "\\([^ :]+\\):\\([0-9]+\\)")
+ xref))
+ (setq group (match-string 1 xref)
+ number (string-to-int (match-string 2 xref))))
+ ((and (setq newsgroups
+ (mail-fetch-field "newsgroups"))
+ (not (string-match "," newsgroups)))
+ (setq group newsgroups))
+ (group)
+ (t (setq group ""))))
+ (when (string-match "\r" group)
+ (setq group (substring group 0 (match-beginning 0))))
+ (cons group number)))))
(defun nntp-wait-for-string (regexp)
"Wait until string arrives in the buffer."
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ proc)
(goto-char (point-min))
- (while (not (re-search-forward regexp nil t))
- (accept-process-output (nntp-find-connection nntp-server-buffer))
+ (while (and (setq proc (get-buffer-process buf))
+ (memq (process-status proc) '(open run))
+ (not (re-search-forward regexp nil t)))
+ (accept-process-output proc)
(set-buffer buf)
(goto-char (point-min)))))
+
+;; ==========================================================================
+;; Obsolete nntp-open-* connection methods -- drv
+;; ==========================================================================
+
+(defvoo nntp-open-telnet-envuser nil
+ "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
+
+(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
+ "*Regular expression to match the shell prompt on the remote machine.")
+
+(defvoo nntp-rlogin-program "rsh"
+ "*Program used to log in on remote machines.
+The default is \"rsh\", but \"ssh\" is a popular alternative.")
+
+(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
+ "*Parameters to `nntp-open-rlogin'.
+That function may be used as `nntp-open-connection-function'. In that
+case, this list will be used as the parameter list given to rsh.")
+
+(defvoo nntp-rlogin-user-name nil
+ "*User name on remote system when using the rlogin connect method.")
+
+(defvoo nntp-telnet-parameters
+ '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
+ "*Parameters to `nntp-open-telnet'.
+That function may be used as `nntp-open-connection-function'. In that
+case, this list will be executed as a command after logging in
+via telnet.")
+
+(defvoo nntp-telnet-user-name nil
+ "User name to log in via telnet with.")
+
+(defvoo nntp-telnet-passwd nil
+ "Password to use to log in via telnet with.")
+
(defun nntp-open-telnet (buffer)
(save-excursion
(set-buffer buffer)
@@ -1331,7 +1691,7 @@ password contained in '~/.nntp-authinfo'."
proc (concat
(or nntp-telnet-passwd
(setq nntp-telnet-passwd
- (mail-source-read-passwd "Password: ")))
+ (read-passwd "Password: ")))
"\n"))
(nntp-wait-for-string nntp-telnet-shell-prompt)
(process-send-string
@@ -1366,44 +1726,155 @@ password contained in '~/.nntp-authinfo'."
(delete-region (point-min) (point))
proc)))
-(defun nntp-find-group-and-number ()
- (save-excursion
- (save-restriction
- (set-buffer nntp-server-buffer)
- (narrow-to-region (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
+
+;; ==========================================================================
+;; Replacements for the nntp-open-* functions -- drv
+;; ==========================================================================
+
+(defun nntp-open-telnet-stream (buffer)
+ "Open a nntp connection by telnet'ing the news server.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-telnet-command',
+- `nntp-telnet-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+ (let ((command `(,nntp-telnet-command
+ ,@nntp-telnet-switches
+ ,nntp-address ,nntp-port-number))
+ proc)
+ (and nntp-pre-command
+ (push nntp-pre-command command))
+ (setq proc (apply 'start-process "nntpd" buffer command))
+ (save-excursion
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)))
+
+(defun nntp-open-via-rlogin-and-telnet (buffer)
+ "Open a connection to an nntp server through an intermediate host.
+First rlogin to the remote host, and then telnet the real news server
+from there.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-rlogin-command',
+- `nntp-via-rlogin-command-switches',
+- `nntp-via-user-name',
+- `nntp-via-address',
+- `nntp-telnet-command',
+- `nntp-telnet-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+ (let ((command `(,nntp-via-address
+ ,nntp-telnet-command
+ ,@nntp-telnet-switches))
+ proc)
+ (when nntp-via-user-name
+ (setq command `("-l" ,nntp-via-user-name ,@command)))
+ (when nntp-via-rlogin-command-switches
+ (setq command (append nntp-via-rlogin-command-switches command)))
+ (push nntp-via-rlogin-command command)
+ (and nntp-pre-command
+ (push nntp-pre-command command))
+ (setq proc (apply 'start-process "nntpd" buffer command))
+ (save-excursion
+ (set-buffer buffer)
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc (concat "open " nntp-address
+ " " nntp-port-number "\n"))
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (process-send-string proc "\^]")
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc "mode character\n")
+ (accept-process-output proc 1)
+ (sit-for 1)
(goto-char (point-min))
- ;; We first find the number by looking at the status line.
- (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
- (string-to-int
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- group newsgroups xref)
- (and number (zerop number) (setq number nil))
- ;; Then we find the group name.
- (setq group
- (cond
- ;; If there is only one group in the Newsgroups header,
- ;; then it seems quite likely that this article comes
- ;; from that group, I'd say.
- ((and (setq newsgroups (mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
- newsgroups)
- ;; If there is more than one group in the Newsgroups
- ;; header, then the Xref header should be filled out.
- ;; We hazard a guess that the group that has this
- ;; article number in the Xref header is the one we are
- ;; looking for. This might very well be wrong if this
- ;; article happens to have the same number in several
- ;; groups, but that's life.
- ((and (setq xref (mail-fetch-field "xref"))
- number
- (string-match (format "\\([^ :]+\\):%d" number) xref))
- (substring xref (match-beginning 1) (match-end 1)))
- (t "")))
- (when (string-match "\r" group)
- (setq group (substring group 0 (match-beginning 0))))
- (cons group number)))))
+ (forward-line 1)
+ (delete-region (point) (point-max)))
+ proc))
+
+(defun nntp-open-via-telnet-and-telnet (buffer)
+ "Open a connection to an nntp server through an intermediate host.
+First telnet the remote host, and then telnet the real news server
+from there.
+
+Please refer to the following variables to customize the connection:
+- `nntp-pre-command',
+- `nntp-via-telnet-command',
+- `nntp-via-telnet-switches',
+- `nntp-via-address',
+- `nntp-via-envuser',
+- `nntp-via-user-name',
+- `nntp-via-user-password',
+- `nntp-via-shell-prompt',
+- `nntp-telnet-command',
+- `nntp-telnet-switches',
+- `nntp-address',
+- `nntp-port-number',
+- `nntp-end-of-line'."
+ (save-excursion
+ (set-buffer buffer)
+ (erase-buffer)
+ (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
+ (case-fold-search t)
+ proc)
+ (and nntp-pre-command (push nntp-pre-command command))
+ (setq proc (apply 'start-process "nntpd" buffer command))
+ (when (memq (process-status proc) '(open run))
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc "set escape \^X\n")
+ (cond
+ ((and nntp-via-envuser nntp-via-user-name)
+ (process-send-string proc (concat "open " "-l" nntp-via-user-name
+ nntp-via-address "\n")))
+ (t
+ (process-send-string proc (concat "open " nntp-via-address
+ "\n"))))
+ (when (not nntp-via-envuser)
+ (nntp-wait-for-string "^\r*.?login:")
+ (process-send-string proc
+ (concat
+ (or nntp-via-user-name
+ (setq nntp-via-user-name
+ (read-string "login: ")))
+ "\n")))
+ (nntp-wait-for-string "^\r*.?password:")
+ (process-send-string proc
+ (concat
+ (or nntp-via-user-password
+ (setq nntp-via-user-password
+ (read-passwd "Password: ")))
+ "\n"))
+ (nntp-wait-for-string nntp-via-shell-prompt)
+ (let ((real-telnet-command `("exec"
+ ,nntp-telnet-command
+ ,@nntp-telnet-switches
+ ,nntp-address
+ ,nntp-port-number)))
+ (process-send-string proc
+ (concat (mapconcat 'identity
+ real-telnet-command " ")
+ "\n")))
+ (nntp-wait-for-string "^\r*20[01]")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (process-send-string proc "\^]")
+ (nntp-wait-for-string "^r?telnet")
+ (process-send-string proc "mode character\n")
+ (accept-process-output proc 1)
+ (sit-for 1)
+ (goto-char (point-min))
+ (forward-line 1)
+ (delete-region (point) (point-max)))
+ proc)))
(provide 'nntp)
diff --git a/lisp/gnus/nnultimate.el b/lisp/gnus/nnultimate.el
index 4ab84e0b983..b785e49af52 100644
--- a/lisp/gnus/nnultimate.el
+++ b/lisp/gnus/nnultimate.el
@@ -1,5 +1,6 @@
-;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
+
+;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -36,11 +37,9 @@
(require 'gnus)
(require 'nnmail)
(require 'mm-util)
-(eval-when-compile
- (ignore-errors
- (require 'nnweb)))
-;; Report failure to find w3 at load time if appropriate.
-(eval '(require 'nnweb))
+(require 'mm-url)
+(require 'nnweb)
+(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnultimate)
@@ -107,7 +106,7 @@
fetchers))
(pop articles)
(setq article (car articles)))))
- ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
+ ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
;; so we start fetching the topics that we need to satisfy the
;; request.
(if (not fetchers)
@@ -125,9 +124,9 @@
(setq subject (nth 2 (assq (car elem) topics)))
(setq href (nth 3 (assq (car elem) topics)))
(if (= current-page 1)
- (nnweb-insert href)
+ (mm-url-insert href)
(string-match "\\.html$" href)
- (nnweb-insert (concat (substring href 0 (match-beginning 0))
+ (mm-url-insert (concat (substring href 0 (match-beginning 0))
"-" (number-to-string current-page)
(match-string 0 href))))
(goto-char (point-min))
@@ -173,25 +172,25 @@
datel nil))
(pop datel))
(when date
- (setq date (delete "" (split-string
- date "[-, \n\t\r    ]")))
- (if (or (member "AM" date)
- (member "PM" date))
- (setq date (format
- "%s %s %s %s"
- (nth 1 date)
- (if (and (>= (length (nth 0 date)) 3)
- (assoc (downcase
- (substring (nth 0 date) 0 3))
- parse-time-months))
- (substring (nth 0 date) 0 3)
- (car (rassq (string-to-number (nth 0 date))
- parse-time-months)))
- (nth 2 date) (nth 3 date)))
- (setq date (format "%s %s %s %s"
- (car (rassq (string-to-number (nth 1 date))
- parse-time-months))
- (nth 0 date) (nth 2 date) (nth 3 date)))))
+ (setq date (delete "" (split-string date "[-, \n\t\r    ]")))
+ (setq date
+ (if (or (member "AM" date)
+ (member "PM" date))
+ (format
+ "%s %s %s %s"
+ (nth 1 date)
+ (if (and (>= (length (nth 0 date)) 3)
+ (assoc (downcase
+ (substring (nth 0 date) 0 3))
+ parse-time-months))
+ (substring (nth 0 date) 0 3)
+ (car (rassq (string-to-number (nth 0 date))
+ parse-time-months)))
+ (nth 2 date) (nth 3 date))
+ (format "%s %s %s %s"
+ (car (rassq (string-to-number (nth 1 date))
+ parse-time-months))
+ (nth 0 date) (nth 2 date) (nth 3 date)))))
(push
(cons
article
@@ -269,7 +268,7 @@
(deffoo nnultimate-request-list (&optional server)
(nnultimate-possibly-change-server nil server)
(mm-with-unibyte-buffer
- (nnweb-insert
+ (mm-url-insert
(if (string-match "/$" nnultimate-address)
(concat nnultimate-address "Ultimate.cgi")
nnultimate-address))
@@ -334,7 +333,7 @@
(mm-with-unibyte-buffer
(while furls
(erase-buffer)
- (nnweb-insert (pop furls))
+ (mm-url-insert (pop furls))
(goto-char (point-min))
(setq parse (w3-parse-buffer (current-buffer)))
(setq contents
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index b8233dd9551..1eac2fe1423 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -1,10 +1,10 @@
;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2002
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news
;; This file is part of GNU Emacs.
@@ -45,13 +45,13 @@
(nnoo-declare nnvirtual)
(defvoo nnvirtual-always-rescan t
- "*If non-nil, always scan groups for unread articles when entering a group.
+ "If non-nil, always scan groups for unread articles when entering a group.
If this variable is nil and you read articles in a component group
after the virtual group has been activated, the read articles from the
component group will show up when you enter the virtual group.")
(defvoo nnvirtual-component-regexp nil
- "*Regexp to match component groups.")
+ "Regexp to match component groups.")
(defvoo nnvirtual-component-groups nil
"Component group in this nnvirtual group.")
@@ -374,8 +374,9 @@ component group will show up when you enter the virtual group.")
#'(lambda (article)
(nnvirtual-reverse-map-article
group article))
- (gnus-group-expire-articles-1 group)))))
- (sort unexpired '<)))
+ (gnus-uncompress-range
+ (gnus-group-expire-articles-1 group))))))
+ (sort (delq nil unexpired) '<)))
;;; Internal functions.
@@ -425,7 +426,7 @@ component group will show up when you enter the virtual group.")
(concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
nil t)
(replace-match "" t t))
- (unless (= (point) (point-max))
+ (unless (eobp)
(insert " ")
(when (not (string= "" prefix))
(while (re-search-forward "[^ ]+:[0-9]+" nil t)
@@ -520,14 +521,15 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components."
;;; We map between virtual articles and real articles in a manner
-;;; which keeps the size of the virtual active list the same as
-;;; the sum of the component active lists.
-;;; To achieve fair mixing of the groups, the last article in
-;;; each of N component groups will be in the last N articles
-;;; in the virtual group.
-
-;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
-;;; respectively, then the virtual article numbers look like:
+;;; which keeps the size of the virtual active list the same as the
+;;; sum of the component active lists.
+
+;;; To achieve fair mixing of the groups, the last article in each of
+;;; N component groups will be in the last N articles in the virtual
+;;; group.
+
+;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and
+;;; 6-7 respectively, then the virtual article numbers look like:
;;;
;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
diff --git a/lisp/gnus/nnwarchive.el b/lisp/gnus/nnwarchive.el
index 00bcb79bb99..a9d0d51d9b6 100644
--- a/lisp/gnus/nnwarchive.el
+++ b/lisp/gnus/nnwarchive.el
@@ -1,5 +1,5 @@
;;; nnwarchive.el --- interfacing with web archives
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news egroups mail-archive
@@ -24,7 +24,7 @@
;;; Commentary:
;; Note: You need to have `url' (w3 0.46) or greater version
-;; installed for this backend to work.
+;; installed for some functions of this backend to work.
;; Todo:
;; 1. To support more web archives.
@@ -41,19 +41,7 @@
(require 'gnus-bcklg)
(require 'nnmail)
(require 'mm-util)
-(require 'mail-source)
-(eval-when-compile
- (ignore-errors
- (require 'w3)
- (require 'url)
- (require 'w3-forms)
- (require 'nnweb)))
-;; Report failure to find w3 at load time if appropriate.
-(eval '(progn
- (require 'w3)
- (require 'url)
- (require 'w3-forms)
- (require 'nnweb)))
+(require 'mm-url)
(nnoo-declare nnwarchive)
@@ -297,7 +285,7 @@
user-mail-address)))
(setq nnwarchive-passwd
(or nnwarchive-passwd
- (mail-source-read-passwd
+ (read-passwd
(format "Password for %s at %s: "
nnwarchive-login server)))))
(unless nnwarchive-groups
@@ -360,23 +348,6 @@
(format " *nnwarchive %s %s*" nnwarchive-type server)))))
(nnwarchive-set-default nnwarchive-type))
-(defun nnwarchive-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun nnwarchive-fetch-form (url pairs)
- (let ((url-request-data (nnwarchive-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (nnweb-insert url))
- t)
-
(defun nnwarchive-eval (expr)
(cond
((consp expr)
@@ -388,14 +359,14 @@
(defun nnwarchive-url (xurl)
(mm-with-unibyte-current-buffer
- (let ((url-confirmation-func 'identity)
+ (let ((url-confirmation-func 'identity) ;; Some hacks.
(url-cookie-multiple-line nil))
(cond
((eq (car xurl) 'post)
(pop xurl)
- (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
+ (mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
(t
- (nnweb-insert (apply 'format (nnwarchive-eval xurl))))))))
+ (mm-url-insert (apply 'format (nnwarchive-eval xurl))))))))
(defun nnwarchive-generate-active ()
(save-excursion
@@ -470,8 +441,8 @@
article
(make-full-mail-header
article
- (nnweb-decode-entities-string subject)
- (nnweb-decode-entities-string from)
+ (mm-url-decode-entities-string subject)
+ (mm-url-decode-entities-string from)
date
(concat "<" group "%"
(number-to-string article)
@@ -490,7 +461,7 @@
(goto-char (point-min))
(while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
(replace-match "\\1"))
- (nnweb-decode-entities)
+ (mm-url-decode-entities)
(buffer-string))
(defun nnwarchive-egroups-xover-files (group articles)
@@ -550,7 +521,7 @@
subject (match-string 2))
(forward-line 1)
(unless (assq article nnwarchive-headers)
- (if (looking-at "<UL><LI><EM>From</EM>:\\([^&]+\\)<\\([^&]+\\)>")
+ (if (looking-at "<UL><LI><EM>From</EM>: *\\([^<]*[^< ]\\) *&lt;\\([^&]+\\)&gt;")
(progn
(setq from (match-string 1)
date (identity (match-string 2))))
@@ -559,8 +530,8 @@
article
(make-full-mail-header
article
- (nnweb-decode-entities-string subject)
- (nnweb-decode-entities-string from)
+ (mm-url-decode-entities-string subject)
+ (mm-url-decode-entities-string from)
date
(format "<%05d%%%s>\n" (1- article) group)
""
@@ -623,7 +594,7 @@
(when (search-forward "X-Head-End" nil t)
(beginning-of-line)
(narrow-to-region (point-min) (point))
- (nnweb-decode-entities)
+ (mm-url-decode-entities)
(goto-char (point-min))
(while (search-forward "<!--X-" nil t)
(replace-match ""))
@@ -645,8 +616,8 @@
(search-forward "</ul>" nil t)
(end-of-line)
(narrow-to-region (point-min) (point))
- (nnweb-remove-markup)
- (nnweb-decode-entities)
+ (mm-url-remove-markup)
+ (mm-url-decode-entities)
(goto-char (point-min))
(delete-blank-lines)
(when from
@@ -687,8 +658,8 @@
(delete-region (match-beginning 0) (match-end 0))
(save-restriction
(narrow-to-region p (point))
- (nnweb-remove-markup)
- (nnweb-decode-entities)
+ (mm-url-remove-markup)
+ (mm-url-decode-entities)
(goto-char (point-max)))))
((looking-at "<P><A HREF=\"\\([^\"]+\\)")
(setq url (match-string 1))
@@ -696,14 +667,17 @@
(progn (forward-line) (point)))
;; I hate to download the url encode it, then immediately
;; decode it.
- ;; FixMe: Find a better solution to attach the URL.
- ;; Maybe do some hack in external part of mml-generate-mim-1.
- (insert "<#part>"
- "\n--\nExternal: \n"
- (format "<URL:http://www.mail-archive.com/%s/%s>"
+ (insert "<#external"
+ " type="
+ (or (and url
+ (string-match "\\.[^\\.]+$" url)
+ (mailcap-extension-to-mime
+ (match-string 0 url)))
+ "application/octet-stream")
+ (format " url=\"http://www.mail-archive.com/%s/%s\""
group url)
- "\n--\n"
- "<#/part>")
+ ">\n"
+ "<#/external>")
(setq mime t))
(t
(setq p (point))
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index cae4079845f..063a1c8f376 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -1,5 +1,5 @@
;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -24,8 +24,7 @@
;;; Commentary:
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
+;; Note: You need to have `w3' installed for some functions to work.
;;; Code:
@@ -37,18 +36,11 @@
(require 'gnus)
(require 'nnmail)
(require 'mm-util)
-(eval-when-compile
+(require 'mm-url)
+(eval-and-compile
(ignore-errors
- (require 'w3)
- (require 'url)
- (require 'w3-forms)))
-
-;; Report failure to find w3 at load time if appropriate.
-(unless noninteractive
- (eval '(progn
- (require 'w3)
- (require 'url)
- (require 'w3-forms))))
+ (require 'url)))
+(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnweb)
@@ -57,63 +49,37 @@
(defvoo nnweb-type 'google
"What search engine type is being used.
-Valid types include `google', `dejanews', `dejanewsold', `reference',
-and `altavista'.")
+Valid types include `google', `dejanews', and `gmane'.")
(defvar nnweb-type-definition
- '(
- (google
- ;;(article . nnweb-google-wash-article)
- ;;(id . "http://groups.google.com/groups?as_umsgid=%s")
+ '((google
(article . ignore)
(id . "http://groups.google.com/groups?selm=%s&output=gplain")
- ;;(reference . nnweb-google-reference)
(reference . identity)
(map . nnweb-google-create-mapping)
(search . nnweb-google-search)
(address . "http://groups.google.com/groups")
(identifier . nnweb-google-identity))
(dejanews ;; alias of google
- ;;(article . nnweb-google-wash-article)
- ;;(id . "http://groups.google.com/groups?as_umsgid=%s")
(article . ignore)
(id . "http://groups.google.com/groups?selm=%s&output=gplain")
- ;;(reference . nnweb-google-reference)
(reference . identity)
(map . nnweb-google-create-mapping)
(search . nnweb-google-search)
(address . "http://groups.google.com/groups")
(identifier . nnweb-google-identity))
-;;; (dejanews
-;;; (article . ignore)
-;;; (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text")
-;;; (map . nnweb-dejanews-create-mapping)
-;;; (search . nnweb-dejanews-search)
-;;; (address . "http://www.deja.com/=dnc/qs.xp")
-;;; (identifier . nnweb-dejanews-identity))
-;;; (dejanewsold
-;;; (article . ignore)
-;;; (map . nnweb-dejanews-create-mapping)
-;;; (search . nnweb-dejanewsold-search)
-;;; (address . "http://www.deja.com/dnquery.xp")
-;;; (identifier . nnweb-dejanews-identity))
- (reference
- (article . nnweb-reference-wash-article)
- (map . nnweb-reference-create-mapping)
- (search . nnweb-reference-search)
- (address . "http://www.reference.com/cgi-bin/pn/go")
- (identifier . identity))
- (altavista
- (article . nnweb-altavista-wash-article)
- (map . nnweb-altavista-create-mapping)
- (search . nnweb-altavista-search)
- (address . "http://www.altavista.digital.com/cgi-bin/query")
- (id . "/cgi-bin/news?id@%s")
- (identifier . identity)))
+ (gmane
+ (article . nnweb-gmane-wash-article)
+ (id . "http://gmane.org/view.php?group=%s")
+ (reference . identity)
+ (map . nnweb-gmane-create-mapping)
+ (search . nnweb-gmane-search)
+ (address . "http://gmane.org/")
+ (identifier . nnweb-gmane-identity)))
"Type-definition alist.")
(defvoo nnweb-search nil
- "Search string to feed to DejaNews.")
+ "Search string to feed to Google.")
(defvoo nnweb-max-hits 999
"Maximum number of hits to display.")
@@ -197,7 +163,7 @@ and `altavista'.")
(url (and header (mail-header-xref header))))
(when (or (and url
(mm-with-unibyte-current-buffer
- (nnweb-fetch-url url)))
+ (mm-url-insert url)))
(and (stringp article)
(nnweb-definition 'id t)
(let ((fetch (nnweb-definition 'id))
@@ -207,7 +173,7 @@ and `altavista'.")
(when (and fetch art)
(setq url (format fetch art))
(mm-with-unibyte-current-buffer
- (nnweb-fetch-url url))
+ (mm-url-insert url))
(if (nnweb-definition 'reference t)
(setq article
(funcall (nnweb-definition
@@ -237,7 +203,7 @@ and `altavista'.")
(nnweb-possibly-change-server group server))
(deffoo nnweb-asynchronous-p ()
- t)
+ nil)
(deffoo nnweb-request-create-group (group &optional server args)
(nnweb-possibly-change-server nil server)
@@ -336,383 +302,6 @@ and `altavista'.")
nnweb-type nnweb-search server))
(current-buffer))))))
-(defun nnweb-fetch-url (url)
- (let (buf)
- (save-excursion
- (if (not nnheader-callback-function)
- (progn
- (with-temp-buffer
- (mm-enable-multibyte)
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (default-process-coding-system 'binary))
- (nnweb-insert url))
- (setq buf (buffer-string)))
- (erase-buffer)
- (insert buf)
- t)
- (nnweb-url-retrieve-asynch
- url 'nnweb-callback (current-buffer) nnheader-callback-function)
- t))))
-
-(defun nnweb-callback (buffer callback)
- (when (gnus-buffer-live-p url-working-buffer)
- (save-excursion
- (set-buffer url-working-buffer)
- (funcall (nnweb-definition 'article))
- (nnweb-decode-entities)
- (set-buffer buffer)
- (goto-char (point-max))
- (insert-buffer-substring url-working-buffer))
- (funcall callback t)
- (gnus-kill-buffer url-working-buffer)))
-
-(defun nnweb-url-retrieve-asynch (url callback &rest data)
- (let ((url-request-method "GET")
- (old-asynch url-be-asynchronous)
- (url-request-data nil)
- (url-request-extra-headers nil)
- (url-working-buffer (generate-new-buffer-name " *nnweb*")))
- (setq-default url-be-asynchronous t)
- (save-excursion
- (set-buffer (get-buffer-create url-working-buffer))
- (setq url-current-callback-data data
- url-be-asynchronous t
- url-current-callback-func callback)
- (url-retrieve url nil))
- (setq-default url-be-asynchronous old-asynch)))
-
-(if (fboundp 'url-retrieve-synchronously)
- (defun nnweb-url-retrieve-asynch (url callback &rest data)
- (url-retrieve url callback data)))
-
-;;;
-;;; DejaNews functions.
-;;;
-
-(defun nnweb-dejanews-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (erase-buffer)
- (when (funcall (nnweb-definition 'search) nnweb-search)
- (let ((i 0)
- (more t)
- (case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- subject date from
- map url parse a table group text)
- (while more
- ;; Go through all the article hits on this page.
- (goto-char (point-min))
- (setq parse (w3-parse-buffer (current-buffer))
- table (nth 1 (nnweb-parse-find-all 'table parse)))
- (dolist (row (nth 2 (car (nth 2 table))))
- (setq a (nnweb-parse-find 'a row)
- url (cdr (assq 'href (nth 1 a)))
- text (nreverse (nnweb-text row)))
- (when a
- (setq subject (nth 4 text)
- group (nth 2 text)
- date (nth 1 text)
- from (nth 0 text))
- (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
- (setq date (format "%s %s 00:00:00 %s"
- (car (rassq (string-to-number
- (match-string 2 date))
- parse-time-months))
- (match-string 3 date)
- (match-string 1 date)))
- (setq date "Jan 1 00:00:00 0000"))
- (incf i)
- (setq url (concat url "&fmt=text"))
- (when (string-match "&context=[^&]+" url)
- (setq url (replace-match "" t t url)))
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) (concat subject " (" group ")") from date
- (concat "<" (nnweb-identifier url) "@dejanews>")
- nil 0 0 url))
- map)
- (nnweb-set-hashtb (cadar map) (car map)))))
- ;; See whether there is a "Get next 20 hits" button here.
- (goto-char (point-min))
- (if (or (not (re-search-forward
- "HREF=\"\\([^\"]+\\)\"[<>b]+Next result" nil t))
- (>= i nnweb-max-hits))
- (setq more nil)
- ;; Yup -- fetch it.
- (setq more (match-string 1))
- (erase-buffer)
- (url-insert-file-contents more)))
- ;; Return the articles in the right order.
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car))))))
-
-(defun nnweb-dejanews-search (search)
- (nnweb-insert
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("ST" . "PS")
- ("svcclass" . "dnyr")
- ("QRY" . ,search)
- ("defaultOp" . "AND")
- ("DBS" . "1")
- ("OP" . "dnquery.xp")
- ("LNG" . "ALL")
- ("maxhits" . "100")
- ("threaded" . "0")
- ("format" . "verbose2")
- ("showsort" . "date")
- ("agesign" . "1")
- ("ageweight" . "1")))))
- t)
-
-(defun nnweb-dejanewsold-search (search)
- (nnweb-fetch-form
- (nnweb-definition 'address)
- `(("query" . ,search)
- ("defaultOp" . "AND")
- ("svcclass" . "dnold")
- ("maxhits" . "100")
- ("format" . "verbose2")
- ("threaded" . "0")
- ("showsort" . "date")
- ("agesign" . "1")
- ("ageweight" . "1")))
- t)
-
-(defun nnweb-dejanews-identity (url)
- "Return an unique identifier based on URL."
- (if (string-match "AN=\\([0-9]+\\)" url)
- (match-string 1 url)
- url))
-
-;;;
-;;; InReference
-;;;
-
-(defun nnweb-reference-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (erase-buffer)
- (when (funcall (nnweb-definition 'search) nnweb-search)
- (let ((i 0)
- (more t)
- (case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- Subject Score Date Newsgroups From Message-ID
- map url)
- (while more
- ;; Go through all the article hits on this page.
- (goto-char (point-min))
- (search-forward "</pre><hr>" nil t)
- (delete-region (point-min) (point))
- (goto-char (point-min))
- (while (re-search-forward "^ +[0-9]+\\." nil t)
- (narrow-to-region
- (point)
- (if (re-search-forward "^$" nil t)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min))
- (when (looking-at ".*href=\"\\([^\"]+\\)\"")
- (setq url (match-string 1)))
- (nnweb-remove-markup)
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t)
- (set (intern (match-string 1)) (match-string 2)))
- (widen)
- (search-forward "</pre>" nil t)
- (incf i)
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) (concat "(" Newsgroups ") " Subject) From Date
- Message-ID
- nil 0 (string-to-int Score) url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))))
- (setq more nil))
- ;; Return the articles in the right order.
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car))))))
-
-(defun nnweb-reference-wash-article ()
- (let ((case-fold-search t))
- (goto-char (point-min))
- (re-search-forward "^</center><hr>" nil t)
- (delete-region (point-min) (point))
- (search-forward "<pre>" nil t)
- (forward-line -1)
- (let ((body (point-marker)))
- (search-forward "</pre>" nil t)
- (delete-region (point) (point-max))
- (nnweb-remove-markup)
- (goto-char (point-min))
- (while (looking-at " *$")
- (gnus-delete-line))
- (narrow-to-region (point-min) body)
- (while (and (re-search-forward "^$" nil t)
- (not (eobp)))
- (gnus-delete-line))
- (goto-char (point-min))
- (while (looking-at "\\(^[^ ]+:\\) *")
- (replace-match "\\1 " t)
- (forward-line 1))
- (goto-char (point-min))
- (when (re-search-forward "^References:" nil t)
- (narrow-to-region
- (point) (if (re-search-forward "^$\\|^[^:]+:" nil t)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "References")
- (insert "\t")
- (forward-line 1)))
- (goto-char (point-min))
- (while (search-forward "," nil t)
- (replace-match " " t t)))
- (widen)
- (nnweb-decode-entities)
- (set-marker body nil))))
-
-(defun nnweb-reference-search (search)
- (url-insert-file-contents
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("search" . "advanced")
- ("querytext" . ,search)
- ("subj" . "")
- ("name" . "")
- ("login" . "")
- ("host" . "")
- ("organization" . "")
- ("groups" . "")
- ("keywords" . "")
- ("choice" . "Search")
- ("startmonth" . "Jul")
- ("startday" . "25")
- ("startyear" . "1996")
- ("endmonth" . "Aug")
- ("endday" . "24")
- ("endyear" . "1996")
- ("mode" . "Quick")
- ("verbosity" . "Verbose")
- ("ranking" . "Relevance")
- ("first" . "1")
- ("last" . "25")
- ("score" . "50")))))
- (setq buffer-file-name nil)
- t)
-
-;;;
-;;; Alta Vista
-;;;
-
-(defun nnweb-altavista-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (erase-buffer)
- (let ((part 0))
- (when (funcall (nnweb-definition 'search) nnweb-search part)
- (let ((i 0)
- (more t)
- (case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- subject date from id group
- map url)
- (while more
- ;; Go through all the article hits on this page.
- (goto-char (point-min))
- (search-forward "<dt>" nil t)
- (delete-region (point-min) (match-beginning 0))
- (goto-char (point-min))
- (while (search-forward "<dt>" nil t)
- (replace-match "\n<blubb>"))
- (nnweb-decode-entities)
- (goto-char (point-min))
- (while (re-search-forward "<blubb>.*href=\"\\([^\"]+\\)\"><strong>\\([^>]*\\)</strong></a><dd>\\([^-]+\\)- <b>\\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)</a><P>"
- nil t)
- (setq url (match-string 1)
- subject (match-string 2)
- date (match-string 3)
- group (match-string 4)
- id (concat "<" (match-string 5) ">")
- from (match-string 6))
- (incf i)
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) (concat "(" group ") " subject) from date
- id nil 0 0 url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))))
- ;; See if we want more.
- (when (or (not nnweb-articles)
- (>= i nnweb-max-hits)
- (not (funcall (nnweb-definition 'search)
- nnweb-search (incf part))))
- (setq more nil)))
- ;; Return the articles in the right order.
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car)))))))
-
-(defun nnweb-altavista-wash-article ()
- (goto-char (point-min))
- (let ((case-fold-search t))
- (when (re-search-forward "^<strong>" nil t)
- (delete-region (point-min) (match-beginning 0)))
- (goto-char (point-min))
- (while (looking-at "<strong>\\([^ ]+\\) +</strong> +\\(.*\\)$")
- (replace-match "\\1: \\2" t)
- (forward-line 1))
- (when (re-search-backward "^References:" nil t)
- (narrow-to-region (point) (progn (forward-line 1) (point)))
- (goto-char (point-min))
- (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)
- (replace-match "&lt;\\1&gt; " t)))
- (widen)
- (nnweb-remove-markup)
- (nnweb-decode-entities)))
-
-(defun nnweb-altavista-search (search &optional part)
- (url-insert-file-contents
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("pg" . "aq")
- ("what" . "news")
- ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
- ("fmt" . "d")
- ("q" . ,search)
- ("r" . "")
- ("d0" . "")
- ("d1" . "")))))
- (setq buffer-file-name nil)
- t)
-
;;;
;;; Deja bought by google.com
;;;
@@ -731,7 +320,7 @@ and `altavista'.")
(goto-char (point-min))
(while (search-forward "<br>" nil t)
(replace-match "\n"))
- (nnweb-remove-markup)
+ (mm-url-remove-markup)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*\n" nil t)
(replace-match ""))
@@ -741,7 +330,7 @@ and `altavista'.")
(narrow-to-region (point) (point-max))
(search-forward "</pre>" nil t)
(delete-region (point) (point-max))
- (nnweb-remove-markup)
+ (mm-url-remove-markup)
(widen)))
(defun nnweb-google-parse-1 (&optional Message-ID)
@@ -763,28 +352,30 @@ and `altavista'.")
"http://groups.google.com/groups?selm=%s&output=gplain" mid))
(narrow-to-region (search-forward ">" nil t)
(search-forward "</a>" nil t))
- (nnweb-remove-markup)
- (nnweb-decode-entities)
+ (mm-url-remove-markup)
+ (mm-url-decode-entities)
(setq Subject (buffer-string))
(goto-char (point-max))
(widen)
- (forward-line 1)
+ (forward-line 2)
(when (looking-at "<br><font[^>]+>")
(goto-char (match-end 0)))
(if (not (looking-at "<a[^>]+>"))
(skip-chars-forward " \t")
(narrow-to-region (point)
(search-forward "</a>" nil t))
- (nnweb-remove-markup)
- (nnweb-decode-entities)
+ (mm-url-remove-markup)
+ (mm-url-decode-entities)
(setq Newsgroups (buffer-string))
(goto-char (point-max))
(widen)
(skip-chars-forward "- \t"))
(when (looking-at
- "\\([0-9]+[/ ][A-Za-z]+[/ ][0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
- (setq From (match-string 2)
- Date (match-string 1)))
+ "\\([0-9]+\\)[/ ]\\([A-Za-z]+\\)[/ ]\\([0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
+ (setq From (match-string 4)
+ Date (format "%s %s 00:00:00 %s"
+ (match-string 2) (match-string 1)
+ (match-string 3))))
(forward-line 1)
(incf i)
(unless (nnweb-get-hashtb url)
@@ -807,7 +398,7 @@ and `altavista'.")
(nconc nnweb-articles map))
(when (setq header (cadar map))
(mm-with-unibyte-current-buffer
- (nnweb-fetch-url (mail-header-xref header)))
+ (mm-url-insert (mail-header-xref header)))
(caar map))))
(defun nnweb-google-create-mapping ()
@@ -816,22 +407,33 @@ and `altavista'.")
(set-buffer nnweb-buffer)
(erase-buffer)
(when (funcall (nnweb-definition 'search) nnweb-search)
- (let ((more t))
+ (let ((more t)
+ (i 0))
(while more
(setq nnweb-articles
(nconc nnweb-articles (nnweb-google-parse-1)))
- ;; FIXME: There is more.
- (setq more nil))
+ ;; Check if there are more articles to fetch
+ (goto-char (point-min))
+ (incf i 100)
+ (if (or (not (re-search-forward
+ "<td nowrap><a href=\\([^>]+\\).*<span class=b>Next</span>" nil t))
+ (>= i nnweb-max-hits))
+ (setq more nil)
+ ;; Yup, there are more articles
+ (setq more (concat "http://groups.google.com" (match-string 1)))
+ (when more
+ (erase-buffer)
+ (mm-url-insert more))))
;; Return the articles in the right order.
(setq nnweb-articles
(sort nnweb-articles 'car-less-than-car))))))
(defun nnweb-google-search (search)
- (nnweb-insert
+ (mm-url-insert
(concat
(nnweb-definition 'address)
"?"
- (nnweb-encode-www-form-urlencoded
+ (mm-url-encode-www-form-urlencoded
`(("q" . ,search)
("num". "100")
("hq" . "")
@@ -848,6 +450,71 @@ and `altavista'.")
url))
;;;
+;;; gmane.org
+;;;
+(defun nnweb-gmane-create-mapping ()
+ "Perform the search and create a number-to-url alist."
+ (save-excursion
+ (set-buffer nnweb-buffer)
+ (erase-buffer)
+ (when (funcall (nnweb-definition 'search) nnweb-search)
+ (let ((more t)
+ (case-fold-search t)
+ (active (or (cadr (assoc nnweb-group nnweb-group-alist))
+ (cons 1 0)))
+ subject group url
+ map)
+ ;; Remove stuff from the beginning of results
+ (goto-char (point-min))
+ (search-forward "Search Results</h1><ul>" nil t)
+ (delete-region (point-min) (point))
+ (goto-char (point-min))
+ ;; Iterate over the actual hits
+ (while (re-search-forward ".*href=\"\\([^\"]+\\)\">\\(.*\\)" nil t)
+ (setq url (concat "http://gmane.org/" (match-string 1)))
+ (setq subject (match-string 2))
+ (unless (nnweb-get-hashtb url)
+ (push
+ (list
+ (incf (cdr active))
+ (make-full-mail-header
+ (cdr active) (concat "(" group ") " subject) nil nil
+ nil nil 0 0 url))
+ map)
+ (nnweb-set-hashtb (cadar map) (car map))))
+ ;; Return the articles in the right order.
+ (setq nnweb-articles
+ (sort (nconc nnweb-articles map) 'car-less-than-car))))))
+
+(defun nnweb-gmane-wash-article ()
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (re-search-forward "<!--X-Head-of-Message-->" nil t)
+ (delete-region (point-min) (point))
+ (goto-char (point-min))
+ (while (looking-at "^<li><em>\\([^ ]+\\)</em>.*</li>")
+ (replace-match "\\1\\2" t)
+ (forward-line 1))
+ (mm-url-remove-markup)))
+
+(defun nnweb-gmane-search (search)
+ (mm-url-insert
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (mm-url-encode-www-form-urlencoded
+ `(("query" . ,search)))))
+ (setq buffer-file-name nil)
+ t)
+
+
+(defun nnweb-gmane-identity (url)
+ "Return a unique identifier based on URL."
+ (if (string-match "group=\\(.+\\)" url)
+ (match-string 1 url)
+ url))
+
+;;;
;;; General web/w3 interface utility functions
;;;
@@ -869,75 +536,6 @@ and `altavista'.")
(mapcar 'nnweb-insert-html (nth 2 parse))
(insert "</" (symbol-name (car parse)) ">\n")))
-(defun nnweb-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun nnweb-fetch-form (url pairs)
- "Fetch a form from URL with PAIRS as the data using the POST method."
- (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun nnweb-decode-entities ()
- "Decode all HTML entities."
- (goto-char (point-min))
- (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
- (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
- (let ((c
- (string-to-number (substring
- (match-string 1) 1))))
- (if (mm-char-or-char-int-p c) c 32))
- (or (cdr (assq (intern (match-string 1))
- w3-html-entities))
- ?#))))
- (unless (stringp elem)
- (setq elem (char-to-string elem)))
- (replace-match elem t t))))
-
-(defun nnweb-decode-entities-string (string)
- (with-temp-buffer
- (insert string)
- (nnweb-decode-entities)
- (buffer-substring (point-min) (point-max))))
-
-(defun nnweb-remove-markup ()
- "Remove all HTML markup, leaving just plain text."
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t)))
-
-(defun nnweb-insert (url &optional follow-refresh)
- "Insert the contents from an URL in the current buffer.
-If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
- (let ((name buffer-file-name))
- (if follow-refresh
- (save-restriction
- (narrow-to-region (point) (point))
- (url-insert-file-contents url)
- (goto-char (point-min))
- (when (re-search-forward
- "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
- (let ((url (match-string 1)))
- (delete-region (point-min) (point-max))
- (nnweb-insert url t))))
- (url-insert-file-contents url))
- (setq buffer-file-name name)))
-
(defun nnweb-parse-find (type parse &optional maxdepth)
"Find the element of TYPE in PARSE."
(catch 'found
@@ -987,11 +585,6 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
(listp (cdr element)))
(nnweb-text-1 element)))))
-(defun nnweb-replace-in-string (string match newtext)
- (while (string-match match string)
- (setq string (replace-match newtext t t string)))
- string)
-
(provide 'nnweb)
;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697
diff --git a/lisp/gnus/nnwfm.el b/lisp/gnus/nnwfm.el
new file mode 100644
index 00000000000..d42730cab6e
--- /dev/null
+++ b/lisp/gnus/nnwfm.el
@@ -0,0 +1,432 @@
+;;; nnwfm.el --- interfacing with a web forum
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Note: You need to have `url' and `w3' installed for this
+;; backend to work.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'nnoo)
+(require 'message)
+(require 'gnus-util)
+(require 'gnus)
+(require 'nnmail)
+(require 'mm-util)
+(require 'mm-url)
+(require 'nnweb)
+(autoload 'w3-parse-buffer "w3-parse")
+
+(nnoo-declare nnwfm)
+
+(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/")
+ "Where nnwfm will save its files.")
+
+(defvoo nnwfm-address ""
+ "The address of the Ultimate bulletin board.")
+
+;;; Internal variables
+
+(defvar nnwfm-groups-alist nil)
+(defvoo nnwfm-groups nil)
+(defvoo nnwfm-headers nil)
+(defvoo nnwfm-articles nil)
+(defvar nnwfm-table-regexp
+ "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
+
+;;; Interface functions
+
+(nnoo-define-basics nnwfm)
+
+(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old)
+ (nnwfm-possibly-change-server group server)
+ (unless gnus-nov-is-evil
+ (let* ((last (car (last articles)))
+ (did nil)
+ (start 1)
+ (entry (assoc group nnwfm-groups))
+ (sid (nth 2 entry))
+ (topics (nth 4 entry))
+ (mapping (nth 5 entry))
+ (old-total (or (nth 6 entry) 1))
+ (nnwfm-table-regexp "Thread.asp")
+ headers article subject score from date lines parent point
+ contents tinfo fetchers map elem a href garticles topic old-max
+ inc datel table string current-page total-contents pages
+ farticles forum-contents parse furl-fetched mmap farticle
+ thread-id tables hstuff bstuff time)
+ (setq map mapping)
+ (while (and (setq article (car articles))
+ map)
+ (while (and map
+ (or (> article (caar map))
+ (< (cadar map) (caar map))))
+ (pop map))
+ (when (setq mmap (car map))
+ (setq farticle -1)
+ (while (and article
+ (<= article (nth 1 mmap)))
+ ;; Do we already have a fetcher for this topic?
+ (if (setq elem (assq (nth 2 mmap) fetchers))
+ ;; Yes, so we just add the spec to the end.
+ (nconc elem (list (cons article
+ (+ (nth 3 mmap) (incf farticle)))))
+ ;; No, so we add a new one.
+ (push (list (nth 2 mmap)
+ (cons article
+ (+ (nth 3 mmap) (incf farticle))))
+ fetchers))
+ (pop articles)
+ (setq article (car articles)))))
+ ;; Now we have the mapping from/to Gnus/nnwfm article numbers,
+ ;; so we start fetching the topics that we need to satisfy the
+ ;; request.
+ (if (not fetchers)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer))
+ (setq nnwfm-articles nil)
+ (mm-with-unibyte-buffer
+ (dolist (elem fetchers)
+ (erase-buffer)
+ (setq subject (nth 2 (assq (car elem) topics))
+ thread-id (nth 0 (assq (car elem) topics)))
+ (mm-url-insert
+ (concat nnwfm-address
+ (format "Item.asp?GroupID=%d&ThreadID=%d" sid
+ thread-id)))
+ (goto-char (point-min))
+ (setq tables (caddar
+ (caddar
+ (cdr (caddar
+ (caddar
+ (ignore-errors
+ (w3-parse-buffer (current-buffer)))))))))
+ (setq tables (cdr (caddar (memq (assq 'div tables) tables))))
+ (setq contents nil)
+ (dolist (table tables)
+ (when (eq (car table) 'table)
+ (setq table (caddar (caddar (caddr table)))
+ hstuff (delete ":link" (nnweb-text (car table)))
+ bstuff (car (caddar (cdr table)))
+ from (car hstuff))
+ (when (nth 2 hstuff)
+ (setq time (nnwfm-date-to-time (nth 2 hstuff)))
+ (push (list from time bstuff) contents))))
+ (setq contents (nreverse contents))
+ (dolist (art (cdr elem))
+ (push (list (car art)
+ (nth (1- (cdr art)) contents)
+ subject)
+ nnwfm-articles))))
+ (setq nnwfm-articles
+ (sort nnwfm-articles 'car-less-than-car))
+ ;; Now we have all the articles, conveniently in an alist
+ ;; where the key is the Gnus article number.
+ (dolist (articlef nnwfm-articles)
+ (setq article (nth 0 articlef)
+ contents (nth 1 articlef)
+ subject (nth 2 articlef))
+ (setq from (nth 0 contents)
+ date (message-make-date (nth 1 contents)))
+ (push
+ (cons
+ article
+ (make-full-mail-header
+ article subject
+ from (or date "")
+ (concat "<" (number-to-string sid) "%"
+ (number-to-string article)
+ "@wfm>")
+ "" 0
+ (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) ""))
+ 70)
+ nil nil))
+ headers))
+ (setq nnwfm-headers (sort headers 'car-less-than-car))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (mm-with-unibyte-current-buffer
+ (erase-buffer)
+ (dolist (header nnwfm-headers)
+ (nnheader-insert-nov (cdr header))))))
+ 'nov)))
+
+(deffoo nnwfm-request-group (group &optional server dont-check)
+ (nnwfm-possibly-change-server nil server)
+ (when (not nnwfm-groups)
+ (nnwfm-request-list))
+ (unless dont-check
+ (nnwfm-create-mapping group))
+ (let ((elem (assoc group nnwfm-groups)))
+ (cond
+ ((not elem)
+ (nnheader-report 'nnwfm "Group does not exist"))
+ (t
+ (nnheader-report 'nnwfm "Opened group %s" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
+ (prin1-to-string group))))))
+
+(deffoo nnwfm-request-close ()
+ (setq nnwfm-groups-alist nil
+ nnwfm-groups nil))
+
+(deffoo nnwfm-request-article (article &optional group server buffer)
+ (nnwfm-possibly-change-server group server)
+ (let ((contents (cdr (assq article nnwfm-articles))))
+ (when (setq contents (nth 2 (car contents)))
+ (save-excursion
+ (set-buffer (or buffer nntp-server-buffer))
+ (erase-buffer)
+ (nnweb-insert-html contents)
+ (goto-char (point-min))
+ (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
+ (let ((header (cdr (assq article nnwfm-headers))))
+ (mm-with-unibyte-current-buffer
+ (nnheader-insert-header header)))
+ (nnheader-report 'nnwfm "Fetched article %s" article)
+ (cons group article)))))
+
+(deffoo nnwfm-request-list (&optional server)
+ (nnwfm-possibly-change-server nil server)
+ (mm-with-unibyte-buffer
+ (mm-url-insert
+ (if (string-match "/$" nnwfm-address)
+ (concat nnwfm-address "Group.asp")
+ nnwfm-address))
+ (let* ((nnwfm-table-regexp "Thread.asp")
+ (contents (w3-parse-buffer (current-buffer)))
+ sid elem description articles a href group forum
+ a1 a2)
+ (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table
+ contents))))))
+ (setq row (nth 2 row))
+ (when (setq a (nnweb-parse-find 'a row))
+ (setq group (car (last (nnweb-text a)))
+ href (cdr (assq 'href (nth 1 a))))
+ (setq description (car (last (nnweb-text (nth 1 row)))))
+ (setq articles
+ (string-to-number
+ (gnus-replace-in-string
+ (car (last (nnweb-text (nth 3 row)))) "," "")))
+ (when (and href
+ (string-match "GroupId=\\([0-9]+\\)" href))
+ (setq forum (string-to-number (match-string 1 href)))
+ (if (setq elem (assoc group nnwfm-groups))
+ (setcar (cdr elem) articles)
+ (push (list group articles forum description nil nil nil nil)
+ nnwfm-groups))))))
+ (nnwfm-write-groups)
+ (nnwfm-generate-active)
+ t))
+
+(deffoo nnwfm-request-newgroups (date &optional server)
+ (nnwfm-possibly-change-server nil server)
+ (nnwfm-generate-active)
+ t)
+
+(nnoo-define-skeleton nnwfm)
+
+;;; Internal functions
+
+(defun nnwfm-new-threads-p (group time)
+ "See whether we want to fetch the threads for GROUP written before TIME."
+ (let ((old-time (nth 7 (assoc group nnwfm-groups))))
+ (or (null old-time)
+ (time-less-p old-time time))))
+
+(defun nnwfm-create-mapping (group)
+ (let* ((entry (assoc group nnwfm-groups))
+ (sid (nth 2 entry))
+ (topics (nth 4 entry))
+ (mapping (nth 5 entry))
+ (old-total (or (nth 6 entry) 1))
+ (current-time (current-time))
+ (nnwfm-table-regexp "Thread.asp")
+ (furls (list (concat nnwfm-address
+ (format "Thread.asp?GroupId=%d" sid))))
+ fetched-urls
+ contents forum-contents a subject href
+ garticles topic tinfo old-max inc parse elem date
+ url time)
+ (mm-with-unibyte-buffer
+ (while furls
+ (erase-buffer)
+ (push (car furls) fetched-urls)
+ (mm-url-insert (pop furls))
+ (goto-char (point-min))
+ (while (re-search-forward " wr(" nil t)
+ (forward-char -1)
+ (setq elem (message-tokenize-header
+ (gnus-replace-in-string
+ (buffer-substring
+ (1+ (point))
+ (progn
+ (forward-sexp 1)
+ (1- (point))))
+ "\\\\[\"\\\\]" "")))
+ (push (list
+ (string-to-number (nth 1 elem))
+ (gnus-replace-in-string (nth 2 elem) "\"" "")
+ (string-to-number (nth 5 elem)))
+ forum-contents))
+ (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)"
+ nil t)
+ (setq url (match-string 1)
+ time (nnwfm-date-to-time (gnus-url-unhex-string
+ (match-string 2))))
+ (when (and (nnwfm-new-threads-p group time)
+ (not (member
+ (setq url (concat
+ nnwfm-address
+ (mm-url-decode-entities-string url)))
+ fetched-urls)))
+ (push url furls))))
+ ;; The main idea here is to map Gnus article numbers to
+ ;; nnwfm article numbers. Say there are three topics in
+ ;; this forum, the first with 4 articles, the seconds with 2,
+ ;; and the third with 1. Then this will translate into 7 Gnus
+ ;; article numbers, where 1-4 comes from the first topic, 5-6
+ ;; from the second and 7 from the third. Now, then next time
+ ;; the group is entered, there's 2 new articles in topic one
+ ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
+ ;; in topic one and 10 will be the 2 in topic three.
+ (dolist (elem (nreverse forum-contents))
+ (setq subject (nth 1 elem)
+ topic (nth 0 elem)
+ garticles (nth 2 elem))
+ (if (setq tinfo (assq topic topics))
+ (progn
+ (setq old-max (cadr tinfo))
+ (setcar (cdr tinfo) garticles))
+ (setq old-max 0)
+ (push (list topic garticles subject) topics)
+ (setcar (nthcdr 4 entry) topics))
+ (when (not (= old-max garticles))
+ (setq inc (- garticles old-max))
+ (setq mapping (nconc mapping
+ (list
+ (list
+ old-total (1- (incf old-total inc))
+ topic (1+ old-max)))))
+ (incf old-max inc)
+ (setcar (nthcdr 5 entry) mapping)
+ (setcar (nthcdr 6 entry) old-total))))
+ (setcar (nthcdr 7 entry) current-time)
+ (setcar (nthcdr 1 entry) (1- old-total))
+ (nnwfm-write-groups)
+ mapping))
+
+(defun nnwfm-possibly-change-server (&optional group server)
+ (nnwfm-init server)
+ (when (and server
+ (not (nnwfm-server-opened server)))
+ (nnwfm-open-server server))
+ (unless nnwfm-groups-alist
+ (nnwfm-read-groups)
+ (setq nnwfm-groups (cdr (assoc nnwfm-address
+ nnwfm-groups-alist)))))
+
+(deffoo nnwfm-open-server (server &optional defs connectionless)
+ (nnheader-init-server-buffer)
+ (if (nnwfm-server-opened server)
+ t
+ (unless (assq 'nnwfm-address defs)
+ (setq defs (append defs (list (list 'nnwfm-address server)))))
+ (nnoo-change-server 'nnwfm server defs)))
+
+(defun nnwfm-read-groups ()
+ (setq nnwfm-groups-alist nil)
+ (let ((file (expand-file-name "groups" nnwfm-directory)))
+ (when (file-exists-p file)
+ (mm-with-unibyte-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (setq nnwfm-groups-alist (read (current-buffer)))))))
+
+(defun nnwfm-write-groups ()
+ (setq nnwfm-groups-alist
+ (delq (assoc nnwfm-address nnwfm-groups-alist)
+ nnwfm-groups-alist))
+ (push (cons nnwfm-address nnwfm-groups)
+ nnwfm-groups-alist)
+ (with-temp-file (expand-file-name "groups" nnwfm-directory)
+ (prin1 nnwfm-groups-alist (current-buffer))))
+
+(defun nnwfm-init (server)
+ "Initialize buffers and such."
+ (unless (file-exists-p nnwfm-directory)
+ (gnus-make-directory nnwfm-directory)))
+
+(defun nnwfm-generate-active ()
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (dolist (elem nnwfm-groups)
+ (insert (prin1-to-string (car elem))
+ " " (number-to-string (cadr elem)) " 1 y\n"))))
+
+(defun nnwfm-find-forum-table (contents)
+ (catch 'found
+ (nnwfm-find-forum-table-1 contents)))
+
+(defun nnwfm-find-forum-table-1 (contents)
+ (dolist (element contents)
+ (unless (stringp element)
+ (when (and (eq (car element) 'table)
+ (nnwfm-forum-table-p element))
+ (throw 'found element))
+ (when (nth 2 element)
+ (nnwfm-find-forum-table-1 (nth 2 element))))))
+
+(defun nnwfm-forum-table-p (parse)
+ (when (not (apply 'gnus-or
+ (mapcar
+ (lambda (p)
+ (nnweb-parse-find 'table p))
+ (nth 2 parse))))
+ (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
+ case-fold-search)
+ (when (and href (string-match nnwfm-table-regexp href))
+ t))))
+
+(defun nnwfm-date-to-time (date)
+ (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]"))))
+ (encode-time 0 (nth 4 time) (nth 3 time)
+ (nth 0 time) (nth 1 time)
+ (if (< (nth 2 time) 70)
+ (+ 2000 (nth 2 time))
+ (+ 1900 (nth 2 time))))))
+
+(provide 'nnwfm)
+
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536
+;;; nnwfm.el ends here
diff --git a/lisp/gnus/pgg-def.el b/lisp/gnus/pgg-def.el
new file mode 100644
index 00000000000..b5228676475
--- /dev/null
+++ b/lisp/gnus/pgg-def.el
@@ -0,0 +1,91 @@
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999, 2003 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'custom)
+
+(defgroup pgg ()
+ "Glue for the various PGP implementations."
+ :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+ "Default PGP scheme."
+ :group 'pgg
+ :type '(choice (const :tag "GnuPG" gpg)
+ (const :tag "PGP 5" pgp5)
+ (const :tag "PGP" pgp)))
+
+(defcustom pgg-default-user-id (user-login-name)
+ "User ID of your default identity."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-default-keyserver-address "subkeys.pgp.net"
+ "Host name of keyserver."
+ :group 'pgg
+ :type 'string)
+
+(defcustom pgg-query-keyserver nil
+ "Whether PGG queries keyservers for missing keys when verifying messages."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-encrypt-for-me t
+ "If t, encrypt all outgoing messages with user's public key."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-cache-passphrase t
+ "If t, cache passphrase."
+ :group 'pgg
+ :type 'boolean)
+
+(defcustom pgg-passphrase-cache-expiry 16
+ "How many seconds the passphrase is cached.
+Whether the passphrase is cached at all is controlled by
+`pgg-cache-passphrase'."
+ :group 'pgg
+ :type 'integer)
+
+(defvar pgg-messages-coding-system nil
+ "Coding system used when reading from a PGP external process.")
+
+(defvar pgg-status-buffer " *PGG status*")
+(defvar pgg-errors-buffer " *PGG errors*")
+(defvar pgg-output-buffer " *PGG output*")
+
+(defvar pgg-echo-buffer "*PGG-echo*")
+
+(defvar pgg-scheme nil
+ "Current scheme of PGP implementation.")
+
+(defmacro pgg-truncate-key-identifier (key)
+ `(if (> (length ,key) 8) (substring ,key 8) ,key))
+
+(provide 'pgg-def)
+
+;;; arch-tag: c425f3ab-ed75-4055-bb46-431a418c94b7
+;;; pgg-def.el ends here
diff --git a/lisp/gnus/pgg-gpg.el b/lisp/gnus/pgg-gpg.el
new file mode 100644
index 00000000000..2b3e521c60f
--- /dev/null
+++ b/lisp/gnus/pgg-gpg.el
@@ -0,0 +1,274 @@
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl) ; for gpg macros
+ (require 'pgg))
+
+(defgroup pgg-gpg ()
+ "GnuPG interface"
+ :group 'pgg)
+
+(defcustom pgg-gpg-program "gpg"
+ "The GnuPG executable."
+ :group 'pgg-gpg
+ :type 'string)
+
+(defcustom pgg-gpg-extra-args nil
+ "Extra arguments for every GnuPG invocation."
+ :group 'pgg-gpg
+ :type '(repeat (string :tag "Argument")))
+
+(defcustom pgg-gpg-recipient-argument "--recipient"
+ "GnuPG option to specify recipient."
+ :group 'pgg-gpg
+ :type '(choice (const :tag "New `--recipient' option" "--recipient")
+ (const :tag "Old `--remote-user' option" "--remote-user")))
+
+(defvar pgg-gpg-user-id nil
+ "GnuPG ID of your default identity.")
+
+(defun pgg-gpg-process-region (start end passphrase program args)
+ (let* ((output-file-name (pgg-make-temp-file "pgg-output"))
+ (args
+ `("--status-fd" "2"
+ ,@(if passphrase '("--passphrase-fd" "0"))
+ "--yes" ; overwrite
+ "--output" ,output-file-name
+ ,@pgg-gpg-extra-args ,@args))
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (orig-mode (default-file-modes))
+ (process-connection-type nil)
+ exit-status)
+ (with-current-buffer (get-buffer-create errors-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ (input (buffer-substring-no-properties start end))
+ (default-enable-multibyte-characters nil))
+ (with-temp-buffer
+ (when passphrase
+ (insert passphrase "\n"))
+ (insert input)
+ (setq exit-status
+ (apply #'call-process-region (point-min) (point-max) program
+ nil errors-buffer nil args))))
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (if (file-exists-p output-file-name)
+ (let ((coding-system-for-read 'raw-text-dos))
+ (insert-file-contents output-file-name)))
+ (set-buffer errors-buffer)
+ (if (not (equal exit-status 0))
+ (insert (format "\n%s exited abnormally: '%s'\n"
+ program exit-status)))))
+ (if (file-exists-p output-file-name)
+ (delete-file output-file-name))
+ (set-default-file-modes orig-mode))))
+
+(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key)
+ (if (and pgg-cache-passphrase
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t)))
+ (pgg-add-passphrase-cache
+ (or key
+ (progn
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
+ (substring (match-string 0) -8))))
+ passphrase)))
+
+(defvar pgg-gpg-all-secret-keys 'unknown)
+
+(defun pgg-gpg-lookup-all-secret-keys ()
+ "Return all secret keys present in secret key ring."
+ (when (eq pgg-gpg-all-secret-keys 'unknown)
+ (setq pgg-gpg-all-secret-keys '())
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ "--list-secret-keys")))
+ (with-temp-buffer
+ (apply #'call-process pgg-gpg-program nil t nil args)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t)
+ (push (substring (match-string 2) 8)
+ pgg-gpg-all-secret-keys)))))
+ pgg-gpg-all-secret-keys)
+
+(defun pgg-gpg-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ (if type "--list-secret-keys" "--list-keys")
+ string)))
+ (with-temp-buffer
+ (apply #'call-process pgg-gpg-program nil t nil args)
+ (goto-char (point-min))
+ (if (re-search-forward "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)"
+ nil t)
+ (substring (match-string 2) 8)))))
+
+(defun pgg-gpg-encrypt-region (start end recipients &optional sign)
+ "Encrypt the current region between START and END.
+If optional argument SIGN is non-nil, do a combined sign and encrypt."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (when sign
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ pgg-gpg-user-id)))
+ (args
+ (append
+ (list "--batch" "--armor" "--always-trust" "--encrypt")
+ (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
+ (if recipients
+ (apply #'nconc
+ (mapcar (lambda (rcpt)
+ (list pgg-gpg-recipient-argument rcpt))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-gpg-user-id)))))))))
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (when sign
+ (with-current-buffer pgg-errors-buffer
+ ;; Possibly cache passphrase under, e.g. "jas", for future sign.
+ (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
+ ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
+ (pgg-gpg-possibly-cache-passphrase passphrase)))
+ (pgg-process-when-success)))
+
+(defun pgg-gpg-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((current-buffer (current-buffer))
+ (message-keys (with-temp-buffer
+ (insert-buffer-substring current-buffer)
+ (pgg-decode-armor-region (point-min) (point-max))))
+ (secret-keys (pgg-gpg-lookup-all-secret-keys))
+ (key (pgg-gpg-select-matching-key message-keys secret-keys))
+ (pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ pgg-gpg-user-id))
+ (args '("--batch" "--decrypt")))
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
+ (with-current-buffer pgg-errors-buffer
+ (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+
+(defun pgg-gpg-select-matching-key (message-keys secret-keys)
+ "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
+ (loop for message-key in message-keys
+ for message-key-id = (and (equal (car message-key) 1)
+ (cdr (assq 'key-identifier message-key)))
+ for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
+ when (and key (member key secret-keys)) return key))
+
+(defun pgg-gpg-sign-region (start end &optional cleartext)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+ pgg-gpg-user-id))
+ (args
+ (list (if cleartext "--clearsign" "--detach-sign")
+ "--armor" "--batch" "--verbose"
+ "--local-user" pgg-gpg-user-id))
+ (inhibit-read-only t)
+ buffer-read-only)
+ (pgg-as-lbt start end 'CRLF
+ (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+ (with-current-buffer pgg-errors-buffer
+ ;; Possibly cache passphrase under, e.g. "jas", for future sign.
+ (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
+ ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
+ (pgg-gpg-possibly-cache-passphrase passphrase))
+ (pgg-process-when-success)))
+
+(defun pgg-gpg-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let ((args '("--batch" "--verify")))
+ (when (stringp signature)
+ (setq args (append args (list signature))))
+ (setq args (append args '("-")))
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
+ (with-current-buffer pgg-output-buffer
+ (insert-buffer-substring pgg-errors-buffer
+ (match-beginning 1) (match-end 0)))
+ (delete-region (match-beginning 0) (match-end 0)))
+ (goto-char (point-min))
+ (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
+
+(defun pgg-gpg-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+ (args (list "--batch" "--export" "--armor"
+ pgg-gpg-user-id)))
+ (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-gpg-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let ((args '("--import" "--batch" "-")) status)
+ (pgg-gpg-process-region start end nil pgg-gpg-program args)
+ (set-buffer pgg-errors-buffer)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
+ (setq status (buffer-substring (match-end 0)
+ (progn (end-of-line)(point)))
+ status (vconcat (mapcar #'string-to-int (split-string status))))
+ (erase-buffer)
+ (insert (format "Imported %d key(s).
+\tArmor contains %d key(s) [%d bad, %d old].\n"
+ (+ (aref status 2)
+ (aref status 10))
+ (aref status 0)
+ (aref status 1)
+ (+ (aref status 4)
+ (aref status 11)))
+ (if (zerop (aref status 9))
+ ""
+ "\tSecret keys are imported.\n")))
+ (append-to-buffer pgg-output-buffer (point-min)(point-max))
+ (pgg-process-when-success)))
+
+(provide 'pgg-gpg)
+
+;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
+;;; pgg-gpg.el ends here
diff --git a/lisp/gnus/pgg-parse.el b/lisp/gnus/pgg-parse.el
new file mode 100644
index 00000000000..bf04ca914a8
--- /dev/null
+++ b/lisp/gnus/pgg-parse.el
@@ -0,0 +1,516 @@
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999, 2003 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
+;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
+;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
+;; (1998/11)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'custom)
+
+(defgroup pgg-parse ()
+ "OpenPGP packet parsing"
+ :group 'pgg)
+
+(defcustom pgg-parse-public-key-algorithm-alist
+ '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
+ "Alist of the assigned number to the public key algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-symmetric-key-algorithm-alist
+ '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
+ "Alist of the assigned number to the simmetric key algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-hash-algorithm-alist
+ '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+ "Alist of the assigned number to the cryptographic hash algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-compression-algorithm-alist
+ '((0 . nil); Uncompressed
+ (1 . ZIP)
+ (2 . ZLIB))
+ "Alist of the assigned number to the compression algorithm."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-parse-signature-type-alist
+ '((0 . "Signature of a binary document")
+ (1 . "Signature of a canonical text document")
+ (2 . "Standalone signature")
+ (16 . "Generic certification of a User ID and Public Key packet")
+ (17 . "Persona certification of a User ID and Public Key packet")
+ (18 . "Casual certification of a User ID and Public Key packet")
+ (19 . "Positive certification of a User ID and Public Key packet")
+ (24 . "Subkey Binding Signature")
+ (31 . "Signature directly on a key")
+ (32 . "Key revocation signature")
+ (40 . "Subkey revocation signature")
+ (48 . "Certification revocation signature")
+ (64 . "Timestamp signature."))
+ "Alist of the assigned number to the signature type."
+ :group 'pgg-parse
+ :type '(repeat
+ (cons (sexp :tag "Number") (sexp :tag "Type"))))
+
+(defcustom pgg-ignore-packet-checksum t; XXX
+ "If non-nil checksum of each ascii armored packet will be ignored."
+ :group 'pgg-parse
+ :type 'boolean)
+
+(defvar pgg-armor-header-lines
+ '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+ "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+ "^-----BEGIN PGP SIGNATURE-----\r?$")
+ "Armor headers.")
+
+(eval-and-compile
+ (defalias 'pgg-char-int (if (fboundp 'char-int)
+ 'char-int
+ 'identity)))
+
+(defmacro pgg-format-key-identifier (string)
+ `(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
+ ,string "")
+ ;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+ ;; (string-to-int-list ,string)))
+ )
+
+(defmacro pgg-parse-time-field (bytes)
+ `(list (logior (lsh (car ,bytes) 8)
+ (nth 1 ,bytes))
+ (logior (lsh (nth 2 ,bytes) 8)
+ (nth 3 ,bytes))
+ 0))
+
+(defmacro pgg-byte-after (&optional pos)
+ `(pgg-char-int (char-after ,(or pos `(point)))))
+
+(defmacro pgg-read-byte ()
+ `(pgg-char-int (char-after (prog1 (point) (forward-char)))))
+
+(defmacro pgg-read-bytes-string (nbytes)
+ `(buffer-substring
+ (point) (prog1 (+ ,nbytes (point))
+ (forward-char ,nbytes))))
+
+(defmacro pgg-read-bytes (nbytes)
+ `(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
+ ;; `(string-to-int-list (pgg-read-bytes-string ,nbytes))
+ )
+
+(defmacro pgg-read-body-string (ptag)
+ `(if (nth 1 ,ptag)
+ (pgg-read-bytes-string (nth 1 ,ptag))
+ (pgg-read-bytes-string (- (point-max) (point)))))
+
+(defmacro pgg-read-body (ptag)
+ `(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
+ ;; `(string-to-int-list (pgg-read-body-string ,ptag))
+ )
+
+(defalias 'pgg-skip-bytes 'forward-char)
+
+(defmacro pgg-skip-header (ptag)
+ `(pgg-skip-bytes (nth 2 ,ptag)))
+
+(defmacro pgg-skip-body (ptag)
+ `(pgg-skip-bytes (nth 1 ,ptag)))
+
+(defmacro pgg-set-alist (alist key value)
+ `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
+
+(when (fboundp 'define-ccl-program)
+
+ (define-ccl-program pgg-parse-crc24
+ '(1
+ ((loop
+ (read r0) (r1 ^= r0) (r2 ^= 0)
+ (r5 = 0)
+ (loop
+ (r1 <<= 1)
+ (r1 += ((r2 >> 15) & 1))
+ (r2 <<= 1)
+ (if (r1 & 256)
+ ((r1 ^= 390) (r2 ^= 19707)))
+ (if (r5 < 7)
+ ((r5 += 1)
+ (repeat))))
+ (repeat)))))
+
+ (defun pgg-parse-crc24-string (string)
+ (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+ (ccl-execute-on-string pgg-parse-crc24 h string)
+ (format "%c%c%c"
+ (logand (aref h 1) 255)
+ (logand (lsh (aref h 2) -8) 255)
+ (logand (aref h 2) 255)))))
+
+(defmacro pgg-parse-length-type (c)
+ `(cond
+ ((< ,c 192) (cons ,c 1))
+ ((< ,c 224)
+ (cons (+ (lsh (- ,c 192) 8)
+ (pgg-byte-after (+ 2 (point)))
+ 192)
+ 2))
+ ((= ,c 255)
+ (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
+ (pgg-byte-after (+ 3 (point))))
+ (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
+ (pgg-byte-after (+ 5 (point)))))
+ 5))
+ (t;partial body length
+ '(0 . 0))))
+
+(defun pgg-parse-packet-header ()
+ (let ((ptag (pgg-byte-after))
+ length-type content-tag packet-bytes header-bytes)
+ (if (zerop (logand 64 ptag));Old format
+ (progn
+ (setq length-type (logand ptag 3)
+ length-type (if (= 3 length-type) 0 (lsh 1 length-type))
+ content-tag (logand 15 (lsh ptag -2))
+ packet-bytes 0
+ header-bytes (1+ length-type))
+ (dotimes (i length-type)
+ (setq packet-bytes
+ (logior (lsh packet-bytes 8)
+ (pgg-byte-after (+ 1 i (point)))))))
+ (setq content-tag (logand 63 ptag)
+ length-type (pgg-parse-length-type
+ (pgg-byte-after (1+ (point))))
+ packet-bytes (car length-type)
+ header-bytes (1+ (cdr length-type))))
+ (list content-tag packet-bytes header-bytes)))
+
+(defun pgg-parse-packet (ptag)
+ (case (car ptag)
+ (1 ;Public-Key Encrypted Session Key Packet
+ (pgg-parse-public-key-encrypted-session-key-packet ptag))
+ (2 ;Signature Packet
+ (pgg-parse-signature-packet ptag))
+ (3 ;Symmetric-Key Encrypted Session Key Packet
+ (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
+ ;; 4 -- One-Pass Signature Packet
+ ;; 5 -- Secret Key Packet
+ (6 ;Public Key Packet
+ (pgg-parse-public-key-packet ptag))
+ ;; 7 -- Secret Subkey Packet
+ ;; 8 -- Compressed Data Packet
+ (9 ;Symmetrically Encrypted Data Packet
+ (pgg-read-body-string ptag))
+ (10 ;Marker Packet
+ (pgg-read-body-string ptag))
+ (11 ;Literal Data Packet
+ (pgg-read-body-string ptag))
+ ;; 12 -- Trust Packet
+ (13 ;User ID Packet
+ (pgg-read-body-string ptag))
+ ;; 14 -- Public Subkey Packet
+ ;; 60 .. 63 -- Private or Experimental Values
+ ))
+
+(defun pgg-parse-packets (&optional header-parser body-parser)
+ (let ((header-parser
+ (or header-parser
+ (function pgg-parse-packet-header)))
+ (body-parser
+ (or body-parser
+ (function pgg-parse-packet)))
+ result ptag)
+ (while (> (point-max) (1+ (point)))
+ (setq ptag (funcall header-parser))
+ (pgg-skip-header ptag)
+ (push (cons (car ptag)
+ (save-excursion
+ (funcall body-parser ptag)))
+ result)
+ (if (zerop (nth 1 ptag))
+ (goto-char (point-max))
+ (forward-char (nth 1 ptag))))
+ result))
+
+(defun pgg-parse-signature-subpacket-header ()
+ (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
+ (list (pgg-byte-after (+ (cdr length-type) (point)))
+ (1- (car length-type))
+ (1+ (cdr length-type)))))
+
+(defun pgg-parse-signature-subpacket (ptag)
+ (case (car ptag)
+ (2 ;signature creation time
+ (cons 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (3 ;signature expiration time
+ (cons 'signature-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ (4 ;exportable certification
+ (cons 'exportability (pgg-read-byte)))
+ (5 ;trust signature
+ (cons 'trust-level (pgg-read-byte)))
+ (6 ;regular expression
+ (cons 'regular-expression
+ (pgg-read-body-string ptag)))
+ (7 ;revocable
+ (cons 'revocability (pgg-read-byte)))
+ (9 ;key expiration time
+ (cons 'key-expiry
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes))))
+ ;; 10 = placeholder for backward compatibility
+ (11 ;preferred symmetric algorithms
+ (cons 'preferred-symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist))))
+ (12 ;revocation key
+ )
+ (16 ;issuer key ID
+ (cons 'key-identifier
+ (pgg-format-key-identifier (pgg-read-body-string ptag))))
+ (20 ;notation data
+ (pgg-skip-bytes 4)
+ (cons 'notation
+ (let ((name-bytes (pgg-read-bytes 2))
+ (value-bytes (pgg-read-bytes 2)))
+ (cons (pgg-read-bytes-string
+ (logior (lsh (car name-bytes) 8)
+ (nth 1 name-bytes)))
+ (pgg-read-bytes-string
+ (logior (lsh (car value-bytes) 8)
+ (nth 1 value-bytes)))))))
+ (21 ;preferred hash algorithms
+ (cons 'preferred-hash-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-hash-algorithm-alist))))
+ (22 ;preferred compression algorithms
+ (cons 'preferred-compression-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-compression-algorithm-alist))))
+ (23 ;key server preferences
+ (cons 'key-server-preferences
+ (pgg-read-body ptag)))
+ (24 ;preferred key server
+ (cons 'preferred-key-server
+ (pgg-read-body-string ptag)))
+ ;; 25 = primary user id
+ (26 ;policy URL
+ (cons 'policy-url (pgg-read-body-string ptag)))
+ ;; 27 = key flags
+ ;; 28 = signer's user id
+ ;; 29 = reason for revocation
+ ;; 100 to 110 = internal or user-defined
+ ))
+
+(defun pgg-parse-signature-packet (ptag)
+ (let* ((signature-version (pgg-byte-after))
+ (result (list (cons 'version signature-version)))
+ hashed-material field n)
+ (cond
+ ((= signature-version 3)
+ (pgg-skip-bytes 2)
+ (setq hashed-material (pgg-read-bytes 5))
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pop hashed-material)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'creation-time
+ (pgg-parse-time-field hashed-material))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte)))
+ ((= signature-version 4)
+ (pgg-skip-bytes 1)
+ (pgg-set-alist result
+ 'signature-type
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-signature-type-alist)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'hash-algorithm (pgg-read-byte))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))
+ (goto-char (point-max))))
+ (when (>= 10000 (setq n (pgg-read-bytes 2)
+ n (logior (lsh (car n) 8)
+ (nth 1 n))))
+ (save-restriction
+ (narrow-to-region (point)(+ n (point)))
+ (nconc result
+ (mapcar (function cdr) ;remove packet types
+ (pgg-parse-packets
+ #'pgg-parse-signature-subpacket-header
+ #'pgg-parse-signature-subpacket)))))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ (setcdr (setq field (assq 'hash-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-hash-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version (pgg-read-byte))
+ (pgg-set-alist result
+ 'key-identifier
+ (pgg-format-key-identifier
+ (pgg-read-bytes-string 8)))
+ (pgg-set-alist result
+ 'public-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+ (let (result)
+ (pgg-set-alist result
+ 'version
+ (pgg-read-byte))
+ (pgg-set-alist result
+ 'symmetric-key-algorithm
+ (cdr (assq (pgg-read-byte)
+ pgg-parse-symmetric-key-algorithm-alist)))
+ result))
+
+(defun pgg-parse-public-key-packet (ptag)
+ (let* ((key-version (pgg-read-byte))
+ (result (list (cons 'version key-version)))
+ field)
+ (cond
+ ((= 3 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'key-expiry (pgg-read-bytes 2))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte)))
+ ((= 4 key-version)
+ (pgg-set-alist result
+ 'creation-time
+ (let ((bytes (pgg-read-bytes 4)))
+ (pgg-parse-time-field bytes)))
+ (pgg-set-alist result
+ 'public-key-algorithm (pgg-read-byte))))
+
+ (setcdr (setq field (assq 'public-key-algorithm
+ result))
+ (cdr (assq (cdr field)
+ pgg-parse-public-key-algorithm-alist)))
+ result))
+
+(defun pgg-decode-packets ()
+ (if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t)
+ (let ((p (match-beginning 0))
+ (checksum (match-string 1)))
+ (delete-region p (point-max))
+ (if (ignore-errors (base64-decode-region (point-min) p))
+ (or (not (fboundp 'pgg-parse-crc24-string))
+ pgg-ignore-packet-checksum
+ (string-equal (base64-encode-string (pgg-parse-crc24-string
+ (buffer-string)))
+ checksum)
+ (progn
+ (message "PGP packet checksum does not match")
+ nil))
+ (message "PGP packet contain invalid base64")
+ nil))
+ (message "PGP packet checksum not found")
+ nil))
+
+(defun pgg-decode-armor-region (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (re-search-forward "^-+BEGIN PGP" nil t)
+ (delete-region (point-min)
+ (and (search-forward "\n\n")
+ (match-end 0)))
+ (when (pgg-decode-packets)
+ (goto-char (point-min))
+ (pgg-parse-packets))))
+
+(defun pgg-parse-armor (string)
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (insert string)
+ (pgg-decode-armor-region (point-min)(point))))
+
+(eval-and-compile
+ (defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte)
+ 'string-as-unibyte
+ 'identity)))
+
+(defun pgg-parse-armor-region (start end)
+ (pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e
+;;; pgg-parse.el ends here
diff --git a/lisp/gnus/pgg-pgp.el b/lisp/gnus/pgg-pgp.el
new file mode 100644
index 00000000000..ca686e9f1a6
--- /dev/null
+++ b/lisp/gnus/pgg-pgp.el
@@ -0,0 +1,242 @@
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl) ; for pgg macros
+ (require 'pgg))
+
+(defgroup pgg-pgp ()
+ "PGP 2.* and 6.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp-program "pgp"
+ "PGP 2.* and 6.* executable."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-file-name "/bin/sh"
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp
+ :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+ "Extra arguments for every PGP invocation."
+ :group 'pgg-pgp
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-pgp-user-id nil
+ "PGP ID of your default identity.")
+
+(defun pgg-pgp-process-region (start end passphrase program args)
+ (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
+ (args
+ (append args
+ pgg-pgp-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp-shell-file-name)
+ (shell-command-switch pgg-pgp-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq process
+ (apply #'funcall
+ #'start-process-shell-command "*PGP*" output-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(defun pgg-pgp-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "+batchmode" "+language=en" "-kv" string)))
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp-program nil t nil args)
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
+ (buffer-substring (point)(+ 8 (point))))
+ ((re-search-forward "^Type" nil t);PGP 6.*
+ (beginning-of-line 2)
+ (substring
+ (nth 2 (split-string
+ (buffer-substring (point)(progn (end-of-line) (point)))))
+ 2))))))
+
+(defun pgg-pgp-encrypt-region (start end recipients)
+ "Encrypt the current region between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ `("+encrypttoself=off +verbose=1" "+batchmode"
+ "+language=us" "-fate"
+ ,@(if recipients
+ (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp-user-id))))))))
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt)))
+ (args
+ '("+verbose=1" "+batchmode" "+language=us" "-f")))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp-sign-region (start end &optional clearsign)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp-user-id)
+ (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))
+ (args
+ (list (if clearsign "-fast" "-fbast")
+ "+verbose=1" "+language=us" "+batchmode"
+ "-u" pgg-pgp-user-id)))
+ (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(defun pgg-pgp-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let* ((orig-file (pgg-make-temp-file "pgg"))
+ (args '("+verbose=1" "+batchmode" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
+ (set-default-file-modes orig-mode))
+ (if (stringp signature)
+ (progn
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature orig-file))))
+ (setq args (append args (list orig-file))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (pgg-process-when-success
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while (re-search-forward "^warning: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (beginning-of-line 2) (point)))))
+ (goto-char (point-min))
+ (when (re-search-forward "^\\.$" nil t)
+ (delete-region (point-min)
+ (progn (beginning-of-line 2)
+ (point)))))))
+
+(defun pgg-pgp-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
+ (concat "\"" pgg-pgp-user-id "\""))))
+ (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-pgp-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+ (key-file (pgg-make-temp-file "pgg"))
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
+ key-file)))
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end key-file))
+ (pgg-pgp-process-region start end nil pgg-pgp-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp)
+
+;;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
+;;; pgg-pgp.el ends here
diff --git a/lisp/gnus/pgg-pgp5.el b/lisp/gnus/pgg-pgp5.el
new file mode 100644
index 00000000000..372cf48c473
--- /dev/null
+++ b/lisp/gnus/pgg-pgp5.el
@@ -0,0 +1,249 @@
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl) ; for pgg macros
+ (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+ "PGP 5.* interface"
+ :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+ "PGP 5.* 'pgpe' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+ "PGP 5.* 'pgps' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+ "PGP 5.* 'pgpk' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-pgpv-program "pgpv"
+ "PGP 5.* 'pgpv' executable."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-file-name "/bin/sh"
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'pgg-pgp5
+ :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+ "Extra arguments for every PGP 5.* invocation."
+ :group 'pgg-pgp5
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Arguments")))
+
+(defvar pgg-pgp5-user-id nil
+ "PGP 5.* ID of your default identity.")
+
+(defun pgg-pgp5-process-region (start end passphrase program args)
+ (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
+ (args
+ (append args
+ pgg-pgp5-extra-args
+ (list (concat "2>" errors-file-name))))
+ (shell-file-name pgg-pgp5-shell-file-name)
+ (shell-command-switch pgg-pgp5-shell-command-switch)
+ (process-environment process-environment)
+ (output-buffer pgg-output-buffer)
+ (errors-buffer pgg-errors-buffer)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (when passphrase
+ (setenv "PGPPASSFD" "0"))
+ (unwind-protect
+ (progn
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (setq process
+ (apply #'funcall
+ #'start-process-shell-command "*PGP*" output-buffer
+ program args)))
+ (set-process-sentinel process #'ignore)
+ (when passphrase
+ (process-send-string process (concat passphrase "\n")))
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer output-buffer
+ (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)))
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (condition-case nil
+ (delete-file errors-file-name)
+ (file-error nil)))))
+
+(defun pgg-pgp5-lookup-key (string &optional type)
+ "Search keys associated with STRING."
+ (let ((args (list "+language=en" "-l" string)))
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
+ (goto-char (point-min))
+ (when (re-search-forward "^sec" nil t)
+ (substring
+ (nth 2 (split-string
+ (buffer-substring (match-end 0)(progn (end-of-line)(point)))))
+ 2)))))
+
+(defun pgg-pgp5-encrypt-region (start end recipients &optional sign)
+ "Encrypt the current region between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (args
+ `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
+ ,@(if recipients
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "-r"
+ (concat "\"" rcpt "\"")))
+ (append recipients
+ (if pgg-encrypt-for-me
+ (list pgg-pgp5-user-id)))))))))
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp5-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))
+ (args
+ '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
+ (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
+ (pgg-process-when-success nil)))
+
+(defun pgg-pgp5-sign-region (start end &optional clearsign)
+ "Make detached signature from text between START and END."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (passphrase
+ (pgg-read-passphrase
+ (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+ (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))
+ (args
+ (list (if clearsign "-fat" "-fbat")
+ "+verbose=1" "+language=us" "+batchmode=1"
+ "-u" pgg-pgp5-user-id)))
+ (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
+ (pgg-process-when-success
+ (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
+ (progn (beginning-of-line 2)
+ (point))
+ (point-max))))))
+ (if pgg-cache-passphrase
+ (pgg-add-passphrase-cache
+ (cdr (assq 'key-identifier packet))
+ passphrase)))))))
+
+(defun pgg-pgp5-verify-region (start end &optional signature)
+ "Verify region between START and END as the detached signature SIGNATURE."
+ (let ((orig-file (pgg-make-temp-file "pgg"))
+ (args '("+verbose=1" "+batchmode=1" "+language=us"))
+ (orig-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
+ (set-default-file-modes orig-mode))
+ (when (stringp signature)
+ (copy-file signature (setq signature (concat orig-file ".asc")))
+ (setq args (append args (list signature))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
+ (delete-file orig-file)
+ (if signature (delete-file signature))
+ (with-current-buffer pgg-errors-buffer
+ (goto-char (point-min))
+ (if (re-search-forward "^Good signature" nil t)
+ (progn
+ (set-buffer pgg-output-buffer)
+ (insert-buffer-substring pgg-errors-buffer)
+ t)
+ nil))))
+
+(defun pgg-pgp5-insert-key ()
+ "Insert public key at point."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
+ (concat "\"" pgg-pgp5-user-id "\""))))
+ (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
+ (insert-buffer-substring pgg-output-buffer)))
+
+(defun pgg-pgp5-snarf-keys-region (start end)
+ "Add all public keys in region between START and END to the keyring."
+ (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+ (key-file (pgg-make-temp-file "pgg"))
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
+ key-file)))
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end key-file))
+ (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
+ (delete-file key-file)
+ (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp5)
+
+;;; arch-tag: 3dbd1073-6b3a-466c-9f55-5c587ffa6d7b
+;;; pgg-pgp5.el ends here
diff --git a/lisp/gnus/pgg.el b/lisp/gnus/pgg.el
new file mode 100644
index 00000000000..888219a8c57
--- /dev/null
+++ b/lisp/gnus/pgg.el
@@ -0,0 +1,468 @@
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'pgg-def)
+(require 'pgg-parse)
+(autoload 'run-at-time "timer")
+
+;; Don't merge these two `eval-when-compile's.
+(eval-when-compile
+ (require 'cl))
+;; Fixme: This would be better done with an autoload for
+;; `url-insert-file-contents', and the url stuff rationalized.
+;; (`locate-library' can say whether the url code is available.)
+(eval-when-compile
+ (ignore-errors
+ (require 'w3)
+ (require 'url)))
+
+;;; @ utility functions
+;;;
+
+(defvar pgg-fetch-key-function (if (fboundp 'url-insert-file-contents)
+ (function pgg-fetch-key-with-w3)))
+
+(defun pgg-invoke (func scheme &rest args)
+ (progn
+ (require (intern (format "pgg-%s" scheme)))
+ (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
+
+(put 'pgg-save-coding-system 'lisp-indent-function 2)
+
+(defmacro pgg-save-coding-system (start end &rest body)
+ `(if (interactive-p)
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (let (buffer-undo-list)
+ (insert-buffer-substring buffer ,start ,end)
+ (encode-coding-region (point-min)(point-max)
+ buffer-file-coding-system)
+ (prog1 (save-excursion ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))))
+ (save-restriction
+ (narrow-to-region ,start ,end)
+ ,@body)))
+
+(defun pgg-temp-buffer-show-function (buffer)
+ (let ((window (or (get-buffer-window buffer 'visible)
+ (split-window-vertically))))
+ (set-window-buffer window buffer)
+ (shrink-window-if-larger-than-buffer window)))
+
+(defun pgg-display-output-buffer (start end status)
+ (if status
+ (progn
+ (delete-region start end)
+ (insert-buffer-substring pgg-output-buffer)
+ (decode-coding-region start (point) buffer-file-coding-system))
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring pgg-errors-buffer)))))
+
+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defun pgg-read-passphrase (prompt &optional key)
+ (or (and pgg-cache-passphrase
+ key (setq key (pgg-truncate-key-identifier key))
+ (symbol-value (intern-soft key pgg-passphrase-cache)))
+ (read-passwd prompt)))
+
+(eval-when-compile
+ (defvar itimer-process)
+ (defvar itimer-timer)
+ (autoload 'delete-itimer "itimer")
+ (autoload 'itimer-driver-start "itimer")
+ (autoload 'itimer-value "itimer")
+ (autoload 'set-itimer-function "itimer")
+ (autoload 'set-itimer-function-arguments "itimer")
+ (autoload 'set-itimer-restart "itimer")
+ (autoload 'start-itimer "itimer"))
+
+(eval-and-compile
+ (defalias
+ 'pgg-run-at-time
+ (if (featurep 'xemacs)
+ (if (condition-case nil
+ (progn
+ (unless (or itimer-process itimer-timer)
+ (itimer-driver-start))
+ ;; Check whether there is a bug to which the difference of
+ ;; the present time and the time when the itimer driver was
+ ;; woken up is subtracted from the initial itimer value.
+ (let* ((inhibit-quit t)
+ (ctime (current-time))
+ (itimer-timer-last-wakeup
+ (prog1
+ ctime
+ (setcar ctime (1- (car ctime)))))
+ (itimer-list nil)
+ (itimer (start-itimer "pgg-run-at-time" 'ignore 5)))
+ (sleep-for 0.1) ;; Accept the timeout interrupt.
+ (prog1
+ (> (itimer-value itimer) 0)
+ (delete-itimer itimer))))
+ (error nil))
+ (lambda (time repeat function &rest args)
+ "Emulating function run as `run-at-time'.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (apply #'start-itimer "pgg-run-at-time"
+ function (if time (max time 1e-9) 1e-9)
+ repeat nil t args))
+ (lambda (time repeat function &rest args)
+ "Emulating function run as `run-at-time' in the right way.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (let ((itimers (list nil)))
+ (setcar
+ itimers
+ (apply #'start-itimer "pgg-run-at-time"
+ (lambda (itimers repeat function &rest args)
+ (let ((itimer (car itimers)))
+ (if repeat
+ (progn
+ (set-itimer-function
+ itimer
+ (lambda (itimer repeat function &rest args)
+ (set-itimer-restart itimer repeat)
+ (set-itimer-function itimer function)
+ (set-itimer-function-arguments itimer args)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer repeat function) args)))
+ (set-itimer-function
+ itimer
+ (lambda (itimer function &rest args)
+ (delete-itimer itimer)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer function) args)))))
+ 1e-9 (if time (max time 1e-9) 1e-9)
+ nil t itimers repeat function args)))))
+ 'run-at-time)))
+
+(defun pgg-add-passphrase-cache (key passphrase)
+ (setq key (pgg-truncate-key-identifier key))
+ (set (intern key pgg-passphrase-cache)
+ passphrase)
+ (pgg-run-at-time pgg-passphrase-cache-expiry nil
+ #'pgg-remove-passphrase-cache
+ key))
+
+(defun pgg-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key pgg-passphrase-cache))))
+
+(defmacro pgg-convert-lbt-region (start end lbt)
+ `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
+ (goto-char ,start)
+ (case ,lbt
+ (CRLF
+ (while (progn
+ (end-of-line)
+ (> (marker-position pgg-conversion-end) (point)))
+ (insert "\r")
+ (forward-line 1)))
+ (LF
+ (while (re-search-forward "\r$" pgg-conversion-end t)
+ (replace-match ""))))))
+
+(put 'pgg-as-lbt 'lisp-indent-function 3)
+
+(defmacro pgg-as-lbt (start end lbt &rest body)
+ `(let ((inhibit-read-only t)
+ buffer-read-only
+ buffer-undo-list)
+ (pgg-convert-lbt-region ,start ,end ,lbt)
+ (let ((,end (point)))
+ ,@body)
+ (push nil buffer-undo-list)
+ (ignore-errors (undo))))
+
+(put 'pgg-process-when-success 'lisp-indent-function 0)
+
+(defmacro pgg-process-when-success (&rest body)
+ `(with-current-buffer pgg-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+(defalias 'pgg-make-temp-file
+ (if (fboundp 'make-temp-file)
+ 'make-temp-file
+ (lambda (prefix &optional dir-flag)
+ (let ((file (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))
+ (if dir-flag
+ (make-directory file))
+ file))))
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun pgg-encrypt-region (start end rcpts &optional sign)
+ "Encrypt the current region between START and END for RCPTS.
+If optional argument SIGN is non-nil, do a combined sign and encrypt."
+ (interactive
+ (list (region-beginning)(region-end)
+ (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let ((status
+ (pgg-save-coding-system start end
+ (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max) rcpts sign))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-encrypt (rcpts &optional sign start end)
+ "Encrypt the current buffer for RCPTS.
+If optional argument SIGN is non-nil, do a combined sign and encrypt.
+If optional arguments START and END are specified, only encrypt within
+the region."
+ (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-encrypt-region start end rcpts sign)))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (interactive "r")
+ (let* ((buf (current-buffer))
+ (status
+ (pgg-save-coding-system start end
+ (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-decrypt (&optional start end)
+ "Decrypt the current buffer.
+If optional arguments START and END are specified, only decrypt within
+the region."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-decrypt-region start end)))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-sign-region (start end &optional cleartext)
+ "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature.
+If this function is called interactively, CLEARTEXT is enabled
+and the the output is displayed."
+ (interactive "r")
+ (let ((status (pgg-save-coding-system start end
+ (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max)
+ (or (interactive-p) cleartext)))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-sign (&optional cleartext start end)
+ "Sign the current buffer.
+If the optional argument CLEARTEXT is non-nil, it does not create a
+detached signature.
+If optional arguments START and END are specified, only sign data
+within the region.
+If this function is called interactively, CLEARTEXT is enabled
+and the the output is displayed."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-sign-region start end (or (interactive-p) cleartext))))
+ (when (interactive-p)
+ (pgg-display-output-buffer start end status))
+ status))
+
+;;;###autoload
+(defun pgg-verify-region (start end &optional signature fetch)
+ "Verify the current region between START and END.
+If the optional 3rd argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+
+If the optional 4th argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'."
+ (interactive "r")
+ (let* ((packet
+ (if (null signature) nil
+ (with-temp-buffer
+ (buffer-disable-undo)
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (insert-file-contents signature)
+ (cdr (assq 2 (pgg-decode-armor-region
+ (point-min)(point-max)))))))
+ (key (cdr (assq 'key-identifier packet)))
+ status keyserver)
+ (and (stringp key)
+ pgg-query-keyserver
+ (setq key (concat "0x" (pgg-truncate-key-identifier key)))
+ (null (pgg-lookup-key key))
+ (or fetch (interactive-p))
+ (y-or-n-p (format "Key %s not found; attempt to fetch? " key))
+ (setq keyserver
+ (or (cdr (assq 'preferred-key-server packet))
+ pgg-default-keyserver-address))
+ (pgg-fetch-key keyserver key))
+ (setq status
+ (pgg-save-coding-system start end
+ (pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme)
+ (point-min) (point-max) signature)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))
+ status))
+
+;;;###autoload
+(defun pgg-verify (&optional signature fetch start end)
+ "Verify the current buffer.
+If the optional argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+If the optional argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'.
+If optional arguments START and END are specified, only verify data
+within the region."
+ (interactive "")
+ (let* ((start (or start (point-min)))
+ (end (or end (point-max)))
+ (status (pgg-verify-region start end signature fetch)))
+ (when (interactive-p)
+ (let ((temp-buffer-show-function
+ (function pgg-temp-buffer-show-function)))
+ (with-output-to-temp-buffer pgg-echo-buffer
+ (set-buffer standard-output)
+ (insert-buffer-substring (if status pgg-output-buffer
+ pgg-errors-buffer)))))))
+
+;;;###autoload
+(defun pgg-insert-key ()
+ "Insert the ASCII armored public key."
+ (interactive)
+ (pgg-invoke "insert-key" (or pgg-scheme pgg-default-scheme)))
+
+;;;###autoload
+(defun pgg-snarf-keys-region (start end)
+ "Import public keys in the current region between START and END."
+ (interactive "r")
+ (pgg-save-coding-system start end
+ (pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme)
+ start end)))
+
+;;;###autoload
+(defun pgg-snarf-keys ()
+ "Import public keys in the current buffer."
+ (interactive "")
+ (pgg-snarf-keys-region (point-min) (point-max)))
+
+(defun pgg-lookup-key (string &optional type)
+ (pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type))
+
+(defvar pgg-insert-url-function (function pgg-insert-url-with-w3))
+
+(defun pgg-insert-url-with-w3 (url)
+ (ignore-errors
+ (require 'w3)
+ (require 'url)
+ (let (buffer-file-name)
+ (url-insert-file-contents url))))
+
+(defvar pgg-insert-url-extra-arguments nil)
+(defvar pgg-insert-url-program nil)
+
+(defun pgg-insert-url-with-program (url)
+ (let ((args (copy-sequence pgg-insert-url-extra-arguments))
+ process)
+ (insert
+ (with-temp-buffer
+ (setq process
+ (apply #'start-process " *PGG url*" (current-buffer)
+ pgg-insert-url-program (nconc args (list url))))
+ (set-process-sentinel process #'ignore)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (delete-process process)
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ (buffer-string)))))
+
+(defun pgg-fetch-key (keyserver key)
+ "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
+ (with-current-buffer (get-buffer-create pgg-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
+ (substring keyserver 0 (1- (match-end 0))))))
+ (save-excursion
+ (funcall pgg-insert-url-function
+ (if proto keyserver
+ (format "http://%s:11371/pks/lookup?op=get&search=%s"
+ keyserver key))))
+ (when (re-search-forward "^-+BEGIN" nil 'last)
+ (delete-region (point-min) (match-beginning 0))
+ (when (re-search-forward "^-+END" nil t)
+ (delete-region (progn (end-of-line) (point))
+ (point-max)))
+ (insert "\n")
+ (with-temp-buffer
+ (insert-buffer-substring pgg-output-buffer)
+ (pgg-snarf-keys-region (point-min)(point-max)))))))
+
+
+(provide 'pgg)
+
+;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4
+;;; pgg.el ends here
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 7bcfa962eb0..567ab24e004 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -1,6 +1,6 @@
;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
@@ -78,7 +78,7 @@ Used for APOP authentication.")
;; query for password
(if (and pop3-password-required (not pop3-password))
(setq pop3-password
- (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (read-passwd (format "Password for %s: " pop3-maildrop))))
(cond ((equal 'apop pop3-authentication-scheme)
(pop3-apop process pop3-maildrop))
((equal 'pass pop3-authentication-scheme)
@@ -88,8 +88,8 @@ Used for APOP authentication.")
(setq message-count (car (pop3-stat process)))
(unwind-protect
(while (<= n message-count)
- (message (format "Retrieving message %d of %d from %s..."
- n message-count pop3-mailhost))
+ (message "Retrieving message %d of %d from %s..."
+ n message-count pop3-mailhost)
(pop3-retr process n crashbuf)
(save-excursion
(set-buffer crashbuf)
@@ -121,7 +121,7 @@ Used for APOP authentication.")
;; query for password
(if (and pop3-password-required (not pop3-password))
(setq pop3-password
- (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (read-passwd (format "Password for %s: " pop3-maildrop))))
(cond ((equal 'apop pop3-authentication-scheme)
(pop3-apop process pop3-maildrop))
((equal 'pass pop3-authentication-scheme)
@@ -177,8 +177,9 @@ Return the response string if optional second argument is non-nil."
(save-excursion
(set-buffer (process-buffer process))
(goto-char pop3-read-point)
- (while (not (search-forward "\r\n" nil t))
- (accept-process-output process 3)
+ (while (and (memq (process-status process) '(open run))
+ (not (search-forward "\r\n" nil t)))
+ (nnheader-accept-process-output process)
(goto-char pop3-read-point))
(setq match-end (point))
(goto-char pop3-read-point)
@@ -192,17 +193,6 @@ Return the response string if optional second argument is non-nil."
t)
)))))
-(defvar pop3-read-passwd nil)
-(defun pop3-read-passwd (prompt)
- (if (not pop3-read-passwd)
- (if (fboundp 'read-passwd)
- (setq pop3-read-passwd 'read-passwd)
- (if (load "passwd" t)
- (setq pop3-read-passwd 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq pop3-read-passwd 'ange-ftp-read-passwd))))
- (funcall pop3-read-passwd prompt))
-
(defun pop3-clean-region (start end)
(setq end (set-marker (make-marker) end))
(save-excursion
@@ -263,7 +253,7 @@ If NOW, use that time instead."
;; Tue Jul 9 09:04:21 1996
(setq date
(cond ((not date)
- "Tue Jan 1 00:00:0 1900")
+ "Tue Jan 1 00:00:0 1900")
((string-match "[A-Z]" (nth 0 date))
(format "%s %s %s %s %s"
(nth 0 date) (nth 2 date) (nth 1 date)
@@ -316,7 +306,7 @@ If NOW, use that time instead."
(let ((pass pop3-password))
(if (and pop3-password-required (not pass))
(setq pass
- (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (read-passwd (format "Password for %s: " pop3-maildrop))))
(if pass
(let ((hash (pop3-md5 (concat pop3-timestamp pass))))
(pop3-send-command process (format "APOP %s %s" user hash))
@@ -363,7 +353,8 @@ This function currently does nothing.")
(save-excursion
(set-buffer (process-buffer process))
(while (not (re-search-forward "^\\.\r\n" nil t))
- (accept-process-output process 3)
+ ;; Fixme: Shouldn't depend on nnheader.
+ (nnheader-accept-process-output process)
;; bill@att.com ... to save wear and tear on the heap
;; uncommented because the condensed version below is a problem for
;; some.
diff --git a/lisp/gnus/post.xpm b/lisp/gnus/post.xpm
index 008cdc7fc6c..7a3eaa5e3b1 100644
--- a/lisp/gnus/post.xpm
+++ b/lisp/gnus/post.xpm
@@ -1,53 +1,35 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 23 1",
-" c Gray0",
-". c Gray6",
-"X c Gray12",
-"o c #2ff22ff22ff2",
-"O c #3fff3fff3fff",
-"+ c Gray28",
-"@ c #53ee53ee53ee",
-"# c #5fdf5fdf5fdf",
-"$ c #67e767e767e7",
-"% c #6fff6fff6fff",
-"& c #77f777f777f7",
-"* c #7bdb7bdb7bdb",
-"= c Gray50",
-"- c Gray56",
-"; c #9bd69bd69bd6",
-": c #9fff9fff9fff",
-"> c #a7c7a7c7a7c7",
-", c Gray70",
-"< c Gray75",
-"1 c Gray81",
-"2 c #dfffdfffdfff",
-"3 c #efffefffefff",
-"4 c Gray100",
-/* pixels */
-",><,><,><,><,><,><,><,><",
-">-<>-<>-<>-<>-<>-<>-<>-<",
-"<<<<<<<<<<<<<<<<<<<<<<<<",
-",><,><,><,>;*O.,><,><,><",
-">-<>-<>-<-o&:4O#-<>-<>-<",
-"<<<<<<<<@@<31O:o<<<<<<<<",
-",><,>;*O1444 X1@><,><,><",
-">-<-o&:4444:=<4<#<>-<>-<",
-"<<<,+<4444414443&;<<<<<<",
-",><,#;4444444444:*,><,><",
-">-<>-o44444444444O>-<>-<",
-"<<<<<;%44444444441@<<<<<",
-",><,><@24444444444@><,><",
-">-<>-<-=4444444444<#<>-<",
-"<<<<<<,$14444444443&;<<<",
-",><,><,#;4444444444:*,><",
-">-<>-<>-o4444444444<X>-<",
-"<<<<<<<<;%4444444%O$-<<<",
-",><,><,><@24444<&;,><,><",
-">-<>-<>-<-=42==#-<>-<>-<",
-"<<<<<<<<<,$Oo+-<<<<<<<<<",
-",><,><,><,><,><,><,><,><",
-">-<>-<>-<>-<>-<>-<>-<>-<",
-"<<<<<<<<<<<<<<<<<<<<<<<<"
-};
+static char * post_xpm[] = {
+"24 24 8 1",
+". c None",
+" c #434343434343",
+"X c #A5A5A5A59595",
+"O c #000000000000",
+"+ c #C7C7C6C6C6C6",
+"@ c #FFFF00000000",
+"# c #9A9A6C6C4E4E",
+"$ c #E1E1E0E0E0E0",
+"O..O..O..O..O..O..O..O..",
+"........................",
+"............X...........",
+"O..O..O..O.XXX.O..O..O..",
+".........XX++@X.........",
+".......XX+++#@$X........",
+"O..OXXX++++##$$$X.O..O..",
+"....X$X++++++$$$X.......",
+"....X$$X+++$$$$$$X......",
+"O..OX$$XX++$$$$$$$X..O..",
+"....X$$X++$$$$$$$$$X....",
+"....X$X+$$$$$$$$$$$+X...",
+"O..O+X++$$$$$$$$$$$$XO..",
+"....+X+$$$$$$$$$$$$X+...",
+".....+X$$$$$$$$$$$X+....",
+"O..O.+X$$$$$$$$$XXO..O..",
+"......+X$$$$$$$X++......",
+"......+X$$$$$XX+........",
+"O..O..O+X$$$X++O..O..O..",
+".......+X$$X++..........",
+"........+XX+............",
+"O..O..O..O+.O..O..O..O..",
+"........................",
+"........................"};
diff --git a/lisp/gnus/prev-ur.xpm b/lisp/gnus/prev-ur.xpm
index 7c3db24599b..80131332832 100644
--- a/lisp/gnus/prev-ur.xpm
+++ b/lisp/gnus/prev-ur.xpm
@@ -1,65 +1,35 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 35 1",
-" c Gray0",
-". c Gray6",
-"X c Gray9",
-"o c Gray12",
-"O c #23f323f323f3",
-"+ c Gray15",
-"@ c #2ff22ff22ff2",
-"# c #399939993999",
-"$ c #3fff3fff3fff",
-"% c Gray28",
-"& c #53ed53ed53ed",
-"* c Gray35",
-"= c #5b1a5b1a5b1a",
-"- c Gray36",
-"; c #5fef5fef5fef",
-": c Gray40",
-"> c #67e767e767e7",
-", c #6ffa6ffa6ffa",
-"< c Gray45",
-"1 c #77ea77ea77ea",
-"2 c #799979997999",
-"3 c #7bdb7bdb7bdb",
-"4 c Gray50",
-"5 c Gray56",
-"6 c Gray60",
-"7 c #9bde9bde9bde",
-"8 c #9fff9fff9fff",
-"9 c #a7c7a7c7a7c7",
-"0 c #acccacccaccc",
-"q c Gray70",
-"w c Gray75",
-"e c Gray81",
-"r c #dfffdfffdfff",
-"t c #efffefffefff",
-"y c Gray100",
-/* pixels */
-"q9wq9wq9wq9wq9wq9wq9wq9w",
-"95w95w95w95w95w95w95w95w",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"q9wq9wq9wq973$.q9wq9wq9w",
-"95w95w95w5@18y$;5w95w95w",
-"wwwwwwww&&wte$8@wwwwwwww",
-"q9wq973$eyyy oe&9wq9wq9w",
-"95w5@18yyyy84wyw;w95w95w",
-"wwwq%wyyyyyeyyyt17wwwwww",
-"q9wq;7yyyyyyyyyy45q9wq9w",
-"95w9518yyr44yyyy4%%@995w",
-"wwwww&.3;;w@yyye=<<#Owww",
-"q9wq=;:$etw;$rt+w0777O9w",
-"95w5+<8yy; wo44+77777X5w",
-"ww&&wtyyy ;t@re+77777@ww",
-"q%wyyyyy,yyyw4ye=<<#Oq9w",
-"9@wyyyyyyyyyr4rywo;;995w",
-"w9&yyyyyyyyyy4we$3wwwwww",
-"q9&eyyyyyyyyyy,@wwq9wq9w",
-"95w$yyyyyyyyyyy@ww95w95w",
-"www38yyyyyyyyyy71wwwwwww",
-"q9w54yyyyyyyyyye:qq9wq9w",
-"95w9,ryyyyyyyyyy4595w95w",
-"wwww9&yyyyyyyyyyr&wwwwww"
-};
+static char * prev_ur_xpm[] = {
+"24 24 8 1",
+". c None",
+" c #000000000000",
+"X c #A5A5A5A59595",
+"o c #C7C7C6C6C6C6",
+"O c #FFFF00000000",
+"+ c #9A9A6C6C4E4E",
+"@ c #E1E1E0E0E0E0",
+"# c #FFFFFFFFFFFF",
+" .. .. .. .. .. .. .. ..",
+"........................",
+"............X...........",
+" .. .. .. .XXX. .. .. ..",
+".........XXooOX.........",
+".......XXooo+O@X........",
+" .. XXXoooo++@@@X. .. ..",
+"....X@Xoooooo@@@X.......",
+"....X@@Xooo@@@@@@X......",
+" .. X@@XXoo@@@@@@@X.. ..",
+"....X@@Xo @@@@@@ X....",
+"....X@Xo ## X @ ## X...",
+" .. oXo #XXXoO@ #### ..",
+"....oXoXXooo+OX #### ...",
+"....XXXoooo++@@X ## ....",
+" .. X@Xoooooo@@@X .. ..",
+"....X@@Xooo@@@@@@X......",
+"....X@@XXoo@@@@@@@X.....",
+" .. X@@Xoo@@@@@@@@@X. ..",
+"....X@Xo@@@@@@@@@@@@X...",
+"... oXoo@@@@@@@@@@@@X...",
+" .. oXo@@@@@@@@@@@@X....",
+".....oX@@@@@@@@@@@X.....",
+".....oX@@@@@@@@@@X......"};
diff --git a/lisp/gnus/preview.xbm b/lisp/gnus/preview.xbm
new file mode 100644
index 00000000000..a42e153d5d2
--- /dev/null
+++ b/lisp/gnus/preview.xbm
@@ -0,0 +1,10 @@
+#define preview_width 24
+#define preview_height 24
+static char preview_bits[] = {
+ 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
+ 0x00,0xc0,0x03,0x00,0x3e,0x06,0xf0,0x03,0x04,0x08,0x00,0x0a,0x78,0x00,0x09,
+ 0x88,0xf9,0x08,0x10,0xc6,0x10,0x10,0x3a,0x13,0x10,0x06,0x15,0x20,0x02,0x29,
+ 0x20,0x02,0x31,0x20,0xad,0x0f,0x40,0xf9,0x03,0xc0,0xb8,0x07,0x80,0x07,0x0e,
+ 0x80,0x01,0x1c,0x00,0x00,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc8,0x00,
+ 0x00,0x00,0x39,0x00,0x00,0x00,0x08,0xc0,0x12,0x42,0x00,0x00,0x00,0x00,0x38,
+ 0x82,0x18,0x08,0x00,0x00,0x00 };
diff --git a/lisp/gnus/preview.xpm b/lisp/gnus/preview.xpm
new file mode 100644
index 00000000000..f5743f91526
--- /dev/null
+++ b/lisp/gnus/preview.xpm
@@ -0,0 +1,33 @@
+/* XPM */
+static char *prev1[]={
+"24 24 6 1",
+". c None",
+"# c #000000",
+"d c #46463e",
+"a c #676663",
+"c c #a8a7a3",
+"b c #ebeae4",
+"........................",
+"........................",
+"........................",
+"........................",
+"........................",
+"..............####......",
+".........#####abbc#.....",
+"....#####acbbbbbbc#.....",
+"...#acbbbbbbbbbbacc#....",
+"...#baabbbbbbbbcacb#....",
+"...#cbcaabbd##dacbb#....",
+"....#bbbccdcbbcdabbc#...",
+"....#bbbbdccaaccdacb#...",
+"....#cbbb#abbbbb#bac#...",
+".....#bbb#cbbbbc#bbac#..",
+".....#bbbdcbbbbddbbc##..",
+".....#cbccdcbbd#####....",
+"......#babbd##dd##......",
+"......#acbc###.####.....",
+"......#aa##......###....",
+".......##.........###...",
+"...................##...",
+"........................",
+"........................"};
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index febf827ef42..6a27b20eb1e 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -1,6 +1,6 @@
;;; qp.el --- Quoted-Printable functions
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, extensions
@@ -32,13 +32,18 @@
(require 'mm-util)
(eval-when-compile (defvar mm-use-ultra-safe-encoding))
+;;;###autoload
(defun quoted-printable-decode-region (from to &optional coding-system)
"Decode quoted-printable in the region between FROM and TO, per RFC 2045.
If CODING-SYSTEM is non-nil, decode bytes into characters with that
coding-system.
Interactively, you can supply the CODING-SYSTEM argument
-with \\[universal-coding-system-argument]."
+with \\[universal-coding-system-argument].
+
+The CODING-SYSTEM argument is a historical hangover and is deprecated.
+QP encodes raw bytes and should be decoded into raw bytes. Decoding
+them into characters should be done separately."
(interactive
;; Let the user determine the coding system with "C-x RET c".
(list (region-beginning) (region-end) coding-system-for-read))
@@ -67,19 +72,19 @@ with \\[universal-coding-system-argument]."
(+ 3 (point)))
16)))
(mm-insert-byte byte 1)
- (delete-char 3)
- (unless (eq byte ?=)
- (backward-char))))
+ (delete-char 3)))
(t
- (error "Malformed quoted-printable text")
+ (message "Malformed quoted-printable text")
(forward-char)))))
(if coding-system
(mm-decode-coding-region (point-min) (point-max) coding-system)))))
(defun quoted-printable-decode-string (string &optional coding-system)
"Decode the quoted-printable encoded STRING and return the result.
-If CODING-SYSTEM is non-nil, decode the region with coding-system."
- (with-temp-buffer
+If CODING-SYSTEM is non-nil, decode the region with coding-system.
+Use of CODING-SYSTEM is deprecated; this function should deal with
+raw bytes, and coding conversion should be done separately."
+ (mm-with-unibyte-buffer
(insert string)
(quoted-printable-decode-region (point-min) (point-max) coding-system)
(buffer-string)))
diff --git a/lisp/gnus/receipt.xpm b/lisp/gnus/receipt.xpm
new file mode 100644
index 00000000000..18caaf1cf78
--- /dev/null
+++ b/lisp/gnus/receipt.xpm
@@ -0,0 +1,32 @@
+/* XPM */
+static char * receipt_xpm[] = {
+"24 24 5 1",
+" c None",
+". c #FFFFFFFFFFFF",
+"X c #676766666363",
+"o c #FFFF00000000",
+"O c #AEAE3E3E4848",
+" ",
+" ",
+" .. ",
+" . ",
+" . ",
+" . ",
+" .. ",
+" Xooo .. ",
+" Xoooooooo.. ",
+" Xoooooooooooooo ... ",
+" oooooooooooOOoo . ",
+" ooooooooooOOOOo. ",
+" oooooooooOO...o ",
+" ooooooooooOOooo ",
+" ooooooooooooooo ",
+" ooooooooooooooo ",
+" oooooooooooooo ",
+" ooooooooooo ",
+" ooooooo ",
+" oooo ",
+" oo ",
+" ",
+" ",
+" "};
diff --git a/lisp/gnus/reply-wo.xpm b/lisp/gnus/reply-wo.xpm
index fb45d4c1351..370678af70d 100644
--- a/lisp/gnus/reply-wo.xpm
+++ b/lisp/gnus/reply-wo.xpm
@@ -1,65 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 35 1",
-" c Gray0",
-". c Gray6",
-"X c Gray9",
-"o c Gray12",
-"O c #23f323f323f3",
-"+ c #2ffe2ffe2ffe",
-"@ c #399939993999",
-"# c #3fff3fff3fff",
-"$ c Gray25",
-"% c #499949994999",
-"& c #4ccc4ccc4ccc",
-"* c #519151915191",
-"= c #53f353f353f3",
-"- c Gray35",
-"; c #5feb5feb5feb",
-": c #67e767e767e7",
-"> c #6fff6fff6fff",
-", c Gray45",
-"< c #77ef77ef77ef",
-"1 c #7bdb7bdb7bdb",
-"2 c Gray50",
-"3 c Gray56",
-"4 c Gray60",
-"5 c #9bd39bd39bd3",
-"6 c #9fff9fff9fff",
-"7 c Gray64",
-"8 c #a7c7a7c7a7c7",
-"9 c Gray70",
-"0 c #b998b998b998",
-"q c #bcccbcccbccc",
-"w c Gray75",
-"e c Gray81",
-"r c #dfffdfffdfff",
-"t c #efffefffefff",
-"y c Gray100",
-/* pixels */
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwww5+o1wwwwwwwww",
-"wwwwwwwwww3<w26;3wwwwwww",
-"wwwwwwwww5<tw2yw<5wwwwww",
-"wwwwww93=#yy#yyyy>O8wwww",
-"wwwww<:226yy#yyyw2 ;wwww",
-"www5+5e66yyy#6##2w X5www",
-"w8=>ye#6yy2+#6yyr+9y>$8w",
-"w;;yw2yw22#wyyyr#@9yy@;w",
-"w;3#o+#2w3;tyyy+@3w##3;w",
-"w;wyy>wry66yyr+%0;>yyw;w",
-"w;wyyy222#yyr#;-2ryyyw;w",
-"7=wyyyyrw.6y+ +wryyyyw=7",
-"5&wyyyyye#o3.#6yyyyyyw&5",
-"5&wyyyyw2yw26y66yyyyyw&5",
-"5&wyyye2tyyyyyy66yyyyw&5",
-"5&wyr;>yyyyyyyyy6#eyyw&5",
-"5&wr2ryyyyyyyyyyyy2wyw&5",
-"5&+;ryyyyyyyyyyyyyt2#+&5",
-"5& wwwwwwwwwwwwwwwwww &5",
-"5,&&&&&&&&&&&&&&&&&&&&,5",
-"555555555555555555555555"
-};
+static char * reply_wo_xpm[] = {
+"24 24 4 1",
+" c None",
+". c #000000000000",
+"X c #E1E1E0E0E0E0",
+"O c #FFFFFFFFFFFF",
+" ",
+" ",
+" ",
+" .... ",
+" ..X.... ",
+" ..XX.XX.. ",
+" .O.XX.XXXX.. ",
+" ..O.XXX.XXXX... ",
+" .OO.XXXX.X....... ",
+" .OO.XXXX...XXX.OO.. ",
+" ..OO.XX....XXXX.OOOO.. ",
+" .......XX.XXXX.OOO.... ",
+" .OOO.XXX.XXXX.OO..OOO. ",
+" .OOOO....XXX....OOOOO. ",
+" .OOOOOOO..XX..OOOOOOO. ",
+" .OOOOOOO......OOOOOOO. ",
+" .OOOOOO.OO..O..OOOOOO. ",
+" .OOOOO.OOOOOOOO.OOOOO. ",
+" .OOOO.OOOOOOOOOO.OOOO. ",
+" .OOO.OOOOOOOOOOOO.OOO. ",
+" .O..OOOOOOOOOOOOOO..O. ",
+" ..OOOOOOOOOOOOOOOOOO.. ",
+" ...................... ",
+" "};
diff --git a/lisp/gnus/reply.xpm b/lisp/gnus/reply.xpm
index 20dd10234a8..a45884803fe 100644
--- a/lisp/gnus/reply.xpm
+++ b/lisp/gnus/reply.xpm
@@ -1,64 +1,31 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 34 1",
-" c Gray0",
-". c Gray6",
-"X c Gray9",
-"o c Gray12",
-"O c #2ffb2ffb2ffb",
-"+ c #399939993999",
-"@ c #3fff3fff3fff",
-"# c Gray25",
-"$ c #499949994999",
-"% c #4ccc4ccc4ccc",
-"& c #519151915191",
-"* c #53f353f353f3",
-"= c Gray35",
-"- c #5feb5feb5feb",
-"; c #67e767e767e7",
-": c #6fff6fff6fff",
-"> c Gray45",
-", c #77ef77ef77ef",
-"< c Gray50",
-"1 c Gray56",
-"2 c #933293329332",
-"3 c Gray60",
-"4 c #9bd29bd29bd2",
-"5 c #9fff9fff9fff",
-"6 c Gray64",
-"7 c #a7c7a7c7a7c7",
-"8 c Gray70",
-"9 c #b998b998b998",
-"0 c #bcccbcccbccc",
-"q c Gray75",
-"w c Gray81",
-"e c #dfffdfffdfff",
-"r c #efffefffefff",
-"t c Gray100",
-/* pixels */
-"qqqqqqqqqqqqqqqqqqqqqqqq",
-"qqqqqqqqqqqqqqqqqqqqqqqq",
-"qqqqqqqqqqqqqqqqqqqqqqqq",
-"qqqqqqqqqqqqqq4qqqqqqqqq",
-"qqqqqqqqqqqqq1,-1qqqqqqq",
-"qqqqqqqqq4OO4,rq,4qqqqqq",
-"qqqqqq81*:tw:tttt:*7qqqq",
-"qqqqq,;<etq<tttttt--qqqq",
-"qqq4O4wttt<qttttt: X4qqq",
-"q7*Oewrew55ttttteO6qO#7q",
-"q--<q5eq@5ttttte@+2<<+-q",
-"q-1@@wtt@ttttttO+1q@@1-q",
-"q-qtt:q<wtttteO$9-:ttq-q",
-"q-qttt<<<ttte@-=<etttq-q",
-"6*qtttteq:ttO Oqettttq*6",
-"4%qtttttw@o1.@5ttttttq%4",
-"4%qttttq<tq<5t55tttttq%4",
-"4%qtttw<rtttttt55ttttq%4",
-"4%qte-:ttttttttt5@wttq%4",
-"4%qe<etttttttttttt<qtq%4",
-"4%O-etttttttttttttr<@O%4",
-"4% qqqqqqqqqqqqqqqqqq %4",
-"4>%%%%%%%%%%%%%%%%%%%%>4",
-"444444444444444444444444"
-};
+static char * reply_xpm[] = {
+"24 24 4 1",
+" c None",
+". c #000000000000",
+"X c #E1E1E0E0E0E0",
+"O c #FFFFFFFFFFFF",
+" ",
+" ",
+" ",
+" .... ",
+" ..XXX.. ",
+" ..XXXXX.. ",
+" .O.XXXXXXX.. ",
+" ..O.XXXXXXXXX.. ",
+" .OO.XXXXXXXXXX... ",
+" .OO.XXXXXXXXXX.OO.. ",
+" ..OO.XXXXXXXXXX.OOOO.. ",
+" .....XXXXXXXXX.OOO.... ",
+" .OOO.XXXXXXXX.OO..OOO. ",
+" .OOOO...XXXXX...OOOOO. ",
+" .OOOOOOO..XX..OOOOOOO. ",
+" .OOOOOOO......OOOOOOO. ",
+" .OOOOOO.OO..O..OOOOOO. ",
+" .OOOOO.OOOOOOOO.OOOOO. ",
+" .OOOO.OOOOOOOOOO.OOOO. ",
+" .OOO.OOOOOOOOOOOO.OOO. ",
+" .O..OOOOOOOOOOOOOO..O. ",
+" ..OOOOOOOOOOOOOOOOOO.. ",
+" ...................... ",
+" "};
diff --git a/lisp/gnus/reverse-smile.xpm b/lisp/gnus/reverse-smile.xpm
new file mode 100644
index 00000000000..56db090e4b3
--- /dev/null
+++ b/lisp/gnus/reverse-smile.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * reverse_smile_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++.....+++.",
+".++.+++++.++.",
+".++.+++++.++.",
+".+++++++++++.",
+".+++++++++++.",
+".++..+++..++.",
+".++..+++..++.",
+".+++++++++++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el
index 5c50ad2ef07..f43bfc0f241 100644
--- a/lisp/gnus/rfc1843.el
+++ b/lisp/gnus/rfc1843.el
@@ -1,5 +1,5 @@
;;; rfc1843.el --- HZ (rfc1843) decoding
-;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (c) 1998, 1999, 2000, 2003 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ HZ+ mail i18n
@@ -43,18 +43,18 @@
(defvar rfc1843-hzp-word-regexp
"~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\
-[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
+\[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
(defvar rfc1843-hzp-word-regexp-strictly
"~\\({\\([\041-\167][\041-\176]\\)+\\|\
-[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
+\[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
(defcustom rfc1843-decode-loosely nil
"Loosely check HZ encoding if non-nil.
When it is set non-nil, only buffers or strings with strictly
HZ-encoded are decoded."
:type 'boolean
- :group 'gnus)
+ :group 'mime)
(defcustom rfc1843-decode-hzp t
"HZ+ decoding support if non-nil.
@@ -64,12 +64,12 @@ e-mail transmission, news posting, etc.
The document of HZ+ 0.78 specification can be found at
ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
:type 'boolean
- :group 'gnus)
+ :group 'mime)
(defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
"Regexp of newsgroups in which might be HZ encoded."
:type 'string
- :group 'gnus)
+ :group 'mime)
(defun rfc1843-decode-region (from to)
"Decode HZ in the region between FROM and TO."
diff --git a/lisp/gnus/rfc2045.el b/lisp/gnus/rfc2045.el
index 3c57837265d..cd7cc4be95d 100644
--- a/lisp/gnus/rfc2045.el
+++ b/lisp/gnus/rfc2045.el
@@ -1,4 +1,4 @@
-;;; rfc2045.el --- functions for decoding rfc2045 headers
+;;; rfc2045.el --- Functions for decoding rfc2045 headers
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index f355ac8bbb4..978bec3c361 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -1,5 +1,5 @@
;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998,1999,2000,02,03,2004 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -29,7 +29,24 @@
(eval-when-compile
(require 'cl)
- (defvar message-posting-charset))
+ (defvar message-posting-charset)
+ (unless (fboundp 'with-syntax-table) ; not in Emacs 20
+ (defmacro with-syntax-table (table &rest body)
+ "Evaluate BODY with syntax table of current buffer set to TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (let ((old-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table ,table)
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table))))))))
(require 'qp)
(require 'mm-util)
@@ -38,11 +55,24 @@
(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")
+(eval-and-compile
+ ;; Avoid gnus-util for mm- code.
+ (defalias 'rfc2047-point-at-bol
+ (if (fboundp 'point-at-bol)
+ 'point-at-bol
+ 'line-beginning-position))
+
+ (defalias 'rfc2047-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position)))
+
(defvar rfc2047-header-encoding-alist
- '(("Newsgroups\\|Followup-To" . nil)
+ '(("Newsgroups" . nil)
+ ("Followup-To" . nil)
("Message-ID" . nil)
- ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
- address-mime)
+ ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\
+\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
(t . mime))
"*Header/encoding method alist.
The list is traversed sequentially. The keys can either be
@@ -80,7 +110,8 @@ The values can be:
(cn-gb-2312 . B)
(euc-kr . B)
(iso-2022-jp-2 . B)
- (iso-2022-int-1 . B))
+ (iso-2022-int-1 . B)
+ (viscii . Q))
"Alist of MIME charsets to RFC2047 encodings.
Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding,
quoted-printable and base64 respectively.")
@@ -91,15 +122,6 @@ quoted-printable and base64 respectively.")
(nil . ignore))
"Alist of RFC2047 encodings to encoding functions.")
-(defvar rfc2047-q-encoding-alist
- '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):"
- . "-A-Za-z0-9!*+/" )
- ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
- ;; Avoid using 8bit characters.
- ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
- ("." . "\010\012\014\040-\074\076\100-\136\140-\177"))
- "Alist of header regexps and valid Q characters.")
-
;;;
;;; Functions for encoding RFC2047 messages
;;;
@@ -112,12 +134,18 @@ quoted-printable and base64 respectively.")
(progn
(forward-line 1)
(if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
+ (rfc2047-point-at-bol)
(point-max))))
(goto-char (point-min)))
+(defun rfc2047-field-value ()
+ "Return the value of the field at point."
+ (save-excursion
+ (save-restriction
+ (rfc2047-narrow-to-field)
+ (re-search-forward ":[ \t\n]*" nil t)
+ (buffer-substring (point) (point-max)))))
+
(defvar rfc2047-encoding-type 'address-mime
"The type of encoding done by `rfc2047-encode-region'.
This should be dynamically bound around calls to
@@ -169,7 +197,7 @@ Should be called narrowed to the head of the message."
((eq method 'address-mime)
(rfc2047-encode-region (point) (point-max)))
((eq method 'mime)
- (let ((rfc2047-encoding-type method))
+ (let ((rfc2047-encoding-type 'mime))
(rfc2047-encode-region (point) (point-max))))
((eq method 'default)
(if (and (featurep 'mule)
@@ -178,6 +206,26 @@ Should be called narrowed to the head of the message."
mail-parse-charset)
(mm-encode-coding-region (point) (point-max)
mail-parse-charset)))
+ ;; We get this when CC'ing messsages to newsgroups with
+ ;; 8-bit names. The group name mail copy just got
+ ;; unconditionally encoded. Previously, it would ask
+ ;; whether to encode, which was quite confusing for the
+ ;; user. If the new behaviour is wrong, tell me. I have
+ ;; left the old code commented out below.
+ ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
+ ;; Modified by Dave Love, with the commented-out code changed
+ ;; in accordance with changes elsewhere.
+ ((null method)
+ (rfc2047-encode-region (point) (point-max)))
+;;; ((null method)
+;;; (if (or (message-options-get
+;;; 'rfc2047-encode-message-header-encode-any)
+;;; (message-options-set
+;;; 'rfc2047-encode-message-header-encode-any
+;;; (y-or-n-p
+;;; "Some texts are not encoded. Encode anyway?")))
+;;; (rfc2047-encode-region (point-min) (point-max))
+;;; (error "Cannot send unencoded text")))
((mm-coding-system-p method)
(if (and (featurep 'mule)
(if (boundp 'default-enable-multibyte-characters)
@@ -197,7 +245,8 @@ The buffer may be narrowed."
(require 'message) ; for message-posting-charset
(let ((charsets
(mm-find-mime-charset-region (point-min) (point-max))))
- (and charsets (not (equal charsets (list message-posting-charset))))))
+ (and charsets
+ (not (equal charsets (list (car message-posting-charset)))))))
;; Use this syntax table when parsing into regions that may need
;; encoding. Double quotes are string delimiters, backslash is
@@ -206,7 +255,19 @@ The buffer may be narrowed."
;; skip to the end of regions appropriately. Nb. ietf-drums does
;; things differently.
(defconst rfc2047-syntax-table
- (let ((table (make-char-table 'syntax-table '(2))))
+ ;; (make-char-table 'syntax-table '(2)) only works in Emacs.
+ (let ((table (make-syntax-table)))
+ ;; The following is done to work for setting all elements of the table
+ ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
+ ;; Play safe and don't assume the form of the word syntax entry --
+ ;; copy it from ?a.
+ (if (fboundp 'set-char-table-range) ; Emacs
+ (funcall (intern "set-char-table-range")
+ table t (aref (standard-syntax-table) ?a))
+ (if (fboundp 'put-char-table)
+ (if (fboundp 'get-char-table) ; warning avoidance
+ (put-char-table t (get-char-table ?a (standard-syntax-table))
+ table))))
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?\" "\"" table)
(modify-syntax-entry ?\( "." table)
@@ -228,22 +289,32 @@ Dynamically bind `rfc2047-encoding-type' to change that."
(save-restriction
(narrow-to-region b e)
(if (eq 'mime rfc2047-encoding-type)
- ;; Simple case -- treat as single word.
+ ;; Simple case. Treat as single word after any initial ASCII
+ ;; part and before any tailing ASCII part. The leading ASCII
+ ;; is relevant for instance in Subject headers with `Re:' for
+ ;; interoperability with non-MIME clients, and we might as
+ ;; well avoid the tail too.
(progn
(goto-char (point-min))
;; Does it need encoding?
- (skip-chars-forward "\000-\177" e)
+ (skip-chars-forward "\000-\177")
(unless (eobp)
- (rfc2047-encode b e)))
+ (skip-chars-backward "^ \n") ; beginning of space-delimited word
+ (rfc2047-encode (point) (progn
+ (goto-char e)
+ (skip-chars-backward "\000-\177")
+ (skip-chars-forward "^ \n")
+ ;; end of space-delimited word
+ (point)))))
;; `address-mime' case -- take care of quoted words, comments.
(with-syntax-table rfc2047-syntax-table
- (let ((start (point)) ; start of current token
+ (let ((start) ; start of current token
end ; end of current token
;; Whether there's an encoded word before the current
;; token, either immediately or separated by space.
last-encoded)
(goto-char (point-min))
- (condition-case nil ; in case of unbalanced quotes
+ (condition-case nil ; in case of unbalanced quotes
;; Look for rfc2822-style: sequences of atoms, quoted
;; strings, specials, whitespace. (Specials mustn't be
;; encoded.)
@@ -306,14 +377,15 @@ Dynamically bind `rfc2047-encoding-type' to change that."
end (1+ end)))
(rfc2047-encode start end)
(setq last-encoded t)))))
- (error (error "Invalid data for rfc2047 encoding: %s"
- (buffer-substring b e)))))))
+ (error
+ (error "Invalid data for rfc2047 encoding: %s"
+ (buffer-substring b e)))))))
(rfc2047-fold-region b (point))))
(defun rfc2047-encode-string (string)
"Encode words in STRING.
By default, the string is treated as containing addresses (see
-`rfc2047-special-chars')."
+`rfc2047-encoding-type')."
(with-temp-buffer
(insert string)
(rfc2047-encode-region (point-min) (point-max))
@@ -322,7 +394,7 @@ By default, the string is treated as containing addresses (see
(defun rfc2047-encode (b e)
"Encode the word(s) in the region B to E.
By default, the region is treated as containing addresses (see
-`rfc2047-special-chars')."
+`rfc2047-encoding-type')."
(let* ((mime-charset (mm-find-mime-charset-region b e))
(cs (if (> (length mime-charset) 1)
;; Fixme: Instead of this, try to break region into
@@ -333,14 +405,36 @@ By default, the region is treated as containing addresses (see
(mm-charset-to-coding-system mime-charset)))
;; Fixme: Better, calculate the number of non-ASCII
;; characters, at least for 8-bit charsets.
- (encoding (if (assq mime-charset
- rfc2047-charset-encoding-alist)
- (cdr (assq mime-charset
+ (encoding (or (cdr (assq mime-charset
rfc2047-charset-encoding-alist))
- 'B))
+ ;; For the charsets that don't have a preferred
+ ;; encoding, choose the one that's shorter.
+ (save-restriction
+ (narrow-to-region b e)
+ (if (eq (mm-qp-or-base64) 'base64)
+ 'B
+ 'Q))))
(start (concat
"=?" (downcase (symbol-name mime-charset)) "?"
(downcase (symbol-name encoding)) "?"))
+ (factor (case mime-charset
+ ((iso-8859-5 iso-8859-7 iso-8859-8 koi8-r) 1)
+ ((big5 gb2312 euc-kr) 2)
+ (utf-8 4)
+ (t 8)))
+ (pre (- b (save-restriction
+ (widen)
+ (rfc2047-point-at-bol))))
+ ;; encoded-words must not be longer than 75 characters,
+ ;; including charset, encoding etc. This leaves us with
+ ;; 75 - (length start) - 2 - 2 characters. The last 2 is for
+ ;; possible base64 padding. In the worst case (iso-2022-*)
+ ;; each character expands to 8 bytes which is expanded by a
+ ;; factor of 4/3 by base64 encoding.
+ (length (floor (- 75 (length start) 4) (* factor (/ 4.0 3.0))))
+ ;; Limit line length to 76 characters.
+ (length1 (max 1 (floor (- 76 (length start) 4 pre)
+ (* factor (/ 4.0 3.0)))))
(first t))
(if mime-charset
(save-restriction
@@ -349,9 +443,14 @@ By default, the region is treated as containing addresses (see
;; break into lines before encoding
(goto-char (point-min))
(while (not (eobp))
- (goto-char (min (point-max) (+ 15 (point))))
+ (if first
+ (progn
+ (goto-char (min (point-max) (+ length1 (point))))
+ (setq first nil))
+ (goto-char (min (point-max) (+ length (point)))))
(unless (eobp)
- (insert ?\n))))
+ (insert ?\n)))
+ (setq first t))
(if (and (mm-multibyte-p)
(mm-coding-system-p cs))
(mm-encode-coding-region (point-min) (point-max) cs))
@@ -367,6 +466,13 @@ By default, the region is treated as containing addresses (see
(insert "?=")
(forward-line 1))))))
+(defun rfc2047-fold-field ()
+ "Fold the current header field."
+ (save-excursion
+ (save-restriction
+ (rfc2047-narrow-to-field)
+ (rfc2047-fold-region (point-min) (point-max)))))
+
(defun rfc2047-fold-region (b e)
"Fold long lines in region B to E."
(save-restriction
@@ -377,9 +483,10 @@ By default, the region is treated as containing addresses (see
(first t)
(bol (save-restriction
(widen)
- (mm-point-at-bol))))
+ (rfc2047-point-at-bol))))
(while (not (eobp))
- (when (and (or break qword-break) (> (- (point) bol) 76))
+ (when (and (or break qword-break)
+ (> (- (point) bol) 76))
(goto-char (or break qword-break))
(setq break nil
qword-break nil)
@@ -389,7 +496,8 @@ By default, the region is treated as containing addresses (see
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(skip-chars-forward " \t")
- (unless (eobp) (forward-char 1)))
+ (unless (eobp)
+ (forward-char 1)))
(cond
((eq (char-after) ?\n)
(forward-char 1)
@@ -412,11 +520,14 @@ By default, the region is treated as containing addresses (see
(if (eq (char-after) ?=)
(forward-char 1)
(skip-chars-forward "^ \t\n\r="))
- (setq qword-break (point))
+ ;; Don't break at the start of the field.
+ (unless (= (point) b)
+ (setq qword-break (point)))
(skip-chars-forward "^ \t\n\r")))
(t
(skip-chars-forward "^ \t\n\r"))))
- (when (and (or break qword-break) (> (- (point) bol) 76))
+ (when (and (or break qword-break)
+ (> (- (point) bol) 76))
(goto-char (or break qword-break))
(setq break nil
qword-break nil)
@@ -426,7 +537,15 @@ By default, the region is treated as containing addresses (see
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(skip-chars-forward " \t")
- (unless (eobp) (forward-char 1))))))
+ (unless (eobp)
+ (forward-char 1))))))
+
+(defun rfc2047-unfold-field ()
+ "Fold the current line."
+ (save-excursion
+ (save-restriction
+ (rfc2047-narrow-to-field)
+ (rfc2047-unfold-region (point-min) (point-max)))))
(defun rfc2047-unfold-region (b e)
"Unfold lines in region B to E."
@@ -435,19 +554,18 @@ By default, the region is treated as containing addresses (see
(goto-char (point-min))
(let ((bol (save-restriction
(widen)
- (mm-point-at-bol)))
- (eol (mm-point-at-eol))
- leading)
+ (rfc2047-point-at-bol)))
+ (eol (rfc2047-point-at-eol)))
(forward-line 1)
(while (not (eobp))
(if (and (looking-at "[ \t]")
- (< (- (mm-point-at-eol) bol) 76))
+ (< (- (rfc2047-point-at-eol) bol) 76))
(delete-region eol (progn
(goto-char eol)
(skip-chars-forward "\r\n")
(point)))
- (setq bol (mm-point-at-bol)))
- (setq eol (mm-point-at-eol))
+ (setq bol (rfc2047-point-at-bol)))
+ (setq eol (rfc2047-point-at-eol))
(forward-line 1)))))
(defun rfc2047-b-encode-region (b e)
@@ -465,16 +583,21 @@ By default, the region is treated as containing addresses (see
(save-excursion
(save-restriction
(narrow-to-region (goto-char b) e)
- (let ((alist rfc2047-q-encoding-alist)
- (bol (save-restriction
+ (let ((bol (save-restriction
(widen)
- (mm-point-at-bol))))
- (while alist
- (when (looking-at (caar alist))
- (quoted-printable-encode-region b e nil (cdar alist))
- (subst-char-in-region (point-min) (point-max) ? ?_)
- (setq alist nil))
- (pop alist))
+ (rfc2047-point-at-bol))))
+ (quoted-printable-encode-region
+ b e nil
+ ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
+ ;; Avoid using 8bit characters.
+ ;; This list excludes `especials' (see the RFC2047 syntax),
+ ;; meaning that some characters in non-structured fields will
+ ;; get encoded when they con't need to be. The following is
+ ;; what it used to be.
+;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
+;;; "\010\012\014\040-\074\076\100-\136\140-\177")
+ "-\b\n\f !#-'*+0-9A-Z\\^`-~\d")
+ (subst-char-in-region (point-min) (point-max) ? ?_)
;; The size of QP encapsulation is about 20, so set limit to
;; 56=76-20.
(unless (< (- (point-max) (point-min)) 56)
@@ -485,15 +608,27 @@ By default, the region is treated as containing addresses (see
(goto-char (min (point-max) (+ 56 bol)))
(search-backward "=" (- (point) 2) t)
(unless (or (bobp) (eobp))
- (insert "\n")
+ (insert ?\n)
(setq bol (point)))))))))
;;;
;;; Functions for decoding RFC2047 messages
;;;
-(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
+(eval-and-compile
+ (defconst rfc2047-encoded-word-regexp
+ "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\
+\\?\\([!->@-~ +]*\\)\\?="))
+
+;; Fixme: This should decode in place, not cons intermediate strings.
+;; Also check whether it needs to worry about delimiting fields like
+;; encoding.
+
+;; In fact it's reported that (invalid) encoding of mailboxes in
+;; addr-specs is in use, so delimiting fields might help. Probably
+;; not decoding a word which isn't properly delimited is good enough
+;; and worthwhile (is it more correct or not?), e.g. something like
+;; `=?iso-8859-1?q?foo?=@'.
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
@@ -506,9 +641,10 @@ By default, the region is treated as containing addresses (see
(goto-char (point-min))
;; Remove whitespace between encoded words.
(while (re-search-forward
- (concat "\\(" rfc2047-encoded-word-regexp "\\)"
- "\\(\n?[ \t]\\)+"
- "\\(" rfc2047-encoded-word-regexp "\\)")
+ (eval-when-compile
+ (concat "\\(" rfc2047-encoded-word-regexp "\\)"
+ "\\(\n?[ \t]\\)+"
+ "\\(" rfc2047-encoded-word-regexp "\\)"))
nil t)
(delete-region (goto-char (match-end 1)) (match-beginning 6)))
;; Decode the encoded words.
@@ -519,8 +655,17 @@ By default, the region is treated as containing addresses (see
(prog1
(match-string 0)
(delete-region (match-beginning 0) (match-end 0)))))
+ ;; Remove newlines between decoded words, though such things
+ ;; essentially must not be there.
+ (save-restriction
+ (narrow-to-region e (point))
+ (goto-char e)
+ (while (re-search-forward "[\n\r]+" nil t)
+ (replace-match " "))
+ (goto-char (point-max)))
(when (and (mm-multibyte-p)
mail-parse-charset
+ (not (eq mail-parse-charset 'us-ascii))
(not (eq mail-parse-charset 'gnus-decoded)))
(mm-decode-coding-region b e mail-parse-charset))
(setq b (point)))
@@ -528,23 +673,37 @@ By default, the region is treated as containing addresses (see
mail-parse-charset
(not (eq mail-parse-charset 'us-ascii))
(not (eq mail-parse-charset 'gnus-decoded)))
- (mm-decode-coding-region b (point-max) mail-parse-charset))
- (rfc2047-unfold-region (point-min) (point-max))))))
+ (mm-decode-coding-region b (point-max) mail-parse-charset))))))
(defun rfc2047-decode-string (string)
"Decode the quoted-printable-encoded STRING and return the results."
(let ((m (mm-multibyte-p)))
- (with-temp-buffer
- (when m
- (mm-enable-multibyte))
- (insert string)
- (inline
- (rfc2047-decode-region (point-min) (point-max)))
- (buffer-string))))
+ (if (string-match "=\\?" string)
+ (with-temp-buffer
+ ;; Fixme: This logic is wrong, but seems to be required by
+ ;; Gnus summary buffer generation. The value of `m' depends
+ ;; on the current buffer, not global multibyteness or that
+ ;; of the string. Also the string returned should always be
+ ;; multibyte in a multibyte session, i.e. the buffer should
+ ;; be multibyte before `buffer-string' is called.
+ (when m
+ (mm-enable-multibyte))
+ (insert string)
+ (inline
+ (rfc2047-decode-region (point-min) (point-max)))
+ (buffer-string))
+ ;; Fixme: As above, `m' here is inappropriate.
+ (if (and m
+ mail-parse-charset
+ (not (eq mail-parse-charset 'us-ascii))
+ (not (eq mail-parse-charset 'gnus-decoded)))
+ (mm-decode-coding-string string mail-parse-charset)
+ (mm-string-as-multibyte string)))))
(defun rfc2047-parse-and-decode (word)
"Decode WORD and return it if it is an encoded word.
-Return WORD if not."
+Return WORD if it is not not an encoded word or if the charset isn't
+decodable."
(if (not (string-match rfc2047-encoded-word-regexp word))
word
(or
@@ -554,7 +713,18 @@ Return WORD if not."
(upcase (match-string 2 word))
(match-string 3 word))
(error word))
- word)))
+ word))) ; un-decodable
+
+(defun rfc2047-pad-base64 (string)
+ "Pad STRING to quartets."
+ ;; Be more liberal to accept buggy base64 strings. If
+ ;; base64-decode-string accepts buggy strings, this function could
+ ;; be aliased to identity.
+ (case (mod (length string) 4)
+ (0 string)
+ (1 string) ;; Error, don't pad it.
+ (2 (concat string "=="))
+ (3 (concat string "="))))
(defun rfc2047-decode (charset encoding string)
"Decode STRING from the given MIME CHARSET in the given ENCODING.
@@ -576,18 +746,16 @@ If your Emacs implementation can't decode CHARSET, return nil."
(when (and (eq cs 'ascii)
mail-parse-charset)
(setq cs mail-parse-charset))
- ;; Ensure unibyte result in Emacs 20.
- (let (default-enable-multibyte-characters)
- (with-temp-buffer
- (mm-decode-coding-string
- (cond
- ((equal "B" encoding)
- (base64-decode-string string))
- ((equal "Q" encoding)
- (quoted-printable-decode-string
- (mm-replace-chars-in-string string ?_ ? )))
- (t (error "Invalid encoding: %s" encoding)))
- cs))))))
+ (mm-decode-coding-string
+ (cond
+ ((equal "B" encoding)
+ (base64-decode-string
+ (rfc2047-pad-base64 string)))
+ ((equal "Q" encoding)
+ (quoted-printable-decode-string
+ (mm-replace-chars-in-string string ?_ ? )))
+ (t (error "Invalid encoding: %s" encoding)))
+ cs))))
(provide 'rfc2047)
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index 36c85841862..b08fe215196 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -1,6 +1,7 @@
-;;; rfc2231.el --- functions for decoding rfc2231 headers
+;;; rfc2231.el --- Functions for decoding rfc2231 headers
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -26,11 +27,20 @@
(eval-when-compile (require 'cl))
(require 'ietf-drums)
+(require 'rfc2047)
+(autoload 'mm-encode-body "mm-bodies")
+(autoload 'mail-header-remove-whitespace "mail-parse")
+(autoload 'mail-header-remove-comments "mail-parse")
(defun rfc2231-get-value (ct attribute)
"Return the value of ATTRIBUTE from CT."
(cdr (assq attribute (cdr ct))))
+(defun rfc2231-parse-qp-string (string)
+ "Parse QP-encoded string using `rfc2231-parse-string'.
+N.B. This is in violation with RFC2047, but it seem to be in common use."
+ (rfc2231-parse-string (rfc2047-decode-string string)))
+
(defun rfc2231-parse-string (string)
"Parse STRING and return a list.
The list will be on the form
@@ -47,6 +57,9 @@ The list will be on the form
(mail-header-remove-comments string)))
(let ((table (copy-syntax-table ietf-drums-syntax-table)))
(modify-syntax-entry ?\' "w" table)
+ (modify-syntax-entry ?* " " table)
+ (modify-syntax-entry ?\; " " table)
+ (modify-syntax-entry ?= " " table)
;; The following isn't valid, but one should be liberal
;; in what one receives.
(modify-syntax-entry ?\: "w" table)
@@ -79,7 +92,9 @@ The list will be on the form
(when (eq c ?*)
(forward-char 1)
(setq c (char-after))
- (when (memq c ntoken)
+ (if (not (memq c ntoken))
+ (setq encoded t
+ number nil)
(setq number
(string-to-number
(buffer-substring
@@ -104,10 +119,11 @@ The list will be on the form
(setq value
(buffer-substring (1+ (point))
(progn (forward-sexp 1) (1- (point))))))
- ((and (memq c ttoken)
+ ((and (or (memq c ttoken)
+ (> c ?\177)) ;; EXTENSION: Support non-ascii chars.
(not (memq c stoken)))
(setq value (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
+ (point) (progn (forward-sexp) (point)))))
(t
(error "Invalid header: %s" string)))
(when encoded
@@ -140,10 +156,11 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
(string-to-number (buffer-substring (point) (+ (point) 2)) 16)
(delete-region (1- (point)) (+ (point) 2)))))
;; Encode using the charset, if any.
- (when (and (< (length elems) 1)
- (not (equal (intern (car elems)) 'us-ascii)))
+ (when (and (mm-multibyte-p)
+ (> (length elems) 1)
+ (not (equal (intern (downcase (car elems))) 'us-ascii)))
(mm-decode-coding-region (point-min) (point-max)
- (intern (car elems))))
+ (intern (downcase (car elems)))))
(buffer-string))))
(defun rfc2231-encode-string (param value)
@@ -175,7 +192,7 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
(goto-char (point-min))
(while (not (eobp))
(when (> (current-column) 60)
- (insert "\n")
+ (insert ";\n")
(setq broken t))
(if (or (not (memq (following-char) ascii))
(memq (following-char) control)
@@ -187,12 +204,13 @@ These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"."
(delete-char 1))
(forward-char 1)))
(goto-char (point-min))
- (insert (or charset "ascii") "''")
+ (insert (symbol-name (or charset 'us-ascii)) "''")
(goto-char (point-min))
(if (not broken)
(insert param "*=")
(while (not (eobp))
- (insert param "*" (format "%d" (incf num)) "*=")
+ (insert (if (>= num 0) " " "\n ")
+ param "*" (format "%d" (incf num)) "*=")
(forward-line 1))))
(spacep
(goto-char (point-min))
diff --git a/lisp/gnus/rot13.xpm b/lisp/gnus/rot13.xpm
index ad20c8ad67d..6e2d7ac3ccf 100644
--- a/lisp/gnus/rot13.xpm
+++ b/lisp/gnus/rot13.xpm
@@ -1,50 +1,32 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 20 1",
-" c Gray0",
-". c Gray6",
-"X c Gray12",
-"o c #2ff52ff52ff5",
-"O c #3fff3fff3fff",
-"+ c Gray28",
-"@ c #53e353e353e3",
-"# c #5fe45fe45fe4",
-"$ c #67e767e767e7",
-"% c #6fff6fff6fff",
-"& c #77d777d777d7",
-"* c Gray50",
-"= c Gray56",
-"- c #9fff9fff9fff",
-"; c Gray70",
-": c Gray75",
-"> c Gray81",
-", c #dfffdfffdfff",
-"< c #efffefffefff",
-"1 c Gray100",
-/* pixels */
-"::::::::::::::::::::::::",
-"::::::::::::::::::::::::",
-"::::::::::::::::::::::::",
-"::::#oOOOOOOOOOo+;::::::",
-"::::#:,*,,**11-#O$::::::",
-"::::#:#:#:#:%--=*>@:::::",
-"::::#:o:o:*%>*:>OOo#::::",
-"::::#:X*X:O*-:**:1:#::::",
-"::::#:>1><::11>:,1:#::::",
-"::::#:>-111%111%11:#::::",
-"::::#:*:-1:*1:*-11:#::::",
-"::::#: *O>*:%*=--1:#::::",
-"::::#:O* :*1O*o%11:#::::",
-"::::#:O:X,**-*:111:#::::",
-"::::#:>1>1,:1,<111:#::::",
-"::::#:1,oo,1111111:#::::",
-"::::#:,O##O*****:1:#::::",
-"::::#:: :: *1:#::::",
-"::::#:1-..-1:*O:*1:#::::",
-"::::#:11--11,:O,:1:#::::",
-"::::#:11111111>111:#::::",
-"::::&oooooooooooooo&::::",
-"::::::::::::::::::::::::",
-"::::::::::::::::::::::::"
-};
+static char * rot13_xpm[] = {
+"24 24 5 1",
+" c None",
+". c #A5A5A5A59595",
+"X c #C7C7C6C6C6C6",
+"o c #E1E1E0E0E0E0",
+"O c #919187876969",
+" ",
+" ",
+" ",
+" . ",
+" ..X. ",
+" ..XXX. ",
+" ..XXXXXo. ",
+" ...XXXXXXooo. ",
+" .o.XXXXXoooo. ",
+" .oo.XXXooOooo. ",
+" .oo..XXoOXOOoo. ",
+" .oo.XXoOXooOXoo. ",
+" .o.XoooOOXXOXooX. ",
+" .XXooOOXOOXoooo. ",
+" .XooOOOooooooo. ",
+" .oOOXOXooooo. ",
+" .oOOXoooooo. ",
+" .oOOXooo.. ",
+" .oooooo. ",
+" .ooo.. ",
+" .oo. ",
+" .. ",
+" ",
+" "};
diff --git a/lisp/gnus/sad.pbm b/lisp/gnus/sad.pbm
new file mode 100644
index 00000000000..892e34352d7
--- /dev/null
+++ b/lisp/gnus/sad.pbm
Binary files differ
diff --git a/lisp/gnus/sad.xpm b/lisp/gnus/sad.xpm
new file mode 100644
index 00000000000..b0acef42a53
--- /dev/null
+++ b/lisp/gnus/sad.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * sad_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++..+++..++.",
+".++..+++..++.",
+".+++++++++++.",
+".+++++++++++.",
+".+++.....+++.",
+".++.+++++.++.",
+".++.+++++.++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/save-aif.xpm b/lisp/gnus/save-aif.xpm
index c8bceb6cbea..f0325ac2fb9 100644
--- a/lisp/gnus/save-aif.xpm
+++ b/lisp/gnus/save-aif.xpm
@@ -1,55 +1,33 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 25 1",
-" c Gray6",
-". c #133313331333",
-"X c #199919991999",
-"o c Gray15",
-"O c #2fef2fef2fef",
-"+ c Gray20",
-"@ c #398739873987",
-"# c #3fff3fff3fff",
-"$ c Gray28",
-"% c #4ccc4ccc4ccc",
-"& c #5fdf5fdf5fdf",
-"* c #626262626262",
-"= c Gray40",
-"- c #72f272f272f2",
-"; c Gray45",
-": c #77d777d777d7",
-"> c #7bdb7bdb7bdb",
-", c #7ccc7ccc7ccc",
-"< c Gray56",
-"1 c Gray60",
-"2 c #9fff9fff9fff",
-"3 c #a7c7a7c7a7c7",
-"4 c Gray75",
-"5 c Gray90",
-"6 c Gray100",
-/* pixels */
-"444444444444444444444444",
-"444444444444444444444444",
-"4444444:OOOOOOOOOOO:4444",
-"4444444&4666666666#2>444",
-"4444444&4666666666#62:44",
-"4444444&4666666666 ##O44",
-"4444444&4666666666666O44",
-"4444444&4666666666666O44",
-"4444444&4666666666666O44",
-"43<<<<<$<444444666666O44",
-"4&@@@-------.%.666666O44",
-"4&---5555555o1o666666O44",
-"4&---5555555o1o666666O44",
-"4&---5555555o1o666666O44",
-"4&---5555555o1o666666O44",
-"4&---5555555o1o666666O44",
-"4&--@-------o1o666666O44",
-"4&-<--------,1o666666O44",
-"4&-<--------,1o444444O44",
-"4&--X++++o@-o1o&&&&&&:44",
-"4&--+====%-5o1o444444444",
-"4:*-+====%-5o1o444444444",
-"44:@X++++o@-.%.444444444",
-"444<<<<<<<<<<<<444444444"
-};
+static char * save_aif_xpm[] = {
+"24 24 6 1",
+" c None",
+". c #999999999999",
+"X c #E1E1E0E0E0E0",
+"o c #C7C7C6C6C6C6",
+"O c #000000000000",
+"+ c #FFFFFFFFFFFF",
+" ",
+" ",
+" ............. ",
+" .XXXXXXXXXX.X.. ",
+" .XXXXXXXXXX.XX. ",
+" .XXXXXXXXXX.... ",
+" .XXXXXXXXXXooo. ",
+" .XXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXX. ",
+" OOOOOOOOOOOOOOXXXXXX. ",
+" O..O+++++++O.OXXXXXX. ",
+" O..O+++++++O.OXXXXXX. ",
+" O..O+++++++O.OXXXXXX. ",
+" O..O+++++++O.OXXXXXX. ",
+" O..O+++++++O.OXXXXXX. ",
+" O..OOOOOOOOO.OXXXXXX. ",
+" O............OXXXXXX. ",
+" O............OXXXXXX. ",
+" O..OOOOOOOOO.O....... ",
+" O..OoooooO++.O ",
+" O..OoooooO++.O ",
+" O.OoooooO++.O ",
+" OOOOOOOOOOOO "};
diff --git a/lisp/gnus/save-art.xpm b/lisp/gnus/save-art.xpm
index da4158ca1c6..fe9726fa3fe 100644
--- a/lisp/gnus/save-art.xpm
+++ b/lisp/gnus/save-art.xpm
@@ -1,62 +1,32 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 32 1",
-" c Gray0",
-". c #133313331333",
-"X c #199919991999",
-"o c Gray12",
-"O c #23f323f323f3",
-"+ c Gray15",
-"@ c #2fef2fef2fef",
-"# c Gray20",
-"$ c #398739873987",
-"% c #3fff3fff3fff",
-"& c #4ccc4ccc4ccc",
-"* c #53e353e353e3",
-"= c #5fe65fe65fe6",
-"- c #626262626262",
-"; c Gray40",
-": c #6fff6fff6fff",
-"> c #72f272f272f2",
-", c Gray45",
-"< c #77d777d777d7",
-"1 c #7ccc7ccc7ccc",
-"2 c Gray50",
-"3 c Gray56",
-"4 c Gray60",
-"5 c #9bcb9bcb9bcb",
-"6 c #9fff9fff9fff",
-"7 c #a7c7a7c7a7c7",
-"8 c Gray75",
-"9 c Gray81",
-"0 c #dfffdfffdfff",
-"q c Gray90",
-"w c #efffefffefff",
-"e c Gray100",
-/* pixels */
-"888888888888888888888888",
-"888888888888888888888888",
-"88888*@@@@@@@@@@@@@@@@@4",
-"88888@%28eeeeeeeeee08%o3",
-"88888@e8228eeeeeee222e23",
-"88888@eee82%eeee6%80ee23",
-"88888@eeew8=%28%28eeee23",
-"88888@eee220e82e826eee23",
-"88888@ee:9eeeeeeee6%9e23",
-"87333O3 3888888eeeee:==3",
-"8=$$$>>>>>>>.&.eeeeee0%3",
-"8=>>>qqqqqqq+4+%%%%%%%o3",
-"8=>>>qqqqqqq+4+888888888",
-"8=>>>qqqqqqq+4+888888888",
-"8=>>>qqqqqqq+4+888888888",
-"8=>>>qqqqqqq+4+888888888",
-"8=>>$>>>>>>>+4+888888888",
-"8=>3>>>>>>>>24+888888888",
-"8=>3>>>>>>>>24+888888888",
-"8=>>X####+$>+4+888888888",
-"8=>>#;;;;&>q+4+888888888",
-"8<->#;;;;&>q+4+888888888",
-"88<$X####+$>.&.888888888",
-"888333333333333888888888"
-};
+static char * save_art_xpm[] = {
+"24 24 5 1",
+" c None",
+". c #000000000000",
+"X c #FFFFFFFFFFFF",
+"o c #999999999999",
+"O c #C7C7C6C6C6C6",
+" ",
+" ",
+" .................. ",
+" ...XXXXXXXXXXXXX.. ",
+" .XX..XXXXXXXXX..X. ",
+" .XXXX..XXXXX..XXX. ",
+" .XXXXX......XXXXX. ",
+" .XXX..XX..XX..XXX. ",
+" .XX..XXXXXXXX..XX. ",
+" ...XXXXXXXXXXXX... ",
+" ..............XXXXXXX. ",
+" .oo.XXXXXXX.o......... ",
+" .oo.XXXXXXX.o. ",
+" .oo.XXXXXXX.o. ",
+" .oo.XXXXXXX.o. ",
+" .oo.XXXXXXX.o. ",
+" .oo.........o. ",
+" .oooooooooooo. ",
+" .oooooooooooo. ",
+" .oo.........o. ",
+" .oo.OOOOO.XXo. ",
+" .oo.OOOOO.XXo. ",
+" .o.OOOOO.XXo. ",
+" ............ "};
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index da6c447d115..a54b57f6fa4 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -1,5 +1,6 @@
;;; score-mode.el --- mode for editing Gnus score files
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 2001, 2004 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -26,7 +27,8 @@
;;; Code:
(eval-when-compile (require 'cl))
-(require 'mm-util) ; for mm-auto-save-coding-system
+(require 'mm-util) ; for mm-universal-coding-system
+(require 'gnus-util) ; for gnus-pp
(defvar gnus-score-mode-hook nil
"*Hook run in score mode buffers.")
@@ -52,7 +54,7 @@
"Syntax table used in score-mode buffers.")
;; We need this to cope with non-ASCII scoring.
-(defvar score-mode-coding-system mm-auto-save-coding-system)
+(defvar score-mode-coding-system mm-universal-coding-system)
;;;###autoload
(defun gnus-score-mode ()
@@ -93,7 +95,7 @@ This mode is an extended emacs-lisp mode.
(let ((form (read (current-buffer))))
(erase-buffer)
(let ((emacs-lisp-mode-syntax-table score-mode-syntax-table))
- (pp form (current-buffer))))
+ (gnus-pp form)))
(goto-char (point-min)))
(defun gnus-score-edit-exit ()
diff --git a/lisp/gnus/sha1.el b/lisp/gnus/sha1.el
new file mode 100644
index 00000000000..c71a135c551
--- /dev/null
+++ b/lisp/gnus/sha1.el
@@ -0,0 +1,441 @@
+;;; sha1.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp
+
+;; Copyright (C) 1999, 2001, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: SHA1, FIPS 180-1
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This program is implemented from the definition of SHA-1 in FIPS PUB
+;; 180-1 (Federal Information Processing Standards Publication 180-1),
+;; "Announcing the Standard for SECURE HASH STANDARD".
+;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm>
+;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c)
+;;
+;; Test cases from FIPS PUB 180-1.
+;;
+;; (sha1 "abc")
+;; => a9993e364706816aba3e25717850c26c9cd0d89d
+;;
+;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")
+;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1
+;;
+;; (sha1 (make-string 1000000 ?a))
+;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f
+;;
+;; BUGS:
+;; * It is assumed that length of input string is less than 2^29 bytes.
+;; * It is caller's responsibility to make string (or region) unibyte.
+;;
+;; TODO:
+;; * Rewrite from scratch!
+;; This version is much faster than Keiichi Suzuki's another sha1.el,
+;; but it is too dirty.
+
+;;; Code:
+
+(require 'hex-util)
+
+;;;
+;;; external SHA1 function.
+;;;
+
+(defgroup sha1 nil
+ "Elisp interface for SHA1 hash computation."
+ :group 'extensions)
+
+(defcustom sha1-maximum-internal-length 500
+ "*Maximum length of message to use Lisp version of SHA1 function.
+If message is longer than this, `sha1-program' is used instead.
+
+If this variable is set to 0, use external program only.
+If this variable is set to nil, use internal function only."
+ :type 'integer
+ :group 'sha1)
+
+(defcustom sha1-program '("sha1sum")
+ "*Name of program to compute SHA1.
+It must be a string \(program name\) or list of strings \(name and its args\)."
+ :type '(repeat string)
+ :group 'sha1)
+
+(defcustom sha1-use-external (condition-case ()
+ (executable-find (car sha1-program))
+ (error))
+ "*Use external SHA1 program.
+If this variable is set to nil, use internal function only."
+ :type 'boolean
+ :group 'sha1)
+
+(defun sha1-string-external (string &optional binary)
+ (let (prog args digest default-enable-multibyte-characters)
+ (if (consp sha1-program)
+ (setq prog (car sha1-program)
+ args (cdr sha1-program))
+ (setq prog sha1-program
+ args nil))
+ (with-temp-buffer
+ (insert string)
+ (apply (function call-process-region)
+ (point-min)(point-max)
+ prog t t nil args)
+ ;; SHA1 is 40 bytes long in hexadecimal form.
+ (setq digest (buffer-substring (point-min)(+ (point-min) 40))))
+ (if binary
+ (decode-hex-string digest)
+ digest)))
+
+(defun sha1-region-external (beg end &optional binary)
+ (sha1-string-external (buffer-substring-no-properties beg end) binary))
+
+;;;
+;;; internal SHA1 function.
+;;;
+
+(eval-when-compile
+ ;; optional second arg of string-to-number is new in v20.
+ (defconst sha1-K0-high 23170) ; (string-to-number "5A82" 16)
+ (defconst sha1-K0-low 31129) ; (string-to-number "7999" 16)
+ (defconst sha1-K1-high 28377) ; (string-to-number "6ED9" 16)
+ (defconst sha1-K1-low 60321) ; (string-to-number "EBA1" 16)
+ (defconst sha1-K2-high 36635) ; (string-to-number "8F1B" 16)
+ (defconst sha1-K2-low 48348) ; (string-to-number "BCDC" 16)
+ (defconst sha1-K3-high 51810) ; (string-to-number "CA62" 16)
+ (defconst sha1-K3-low 49622) ; (string-to-number "C1D6" 16)
+
+;;; original definition of sha1-F0.
+;;; (defmacro sha1-F0 (B C D)
+;;; (` (logior (logand (, B) (, C))
+;;; (logand (lognot (, B)) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
+ (defmacro sha1-F0 (B C D)
+ (` (logxor (, D) (logand (, B) (logxor (, C) (, D))))))
+ (defmacro sha1-F1 (B C D)
+ (` (logxor (, B) (, C) (, D))))
+;;; original definition of sha1-F2.
+;;; (defmacro sha1-F2 (B C D)
+;;; (` (logior (logand (, B) (, C))
+;;; (logand (, B) (, D))
+;;; (logand (, C) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
+ (defmacro sha1-F2 (B C D)
+ (` (logior (logand (, B) (, C))
+ (logand (, D) (logior (, B) (, C))))))
+ (defmacro sha1-F3 (B C D)
+ (` (logxor (, B) (, C) (, D))))
+
+ (defmacro sha1-S1 (W-high W-low)
+ (` (let ((W-high (, W-high))
+ (W-low (, W-low)))
+ (setq S1W-high (+ (% (* W-high 2) 65536)
+ (/ W-low (, (/ 65536 2)))))
+ (setq S1W-low (+ (/ W-high (, (/ 65536 2)))
+ (% (* W-low 2) 65536))))))
+ (defmacro sha1-S5 (A-high A-low)
+ (` (progn
+ (setq S5A-high (+ (% (* (, A-high) 32) 65536)
+ (/ (, A-low) (, (/ 65536 32)))))
+ (setq S5A-low (+ (/ (, A-high) (, (/ 65536 32)))
+ (% (* (, A-low) 32) 65536))))))
+ (defmacro sha1-S30 (B-high B-low)
+ (` (progn
+ (setq S30B-high (+ (/ (, B-high) 4)
+ (* (% (, B-low) 4) (, (/ 65536 4)))))
+ (setq S30B-low (+ (/ (, B-low) 4)
+ (* (% (, B-high) 4) (, (/ 65536 4))))))))
+
+ (defmacro sha1-OP (round)
+ (` (progn
+ (sha1-S5 sha1-A-high sha1-A-low)
+ (sha1-S30 sha1-B-high sha1-B-low)
+ (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round)))
+ sha1-B-low sha1-C-low sha1-D-low)
+ sha1-E-low
+ (, (symbol-value
+ (intern (format "sha1-K%d-low" round))))
+ (aref block-low idx)
+ (progn
+ (setq sha1-E-low sha1-D-low)
+ (setq sha1-D-low sha1-C-low)
+ (setq sha1-C-low S30B-low)
+ (setq sha1-B-low sha1-A-low)
+ S5A-low)))
+ (setq carry (/ sha1-A-low 65536))
+ (setq sha1-A-low (% sha1-A-low 65536))
+ (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round)))
+ sha1-B-high sha1-C-high sha1-D-high)
+ sha1-E-high
+ (, (symbol-value
+ (intern (format "sha1-K%d-high" round))))
+ (aref block-high idx)
+ (progn
+ (setq sha1-E-high sha1-D-high)
+ (setq sha1-D-high sha1-C-high)
+ (setq sha1-C-high S30B-high)
+ (setq sha1-B-high sha1-A-high)
+ S5A-high)
+ carry)
+ 65536)))))
+
+ (defmacro sha1-add-to-H (H X)
+ (` (progn
+ (setq (, (intern (format "sha1-%s-low" H)))
+ (+ (, (intern (format "sha1-%s-low" H)))
+ (, (intern (format "sha1-%s-low" X)))))
+ (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536))
+ (setq (, (intern (format "sha1-%s-low" H)))
+ (% (, (intern (format "sha1-%s-low" H))) 65536))
+ (setq (, (intern (format "sha1-%s-high" H)))
+ (% (+ (, (intern (format "sha1-%s-high" H)))
+ (, (intern (format "sha1-%s-high" X)))
+ carry)
+ 65536)))))
+ )
+
+;;; buffers (H0 H1 H2 H3 H4).
+(defvar sha1-H0-high)
+(defvar sha1-H0-low)
+(defvar sha1-H1-high)
+(defvar sha1-H1-low)
+(defvar sha1-H2-high)
+(defvar sha1-H2-low)
+(defvar sha1-H3-high)
+(defvar sha1-H3-low)
+(defvar sha1-H4-high)
+(defvar sha1-H4-low)
+
+(defun sha1-block (block-high block-low)
+ (let (;; step (c) --- initialize buffers (A B C D E).
+ (sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low)
+ (sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low)
+ (sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low)
+ (sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low)
+ (sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low)
+ (idx 16))
+ ;; step (b).
+ (let (;; temporary variables used in sha1-S1 macro.
+ S1W-high S1W-low)
+ (while (< idx 80)
+ (sha1-S1 (logxor (aref block-high (- idx 3))
+ (aref block-high (- idx 8))
+ (aref block-high (- idx 14))
+ (aref block-high (- idx 16)))
+ (logxor (aref block-low (- idx 3))
+ (aref block-low (- idx 8))
+ (aref block-low (- idx 14))
+ (aref block-low (- idx 16))))
+ (aset block-high idx S1W-high)
+ (aset block-low idx S1W-low)
+ (setq idx (1+ idx))))
+ ;; step (d).
+ (setq idx 0)
+ (let (;; temporary variables used in sha1-OP macro.
+ S5A-high S5A-low S30B-high S30B-low carry)
+ (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx)))
+ (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx)))
+ (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx)))
+ (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx))))
+ ;; step (e).
+ (let (;; temporary variables used in sha1-add-to-H macro.
+ carry)
+ (sha1-add-to-H H0 A)
+ (sha1-add-to-H H1 B)
+ (sha1-add-to-H H2 C)
+ (sha1-add-to-H H3 D)
+ (sha1-add-to-H H4 E))))
+
+(defun sha1-binary (string)
+ "Return the SHA1 of STRING in binary form."
+ (let (;; prepare buffers for a block. byte-length of block is 64.
+ ;; input block is split into two vectors.
+ ;;
+ ;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ...
+ ;; block-high: +-0-+ +-1-+ +-2-+ +-3-+
+ ;; block-low: +-0-+ +-1-+ +-2-+ +-3-+
+ ;;
+ ;; length of each vector is 80, and elements of each vector are
+ ;; 16bit integers. elements 0x10-0x4F of each vector are
+ ;; assigned later in `sha1-block'.
+ (block-high (eval-when-compile (make-vector 80 nil)))
+ (block-low (eval-when-compile (make-vector 80 nil))))
+ (unwind-protect
+ (let* (;; byte-length of input string.
+ (len (length string))
+ (lim (* (/ len 64) 64))
+ (rem (% len 4))
+ (idx 0)(pos 0))
+ ;; initialize buffers (H0 H1 H2 H3 H4).
+ (setq sha1-H0-high 26437 ; (string-to-number "6745" 16)
+ sha1-H0-low 8961 ; (string-to-number "2301" 16)
+ sha1-H1-high 61389 ; (string-to-number "EFCD" 16)
+ sha1-H1-low 43913 ; (string-to-number "AB89" 16)
+ sha1-H2-high 39098 ; (string-to-number "98BA" 16)
+ sha1-H2-low 56574 ; (string-to-number "DCFE" 16)
+ sha1-H3-high 4146 ; (string-to-number "1032" 16)
+ sha1-H3-low 21622 ; (string-to-number "5476" 16)
+ sha1-H4-high 50130 ; (string-to-number "C3D2" 16)
+ sha1-H4-low 57840) ; (string-to-number "E1F0" 16)
+ ;; loop for each 64 bytes block.
+ (while (< pos lim)
+ ;; step (a).
+ (setq idx 0)
+ (while (< idx 16)
+ (aset block-high idx (+ (* (aref string pos) 256)
+ (aref string (1+ pos))))
+ (setq pos (+ pos 2))
+ (aset block-low idx (+ (* (aref string pos) 256)
+ (aref string (1+ pos))))
+ (setq pos (+ pos 2))
+ (setq idx (1+ idx)))
+ (sha1-block block-high block-low))
+ ;; last block.
+ (if (prog1
+ (< (- len lim) 56)
+ (setq lim (- len rem))
+ (setq idx 0)
+ (while (< pos lim)
+ (aset block-high idx (+ (* (aref string pos) 256)
+ (aref string (1+ pos))))
+ (setq pos (+ pos 2))
+ (aset block-low idx (+ (* (aref string pos) 256)
+ (aref string (1+ pos))))
+ (setq pos (+ pos 2))
+ (setq idx (1+ idx)))
+ ;; this is the last (at most) 32bit word.
+ (cond
+ ((= rem 3)
+ (aset block-high idx (+ (* (aref string pos) 256)
+ (aref string (1+ pos))))
+ (setq pos (+ pos 2))
+ (aset block-low idx (+ (* (aref string pos) 256)
+ 128)))
+ ((= rem 2)
+ (aset block-high idx (+ (* (aref string pos) 256)
+ (aref string (1+ pos))))
+ (aset block-low idx 32768))
+ ((= rem 1)
+ (aset block-high idx (+ (* (aref string pos) 256)
+ 128))
+ (aset block-low idx 0))
+ (t ;; (= rem 0)
+ (aset block-high idx 32768)
+ (aset block-low idx 0)))
+ (setq idx (1+ idx))
+ (while (< idx 16)
+ (aset block-high idx 0)
+ (aset block-low idx 0)
+ (setq idx (1+ idx))))
+ ;; last block has enough room to write the length of string.
+ (progn
+ ;; write bit length of string to last 4 bytes of the block.
+ (aset block-low 15 (* (% len 8192) 8))
+ (setq len (/ len 8192))
+ (aset block-high 15 (% len 65536))
+ ;; XXX: It is not practical to compute SHA1 of
+ ;; such a huge message on emacs.
+ ;; (setq len (/ len 65536)) ; for 64bit emacs.
+ ;; (aset block-low 14 (% len 65536))
+ ;; (aset block-high 14 (/ len 65536))
+ (sha1-block block-high block-low))
+ ;; need one more block.
+ (sha1-block block-high block-low)
+ (fillarray block-high 0)
+ (fillarray block-low 0)
+ ;; write bit length of string to last 4 bytes of the block.
+ (aset block-low 15 (* (% len 8192) 8))
+ (setq len (/ len 8192))
+ (aset block-high 15 (% len 65536))
+ ;; XXX: It is not practical to compute SHA1 of
+ ;; such a huge message on emacs.
+ ;; (setq len (/ len 65536)) ; for 64bit emacs.
+ ;; (aset block-low 14 (% len 65536))
+ ;; (aset block-high 14 (/ len 65536))
+ (sha1-block block-high block-low))
+ ;; make output string (in binary form).
+ (let ((result (make-string 20 0)))
+ (aset result 0 (/ sha1-H0-high 256))
+ (aset result 1 (% sha1-H0-high 256))
+ (aset result 2 (/ sha1-H0-low 256))
+ (aset result 3 (% sha1-H0-low 256))
+ (aset result 4 (/ sha1-H1-high 256))
+ (aset result 5 (% sha1-H1-high 256))
+ (aset result 6 (/ sha1-H1-low 256))
+ (aset result 7 (% sha1-H1-low 256))
+ (aset result 8 (/ sha1-H2-high 256))
+ (aset result 9 (% sha1-H2-high 256))
+ (aset result 10 (/ sha1-H2-low 256))
+ (aset result 11 (% sha1-H2-low 256))
+ (aset result 12 (/ sha1-H3-high 256))
+ (aset result 13 (% sha1-H3-high 256))
+ (aset result 14 (/ sha1-H3-low 256))
+ (aset result 15 (% sha1-H3-low 256))
+ (aset result 16 (/ sha1-H4-high 256))
+ (aset result 17 (% sha1-H4-high 256))
+ (aset result 18 (/ sha1-H4-low 256))
+ (aset result 19 (% sha1-H4-low 256))
+ result))
+ ;; do not leave a copy of input string.
+ (fillarray block-high nil)
+ (fillarray block-low nil))))
+
+(defun sha1-string-internal (string &optional binary)
+ (if binary
+ (sha1-binary string)
+ (encode-hex-string (sha1-binary string))))
+
+(defun sha1-region-internal (beg end &optional binary)
+ (sha1-string-internal (buffer-substring-no-properties beg end) binary))
+
+;;;
+;;; application interface.
+;;;
+
+(defun sha1-region (beg end &optional binary)
+ (if (and sha1-use-external
+ sha1-maximum-internal-length
+ (> (abs (- end beg)) sha1-maximum-internal-length))
+ (sha1-region-external beg end binary)
+ (sha1-region-internal beg end binary)))
+
+(defun sha1-string (string &optional binary)
+ (if (and sha1-use-external
+ sha1-maximum-internal-length
+ (> (length string) sha1-maximum-internal-length))
+ (sha1-string-external string binary)
+ (sha1-string-internal string binary)))
+
+;;;###autoload
+(defun sha1 (object &optional beg end binary)
+ "Return the SHA1 (Secure Hash Algorithm) of an object.
+OBJECT is either a string or a buffer.
+Optional arguments BEG and END denote buffer positions for computing the
+hash of a portion of OBJECT.
+If BINARY is non-nil, return a string in binary form."
+ (if (stringp object)
+ (sha1-string object binary)
+ (save-excursion
+ (set-buffer object)
+ (sha1-region (or beg (point-min)) (or end (point-max)) binary))))
+
+(provide 'sha1)
+
+;;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901
+;;; sha1.el ends here
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
new file mode 100644
index 00000000000..5b7ef9a99fb
--- /dev/null
+++ b/lisp/gnus/sieve-manage.el
@@ -0,0 +1,616 @@
+;;; sieve-manage.el --- Implementation of the managesive protocol in elisp
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This library provides an elisp API for the managesieve network
+;; protocol.
+;;
+;; Currently only the CRAM-MD5 authentication mechanism is supported.
+;;
+;; The API should be fairly obvious for anyone familiar with the
+;; managesieve protocol, interface functions include:
+;;
+;; `sieve-manage-open'
+;; open connection to managesieve server, returning a buffer to be
+;; used by all other API functions.
+;;
+;; `sieve-manage-opened'
+;; check if a server is open or not
+;;
+;; `sieve-manage-close'
+;; close a server connection.
+;;
+;; `sieve-manage-authenticate'
+;; `sieve-manage-listscripts'
+;; `sieve-manage-deletescript'
+;; `sieve-manage-getscript'
+;; performs managesieve protocol actions
+;;
+;; and that's it. Example of a managesieve session in *scratch*:
+;;
+;; (setq my-buf (sieve-manage-open "my.server.com"))
+;; " *sieve* my.server.com:2000*"
+;;
+;; (sieve-manage-authenticate "myusername" "mypassword" my-buf)
+;; 'auth
+;;
+;; (sieve-manage-listscripts my-buf)
+;; ("vacation" "testscript" ("splitmail") "badscript")
+;;
+;; References:
+;;
+;; draft-martin-managesieve-02.txt,
+;; "A Protocol for Remotely Managing Sieve Scripts",
+;; by Tim Martin.
+;;
+;; Release history:
+;;
+;; 2001-10-31 Committed to Oort Gnus.
+;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd.
+
+;;; Code:
+
+(require 'rfc2104)
+(or (fboundp 'md5)
+ (require 'md5))
+(eval-and-compile
+ (autoload 'starttls-open-stream "starttls")
+ (autoload 'starttls-negotiate "starttls"))
+
+;; User customizable variables:
+
+(defgroup sieve-manage nil
+ "Low-level Managesieve protocol issues."
+ :group 'mail
+ :prefix "sieve-")
+
+(defcustom sieve-manage-log "*sieve-manage-log*"
+ "Name of buffer for managesieve session trace."
+ :type 'string)
+
+(defcustom sieve-manage-default-user (user-login-name)
+ "Default username to use."
+ :type 'string)
+
+(defcustom sieve-manage-server-eol "\r\n"
+ "The EOL string sent from the server."
+ :type 'string)
+
+(defcustom sieve-manage-client-eol "\r\n"
+ "The EOL string we send to the server."
+ :type 'string)
+
+(defcustom sieve-manage-streams '(network starttls shell)
+ "Priority of streams to consider when opening connection to server.")
+
+(defcustom sieve-manage-stream-alist
+ '((network sieve-manage-network-p sieve-manage-network-open)
+ (shell sieve-manage-shell-p sieve-manage-shell-open)
+ (starttls sieve-manage-starttls-p sieve-manage-starttls-open))
+ "Definition of network streams.
+
+\(NAME CHECK OPEN)
+
+NAME names the stream, CHECK is a function returning non-nil if the
+server support the stream and OPEN is a function for opening the
+stream.")
+
+(defcustom sieve-manage-authenticators '(cram-md5 plain)
+ "Priority of authenticators to consider when authenticating to server.")
+
+(defcustom sieve-manage-authenticator-alist
+ '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth)
+ (plain sieve-manage-plain-p sieve-manage-plain-auth))
+ "Definition of authenticators.
+
+\(NAME CHECK AUTHENTICATE)
+
+NAME names the authenticator. CHECK is a function returning non-nil if
+the server support the authenticator and AUTHENTICATE is a function
+for doing the actual authentication.")
+
+(defcustom sieve-manage-default-port 2000
+ "Default port number for managesieve protocol."
+ :type 'integer)
+
+;; Internal variables:
+
+(defconst sieve-manage-local-variables '(sieve-manage-server
+ sieve-manage-port
+ sieve-manage-auth
+ sieve-manage-stream
+ sieve-manage-username
+ sieve-manage-password
+ sieve-manage-process
+ sieve-manage-client-eol
+ sieve-manage-server-eol
+ sieve-manage-capability))
+(defconst sieve-manage-default-stream 'network)
+(defconst sieve-manage-coding-system-for-read 'binary)
+(defconst sieve-manage-coding-system-for-write 'binary)
+(defvar sieve-manage-stream nil)
+(defvar sieve-manage-auth nil)
+(defvar sieve-manage-server nil)
+(defvar sieve-manage-port nil)
+(defvar sieve-manage-username nil)
+(defvar sieve-manage-password nil)
+(defvar sieve-manage-state 'closed
+ "Managesieve state.
+Valid states are `closed', `initial', `nonauth', and `auth'.")
+(defvar sieve-manage-process nil)
+(defvar sieve-manage-capability nil)
+
+;; Internal utility functions
+
+(defsubst sieve-manage-disable-multibyte ()
+ "Enable multibyte in the current buffer."
+ (when (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil)))
+
+;; Uses the dynamically bound `reason' variable.
+(defvar reason)
+(defun sieve-manage-interactive-login (buffer loginfunc)
+ "Login to server in BUFFER.
+LOGINFUNC is passed a username and a password, it should return t if
+it where sucessful authenticating itself to the server, nil otherwise.
+Returns t if login was successful, nil otherwise."
+ (with-current-buffer buffer
+ (make-variable-buffer-local 'sieve-manage-username)
+ (make-variable-buffer-local 'sieve-manage-password)
+ (let (user passwd ret reason)
+ ;; (condition-case ()
+ (while (or (not user) (not passwd))
+ (setq user (or sieve-manage-username
+ (read-from-minibuffer
+ (concat "Managesieve username for "
+ sieve-manage-server ": ")
+ (or user sieve-manage-default-user))))
+ (setq passwd (or sieve-manage-password
+ (read-passwd
+ (concat "Managesieve password for " user "@"
+ sieve-manage-server ": "))))
+ (when (and user passwd)
+ (if (funcall loginfunc user passwd)
+ (progn
+ (setq ret t
+ sieve-manage-username user)
+ (if (and (not sieve-manage-password)
+ (y-or-n-p "Store password for this session? "))
+ (setq sieve-manage-password passwd)))
+ (if reason
+ (message "Login failed (reason given: %s)..." reason)
+ (message "Login failed..."))
+ (setq reason nil)
+ (setq passwd nil)
+ (sit-for 1))))
+ ;; (quit (with-current-buffer buffer
+ ;; (setq user nil
+ ;; passwd nil)))
+ ;; (error (with-current-buffer buffer
+ ;; (setq user nil
+ ;; passwd nil))))
+ ret)))
+
+(defun sieve-manage-erase (&optional p buffer)
+ (let ((buffer (or buffer (current-buffer))))
+ (and sieve-manage-log
+ (with-current-buffer (get-buffer-create sieve-manage-log)
+ (sieve-manage-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer (with-current-buffer buffer
+ (point-min))
+ (or p (with-current-buffer buffer
+ (point-max)))))))
+ (delete-region (point-min) (or p (point-max))))
+
+(defun sieve-manage-open-1 (buffer)
+ (with-current-buffer buffer
+ (sieve-manage-erase)
+ (setq sieve-manage-state 'initial
+ sieve-manage-process
+ (condition-case ()
+ (funcall (nth 2 (assq sieve-manage-stream
+ sieve-manage-stream-alist))
+ "sieve" buffer sieve-manage-server sieve-manage-port)
+ ((error quit) nil)))
+ (when sieve-manage-process
+ (while (and (eq sieve-manage-state 'initial)
+ (memq (process-status sieve-manage-process) '(open run)))
+ (message "Waiting for response from %s..." sieve-manage-server)
+ (accept-process-output sieve-manage-process 1))
+ (message "Waiting for response from %s...done" sieve-manage-server)
+ (and (memq (process-status sieve-manage-process) '(open run))
+ sieve-manage-process))))
+
+;; Streams
+
+(defun sieve-manage-network-p (buffer)
+ t)
+
+(defun sieve-manage-network-open (name buffer server port)
+ (let* ((port (or port sieve-manage-default-port))
+ (coding-system-for-read sieve-manage-coding-system-for-read)
+ (coding-system-for-write sieve-manage-coding-system-for-write)
+ (process (open-network-stream name buffer server port)))
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-min))
+ (not (sieve-manage-parse-greeting-1)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (sieve-manage-erase nil buffer)
+ (when (memq (process-status process) '(open run))
+ process))))
+
+(defun imap-starttls-p (buffer)
+ ;; (and (imap-capability 'STARTTLS buffer)
+ (condition-case ()
+ (progn
+ (require 'starttls)
+ (call-process "starttls"))
+ (error nil)))
+
+(defun imap-starttls-open (name buffer server port)
+ (let* ((port (or port sieve-manage-default-port))
+ (coding-system-for-read sieve-manage-coding-system-for-read)
+ (coding-system-for-write sieve-manage-coding-system-for-write)
+ (process (starttls-open-stream name buffer server port))
+ done)
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-min))
+ (not (sieve-manage-parse-greeting-1)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (sieve-manage-erase nil buffer)
+ (sieve-manage-send "STARTTLS")
+ (starttls-negotiate process))
+ (when (memq (process-status process) '(open run))
+ process)))
+
+;; Authenticators
+
+(defun sieve-manage-plain-p (buffer)
+ (sieve-manage-capability "SASL" "PLAIN" buffer))
+
+(defun sieve-manage-plain-auth (buffer)
+ "Login to managesieve server using the PLAIN SASL method."
+ (let* ((done (sieve-manage-interactive-login
+ buffer
+ (lambda (user passwd)
+ (sieve-manage-send (concat "AUTHENTICATE \"PLAIN\" \""
+ (base64-encode-string
+ (concat (char-to-string 0)
+ user
+ (char-to-string 0)
+ passwd))
+ "\""))
+ (let ((rsp (sieve-manage-parse-okno)))
+ (if (sieve-manage-ok-p rsp)
+ t
+ (setq reason (cdr-safe rsp))
+ nil))))))
+ (if done
+ (message "sieve: Authenticating using PLAIN...done")
+ (message "sieve: Authenticating using PLAIN...failed"))))
+
+(defun sieve-manage-cram-md5-p (buffer)
+ (sieve-manage-capability "SASL" "CRAM-MD5" buffer))
+
+(defun sieve-manage-cram-md5-auth (buffer)
+ "Login to managesieve server using the CRAM-MD5 SASL method."
+ (message "sieve: Authenticating using CRAM-MD5...")
+ (let* ((done (sieve-manage-interactive-login
+ buffer
+ (lambda (user passwd)
+ (sieve-manage-send "AUTHENTICATE \"CRAM-MD5\"")
+ (sieve-manage-send
+ (concat
+ "\""
+ (base64-encode-string
+ (concat
+ user " "
+ (rfc2104-hash 'md5 64 16 passwd
+ (base64-decode-string
+ (prog1
+ (sieve-manage-parse-string)
+ (sieve-manage-erase))))))
+ "\""))
+ (let ((rsp (sieve-manage-parse-okno)))
+ (if (sieve-manage-ok-p rsp)
+ t
+ (setq reason (cdr-safe rsp))
+ nil))))))
+ (if done
+ (message "sieve: Authenticating using CRAM-MD5...done")
+ (message "sieve: Authenticating using CRAM-MD5...failed"))))
+
+;; Managesieve API
+
+(defun sieve-manage-open (server &optional port stream auth buffer)
+ "Open a network connection to a managesieve SERVER (string).
+Optional variable PORT is port number (integer) on remote server.
+Optional variable STREAM is any of `sieve-manage-streams' (a symbol).
+Optional variable AUTH indicates authenticator to use, see
+`sieve-manage-authenticators' for available authenticators. If nil, chooses
+the best stream the server is capable of.
+Optional variable BUFFER is buffer (buffer, or string naming buffer)
+to work in."
+ (setq buffer (or buffer (format " *sieve* %s:%d" server (or port 2000))))
+ (with-current-buffer (get-buffer-create buffer)
+ (mapcar 'make-variable-buffer-local sieve-manage-local-variables)
+ (sieve-manage-disable-multibyte)
+ (buffer-disable-undo)
+ (setq sieve-manage-server (or server sieve-manage-server))
+ (setq sieve-manage-port (or port sieve-manage-port))
+ (setq sieve-manage-stream (or stream sieve-manage-stream))
+ (message "sieve: Connecting to %s..." sieve-manage-server)
+ (if (let ((sieve-manage-stream
+ (or sieve-manage-stream sieve-manage-default-stream)))
+ (sieve-manage-open-1 buffer))
+ ;; Choose stream.
+ (let (stream-changed)
+ (message "sieve: Connecting to %s...done" sieve-manage-server)
+ (when (null sieve-manage-stream)
+ (let ((streams sieve-manage-streams))
+ (while (setq stream (pop streams))
+ (if (funcall (nth 1 (assq stream
+ sieve-manage-stream-alist)) buffer)
+ (setq stream-changed
+ (not (eq (or sieve-manage-stream
+ sieve-manage-default-stream)
+ stream))
+ sieve-manage-stream stream
+ streams nil)))
+ (unless sieve-manage-stream
+ (error "Couldn't figure out a stream for server"))))
+ (when stream-changed
+ (message "sieve: Reconnecting with stream `%s'..."
+ sieve-manage-stream)
+ (sieve-manage-close buffer)
+ (if (sieve-manage-open-1 buffer)
+ (message "sieve: Reconnecting with stream `%s'...done"
+ sieve-manage-stream)
+ (message "sieve: Reconnecting with stream `%s'...failed"
+ sieve-manage-stream))
+ (setq sieve-manage-capability nil))
+ (if (sieve-manage-opened buffer)
+ ;; Choose authenticator
+ (when (and (null sieve-manage-auth)
+ (not (eq sieve-manage-state 'auth)))
+ (let ((auths sieve-manage-authenticators))
+ (while (setq auth (pop auths))
+ (if (funcall (nth 1 (assq
+ auth
+ sieve-manage-authenticator-alist))
+ buffer)
+ (setq sieve-manage-auth auth
+ auths nil)))
+ (unless sieve-manage-auth
+ (error "Couldn't figure out authenticator for server"))))))
+ (message "sieve: Connecting to %s...failed" sieve-manage-server))
+ (when (sieve-manage-opened buffer)
+ (sieve-manage-erase)
+ buffer)))
+
+(defun sieve-manage-opened (&optional buffer)
+ "Return non-nil if connection to managesieve server in BUFFER is open.
+If BUFFER is nil then the current buffer is used."
+ (and (setq buffer (get-buffer (or buffer (current-buffer))))
+ (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (and sieve-manage-process
+ (memq (process-status sieve-manage-process) '(open run))))))
+
+(defun sieve-manage-close (&optional buffer)
+ "Close connection to managesieve server in BUFFER.
+If BUFFER is nil, the current buffer is used."
+ (with-current-buffer (or buffer (current-buffer))
+ (when (sieve-manage-opened)
+ (sieve-manage-send "LOGOUT")
+ (sit-for 1))
+ (when (and sieve-manage-process
+ (memq (process-status sieve-manage-process) '(open run)))
+ (delete-process sieve-manage-process))
+ (setq sieve-manage-process nil)
+ (sieve-manage-erase)
+ t))
+
+(defun sieve-manage-authenticate (&optional user passwd buffer)
+ "Authenticate to server in BUFFER, using current buffer if nil.
+It uses the authenticator specified when opening the server. If the
+authenticator requires username/passwords, they are queried from the
+user and optionally stored in the buffer. If USER and/or PASSWD is
+specified, the user will not be questioned and the username and/or
+password is remembered in the buffer."
+ (with-current-buffer (or buffer (current-buffer))
+ (if (not (eq sieve-manage-state 'nonauth))
+ (eq sieve-manage-state 'auth)
+ (make-variable-buffer-local 'sieve-manage-username)
+ (make-variable-buffer-local 'sieve-manage-password)
+ (if user (setq sieve-manage-username user))
+ (if passwd (setq sieve-manage-password passwd))
+ (if (funcall (nth 2 (assq sieve-manage-auth
+ sieve-manage-authenticator-alist)) buffer)
+ (setq sieve-manage-state 'auth)))))
+
+(defun sieve-manage-capability (&optional name value buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (if (null name)
+ sieve-manage-capability
+ (if (null value)
+ (nth 1 (assoc name sieve-manage-capability))
+ (when (string-match value (nth 1 (assoc name sieve-manage-capability)))
+ (nth 1 (assoc name sieve-manage-capability)))))))
+
+(defun sieve-manage-listscripts (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send "LISTSCRIPTS")
+ (sieve-manage-parse-listscripts)))
+
+(defun sieve-manage-havespace (name size &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
+ (sieve-manage-parse-okno)))
+
+(eval-and-compile
+ (if (fboundp 'string-bytes)
+ (defalias 'sieve-string-bytes 'string-bytes)
+ (defalias 'sieve-string-bytes 'length)))
+
+(defun sieve-manage-putscript (name content &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
+ (sieve-string-bytes content)
+ sieve-manage-client-eol content))
+ (sieve-manage-parse-okno)))
+
+(defun sieve-manage-deletescript (name &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send (format "DELETESCRIPT \"%s\"" name))
+ (sieve-manage-parse-okno)))
+
+(defun sieve-manage-getscript (name output-buffer &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send (format "GETSCRIPT \"%s\"" name))
+ (let ((script (sieve-manage-parse-string)))
+ (sieve-manage-parse-crlf)
+ (with-current-buffer output-buffer
+ (insert script))
+ (sieve-manage-parse-okno))))
+
+(defun sieve-manage-setactive (name &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (sieve-manage-send (format "SETACTIVE \"%s\"" name))
+ (sieve-manage-parse-okno)))
+
+;; Protocol parsing routines
+
+(defun sieve-manage-ok-p (rsp)
+ (string= (downcase (or (car-safe rsp) "")) "ok"))
+
+(defsubst sieve-manage-forward ()
+ (or (eobp) (forward-char)))
+
+(defun sieve-manage-is-okno ()
+ (when (looking-at (concat
+ "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
+ sieve-manage-server-eol))
+ (let ((status (match-string 1))
+ (resp-code (match-string 3))
+ (response (match-string 5)))
+ (when response
+ (goto-char (match-beginning 5))
+ (setq response (sieve-manage-is-string)))
+ (list status resp-code response))))
+
+(defun sieve-manage-parse-okno ()
+ (let (rsp)
+ (while (null rsp)
+ (accept-process-output (get-buffer-process (current-buffer)) 1)
+ (goto-char (point-min))
+ (setq rsp (sieve-manage-is-okno)))
+ (sieve-manage-erase)
+ rsp))
+
+(defun sieve-manage-parse-capability-1 ()
+ "Accept a managesieve greeting."
+ (let (str)
+ (while (setq str (sieve-manage-is-string))
+ (if (eq (char-after) ? )
+ (progn
+ (sieve-manage-forward)
+ (push (list str (sieve-manage-is-string))
+ sieve-manage-capability))
+ (push (list str) sieve-manage-capability))
+ (forward-line)))
+ (when (re-search-forward (concat "^OK" sieve-manage-server-eol) nil t)
+ (setq sieve-manage-state 'nonauth)))
+
+(defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1)
+
+(defun sieve-manage-is-string ()
+ (cond ((looking-at "\"\\([^\"]+\\)\"")
+ (prog1
+ (match-string 1)
+ (goto-char (match-end 0))))
+ ((looking-at (concat "{\\([0-9]+\\)}" sieve-manage-server-eol))
+ (let ((pos (match-end 0))
+ (len (string-to-number (match-string 1))))
+ (if (< (point-max) (+ pos len))
+ nil
+ (goto-char (+ pos len))
+ (buffer-substring pos (+ pos len)))))))
+
+(defun sieve-manage-parse-string ()
+ (let (rsp)
+ (while (null rsp)
+ (accept-process-output (get-buffer-process (current-buffer)) 1)
+ (goto-char (point-min))
+ (setq rsp (sieve-manage-is-string)))
+ (sieve-manage-erase (point))
+ rsp))
+
+(defun sieve-manage-parse-crlf ()
+ (when (looking-at sieve-manage-server-eol)
+ (sieve-manage-erase (match-end 0))))
+
+(defun sieve-manage-parse-listscripts ()
+ (let (tmp rsp data)
+ (while (null rsp)
+ (while (null (or (setq rsp (sieve-manage-is-okno))
+ (setq tmp (sieve-manage-is-string))))
+ (accept-process-output (get-buffer-process (current-buffer)) 1)
+ (goto-char (point-min)))
+ (when tmp
+ (while (not (looking-at (concat "\\( ACTIVE\\)?"
+ sieve-manage-server-eol)))
+ (accept-process-output (get-buffer-process (current-buffer)) 1)
+ (goto-char (point-min)))
+ (if (match-string 1)
+ (push (cons 'active tmp) data)
+ (push tmp data))
+ (goto-char (match-end 0))
+ (setq tmp nil)))
+ (sieve-manage-erase)
+ (if (sieve-manage-ok-p rsp)
+ data
+ rsp)))
+
+(defun sieve-manage-send (cmdstr)
+ (setq cmdstr (concat cmdstr sieve-manage-client-eol))
+ (and sieve-manage-log
+ (with-current-buffer (get-buffer-create sieve-manage-log)
+ (sieve-manage-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert cmdstr)))
+ (process-send-string sieve-manage-process cmdstr))
+
+(provide 'sieve-manage)
+
+;;; arch-tag: 321c4640-1371-4495-9baf-8ccb71dd5bd1
+;; sieve-manage.el ends here
diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el
new file mode 100644
index 00000000000..e303e8e70b5
--- /dev/null
+++ b/lisp/gnus/sieve-mode.el
@@ -0,0 +1,205 @@
+;;; sieve-mode.el --- Sieve code editing commands for Emacs
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file contain editing mode functions and font-lock support for
+;; editing Sieve scripts. It sets up C-mode with support for
+;; sieve-style #-comments and a lightly hacked syntax table. It was
+;; strongly influenced by awk-mode.el.
+;;
+;; Put something similar to the following in your .emacs to use this file:
+;;
+;; (load "~/lisp/sieve")
+;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist))
+;;
+;; References:
+;;
+;; RFC 3028,
+;; "Sieve: A Mail Filtering Language",
+;; by Tim Showalter.
+;;
+;; Release history:
+;;
+;; 2001-03-02 version 1.0 posted to gnu.emacs.sources
+;; version 1.1 change file extension into ".siv" (official one)
+;; added keymap and menubar to hook into sieve-manage
+;; 2001-10-31 version 1.2 committed to Oort Gnus
+
+;;; Code:
+
+(autoload 'sieve-manage "sieve")
+(autoload 'sieve-upload "sieve")
+(autoload 'c-mode "cc-mode")
+(require 'easymenu)
+(eval-when-compile
+ (require 'font-lock))
+
+(defgroup sieve nil
+ "Sieve."
+ :group 'languages)
+
+(defcustom sieve-mode-hook nil
+ "Hook run in sieve mode buffers."
+ :group 'sieve
+ :type 'hook)
+
+;; Font-lock
+
+(defvar sieve-control-commands-face 'sieve-control-commands-face
+ "Face name used for Sieve Control Commands.")
+
+(defface sieve-control-commands-face
+ '((((type tty) (class color)) (:foreground "blue" :weight light))
+ (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (((class color) (background light)) (:foreground "Orchid"))
+ (((class color) (background dark)) (:foreground "LightSteelBlue"))
+ (t (:bold t)))
+ "Face used for Sieve Control Commands.")
+
+(defvar sieve-action-commands-face 'sieve-action-commands-face
+ "Face name used for Sieve Action Commands.")
+
+(defface sieve-action-commands-face
+ '((((type tty) (class color)) (:foreground "blue" :weight bold))
+ (((class color) (background light)) (:foreground "Blue"))
+ (((class color) (background dark)) (:foreground "LightSkyBlue"))
+ (t (:inverse-video t :bold t)))
+ "Face used for Sieve Action Commands.")
+
+(defvar sieve-test-commands-face 'sieve-test-commands-face
+ "Face name used for Sieve Test Commands.")
+
+(defface sieve-test-commands-face
+ '((((type tty) (class color)) (:foreground "magenta"))
+ (((class grayscale) (background light))
+ (:foreground "LightGray" :bold t :underline t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray50" :bold t :underline t))
+ (((class color) (background light)) (:foreground "CadetBlue"))
+ (((class color) (background dark)) (:foreground "Aquamarine"))
+ (t (:bold t :underline t)))
+ "Face used for Sieve Test Commands.")
+
+(defvar sieve-tagged-arguments-face 'sieve-tagged-arguments-face
+ "Face name used for Sieve Tagged Arguments.")
+
+(defface sieve-tagged-arguments-face
+ '((((type tty) (class color)) (:foreground "cyan" :weight bold))
+ (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (t (:bold t)))
+ "Face used for Sieve Tagged Arguments.")
+
+
+(defconst sieve-font-lock-keywords
+ (eval-when-compile
+ (list
+ ;; control commands
+ (cons (regexp-opt '("require" "if" "else" "elsif" "stop"))
+ 'sieve-control-commands-face)
+ ;; action commands
+ (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard"))
+ 'sieve-action-commands-face)
+ ;; test commands
+ (cons (regexp-opt '("address" "allof" "anyof" "exists" "false"
+ "true" "header" "not" "size" "envelope"))
+ 'sieve-test-commands-face)
+ (cons "\\Sw+:\\sw+"
+ 'sieve-tagged-arguments-face))))
+
+;; Syntax table
+
+(defvar sieve-mode-syntax-table nil
+ "Syntax table in use in sieve-mode buffers.")
+
+(if sieve-mode-syntax-table
+ ()
+ (setq sieve-mode-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\\ "\\" sieve-mode-syntax-table)
+ (modify-syntax-entry ?\n "> " sieve-mode-syntax-table)
+ (modify-syntax-entry ?\f "> " sieve-mode-syntax-table)
+ (modify-syntax-entry ?\# "< " sieve-mode-syntax-table)
+ (modify-syntax-entry ?/ "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?* "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?+ "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?- "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?= "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?% "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?< "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?> "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?& "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?| "." sieve-mode-syntax-table)
+ (modify-syntax-entry ?_ "_" sieve-mode-syntax-table)
+ (modify-syntax-entry ?\' "\"" sieve-mode-syntax-table))
+
+;; Key map definition
+
+(defvar sieve-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-l" 'sieve-upload)
+ (define-key map "\C-c\C-c" 'sieve-upload-and-bury)
+ (define-key map "\C-c\C-m" 'sieve-manage)
+ map)
+ "Key map used in sieve mode.")
+
+;; Menu definition
+
+(defvar sieve-mode-menu nil
+ "Menubar used in sieve mode.")
+
+;; Code for Sieve editing mode.
+
+;;;###autoload
+(define-derived-mode sieve-mode c-mode "Sieve"
+ "Major mode for editing Sieve code.
+This is much like C mode except for the syntax of comments. Its keymap
+inherits from C mode's and it has the same variables for customizing
+indentation. It has its own abbrev table and its own syntax table.
+
+Turning on Sieve mode runs `sieve-mode-hook'."
+ (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
+ (set (make-local-variable 'paragraph-separate) paragraph-start)
+ (set (make-local-variable 'comment-start) "#")
+ (set (make-local-variable 'comment-end) "")
+ ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *")
+ (set (make-local-variable 'comment-start-skip) "#+ *")
+ (unless (featurep 'xemacs)
+ (set (make-local-variable 'font-lock-defaults)
+ '(sieve-font-lock-keywords nil nil ((?_ . "w")))))
+ (easy-menu-add-item nil nil sieve-mode-menu))
+
+;; Menu
+
+(easy-menu-define sieve-mode-menu sieve-mode-map
+ "Sieve Menu."
+ '("Sieve"
+ ["Upload script" sieve-upload t]
+ ["Manage scripts on server" sieve-manage t]))
+
+(provide 'sieve-mode)
+
+;;; arch-tag: 3b8ab76d-065d-4c52-b1e8-ab2ec21f2ace
+;; sieve-mode.el ends here
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
new file mode 100644
index 00000000000..f4645168dec
--- /dev/null
+++ b/lisp/gnus/sieve.el
@@ -0,0 +1,384 @@
+;;; sieve.el --- Utilities to manage sieve scripts
+;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file contain utilities to facilate upload, download and
+;; general management of sieve scripts. Currently only the
+;; Managesieve protocol is supported (using sieve-manage.el), but when
+;; (useful) alternatives become available, they might be supported as
+;; well.
+;;
+;; The cursor navigation was inspired by biff-mode by Franklin Lee.
+;;
+;; Release history:
+;;
+;; 2001-10-31 Committed to Oort Gnus.
+;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode. Fix menubar
+;; in manage-mode. Change some messages. Added sieve-deactivate*,
+;; sieve-remove. Fixed help text in manage-mode. Suggested by
+;; Ned Ludd.
+;;
+;; Todo:
+;;
+;; * Namespace? This file contains `sieve-manage' and
+;; `sieve-manage-mode', but there is a sieve-manage.el file as well.
+;; Can't think of a good solution though, this file need a *-mode,
+;; and naming it `sieve-mode' would collide with sieve-mode.el. One
+;; solution would be to come up with some better name that this file
+;; can use that doesn't have the managesieve specific "manage" in
+;; it. sieve-dired? i dunno. we could copy all off sieve.el into
+;; sieve-manage.el too, but I'd like to separate the interface from
+;; the protocol implementation since the backends are likely to
+;; change (well).
+;;
+;; * Define servers? We could have a customize buffer to create a server,
+;; with authentication/stream/etc parameters, much like Gnus, and then
+;; only use names of defined servers when interacting with M-x sieve-*.
+;; Right now you can't use STARTTLS, which sieve-manage.el provides
+
+;;; Code:
+
+(require 'sieve-manage)
+(require 'sieve-mode)
+
+;; User customizable variables:
+
+(defgroup sieve nil
+ "Manage sieve scripts."
+ :group 'tools)
+
+(defcustom sieve-new-script "<new script>"
+ "Name of name script indicator."
+ :type 'string
+ :group 'sieve)
+
+(defcustom sieve-buffer "*sieve*"
+ "Name of sieve management buffer."
+ :type 'string
+ :group 'sieve)
+
+(defcustom sieve-template "\
+require \"fileinto\";
+
+# Example script (remove comment character '#' to make it effective!):
+#
+# if header :contains \"from\" \"coyote\" {
+# discard;
+# } elsif header :contains [\"subject\"] [\"$$$\"] {
+# discard;
+# } else {
+# fileinto \"INBOX\";
+# }
+"
+ "Template sieve script."
+ :type 'string
+ :group 'sieve)
+
+;; Internal variables:
+
+(defvar sieve-manage-buffer nil)
+(defvar sieve-buffer-header-end nil)
+
+;; Sieve-manage mode:
+
+(defvar sieve-manage-mode-map nil
+ "Keymap for `sieve-manage-mode'.")
+
+(if sieve-manage-mode-map
+ ()
+ (setq sieve-manage-mode-map (make-sparse-keymap))
+ (suppress-keymap sieve-manage-mode-map)
+ ;; various
+ (define-key sieve-manage-mode-map "?" 'sieve-help)
+ (define-key sieve-manage-mode-map "h" 'sieve-help)
+ (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
+ ;; activating
+ (define-key sieve-manage-mode-map "m" 'sieve-activate)
+ (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
+ (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
+ ;; navigation keys
+ (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
+ (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
+ (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
+ (define-key sieve-manage-mode-map [down] 'sieve-next-line)
+ (define-key sieve-manage-mode-map " " 'sieve-next-line)
+ (define-key sieve-manage-mode-map "n" 'sieve-next-line)
+ (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
+ (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
+ (define-key sieve-manage-mode-map "f" 'sieve-edit-script)
+ (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
+ (define-key sieve-manage-mode-map "r" 'sieve-remove)
+ (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script)
+ (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu))
+
+(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
+ "Sieve Menu."
+ '("Manage Sieve"
+ ["Edit script" sieve-edit-script t]
+ ["Activate script" sieve-activate t]
+ ["Deactivate script" sieve-deactivate t]))
+
+(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
+ "Mode used for sieve script management."
+ (setq mode-name "SIEVE")
+ (buffer-disable-undo (current-buffer))
+ (setq truncate-lines t)
+ (easy-menu-add-item nil nil sieve-manage-mode-menu))
+
+(put 'sieve-manage-mode 'mode-class 'special)
+
+;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
+;; in substitute-command-keys.
+;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
+
+;; Commands used in sieve-manage mode:
+
+(defun sieve-activate (&optional pos)
+ (interactive "d")
+ (let ((name (sieve-script-at-point)) err)
+ (when (or (null name) (string-equal name sieve-new-script))
+ (error "No sieve script at point"))
+ (message "Activating script %s..." name)
+ (setq err (sieve-manage-setactive name sieve-manage-buffer))
+ (sieve-refresh-scriptlist)
+ (if (sieve-manage-ok-p err)
+ (message "Activating script %s...done" name)
+ (message "Activating script %s...failed: %s" name (nth 2 err)))))
+
+(defun sieve-deactivate-all (&optional pos)
+ (interactive "d")
+ (let ((name (sieve-script-at-point)) err)
+ (message "Deactivating scripts...")
+ (setq err (sieve-manage-setactive "" sieve-manage-buffer))
+ (sieve-refresh-scriptlist)
+ (if (sieve-manage-ok-p err)
+ (message "Deactivating scripts...done")
+ (message "Deactivating scripts...failed: %s" (nth 2 err)))))
+
+(defalias 'sieve-deactivate 'sieve-deactivate-all)
+
+(defun sieve-remove (&optional pos)
+ (interactive "d")
+ (let ((name (sieve-script-at-point)) err)
+ (when (or (null name) (string-equal name sieve-new-script))
+ (error "No sieve script at point"))
+ (message "Removing sieve script %s..." name)
+ (setq err (sieve-manage-deletescript name sieve-manage-buffer))
+ (unless (sieve-manage-ok-p err)
+ (error "Removing sieve script %s...failed: " err))
+ (sieve-refresh-scriptlist)
+ (message "Removing sieve script %s...done" name)))
+
+(defun sieve-edit-script (&optional pos)
+ (interactive "d")
+ (let ((name (sieve-script-at-point)))
+ (unless name
+ (error "No sieve script at point"))
+ (if (not (string-equal name sieve-new-script))
+ (let ((newbuf (generate-new-buffer name))
+ err)
+ (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
+ (switch-to-buffer newbuf)
+ (unless (sieve-manage-ok-p err)
+ (error "Sieve download failed: %s" err)))
+ (switch-to-buffer (get-buffer-create "template.siv"))
+ (insert sieve-template))
+ (sieve-mode)
+ (message "Press C-c C-l to upload script to server.")))
+
+(defmacro sieve-change-region (&rest body)
+ "Turns off sieve-region before executing BODY, then re-enables it after.
+Used to bracket operations which move point in the sieve-buffer."
+ `(progn
+ (sieve-highlight nil)
+ ,@body
+ (sieve-highlight t)))
+(put 'sieve-change-region 'lisp-indent-function 0)
+
+(defun sieve-next-line (&optional arg)
+ (interactive)
+ (unless arg
+ (setq arg 1))
+ (if (save-excursion
+ (forward-line arg)
+ (sieve-script-at-point))
+ (sieve-change-region
+ (forward-line arg))
+ (message "End of list")))
+
+(defun sieve-prev-line (&optional arg)
+ (interactive)
+ (unless arg
+ (setq arg -1))
+ (if (save-excursion
+ (forward-line arg)
+ (sieve-script-at-point))
+ (sieve-change-region
+ (forward-line arg))
+ (message "Beginning of list")))
+
+(defun sieve-help ()
+ "Display help for various sieve commands."
+ (interactive)
+ (if (eq last-command 'sieve-help)
+ ;; would need minor-mode for log-edit-mode
+ (describe-function 'sieve-mode)
+ (message (substitute-command-keys
+ "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
+
+(defun sieve-bury-buffer (buf &optional mainbuf)
+ "Hide the buffer BUF that was temporarily popped up.
+BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
+ (interactive (list (current-buffer)))
+ (save-current-buffer
+ (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
+ (get-buffer-window buf t))))
+ (when win
+ (if (window-dedicated-p win)
+ (condition-case ()
+ (delete-window win)
+ (error (iconify-frame (window-frame win))))
+ (if (and mainbuf (get-buffer-window mainbuf))
+ (delete-window win)))))
+ (with-current-buffer buf
+ (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
+ (not (window-dedicated-p (selected-window))))
+ buf)))
+ (when mainbuf
+ (let ((mainwin (or (get-buffer-window mainbuf)
+ (get-buffer-window mainbuf 'visible))))
+ (when mainwin (select-window mainwin))))))
+
+;; Create buffer:
+
+(defun sieve-setup-buffer (server port)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (buffer-disable-undo)
+ (insert "\
+Server : " server ":" (or port "2000") "
+
+")
+ (set (make-local-variable 'sieve-buffer-header-end)
+ (point-max)))
+
+(defun sieve-script-at-point (&optional pos)
+ "Return name of sieve script at point POS, or nil."
+ (interactive "d")
+ (get-char-property (or pos (point)) 'script-name))
+
+(eval-and-compile
+ (defalias 'sieve-make-overlay (if (fboundp 'make-overlay)
+ 'make-overlay
+ 'make-extent))
+ (defalias 'sieve-overlay-put (if (fboundp 'overlay-put)
+ 'overlay-put
+ 'set-extent-property))
+ (defalias 'sieve-overlays-at (if (fboundp 'overlays-at)
+ 'overlays-at
+ 'extents-at)))
+
+(defun sieve-highlight (on)
+ "Turn ON or off highlighting on the current language overlay."
+ (sieve-overlay-put (car (sieve-overlays-at (point)))
+ 'face (if on 'highlight 'default)))
+
+(defun sieve-insert-scripts (scripts)
+ "Format and insert LANGUAGE-LIST strings into current buffer at point."
+ (while scripts
+ (let ((p (point))
+ (ext nil)
+ (script (pop scripts)))
+ (if (consp script)
+ (insert (format " ACTIVE %s" (cdr script)))
+ (insert (format " %s" script)))
+ (setq ext (sieve-make-overlay p (point)))
+ (sieve-overlay-put ext 'mouse-face 'highlight)
+ (sieve-overlay-put ext 'script-name (if (consp script)
+ (cdr script)
+ script))
+ (insert "\n"))))
+
+(defun sieve-open-server (server &optional port)
+ ;; open server
+ (set (make-local-variable 'sieve-manage-buffer)
+ (sieve-manage-open server))
+ ;; authenticate
+ (sieve-manage-authenticate nil nil sieve-manage-buffer))
+
+(defun sieve-refresh-scriptlist ()
+ (interactive)
+ (with-current-buffer sieve-buffer
+ (setq buffer-read-only nil)
+ (delete-region (or sieve-buffer-header-end (point-max)) (point-max))
+ (goto-char (point-max))
+ ;; get list of script names and print them
+ (let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
+ (if (null scripts)
+ (insert (format (concat "No scripts on server, press RET on %s to "
+ "create a new script.\n") sieve-new-script))
+ (insert (format (concat "%d script%s on server, press RET on a script "
+ "name edits it, or\npress RET on %s to create "
+ "a new script.\n") (length scripts)
+ (if (eq (length scripts) 1) "" "s")
+ sieve-new-script)))
+ (save-excursion
+ (sieve-insert-scripts (list sieve-new-script))
+ (sieve-insert-scripts scripts)))
+ (sieve-highlight t)
+ (setq buffer-read-only t)))
+
+;;;###autoload
+(defun sieve-manage (server &optional port)
+ (interactive "sServer: ")
+ (switch-to-buffer (get-buffer-create sieve-buffer))
+ (sieve-manage-mode)
+ (sieve-setup-buffer server port)
+ (if (sieve-open-server server port)
+ (sieve-refresh-scriptlist)
+ (message "Could not open server %s" server)))
+
+;;;###autoload
+(defun sieve-upload (&optional name)
+ (interactive)
+ (unless name
+ (setq name (buffer-name)))
+ (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
+ (let ((script (buffer-string)) err)
+ (with-current-buffer (get-buffer sieve-buffer)
+ (setq err (sieve-manage-putscript name script sieve-manage-buffer))
+ (if (sieve-manage-ok-p err)
+ (message (concat
+ "Sieve upload done. Use `C-c RET' to manage scripts."))
+ (message "Sieve upload failed: %s" (nth 2 err)))))))
+
+;;;###autoload
+(defun sieve-upload-and-bury (&optional name)
+ (interactive)
+ (sieve-upload name)
+ (bury-buffer))
+
+(provide 'sieve)
+
+;;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94
+;; sieve.el ends here
diff --git a/lisp/gnus/smile.xpm b/lisp/gnus/smile.xpm
new file mode 100644
index 00000000000..374d240a955
--- /dev/null
+++ b/lisp/gnus/smile.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * smile_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".++..+++..++.",
+".++..+++..++.",
+".+++++++++++.",
+".+++++++++++.",
+".++.+++++.++.",
+".++.+++++.++.",
+".+++.....+++.",
+" .+++++++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/smiley-ems.el b/lisp/gnus/smiley.el
index 7fce284e500..d41aea1d4ce 100644
--- a/lisp/gnus/smiley-ems.el
+++ b/lisp/gnus/smiley.el
@@ -1,6 +1,6 @@
-;;; smiley-ems.el --- displaying smiley faces
+;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: news mail multimedia
@@ -35,7 +35,9 @@
;;; Code:
+(eval-when-compile (require 'cl))
(require 'nnheader)
+(require 'gnus-art)
(defgroup smiley nil
"Turn :-)'s into real images."
@@ -43,22 +45,24 @@
;; Maybe this should go.
(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies")
- "*If non-nil, a directory to search for the smiley image files.
-This is in addition to the normal image search path."
- :type '(choice directory
- (const nil))
+ "*Location of the smiley faces files."
+ :type 'directory
:group 'smiley)
;; The XEmacs version has a baroque, if not rococo, set of these.
(defcustom smiley-regexp-alist
- ;; Perhaps :-) should be distinct -- it does appear in the Jargon File.
- '(("\\([:;]-?)\\)\\(\\W\\|\\'\\)" 1 "smile.pbm")
- ("\\(:-[/\\]\\)\\(\\W\\|\\'\\)" 1 "wry.pbm")
- ("\\(:-[({]\\)\\(\\W\\|\\'\\)" 1 "frown.pbm"))
+ '(("\\(:-?)\\)\\W" 1 "smile")
+ ("\\(;-?)\\)\\W" 1 "blink")
+ ("\\(:-]\\)\\W" 1 "forced")
+ ("\\(8-)\\)\\W" 1 "braindamaged")
+ ("\\(:-|\\)\\W" 1 "indifferent")
+ ("\\(:-[/\\]\\)\\W" 1 "wry")
+ ("\\(:-(\\)\\W" 1 "sad")
+ ("\\(:-{\\)\\W" 1 "frown"))
"*A list of regexps to map smilies to images.
The elements are (REGEXP MATCH FILE), where MATCH is the submatch in
-rgexp to replace with IMAGE. IMAGE is the name of a PBM file in
-`smiley-data-directory' or the normal image search path."
+regexp to replace with IMAGE. IMAGE is the name of a PBM file in
+`smiley-data-directory'."
:type '(repeat (list regexp
(integer :tag "Regexp match number")
(string :tag "Image name")))
@@ -68,21 +72,35 @@ rgexp to replace with IMAGE. IMAGE is the name of a PBM file in
:initialize 'custom-initialize-default
:group 'smiley)
+(defcustom gnus-smiley-file-types
+ (let ((types (list "pbm")))
+ (when (gnus-image-type-available-p 'xpm)
+ (push "xpm" types))
+ types)
+ "*List of suffixes on picon file names to try."
+ :type '(repeat string)
+ :group 'smiley)
+
(defvar smiley-cached-regexp-alist nil)
(defun smiley-update-cache ()
- (dolist (elt smiley-regexp-alist)
- (let* ((data-directory smiley-data-directory)
- (image (find-image (list (list :type 'pbm
- :file (nth 2 elt)
- :ascent 'center)))))
- (if image
- (push (list (car elt) (cadr elt) image)
- smiley-cached-regexp-alist)))))
-
-(defvar smiley-active nil
- "Non-nil means smilies in the buffer will be displayed.")
-(make-variable-buffer-local 'smiley-active)
+ (dolist (elt (if (symbolp smiley-regexp-alist)
+ (symbol-value smiley-regexp-alist)
+ smiley-regexp-alist))
+ (let ((types gnus-smiley-file-types)
+ file type)
+ (while (and (not file)
+ (setq type (pop types)))
+ (unless (file-exists-p
+ (setq file (expand-file-name (concat (nth 2 elt) "." type)
+ smiley-data-directory)))
+ (setq file nil)))
+ (when type
+ (let ((image (gnus-create-image file (intern type) nil
+ :ascent 'center)))
+ (when image
+ (push (list (car elt) (cadr elt) image)
+ smiley-cached-regexp-alist)))))))
(defvar smiley-mouse-map
(let ((map (make-sparse-keymap)))
@@ -93,48 +111,50 @@ rgexp to replace with IMAGE. IMAGE is the name of a PBM file in
;;;###autoload
(defun smiley-region (start end)
- "Display textual smileys as images.
-START and END specify the region; interactively, use the values
-of point and mark. The value of `smiley-regexp-alist' determines
-which smileys to operate on and which images to use for them."
+ "Replace in the region `smiley-regexp-alist' matches with corresponding images.
+A list of images is returned."
(interactive "r")
- (when (and (fboundp 'display-graphic-p)
- (display-graphic-p))
- (mapc (lambda (o)
- (if (eq 'smiley (overlay-get o 'smiley))
- (delete-overlay o)))
- (overlays-in start end))
+ (when (gnus-graphic-display-p)
(unless smiley-cached-regexp-alist
(smiley-update-cache))
(save-excursion
(let ((beg (or start (point-min)))
- (inhibit-point-motion-hooks t)
- group overlay image)
+ group image images string)
(dolist (entry smiley-cached-regexp-alist)
(setq group (nth 1 entry)
image (nth 2 entry))
(goto-char beg)
(while (re-search-forward (car entry) end t)
+ (setq string (match-string group))
+ (goto-char (match-end group))
+ (delete-region (match-beginning group) (match-end group))
(when image
- (setq overlay (make-overlay (match-beginning group)
- (match-end group)))
- (overlay-put overlay
- 'display `(when smiley-active ,@image))
- (overlay-put overlay 'mouse-face 'highlight)
- (overlay-put overlay 'smiley t)
- (overlay-put overlay
- 'help-echo "mouse-2: toggle smilies in buffer")
- (overlay-put overlay 'keymap smiley-mouse-map)
- (goto-char (match-end group)))))))
- (setq smiley-active t)))
+ (push image images)
+ (gnus-add-wash-type 'smiley)
+ (gnus-add-image 'smiley image)
+ (gnus-put-image image string 'smiley))))
+ images))))
+
+;;;###autoload
+(defun smiley-buffer (&optional buffer)
+ "Run `smiley-region' at the buffer, specified in the argument or
+interactively. If there's no argument, do it at the current buffer"
+ (interactive "bBuffer to run smiley-region: ")
+ (save-excursion
+ (if buffer
+ (set-buffer (get-buffer buffer)))
+ (smiley-region (point-min) (point-max))))
(defun smiley-toggle-buffer (&optional arg)
- "Toggle displaying smiley faces.
+ "Toggle displaying smiley faces in article buffer.
With arg, turn displaying on if and only if arg is positive."
(interactive "P")
- (if (numberp arg)
- (setq smiley-active (> arg 0))
- (setq smiley-active (not smiley-active))))
+ (gnus-with-article-buffer
+ (if (if (numberp arg)
+ (> arg 0)
+ (not (memq 'smiley gnus-article-wash-types)))
+ (smiley-region (point-min) (point-max))
+ (gnus-delete-images 'smiley))))
(defun smiley-mouse-toggle-buffer (event)
"Toggle displaying smiley faces.
@@ -145,22 +165,7 @@ With arg, turn displaying on if and only if arg is positive."
(mouse-set-point event)
(smiley-toggle-buffer))))
-(eval-when-compile (defvar gnus-article-buffer))
-
-(defun gnus-smiley-display (&optional arg)
- "Display textual emoticons (\"smilies\") as small graphical icons.
-With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (widen)
- (article-goto-body)
- (smiley-region (point-min) (point-max))
- (if (and (numberp arg) (<= arg 0))
- (smiley-toggle-buffer arg)))))
-
(provide 'smiley)
-;;; arch-tag: e726728a-14fb-4e6a-9aef-889941bdf7ad
-;;; smiley-ems.el ends here
+;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818
+;;; smiley.el ends here
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
new file mode 100644
index 00000000000..a1f9e902577
--- /dev/null
+++ b/lisp/gnus/smime.el
@@ -0,0 +1,644 @@
+;;; smime.el --- S/MIME support library
+;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: SMIME X.509 PEM OpenSSL
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This library perform S/MIME operations from within Emacs.
+;;
+;; Functions for fetching certificates from public repositories are
+;; provided, currently only from DNS. LDAP support (via EUDC) is planned.
+;;
+;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
+;; encryption and decryption.
+;;
+;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is
+;; probably required to use this library in any useful way.
+;; Especially, don't expect this library to buy security for you. If
+;; you don't understand what you are doing, you're as likely to lose
+;; security than gain any by using this library.
+;;
+;; This library is not intended to provide a "raw" API for S/MIME,
+;; PKCSx or similar, it's intended to perform common operations
+;; done on messages encoded in these formats. The terminology chosen
+;; reflect this.
+;;
+;; The home of this file is in Gnus CVS, but also available from
+;; http://josefsson.org/smime.html.
+
+;;; Quick introduction:
+
+;; Get your S/MIME certificate from VeriSign or someplace. I used
+;; Netscape to generate the key and certificate request and stuff, and
+;; Netscape can export the key into PKCS#12 format.
+;;
+;; Enter OpenSSL. To be able to use this library, it need to have the
+;; SMIME key readable in PEM format. OpenSSL is used to convert the
+;; key:
+;;
+;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem
+;; ...
+;;
+;; Now, use M-x customize-variable smime-keys and add mykey.pem as
+;; a key.
+;;
+;; Now you should be able to sign messages! Create a buffer and write
+;; something and run M-x smime-sign-buffer RET RET and you should see
+;; your message MIME armoured and a signature. Encryption, M-x
+;; smime-encrypt-buffer, should also work.
+;;
+;; To be able to verify messages you need to build up trust with
+;; someone. Perhaps you trust the CA that issued your certificate, at
+;; least I did, so I export it's certificates from my PKCS#12
+;; certificate with:
+;;
+;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem
+;; ...
+;;
+;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a
+;; CA certificate.
+;;
+;; You should now be able to sign messages, and even verify messages
+;; sent by others that use the same CA as you.
+
+;; Bugs:
+;;
+;; Don't complain that this package doesn't do encrypted PEM files,
+;; submit a patch instead. I store my keys in a safe place, so I
+;; didn't need the encryption. Also, programming was made easier by
+;; that decision. One might think that this even influenced were I
+;; store my keys, and one would probably be right. :-)
+;;
+;; Update: Mathias Herberts sent the patch. However, it uses
+;; environment variables to pass the password to OpenSSL, which is
+;; slightly insecure. Hence a new todo: use a better -passin method.
+;;
+;; Cache password for e.g. 1h
+;;
+;; Suggestions and comments are appreciated, mail me at simon@josefsson.org.
+
+;; begin rant
+;;
+;; I would include pointers to introductory text on concepts used in
+;; this library here, but the material I've read are so horrible I
+;; don't want to recomend them.
+;;
+;; Why can't someone write a simple introduction to all this stuff?
+;; Until then, much of this resemble security by obscurity.
+;;
+;; Also, I'm not going to mention anything about the wonders of
+;; cryptopolitics. Oops, I just did.
+;;
+;; end rant
+
+;;; Revision history:
+
+;; 2000-06-05 initial version, committed to Gnus CVS contrib/
+;; 2000-10-28 retrieve certificates via DNS CERT RRs
+;; 2001-10-14 posted to gnu.emacs.sources
+
+;;; Code:
+
+(require 'dig)
+(eval-when-compile (require 'cl))
+
+(defgroup smime nil
+ "S/MIME configuration.")
+
+(defcustom smime-keys nil
+ "*Map mail addresses to a file containing Certificate (and private key).
+The file is assumed to be in PEM format. You can also associate additional
+certificates to be sent with every message to each address."
+ :type '(repeat (list (string :tag "Mail address")
+ (file :tag "File name")
+ (repeat :tag "Additional certificate files"
+ (file :tag "File name"))))
+ :group 'smime)
+
+(defcustom smime-CA-directory nil
+ "*Directory containing certificates for CAs you trust.
+Directory should contain files (in PEM format) named to the X.509
+hash of the certificate. This can be done using OpenSSL such as:
+
+$ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0
+
+where `ca.pem' is the file containing a PEM encoded X.509 CA
+certificate."
+ :type '(choice (const :tag "none" nil)
+ directory)
+ :group 'smime)
+
+(defcustom smime-CA-file nil
+ "*Files containing certificates for CAs you trust.
+File should contain certificates in PEM format."
+ :type '(choice (const :tag "none" nil)
+ file)
+ :group 'smime)
+
+(defcustom smime-certificate-directory "~/Mail/certs/"
+ "*Directory containing other people's certificates.
+It should contain files named to the X.509 hash of the certificate,
+and the files themself should be in PEM format."
+;The S/MIME library provide simple functionality for fetching
+;certificates into this directory, so there is no need to populate it
+;manually.
+ :type 'directory
+ :group 'smime)
+
+(defcustom smime-openssl-program
+ (and (condition-case ()
+ (eq 0 (call-process "openssl" nil nil nil "version"))
+ (error nil))
+ "openssl")
+ "*Name of OpenSSL binary."
+ :type 'string
+ :group 'smime)
+
+;; OpenSSL option to select the encryption cipher
+
+(defcustom smime-encrypt-cipher "-des3"
+ "*Cipher algorithm used for encryption."
+ :type '(choice (const :tag "Triple DES" "-des3")
+ (const :tag "DES" "-des")
+ (const :tag "RC2 40 bits" "-rc2-40")
+ (const :tag "RC2 64 bits" "-rc2-64")
+ (const :tag "RC2 128 bits" "-rc2-128"))
+ :group 'smime)
+
+(defcustom smime-crl-check nil
+ "*Check revocation status of signers certificate using CRLs.
+Enabling this will have OpenSSL check the signers certificate
+against a certificate revocation list (CRL).
+
+For this to work the CRL must be up-to-date and since they are
+normally updated quite often (ie. several times a day) you
+probably need some tool to keep them up-to-date. Unfortunately
+Gnus cannot do this for you.
+
+The CRL should either be appended (in PEM format) to your
+`smime-CA-file' or be located in a file (also in PEM format) in
+your `smime-certificate-directory' named to the X.509 hash of the
+certificate with .r0 as file name extension.
+
+At least OpenSSL version 0.9.7 is required for this to work."
+ :type '(choice (const :tag "No check" nil)
+ (const :tag "Check certificate" "-crl_check")
+ (const :tag "Check certificate chain" "-crl_check_all"))
+ :group 'smime)
+
+(defcustom smime-dns-server nil
+ "*DNS server to query certificates from.
+If nil, use system defaults."
+ :type '(choice (const :tag "System defaults")
+ string)
+ :group 'smime)
+
+(defvar smime-details-buffer "*OpenSSL output*")
+
+;; Use mm-util?
+(eval-and-compile
+ (defalias 'smime-make-temp-file
+ (if (fboundp 'make-temp-file)
+ 'make-temp-file
+ (lambda (prefix &optional dir-flag) ;; Simple implementation
+ (expand-file-name
+ (make-temp-name prefix)
+ (if (fboundp 'temp-directory)
+ (temp-directory)
+ temporary-file-directory))))))
+
+;; Password dialog function
+
+(defun smime-ask-passphrase ()
+ "Asks the passphrase to unlock the secret key."
+ (let ((passphrase
+ (read-passwd
+ "Passphrase for secret key (RET for no passphrase): ")))
+ (if (string= passphrase "")
+ nil
+ passphrase)))
+
+;; OpenSSL wrappers.
+
+(defun smime-call-openssl-region (b e buf &rest args)
+ (case (apply 'call-process-region b e smime-openssl-program nil buf nil args)
+ (0 t)
+ (1 (message "OpenSSL: An error occurred parsing the command options.") nil)
+ (2 (message "OpenSSL: One of the input files could not be read.") nil)
+ (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil)
+ (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil)
+ (t (error "Unknown OpenSSL exitcode") nil)))
+
+(defun smime-make-certfiles (certfiles)
+ (if certfiles
+ (append (list "-certfile" (expand-file-name (car certfiles)))
+ (smime-make-certfiles (cdr certfiles)))))
+
+;; Sign+encrypt region
+
+(defun smime-sign-region (b e keyfile)
+ "Sign region with certified key in KEYFILE.
+If signing fails, the buffer is not modified. Region is assumed to
+have proper MIME tags. KEYFILE is expected to contain a PEM encoded
+private key and certificate as its car, and a list of additional
+certificates to include in its caar. If no additional certificates is
+included, KEYFILE may be the file containing the PEM encoded private
+key and certificate itself."
+ (smime-new-details-buffer)
+ (let ((keyfile (or (car-safe keyfile) keyfile))
+ (certfiles (and (cdr-safe keyfile) (cadr keyfile)))
+ (buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+ (passphrase (smime-ask-passphrase))
+ (tmpfile (smime-make-temp-file "smime")))
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
+ (prog1
+ (when (prog1
+ (apply 'smime-call-openssl-region b e (list buffer tmpfile)
+ "smime" "-sign" "-signer" (expand-file-name keyfile)
+ (append
+ (smime-make-certfiles certfiles)
+ (if passphrase
+ (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))))
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" "" t))
+ (with-current-buffer smime-details-buffer
+ (insert-file-contents tmpfile)
+ (delete-file tmpfile)))
+ (delete-region b e)
+ (insert-buffer-substring buffer)
+ (goto-char b)
+ (when (looking-at "^MIME-Version: 1.0$")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ t)
+ (with-current-buffer smime-details-buffer
+ (goto-char (point-max))
+ (insert-buffer-substring buffer))
+ (kill-buffer buffer))))
+
+(defun smime-encrypt-region (b e certfiles)
+ "Encrypt region for recipients specified in CERTFILES.
+If encryption fails, the buffer is not modified. Region is assumed to
+have proper MIME tags. CERTFILES is a list of filenames, each file
+is expected to contain of a PEM encoded certificate."
+ (smime-new-details-buffer)
+ (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+ (tmpfile (smime-make-temp-file "smime")))
+ (prog1
+ (when (prog1
+ (apply 'smime-call-openssl-region b e (list buffer tmpfile)
+ "smime" "-encrypt" smime-encrypt-cipher
+ (mapcar 'expand-file-name certfiles))
+ (with-current-buffer smime-details-buffer
+ (insert-file-contents tmpfile)
+ (delete-file tmpfile)))
+ (delete-region b e)
+ (insert-buffer-substring buffer)
+ (goto-char b)
+ (when (looking-at "^MIME-Version: 1.0$")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ t)
+ (with-current-buffer smime-details-buffer
+ (goto-char (point-max))
+ (insert-buffer-substring buffer))
+ (kill-buffer buffer))))
+
+;; Sign+encrypt buffer
+
+(defun smime-sign-buffer (&optional keyfile buffer)
+ "S/MIME sign BUFFER with key in KEYFILE.
+KEYFILE should contain a PEM encoded key and certificate."
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (smime-sign-region
+ (point-min) (point-max)
+ (if keyfile
+ keyfile
+ (smime-get-key-with-certs-by-email
+ (completing-read
+ (concat "Sign using which key? "
+ (if smime-keys (concat "(default " (caar smime-keys) ") ")
+ ""))
+ smime-keys nil nil (car-safe (car-safe smime-keys))))))))
+
+(defun smime-encrypt-buffer (&optional certfiles buffer)
+ "S/MIME encrypt BUFFER for recipients specified in CERTFILES.
+CERTFILES is a list of filenames, each file is expected to consist of
+a PEM encoded key and certificate. Uses current buffer if BUFFER is
+nil."
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (smime-encrypt-region
+ (point-min) (point-max)
+ (or certfiles
+ (list (read-file-name "Recipient's S/MIME certificate: "
+ smime-certificate-directory nil))))))
+
+;; Verify+decrypt region
+
+(defun smime-verify-region (b e)
+ "Verify S/MIME message in region between B and E.
+Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+ (smime-new-details-buffer)
+ (let ((CAs (append (if smime-CA-file
+ (list "-CAfile"
+ (expand-file-name smime-CA-file)))
+ (if smime-CA-directory
+ (list "-CApath"
+ (expand-file-name smime-CA-directory))))))
+ (unless CAs
+ (error "No CA configured"))
+ (if smime-crl-check
+ (add-to-list 'CAs smime-crl-check))
+ (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
+ "smime" "-verify" "-out" "/dev/null" CAs)
+ t
+ (insert-buffer-substring smime-details-buffer)
+ nil)))
+
+(defun smime-noverify-region (b e)
+ "Verify integrity of S/MIME message in region between B and E.
+Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+ (smime-new-details-buffer)
+ (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
+ "smime" "-verify" "-noverify" "-out" '("/dev/null"))
+ t
+ (insert-buffer-substring smime-details-buffer)
+ nil))
+
+(eval-when-compile
+ (defvar from))
+
+(defun smime-decrypt-region (b e keyfile)
+ "Decrypt S/MIME message in region between B and E with key in KEYFILE.
+On success, replaces region with decrypted data and return non-nil.
+Any details (stderr on success, stdout and stderr on error) are left
+in the buffer specified by `smime-details-buffer'."
+ (smime-new-details-buffer)
+ (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+ CAs (passphrase (smime-ask-passphrase))
+ (tmpfile (smime-make-temp-file "smime")))
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
+ (if (prog1
+ (apply 'smime-call-openssl-region b e
+ (list buffer tmpfile)
+ "smime" "-decrypt" "-recip" (expand-file-name keyfile)
+ (if passphrase
+ (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" "" t))
+ (with-current-buffer smime-details-buffer
+ (insert-file-contents tmpfile)
+ (delete-file tmpfile)))
+ (progn
+ (delete-region b e)
+ (when (boundp 'from)
+ ;; `from' is dynamically bound in mm-dissect.
+ (insert "From: " from "\n"))
+ (insert-buffer-substring buffer)
+ (kill-buffer buffer)
+ t)
+ (with-current-buffer smime-details-buffer
+ (insert-buffer-substring buffer))
+ (kill-buffer buffer)
+ (delete-region b e)
+ (insert-buffer-substring smime-details-buffer)
+ nil)))
+
+;; Verify+Decrypt buffer
+
+(defun smime-verify-buffer (&optional buffer)
+ "Verify integrity of S/MIME message in BUFFER.
+Uses current buffer if BUFFER is nil. Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (smime-verify-region (point-min) (point-max))))
+
+(defun smime-noverify-buffer (&optional buffer)
+ "Verify integrity of S/MIME message in BUFFER.
+Does NOT verify validity of certificate (only message integrity).
+Uses current buffer if BUFFER is nil. Returns non-nil on success.
+Any details (stdout and stderr) are left in the buffer specified by
+`smime-details-buffer'."
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (smime-noverify-region (point-min) (point-max))))
+
+(defun smime-decrypt-buffer (&optional buffer keyfile)
+ "Decrypt S/MIME message in BUFFER using KEYFILE.
+Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil.
+On success, replaces data in buffer and return non-nil.
+Any details (stderr on success, stdout and stderr on error) are left
+in the buffer specified by `smime-details-buffer'."
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (smime-decrypt-region
+ (point-min) (point-max)
+ (expand-file-name
+ (or keyfile
+ (smime-get-key-by-email
+ (completing-read
+ (concat "Decipher using which key? "
+ (if smime-keys (concat "(default " (caar smime-keys) ") ")
+ ""))
+ smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
+
+;; Various operations
+
+(defun smime-new-details-buffer ()
+ (with-current-buffer (get-buffer-create smime-details-buffer)
+ (erase-buffer)))
+
+(defun smime-pkcs7-region (b e)
+ "Convert S/MIME message between points B and E into a PKCS7 message."
+ (smime-new-details-buffer)
+ (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out")
+ (delete-region b e)
+ (insert-buffer-substring smime-details-buffer)
+ t))
+
+(defun smime-pkcs7-certificates-region (b e)
+ "Extract any certificates enclosed in PKCS7 message between points B and E."
+ (smime-new-details-buffer)
+ (when (smime-call-openssl-region
+ b e smime-details-buffer "pkcs7" "-print_certs" "-text")
+ (delete-region b e)
+ (insert-buffer-substring smime-details-buffer)
+ t))
+
+(defun smime-pkcs7-email-region (b e)
+ "Get email addresses contained in certificate between points B and E.
+A string or a list of strings is returned."
+ (smime-new-details-buffer)
+ (when (smime-call-openssl-region
+ b e smime-details-buffer "x509" "-email" "-noout")
+ (delete-region b e)
+ (insert-buffer-substring smime-details-buffer)
+ t))
+
+;; Utility functions
+
+(defun smime-get-certfiles (keyfile keys)
+ (if keys
+ (let ((curkey (car keys))
+ (otherkeys (cdr keys)))
+ (if (string= keyfile (cadr curkey))
+ (caddr curkey)
+ (smime-get-certfiles keyfile otherkeys)))))
+
+;; Use mm-util?
+(eval-and-compile
+ (defalias 'smime-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position)))
+
+(defun smime-buffer-as-string-region (b e)
+ "Return each line in region between B and E as a list of strings."
+ (save-excursion
+ (goto-char b)
+ (let (res)
+ (while (< (point) e)
+ (let ((str (buffer-substring (point) (smime-point-at-eol))))
+ (unless (string= "" str)
+ (push str res)))
+ (forward-line))
+ res)))
+
+;; Find certificates
+
+(defun smime-mail-to-domain (mailaddr)
+ (if (string-match "@" mailaddr)
+ (replace-match "." 'fixedcase 'literal mailaddr)
+ mailaddr))
+
+(defun smime-cert-by-dns (mail)
+ (let* ((dig-dns-server smime-dns-server)
+ (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
+ (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
+ (certrr (with-current-buffer digbuf
+ (dig-extract-rr (smime-mail-to-domain mail) "cert")))
+ (cert (and certrr (dig-rr-get-pkix-cert certrr))))
+ (if cert
+ (with-current-buffer retbuf
+ (insert "-----BEGIN CERTIFICATE-----\n")
+ (let ((i 0) (len (length cert)))
+ (while (> (- len 64) i)
+ (insert (substring cert i (+ i 64)) "\n")
+ (setq i (+ i 64)))
+ (insert (substring cert i len) "\n"))
+ (insert "-----END CERTIFICATE-----\n"))
+ (kill-buffer retbuf)
+ (setq retbuf nil))
+ (kill-buffer digbuf)
+ retbuf))
+
+;; User interface.
+
+(defvar smime-buffer "*SMIME*")
+
+(defvar smime-mode-map nil)
+(put 'smime-mode 'mode-class 'special)
+
+(unless smime-mode-map
+ (setq smime-mode-map (make-sparse-keymap))
+ (suppress-keymap smime-mode-map)
+
+ (define-key smime-mode-map "q" 'smime-exit)
+ (define-key smime-mode-map "f" 'smime-certificate-info))
+
+(defun smime-mode ()
+ "Major mode for browsing, viewing and fetching certificates.
+
+All normal editing commands are switched off.
+\\<smime-mode-map>
+
+The following commands are available:
+
+\\{smime-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'smime-mode)
+ (setq mode-name "SMIME")
+ (setq mode-line-process nil)
+ (use-local-map smime-mode-map)
+ (buffer-disable-undo)
+ (setq truncate-lines t)
+ (setq buffer-read-only t))
+
+(defun smime-certificate-info (certfile)
+ (interactive "fCertificate file: ")
+ (let ((buffer (get-buffer-create (format "*certificate %s*" certfile))))
+ (switch-to-buffer buffer)
+ (erase-buffer)
+ (call-process smime-openssl-program nil buffer 'display
+ "x509" "-in" (expand-file-name certfile) "-text")
+ (fundamental-mode)
+ (set-buffer-modified-p nil)
+ (toggle-read-only t)
+ (goto-char (point-min))))
+
+(defun smime-draw-buffer ()
+ (with-current-buffer smime-buffer
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert "\nYour keys:\n")
+ (dolist (key smime-keys)
+ (insert
+ (format "\t\t%s: %s\n" (car key) (cadr key))))
+ (insert "\nTrusted Certificate Authoritys:\n")
+ (insert "\nKnown Certificates:\n"))))
+
+(defun smime ()
+ "Go to the SMIME buffer."
+ (interactive)
+ (unless (get-buffer smime-buffer)
+ (save-excursion
+ (set-buffer (get-buffer-create smime-buffer))
+ (smime-mode)))
+ (smime-draw-buffer)
+ (switch-to-buffer smime-buffer))
+
+(defun smime-exit ()
+ "Quit the S/MIME buffer."
+ (interactive)
+ (kill-buffer (current-buffer)))
+
+;; Other functions
+
+(defun smime-get-key-by-email (email)
+ (cadr (assoc email smime-keys)))
+
+(defun smime-get-key-with-certs-by-email (email)
+ (cdr (assoc email smime-keys)))
+
+(provide 'smime)
+
+;;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e
+;;; smime.el ends here
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
new file mode 100644
index 00000000000..edfd2e0ae73
--- /dev/null
+++ b/lisp/gnus/spam-report.el
@@ -0,0 +1,127 @@
+;;; spam-report.el --- Reporting spam
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Keywords: network
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module addresses a few aspects of spam reporting under Gnus. Page
+;;; breaks are used for grouping declarations and documentation relating to
+;;; each particular aspect.
+
+;;; Code:
+(require 'gnus)
+(require 'gnus-sum)
+
+(eval-and-compile
+ (autoload 'mm-url-insert "mm-url"))
+
+(defgroup spam-report nil
+ "Spam reporting configuration.")
+
+(defcustom spam-report-gmane-regex nil
+ "Regexp matching Gmane newsgroups, e.g. \"^nntp\\+.*:gmane\\.\"
+If you are using spam.el, consider setting gnus-spam-process-newsgroups
+or the gnus-group-spam-exit-processor-report-gmane group/topic parameter
+instead."
+ :type '(radio (const nil)
+ (regexp :format "%t: %v\n" :size 0 :value "^nntp\+.*:gmane\."))
+ :group 'spam-report)
+
+(defcustom spam-report-gmane-spam-header
+ "^X-Report-Spam: http://\\([^/]+\\)\\(.*\\)$"
+ "String matching Gmane spam-reporting header. Two match groups are needed."
+ :type 'regexp
+ :group 'spam-report)
+
+(defcustom spam-report-gmane-use-article-number t
+ "Whether the article number (faster!) or the header should be used."
+ :type 'boolean
+ :group 'spam-report)
+
+(defcustom spam-report-url-ping-function
+ 'spam-report-url-ping-plain
+ "Function to use for url ping spam reporting."
+ :type '(choice
+ (const :tag "Connect directly"
+ spam-report-url-ping-plain)
+ (const :tag "Use the external program specified in `mm-url-program'"
+ spam-report-url-ping-mm-url))
+ :group 'spam-report)
+
+(defun spam-report-gmane (&rest articles)
+ "Report an article as spam through Gmane"
+ (dolist (article articles)
+ (when (and gnus-newsgroup-name
+ (or (null spam-report-gmane-regex)
+ (string-match spam-report-gmane-regex gnus-newsgroup-name)))
+ (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article)
+ (if spam-report-gmane-use-article-number
+ (spam-report-url-ping "spam.gmane.org"
+ (format "/%s:%d"
+ (gnus-group-real-name gnus-newsgroup-name)
+ article))
+ (with-current-buffer nntp-server-buffer
+ (gnus-request-head article gnus-newsgroup-name)
+ (goto-char (point-min))
+ (if (re-search-forward spam-report-gmane-spam-header nil t)
+ (let* ((host (match-string 1))
+ (report (match-string 2))
+ (url (format "http://%s%s" host report)))
+ (gnus-message 7 "Reporting spam through URL %s..." url)
+ (spam-report-url-ping host report))
+ (gnus-message 3 "Could not find X-Report-Spam in article %d..."
+ article)))))))
+
+(defun spam-report-url-ping (host report)
+ "Ping a host through HTTP, addressing a specific GET resource using
+the function specified by `spam-report-url-ping-function'."
+ (funcall spam-report-url-ping-function host report))
+
+(defun spam-report-url-ping-plain (host report)
+ "Ping a host through HTTP, addressing a specific GET resource."
+ (let ((tcp-connection))
+ (with-temp-buffer
+ (or (setq tcp-connection
+ (open-network-stream
+ "URL ping"
+ (buffer-name)
+ host
+ 80))
+ (error "Could not open connection to %s" host))
+ (set-marker (process-mark tcp-connection) (point-min))
+ (process-send-string
+ tcp-connection
+ (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n"
+ report (gnus-emacs-version) host)))))
+
+(defun spam-report-url-ping-mm-url (host report)
+ "Ping a host through HTTP, addressing a specific GET resource. Use
+the external program specified in `mm-url-program' to connect to
+server."
+ (with-temp-buffer
+ (let ((url (concat "http://" host "/" report)))
+ (mm-url-insert url t))))
+
+(provide 'spam-report)
+
+;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022
+;;; spam-report.el ends here.
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
new file mode 100644
index 00000000000..9e20a51b127
--- /dev/null
+++ b/lisp/gnus/spam-stat.el
@@ -0,0 +1,600 @@
+;;; spam-stat.el --- detecting spam based on statistics
+
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Alex Schroeder <alex@gnu.org>
+;; Keywords: network
+;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
+
+;; This file is part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This implements spam analysis according to Paul Graham in "A Plan
+;; for Spam". The basis for all this is a statistical distribution of
+;; words for your spam and non-spam mails. We need this information
+;; in a hash-table so that the analysis can use the information when
+;; looking at your mails. Therefore, before you begin, you need tons
+;; of mails (Graham uses 4000 non-spam and 4000 spam mails for his
+;; experiments).
+;;
+;; The main interface to using spam-stat, are the following functions:
+;;
+;; `spam-stat-buffer-is-spam' -- called in a buffer, that buffer is
+;; considered to be a new spam mail; use this for new mail that has
+;; not been processed before
+;;
+;; `spam-stat-buffer-is-non-spam' -- called in a buffer, that buffer
+;; is considered to be a new non-spam mail; use this for new mail that
+;; has not been processed before
+;;
+;; `spam-stat-buffer-change-to-spam' -- called in a buffer, that
+;; buffer is no longer considered to be normal mail but spam; use this
+;; to change the status of a mail that has already been processed as
+;; non-spam
+;;
+;; `spam-stat-buffer-change-to-non-spam' -- called in a buffer, that
+;; buffer is no longer considered to be spam but normal mail; use this
+;; to change the status of a mail that has already been processed as
+;; spam
+;;
+;; `spam-stat-save' -- save the hash table to the file; the filename
+;; used is stored in the variable `spam-stat-file'
+;;
+;; `spam-stat-load' -- load the hash table from a file; the filename
+;; used is stored in the variable `spam-stat-file'
+;;
+;; `spam-stat-score-word' -- return the spam score for a word
+;;
+;; `spam-stat-score-buffer' -- return the spam score for a buffer
+;;
+;; `spam-stat-split-fancy' -- for fancy mail splitting; add
+;; the rule (: spam-stat-split-fancy) to `nnmail-split-fancy'
+;;
+;; This requires the following in your ~/.gnus file:
+;;
+;; (require 'spam-stat)
+;; (spam-stat-load)
+
+;;; Testing:
+
+;; Typical test will involve calls to the following functions:
+;;
+;; Reset: (spam-stat-reset)
+;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+;; Save table: (spam-stat-save)
+;; File size: (nth 7 (file-attributes spam-stat-file))
+;; Number of words: (hash-table-count spam-stat)
+;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+;; Reduce table size: (spam-stat-reduce-size)
+;; Save table: (spam-stat-save)
+;; File size: (nth 7 (file-attributes spam-stat-file))
+;; Number of words: (hash-table-count spam-stat)
+;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
+;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
+
+;;; Dictionary Creation:
+
+;; Typically, you will filter away mailing lists etc. using specific
+;; rules in `nnmail-split-fancy'. Somewhere among these rules, you
+;; will filter spam. Here is how you would create your dictionary:
+
+;; Reset: (spam-stat-reset)
+;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
+;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
+;; Repeat for any other non-spam group you need...
+;; Reduce table size: (spam-stat-reduce-size)
+;; Save table: (spam-stat-save)
+
+;;; Todo:
+
+;; Speed it up. Integrate with Gnus such that it uses spam and expiry
+;; marks to call the appropriate functions when leaving the summary
+;; buffer and saves the hash table when leaving Gnus. More testing:
+;; More mails, disabling SpamAssassin, double checking algorithm, find
+;; improved algorithm.
+
+;;; Thanks:
+
+;; Ted Zlatanov <tzz@lifelogs.com>
+;; Jesper Harder <harder@myrealbox.com>
+;; Dan Schmidt <dfan@dfan.org>
+;; Lasse Rasinen <lrasinen@iki.fi>
+;; Milan Zamazal <pdm@zamazal.org>
+
+
+
+;;; Code:
+
+(defgroup spam-stat nil
+ "Statistical spam detection for Emacs.
+Use the functions to build a dictionary of words and their statistical
+distribution in spam and non-spam mails. Then use a function to determine
+whether a buffer contains spam or not."
+ :group 'gnus)
+
+(defcustom spam-stat-file "~/.spam-stat.el"
+ "File used to save and load the dictionary.
+See `spam-stat-to-hash-table' for the format of the file."
+ :type 'file
+ :group 'spam-stat)
+
+(defcustom spam-stat-install-hooks t
+ "Whether spam-stat should install its hooks in Gnus.
+This is set to nil if you use spam-stat through spam.el."
+ :type 'boolean
+ :group 'spam-stat)
+
+(defcustom spam-stat-unknown-word-score 0.2
+ "The score to use for unknown words.
+Also used for words that don't appear often enough."
+ :type 'number
+ :group 'spam-stat)
+
+(defcustom spam-stat-max-word-length 15
+ "Only words shorter than this will be considered."
+ :type 'integer
+ :group 'spam-stat)
+
+(defcustom spam-stat-max-buffer-length 10240
+ "Only the beginning of buffers will be analyzed.
+This variable says how many characters this will be."
+ :type 'integer
+ :group 'spam-stat)
+
+(defcustom spam-stat-split-fancy-spam-group "mail.spam"
+ "Name of the group where spam should be stored, if
+`spam-stat-split-fancy' is used in fancy splitting rules. Has no
+effect when spam-stat is invoked through spam.el."
+ :type 'string
+ :group 'spam-stat)
+
+(defcustom spam-stat-split-fancy-spam-threshhold 0.9
+ "Spam score threshhold in spam-stat-split-fancy."
+ :type 'number
+ :group 'spam-stat)
+
+(defvar spam-stat-syntax-table
+ (let ((table (copy-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?- "w" table)
+ (modify-syntax-entry ?_ "w" table)
+ (modify-syntax-entry ?. "w" table)
+ (modify-syntax-entry ?! "w" table)
+ (modify-syntax-entry ?? "w" table)
+ (modify-syntax-entry ?+ "w" table)
+ table)
+ "Syntax table used when processing mails for statistical analysis.
+The important part is which characters are word constituents.")
+
+(defvar spam-stat-dirty nil
+ "Whether the spam-stat database needs saving.")
+
+(defvar spam-stat-buffer nil
+ "Buffer to use for scoring while splitting.
+This is set by hooking into Gnus.")
+
+(defvar spam-stat-buffer-name " *spam stat buffer*"
+ "Name of the `spam-stat-buffer'.")
+
+;; Functions missing in Emacs 20
+
+(when (memq nil (mapcar 'fboundp
+ '(gethash hash-table-count make-hash-table
+ mapc puthash)))
+ (require 'cl)
+ (unless (fboundp 'puthash)
+ ;; alias puthash is missing from Emacs 20 cl-extra.el
+ (defalias 'puthash 'cl-puthash)))
+
+(eval-when-compile
+ (unless (fboundp 'with-syntax-table)
+ ;; Imported from Emacs 21.2
+ (defmacro with-syntax-table (table &rest body) "\
+Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (let ((old-table (make-symbol "table"))
+ (old-buffer (make-symbol "buffer")))
+ `(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table (copy-syntax-table ,table))
+ ,@body)
+ (save-current-buffer
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table))))))))
+
+;; Hooking into Gnus
+
+(defun spam-stat-store-current-buffer ()
+ "Store a copy of the current buffer in `spam-stat-buffer'."
+ (save-excursion
+ (let ((str (buffer-string)))
+ (set-buffer (get-buffer-create spam-stat-buffer-name))
+ (erase-buffer)
+ (insert str)
+ (setq spam-stat-buffer (current-buffer)))))
+
+(defun spam-stat-store-gnus-article-buffer ()
+ "Store a copy of the current article in `spam-stat-buffer'.
+This uses `gnus-article-buffer'."
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (spam-stat-store-current-buffer)))
+
+;; Data -- not using defstruct in order to save space and time
+
+(defvar spam-stat (make-hash-table :test 'equal)
+ "Hash table used to store the statistics.
+Use `spam-stat-load' to load the file.
+Every word is used as a key in this table. The value is a vector.
+Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
+`spam-stat-bad', and `spam-stat-score' to access this vector.")
+
+(defvar spam-stat-ngood 0
+ "The number of good mails in the dictionary.")
+
+(defvar spam-stat-nbad 0
+ "The number of bad mails in the dictionary.")
+
+(defsubst spam-stat-good (entry)
+ "Return the number of times this word belongs to good mails."
+ (aref entry 0))
+
+(defsubst spam-stat-bad (entry)
+ "Return the number of times this word belongs to bad mails."
+ (aref entry 1))
+
+(defsubst spam-stat-score (entry)
+ "Set the score of this word."
+ (if entry
+ (aref entry 2)
+ spam-stat-unknown-word-score))
+
+(defsubst spam-stat-set-good (entry value)
+ "Set the number of times this word belongs to good mails."
+ (aset entry 0 value))
+
+(defsubst spam-stat-set-bad (entry value)
+ "Set the number of times this word belongs to bad mails."
+ (aset entry 1 value))
+
+(defsubst spam-stat-set-score (entry value)
+ "Set the score of this word."
+ (aset entry 2 value))
+
+(defsubst spam-stat-make-entry (good bad)
+ "Return a vector with the given properties."
+ (let ((entry (vector good bad nil)))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ entry))
+
+;; Computing
+
+(defun spam-stat-compute-score (entry)
+ "Compute the score of this word. 1.0 means spam."
+ ;; promote all numbers to floats for the divisions
+ (let* ((g (* 2.0 (spam-stat-good entry)))
+ (b (float (spam-stat-bad entry))))
+ (cond ((< (+ g b) 5)
+ .2)
+ ((= 0 spam-stat-ngood)
+ .99)
+ ((= 0 spam-stat-nbad)
+ .01)
+ (t
+ (max .01
+ (min .99 (/ (/ b spam-stat-nbad)
+ (+ (/ g spam-stat-ngood)
+ (/ b spam-stat-nbad)))))))))
+
+;; Parsing
+
+(defmacro with-spam-stat-max-buffer-size (&rest body)
+ "Narrows the buffer down to the first 4k characters, then evaluates BODY."
+ `(save-restriction
+ (when (> (- (point-max)
+ (point-min))
+ spam-stat-max-buffer-length)
+ (narrow-to-region (point-min)
+ (+ (point-min) spam-stat-max-buffer-length)))
+ ,@body))
+
+(defun spam-stat-buffer-words ()
+ "Return a hash table of words and number of occurences in the buffer."
+ (with-spam-stat-max-buffer-size
+ (with-syntax-table spam-stat-syntax-table
+ (goto-char (point-min))
+ (let ((result (make-hash-table :test 'equal))
+ word count)
+ (while (re-search-forward "\\w+" nil t)
+ (setq word (match-string-no-properties 0)
+ count (1+ (gethash word result 0)))
+ (when (< (length word) spam-stat-max-word-length)
+ (puthash word count result)))
+ result))))
+
+(defun spam-stat-buffer-is-spam ()
+ "Consider current buffer to be a new spam mail."
+ (setq spam-stat-nbad (1+ spam-stat-nbad))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if entry
+ (spam-stat-set-bad entry (+ count (spam-stat-bad entry)))
+ (setq entry (spam-stat-make-entry 0 count)))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
+
+(defun spam-stat-buffer-is-non-spam ()
+ "Consider current buffer to be a new non-spam mail."
+ (setq spam-stat-ngood (1+ spam-stat-ngood))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if entry
+ (spam-stat-set-good entry (+ count (spam-stat-good entry)))
+ (setq entry (spam-stat-make-entry count 0)))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
+
+(defun spam-stat-buffer-change-to-spam ()
+ "Consider current buffer no longer normal mail but spam."
+ (setq spam-stat-nbad (1+ spam-stat-nbad)
+ spam-stat-ngood (1- spam-stat-ngood))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if (not entry)
+ (error "This buffer has unknown words in it.")
+ (spam-stat-set-good entry (- (spam-stat-good entry) count))
+ (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat))))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
+
+(defun spam-stat-buffer-change-to-non-spam ()
+ "Consider current buffer no longer spam but normal mail."
+ (setq spam-stat-nbad (1- spam-stat-nbad)
+ spam-stat-ngood (1+ spam-stat-ngood))
+ (maphash
+ (lambda (word count)
+ (let ((entry (gethash word spam-stat)))
+ (if (not entry)
+ (error "This buffer has unknown words in it.")
+ (spam-stat-set-good entry (+ (spam-stat-good entry) count))
+ (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
+ (spam-stat-set-score entry (spam-stat-compute-score entry))
+ (puthash word entry spam-stat))))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
+
+;; Saving and Loading
+
+(defun spam-stat-save (&optional force)
+ "Save the `spam-stat' hash table as lisp file.
+With a prefix argument save unconditionally."
+ (interactive "P")
+ (when (or force spam-stat-dirty)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer))
+ (font-lock-maximum-size 0))
+ (insert "(setq spam-stat-ngood "
+ (number-to-string spam-stat-ngood)
+ " spam-stat-nbad "
+ (number-to-string spam-stat-nbad)
+ " spam-stat (spam-stat-to-hash-table '(")
+ (maphash (lambda (word entry)
+ (prin1 (list word
+ (spam-stat-good entry)
+ (spam-stat-bad entry))))
+ spam-stat)
+ (insert ")))")
+ (write-file spam-stat-file)))
+ (setq spam-stat-dirty nil)))
+
+(defun spam-stat-load ()
+ "Read the `spam-stat' hash table from disk."
+ ;; TODO: maybe we should warn the user if spam-stat-dirty is t?
+ (load-file spam-stat-file)
+ (setq spam-stat-dirty nil))
+
+(defun spam-stat-to-hash-table (entries)
+ "Turn list ENTRIES into a hash table and store as `spam-stat'.
+Every element in ENTRIES has the form \(WORD GOOD BAD) where WORD is
+the word string, NGOOD is the number of good mails it has appeared in,
+NBAD is the number of bad mails it has appeared in, GOOD is the number
+of times it appeared in good mails, and BAD is the number of times it
+has appeared in bad mails."
+ (let ((table (make-hash-table :test 'equal)))
+ (mapc (lambda (l)
+ (puthash (car l)
+ (spam-stat-make-entry (nth 1 l) (nth 2 l))
+ table))
+ entries)
+ table))
+
+(defun spam-stat-reset ()
+ "Reset `spam-stat' to an empty hash-table.
+This deletes all the statistics."
+ (interactive)
+ (setq spam-stat (make-hash-table :test 'equal)
+ spam-stat-ngood 0
+ spam-stat-nbad 0)
+ (setq spam-stat-dirty t))
+
+;; Scoring buffers
+
+(defvar spam-stat-score-data nil
+ "Raw data used in the last run of `spam-stat-score-buffer'.")
+
+(defsubst spam-stat-score-word (word)
+ "Return score for WORD.
+The default score for unknown words is stored in
+`spam-stat-unknown-word-score'."
+ (spam-stat-score (gethash word spam-stat)))
+
+(defun spam-stat-buffer-words-with-scores ()
+ "Process current buffer, return the 15 most conspicuous words.
+These are the words whose spam-stat differs the most from 0.5.
+The list returned contains elements of the form \(WORD SCORE DIFF),
+where DIFF is the difference between SCORE and 0.5."
+ (with-spam-stat-max-buffer-size
+ (with-syntax-table spam-stat-syntax-table
+ (let (result word score)
+ (maphash (lambda (word ignore)
+ (setq score (spam-stat-score-word word)
+ result (cons (list word score (abs (- score 0.5)))
+ result)))
+ (spam-stat-buffer-words))
+ (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a)))))
+ (setcdr (nthcdr 14 result) nil)
+ result))))
+
+(defun spam-stat-score-buffer ()
+ "Return a score describing the spam-probability for this buffer."
+ (setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
+ (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data))
+ (prod (apply #'* probs)))
+ (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
+ probs))))))
+
+(defun spam-stat-split-fancy ()
+ "Return the name of the spam group if the current mail is spam.
+Use this function on `nnmail-split-fancy'. If you are interested in
+the raw data used for the last run of `spam-stat-score-buffer',
+check the variable `spam-stat-score-data'."
+ (condition-case var
+ (progn
+ (set-buffer spam-stat-buffer)
+ (goto-char (point-min))
+ (when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshhold)
+ (when (boundp 'nnmail-split-trace)
+ (mapc (lambda (entry)
+ (push entry nnmail-split-trace))
+ spam-stat-score-data))
+ spam-stat-split-fancy-spam-group))
+ (error (message "Error in spam-stat-split-fancy: %S" var)
+ nil)))
+
+;; Testing
+
+(defun spam-stat-process-directory (dir func)
+ "Process all the regular files in directory DIR using function FUNC."
+ (let* ((files (directory-files dir t "^[^.]"))
+ (max (/ (length files) 100.0))
+ (count 0))
+ (with-temp-buffer
+ (dolist (f files)
+ (when (and (file-readable-p f)
+ (file-regular-p f)
+ (> (nth 7 (file-attributes f)) 0))
+ (setq count (1+ count))
+ (message "Reading %s: %.2f%%" dir (/ count max))
+ (insert-file-contents f)
+ (funcall func)
+ (erase-buffer))))))
+
+(defun spam-stat-process-spam-directory (dir)
+ "Process all the regular files in directory DIR as spam."
+ (interactive "D")
+ (spam-stat-process-directory dir 'spam-stat-buffer-is-spam))
+
+(defun spam-stat-process-non-spam-directory (dir)
+ "Process all the regular files in directory DIR as non-spam."
+ (interactive "D")
+ (spam-stat-process-directory dir 'spam-stat-buffer-is-non-spam))
+
+(defun spam-stat-count ()
+ "Return size of `spam-stat'."
+ (interactive)
+ (hash-table-count spam-stat))
+
+(defun spam-stat-test-directory (dir)
+ "Test all the regular files in directory DIR for spam.
+If the result is 1.0, then all files are considered spam.
+If the result is 0.0, non of the files is considered spam.
+You can use this to determine error rates."
+ (interactive "D")
+ (let* ((files (directory-files dir t "^[^.]"))
+ (total (length files))
+ (score 0.0); float
+ (max (/ total 100.0)); float
+ (count 0))
+ (with-temp-buffer
+ (dolist (f files)
+ (when (and (file-readable-p f)
+ (file-regular-p f)
+ (> (nth 7 (file-attributes f)) 0))
+ (setq count (1+ count))
+ (message "Reading %.2f%%, score %.2f%%"
+ (/ count max) (/ score count))
+ (insert-file-contents f)
+ (when (> (spam-stat-score-buffer) 0.9)
+ (setq score (1+ score)))
+ (erase-buffer))))
+ (message "Final score: %d / %d = %f" score total (/ score total))))
+
+;; Shrinking the dictionary
+
+(defun spam-stat-reduce-size (&optional count)
+ "Reduce the size of `spam-stat'.
+This removes all words that occur less than COUNT from the dictionary.
+COUNT defaults to 5"
+ (interactive)
+ (setq count (or count 5))
+ (maphash (lambda (key entry)
+ (when (< (+ (spam-stat-good entry)
+ (spam-stat-bad entry))
+ count)
+ (remhash key spam-stat)))
+ spam-stat)
+ (setq spam-stat-dirty t))
+
+(defun spam-stat-install-hooks-function ()
+ "Install the spam-stat function hooks"
+ (interactive)
+ (add-hook 'nnmail-prepare-incoming-message-hook
+ 'spam-stat-store-current-buffer)
+ (add-hook 'gnus-select-article-hook
+ 'spam-stat-store-gnus-article-buffer))
+
+(when spam-stat-install-hooks
+ (spam-stat-install-hooks-function))
+
+(defun spam-stat-unload-hook ()
+ "Uninstall the spam-stat function hooks"
+ (interactive)
+ (remove-hook 'nnmail-prepare-incoming-message-hook
+ 'spam-stat-store-current-buffer)
+ (remove-hook 'gnus-select-article-hook
+ 'spam-stat-store-gnus-article-buffer))
+
+(provide 'spam-stat)
+
+;;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554
+;;; spam-stat.el ends here
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
new file mode 100644
index 00000000000..6fb99db157a
--- /dev/null
+++ b/lisp/gnus/spam.el
@@ -0,0 +1,1827 @@
+;;; spam.el --- Identifying spam
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: network
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; This module addresses a few aspects of spam control under Gnus. Page
+;;; breaks are used for grouping declarations and documentation relating to
+;;; each particular aspect.
+
+;;; The integration with Gnus is not yet complete. See various `FIXME'
+;;; comments, below, for supplementary explanations or discussions.
+
+;;; Several TODO items are marked as such
+
+;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting,
+;; remote processing, training through files
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus-sum)
+
+(require 'gnus-uu) ; because of key prefix issues
+;;; for the definitions of group content classification and spam processors
+(require 'gnus)
+(require 'message) ;for the message-fetch-field functions
+
+;; for nnimap-split-download-body-default
+(eval-when-compile (require 'nnimap))
+
+;; autoload executable-find
+(eval-and-compile
+ ;; executable-find is not autoloaded in Emacs 20
+ (autoload 'executable-find "executable"))
+
+;; autoload query-dig
+(eval-and-compile
+ (autoload 'query-dig "dig"))
+
+;; autoload spam-report
+(eval-and-compile
+ (autoload 'spam-report-gmane "spam-report"))
+
+;; autoload gnus-registry
+(eval-and-compile
+ (autoload 'gnus-registry-group-count "gnus-registry")
+ (autoload 'gnus-registry-add-group "gnus-registry")
+ (autoload 'gnus-registry-store-extra-entry "gnus-registry")
+ (autoload 'gnus-registry-fetch-extra "gnus-registry"))
+
+;; autoload query-dns
+(eval-and-compile
+ (autoload 'query-dns "dns"))
+
+;;; Main parameters.
+
+(defgroup spam nil
+ "Spam configuration.")
+
+(defcustom spam-directory "~/News/spam/"
+ "Directory for spam whitelists and blacklists."
+ :type 'directory
+ :group 'spam)
+
+(defcustom spam-move-spam-nonspam-groups-only t
+ "Whether spam should be moved in non-spam groups only.
+When t, only ham and unclassified groups will have their spam moved
+to the spam-process-destination. When nil, spam will also be moved from
+spam groups."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-process-ham-in-nonham-groups nil
+ "Whether ham should be processed in non-ham groups."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-log-to-registry nil
+ "Whether spam/ham processing should be logged in the registry."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-split-symbolic-return nil
+ "Whether `spam-split' should work with symbols or group names."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-split-symbolic-return-positive nil
+ "Whether `spam-split' should ALWAYS work with symbols or group names.
+Do not set this if you use `spam-split' in a fancy split
+ method."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-process-ham-in-spam-groups nil
+ "Whether ham should be processed in spam groups."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-mark-only-unseen-as-spam t
+ "Whether only unseen articles should be marked as spam in spam groups.
+When nil, all unread articles in a spam group are marked as
+spam. Set this if you want to leave an article unread in a spam group
+without losing it to the automatic spam-marking process."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-mark-ham-unread-before-move-from-spam-group nil
+ "Whether ham should be marked unread before it's moved.
+The article is moved out of a spam group according to ham-process-destination.
+This variable is an official entry in the international Longest Variable Name
+Competition."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-disable-spam-split-during-ham-respool nil
+ "Whether `spam-split' should be ignored while resplitting ham in a process
+destination. This is useful to prevent ham from ending up in the same spam
+group after the resplit. Don't set this to t if you have spam-split as the
+last rule in your split configuration."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-autodetect-recheck-messages nil
+ "Should spam.el recheck all meessages when autodetecting?
+Normally this is nil, so only unseen messages will be checked."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
+ "The location of the whitelist.
+The file format is one regular expression per line.
+The regular expression is matched against the address."
+ :type 'file
+ :group 'spam)
+
+(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
+ "The location of the blacklist.
+The file format is one regular expression per line.
+The regular expression is matched against the address."
+ :type 'file
+ :group 'spam)
+
+(defcustom spam-use-dig t
+ "Whether `query-dig' should be used instead of `query-dns'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-blacklist nil
+ "Whether the blacklist should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-blacklist-ignored-regexes nil
+ "Regular expressions that the blacklist should ignore."
+ :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
+ :group 'spam)
+
+(defcustom spam-use-whitelist nil
+ "Whether the whitelist should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-whitelist-exclusive nil
+ "Whether whitelist-exclusive should be used by `spam-split'.
+Exclusive whitelisting means that all messages from senders not in the whitelist
+are considered spam."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-blackholes nil
+ "Whether blackholes should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-hashcash nil
+ "Whether hashcash payments should be detected by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-regex-headers nil
+ "Whether a header regular expression match should be used by `spam-split'.
+Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-regex-body nil
+ "Whether a body regular expression match should be used by `spam-split'.
+Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-bogofilter-headers nil
+ "Whether bogofilter headers should be used by `spam-split'.
+Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-bogofilter nil
+ "Whether bogofilter should be invoked by `spam-split'.
+Enable this if you want Gnus to invoke Bogofilter on new messages."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-BBDB nil
+ "Whether BBDB should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-BBDB-exclusive nil
+ "Whether BBDB-exclusive should be used by `spam-split'.
+Exclusive BBDB means that all messages from senders not in the BBDB are
+considered spam."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-ifile nil
+ "Whether ifile should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-stat nil
+ "Whether `spam-stat' should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-use-spamoracle nil
+ "Whether spamoracle should be used by `spam-split'."
+ :type 'boolean
+ :group 'spam)
+
+(defcustom spam-install-hooks (or
+ spam-use-dig
+ spam-use-blacklist
+ spam-use-whitelist
+ spam-use-whitelist-exclusive
+ spam-use-blackholes
+ spam-use-hashcash
+ spam-use-regex-headers
+ spam-use-regex-body
+ spam-use-bogofilter-headers
+ spam-use-bogofilter
+ spam-use-BBDB
+ spam-use-BBDB-exclusive
+ spam-use-ifile
+ spam-use-stat
+ spam-use-spamoracle)
+ "Whether the spam hooks should be installed.
+Default to t if one of the spam-use-* variables is set."
+ :group 'spam
+ :type 'boolean)
+
+(defcustom spam-split-group "spam"
+ "Group name where incoming spam should be put by `spam-split'."
+ :type 'string
+ :group 'spam)
+
+;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
+;;; not regular expressions
+(defcustom spam-junk-mailgroups (cons
+ spam-split-group
+ '("mail.junk" "poste.pourriel"))
+ "Mailgroups with spam contents.
+All unmarked article in such group receive the spam mark on group entry."
+ :type '(repeat (string :tag "Group"))
+ :group 'spam)
+
+(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
+ "dev.null.dk" "relays.visi.com")
+ "List of blackhole servers."
+ :type '(repeat (string :tag "Server"))
+ :group 'spam)
+
+(defcustom spam-blackhole-good-server-regex nil
+ "String matching IP addresses that should not be checked in the blackholes."
+ :type '(radio (const nil)
+ (regexp :format "%t: %v\n" :size 0))
+ :group 'spam)
+
+(defcustom spam-face 'gnus-splash-face
+ "Face for spam-marked articles."
+ :type 'face
+ :group 'spam)
+
+(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
+ "Regular expression for positive header spam matches."
+ :type '(repeat (regexp :tag "Regular expression to match spam header"))
+ :group 'spam)
+
+(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
+ "Regular expression for positive header ham matches."
+ :type '(repeat (regexp :tag "Regular expression to match ham header"))
+ :group 'spam)
+
+(defcustom spam-regex-body-spam '()
+ "Regular expression for positive body spam matches."
+ :type '(repeat (regexp :tag "Regular expression to match spam body"))
+ :group 'spam)
+
+(defcustom spam-regex-body-ham '()
+ "Regular expression for positive body ham matches."
+ :type '(repeat (regexp :tag "Regular expression to match ham body"))
+ :group 'spam)
+
+(defgroup spam-ifile nil
+ "Spam ifile configuration."
+ :group 'spam)
+
+(defcustom spam-ifile-path (executable-find "ifile")
+ "File path of the ifile executable program."
+ :type '(choice (file :tag "Location of ifile")
+ (const :tag "ifile is not installed"))
+ :group 'spam-ifile)
+
+(defcustom spam-ifile-database-path nil
+ "File path of the ifile database."
+ :type '(choice (file :tag "Location of the ifile database")
+ (const :tag "Use the default"))
+ :group 'spam-ifile)
+
+(defcustom spam-ifile-spam-category "spam"
+ "Name of the spam ifile category."
+ :type 'string
+ :group 'spam-ifile)
+
+(defcustom spam-ifile-ham-category nil
+ "Name of the ham ifile category.
+If nil, the current group name will be used."
+ :type '(choice (string :tag "Use a fixed category")
+ (const :tag "Use the current group name"))
+ :group 'spam-ifile)
+
+(defcustom spam-ifile-all-categories nil
+ "Whether the ifile check will return all categories, or just spam.
+Set this to t if you want to use the `spam-split' invocation of ifile as
+your main source of newsgroup names."
+ :type 'boolean
+ :group 'spam-ifile)
+
+(defgroup spam-bogofilter nil
+ "Spam bogofilter configuration."
+ :group 'spam)
+
+(defcustom spam-bogofilter-path (executable-find "bogofilter")
+ "File path of the Bogofilter executable program."
+ :type '(choice (file :tag "Location of bogofilter")
+ (const :tag "Bogofilter is not installed"))
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-header "X-Bogosity"
+ "The header that Bogofilter inserts in messages."
+ :type 'string
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-spam-switch "-s"
+ "The switch that Bogofilter uses to register spam messages."
+ :type 'string
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-ham-switch "-n"
+ "The switch that Bogofilter uses to register ham messages."
+ :type 'string
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-spam-strong-switch "-S"
+ "The switch that Bogofilter uses to unregister ham messages."
+ :type 'string
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-ham-strong-switch "-N"
+ "The switch that Bogofilter uses to unregister spam messages."
+ :type 'string
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
+ "The regex on `spam-bogofilter-header' for positive spam identification."
+ :type 'regexp
+ :group 'spam-bogofilter)
+
+(defcustom spam-bogofilter-database-directory nil
+ "Directory path of the Bogofilter databases."
+ :type '(choice (directory
+ :tag "Location of the Bogofilter database directory")
+ (const :tag "Use the default"))
+ :group 'spam-bogofilter)
+
+(defgroup spam-spamoracle nil
+ "Spam spamoracle configuration."
+ :group 'spam)
+
+(defcustom spam-spamoracle-database nil
+ "Location of spamoracle database file. When nil, use the default
+spamoracle database."
+ :type '(choice (directory :tag "Location of spamoracle database file.")
+ (const :tag "Use the default"))
+ :group 'spam-spamoracle)
+
+(defcustom spam-spamoracle-binary (executable-find "spamoracle")
+ "Location of the spamoracle binary."
+ :type '(choice (directory :tag "Location of the spamoracle binary")
+ (const :tag "Use the default"))
+ :group 'spam-spamoracle)
+
+;;; Key bindings for spam control.
+
+(gnus-define-keys gnus-summary-mode-map
+ "St" spam-bogofilter-score
+ "Sx" gnus-summary-mark-as-spam
+ "Mst" spam-bogofilter-score
+ "Msx" gnus-summary-mark-as-spam
+ "\M-d" gnus-summary-mark-as-spam)
+
+(defvar spam-old-ham-articles nil
+ "List of old ham articles, generated when a group is entered.")
+
+(defvar spam-old-spam-articles nil
+ "List of old spam articles, generated when a group is entered.")
+
+(defvar spam-split-disabled nil
+ "If non-nil, `spam-split' is disabled, and always returns nil.")
+
+(defvar spam-split-last-successful-check nil
+ "`spam-split' will set this to nil or a spam-use-XYZ check if it
+ finds ham or spam.")
+
+;; convenience functions
+(defun spam-xor (a b)
+ "Logical exclusive `or'."
+ (and (or a b) (not (and a b))))
+
+(defun spam-group-ham-mark-p (group mark &optional spam)
+ (when (stringp group)
+ (let* ((marks (spam-group-ham-marks group spam))
+ (marks (if (symbolp mark)
+ marks
+ (mapcar 'symbol-value marks))))
+ (memq mark marks))))
+
+(defun spam-group-spam-mark-p (group mark)
+ (spam-group-ham-mark-p group mark t))
+
+(defun spam-group-ham-marks (group &optional spam)
+ (when (stringp group)
+ (let* ((marks (if spam
+ (gnus-parameter-spam-marks group)
+ (gnus-parameter-ham-marks group)))
+ (marks (car marks))
+ (marks (if (listp (car marks)) (car marks) marks)))
+ marks)))
+
+(defun spam-group-spam-marks (group)
+ (spam-group-ham-marks group t))
+
+(defun spam-group-spam-contents-p (group)
+ (if (stringp group)
+ (or (member group spam-junk-mailgroups)
+ (memq 'gnus-group-spam-classification-spam
+ (gnus-parameter-spam-contents group)))
+ nil))
+
+(defun spam-group-ham-contents-p (group)
+ (if (stringp group)
+ (memq 'gnus-group-spam-classification-ham
+ (gnus-parameter-spam-contents group))
+ nil))
+
+(defvar spam-list-of-processors
+ '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
+ (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
+ (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist)
+ (gnus-group-spam-exit-processor-ifile spam spam-use-ifile)
+ (gnus-group-spam-exit-processor-stat spam spam-use-stat)
+ (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle)
+ (gnus-group-ham-exit-processor-ifile ham spam-use-ifile)
+ (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter)
+ (gnus-group-ham-exit-processor-stat ham spam-use-stat)
+ (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist)
+ (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB)
+ (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy)
+ (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle))
+ "The spam-list-of-processors list contains pairs associating a
+ham/spam exit processor variable with a classification and a
+spam-use-* variable.")
+
+(defun spam-group-processor-p (group processor)
+ (if (and (stringp group)
+ (symbolp processor))
+ (or (member processor (nth 0 (gnus-parameter-spam-process group)))
+ (spam-group-processor-multiple-p
+ group
+ (cdr-safe (assoc processor spam-list-of-processors))))
+ nil))
+
+(defun spam-group-processor-multiple-p (group processor-info)
+ (let* ((classification (nth 0 processor-info))
+ (check (nth 1 processor-info))
+ (parameters (nth 0 (gnus-parameter-spam-process group)))
+ found)
+ (dolist (parameter parameters)
+ (when (and (null found)
+ (listp parameter)
+ (eq classification (nth 0 parameter))
+ (eq check (nth 1 parameter)))
+ (setq found t)))
+ found))
+
+(defun spam-group-spam-processor-report-gmane-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
+
+(defun spam-group-spam-processor-bogofilter-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
+
+(defun spam-group-spam-processor-blacklist-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
+
+(defun spam-group-spam-processor-ifile-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
+
+(defun spam-group-ham-processor-ifile-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
+
+(defun spam-group-spam-processor-spamoracle-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
+
+(defun spam-group-ham-processor-bogofilter-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
+
+(defun spam-group-spam-processor-stat-p (group)
+ (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
+
+(defun spam-group-ham-processor-stat-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
+
+(defun spam-group-ham-processor-whitelist-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
+
+(defun spam-group-ham-processor-BBDB-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
+
+(defun spam-group-ham-processor-copy-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
+
+(defun spam-group-ham-processor-spamoracle-p (group)
+ (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
+
+;;; Summary entry and exit processing.
+
+(defun spam-summary-prepare ()
+ (setq spam-old-ham-articles
+ (spam-list-articles gnus-newsgroup-articles 'ham))
+ (setq spam-old-spam-articles
+ (spam-list-articles gnus-newsgroup-articles 'spam))
+ (spam-mark-junk-as-spam-routine))
+
+;; The spam processors are invoked for any group, spam or ham or neither
+(defun spam-summary-prepare-exit ()
+ (unless gnus-group-is-exiting-without-update-p
+ (gnus-message 6 "Exiting summary buffer and applying spam rules")
+
+ ;; first of all, unregister any articles that are no longer ham or spam
+ ;; we have to iterate over the processors, or else we'll be too slow
+ (dolist (classification '(spam ham))
+ (let* ((old-articles (if (eq classification 'spam)
+ spam-old-spam-articles
+ spam-old-ham-articles))
+ (new-articles (spam-list-articles
+ gnus-newsgroup-articles
+ classification))
+ (changed-articles (gnus-set-difference old-articles new-articles)))
+ ;; now that we have the changed articles, we go through the processors
+ (dolist (processor-param spam-list-of-processors)
+ (let ((processor (nth 0 processor-param))
+ (processor-classification (nth 1 processor-param))
+ (check (nth 2 processor-param))
+ unregister-list)
+ (dolist (article changed-articles)
+ (let ((id (spam-fetch-field-message-id-fast article)))
+ (when (spam-log-unregistration-needed-p
+ id 'process classification check)
+ (push article unregister-list))))
+ ;; call spam-register-routine with specific articles to unregister,
+ ;; when there are articles to unregister and the check is enabled
+ (when (and unregister-list (symbol-value check))
+ (spam-register-routine classification check t unregister-list))))))
+
+ ;; find all the spam processors applicable to this group
+ (dolist (processor-param spam-list-of-processors)
+ (let ((processor (nth 0 processor-param))
+ (classification (nth 1 processor-param))
+ (check (nth 2 processor-param)))
+ (when (and (eq 'spam classification)
+ (spam-group-processor-p gnus-newsgroup-name processor))
+ (spam-register-routine classification check))))
+
+ (if spam-move-spam-nonspam-groups-only
+ (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
+ (spam-mark-spam-as-expired-and-move-routine
+ (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+ (gnus-message 5 "Marking spam as expired and moving it to %s"
+ gnus-newsgroup-name)
+ (spam-mark-spam-as-expired-and-move-routine
+ (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+
+ ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
+ ;; expire spam, in case the above did not expire them
+ (gnus-message 5 "Marking spam as expired without moving it")
+ (spam-mark-spam-as-expired-and-move-routine nil)
+
+ (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
+ (and (spam-group-spam-contents-p gnus-newsgroup-name)
+ spam-process-ham-in-spam-groups)
+ spam-process-ham-in-nonham-groups)
+ ;; find all the ham processors applicable to this group
+ (dolist (processor-param spam-list-of-processors)
+ (let ((processor (nth 0 processor-param))
+ (classification (nth 1 processor-param))
+ (check (nth 2 processor-param)))
+ (when (and (eq 'ham classification)
+ (spam-group-processor-p gnus-newsgroup-name processor))
+ (spam-register-routine classification check)))))
+
+ (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
+ (gnus-message 5 "Copying ham")
+ (spam-ham-copy-routine
+ (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
+
+ ;; now move all ham articles out of spam groups
+ (when (spam-group-spam-contents-p gnus-newsgroup-name)
+ (gnus-message 5 "Moving ham messages from spam group")
+ (spam-ham-move-routine
+ (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+
+ (setq spam-old-ham-articles nil)
+ (setq spam-old-spam-articles nil))
+
+(defun spam-mark-junk-as-spam-routine ()
+ ;; check the global list of group names spam-junk-mailgroups and the
+ ;; group parameters
+ (when (spam-group-spam-contents-p gnus-newsgroup-name)
+ (gnus-message 5 "Marking %s articles as spam"
+ (if spam-mark-only-unseen-as-spam
+ "unseen"
+ "unread"))
+ (let ((articles (if spam-mark-only-unseen-as-spam
+ gnus-newsgroup-unseen
+ gnus-newsgroup-unreads)))
+ (dolist (article articles)
+ (gnus-summary-mark-article article gnus-spam-mark)))))
+
+(defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
+ (if (and (car-safe groups) (listp (car-safe groups)))
+ (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
+ (gnus-summary-kill-process-mark)
+ (let ((articles gnus-newsgroup-articles)
+ (backend-supports-deletions
+ (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name))
+ article tomove deletep)
+ (dolist (article articles)
+ (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
+ (gnus-summary-mark-article article gnus-expirable-mark)
+ (push article tomove)))
+
+ ;; now do the actual copies
+ (dolist (group groups)
+ (when (and tomove
+ (stringp group))
+ (dolist (article tomove)
+ (gnus-summary-set-process-mark article))
+ (when tomove
+ (if (or (not backend-supports-deletions)
+ (> (length groups) 1))
+ (progn
+ (gnus-summary-copy-article nil group)
+ (setq deletep t))
+ (gnus-summary-move-article nil group)))))
+
+ ;; now delete the articles, if there was a copy done, and the
+ ;; backend allows it
+ (when (and deletep backend-supports-deletions)
+ (dolist (article tomove)
+ (gnus-summary-set-process-mark article))
+ (when tomove
+ (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
+ (gnus-summary-delete-article nil))))
+
+ (gnus-summary-yank-process-mark))))
+
+(defun spam-ham-copy-or-move-routine (copy groups)
+ (gnus-summary-kill-process-mark)
+ (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
+ (backend-supports-deletions
+ (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name))
+ (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
+ article mark todo deletep respool)
+
+ (when (member 'respool groups)
+ (setq respool t) ; boolean for later
+ (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
+
+ ;; now do the actual move
+ (dolist (group groups)
+ (when (and todo (stringp group))
+ (dolist (article todo)
+ (when spam-mark-ham-unread-before-move-from-spam-group
+ (gnus-summary-mark-article article gnus-unread-mark))
+ (gnus-summary-set-process-mark article))
+
+ (if respool ; respooling is with a "fake" group
+ (let ((spam-split-disabled
+ (or spam-split-disabled
+ spam-disable-spam-split-during-ham-respool)))
+ (gnus-summary-respool-article nil respool-method))
+ (if (or (not backend-supports-deletions) ; else, we are not respooling
+ (> (length groups) 1))
+ (progn ; if copying, copy and set deletep
+ (gnus-summary-copy-article nil group)
+ (setq deletep t))
+ (gnus-summary-move-article nil group))))) ; else move articles
+
+ ;; now delete the articles, unless a) copy is t, and there was a copy done
+ ;; b) a move was done to a single group
+ ;; c) backend-supports-deletions is nil
+ (unless copy
+ (when (and deletep backend-supports-deletions)
+ (dolist (article todo)
+ (gnus-summary-set-process-mark article))
+ (when todo
+ (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
+ (gnus-summary-delete-article nil))))))
+
+ (gnus-summary-yank-process-mark))
+
+(defun spam-ham-copy-routine (&rest groups)
+ (if (and (car-safe groups) (listp (car-safe groups)))
+ (apply 'spam-ham-copy-routine (car groups))
+ (spam-ham-copy-or-move-routine t groups)))
+
+(defun spam-ham-move-routine (&rest groups)
+ (if (and (car-safe groups) (listp (car-safe groups)))
+ (apply 'spam-ham-move-routine (car groups))
+ (spam-ham-copy-or-move-routine nil groups)))
+
+(eval-and-compile
+ (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position)))
+
+(defun spam-get-article-as-string (article)
+ (let ((article-buffer (spam-get-article-as-buffer article))
+ article-string)
+ (when article-buffer
+ (save-window-excursion
+ (set-buffer article-buffer)
+ (setq article-string (buffer-string))))
+ article-string))
+
+(defun spam-get-article-as-buffer (article)
+ (let ((article-buffer))
+ (when (numberp article)
+ (save-window-excursion
+ (gnus-summary-goto-subject article)
+ (gnus-summary-show-article t)
+ (setq article-buffer (get-buffer gnus-article-buffer))))
+ article-buffer))
+
+;; disabled for now
+;; (defun spam-get-article-as-filename (article)
+;; (let ((article-filename))
+;; (when (numberp article)
+;; (nnml-possibly-change-directory
+;; (gnus-group-real-name gnus-newsgroup-name))
+;; (setq article-filename (expand-file-name
+;; (int-to-string article) nnml-current-directory)))
+;; (if (file-exists-p article-filename)
+;; article-filename
+;; nil)))
+
+(defun spam-fetch-field-from-fast (article)
+ "Fetch the `from' field quickly, using the internal gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (mail-header-from
+ (gnus-data-header (assoc article (gnus-data-list nil))))
+ nil))
+
+(defun spam-fetch-field-subject-fast (article)
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (mail-header-subject
+ (gnus-data-header (assoc article (gnus-data-list nil))))
+ nil))
+
+(defun spam-fetch-field-message-id-fast (article)
+ "Fetch the `Message-ID' field quickly, using the internal
+ gnus-data-list function"
+ (if (and (numberp article)
+ (assoc article (gnus-data-list nil)))
+ (mail-header-message-id
+ (gnus-data-header (assoc article (gnus-data-list nil))))
+ nil))
+
+
+;;;; Spam determination.
+
+(defvar spam-list-of-checks
+ '((spam-use-blacklist . spam-check-blacklist)
+ (spam-use-regex-headers . spam-check-regex-headers)
+ (spam-use-regex-body . spam-check-regex-body)
+ (spam-use-whitelist . spam-check-whitelist)
+ (spam-use-BBDB . spam-check-BBDB)
+ (spam-use-ifile . spam-check-ifile)
+ (spam-use-spamoracle . spam-check-spamoracle)
+ (spam-use-stat . spam-check-stat)
+ (spam-use-blackholes . spam-check-blackholes)
+ (spam-use-hashcash . spam-check-hashcash)
+ (spam-use-bogofilter-headers . spam-check-bogofilter-headers)
+ (spam-use-bogofilter . spam-check-bogofilter))
+ "The spam-list-of-checks list contains pairs associating a
+parameter variable with a spam checking function. If the
+parameter variable is true, then the checking function is called,
+and its value decides what happens. Each individual check may
+return nil, t, or a mailgroup name. The value nil means that the
+check does not yield a decision, and so, that further checks are
+needed. The value t means that the message is definitely not
+spam, and that further spam checks should be inhibited.
+Otherwise, a mailgroup name or the symbol 'spam (depending on
+spam-split-symbolic-return) is returned where the mail should go,
+and further checks are also inhibited. The usual mailgroup name
+is the value of `spam-split-group', meaning that the message is
+definitely a spam.")
+
+(defvar spam-list-of-statistical-checks
+ '(spam-use-ifile
+ spam-use-regex-body
+ spam-use-stat
+ spam-use-bogofilter
+ spam-use-spamoracle)
+ "The spam-list-of-statistical-checks list contains all the mail
+splitters that need to have the full message body available.")
+
+;;;TODO: modify to invoke self with each check if invoked without specifics
+(defun spam-split (&rest specific-checks)
+ "Split this message into the `spam' group if it is spam.
+This function can be used as an entry in the variable `nnmail-split-fancy',
+for example like this: (: spam-split). It can take checks as
+parameters. A string as a parameter will set the
+spam-split-group to that string.
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
+ (interactive)
+ (setq spam-split-last-successful-check nil)
+ (unless spam-split-disabled
+ (let ((spam-split-group-choice spam-split-group))
+ (dolist (check specific-checks)
+ (when (stringp check)
+ (setq spam-split-group-choice check)
+ (setq specific-checks (delq check specific-checks))))
+
+ (let ((spam-split-group spam-split-group-choice))
+ (save-excursion
+ (save-restriction
+ (dolist (check spam-list-of-statistical-checks)
+ (when (and (symbolp check) (symbol-value check))
+ (widen)
+ (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
+ (symbol-name check))
+ (return)))
+ ;; (progn (widen) (debug (buffer-string)))
+ (let ((list-of-checks spam-list-of-checks)
+ decision)
+ (while (and list-of-checks (not decision))
+ (let ((pair (pop list-of-checks)))
+ (when (and (symbol-value (car pair))
+ (or (null specific-checks)
+ (memq (car pair) specific-checks)))
+ (gnus-message 5 "spam-split: calling the %s function"
+ (symbol-name (cdr pair)))
+ (setq decision (funcall (cdr pair)))
+ ;; if we got a decision at all, save the current check
+ (when decision
+ (setq spam-split-last-successful-check (car pair)))
+
+ (when (eq decision 'spam)
+ (if spam-split-symbolic-return
+ (setq decision spam-split-group)
+ (gnus-error
+ 5
+ (format "spam-split got %s but %s is nil"
+ (symbol-name decision)
+ (symbol-name spam-split-symbolic-return))))))))
+ (if (eq decision t)
+ (if spam-split-symbolic-return-positive 'ham nil)
+ decision))))))))
+
+(defun spam-find-spam ()
+ "This function will detect spam in the current newsgroup using spam-split."
+ (interactive)
+
+ (let* ((group gnus-newsgroup-name)
+ (autodetect (gnus-parameter-spam-autodetect group))
+ (methods (gnus-parameter-spam-autodetect-methods group))
+ (first-method (nth 0 methods)))
+ (when (and autodetect
+ (not (equal first-method 'none)))
+ (mapcar
+ (lambda (article)
+ (let ((id (spam-fetch-field-message-id-fast article))
+ (subject (spam-fetch-field-subject-fast article))
+ (sender (spam-fetch-field-from-fast article)))
+ (unless (and spam-log-to-registry
+ (spam-log-registered-p id 'incoming))
+ (let* ((spam-split-symbolic-return t)
+ (spam-split-symbolic-return-positive t)
+ (split-return
+ (with-temp-buffer
+ (gnus-request-article-this-buffer
+ article
+ group)
+ (if (or (null first-method)
+ (equal first-method 'default))
+ (spam-split)
+ (apply 'spam-split methods)))))
+ (if (equal split-return 'spam)
+ (gnus-summary-mark-article article gnus-spam-mark))
+
+ (when (and split-return spam-log-to-registry)
+ (when (zerop (gnus-registry-group-count id))
+ (gnus-registry-add-group
+ id group subject sender))
+
+ (spam-log-processing-to-registry
+ id
+ 'incoming
+ split-return
+ spam-split-last-successful-check
+ group))))))
+ (if spam-autodetect-recheck-messages
+ gnus-newsgroup-articles
+ gnus-newsgroup-unseen)))))
+
+(defvar spam-registration-functions
+ ;; first the ham register, second the spam register function
+ ;; third the ham unregister, fourth the spam unregister function
+ '((spam-use-blacklist nil
+ spam-blacklist-register-routine
+ nil
+ spam-blacklist-unregister-routine)
+ (spam-use-whitelist spam-whitelist-register-routine
+ nil
+ spam-whitelist-unregister-routine
+ nil)
+ (spam-use-BBDB spam-BBDB-register-routine
+ nil
+ spam-BBDB-unregister-routine
+ nil)
+ (spam-use-ifile spam-ifile-register-ham-routine
+ spam-ifile-register-spam-routine
+ spam-ifile-unregister-ham-routine
+ spam-ifile-unregister-spam-routine)
+ (spam-use-spamoracle spam-spamoracle-learn-ham
+ spam-spamoracle-learn-spam
+ spam-spamoracle-unlearn-ham
+ spam-spamoracle-unlearn-spam)
+ (spam-use-stat spam-stat-register-ham-routine
+ spam-stat-register-spam-routine
+ spam-stat-unregister-ham-routine
+ spam-stat-unregister-spam-routine)
+ ;; note that spam-use-gmane is not a legitimate check
+ (spam-use-gmane nil
+ spam-report-gmane-register-routine
+ ;; does Gmane support unregistration?
+ nil
+ nil)
+ (spam-use-bogofilter spam-bogofilter-register-ham-routine
+ spam-bogofilter-register-spam-routine
+ spam-bogofilter-unregister-ham-routine
+ spam-bogofilter-unregister-spam-routine))
+ "The spam-registration-functions list contains pairs
+associating a parameter variable with the ham and spam
+registration functions, and the ham and spam unregistration
+functions")
+
+(defun spam-classification-valid-p (classification)
+ (or (eq classification 'spam)
+ (eq classification 'ham)))
+
+(defun spam-process-type-valid-p (process-type)
+ (or (eq process-type 'incoming)
+ (eq process-type 'process)))
+
+(defun spam-registration-check-valid-p (check)
+ (assoc check spam-registration-functions))
+
+(defun spam-unregistration-check-valid-p (check)
+ (assoc check spam-registration-functions))
+
+(defun spam-registration-function (classification check)
+ (let ((flist (cdr-safe (assoc check spam-registration-functions))))
+ (if (eq classification 'spam)
+ (nth 1 flist)
+ (nth 0 flist))))
+
+(defun spam-unregistration-function (classification check)
+ (let ((flist (cdr-safe (assoc check spam-registration-functions))))
+ (if (eq classification 'spam)
+ (nth 3 flist)
+ (nth 2 flist))))
+
+(defun spam-list-articles (articles classification)
+ (let ((mark-check (if (eq classification 'spam)
+ 'spam-group-spam-mark-p
+ 'spam-group-ham-mark-p))
+ list mark-cache-yes mark-cache-no)
+ (dolist (article articles)
+ (let ((mark (gnus-summary-article-mark article)))
+ (unless (memq mark mark-cache-no)
+ (if (memq mark mark-cache-yes)
+ (push article list)
+ ;; else, we have to actually check the mark
+ (if (funcall mark-check
+ gnus-newsgroup-name
+ mark)
+ (progn
+ (push article list)
+ (push mark mark-cache-yes))
+ (push mark mark-cache-no))))))
+ list))
+
+(defun spam-register-routine (classification
+ check
+ &optional unregister
+ specific-articles)
+ (when (and (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let* ((register-function
+ (spam-registration-function classification check))
+ (unregister-function
+ (spam-unregistration-function classification check))
+ (run-function (if unregister
+ unregister-function
+ register-function))
+ (log-function (if unregister
+ 'spam-log-undo-registration
+ 'spam-log-processing-to-registry))
+ article articles)
+
+ (when run-function
+ ;; make list of articles, using specific-articles if given
+ (setq articles (or specific-articles
+ (spam-list-articles
+ gnus-newsgroup-articles
+ classification)))
+ ;; process them
+ (gnus-message 5 "%s %d %s articles with classification %s, check %s"
+ (if unregister "Unregistering" "Registering")
+ (length articles)
+ (if specific-articles "specific" "")
+ (symbol-name classification)
+ (symbol-name check))
+ (funcall run-function articles)
+ ;; now log all the registrations (or undo them, depending on unregister)
+ (dolist (article articles)
+ (funcall log-function
+ (spam-fetch-field-message-id-fast article)
+ 'process
+ classification
+ check
+ gnus-newsgroup-name))))))
+
+;;; log a ham- or spam-processor invocation to the registry
+(defun spam-log-processing-to-registry (id type classification check group)
+ (when spam-log-to-registry
+ (if (and (stringp id)
+ (stringp group)
+ (spam-process-type-valid-p type)
+ (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+ (cell (list classification check group)))
+ (push cell cell-list)
+ (gnus-registry-store-extra-entry
+ id
+ type
+ cell-list))
+
+ (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group"
+ "spam-log-processing-to-registry")))))
+
+;;; check if a ham- or spam-processor registration has been done
+(defun spam-log-registered-p (id type)
+ (when spam-log-to-registry
+ (if (and (stringp id)
+ (spam-process-type-valid-p type))
+ (cdr-safe (gnus-registry-fetch-extra id type))
+ (progn
+ (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
+ "spam-log-registered-p"))
+ nil))))
+
+;;; check if a ham- or spam-processor registration needs to be undone
+(defun spam-log-unregistration-needed-p (id type classification check)
+ (when spam-log-to-registry
+ (if (and (stringp id)
+ (spam-process-type-valid-p type)
+ (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+ found)
+ (dolist (cell cell-list)
+ (unless found
+ (when (and (eq classification (nth 0 cell))
+ (eq check (nth 1 cell)))
+ (setq found t))))
+ found)
+ (progn
+ (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
+ "spam-log-unregistration-needed-p"))
+ nil))))
+
+
+;;; undo a ham- or spam-processor registration (the group is not used)
+(defun spam-log-undo-registration (id type classification check &optional group)
+ (when (and spam-log-to-registry
+ (spam-log-unregistration-needed-p id type classification check))
+ (if (and (stringp id)
+ (spam-process-type-valid-p type)
+ (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
+ new-cell-list found)
+ (dolist (cell cell-list)
+ (unless (and (eq classification (nth 0 cell))
+ (eq check (nth 1 cell)))
+ (push cell new-cell-list)))
+ (gnus-registry-store-extra-entry
+ id
+ type
+ new-cell-list))
+ (progn
+ (gnus-message 5 (format "%s called with bad ID, type, check, or group"
+ "spam-log-undo-registration"))
+ nil))))
+
+;;; set up IMAP widening if it's necessary
+(defun spam-setup-widening ()
+ (dolist (check spam-list-of-statistical-checks)
+ (when (symbol-value check)
+ (setq nnimap-split-download-body-default t))))
+
+
+;;;; Regex body
+
+(defun spam-check-regex-body ()
+ (let ((spam-regex-headers-ham spam-regex-body-ham)
+ (spam-regex-headers-spam spam-regex-body-spam))
+ (spam-check-regex-headers t)))
+
+
+;;;; Regex headers
+
+(defun spam-check-regex-headers (&optional body)
+ (let ((type (if body "body" "header"))
+ (spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group))
+ ret found)
+ (dolist (h-regex spam-regex-headers-ham)
+ (unless found
+ (goto-char (point-min))
+ (when (re-search-forward h-regex nil t)
+ (message "Ham regex %s search positive." type)
+ (setq found t))))
+ (dolist (s-regex spam-regex-headers-spam)
+ (unless found
+ (goto-char (point-min))
+ (when (re-search-forward s-regex nil t)
+ (message "Spam regex %s search positive." type)
+ (setq found t)
+ (setq ret spam-split-group))))
+ ret))
+
+
+;;;; Blackholes.
+
+(defun spam-reverse-ip-string (ip)
+ (when (stringp ip)
+ (mapconcat 'identity
+ (nreverse (split-string ip "\\."))
+ ".")))
+
+(defun spam-check-blackholes ()
+ "Check the Received headers for blackholed relays."
+ (let ((headers (nnmail-fetch-field "received"))
+ (spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group))
+ ips matches)
+ (when headers
+ (with-temp-buffer
+ (insert headers)
+ (goto-char (point-min))
+ (gnus-message 5 "Checking headers for relay addresses")
+ (while (re-search-forward
+ "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
+ (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
+ (push (spam-reverse-ip-string (match-string 1))
+ ips)))
+ (dolist (server spam-blackhole-servers)
+ (dolist (ip ips)
+ (unless (and spam-blackhole-good-server-regex
+ ;; match the good-server-regex against the reversed (again) IP string
+ (string-match
+ spam-blackhole-good-server-regex
+ (spam-reverse-ip-string ip)))
+ (unless matches
+ (let ((query-string (concat ip "." server)))
+ (if spam-use-dig
+ (let ((query-result (query-dig query-string)))
+ (when query-result
+ (gnus-message 5 "(DIG): positive blackhole check '%s'"
+ query-result)
+ (push (list ip server query-result)
+ matches)))
+ ;; else, if not using dig.el
+ (when (query-dns query-string)
+ (gnus-message 5 "positive blackhole check")
+ (push (list ip server (query-dns query-string 'TXT))
+ matches)))))))))
+ (when matches
+ spam-split-group)))
+
+;;;; Hashcash.
+
+(condition-case nil
+ (progn
+ (require 'hashcash)
+
+ (defun spam-check-hashcash ()
+ "Check the headers for hashcash payments."
+ (mail-check-payment))) ;mail-check-payment returns a boolean
+
+ (file-error (progn
+ (defalias 'mail-check-payment 'ignore)
+ (defalias 'spam-check-hashcash 'ignore))))
+
+;;;; BBDB
+
+;;; original idea for spam-check-BBDB from Alexander Kotelnikov
+;;; <sacha@giotto.sj.ru>
+
+;; all this is done inside a condition-case to trap errors
+
+(condition-case nil
+ (progn
+ (require 'bbdb)
+ (require 'bbdb-com)
+
+ (defun spam-enter-ham-BBDB (addresses &optional remove)
+ "Enter an address into the BBDB; implies ham (non-spam) sender"
+ (dolist (from addresses)
+ (when (stringp from)
+ (let* ((parsed-address (gnus-extract-address-components from))
+ (name (or (nth 0 parsed-address) "Ham Sender"))
+ (remove-function (if remove
+ 'bbdb-delete-record-internal
+ 'ignore))
+ (net-address (nth 1 parsed-address))
+ (record (and net-address
+ (bbdb-search-simple nil net-address))))
+ (when net-address
+ (gnus-message 5 "%s address %s %s BBDB"
+ (if remove "Deleting" "Adding")
+ from
+ (if remove "from" "to"))
+ (if record
+ (funcall remove-function record)
+ (bbdb-create-internal name nil net-address nil nil
+ "ham sender added by spam.el")))))))
+
+ (defun spam-BBDB-register-routine (articles &optional unregister)
+ (let (addresses)
+ (dolist (article articles)
+ (when (stringp (spam-fetch-field-from-fast article))
+ (push (spam-fetch-field-from-fast article) addresses)))
+ ;; now do the register/unregister action
+ (spam-enter-ham-BBDB addresses unregister)))
+
+ (defun spam-BBDB-unregister-routine (articles)
+ (spam-BBDB-register-routine articles t))
+
+ (defun spam-check-BBDB ()
+ "Mail from people in the BBDB is classified as ham or non-spam"
+ (let ((who (nnmail-fetch-field "from"))
+ (spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group)))
+ (when who
+ (setq who (nth 1 (gnus-extract-address-components who)))
+ (if (bbdb-search-simple nil who)
+ t
+ (if spam-use-BBDB-exclusive
+ spam-split-group
+ nil))))))
+
+ (file-error (progn
+ (defalias 'bbdb-search-simple 'ignore)
+ (defalias 'spam-check-BBDB 'ignore)
+ (defalias 'spam-BBDB-register-routine 'ignore)
+ (defalias 'spam-enter-ham-BBDB 'ignore)
+ (defalias 'bbdb-create-internal 'ignore)
+ (defalias 'bbdb-delete-record-internal 'ignore)
+ (defalias 'bbdb-records 'ignore))))
+
+
+;;;; ifile
+
+;;; check the ifile backend; return nil if the mail was NOT classified
+;;; as spam
+
+(defun spam-get-ifile-database-parameter ()
+ "Get the command-line parameter for ifile's database from
+ spam-ifile-database-path."
+ (if spam-ifile-database-path
+ (format "--db-file=%s" spam-ifile-database-path)
+ nil))
+
+(defun spam-check-ifile ()
+ "Check the ifile backend for the classification of this message."
+ (let ((article-buffer-name (buffer-name))
+ (spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group))
+ category return)
+ (with-temp-buffer
+ (let ((temp-buffer-name (buffer-name))
+ (db-param (spam-get-ifile-database-parameter)))
+ (save-excursion
+ (set-buffer article-buffer-name)
+ (apply 'call-process-region
+ (point-min) (point-max) spam-ifile-path
+ nil temp-buffer-name nil "-c"
+ (if db-param `(,db-param "-q") `("-q"))))
+ ;; check the return now (we're back in the temp buffer)
+ (goto-char (point-min))
+ (if (not (eobp))
+ (setq category (buffer-substring (point) (spam-point-at-eol))))
+ (when (not (zerop (length category))) ; we need a category here
+ (if spam-ifile-all-categories
+ (setq return category)
+ ;; else, if spam-ifile-all-categories is not set...
+ (when (string-equal spam-ifile-spam-category category)
+ (setq return spam-split-group)))))) ; note return is nil otherwise
+ return))
+
+(defun spam-ifile-register-with-ifile (articles category &optional unregister)
+ "Register an article, given as a string, with a category.
+Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
+ (let ((category (or category gnus-newsgroup-name))
+ (add-or-delete-option (if unregister "-d" "-i"))
+ (db (spam-get-ifile-database-parameter))
+ parameters)
+ (with-temp-buffer
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article)))
+ (when (stringp article-string)
+ (insert article-string))))
+ (apply 'call-process-region
+ (point-min) (point-max) spam-ifile-path
+ nil nil nil
+ add-or-delete-option category
+ (if db `(,db "-h") `("-h"))))))
+
+(defun spam-ifile-register-spam-routine (articles &optional unregister)
+ (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
+
+(defun spam-ifile-unregister-spam-routine (articles)
+ (spam-ifile-register-spam-routine articles t))
+
+(defun spam-ifile-register-ham-routine (articles &optional unregister)
+ (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
+
+(defun spam-ifile-unregister-ham-routine (articles)
+ (spam-ifile-register-ham-routine articles t))
+
+
+;;;; spam-stat
+
+(condition-case nil
+ (progn
+ (let ((spam-stat-install-hooks nil))
+ (require 'spam-stat))
+
+ (defun spam-check-stat ()
+ "Check the spam-stat backend for the classification of this message"
+ (let ((spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group))
+ (spam-stat-split-fancy-spam-group spam-split-group) ; override
+ (spam-stat-buffer (buffer-name)) ; stat the current buffer
+ category return)
+ (spam-stat-split-fancy)))
+
+ (defun spam-stat-register-spam-routine (articles &optional unregister)
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article)))
+ (with-temp-buffer
+ (insert article-string)
+ (if unregister
+ (spam-stat-buffer-change-to-non-spam)
+ (spam-stat-buffer-is-spam))))))
+
+ (defun spam-stat-unregister-spam-routine (articles)
+ (spam-stat-register-spam-routine articles t))
+
+ (defun spam-stat-register-ham-routine (articles &optional unregister)
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article)))
+ (with-temp-buffer
+ (insert article-string)
+ (if unregister
+ (spam-stat-buffer-change-to-spam)
+ (spam-stat-buffer-is-non-spam))))))
+
+ (defun spam-stat-unregister-ham-routine (articles)
+ (spam-stat-register-ham-routine articles t))
+
+ (defun spam-maybe-spam-stat-load ()
+ (when spam-use-stat (spam-stat-load)))
+
+ (defun spam-maybe-spam-stat-save ()
+ (when spam-use-stat (spam-stat-save))))
+
+ (file-error (progn
+ (defalias 'spam-stat-load 'ignore)
+ (defalias 'spam-stat-save 'ignore)
+ (defalias 'spam-maybe-spam-stat-load 'ignore)
+ (defalias 'spam-maybe-spam-stat-save 'ignore)
+ (defalias 'spam-stat-register-ham-routine 'ignore)
+ (defalias 'spam-stat-unregister-ham-routine 'ignore)
+ (defalias 'spam-stat-register-spam-routine 'ignore)
+ (defalias 'spam-stat-unregister-spam-routine 'ignore)
+ (defalias 'spam-stat-buffer-is-spam 'ignore)
+ (defalias 'spam-stat-buffer-change-to-spam 'ignore)
+ (defalias 'spam-stat-buffer-is-non-spam 'ignore)
+ (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
+ (defalias 'spam-stat-split-fancy 'ignore)
+ (defalias 'spam-check-stat 'ignore))))
+
+
+
+;;;; Blacklists and whitelists.
+
+(defvar spam-whitelist-cache nil)
+(defvar spam-blacklist-cache nil)
+
+(defun spam-kill-whole-line ()
+ (beginning-of-line)
+ (let ((kill-whole-line t))
+ (kill-line)))
+
+;;; address can be a list, too
+(defun spam-enter-whitelist (address &optional remove)
+ "Enter ADDRESS (list or single) into the whitelist.
+With a non-nil REMOVE, remove them."
+ (interactive "sAddress: ")
+ (spam-enter-list address spam-whitelist remove)
+ (setq spam-whitelist-cache nil))
+
+;;; address can be a list, too
+(defun spam-enter-blacklist (address &optional remove)
+ "Enter ADDRESS (list or single) into the blacklist.
+With a non-nil REMOVE, remove them."
+ (interactive "sAddress: ")
+ (spam-enter-list address spam-blacklist remove)
+ (setq spam-blacklist-cache nil))
+
+(defun spam-enter-list (addresses file &optional remove)
+ "Enter ADDRESSES into the given FILE.
+Either the whitelist or the blacklist files can be used. With
+REMOVE not nil, remove the ADDRESSES."
+ (if (stringp addresses)
+ (spam-enter-list (list addresses) file remove)
+ ;; else, we have a list of addresses here
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (save-excursion
+ (set-buffer
+ (find-file-noselect file))
+ (dolist (a addresses)
+ (when (stringp a)
+ (goto-char (point-min))
+ (if (re-search-forward (regexp-quote a) nil t)
+ ;; found the address
+ (when remove
+ (spam-kill-whole-line))
+ ;; else, the address was not found
+ (unless remove
+ (goto-char (point-max))
+ (unless (bobp)
+ (insert "\n"))
+ (insert a "\n")))))
+ (save-buffer))))
+
+;;; returns t if the sender is in the whitelist, nil or
+;;; spam-split-group otherwise
+(defun spam-check-whitelist ()
+ ;; FIXME! Should it detect when file timestamps change?
+ (let ((spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group)))
+ (unless spam-whitelist-cache
+ (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
+ (if (spam-from-listed-p spam-whitelist-cache)
+ t
+ (if spam-use-whitelist-exclusive
+ spam-split-group
+ nil))))
+
+(defun spam-check-blacklist ()
+ ;; FIXME! Should it detect when file timestamps change?
+ (let ((spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group)))
+ (unless spam-blacklist-cache
+ (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
+ (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)))
+
+(defun spam-parse-list (file)
+ (when (file-readable-p file)
+ (let (contents address)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (while (not (eobp))
+ (setq address (buffer-substring (point) (spam-point-at-eol)))
+ (forward-line 1)
+ ;; insert the e-mail address if detected, otherwise the raw data
+ (unless (zerop (length address))
+ (let ((pure-address (nth 1 (gnus-extract-address-components address))))
+ (push (or pure-address address) contents)))))
+ (nreverse contents))))
+
+(defun spam-from-listed-p (cache)
+ (let ((from (nnmail-fetch-field "from"))
+ found)
+ (while cache
+ (let ((address (pop cache)))
+ (unless (zerop (length address)) ; 0 for a nil address too
+ (setq address (regexp-quote address))
+ ;; fix regexp-quote's treatment of user-intended regexes
+ (while (string-match "\\\\\\*" address)
+ (setq address (replace-match ".*" t t address))))
+ (when (and address (string-match address from))
+ (setq found t
+ cache nil))))
+ found))
+
+(defun spam-filelist-register-routine (articles blacklist &optional unregister)
+ (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
+ (declassification (if blacklist 'ham 'spam))
+ (enter-function
+ (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
+ (remove-function
+ (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
+ from addresses unregister-list)
+ (dolist (article articles)
+ (let ((from (spam-fetch-field-from-fast article))
+ (id (spam-fetch-field-message-id-fast article))
+ sender-ignored)
+ (when (stringp from)
+ (dolist (ignore-regex spam-blacklist-ignored-regexes)
+ (when (and (not sender-ignored)
+ (stringp ignore-regex)
+ (string-match ignore-regex from))
+ (setq sender-ignored t)))
+ ;; remember the messages we need to unregister, unless remove is set
+ (when (and
+ (null unregister)
+ (spam-log-unregistration-needed-p
+ id 'process declassification de-symbol))
+ (push from unregister-list))
+ (unless sender-ignored
+ (push from addresses)))))
+
+ (if unregister
+ (funcall enter-function addresses t) ; unregister all these addresses
+ ;; else, register normally and unregister what we need to
+ (funcall remove-function unregister-list t)
+ (dolist (article unregister-list)
+ (spam-log-undo-registration
+ (spam-fetch-field-message-id-fast article)
+ 'process
+ declassification
+ de-symbol))
+ (funcall enter-function addresses nil))))
+
+(defun spam-blacklist-unregister-routine (articles)
+ (spam-blacklist-register-routine articles t))
+
+(defun spam-blacklist-register-routine (articles &optional unregister)
+ (spam-filelist-register-routine articles t unregister))
+
+(defun spam-whitelist-unregister-routine (articles)
+ (spam-whitelist-register-routine articles t))
+
+(defun spam-whitelist-register-routine (articles &optional unregister)
+ (spam-filelist-register-routine articles nil unregister))
+
+
+;;;; Spam-report glue
+(defun spam-report-gmane-register-routine (articles)
+ (when articles
+ (apply 'spam-report-gmane articles)))
+
+
+;;;; Bogofilter
+(defun spam-check-bogofilter-headers (&optional score)
+ (let ((header (nnmail-fetch-field spam-bogofilter-header))
+ (spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group)))
+ (when header ; return nil when no header
+ (if score ; scoring mode
+ (if (string-match "spamicity=\\([0-9.]+\\)" header)
+ (match-string 1 header)
+ "0")
+ ;; spam detection mode
+ (when (string-match spam-bogofilter-bogosity-positive-spam-header
+ header)
+ spam-split-group)))))
+
+;; return something sensible if the score can't be determined
+(defun spam-bogofilter-score ()
+ "Get the Bogofilter spamicity score"
+ (interactive)
+ (save-window-excursion
+ (gnus-summary-show-article t)
+ (set-buffer gnus-article-buffer)
+ (let ((score (or (spam-check-bogofilter-headers t)
+ (spam-check-bogofilter t))))
+ (message "Spamicity score %s" score)
+ (or score "0"))
+ (gnus-summary-show-article)))
+
+(defun spam-check-bogofilter (&optional score)
+ "Check the Bogofilter backend for the classification of this message"
+ (let ((article-buffer-name (buffer-name))
+ (db spam-bogofilter-database-directory)
+ return)
+ (with-temp-buffer
+ (let ((temp-buffer-name (buffer-name)))
+ (save-excursion
+ (set-buffer article-buffer-name)
+ (apply 'call-process-region
+ (point-min) (point-max)
+ spam-bogofilter-path
+ nil temp-buffer-name nil
+ (if db `("-d" ,db "-v") `("-v"))))
+ (setq return (spam-check-bogofilter-headers score))))
+ return))
+
+(defun spam-bogofilter-register-with-bogofilter (articles
+ spam
+ &optional unregister)
+ "Register an article, given as a string, as spam or non-spam."
+ (dolist (article articles)
+ (let ((article-string (spam-get-article-as-string article))
+ (db spam-bogofilter-database-directory)
+ (switch (if unregister
+ (if spam
+ spam-bogofilter-spam-strong-switch
+ spam-bogofilter-ham-strong-switch)
+ (if spam
+ spam-bogofilter-spam-switch
+ spam-bogofilter-ham-switch))))
+ (when (stringp article-string)
+ (with-temp-buffer
+ (insert article-string)
+
+ (apply 'call-process-region
+ (point-min) (point-max)
+ spam-bogofilter-path
+ nil nil nil switch
+ (if db `("-d" ,db "-v") `("-v"))))))))
+
+(defun spam-bogofilter-register-spam-routine (articles &optional unregister)
+ (spam-bogofilter-register-with-bogofilter articles t unregister))
+
+(defun spam-bogofilter-unregister-spam-routine (articles)
+ (spam-bogofilter-register-spam-routine articles t))
+
+(defun spam-bogofilter-register-ham-routine (articles &optional unregister)
+ (spam-bogofilter-register-with-bogofilter articles nil unregister))
+
+(defun spam-bogofilter-unregister-ham-routine (articles)
+ (spam-bogofilter-register-ham-routine articles t))
+
+
+
+;;;; spamoracle
+(defun spam-check-spamoracle ()
+ "Run spamoracle on an article to determine whether it's spam."
+ (let ((article-buffer-name (buffer-name))
+ (spam-split-group (if spam-split-symbolic-return
+ 'spam
+ spam-split-group)))
+ (with-temp-buffer
+ (let ((temp-buffer-name (buffer-name)))
+ (save-excursion
+ (set-buffer article-buffer-name)
+ (let ((status
+ (apply 'call-process-region
+ (point-min) (point-max)
+ spam-spamoracle-binary
+ nil temp-buffer-name nil
+ (if spam-spamoracle-database
+ `("-f" ,spam-spamoracle-database "mark")
+ '("mark")))))
+ (if (eq 0 status)
+ (progn
+ (set-buffer temp-buffer-name)
+ (goto-char (point-min))
+ (when (re-search-forward "^X-Spam: yes;" nil t)
+ spam-split-group))
+ (error "Error running spamoracle" status))))))))
+
+(defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
+ "Run spamoracle in training mode."
+ (with-temp-buffer
+ (let ((temp-buffer-name (buffer-name)))
+ (save-excursion
+ (goto-char (point-min))
+ (dolist (article articles)
+ (insert (spam-get-article-as-string article)))
+ (let* ((arg (if (spam-xor unregister article-is-spam-p)
+ "-spam"
+ "-good"))
+ (status
+ (apply 'call-process-region
+ (point-min) (point-max)
+ spam-spamoracle-binary
+ nil temp-buffer-name nil
+ (if spam-spamoracle-database
+ `("-f" ,spam-spamoracle-database
+ "add" ,arg)
+ `("add" ,arg)))))
+ (when (not (eq 0 status))
+ (error "Error running spamoracle" status)))))))
+
+(defun spam-spamoracle-learn-ham (articles &optional unregister)
+ (spam-spamoracle-learn articles nil unregister))
+
+(defun spam-spamoracle-unlearn-ham (articles &optional unregister)
+ (spam-spamoracle-learn-ham articles t))
+
+(defun spam-spamoracle-learn-spam (articles &optional unregister)
+ (spam-spamoracle-learn articles t unregister))
+
+(defun spam-spamoracle-unlearn-spam (articles &optional unregister)
+ (spam-spamoracle-learn-spam articles t))
+
+
+;;;; Hooks
+
+;;;###autoload
+(defun spam-initialize ()
+ "Install the spam.el hooks and do other initialization"
+ (interactive)
+ (setq spam-install-hooks t)
+ ;; TODO: How do we redo this every time spam-face is customized?
+ (push '((eq mark gnus-spam-mark) . spam-face)
+ gnus-summary-highlight)
+ ;; Add hooks for loading and saving the spam stats
+ (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
+ (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
+ (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
+ (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
+ (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
+ (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
+ (add-hook 'gnus-summary-prepare-hook 'spam-find-spam))
+
+(defun spam-unload-hook ()
+ "Uninstall the spam.el hooks"
+ (interactive)
+ (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
+ (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
+ (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
+ (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
+ (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
+ (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
+ (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
+
+(when spam-install-hooks
+ (spam-initialize))
+
+(provide 'spam)
+
+;;; spam.el ends here.
+
+(provide 'spam)
+
+;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
+;;; spam.el ends here
diff --git a/lisp/gnus/subscribe.xpm b/lisp/gnus/subscribe.xpm
index 62db2dad51f..ff193a9e8ab 100644
--- a/lisp/gnus/subscribe.xpm
+++ b/lisp/gnus/subscribe.xpm
@@ -1,49 +1,32 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 19 1",
-" c Gray6",
-". c Gray12",
-"X c #2ff42ff42ff4",
-"o c #3fff3fff3fff",
-"O c Gray28",
-"+ c #53e353e353e3",
-"@ c #5fe25fe25fe2",
-"# c #67e767e767e7",
-"$ c #6fff6fff6fff",
-"% c #77d777d777d7",
-"& c Gray50",
-"* c Gray56",
-"= c #9fff9fff9fff",
-"- c Gray70",
-"; c Gray75",
-": c Gray81",
-"> c #dfffdfffdfff",
-", c #efffefffefff",
-"< c Gray100",
-/* pixels */
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;@Xooooo oooXO-;;;;;;",
-";;;;@;>;=<<o<<<;o#;;;;;;",
-";;;;@;,&=<<o<<<;&:+;;;;;",
-";;;;@;:=$<<o<<<:ooX@;;;;",
-";;;;@@&&&&&.<<<<<<;@;;;;",
-";;;;@*;;;;;X<<<<<<;@;;;;",
-";;;;@;:&@<<o<<<<<<;@;;;;",
-";;;;@;>&&<<o<<<<<<;@;;;;",
-";;;;@;,>:<<o<<<<<<;@;;;;",
-";;;;@Xooooo <<<<<<;@;;;;",
-";;;;@;>;=<<o<<<<<<;@;;;;",
-";;;;@;,&=<<o<<<<<<;@;;;;",
-";;;;@;:=$<<o<<<<<<;@;;;;",
-";;;;@@&&&&&.<<<<<<;@;;;;",
-";;;;@*;;;;;X<<<<<<;@;;;;",
-";;;;@;<<<<<o<<<<<<;@;;;;",
-";;;;@;<<<<<o<<<<<<;@;;;;",
-";;;;@;<<<<<o<<<<<<;@;;;;",
-";;;;%XXXXXXXXXXXXXX%;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;",
-";;;;;;;;;;;;;;;;;;;;;;;;"
-};
+static char * subscribe_xpm[] = {
+"24 24 5 1",
+" c None",
+". c #A5A5A5A59595",
+"X c #E1E1E0E0E0E0",
+"o c #C7C7C6C6C6C6",
+"O c #8686ADAD7D7D",
+" ",
+" ",
+" ",
+" ... ",
+" ..XXX..... ",
+"...XXXXX..XXX. ... ",
+".X.XX...XXXX...XXX. ",
+".XX.X.X.XX...XXXXX. ",
+".XX...XX.X.X.XXXXXX. ",
+".XX.o.XX...XX.XXXXXX. ",
+".X.oo.XX.o.XX..XXXXXX. ",
+"o.ooo.X.oo.XX.XXXOXXX. ",
+"o.oXXo.ooo.X.oXXOXXXXX. ",
+" o.XXo.oXXo.ooXXOXXXXX. ",
+" o.XXXo.XXo.oXXXOXXXXXX.",
+" o.XXo.XXXo.XOOOOXXXXX.",
+" o.XXoo.XXo.XXXOOXXXXX.",
+" o.XXo.XXXo.XXXXXXX...",
+" o.XX.o.XXo.XXXXXX.oo ",
+" o..oo.XX.o.XXX..o ",
+" oo o..oo.XX.oo ",
+" oo o..o ",
+" oo ",
+" "};
diff --git a/lisp/gnus/unimportant.xpm b/lisp/gnus/unimportant.xpm
new file mode 100644
index 00000000000..4298224e56c
--- /dev/null
+++ b/lisp/gnus/unimportant.xpm
@@ -0,0 +1,32 @@
+/* XPM */
+static char *magick[] = {
+/* columns rows colors chars-per-pixel */
+"24 24 2 1",
+"! c blue",
+"w c Gray75",
+/* pixels */
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"ww!!!wwwwww!!!wwwwww!!!w",
+"www!!!wwwww!!!wwwww!!!ww",
+"wwww!!!wwww!!!wwww!!!www",
+"wwwww!!!www!!!www!!!wwww",
+"wwwwww!!!ww!!!ww!!!wwwww",
+"wwwwwww!!!w!!!w!!!wwwwww",
+"wwwwwwww!!!!!!!!!wwwwwww",
+"wwwwwwwww!!!!!!!wwwwwwww",
+"wwwwwwwwww!!!!!wwwwwwwww",
+"wwwwwwwwwww!!!wwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww",
+"wwwwwwwwwwwwwwwwwwwwwwww"
+};
diff --git a/lisp/gnus/unsubscribe.xpm b/lisp/gnus/unsubscribe.xpm
index 38eab8578e4..a91180d00f8 100644
--- a/lisp/gnus/unsubscribe.xpm
+++ b/lisp/gnus/unsubscribe.xpm
@@ -1,48 +1,32 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 18 1",
-" c Gray6",
-". c Gray12",
-"X c #2ff42ff42ff4",
-"o c #3fff3fff3fff",
-"O c Gray28",
-"+ c #53e353e353e3",
-"@ c #5fe55fe55fe5",
-"# c #67e767e767e7",
-"$ c #77d777d777d7",
-"% c Gray50",
-"& c Gray56",
-"* c #9fff9fff9fff",
-"= c Gray70",
-"- c Gray75",
-"; c Gray81",
-": c #dfffdfffdfff",
-"> c #efffefffefff",
-", c Gray100",
-/* pixels */
-"------------------------",
-"------------------------",
-"------------------------",
-"----@Xooooo oooXO=------",
-"----@-,,,:-o,,,-o#------",
-"----@-,,,@:o,,,-%;+-----",
-"----@-;%@,,o,,,;ooX@----",
-"----@@%o@%%.,,,,,,-@----",
-"----@&-----X,,,,,,-@----",
-"----@-,,,**o,,,,,,-@----",
-"----@-:-**,o,,,,,,-@----",
-"----@->%*,,o,,,,,,-@----",
-"----@Xooooo ,,,,,,-@----",
-"----@-,,,:-o,,,,,,-@----",
-"----@-,,,@:o,,,,,,-@----",
-"----@-;%@,,o,,,,,,-@----",
-"----@@%o@%%.,,,,,,-@----",
-"----@&-----X,,,,,,-@----",
-"----@-,,,,,o,,,,,,-@----",
-"----@-,,,,,o,,,,,,-@----",
-"----@-,,,,,o,,,,,,-@----",
-"----$XXXXXXXXXXXXXX$----",
-"------------------------",
-"------------------------"
-};
+static char * unsubscribe_xpm[] = {
+"24 24 5 1",
+" c None",
+". c #A5A5A5A59595",
+"X c #E1E1E0E0E0E0",
+"o c #C7C7C6C6C6C6",
+"O c #FFFF00000000",
+" ",
+" ",
+" ",
+" ... ",
+" ..XXX..... ",
+"...XXXXX..XXX. ... ",
+".X.XX...XXXX...XXX. ",
+".XX.X.X.XX...XXXXX. ",
+".XX...XX.X.X.XXXXXX. ",
+".XX.o.XX...XX.XXXXXX. ",
+".X.oo.XX.o.XX..XXXXXX. ",
+"o.ooo.X.oo.XX.XXXXXXX. ",
+"o.oXXo.ooo.X.oXXXXXXXX. ",
+" o.XXo.oXXo.ooXXOXXXXX. ",
+" o.XXXo.XXo.oXXXOXXXXXX.",
+" o.XXo.XXXo.XOOOXXXXXX.",
+" o.XXoo.XXo.XoOOOXXXXX.",
+" o.XXo.XXXo.XOoOXXX...",
+" o.XX.o.XXo.XOXoXX.oo ",
+" o..oo.XX.o.oXX..o ",
+" oo o..oo.XX.oo ",
+" oo o..o ",
+" oo ",
+" "};
diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el
index 8f81d787fdb..18e7774a578 100644
--- a/lisp/gnus/utf7.el
+++ b/lisp/gnus/utf7.el
@@ -1,7 +1,8 @@
-;;; utf7.el --- UTF-7 encoding/decoding for Emacs
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*-
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
;; Author: Jon K Hellan <hellan@acm.org>
+;; Maintainer: bugs@gnus.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -22,37 +23,69 @@
;; Boston, MA 02111-1307, USA.
;;; Commentary:
-;;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152
-;;; This is a transformation format of Unicode that contains only 7-bit
-;;; ASCII octets and is intended to be readable by humans in the limiting
-;;; case that the document consists of characters from the US-ASCII
-;;; repertoire.
-;;; In short, runs of characters outside US-ASCII are encoded as base64
-;;; inside delimiters.
-;;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way
-;;; to represent characters outside US-ASCII in mailbox names in IMAP.
-;;; This library supports both variants, but the IMAP variation was the
-;;; reason I wrote it.
-;;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode)
-;;; -> current character set, and vice versa.
-;;; However, until Emacs supports Unicode, the only Emacs character set
-;;; supported here is ISO-8859.1, which can trivially be converted to/from
-;;; Unicode.
-;;; When decoding results in a character outside the Emacs character set,
-;;; an error is thrown. It is up to the application to recover.
+
+;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152
+;; This is a transformation format of Unicode that contains only 7-bit
+;; ASCII octets and is intended to be readable by humans in the limiting
+;; case that the document consists of characters from the US-ASCII
+;; repertoire.
+;; In short, runs of characters outside US-ASCII are encoded as base64
+;; inside delimiters.
+;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way
+;; to represent characters outside US-ASCII in mailbox names in IMAP.
+;; This library supports both variants, but the IMAP variation was the
+;; reason I wrote it.
+;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode)
+;; -> current character set, and vice versa.
+;; However, until Emacs supports Unicode, the only Emacs character set
+;; supported here is ISO-8859.1, which can trivially be converted to/from
+;; Unicode.
+;; When decoding results in a character outside the Emacs character set,
+;; an error is thrown. It is up to the application to recover.
+
+;; UTF-7 should be done by providing a coding system. Mule-UCS does
+;; already, but I don't know if it does the IMAP version and it's not
+;; clear whether that should really be a coding system. The UTF-16
+;; part of the conversion can be done with coding systems available
+;; with Mule-UCS or some versions of Emacs. Unfortunately these were
+;; done wrongly (regarding handling of byte-order marks and how the
+;; variants were named), so we don't have a consistent name for the
+;; necessary coding system. The code below doesn't seem to DTRT
+;; generally. E.g.:
+;;
+;; (utf7-encode "a+£")
+;; => "a+ACsAow-"
+;;
+;; $ echo "a+£"|iconv -f iso-8859-1 -t utf-7
+;; a+-+AKM
+;;
+;; -- fx
+
;;; Code:
(require 'base64)
(eval-when-compile (require 'cl))
+(require 'mm-util)
-(defvar utf7-direct-encoding-chars " -%'-*,-[]-}"
+(defconst utf7-direct-encoding-chars " -%'-*,-[]-}"
"Character ranges which do not need escaping in UTF-7.")
-(defvar utf7-imap-direct-encoding-chars
+(defconst utf7-imap-direct-encoding-chars
(concat utf7-direct-encoding-chars "+\\~")
"Character ranges which do not need escaping in the IMAP variant of UTF-7.")
+(defconst utf7-utf-16-coding-system
+ (cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS
+ 'utf-16-be-no-signature)
+ ((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.4 (?), Emacs 22
+ ;; Avoid versions with BOM.
+ (= 2 (length (encode-coding-string "a" 'utf-16-be))))
+ 'utf-16-be)
+ ((mm-coding-system-p 'utf-16-be-nosig) ; ?
+ 'utf-16-be-nosig))
+ "Coding system which encodes big endian UTF-16 without a BOM signature.")
+
(defsubst utf7-imap-get-pad-length (len modulus)
"Return required length of padding for IMAP modified base64 fragment."
(mod (- len) modulus))
@@ -64,10 +97,11 @@ Use IMAP modification if FOR-IMAP is non-nil."
(end (point-max)))
(narrow-to-region start end)
(goto-char start)
- (let ((esc-char (if for-imap ?& ?+))
- (direct-encoding-chars
- (if for-imap utf7-imap-direct-encoding-chars
- utf7-direct-encoding-chars)))
+ (let* ((esc-char (if for-imap ?& ?+))
+ (direct-encoding-chars
+ (if for-imap utf7-imap-direct-encoding-chars
+ utf7-direct-encoding-chars))
+ (not-direct-encoding-chars (concat "^" direct-encoding-chars)))
(while (not (eobp))
(skip-chars-forward direct-encoding-chars)
(unless (eobp)
@@ -75,7 +109,7 @@ Use IMAP modification if FOR-IMAP is non-nil."
(let ((p (point))
(fc (following-char))
(run-length
- (skip-chars-forward (concat "^" direct-encoding-chars))))
+ (skip-chars-forward not-direct-encoding-chars)))
(if (and (= fc esc-char)
(= run-length 1)) ; Lone esc-char?
(delete-backward-char 1) ; Now there's one too many
@@ -88,7 +122,8 @@ Use IMAP modification if FOR-IMAP is non-nil."
(save-restriction
(narrow-to-region start end)
(funcall (utf7-get-u16char-converter 'to-utf-16))
- (base64-encode-region start (point-max))
+ (mm-with-unibyte-current-buffer
+ (base64-encode-region start (point-max)))
(goto-char start)
(let ((pm (point-max)))
(when for-imap
@@ -135,15 +170,24 @@ Use IMAP modification if FOR-IMAP is non-nil."
(defun utf7-get-u16char-converter (which-way)
"Return a function to convert between UTF-16 and current character set."
- ;; Add test to check if we are really Latin-1.
- ;; Support other character sets once Emacs groks Unicode.
- (if (eq which-way 'to-utf-16)
- 'utf7-latin1-u16-char-converter
- 'utf7-u16-latin1-char-converter))
+ (if utf7-utf-16-coding-system
+ (if (eq which-way 'to-utf-16)
+ (lambda ()
+ (encode-coding-region (point-min) (point-max)
+ utf7-utf-16-coding-system))
+ (lambda ()
+ (decode-coding-region (point-min) (point-max)
+ utf7-utf-16-coding-system)))
+ ;; Add test to check if we are really Latin-1.
+ (if (eq which-way 'to-utf-16)
+ 'utf7-latin1-u16-char-converter
+ 'utf7-u16-latin1-char-converter)))
(defun utf7-latin1-u16-char-converter ()
"Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode.
Characters are converted to raw byte pairs in narrowed buffer."
+ (mm-encode-coding-region (point-min) (point-max) 'iso-8859-1)
+ (mm-disable-multibyte)
(goto-char (point-min))
(while (not (eobp))
(insert 0)
@@ -157,11 +201,13 @@ Characters are in raw byte pairs in narrowed buffer."
(if (= 0 (following-char))
(delete-char 1)
(error "Unable to convert from Unicode"))
- (forward-char)))
+ (forward-char))
+ (mm-decode-coding-region (point-min) (point-max) 'iso-8859-1)
+ (mm-enable-multibyte))
(defun utf7-encode (string &optional for-imap)
"Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil."
- (let ((default-enable-multibyte-characters nil))
+ (let ((default-enable-multibyte-characters t))
(with-temp-buffer
(insert string)
(utf7-encode-internal for-imap)
@@ -173,6 +219,7 @@ Characters are in raw byte pairs in narrowed buffer."
(with-temp-buffer
(insert string)
(utf7-decode-internal for-imap)
+ (mm-enable-multibyte)
(buffer-string))))
(provide 'utf7)
diff --git a/lisp/gnus/uu-decode.xpm b/lisp/gnus/uu-decode.xpm
index cdadff68d52..b9d940cc99e 100644
--- a/lisp/gnus/uu-decode.xpm
+++ b/lisp/gnus/uu-decode.xpm
@@ -1,48 +1,36 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 18 1",
-" c #2fef2fef2fef",
-". c #3fff3fff3fff",
-"X c #4ccc4ccc4ccc",
-"o c #53e353e353e3",
-"O c #566656665666",
-"+ c #5fe35fe35fe3",
-"@ c Gray45",
-"# c #77d777d777d7",
-"$ c Gray50",
-"% c #866586658665",
-"& c Gray56",
-"* c Gray60",
-"= c #9fff9fff9fff",
-"- c Gray75",
-"; c Gray81",
-": c #dfffdfffdfff",
-"> c #efffefffefff",
-", c Gray100",
-/* pixels */
-"------------------------",
-"------------------------",
-"------------------------",
-"------------------------",
-"-----#+++++++++++++&----",
-"----- @@@@@@@@@@@@O+----",
-"----- *%@@@@@@@@@&@+----",
-"----- *X+$$$$$$$.@@+----",
-"----- *X-,,,,,,,$@@+----",
-"----- *X-,,;,,,,$@@+----",
-"----- *X-:$$$-=,$@@+----",
-"----- *X-+-+-$=,$@@+----",
-"----- *X->$;;,,,$@@+----",
-"----- *X--.$.,,,$@@+----",
-"----- *X->--==,,$@@+----",
-"----- *X-,,,,=;,$@@+----",
-"----- *X-,,,,,,,$@@+----",
-"----- *X-,,,,,,,$@@+----",
-"----- *X&-------+@@+----",
-"----- *@XXXXXXXXX%@+----",
-"----- ************@+----",
-"-----o #----",
-"------------------------",
-"------------------------"
-};
+static char * uu_decode_xpm[] = {
+"24 24 9 1",
+" c None",
+". c #919187876969",
+"X c #C2C2B9B99C9C",
+"o c #868686868686",
+"O c #8F8F8F8F8F8F",
+"+ c #000000000000",
+"@ c #4C4C4C4C4C4C",
+"# c #E9E9EFEFE8E8",
+"$ c #8686ADAD7D7D",
+" ",
+" ",
+" ",
+" .............. ",
+" X.o.........O.++ ",
+" XX++++++++++..++ ",
+" XX@########+..++ ",
+" XX@########+..++ ",
+" XX@$#$$$#$#+..++ ",
+" XX@#$$$$$$#+..++ ",
+" XX@##$#####+..++ ",
+" XX@##$#$$##+..++ ",
+" XX@##$#$$##+..++ ",
+" XX@##$$#$$#+..++ ",
+" XX@######$#+..++ ",
+" XX@########+..++ ",
+" XX@########+..++ ",
+" XX.@@@@@@@@@..++ ",
+" X.XXXXXXXXXX..++ ",
+" .XXXXXXXXXXXX.++ ",
+" +++++++++++++++ ",
+" +++++++++++++++ ",
+" ",
+" "};
diff --git a/lisp/gnus/uu-post.xpm b/lisp/gnus/uu-post.xpm
index b67fa8b8ab0..7c4204c6957 100644
--- a/lisp/gnus/uu-post.xpm
+++ b/lisp/gnus/uu-post.xpm
@@ -1,57 +1,35 @@
/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 27 1",
-" c Gray0",
-". c #0bfb0bfb0bfb",
-"X c Gray9",
-"o c Gray12",
-"O c #2fef2fef2fef",
-"+ c #3fff3fff3fff",
-"@ c Gray28",
-"# c #4ccc4ccc4ccc",
-"$ c #53e353e353e3",
-"% c #566656665666",
-"& c #5fe25fe25fe2",
-"* c #6fff6fff6fff",
-"= c Gray45",
-"- c #77d777d777d7",
-"; c Gray50",
-": c #866586658665",
-"> c Gray56",
-", c Gray60",
-"< c #9bcb9bcb9bcb",
-"1 c #9fff9fff9fff",
-"2 c #a7c7a7c7a7c7",
-"3 c Gray70",
-"4 c Gray75",
-"5 c Gray81",
-"6 c #dfffdfffdfff",
-"7 c #efffefffefff",
-"8 c Gray100",
-/* pixels */
-"$44$44$44$44$44$44$44$44",
-"444444444444-44444444444",
-"4444444444-O-O,444444444",
-"$44$44$2>O-4$4$@>3$44$44",
-"444444&&&4444442&&-44444",
-"44444$ XOOOOOOOOO..-4444",
-"$44$4O,,,,,,,,,,,,=&4$44",
-"44444O,=#########:=&4444",
-"44444O,#>4444444&==&4444",
-"$44$4O,#48888888;==&4$44",
-"44444O,#48818888;==&4444",
-"44444O,#45+1+1*8;==&4444",
-"$44$4O,#4*6&8158;==&4$44",
-"44444O,#46;61888;==&4444",
-"44444O,#44o++888;==&4444",
-"$44$4O,#48885;78;==&4$44",
-"44444O,#48888468;==&4444",
-"44444O,#48888888;==&4444",
-"$44$4O,#48888888;==&4$44",
-"44444O,#&;;;;;;;+==&4444",
-"44444O,:=========>=&4444",
-"$44$4O============%&4$44",
-"44444-&&&&&&&&&&&&&>4444",
-"444444444444444444444444"
-};
+static char * uu_post_xpm[] = {
+"24 24 8 1",
+". c None",
+"X c #000000000000",
+"+ c #C2C2B9B99C9C",
+"@ c #919187876969",
+"# c #868686868686",
+"% c #4C4C4C4C4C4C",
+"& c #E9E9EFEFE8E8",
+"* c #8686ADAD7D7D",
+"X..X..X..X.XX..X..X..X..",
+"..........X.X...........",
+".........X...X..........",
+"X..X..X.XX..X.XX..X..X..",
+".......X.......X........",
+"......X.........X.......",
+"X..X+X@@@@@@@@@@@XX..X..",
+"....+@@@@@@@@@@@@@......",
+"....++XXXXXXXXXX@@......",
+"X..X++%&&&&&&&&X@@X..X..",
+"....++%&&&&&&&&X@@......",
+"....++%*&***&*&X@@......",
+"X..X++%&******&X@@X..X..",
+"....++%&&*&&&&&X@@......",
+"....++%&&*&**&&X@@......",
+"X..X++%&&*&**&&X@@X..X..",
+"....++%&&**&**&X@@......",
+"....++%&&&&&&*&X@@......",
+"X..X++%&&&&&&&&X@@X..X..",
+"....++%&&&&&&&&X@@......",
+"....++@%%%%%%%%%@@......",
+"X..X+@++++++++++@@X..X..",
+"....+++++++++++++@......",
+"........................"};
diff --git a/lisp/gnus/uudecode.el b/lisp/gnus/uudecode.el
index 3e92cbcb832..086ece1cfd4 100644
--- a/lisp/gnus/uudecode.el
+++ b/lisp/gnus/uudecode.el
@@ -1,6 +1,6 @@
-;;; uudecode.el --- elisp native uudecode
+;;; uudecode.el -- elisp native uudecode
-;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (c) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: uudecode news
@@ -24,35 +24,17 @@
;;; Commentary:
-;; Lots of codes are stolen from mm-decode.el, gnus-uu.el and
-;; base64.el
-
-;; This looks as though it could be made rather more efficient for
-;; internal working. Encoding could use a lookup table and decoding
-;; should presumably use a vector or list buffer for partial results
-;; rather than with-current-buffer. -- fx
-
-;; Only `uudecode-decode-region' should be advertised, and whether or
-;; not that uses a program should be customizable, but I guess it's
-;; too late now. -- fx
-
;;; Code:
+(autoload 'executable-find "executable")
+
(eval-when-compile (require 'cl))
(eval-and-compile
(defalias 'uudecode-char-int
(if (fboundp 'char-int)
'char-int
- 'identity))
-
- (if (featurep 'xemacs)
- (defalias 'uudecode-insert-char 'insert-char)
- (defun uudecode-insert-char (char &optional count ignored buffer)
- (if (or (null buffer) (eq buffer (current-buffer)))
- (insert-char char count)
- (with-current-buffer buffer
- (insert-char char count))))))
+ 'identity)))
(defcustom uudecode-decoder-program "uudecode"
"*Non-nil value should be a string that names a uu decoder.
@@ -66,6 +48,12 @@ input and write the converted data to its standard output."
:group 'gnus-extract
:type '(repeat string))
+(defcustom uudecode-use-external
+ (executable-find uudecode-decoder-program)
+ "*Use external uudecode program."
+ :group 'gnus-extract
+ :type 'boolean)
+
(defconst uudecode-alphabet "\040-\140")
(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
@@ -102,9 +90,13 @@ used is specified by `uudecode-decoder-program'."
(match-string 1)))))
(setq tempfile (if file-name
(expand-file-name file-name)
- (let ((temporary-file-directory
- uudecode-temporary-file-directory))
- (make-temp-file "uu"))))
+ (if (fboundp 'make-temp-file)
+ (let ((temporary-file-directory
+ uudecode-temporary-file-directory))
+ (make-temp-file "uu"))
+ (expand-file-name
+ (make-temp-name "uu")
+ uudecode-temporary-file-directory))))
(let ((cdir default-directory)
default-process-coding-system)
(unwind-protect
@@ -131,86 +123,92 @@ used is specified by `uudecode-decoder-program'."
(ignore-errors (or file-name (delete-file tempfile))))))
;;;###autoload
-(defun uudecode-decode-region (start end &optional file-name)
+(defun uudecode-decode-region-internal (start end &optional file-name)
"Uudecode region between START and END without using an external program.
If FILE-NAME is non-nil, save the result to FILE-NAME."
(interactive "r\nP")
- (let ((work-buffer nil)
- (done nil)
+ (let ((done nil)
(counter 0)
(remain 0)
(bits 0)
- (lim 0) inputpos
+ (lim 0) inputpos result
(non-data-chars (concat "^" uudecode-alphabet)))
- (unwind-protect
- (save-excursion
+ (save-excursion
+ (goto-char start)
+ (when (re-search-forward uudecode-begin-line nil t)
+ (cond ((null file-name))
+ ((stringp file-name))
+ (t
+ (setq file-name (expand-file-name
+ (read-file-name "File to Name:"
+ nil nil nil
+ (match-string 1))))))
+ (forward-line 1)
+ (skip-chars-forward non-data-chars end)
+ (while (not done)
+ (setq inputpos (point))
+ (setq remain 0 bits 0 counter 0)
+ (cond
+ ((> (skip-chars-forward uudecode-alphabet end) 0)
+ (setq lim (point))
+ (setq remain
+ (logand (- (uudecode-char-int (char-after inputpos)) 32)
+ 63))
+ (setq inputpos (1+ inputpos))
+ (if (= remain 0) (setq done t))
+ (while (and (< inputpos lim) (> remain 0))
+ (setq bits (+ bits
+ (logand
+ (-
+ (uudecode-char-int (char-after inputpos)) 32)
+ 63)))
+ (if (/= counter 0) (setq remain (1- remain)))
+ (setq counter (1+ counter)
+ inputpos (1+ inputpos))
+ (cond ((= counter 4)
+ (setq result (cons
+ (concat
+ (char-to-string (lsh bits -16))
+ (char-to-string (logand (lsh bits -8) 255))
+ (char-to-string (logand bits 255)))
+ result))
+ (setq bits 0 counter 0))
+ (t (setq bits (lsh bits 6)))))))
+ (cond
+ (done)
+ ((> 0 remain)
+ (error "uucode line ends unexpectly")
+ (setq done t))
+ ((and (= (point) end) (not done))
+ ;;(error "uucode ends unexpectly")
+ (setq done t))
+ ((= counter 3)
+ (setq result (cons
+ (concat
+ (char-to-string (logand (lsh bits -16) 255))
+ (char-to-string (logand (lsh bits -8) 255)))
+ result)))
+ ((= counter 2)
+ (setq result (cons
+ (char-to-string (logand (lsh bits -10) 255))
+ result))))
+ (skip-chars-forward non-data-chars end))
+ (if file-name
+ (let (default-enable-multibyte-characters)
+ (with-temp-file file-name
+ (insert (apply 'concat (nreverse result)))))
+ (or (markerp end) (setq end (set-marker (make-marker) end)))
(goto-char start)
- (when (re-search-forward uudecode-begin-line nil t)
- (cond ((null file-name))
- ((stringp file-name))
- (t
- (setq file-name (expand-file-name
- (read-file-name "File to Name:"
- nil nil nil
- (match-string 1))))))
- (setq work-buffer (generate-new-buffer " *uudecode-work*"))
- (forward-line 1)
- (skip-chars-forward non-data-chars end)
- (while (not done)
- (setq inputpos (point))
- (setq remain 0 bits 0 counter 0)
- (cond
- ((> (skip-chars-forward uudecode-alphabet end) 0)
- (setq lim (point))
- (setq remain
- (logand (- (uudecode-char-int (char-after inputpos)) 32)
- 63))
- (setq inputpos (1+ inputpos))
- (if (= remain 0) (setq done t))
- (while (and (< inputpos lim) (> remain 0))
- (setq bits (+ bits
- (logand
- (-
- (uudecode-char-int (char-after inputpos)) 32)
- 63)))
- (if (/= counter 0) (setq remain (1- remain)))
- (setq counter (1+ counter)
- inputpos (1+ inputpos))
- (cond ((= counter 4)
- (uudecode-insert-char
- (lsh bits -16) 1 nil work-buffer)
- (uudecode-insert-char
- (logand (lsh bits -8) 255) 1 nil work-buffer)
- (uudecode-insert-char (logand bits 255) 1 nil
- work-buffer)
- (setq bits 0 counter 0))
- (t (setq bits (lsh bits 6)))))))
- (cond
- (done)
- ((> 0 remain)
- (error "uucode line ends unexpectly")
- (setq done t))
- ((and (= (point) end) (not done))
- ;;(error "uucode ends unexpectly")
- (setq done t))
- ((= counter 3)
- (uudecode-insert-char (logand (lsh bits -16) 255) 1 nil
- work-buffer)
- (uudecode-insert-char (logand (lsh bits -8) 255) 1 nil
- work-buffer))
- ((= counter 2)
- (uudecode-insert-char (logand (lsh bits -10) 255) 1 nil
- work-buffer)))
- (skip-chars-forward non-data-chars end))
- (if file-name
- (save-excursion
- (set-buffer work-buffer)
- (write-file file-name))
- (or (markerp end) (setq end (set-marker (make-marker) end)))
- (goto-char start)
- (insert-buffer-substring work-buffer)
- (delete-region (point) end))))
- (and work-buffer (kill-buffer work-buffer)))))
+ (insert (apply 'concat (nreverse result)))
+ (delete-region (point) end))))))
+
+;;;###autoload
+(defun uudecode-decode-region (start end &optional file-name)
+ "Uudecode region between START and END.
+If FILE-NAME is non-nil, save the result to FILE-NAME."
+ (if uudecode-use-external
+ (uudecode-decode-region-external start end file-name)
+ (uudecode-decode-region-internal start end file-name)))
(provide 'uudecode)
diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
index 981e8e367fe..b9670137139 100644
--- a/lisp/gnus/webmail.el
+++ b/lisp/gnus/webmail.el
@@ -1,5 +1,5 @@
;;; webmail.el --- interface of web mail
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2004 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: hotmail netaddress my-deja netscape
@@ -48,21 +48,16 @@
(require 'gnus)
(require 'nnmail)
(require 'mm-util)
+(require 'mm-url)
(require 'mml)
(eval-when-compile
(ignore-errors
- (require 'w3)
(require 'url)
- (require 'url-cookie)
- (require 'w3-forms)
- (require 'nnweb)))
+ (require 'url-cookie)))
;; Report failure to find w3 at load time if appropriate.
(eval '(progn
- (require 'w3)
(require 'url)
- (require 'url-cookie)
- (require 'w3-forms)
- (require 'nnweb)))
+ (require 'url-cookie)))
;;;
@@ -144,14 +139,12 @@
(my-deja
(paranoid cookie post)
(address . "www.my-deja.com")
- (open-url "http://www.deja.com/my/pr.xp")
- (open-snarf . webmail-my-deja-open)
+ ;;(open-snarf . webmail-my-deja-open)
(login-url
content
- ("%s" webmail-aux)
- "member_name=%s&pw=%s&go=&priv_opt_MyDeja99="
+ ("http://mydeja.google.com/cgi-bin/deja/maillogin.py")
+ "userid=%s&password=%s"
user password)
- (list-url "http://www.deja.com/rg_gotomail.xp")
(list-snarf . webmail-my-deja-list)
(article-snarf . webmail-my-deja-article)
(trash-url webmail-aux id))))
@@ -203,7 +196,7 @@
(insert "\n---------------- A bug at " str " ------------------\n")
(mapcar #'(lambda (sym)
(if (boundp sym)
- (pp `(setq ,sym ',(eval sym)) (current-buffer))))
+ (gnus-pp `(setq ,sym ',(eval sym)))))
'(webmail-type user))
(insert "---------------- webmail buffer ------------------\n\n")
(insert-buffer-substring webmail-buffer)
@@ -228,31 +221,6 @@
(set (intern (concat "webmail-" (symbol-name var))) (cdr pair))
(set (intern (concat "webmail-" (symbol-name var))) nil)))))
-(defun webmail-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun webmail-fetch-simple (url content)
- (let ((url-request-data content)
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (nnweb-insert url))
- t)
-
-(defun webmail-fetch-form (url pairs)
- (let ((url-request-data (webmail-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (nnweb-insert url))
- t)
-
(defun webmail-eval (expr)
(cond
((consp expr)
@@ -267,15 +235,15 @@
(cond
((eq (car xurl) 'content)
(pop xurl)
- (webmail-fetch-simple (if (stringp (car xurl))
+ (mm-url-fetch-simple (if (stringp (car xurl))
(car xurl)
(apply 'format (webmail-eval (car xurl))))
(apply 'format (webmail-eval (cdr xurl)))))
((eq (car xurl) 'post)
(pop xurl)
- (webmail-fetch-form (car xurl) (webmail-eval (cdr xurl))))
+ (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl))))
(t
- (nnweb-insert (apply 'format (webmail-eval xurl)))))))
+ (mm-url-insert (apply 'format (webmail-eval xurl)))))))
(defun webmail-init ()
"Initialize buffers and such."
@@ -317,7 +285,7 @@
(let ((url (match-string 1)))
(erase-buffer)
(mm-with-unibyte-current-buffer
- (nnweb-insert url)))
+ (mm-url-insert url)))
(goto-char (point-min))))
(defun webmail-fetch (file subtype user password)
@@ -359,7 +327,7 @@
(message "Fetching mail #%d..." (setq n (1+ n)))
(erase-buffer)
(mm-with-unibyte-current-buffer
- (nnweb-insert (cdr item)))
+ (mm-url-insert (cdr item)))
(setq id (car item))
(if webmail-article-snarf
(funcall webmail-article-snarf file id))
@@ -461,9 +429,8 @@
(if (not (search-forward "</pre>" nil t))
(webmail-error "article@3.1"))
(delete-region (match-beginning 0) (point-max))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(while (re-search-forward "\r\n?" nil t)
(replace-match "\n"))
@@ -494,9 +461,8 @@
(setq p (match-beginning 0))
(search-forward "</a>" nil t)
(delete-region p (match-end 0)))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(delete-blank-lines)
(goto-char (point-min))
@@ -516,7 +482,7 @@
(delete-region p (match-end 0))
(save-excursion
(set-buffer (generate-new-buffer " *webmail-att*"))
- (nnweb-insert attachment)
+ (mm-url-insert attachment)
(push (current-buffer) webmail-buffer-list)
(setq bufname (buffer-name)))
(setq mime t)
@@ -551,9 +517,8 @@
(goto-char (match-end 0))
(if (looking-at "$") (forward-char))
(delete-region (point-min) (point))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
nil)
(t
(setq mime t)
@@ -648,9 +613,8 @@
(setq p (match-beginning 0))
(search-forward "</a>" nil t)
(delete-region p (match-end 0)))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(delete-blank-lines)
(goto-char (point-max))
@@ -666,9 +630,8 @@
(if (not (search-forward "</table>" nil t))
(webmail-error "article@5"))
(narrow-to-region p (match-end 0))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(delete-blank-lines)
(setq ct (mail-fetch-field "content-type")
@@ -681,7 +644,7 @@
(widen)
(save-excursion
(set-buffer (generate-new-buffer " *webmail-att*"))
- (nnweb-insert (concat webmail-aux attachment))
+ (mm-url-insert (concat webmail-aux attachment))
(push (current-buffer) webmail-buffer-list)
(setq bufname (buffer-name)))
(insert "<#part")
@@ -776,9 +739,8 @@
(goto-char (point-min))
(while (re-search-forward "<br>" nil t)
(replace-match "\n"))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
nil)
(t
(insert "<#part type=\"text/html\" disposition=inline>")
@@ -806,9 +768,8 @@
(goto-char (point-min))
(while (search-forward "<b>" nil t)
(replace-match "\n"))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(delete-blank-lines)
(goto-char (point-min))
@@ -850,7 +811,7 @@
(let (bufname);; Attachment
(save-excursion
(set-buffer (generate-new-buffer " *webmail-att*"))
- (nnweb-insert (concat (car webmail-open-url) attachment))
+ (mm-url-insert (concat (car webmail-open-url) attachment))
(push (current-buffer) webmail-buffer-list)
(setq bufname (buffer-name)))
(insert "<#part type=" type)
@@ -934,9 +895,8 @@
(goto-char (point-min))
(while (search-forward "<b>" nil t)
(replace-match "\n"))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(delete-blank-lines)
(goto-char (point-min))
@@ -978,7 +938,7 @@
(let (bufname);; Attachment
(save-excursion
(set-buffer (generate-new-buffer " *webmail-att*"))
- (nnweb-insert (concat (car webmail-open-url) attachment))
+ (mm-url-insert (concat (car webmail-open-url) attachment))
(push (current-buffer) webmail-buffer-list)
(setq bufname (buffer-name)))
(insert "<#part type=" type)
@@ -1045,7 +1005,7 @@
(defun webmail-my-deja-open ()
(webmail-refresh-redirect)
(goto-char (point-min))
- (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\""
+ (if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\""
nil t)
(setq webmail-aux (match-string 1))
(webmail-error "open@1")))
@@ -1058,7 +1018,7 @@
(let ((url (match-string 1)))
(setq base (match-string 2))
(erase-buffer)
- (nnweb-insert url)))
+ (mm-url-insert url)))
(goto-char (point-min))
(when (re-search-forward
"(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
@@ -1095,9 +1055,8 @@
(match-beginning 0)
(point-max)))
(goto-char (point-min))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-max))))
((looking-at "[\t\040\r\n]*<TABLE")
(save-restriction
@@ -1126,7 +1085,7 @@
(delete-region (point-min) (point-max))
(save-excursion
(set-buffer (generate-new-buffer " *webmail-att*"))
- (nnweb-insert url)
+ (mm-url-insert url)
(push (current-buffer) webmail-buffer-list)
(setq bufname (buffer-name)))
(insert "<#part type=\"" type "\"")
@@ -1159,9 +1118,8 @@
(narrow-to-region (point-min) (point))
(while (search-forward "\r\n" nil t)
(replace-match "\n"))
- (nnweb-remove-markup)
- (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
- (nnweb-decode-entities))
+ (mm-url-remove-markup)
+ (mm-url-decode-entities-nbsp)
(goto-char (point-min))
(while (re-search-forward "\n\n+" nil t)
(replace-match "\n"))
diff --git a/lisp/gnus/wry.xpm b/lisp/gnus/wry.xpm
new file mode 100644
index 00000000000..8cd8dedce65
--- /dev/null
+++ b/lisp/gnus/wry.xpm
@@ -0,0 +1,20 @@
+/* XPM */
+static char * wry_xpm[] = {
+"13 14 3 1",
+" c None",
+". c #000000",
+"+ c #FFDD00",
+" ....... ",
+" ..+++++.. ",
+" .+++++++++. ",
+".+++++++++++.",
+".+++++++..++.",
+".++..+++..++.",
+".++..+++++++.",
+".+++++++++++.",
+".+++++++...+.",
+".+++++...+++.",
+".++++..+++++.",
+" .+++.+++++. ",
+" ..+++++.. ",
+" ....... "};
diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el
new file mode 100644
index 00000000000..ed0d9506393
--- /dev/null
+++ b/lisp/gnus/yenc.el
@@ -0,0 +1,121 @@
+;;; yenc.el --- elisp native yenc decoder
+;; Copyright (c) 2002 Free Software Foundation, Inc.
+
+;; Author: Jesper Harder <harder@ifa.au.dk>
+;; Keywords: yenc news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Functions for decoding yenc encoded messages.
+;;
+;; Limitations:
+;;
+;; * Does not handle multipart messages.
+;; * No support for external decoders.
+;; * Doesn't check the crc32 checksum (if present).
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defconst yenc-begin-line
+ "^=ybegin.*$")
+
+(defconst yenc-decoding-vector
+ [214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
+ 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
+ 248 249 250 251 252 253 254 255 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
+ 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
+ 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
+ 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
+ 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
+ 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
+ 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
+ 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
+ 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
+ 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+ 208 209 210 211 212 213])
+
+;;;###autoload
+(defun yenc-decode-region (start end)
+ "Yenc decode region between START and END using an internal decoder."
+ (interactive "r")
+ (let (work-buffer)
+ (unwind-protect
+ (save-excursion
+ (goto-char start)
+ (when (re-search-forward yenc-begin-line end t)
+ (let ((first (match-end 0))
+ (header-alist (yenc-parse-line (match-string 0)))
+ bytes last footer-alist char)
+ (when (re-search-forward "^=ypart.*$" end t)
+ (setq first (match-end 0)))
+ (when (re-search-forward "^=yend.*$" end t)
+ (setq last (match-beginning 0))
+ (setq footer-alist (yenc-parse-line (match-string 0)))
+ (let (default-enable-multibyte-characters)
+ (setq work-buffer (generate-new-buffer " *yenc-work*")))
+ (while (< first last)
+ (setq char (char-after first))
+ (cond ((or (eq char ?\r)
+ (eq char ?\n)))
+ ((eq char ?=)
+ (setq char (char-after (incf first)))
+ (with-current-buffer work-buffer
+ (insert-char (mod (- char 106) 256) 1)))
+ (t
+ (with-current-buffer work-buffer
+ ;;(insert-char (mod (- char 42) 256) 1)
+ (insert-char (aref yenc-decoding-vector char) 1))))
+ (incf first))
+ (setq bytes (buffer-size work-buffer))
+ (unless (and (= (cdr (assq 'size header-alist)) bytes)
+ (= (cdr (assq 'size footer-alist)) bytes))
+ (message "Warning: Size mismatch while decoding."))
+ (goto-char start)
+ (delete-region start end)
+ (insert-buffer-substring work-buffer))))
+ (and work-buffer (kill-buffer work-buffer))))))
+
+;;;###autoload
+(defun yenc-extract-filename ()
+ "Extract file name from an yenc header."
+ (save-excursion
+ (when (re-search-forward yenc-begin-line nil t)
+ (cdr (assoc 'name (yenc-parse-line (match-string 0)))))))
+
+(defun yenc-parse-line (str)
+ "Extract file name and size from STR."
+ (let (result name)
+ (when (string-match "^=y.*size=\\([0-9]+\\)" str)
+ (push (cons 'size (string-to-number (match-string 1 str))) result))
+ (when (string-match "^=y.*name=\\(.*\\)$" str)
+ (setq name (match-string 1 str))
+ ;; Remove trailing white space
+ (when (string-match " +$" name)
+ (setq name (substring name 0 (match-beginning 0))))
+ (push (cons 'name name) result))
+ result))
+
+(provide 'yenc)
+
+;;; arch-tag: 74df17e8-6fa8-4071-9f7d-54d548d79d9a
+;;; yenc.el ends here
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index dd161032d9a..d7c8a47a2c0 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -66,7 +66,7 @@ after successful negotiation."
:group 'tls)
(defcustom tls-process-connection-type nil
- "*Value for `process-connection-type' to use when starting process."
+ "*Value for `process-connection-type' to use when starting TLS process."
:type 'boolean
:group 'tls)