From 2ff131474a99f8d5658c3cd0e2398070750d78ad Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 18 Mar 2003 00:45:40 +0000 Subject: [PATCH] T-gnus 6.15.16 r00. --- ChangeLog | 31 + GNUS-NEWS | 31 +- Mule23@1934.en | 15 + Mule23@1934.ja | 15 + README.T-gnus | 2 +- README.semi | 2 +- README.semi.ja | 2 +- contrib/ChangeLog | 24 + contrib/gnus-idna.el | 116 ++++ contrib/hashcash.el | 71 ++- contrib/passwd.el | 386 ++++++++++++ lisp/ChangeLog | 1104 +++++++++++++++++++++++++++++++--- lisp/canlock.el | 20 +- lisp/gnus-agent.el | 1605 ++++++++++++++++++++++++++++++------------------- lisp/gnus-art.el | 511 ++++++++++++---- lisp/gnus-cache.el | 5 +- lisp/gnus-cite.el | 66 +- lisp/gnus-cus.el | 312 +++++++++- lisp/gnus-draft.el | 18 +- lisp/gnus-group.el | 8 +- lisp/gnus-int.el | 22 +- lisp/gnus-kill.el | 2 +- lisp/gnus-mailcap.el | 2 +- lisp/gnus-msg.el | 45 +- lisp/gnus-offline.el | 2 +- lisp/gnus-ofsetup.el | 4 - lisp/gnus-registry.el | 68 ++- lisp/gnus-score.el | 2 +- lisp/gnus-spec.el | 2 +- lisp/gnus-start.el | 151 ++++- lisp/gnus-sum.el | 195 +++--- lisp/gnus-topic.el | 24 +- lisp/gnus-util.el | 92 ++- lisp/gnus-uu.el | 4 +- lisp/gnus-vers.el | 4 +- lisp/gnus-xmas.el | 6 +- lisp/gnus.el | 39 +- lisp/html2text.el | 45 +- lisp/ietf-drums.el | 2 +- lisp/imap.el | 53 +- lisp/lpath.el | 5 +- lisp/mail-source.el | 118 ++-- lisp/message.el | 122 +++- lisp/mm-bodies.el | 24 +- lisp/mm-decode.el | 12 +- lisp/mm-url.el | 2 +- lisp/mm-util.el | 4 +- lisp/mm-uu.el | 4 +- lisp/mm-view.el | 24 +- lisp/mml1991.el | 47 +- lisp/nndb.el | 4 +- lisp/nndoc.el | 10 +- lisp/nndraft.el | 10 +- lisp/nnfolder.el | 18 +- lisp/nnheader.el | 14 +- lisp/nnimap.el | 17 +- lisp/nnkiboze.el | 2 +- lisp/nnmail.el | 16 +- lisp/nnmaildir.el | 73 ++- lisp/nnmbox.el | 7 +- lisp/nnmh.el | 4 +- lisp/nnml.el | 5 +- lisp/nnrss.el | 2 +- lisp/nntp.el | 66 +- lisp/nnvirtual.el | 2 +- lisp/nnwarchive.el | 3 +- lisp/pop3.el | 17 +- lisp/rfc2047.el | 9 +- lisp/sieve-manage.el | 19 +- lisp/spam.el | 278 ++++++--- texi/ChangeLog | 121 ++++ texi/emacs-mime.texi | 58 +- texi/gnus-ja.texi | 718 +++++++++++++++------- texi/gnus.texi | 699 +++++++++++++++------ texi/gnusref.tex | 16 +- texi/message-ja.texi | 28 +- texi/message.texi | 27 +- 77 files changed, 5770 insertions(+), 1943 deletions(-) create mode 100644 contrib/gnus-idna.el create mode 100644 contrib/passwd.el diff --git a/ChangeLog b/ChangeLog index 187fd1e..b316707 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,34 @@ +2003-03-18 Katsumi Yamaoka + + * lisp/gnus-vers.el: T-gnus 6.15.16 revision 00. + +2003-03-04 Katsumi Yamaoka + + * lisp/gnus-ofsetup.el: Don't require `read-passwd'; don't set + `mail-source-read-passwd' and `gnus-setup-news-hook'. + + * contrib/passwd.el: New file. + +2003-02-20 Katsumi Yamaoka + + * lisp/gnus-offline.el (gnus-offline-add-custom-header): Use + insert instead of insert-string which is obsolete in Emacs 21.4 + (synch to the change of Jesper Harder at 2003-02-20). + +2003-02-19 Reiner Steib + + * GNUS-NEWS: Renamed `gnus-unsightly-citation-regexp' to + `gnus-cite-unsightly-citation-regexp'. + +2003-02-18 Simon Josefsson + + * GNUS-NEWS: Talk about canlock more. + +2003-02-13 Kai Gro,A_(Bjohann + + * GNUS-NEWS: Add user visible changes from Michael Shields from + the past couple of days. Actual text from Michael. + 2003-02-09 Katsumi Yamaoka * lisp/gnus-vers.el: T-gnus 6.15.15 revision 00. diff --git a/GNUS-NEWS b/GNUS-NEWS index dc49807..b399c7b 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -8,6 +8,25 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** Better handling of Microsoft citation styles + +Gnus now tries to recognize the mangled header block that some Microsoft +mailers use to indicate that the rest of the message is a citation, even +though it is not quoted in any way. The variable +`gnus-cite-unsightly-citation-regexp' matches the start of these +citations. + +** gnus-article-skip-boring + +If you set `gnus-article-skip-boring' to t, then Gnus will not scroll +down to show you a page that contains only boring text, which by +default means cited text and signature. You can customize what is +skippable using `gnus-article-boring-faces'. + +This feature is especially useful if you read many articles that +consist of a little new content at the top with a long, untrimmed +message cited below. + ** The format spec %C for positioning point has changed to %*. ** The new variable `gnus-parameters' can be used to set group parameters. @@ -217,10 +236,14 @@ values. ** Gnus supports Cancel Locks in News. -This means a header "Cancel-Lock" is inserted in news posting. It is -used to determine if you wrote a article or not (for -cancelling/superseding). The behaviour can be changed by customizing -`message-insert-canlock'. +This means a header "Cancel-Lock" is inserted in news posting. It is +used to determine if you wrote a article or not (for cancelling and +superseding). Gnus generates a random password string the first time +you post a message, and saves it in your ~/.emacs using the Custom +system. While the variable is called `canlock-password', it is not +security sensitive data. Publishing your canlock string on the web +will not allow anyone to be able to anything she could not already do. +The behaviour can be changed by customizing `message-insert-canlock'. ** Gnus supports server-side mail filtering using Sieve. diff --git a/Mule23@1934.en b/Mule23@1934.en index f88af6c..9ed0acf 100644 --- a/Mule23@1934.en +++ b/Mule23@1934.en @@ -80,6 +80,21 @@ other directory), and byte-compile it as follows: % mule -batch -q -no-site-file -f batch-byte-compile regexp-opt.el +INSTALL passwd.el +================= + +This module provide the `read-passwd' function. You have to install +it if you don't have that function. To do this: + + % cp -p contrib/passwd.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile passwd.el + +And add the following line in your .emacs file: + + (autoload 'read-passwd "passwd") + + INSTALL T-gnus ============== diff --git a/Mule23@1934.ja b/Mule23@1934.ja index 32c053d..3bcdc8a 100644 --- a/Mule23@1934.ja +++ b/Mule23@1934.ja @@ -82,6 +82,21 @@ T-gnus $B$N$$$/$D$+$N%b%8%e!<%k$O(B `regexp-opt' $B$J$I$N4X?t$r;H$$$^$9!#$=( % mule -batch -q -no-site-file -f batch-byte-compile regexp-opt.el +INSTALL passwd.el +================= + +$B$3$N%b%8%e!<%k$O(B `read-passwd' $B4X?t$rDs6!$7$^$9!#L5$$>l9g$O%$%s%9%H!<(B +$B%k$7$J$1$l$P$J$j$^$;$s!#$=$l$K$O$3$&$7$F2<$5$$!#(B + + % cp -p contrib/passwd.el /usr/local/share/mule/site-lisp + % cd /usr/local/share/mule/site-lisp/ + % mule -batch -q -no-site-file -f batch-byte-compile passwd.el + +$B$=$7$F(B .emacs $B%U%!%$%k$K0J2<$N9T$rDI2C$7$F2<$5$$!#(B + + (autoload 'read-passwd "passwd") + + INSTALL T-gnus ============== diff --git a/README.T-gnus b/README.T-gnus index 5841ece..df6c3fd 100644 --- a/README.T-gnus +++ b/README.T-gnus @@ -33,5 +33,5 @@ NEWS: * T-gnus 6.15 - this is based on Oort Gnus. - The latest T-gnus is T-gnus 6.15.15 (based on Oort Gnus 0.15). It + The latest T-gnus is T-gnus 6.15.16 (based on Oort Gnus 0.16). It requires SEMI 1.14, FLIM 1.14, and APEL 10.0 or later. diff --git a/README.semi b/README.semi index ad0949a..94ffae8 100644 --- a/README.semi +++ b/README.semi @@ -4,7 +4,7 @@ What is T-gnus? =============== T-gnus is an improvement of Gnus with SEMI's MIME feature. T-gnus -6.15 is based on Oort Gnus v0.15. SEMI may stand for "SEMI is Emacs +6.15 is based on Oort Gnus v0.16. SEMI may stand for "SEMI is Emacs MIME Interface" and is developped to provide an easy interfaces for users to handle MIME message structures. For further information, refer to REASME.en of SEMI. diff --git a/README.semi.ja b/README.semi.ja index c2dc0cd..47da900 100644 --- a/README.semi.ja +++ b/README.semi.ja @@ -4,7 +4,7 @@ T-gnus $B$H$O!)(B ============= T-gnus $B$O!"(BSEMI $B$rMxMQ$7$F(B Gnus $B$K(B MIME $B5!G=$rDI2C$9$k$b$N$G$9!#(B -T-gnus 6.15 $B$O(B Oort Gnus v0.15 $B$r%Y!<%9$K$7$F$$$^$9!#(BSEMI $B$O(B Emacs $B$G(B +T-gnus 6.15 $B$O(B Oort Gnus v0.16 $B$r%Y!<%9$K$7$F$$$^$9!#(BSEMI $B$O(B Emacs $B$G(B MIME $B$r;H$($k$h$&$K$9$k$b$N$G!"(BMIME message $B$N9=J8$N9=B$$HMxMQ\$7$/$O!"(BSEMI $B$N(B README.en $B$r;2>H(B $B$7$F$/$@$5$$!#(B diff --git a/contrib/ChangeLog b/contrib/ChangeLog index f8271d6..4f6586b 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,27 @@ +2003-03-11 Teodor Zlatanov + + * hashcash.el (hashcash-version, hashcash-insert-payment): patch + from Paul Foley + +2003-03-07 Simon Josefsson + + * gnus-idna.el (gnus-idna-to-ascii-rhs-1): Narrow to + head (otherwise forwarded mail break havoc). + +2003-03-07 Teodor Zlatanov + + * hashcash.el: New version from Paul Foley with better variable + names, executable-find support, and no errors in GNU Emacs + (hashcash-version): return nil when invoked with a + nil token + +2003-02-21 Simon Josefsson + + * hashcash.el (hashcash-point-at-bol): + (hashcash-point-at-eol): Defalias. + (hashcash-generate-payment): + (mail-check-payment): Use it. + 2002-12-30 Lars Magne Ingebrigtsen * hashcash.el: New version from Paul Foley with new diff --git a/contrib/gnus-idna.el b/contrib/gnus-idna.el new file mode 100644 index 0000000..32eb2f8 --- /dev/null +++ b/contrib/gnus-idna.el @@ -0,0 +1,116 @@ +;;; gnus-idna.el --- Internationalized domain names support for Gnus. + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: news, mail + +;; 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 implement crude support for internationalized +;; (non-ASCII) domain names in Gnus. It is meant as a proof of +;; concept. + +;; Theory of Operation: + +;; RFC 2822 RHS's inside the From:, To:, and CC: headers are encoded +;; using IDNA ToASCII() when you send mail using Message. The hook +;; used is message-send-hook. +;; +;; For incoming articles, when QP in headers are decoded, it searches +;; for "xn--" prefixes and decode them using IDNA ToUnicode(). The +;; hook used is gnus-article-decode-hook. + +;; Usage: + +;; Simply put (require 'gnus-idna) in your ~/.gnus or ~/.emacs and it +;; should work. You need to install GNU Libidn (0.1.11 or later) and +;; make sure the idna.el installed by it is found by emacs. + +;;; Code: + +(require 'gnus) +(require 'rfc822) +(require 'idna) + +(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)))) + +(defun gnus-idna-to-ascii-rhs-1 (header) + (save-excursion + (save-restriction + (let (address header-data new-header-data rhs ace) + (message-narrow-to-head) + (setq header-data (message-fetch-field header)) + (when header-data + (dolist (element (message-tokenize-header header-data)) + (setq address (car (rfc822-addresses element))) + (when (string-match "\\(.*\\)@\\([^@]+\\)" address) + (setq ace (if (setq rhs (match-string 2 address)) + (idna-to-ascii rhs))) + (push (if (string= rhs ace) + element + (gnus-replace-in-string + element (regexp-quote rhs) ace t)) + new-header-data))) + (message-remove-header header) + (message-position-on-field header) + (dolist (addr (reverse new-header-data)) + (insert addr ", ")) + (when new-header-data + (delete-backward-char 2))))))) + +(defun gnus-idna-to-ascii-rhs () + (gnus-idna-to-ascii-rhs-1 "From") + (gnus-idna-to-ascii-rhs-1 "To") + (gnus-idna-to-ascii-rhs-1 "Cc")) + +(add-hook 'message-send-hook 'gnus-idna-to-ascii-rhs) + +(defun gnus-idna-to-unicode-rhs () + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (goto-char (point-min)) + (while (re-search-forward "xn--.*[ \t\n\r.,<>()@!]" nil t) + ;(or (eobp) (forward-char)) + (let (ace unicode) + (when (setq ace (match-string 0)) + (setq unicode (idna-to-unicode ace)) + (unless (string= ace unicode) + (replace-match unicode))))))) + +(add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append) + +(provide 'gnus-idna) + +;; gnus-idna.el ends here diff --git a/contrib/hashcash.el b/contrib/hashcash.el index 5ec251f..6966b21 100644 --- a/contrib/hashcash.el +++ b/contrib/hashcash.el @@ -1,11 +1,13 @@ ;;; hashcash.el --- Add hashcash payments to email -;; Copyright (C) 1997,2001 Paul E. Foley +;; Copyright (C) 1997--2002 Paul E. Foley +;; Copyright (C) 2003 Free Software Foundation ;; Maintainer: Paul Foley ;; Keywords: mail, hashcash ;; Released under the GNU General Public License +;; (http://www.gnu.org/licenses/gpl.html) ;;; Commentary: @@ -21,6 +23,9 @@ (eval-when-compile (require 'cl)) +(eval-and-compile + (autoload 'executable-find "executable")) + (defcustom hashcash-default-payment 0 "*The default number of bits to pay to unknown users. If this is zero, no payment header will be generated. @@ -38,13 +43,13 @@ present, is the string to be hashed; if not present ADDR will be used.") "*The default minimum number of bits to accept on incoming payments." :type 'integer) -(defcustom hashcash-accept-resources `((,(user-mail-address) nil)) +(defcustom hashcash-accept-resources `((,user-mail-address nil)) "*An association list mapping hashcash resources to payment amounts. Resources named here are to be accepted in incoming payments. If the corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment' is used instead.") -(defcustom hashcash "/usr/local/bin/hashcash" +(defcustom hashcash-path (executable-find "hashcash") "*The path to the hashcash binary.") (defcustom hashcash-double-spend-database "hashcash.db" @@ -56,6 +61,16 @@ is used instead.") (require 'mail-utils) +(defalias 'hashcash-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + +(defalias 'hashcash-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position)) + (defun hashcash-strip-quoted-names (addr) (setq addr (mail-strip-quoted-names addr)) (if (and addr (string-match "^[^+@]+\\(\\+[^@]*\\)@" addr)) @@ -87,20 +102,36 @@ is used instead.") (save-excursion (set-buffer (get-buffer-create " *hashcash*")) (erase-buffer) - (call-process hashcash nil t nil (concat "-b " (number-to-string val)) - str) + (call-process hashcash-path nil t nil + (concat "-b " (number-to-string val)) str) (goto-char (point-min)) - (buffer-substring (point-at-bol) (point-at-eol))) + (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol))) nil)) (defun hashcash-check-payment (token str val) "Check the validity of a hashcash payment." - (zerop (call-process hashcash nil nil nil "-c" + (zerop (call-process hashcash-path nil nil nil "-c" "-d" "-f" hashcash-double-spend-database "-b" (number-to-string val) "-r" str token))) +(defun hashcash-version (token) + "Find the format version of a hashcash token." + ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; This carries its own version number embedded in the token, + ;; so no further format number changes should be necessary + ;; in the X-Payment header. + ;; + ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; You need to upgrade your hashcash binary. + ;; + ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx + ;; This is no longer supported. + (cond ((equal (aref token 1) ?:) 1.2) + ((equal (aref token 6) ?:) 1.1) + (t (error "Unknown hashcash format version")))) + ;;;###autoload (defun hashcash-insert-payment (arg) "Insert X-Payment and X-Hashcash headers with a payment for ARG" @@ -108,13 +139,17 @@ is used instead.") (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) (hashcash-payment-required arg)))) (when pay - (insert-before-markers "X-Payment: hashcash 1.1 " pay "\n") + (insert-before-markers "X-Payment: hashcash " + (number-to-string (hashcash-version pay)) " " + pay "\n") (insert-before-markers "X-Hashcash: " pay "\n")))) ;;;###autoload (defun hashcash-verify-payment (token &optional resource amount) "Verify a hashcash payment" - (let ((key (cadr (split-string-by-char token ?:)))) + (let ((key (if (< (hashcash-version token) 1.2) + (cadr (split-string token ":")) + (caddr (split-string token ":"))))) (cond ((null resource) (let ((elt (assoc key hashcash-accept-resources))) (and elt (hashcash-check-payment token (car elt) @@ -160,25 +195,27 @@ for each recipient address. Prefix arg sets default payment temporarily." Prefix arg sets default accept amount temporarily." (interactive "P") (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg) - hashcash-default-accept-payment))) + hashcash-default-accept-payment)) + (version (hashcash-version (hashcash-generate-payment "x" 1)))) (save-excursion (goto-char (point-min)) - (search-forward mail-header-separator) + (search-forward "\n\n") (beginning-of-line) (let ((end (point)) (ok nil)) (goto-char (point-min)) - (while (and (not ok) (search-forward "X-Payment: hashcash 1.1 " end t)) - (setq ok (hashcash-verify-payment - (buffer-substring (point) (point-at-eol))))) + (while (and (not ok) (search-forward "X-Payment: hashcash " end t)) + (let ((value (split-string + (buffer-substring (point) (hashcash-point-at-eol)) + " "))) + (when (equal (car value) (number-to-string version)) + (setq ok (hashcash-verify-payment (cadr value)))))) (goto-char (point-min)) (while (and (not ok) (search-forward "X-Hashcash: " end t)) (setq ok (hashcash-verify-payment - (buffer-substring (point) (point-at-eol))))) + (buffer-substring (point) (hashcash-point-at-eol))))) (when ok (message "Payment valid")) ok)))) (provide 'hashcash) - -;;; hashcash.el ends here diff --git a/contrib/passwd.el b/contrib/passwd.el new file mode 100644 index 0000000..0257469 --- /dev/null +++ b/contrib/passwd.el @@ -0,0 +1,386 @@ +;;; passwd.el --- Prompting for passwords semi-securely + +;; Copyright (C) 1994 Free Software Foundation, Inc. +;; Keywords: comm, extensions + +;; Author: Jamie Zawinski + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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. + +;;; Synched up with: Not in FSF. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Change Log: +;; +;; Sun Jun 12 04:19:30 1994 by sandy on ibm550.sissa.it +;; Added support for password histories and (provide 'passwd) +;; (jwz says: this "history" thing is completely undocumented, you loser!) +;; 2-Jan-95 (mon); 4:13 AM by jwz@netscape.com +;; Fixed Sandy's extreme keymap bogosity. Made it invert the screen when +;; reading securely (this could be better; maybe use red text or something +;; instead...) +;; 9-Jul-95 (fri); 4:55 AM by jwz@netscape.com +;; Made it work with XEmacs 19.12. +;; 7-Jul-95 by cthomp@cs.uiuc.edu +;; Added variable to control inverting frame when keyboard grabbed + +;;; Code: + +(defvar passwd-invert-frame-when-keyboard-grabbed t + "*If non-nil swap the foreground and background colors of all faces. +This is done while the keyboard is grabbed in order to give a visual +clue that a grab is in effect.") + +(defvar passwd-echo ?. + "*The character which should be echoed when typing a password, +or nil, meaning echo nothing.") + +(defvar read-passwd-map + (let ((i 0) + (s (make-string 1 0)) + map) + (cond ((fboundp 'set-keymap-parent) + (setq map (make-keymap)) + (set-keymap-parent map minibuffer-local-map)) + (t ; v18/FSFmacs compatibility + (setq map (copy-keymap minibuffer-local-map)))) + (if (fboundp 'set-keymap-name) + (set-keymap-name map 'read-passwd-map)) + + (while (< i 127) + (aset s 0 i) + (or (and (boundp 'meta-prefix-char) (eq i meta-prefix-char)) + (define-key map s 'self-insert-command)) + (setq i (1+ i))) + + (define-key map "\C-g" 'keyboard-quit) + (define-key map "\C-h" 'delete-backward-char) + (define-key map "\r" 'exit-minibuffer) + (define-key map "\n" 'exit-minibuffer) + (define-key map "\C-u" 'passwd-erase-buffer) + (define-key map "\C-q" 'quoted-insert) + (define-key map "\177" 'delete-backward-char) + (define-key map "\M-n" 'passwd-next-history-element) + (define-key map "\M-p" 'passwd-previous-history-element) + map) + "Keymap used for reading passwords in the minibuffer. +The \"bindings\" in this map are not real commands; only a limited +number of commands are understood. The important bindings are: +\\ + \\[passwd-erase-buffer] Erase all input. + \\[quoted-insert] Insert the next character literally. + \\[delete-backward-char] Delete the previous character. + \\[exit-minibuffer] Accept what you have typed. + \\[keyboard-quit] Abort the command. + +All other characters insert themselves (but do not echo.)") + +;;; internal variables + +(defvar passwd-history nil) +(defvar passwd-history-posn 0) + +;;;###autoload +(defun read-passwd (prompt &optional confirm default) + "Prompts for a password in the minibuffer, and returns it as a string. +If PROMPT may be a prompt string or an alist of elements +'\(prompt . default\). +If optional arg CONFIRM is true, then ask the user to type the password +again to confirm that they typed it correctly. +If optional arg DEFAULT is provided, then it is a string to insert as +the default choice (it is not, of course, displayed.) + +If running under X, the keyboard will be grabbed (with XGrabKeyboard()) +to reduce the possibility that evesdropping is occuring. + +When reading a password, all keys self-insert, except for: +\\ + \\[read-passwd-erase-line] Erase the entire line. + \\[quoted-insert] Insert the next character literally. + \\[delete-backward-char] Delete the previous character. + \\[exit-minibuffer] Accept what you have typed. + \\[keyboard-quit] Abort the command. + +The returned value is always a newly-created string. No additional copies +of the password remain after this function has returned. + +NOTE: unless great care is taken, the typed password will exist in plaintext +form in the running image for an arbitrarily long time. Priveleged users may +be able to extract it from memory. If emacs crashes, it may appear in the +resultant core file. + +Some steps you can take to prevent the password from being copied around: + + - as soon as you are done with the returned string, destroy it with + (fillarray string 0). The same goes for any default passwords + or password histories. + + - do not copy the string, as with concat or substring - if you do, be + sure to keep track of and destroy all copies. + + - do not insert the password into a buffer - if you do, be sure to + overwrite the buffer text before killing it, as with the functions + `passwd-erase-buffer' or `passwd-kill-buffer'. Note that deleting + the text from the buffer does NOT necessarily remove the text from + memory. + + - be careful of the undo history - if you insert the password into a + buffer which has undo recording turned on, the password will be + copied onto the undo list, and thus recoverable. + + - do not pass it as an argument to a shell command - anyone will be + able to see it if they run `ps' at the right time. + +Note that the password will be temporarily recoverable with the `view-lossage' +command. This data will not be overwritten until another hundred or so +characters are typed. There's not currently a way around this." + + (save-excursion + (let ((input (get-buffer-create " *password*")) + (passwd-history-posn 0) + passwd-history) + (if (listp prompt) + (setq passwd-history prompt + default (cdr (car passwd-history)))) + (set-buffer input) + (buffer-disable-undo input) + (use-local-map read-passwd-map) + (unwind-protect + (progn + (if (passwd-grab-keyboard) + (passwd-secure-display)) + (read-passwd-1 input prompt nil default) + (set-buffer input) + + (if (not confirm) + (buffer-string) + (let ((ok nil) + passwd) + (while (not ok) + (set-buffer input) + (setq passwd (buffer-string)) + (read-passwd-1 input prompt "[Retype to confirm]") + (if (passwd-compare-string-to-buffer passwd input) + (setq ok t) + (fillarray passwd 0) + (setq passwd nil) + (beep) + (read-passwd-1 input prompt "[Mismatch. Start over]") + )) + passwd))) + ;; protected + (passwd-ungrab-keyboard) + (passwd-insecure-display) + (passwd-kill-buffer input) + (if (fboundp 'clear-message) ;XEmacs + (clear-message) + (message "")) + )))) + + +(defun read-passwd-1 (buffer prompt &optional prompt2 default) + (set-buffer buffer) + (passwd-erase-buffer) + (if default (insert default)) + (catch 'exit ; exit-minibuffer throws here + (while t + (set-buffer buffer) + (let* ((minibuffer-completion-table nil) + (cursor-in-echo-area t) + (echo-keystrokes 0) + (key (passwd-read-key-sequence + (concat (if (listp prompt) + (car (nth passwd-history-posn passwd-history)) + prompt) + prompt2 + (if passwd-echo + (make-string (buffer-size) passwd-echo))))) + (binding (key-binding key))) + (setq prompt2 nil) + (set-buffer buffer) ; just in case... + (if (fboundp 'event-to-character) ;; lemacs + (setq last-command-event (aref key (1- (length key))) + last-command-char (event-to-character last-command-event)) + ;; v18/FSFmacs compatibility + (setq last-command-char (aref key (1- (length key))))) + (setq this-command binding) + (condition-case c + (command-execute binding) + (error + (beep) + (if (fboundp 'display-error) + (display-error c t) + ;; v18/FSFmacs compatibility + (message (concat (or (get (car-safe c) 'error-message) "???") + (if (cdr-safe c) ": ") + (mapconcat + (function (lambda (x) (format "%s" x))) + (cdr-safe c) ", ")))) + (sit-for 2))) + )))) + +(defun passwd-previous-history-element (n) + (interactive "p") + (or passwd-history + (error "Password history is empty.")) + (let ((l (length passwd-history))) + (setq passwd-history-posn + (% (+ n passwd-history-posn) l)) + (if (< passwd-history-posn 0) + (setq passwd-history-posn (+ passwd-history-posn l)))) + (let ((obuff (current-buffer))) ; want to move point in passwd buffer + (unwind-protect + (progn + (set-buffer " *password*") + (passwd-erase-buffer) + (insert (cdr (nth passwd-history-posn passwd-history)))) + (set-buffer obuff)))) + +(defun passwd-next-history-element (n) + (interactive "p") + (passwd-previous-history-element (- n))) + +(defun passwd-erase-buffer () + ;; First erase the buffer, which will simply enlarge the gap. + ;; Then insert null characters until the gap is filled with them + ;; to prevent the old text from being visible in core files or kmem. + ;; (Actually use 3x the size of the buffer just to be safe - a longer + ;; passwd might have been typed and backspaced over.) + (interactive) + (widen) + (let ((s (* (buffer-size) 3))) + (erase-buffer) + (while (> s 0) + (insert ?\000) + (setq s (1- s))) + (erase-buffer))) + +(defun passwd-kill-buffer (buffer) + (save-excursion + (set-buffer buffer) + (buffer-disable-undo buffer) + (passwd-erase-buffer) + (set-buffer-modified-p nil)) + (kill-buffer buffer)) + + +(defun passwd-compare-string-to-buffer (string buffer) + ;; same as (equal string (buffer-string)) but with no dangerous consing. + (save-excursion + (set-buffer buffer) + (goto-char (point-min)) + (let ((L (length string)) + (i 0)) + (if (/= L (- (point-max) (point-min))) + nil + (while (not (eobp)) + (if (/= (following-char) (aref string i)) + (goto-char (point-max)) + (setq i (1+ i)) + (forward-char))) + (= (point) (+ i (point-min))))))) + + +(defvar passwd-face-data nil) +(defun passwd-secure-display () + ;; Inverts the screen - used to indicate secure input, like xterm. + (cond + ((and passwd-invert-frame-when-keyboard-grabbed + (fboundp 'set-face-foreground)) + (setq passwd-face-data + (delq nil (mapcar (function + (lambda (face) + (let ((fg (face-foreground face)) + (bg (face-background face))) + (if (or fg bg) + (if (fboundp 'color-name) + (list face + (color-name fg) + (color-name bg)) + (list face fg bg)) + nil)))) + (if (fboundp 'list-faces) + (list-faces) ; lemacs + (face-list) ; FSFmacs + )))) + (let ((rest passwd-face-data)) + (while rest + (set-face-foreground (nth 0 (car rest)) (nth 2 (car rest))) + (set-face-background (nth 0 (car rest)) (nth 1 (car rest))) + (setq rest (cdr rest)))))) + nil) + +(defun passwd-insecure-display () + ;; Undoes the effect of `passwd-secure-display'. + (cond + (passwd-invert-frame-when-keyboard-grabbed + (while passwd-face-data + (set-face-foreground (nth 0 (car passwd-face-data)) + (nth 1 (car passwd-face-data))) + (set-face-background (nth 0 (car passwd-face-data)) + (nth 2 (car passwd-face-data))) + (setq passwd-face-data (cdr passwd-face-data))) + nil))) + +(defun passwd-grab-keyboard () + (cond ((not (and (fboundp 'x-grab-keyboard) ; lemacs 19.10+ + (eq 'x (if (fboundp 'frame-type) + (frame-type (selected-frame)) + (live-screen-p (selected-screen)))))) + nil) + ((x-grab-keyboard) + t) + (t + (message "Unable to grab keyboard - waiting a second...") + (sleep-for 1) + (cond ((x-grab-keyboard) + (message "Keyboard grabbed on second try.") + t) + (t + (beep) + (message "WARNING: keyboard is insecure (unable to grab!)") + (sleep-for 3) + nil))))) + +(defun passwd-ungrab-keyboard () + (if (and (fboundp 'x-ungrab-keyboard) ; lemacs 19.10+ + (eq 'x (if (fboundp 'frame-type) + (frame-type (selected-frame)) + (live-screen-p (selected-screen))))) + (x-ungrab-keyboard))) + +;; v18 compatibility +(or (fboundp 'buffer-disable-undo) + (fset 'buffer-disable-undo 'buffer-flush-undo)) + +;; read-key-sequence echoes the key sequence in Emacs 18. +(defun passwd-read-key-sequence (prompt) + (let ((inhibit-quit t) + str) + (while (or (null str) (keymapp (key-binding str))) + (if (fboundp 'display-message) + (display-message 'prompt prompt) + (message prompt)) + (setq str (concat str (char-to-string (read-char))))) + (setq quit-flag nil) + str)) + +(or (string-match "^18" emacs-version) + (fset 'passwd-read-key-sequence 'read-key-sequence)) + +(provide 'passwd) + +;;; passwd.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d04dbef..e6dd576 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,970 @@ +2003-03-18 00:38:22 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.16 is released. + +2003-03-18 Lars Magne Ingebrigtsen + + * lpath.el (featurep): Bind mm-w3m-mode-map. + +2003-03-12 Paul Jarc + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * nnmaildir.el (nnmaildir-request-update-info): Pretend missing + articles are marked 'read, so we get correct article counts. + +2003-03-13 Katsumi Yamaoka + + * 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 . + (mm-inline-image-xemacs): Ditto. + +2003-03-12 Paul Jarc + + * 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 + + * 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 + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use + kill-line. + +2003-03-09 Jesper Harder + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use + kill-line. + +2003-03-09 Kevin Greiner + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message. + +2003-03-06 Katsumi Yamaoka + + * gnus-cus.el (gnus-group-customize): Don't use delete-if which is + a cl run-time function. + +2003-03-06 Kevin Greiner + + * 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 + + * 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 + + * 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 + + * gnus-agent.el (gnus-function-implies-unread-1): Grok + byte-compiled functions. + +2003-03-04 Kevin Greiner + + * 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 + + * 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 + + * 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 + + * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed + doc-string. + +2003-03-03 Jesper Harder + + * 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 + + * 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 + + * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config. + (gnus-user-agent): Fixed typo. + +2003-03-03 Kevin Greiner + + * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation. + (gnus-agent-expire-group-1): Removed invalid (interactive) specifier. + +2003-03-03 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message. + (gnus-agent-fetch-session): Allow debugging to take place. + +2003-03-03 Jesper Harder + + * 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 + + * 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 + + * 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 + + * nnvirtual.el (nnvirtual-update-xref-header): Simplify. + +2003-03-01 Jesper Harder + + * gnus-art.el (gnus-article-refer-article): Be more permissive. + +2003-03-01 ShengHuo ZHU + + * spam.el: Fix typo. + +2003-03-01 Satyaki Das + (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 + + * 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 + + * mm-view.el (mm-inline-text): Ignore errors from enriched-decode. + +2003-03-01 Lars Magne Ingebrigtsen + + * message.el (message-make-fqdn): Protect against nil user-mail. + +2003-02-28 Vasily Korytov + + * gnus-art.el (gnus-boring-article-headers): New values: + 'to-list and 'cc-list. + +2003-02-28 Teodor Zlatanov + + * 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 + + * gnus-msg.el (gnus-user-agent): Changed default to + 'emacs-gnus-type, renamed 'full. + +2003-02-28 ShengHuo ZHU + + * nnfolder.el (nnfolder-request-accept-article): Don't use + mail-header-unfold-field. + +2003-02-27 ShengHuo ZHU + + * 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 + + * spam.el: add spam-stat-load to gnus-get-new-news-hook + (spam-split): remove spam-stat-load call + +2003-02-26 Simon Josefsson + + * 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 + + * gnus-agent.el (gnus-agent-expire-group): Remove debug. + +2003-02-25 Jesper Harder + + * 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 + + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added + compensation for TDMA addresses. + +2003-02-24 Reiner Steib + + * 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 + + * 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 + + * gnus-group.el (gnus-topic-mode-p): Fixed free variable + reference. + +2003-02-24 Kevin Greiner + + * nnheader.el (nnheader-find-nov-line): Changed midpoint + calculation to avoid integer overflow. + +2003-02-24 Reiner Steib + + * gnus-start.el (gnus-backup-startup-file): Fixed custom type. + +2003-02-24 Ted Zlatanov + * spam.el: disabled spam-get-article-as-filename + + From Michael Shields + + * 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 + From Martin Thornquist + + * 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 + + * 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 + + * 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 + + * 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 + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg. + +2003-02-20 Reiner Steib + + * 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 + + * 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 + + * message.el (message-mode): \\(...\\) around additional + paragraph-separate alternative. + +2003-02-23 Jesper Harder + + * 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 + + * gnus-art.el (gnus-button-url-regexp): Removed `. + +2003-02-23 Max Froumentin + + * gnus-art.el (gnus-button-url-regexp): Remove `, enter '. + +2003-02-23 Lars Magne Ingebrigtsen + + * 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 + + * gnus.el (gnus-summary-buffer-name): Moved function here. + + * gnus-draft.el (defun): Remove debug. + +2003-02-22 Jesper Harder + + * gnus-sum.el (gnus-summary-refer-article): Skip method if we + can't open server. + +2003-02-22 Lars Magne Ingebrigtsen + + * 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 + + * message.el (message-mode): MML tags separate paragraphs. Small + change from David S Goldberg . + + * 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 . + +2003-02-22 Jesper Harder + + * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't + use "path name". + +2003-02-21 Teodor Zlatanov + + * 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 + From Reiner Steib . + + * 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 + + * message.el (message-resend): Bind message-setup-hook to nil; + remove X-Draft-From header. + +2003-02-20 Jesper Harder + + * 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 + + * gnus.el (gnus-shell-command-separator, gnus-email-address) + (gnus-default-charset, gnus-other-frame-parameters): Doc fixes. + +2003-02-20 Jesper Harder + + * 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 + + * 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 + + * gnus-msg.el (gnus-copy-article-buffer): Copy an article header + even if there's just a header. + +2003-02-19 Jesper Harder + + * 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 . + +2003-02-18 Jesper Harder + + * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer. + +2003-02-18 Teodor Zlatanov + + * 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 + + * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart + submenu. + +2003-02-17 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Reverse the return value of + the continuation question. + +2003-02-16 Lars Magne Ingebrigtsen + + * nndraft.el (nndraft-request-move-article): Bind + nnmh-allow-delete-final to t. + +2003-02-14 ShengHuo ZHU + + * mm-uu.el (mm-uu-uu-filename): Fix use of character constant. + +2003-02-11 Stefan Monnier + + * nntp.el (nntp-accept-process-output): Don't use point-max to get + the buffer's size. + +2003-01-31 Joe Buehler + + * nnheader.el: Added cygwin to system-type comparisons. + +2003-01-27 Juanma Barranquero + + * imap.el (imap-mailbox-status): Fix typo. + +2003-02-14 ShengHuo ZHU + + * gnus-art.el (gnus-article-prepare): Don't set agent mark if + online. + +2003-02-14 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all + commands. + * gnus-sum.el: Small change from Frank Weinberg + : + (gnus-auto-center-group): New variable. + (gnus-summary-read-group-1): Use it. + (gnus-summary-next-group): Fix docstring. + +2003-02-13 Katsumi Yamaoka + + * gnus-util.el (gnus-faces-at): Simplify. + +2003-02-13 Teodor Zlatanov + + * 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 + + * 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 . + +2003-02-13 Katsumi Yamaoka + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * gnus-sum.el (gnus-summary-refer-thread): Handle case where + gnus-refer-thread-limit is t. + +2003-02-10 Jesper Harder + + * 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 + + * 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 + + * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the + next line after finding the parent. + +2003-02-08 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bumped. + 2003-02-08 23:23:27 Lars Magne Ingebrigtsen * gnus.el: Oort Gnus v0.15 is released. @@ -34,8 +1001,6 @@ * gnus-registry.el (regtest-nnmail): use gnus-internal-registry-spool-current-method - - 2003-02-07 Lars Magne Ingebrigtsen * mail-source.el (mail-source-fetch): Typo fix. @@ -55,16 +1020,16 @@ (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-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-move-article, gnus-summary-expire-articles) (gnus-summary-delete-article): invoke the new hooks 2003-02-07 Frank Weinberg - * gnus-art.el (gnus-article-refer-article): Strip leading "news:" - from message-ID + * gnus-art.el (gnus-article-refer-article): Strip leading "news:" + from message-ID 2003-02-07 Jesper Harder @@ -81,7 +1046,7 @@ (mail-source-ignore-errors): New variable. * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current - articles. + articles. * gnus-msg.el (gnus-version-expose-system): Change default. @@ -133,11 +1098,11 @@ "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. @@ -219,7 +1184,7 @@ * gnus.el: Use gnus-prin1-to-string throughout. * gnus-util.el (gnus-prin1-to-string): Bind print-length and - print-level. + print-level. * gnus-art.el (article-display-x-face): Removed grey x-face stuff. (gnus-treat-display-grey-xface): Removed. @@ -251,10 +1216,10 @@ 2003-01-27 Teodor Zlatanov - * spam.el (spam-check-blackholes) + * 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-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 @@ -264,15 +1229,15 @@ * 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 @@ -280,7 +1245,7 @@ * 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. + * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. 2003-01-26 Jesper Harder @@ -321,7 +1286,7 @@ 2003-01-24 Lars Magne Ingebrigtsen * nnheader.el (nnheader-directory-separator-character): New - variable. + variable. 2003-01-24 Kai Gro,A_(Bjohann @@ -338,7 +1303,7 @@ (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. + end of the file, in particular gnus-agent-expire. 2003-01-24 Lars Magne Ingebrigtsen @@ -358,7 +1323,7 @@ 2003-01-24 Teodor Zlatanov - * spam.el (spam-check-blackholes, spam-split) + * 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 @@ -370,7 +1335,7 @@ 2003-01-24 Lars Magne Ingebrigtsen * gnus-art.el (gnus-mime-security-show-details): Toggle showing - details. + details. 2003-01-23 Lars Magne Ingebrigtsen @@ -382,15 +1347,15 @@ * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Doc fix. * gnus-async.el (gnus-async-wait-for-article): Don't use a - timeout. + timeout. - * nntp.el (nntp-accept-process-output): Removed 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 *. -2002-01-23 Kevin Greiner +2003-01-23 Kevin Greiner * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I introduced on 2002-01-22. @@ -398,7 +1363,7 @@ 2003-01-23 Teodor Zlatanov - * spam.el (spam-check-regex-headers, spam-list-of-checks) + * 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 @@ -406,7 +1371,7 @@ * gnus-sum.el (gnus-spam-mark): set to `$' -2002-01-22 Kevin Greiner +2003-01-22 Kevin Greiner * gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes gnus-newsgroup-unfetched, the list of articles whose headers have @@ -425,7 +1390,7 @@ 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 * gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook): @@ -494,14 +1459,14 @@ * mailcap.el (mailcap-print-command): lpr-command might be unbound in XEmacs. -2002-01-18 Kevin Greiner +2003-01-18 Kevin Greiner * 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 * nnmail.el (nnmail-process-unix-mail-format): Improve error @@ -509,7 +1474,7 @@ 2003-01-17 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-article-followup-with-original): Clean up. + * 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, @@ -517,7 +1482,7 @@ 2003-01-17 Simon Josefsson - * gnus-fun.el (gnus-x-face-from-file): + * 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) @@ -542,8 +1507,8 @@ 2003-01-16 Simon Josefsson - * gnus-fun.el (gnus-convert-image-to-x-face-command) - (gnus-convert-image-to-face-command, gnus-x-face-from-file) + * 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 @@ -554,31 +1519,31 @@ (spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis 2003-01-15 ShengHuo ZHU - + * 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. - + (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 * gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type. @@ -593,12 +1558,12 @@ 2003-01-15 Teodor Zlatanov - * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header) + * 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-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 @@ -628,14 +1593,14 @@ 2003-01-15 Lars Magne Ingebrigtsen * message.el (message-send): Don't warn about duplicates when - superseding. + superseding. 2003-01-15 Simon Josefsson * nnimap.el (nnimap-split-download-body): New variable. (nnimap-split-articles): Use it. -2002-01-14 Kevin Greiner +2003-01-14 Kevin Greiner * gnus-agent.el (gnus-agent-check-overview-buffer): This data integrity checker was incorrectly flagging, and removing, articles @@ -649,12 +1614,12 @@ 2003-01-14 Lars Magne Ingebrigtsen - * gnus-audio.el (gnus-audio-au-player): Use executable-find. + * gnus-audio.el (gnus-audio-au-player): Use executable-find. 2003-01-13 Jhair Tocancipa Triana * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use - /usr/bin/play as default player. + /usr/bin/play as default player. (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play. 2003-01-14 Katsumi Yamaoka @@ -662,11 +1627,11 @@ * gnus-msg.el (gnus-inews-add-send-actions): Allow a list of articles to be marked as well. -2002-01-14 Kevin Greiner +2003-01-14 Kevin Greiner * 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, @@ -690,13 +1655,13 @@ 2003-01-13 Romain FRANCOISE - * gnus-fun.el (gnus-x-face-from-file): Quote file name. + * gnus-fun.el (gnus-x-face-from-file): Quote file name. (gnus-face-from-file): Ditto. 2003-01-13 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-articles-to-read): Don't just apply - gnus-alter-articles-to-read-function to the unread articles. + gnus-alter-articles-to-read-function to the unread articles. 2003-01-13 Reiner Steib @@ -757,7 +1722,7 @@ 2003-01-12 Fran,Ag(Bois-David Collin * mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer. - + 2003-01-12 Lars Magne Ingebrigtsen * gnus-fun.el (gnus-face-from-file): Autoload. @@ -791,13 +1756,13 @@ * gnus-msg.el (gnus-inews-do-gcc): Don't try to mark GCC's as read if Gnus isn't alive. -2002-01-11 Kevin Greiner +2003-01-11 Kevin Greiner * 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. * gnus-sum.el (gnus-summary-exit): Reverse change to make group @@ -829,7 +1794,7 @@ 2003-01-11 Lars Magne Ingebrigtsen * gnus-art.el (gnus-display-mime): Use the mime emulation - variable. + variable. * gnus-sum.el (gnus-article-emulate-mime): New variable. @@ -847,7 +1812,7 @@ * message.el (message-check-news-header-syntax): Compute the header length correctly. -2002-01-10 Kevin Greiner +2003-01-10 Kevin Greiner * gnus-agent.el (gnus-agent-expire): Do not remove article from alist when keeping fetched article file. @@ -884,7 +1849,7 @@ 2003-01-10 Teodor Zlatanov * spam.el (spam-use-stat): new variable - (spam-group-spam-processor-stat-p) + (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 @@ -929,7 +1894,7 @@ (spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0. Changed copyright statement to FSF. -2002-01-09 Kevin Greiner +2003-01-09 Kevin Greiner * gnus-agent.el (gnus-agent-catchup): Do not mark cached nor processable articles as read. @@ -1085,7 +2050,7 @@ * gnus-sum.el (gnus-summary-make-menu-bar): Added gnus-summary-refer-thread to thread menu. -2002-01-07 Kevin Greiner +2003-01-07 Kevin Greiner * gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a summary buffer, articles that cannot be fetched are marked as @@ -1136,7 +2101,7 @@ gnus-sieve-crosspost. One-line patch from Steinar Bang . -2002-01-06 Kevin Greiner +2003-01-06 Kevin Greiner * gnus.el: Renamed gnus-summary-*-uncached-face as gnus-summary-*-undownloaded-face to avoid confusing the agent with @@ -1144,7 +2109,7 @@ * gnus-sum.el: Ditto. -2002-01-06 Kevin Greiner +2003-01-06 Kevin Greiner * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution in either the group or summary buffer. @@ -2847,7 +3812,6 @@ * 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 * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article @@ -12709,7 +13673,7 @@ * mail-source.el (mail-sources): Revert to nil. - * nnmail (nnmail-spool-file): Revert to `((file))'. + * nnmail.el (nnmail-spool-file): Revert to `((file))'. * qp.el: Don't require mm-util. (quoted-printable-decode-region): Rewritten. diff --git a/lisp/canlock.el b/lisp/canlock.el index 13e7fbc..b52afed 100644 --- a/lisp/canlock.el +++ b/lisp/canlock.el @@ -125,22 +125,6 @@ buffer does not look like a news message." "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes." (canlock-string-as-unibyte (funcall canlock-sha1-function message))) -(defvar canlock-read-passwd nil) -(defun canlock-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 canlock-read-passwd - (if (or (fboundp 'read-passwd) (load "passwd" t)) - (setq canlock-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq canlock-read-passwd 'ange-ftp-read-passwd))) - (funcall canlock-read-passwd prompt))) - (defun canlock-make-cancel-key (message-id password) "Make a Cancel-Key header." (when (> (length password) 20) @@ -231,7 +215,7 @@ message." (message "There are no Message-ID(s)") (unless password (setq password (or canlock-password - (canlock-read-passwd + (read-passwd "Password for Canlock: ")))) (if (or (not (stringp password)) (zerop (length password))) (message "Password for Canlock is bad") @@ -284,7 +268,7 @@ nil instead of to signal an error by setting the option (error "%s" errmsg)) (setq password (or canlock-password-for-verify - (canlock-read-passwd "Password for Canlock: "))) + (read-passwd "Password for Canlock: "))) (if (or (not (stringp password)) (zerop (length password))) (progn (setq errmsg "Password for Canlock is bad") diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 14506d5..a897188 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -34,6 +34,7 @@ (require 'gnus-sum) (require 'gnus-score) (require 'gnus-srvr) +(require 'gnus-util) (eval-when-compile (if (featurep 'xemacs) (require 'itimer) @@ -41,7 +42,9 @@ (require 'gnus-group)) (eval-and-compile - (autoload 'gnus-server-update-server "gnus-srvr")) + (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." @@ -58,19 +61,23 @@ :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 nil +(defcustom gnus-agent-expire-days 7 "Read articles older than this will be expired. This can also be a list of regexp/day pairs. The regexps will be -matched against group names. If nil, articles in the agent cache are -never expired." +matched against group names." :group 'gnus-agent :type '(choice (number :tag "days") - (const :tag "never" nil))) + (sexp :tag "List" nil))) (defcustom gnus-agent-expire-all nil "If non-nil, also expire unread, ticked and dormant articles. @@ -162,12 +169,23 @@ 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))) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil -"An assoc list identifying the articles whose headers have been fetched. + "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 @@ -176,8 +194,7 @@ 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 gnus-agent-regenerate may destructively modify the value. -") +2) The function `gnus-agent-regenerate' may destructively modify the value.") (defvar gnus-agent-group-alist nil) (defvar gnus-category-alist nil) (defvar gnus-agent-current-history nil) @@ -259,6 +276,107 @@ node `(gnus)Server Buffer'.") (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) + +(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-- (gensym "--category--")) + (--value--temp-- (gensym "--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) + +(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) + (list name '(agent-predicate . false))) + ;;; Fetching setup functions. (defun gnus-agent-start-fetch () @@ -315,7 +433,12 @@ node `(gnus)Server Buffer'.") buffer)))) minor-mode-map-alist)) (when (eq major-mode 'gnus-group-mode) - (gnus-agent-toggle-plugged gnus-plugged)) + (let ((init-plugged gnus-plugged)) + ;; 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))))) @@ -339,10 +462,14 @@ node `(gnus)Server Buffer'.") ["Toggle plugged" gnus-agent-toggle-plugged t] ["Toggle group plugged" gnus-agent-toggle-group-plugged t] ["List categories" gnus-enter-category-buffer t] + ["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 @@ -389,29 +516,41 @@ node `(gnus)Server Buffer'.") (make-mode-line-mouse-map mouse-button mouse-func)) string)) -(defun gnus-agent-toggle-plugged (plugged) +(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-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)) - (gnus-agent-close-connections) - (setq gnus-plugged plugged) - (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))) + (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)))) (force-mode-line-update) (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)) @@ -456,7 +595,7 @@ minor mode in all Gnus buffers." (unless gnus-agent-send-mail-function (setq gnus-agent-send-mail-function (or message-send-mail-real-function - message-send-mail-function) + message-send-mail-function) message-send-mail-real-function 'gnus-agent-send-mail)) (unless gnus-agent-covered-methods @@ -553,21 +692,15 @@ be a select method." (defun gnus-agent-fetch-group (&optional group) "Put all new articles in GROUP into the Agent." (interactive (list (gnus-group-group-name))) - (let ((state gnus-plugged)) - (unwind-protect - (progn - (setq group (or group gnus-newsgroup-name)) - (unless group - (error "No group on the current line")) - (unless state - (gnus-agent-toggle-plugged gnus-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)))) - (when (and (not state) - gnus-plugged) - (gnus-agent-toggle-plugged gnus-plugged))))) + (setq group (or group gnus-newsgroup-name)) + (unless group + (error "No group on the current line")) + + (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." @@ -584,10 +717,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) @@ -596,8 +731,9 @@ 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 () @@ -627,8 +763,7 @@ be a select 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")))) @@ -749,32 +884,36 @@ article's mark is toggled." t) (t (memq article gnus-newsgroup-downloadable))))) - (gnus-summary-update-mark - (if unmark - (progn - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (gnus-article-mark article)) - (progn - (setq gnus-newsgroup-downloadable - (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)) - gnus-downloadable-mark) - ) - 'unread))) + (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)) + (progn + (setq gnus-newsgroup-downloadable + (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)) + gnus-downloadable-mark) + ) + 'unread)))) (defun gnus-agent-get-undownloaded-list () "Construct list of articles that have not been downloaded." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (set (make-local-variable 'gnus-newsgroup-agentized) (gnus-agent-method-p gnus-command-method)) + (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 gnus-newsgroup-headers) + (headers (sort (mapcar (lambda (h) + (mail-header-number h)) + gnus-newsgroup-headers) '<)) (undownloaded (list nil)) (tail-undownloaded undownloaded) (unfetched (list nil)) (tail-unfetched unfetched)) (while (and alist headers) (let ((a (caar alist)) - (h (mail-header-number (car headers)))) + (h (car headers))) (cond ((< a h) ;; Ignore IDs in the alist that are not being ;; displayed in the summary. @@ -797,7 +936,7 @@ article's mark is toggled." (gnus-agent-append-to-list tail-undownloaded a))))) (while headers - (let ((num (mail-header-number (pop headers)))) + (let ((num (pop headers))) (gnus-agent-append-to-list tail-undownloaded num) (gnus-agent-append-to-list tail-unfetched num))) @@ -815,7 +954,7 @@ downloadable." gnus-newsgroup-cached) (setq articles (gnus-sorted-ndifference (gnus-sorted-ndifference - (copy-sequence articles) + (gnus-copy-sequence articles) gnus-newsgroup-downloadable) gnus-newsgroup-cached))) @@ -830,7 +969,7 @@ downloadable." (setq gnus-newsgroup-downloadable (let* ((dl gnus-newsgroup-downloadable) (gnus-newsgroup-downloadable - (sort (copy-sequence gnus-newsgroup-processable) '<)) + (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 @@ -852,33 +991,34 @@ Optional arg ALL, if non-nil, means to fetch all articles." (if all gnus-newsgroup-articles gnus-newsgroup-downloadable)) (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)) - (state gnus-plugged) fetched-articles) - (unwind-protect - (progn - (unless state - (gnus-agent-toggle-plugged t)) - (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) - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (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))))) - (when (and (not state) - gnus-plugged) - (gnus-agent-toggle-plugged nil))) + (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)) + + ;; The downloadable mark is implemented as a + ;; type of read mark. Therefore, marking the + ;; article as unread is sufficient to clear + ;; its downloadable flag. + (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 () @@ -892,9 +1032,7 @@ This can be added to `gnus-select-article-hook' or (list gnus-current-article)) (setq gnus-newsgroup-undownloaded (delq gnus-current-article gnus-newsgroup-undownloaded)) - (gnus-summary-update-article-line - gnus-current-article - (gnus-summary-article-header gnus-current-article)))))) + (gnus-summary-update-line gnus-current-article))))) ;;; ;;; Internal functions @@ -1060,7 +1198,18 @@ This can be added to `gnus-select-article-hook' or (setq current-set-size (+ current-set-size (if (= header-number article) - (mail-header-chars (car headers)) + (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) @@ -1081,7 +1230,7 @@ This can be added to `gnus-select-article-hook' or (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. @@ -1140,7 +1289,8 @@ This can be added to `gnus-select-article-hook' or (widen) (pop pos)))) - (gnus-agent-save-alist group (cdr fetched-articles) date)) + (gnus-agent-save-alist group (cdr fetched-articles) date) + (gnus-message 7 "")) (cdr fetched-articles)))))) (defun gnus-agent-crosspost (crosses article &optional date) @@ -1249,6 +1399,24 @@ and that there are no duplicates." (insert "\n")) (pop 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) "Fetch interesting headers into the agent. The group's overview file will be updated to include the headers while a list of available @@ -1257,15 +1425,13 @@ article numbers will be returned." ;; Do not fetch all headers if the predicate ;; implies that we only consider unread articles. (not (gnus-predicate-implies-unread - (or (gnus-group-find-parameter - group 'agent-predicate t) - (cadr (gnus-group-category group))))))) + (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)) - gnus-agent-cache) + (file (gnus-agent-article-name ".overview" group))) ;; Check whether the number of articles is not too large. (when (and (integerp gnus-agent-large-newsgroup) (> gnus-agent-large-newsgroup 0)) @@ -1292,7 +1458,9 @@ article numbers will be returned." ;; be fetched. (let ((articles articles)) ;; Remove known articles. - (when (gnus-agent-load-alist group) + (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. @@ -1351,8 +1519,7 @@ article numbers will be returned." articles) (ignore-errors (erase-buffer) - (nnheader-insert-file-contents file)))) - ) + (nnheader-insert-file-contents file))))) articles)) (defsubst gnus-agent-copy-nov-line (article) @@ -1414,7 +1581,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (t (beginning-of-line) nil)))) - + (gnus-agent-copy-nov-line (pop articles))))) ;; Copy the rest lines @@ -1552,7 +1719,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (insert "\n")))) (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))))) @@ -1582,28 +1749,35 @@ FILE and places the combined headers into `nntp-server-buffer'." groups group gnus-command-method) (save-excursion (while methods - (condition-case err - (progn - (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) - (gnus-agent-fetch-group-1 group gnus-command-method)))))) - (error - (unless (funcall gnus-agent-confirmation-function - (format "Error %s. Continue? " (cdr err))) - (error "Cannot fetch articles into the Gnus agent"))) - (quit - (unless (funcall gnus-agent-confirmation-function - (format "Quit fetching session %s. Continue? " - (cdr err))) - (signal 'quit "Cannot fetch articles into the Gnus agent")))) + (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"))))))))) (pop methods)) - (run-hooks 'gnus-agent-fetch-hook) + (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) @@ -1635,9 +1809,9 @@ FILE and places the combined headers into `nntp-server-buffer'." (let ((marked-articles gnus-newsgroup-downloadable)) ;; Identify the articles marked for download (unless gnus-newsgroup-active - ;; This needs to be a gnus-summary local variable that is - ;; NOT bound to any value above (its global value should - ;; default to nil). + ;; 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))))))) @@ -1671,14 +1845,12 @@ FILE and places the combined headers into `nntp-server-buffer'." (setq predicate (gnus-get-predicate - (or (gnus-group-find-parameter group 'agent-predicate t) - (cadr category)))) + (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 - (or (gnus-group-get-parameter group 'agent-score t) - (caddr category)))) + (gnus-agent-find-parameter group 'agent-score-file))) ;; Translate score-param into real one (cond ((not score-param)) @@ -1719,7 +1891,22 @@ FILE and places the combined headers into `nntp-server-buffer'." (let ((gnus-score (or (cdr (assq num gnus-newsgroup-scored)) - gnus-summary-default-score))) + 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)))))) @@ -1739,8 +1926,7 @@ FILE and places the combined headers into `nntp-server-buffer'." ;; Update the summary buffer (progn (dolist (article marked-articles) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-set-agent-mark article t))) + (gnus-summary-set-agent-mark article t)) (dolist (article fetched-articles) (if gnus-agent-mark-unread-after-downloaded (gnus-summary-mark-article @@ -1800,6 +1986,9 @@ General format specifiers can also be used. See Info node (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.") @@ -1839,6 +2028,7 @@ General format specifiers can also be used. See Info node "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 @@ -1859,6 +2049,7 @@ General format specifiers can also be used. See Info node ["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] @@ -1896,7 +2087,7 @@ The following commands are available: (defun gnus-category-insert-line (category) (let* ((gnus-tmp-name (format "%s" (car category))) - (gnus-tmp-groups (length (cadddr category)))) + (gnus-tmp-groups (length (gnus-agent-cat-groups category)))) (beginning-of-line) (gnus-add-text-properties (point) @@ -1936,9 +2127,35 @@ The following commands are available: (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))))) (defun gnus-category-write () "Write the category alist." @@ -1946,6 +2163,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) @@ -1953,9 +2180,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))))) @@ -1964,10 +2198,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 (nthcdr 2 (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))))) @@ -1976,9 +2216,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))))) @@ -1995,8 +2242,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))) @@ -2006,7 +2255,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)) @@ -2068,9 +2317,9 @@ The following commands are available: (gnus-member-of-range (mail-header-number gnus-headers) (gnus-info-read (gnus-get-info gnus-newsgroup-name)))) -(defun gnus-category-make-function (cat) - "Make a function from category CAT." - (let ((func (gnus-category-make-function-1 cat))) +(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) @@ -2084,29 +2333,29 @@ 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) + (gnus-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)) (let ((func (gnus-category-make-function predicate))) (setq gnus-category-predicate-cache @@ -2119,8 +2368,20 @@ The following commands are available: It is okay to miss some cases, but there must be no false positives. That is, if this function returns true, then indeed the predicate must return only unread articles." - ;; Todo: make this work in more cases. - (equal predicate '(not read))) + (gnus-function-implies-unread-1 (gnus-category-make-function predicate))) + +(defun gnus-function-implies-unread-1 (function) + (cond ((eq function (symbol-function 'gnus-agent-read-p)) + nil) + ((not function) + nil) + ((gnus-functionp function) + 'ignore) + ((memq (car function) '(or and not)) + (apply (car function) + (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (t + (error "Unknown function: %s" function)))) (defun gnus-group-category (group) "Return the category GROUP belongs to." @@ -2129,336 +2390,373 @@ return only unread articles." (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-2 (expiring-group active articles overview day force - dir) - (gnus-agent-load-alist expiring-group) - (gnus-message 5 "Expiring articles in %s" expiring-group) - (let* ((info (gnus-get-info expiring-group)) - (alist gnus-agent-article-alist) - (specials (if alist - (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 expiring-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 exluded 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) - (when (file-exists-p nov-file) - (gnus-message 7 "gnus-agent-expire: Loading overview...") - (nnheader-insert-file-contents nov-file) - (goto-char (point-min)) +(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. - (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 (concat "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))))) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 9 "%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 - (when fetch-date - (unless (file-exists-p (concat dir (number-to-string - article-number))) - (setf (nth 1 entry) nil) - (gnus-message 3 (concat "gnus-agent-expire cleared download " - "flag on article %d as the cached " - "article file is missing.") - (caar dlist))) - (unless marker - (gnus-message 1 (concat "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. - (delete-file (concat dir (number-to-string article-number))) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil)) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - (gnus-delete-line)) - - ;; If considering all articles is set, I can only expire - ;; article IDs that are no longer in the active range. - (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)) - - (gnus-message 7 "gnus-agent-expire: Article %d: %s" - article-number (mapconcat 'identity - actions ", ")))) - (t - (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 expiring-group)) - - (when (buffer-modified-p) - (gnus-make-directory dir) - (write-region-as-coding-system gnus-agent-file-coding-system - (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-1 (&optional articles group force) - "Expire all old agent cached articles unconditionally. -See `gnus-agent-expire'." - (let ((methods (if group - (list (gnus-find-method-for-group group)) - gnus-agent-covered-methods)) - (day (if (numberp gnus-agent-expire-days) - (- (time-to-days (current-time)) gnus-agent-expire-days) - nil)) - gnus-command-method sym arts pos - history overview file histories elem art nov-file low info - unreads marked article orig lowest highest found days) - (save-excursion - (setq overview (gnus-get-buffer-create " *expire overview*")) - (unwind-protect - (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)))))) - (dolist (expiring-group (gnus-groups-from-server - gnus-command-method)) - (if (or (not group) - (equal group expiring-group)) - (let* ((dir (concat - (gnus-agent-directory) - (gnus-agent-group-path expiring-group) - "/")) - (active - (gnus-gethash-safe expiring-group orig)) - (day (if (numberp day) - day - (let (found - (days gnus-agent-expire-days)) - (catch 'found - (while (and (not found) days) - (when (eq 0 (string-match - (caar days) - expiring-group)) - (throw 'found (- (time-to-days - (current-time)) - (cadar days)))) - (pop days)) - ;; No regexp matched so set - ;; a limit that will block - ;; expiration in this group. - 0))))) - - (when active - (gnus-agent-expire-2 expiring-group active - articles overview day force - dir))))))) - (kill-buffer overview))))) +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) + (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 + (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)))))) + (save-excursion + (gnus-agent-expire-group-1 + group overview (gnus-gethash-safe group orig) + articles force))) + (kill-buffer overview)))) + (gnus-message 4 "Expiry...done"))) + +(defmacro gnus-agent-message (level &rest args) + `(if (<= ,level gnus-verbose) + (message ,@args))) + +(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 + + (if (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* ((info (gnus-get-info group)) + (alist gnus-agent-article-alist) + (dir (concat + (gnus-agent-directory) + (gnus-agent-group-path group) + "/")) + (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 exluded 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))))) + (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: Article %d: Kept %s article." + article-number keep) + (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 article %d as the cached article file is missing." + (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. + (delete-file (concat dir (number-to-string + article-number))) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil) + ) + + (when marker + (push "NOV entry removed" actions) + (goto-char marker) + (gnus-delete-line)) + + ;; If considering all articles is set, I can only + ;; expire article IDs that are no longer in the + ;; active range. + (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)) + + (gnus-agent-message 8 "gnus-agent-expire: Article %d: %s" + article-number + (mapconcat 'identity actions ", ")))) + (t + (gnus-agent-message + 10 "gnus-agent-expire: Article %d: Article kept as \ +expiration tests failed." 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) + (gnus-make-directory dir) + (write-region-as-coding-system gnus-agent-file-coding-system + (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 agent cached articles. + "Expire all old articles. If you want to force expiring of certain articles, this function can take ARTICLES, GROUP and FORCE parameters as well. @@ -2467,16 +2765,38 @@ The articles on which the expiration process runs are selected as follows: 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 gnus-agent-expire-days to zero(0)." +FORCE is equivalent to setting the expiration predicates to true." (interactive) - (if (and (not gnus-agent-expire-days) - (or (not (eq articles t)) - (yes-or-no-p (concat "Are you sure that you want to expire all " - "articles in " (if group group - "every agentized group") - ".")))) - (gnus-agent-expire-1 articles group force) - (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) + gnus-command-method overview orig) + (setq overview (gnus-get-buffer-create " *expire overview*")) + (unwind-protect + (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)))))) + (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-message 4 "Expiry...done"))))) ;;;###autoload (defun gnus-agent-batch () @@ -2521,7 +2841,8 @@ has been fetched." ;; Functionally, I don't need to construct a temp list using mapcar. - (if (gnus-agent-load-alist group) + (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)) @@ -2529,15 +2850,15 @@ has been fetched." (while (and ref arts) (let ((v1 (car arts)) (v2 (caar ref))) - (cond ((< v1 v2) ; the article (v1) does not appear in the reference list + (cond ((< v1 v2) ; v1 does not appear in the reference list (gnus-agent-append-to-list tail-uncached v1) (pop arts)) ((= v1 v2) - (unless (or cached-header (cdar ref)) ; the article (v1) is already cached + (unless (or cached-header (cdar ref)) ; v1 is already cached (gnus-agent-append-to-list tail-uncached v1)) (pop arts) (pop ref)) - (t ; the reference article (v2) preceeds the list being filtered + (t ; reference article (v2) preceeds the list being filtered (pop ref))))) (while arts (gnus-agent-append-to-list tail-uncached (pop arts))) @@ -2562,70 +2883,77 @@ has been fetched." gnus-agent-file-coding-system)) (nnheader-insert-nov-file file (car articles))))) - (if (setq uncached-articles (gnus-agent-uncached-articles articles group t)) + (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) - (let (gnus-agent-cache) ; Turn off agent cache - (cond ((not (eq 'nov (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)) - )))) + (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) @@ -2646,13 +2974,13 @@ has been fetched." (write-region-as-coding-system gnus-agent-file-coding-system (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) @@ -2671,32 +2999,41 @@ has been fetched." (defun gnus-agent-request-article (article group) "Retrieve ARTICLE in GROUP from the agent cache." - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (file (concat + (when (and gnus-agent + (or gnus-agent-cache + (not gnus-plugged)) + (numberp article)) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (file (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" (number-to-string article))) - (buffer-read-only nil)) - (when (and (file-exists-p file) - (> (nth 7 (file-attributes file)) 0)) - (erase-buffer) - (gnus-kill-all-overlays) - (insert-file-contents-as-coding-system gnus-cache-coding-system file) - t))) + (buffer-read-only nil)) + (when (and (file-exists-p file) + (> (nth 7 (file-attributes file)) 0)) + (erase-buffer) + (gnus-kill-all-overlays) + (insert-file-contents-as-coding-system gnus-cache-coding-system 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 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))) - (intern-soft (read-string "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): ")))) + (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))) + (intern-soft + (read-string + "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): ")))) (gnus-message 5 "Regenerating in %s" group) (let* ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) @@ -2726,7 +3063,8 @@ If REREAD is not nil, downloaded articles are marked as unread." (setq load nil) (goto-char (point-min)) (while (< (point) (point-max)) - (cond ((looking-at "[0-9]+\t") + (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)) @@ -2734,21 +3072,26 @@ If REREAD is not nil, downloaded articles are marked as unread." (cond ((not l2) nil) ((< l1 l2) - (gnus-message 3 "gnus-agent-regenerate-group: NOV entries are NOT in ascending order.") + (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-message 4 "gnus-agent-regenerate-group: NOV\ + entries contained duplicate of article %s. Duplicate deleted." l1) (gnus-delete-line) (pop 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-message 1 "gnus-agent-regenerate-group: NOV\ + entries contained line that did not begin with an article number. Deleted\ + line.") (gnus-delete-line)))) (if load (progn - (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV entries into ascending order.") + (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) @@ -2757,11 +3100,12 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; 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 + (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)) + (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) @@ -2769,7 +3113,8 @@ If REREAD is not nil, downloaded articles are marked as unread." (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"))) + (let ((key (concat "^" (int-to-string (car nov-arts)) + "\t"))) (or (re-search-backward key nil t) (re-search-forward key)) (forward-line 1)) @@ -2778,7 +3123,11 @@ If REREAD is not nil, downloaded articles are marked as unread." (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) + (push (cons (car downloaded) + (time-to-days + (nth 5 (file-attributes + (concat dir (number-to-string + (car downloaded))))))) alist) (pop downloaded) (pop nov-arts)) (t @@ -2821,12 +3170,13 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; 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 n) - (when o - (push (cons (caar o) nil) alist))) + (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)) (write-region-as-coding-system @@ -2839,7 +3189,7 @@ If REREAD is not nil, downloaded articles are marked as unread." ) (setq gnus-agent-article-alist alist) - + (when regenerated (gnus-agent-save-alist group))) ) @@ -2859,6 +3209,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (sit-for 0)) ) + (gnus-message 5 nil) regenerated)) ;;;###autoload @@ -2907,7 +3258,8 @@ If CLEAN, don't read existing active files." (when active-changed (setq regenerated t) (gnus-message 4 "Regenerate %s" active-file) - (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) + (let ((nnmail-active-file-coding-system + gnus-agent-file-coding-system)) (gnus-write-active-file active-file active-hashtb))))) (gnus-message 4 "Regenerating Gnus agent files...done") regenerated)) @@ -2941,6 +3293,49 @@ If CLEAN, don't read existing active files." (member (gnus-group-method group) gnus-agent-covered-methods)) +(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))) + (pop 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) ;;; gnus-agent.el ends here diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index dffdb68..f1ad33d 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -194,6 +194,8 @@ 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. @@ -202,6 +204,8 @@ Possible values in this list are: :type '(set (const :tag "Headers with no content." empty) (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) @@ -209,6 +213,15 @@ Possible values in this list are: (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 @@ -853,6 +866,7 @@ 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) @@ -1691,7 +1705,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) @@ -1720,6 +1734,32 @@ always hide." (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 (gnus-string-equal (message-fetch-field "followup-to") @@ -1781,7 +1821,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) @@ -1903,7 +1943,7 @@ unfolded." (while (not (eobp)) (save-restriction (mail-header-narrow-to-field) - (let ((header (buffer-substring (point-min) (point-max)))) + (let ((header (buffer-string))) (with-temp-buffer (insert header) (goto-char (point-min)) @@ -2182,7 +2222,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) - (car ctl))))))) + (car ctl) prompt)))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2417,43 +2457,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-parameter-banner gnus-newsgroup-name)) (gnus-signature-limit nil) - buffer-read-only beg end) - (when (and gnus-article-address-banner-alist - (not banner)) - (setq 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))))))))) - (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)))))))))) + buffer-read-only) + (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." @@ -3804,7 +3851,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 (memq article gnus-newsgroup-undownloaded) + (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")) @@ -4050,13 +4099,14 @@ General format specifiers can also be used. See Info node (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-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 () (with-current-buffer gnus-article-buffer @@ -4081,21 +4131,36 @@ General format specifiers can also be used. See Info node (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-window-excursion - (let ((pos (event-start event))) - (select-window (posn-window pos)) - (goto-char (posn-point pos)) - (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." @@ -4179,6 +4244,87 @@ General format specifiers can also be used. See Info node ,(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) + (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))) + (if (mm-multiple-handles gnus-article-mime-handles) + (error "This function is not implemented")) + (with-current-buffer (mm-handle-buffer data) + (let ((bsize (format "%s" (buffer-size)))) + (erase-buffer) + (insert + (concat + "<#part type=text/plain nofile=yes disposition=attachment" + " description=\"Deleted attachment (" bsize " Byte)\">" + ",----\n" + "| The following attachment has been deleted:\n" + "|\n" + "| Type: " type "\n" + "| Filename: " filename "\n" + "| Size (encoded): " bsize " Byte\n" + "| Description: " description "\n" + "`----\n" + "<#/part>")) + (setcdr data + (cdr (mm-make-handle nil `("text/plain")))))) + (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)) + ;; LOCAL argument of add-hook differs between GNU Emacs + ;; and XEmacs. make-local-hook makes sure they are local. + (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) @@ -4412,7 +4558,7 @@ If no internal viewer is available, use an external viewer." (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 @@ -4545,16 +4691,14 @@ If no internal viewer is available, use an external viewer." (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 @@ -4590,7 +4734,10 @@ If no internal viewer is available, use an external viewer." gnus-part ,gnus-tmp-id article-type annotation gnus-data ,handle)) - (setq e (point)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) (widget-convert-button 'link b e :mime-handle handle @@ -5050,15 +5197,14 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-next-page () "Show the next page of the article." (interactive) - (when (gnus-article-next-page) - (goto-char (point-min)) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + (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) - (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) - (gnus-article-prev-page nil))) + (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. @@ -5116,17 +5262,33 @@ Argument LINES specifies lines to be scrolled down." (beginning-of-buffer (goto-char (point-min)))))))) +(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 (gnus-replace-in-string (match-string 1) "]+" (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 () @@ -5444,9 +5606,7 @@ If given a prefix, show the hidden text instead." (gnus-cache-request-article article group)) 'article) ;; Check the agent cache. - ((and gnus-agent gnus-agent-cache gnus-plugged - (numberp article) - (gnus-agent-request-article article group)) + ((gnus-agent-request-article article group) 'article) ;; Get the article and put into the article buffer. ((or (stringp article) @@ -5850,8 +6010,8 @@ after replacing with the original article." (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-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~`%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~`%&*+\\/[:word:]]\\)" - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~`%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~`%&*+\\/]\\|\\w\\)\\)") + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|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\\|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) @@ -5910,57 +6070,173 @@ The function must take one argument, the string naming the URL." :group 'gnus-article-buttons :type 'regexp) -(defcustom gnus-button-prefer-mid-or-mail 'guess - "What to do when the button on a string as \"foo123@bar.com\" is pushed. -Strings like this can be either a message ID or a mail address. If the -variable is set to the symbol `ask', query the user what do do. If it is the -symbol `guess', Gnus will do a guess and query the user what do do if it is -ambiguous. See the variable `gnus-button-guessed-mid-regexp' for details -concerning the guessing. If it is one of the sybols `mid' or `mail', Gnus -will always assume that the string is a message ID or a mail address, -respectivly." - ;; FIXME: doc-string could/should be improved. +(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, respectivly. 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 (const ask) - (const guess) + :type '(choice (function-item :tag "Heuristic function" + gnus-button-mid-or-mail-heuristic) + (const ask) (const mid) (const mail))) -(defcustom gnus-button-guessed-mid-regexp - (concat - "^. I.e. translate the - ;; Perl-REs to Elisp-REs. +(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 'regexp) + :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") + mid-or-mail) + (gnus-message 8 "`%s' is a known mail address.") + (setq result 'mail)) + (when (string-match "@.*@\\| " mid-or-mail) + (gnus-message 8 "`%s' is invalid.") + (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) + (cond + ;; Maybe we should make this a customizable alist: (condition . 'result) + ((< 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) + (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) - ;; If it looks like a MID (well known readers or servers) use 'mid, - ;; otherwise 'ask the user. - (if (eq pref 'guess) - (if (string-match gnus-button-guessed-mid-regexp mid-or-mail) - (setq pref 'mid) - (setq pref 'ask))) + (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 9 "calling `gnus-button-handle-news' %s" url-mid) + (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid) (gnus-button-handle-news url-mid)) ((eq pref 'mail) - (gnus-message 9 "calling `gnus-url-mailto' %s" url-mailto) - (gnus-url-mailto url-mailto))))) + (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." @@ -6656,7 +6932,10 @@ specified by `gnus-button-alist'." article-type annotation mime-view-situation ,situation)) (widget-convert-button - 'link b (point) + 'link b (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point)) :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) @@ -6696,7 +6975,10 @@ specified by `gnus-button-alist'." article-type annotation mime-view-situation ,situation)) (widget-convert-button - 'link b (point) + 'link b (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point)) :action 'gnus-button-next-page :button-keymap gnus-next-page-map))) @@ -6887,7 +7169,7 @@ For example: (search-forward field nil t)) (prog2 (message-narrow-to-field) - (buffer-substring (point-min) (point-max)) + (buffer-string) (delete-region (point-min) (point-max)) (widen)))) '("Content-Type:" "Content-Transfer-Encoding:" @@ -7056,7 +7338,10 @@ For example: gnus-mime-details ,gnus-mime-security-button-pressed article-type annotation gnus-data ,handle)) - (setq e (point)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) (widget-convert-button 'link b e :mime-handle handle diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 60e78fe..e9733a2 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -467,8 +467,7 @@ 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))))) + (gnus-delete-line))) (unless (setq gnus-newsgroup-cached (delq article gnus-newsgroup-cached)) (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) @@ -518,7 +517,7 @@ Returns the list of articles removed." (set-buffer cache-buf) (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") nil t) - (setq beg (progn (beginning-of-line) (point)) + (setq beg (gnus-point-at-bol) end (progn (end-of-line) (point))) (setq beg nil)) (set-buffer nntp-server-buffer) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index ff551dd..31ee34a 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -30,7 +30,6 @@ (eval-when-compile (require 'static)) (require 'gnus) -(require 'gnus-art) (require 'gnus-range) (require 'message) ; for message-cite-prefix-regexp @@ -92,19 +91,42 @@ 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) + (defface gnus-cite-attribution-face '((t (:italic t))) "Face used for attribution lines.") @@ -252,6 +274,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) @@ -340,7 +373,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)) @@ -691,7 +724,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;; Each line. (setq begin (point) guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) - end (progn (beginning-of-line 2) (point)) + end (gnus-point-at-bol 2) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. @@ -715,9 +748,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)))))) @@ -998,6 +1041,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-cus.el b/lisp/gnus-cus.el index 715007d..9de3266 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -29,6 +29,7 @@ (require 'wid-edit) (require 'gnus) +(require 'gnus-agent) (require 'gnus-score) (require 'gnus-topic) (require 'gnus-art) @@ -264,6 +265,62 @@ 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 "Inherit " nil) + (const :format "Enable " ENABLE) + (const :format "Disable " DISABLE)) + "\nEnable, or disable, agent expiration in this group or topic." + gnus-agent-cat-enable-expiration) ) + "Alist of group parameters that are not also topic parameters. + +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.")) + (defvar gnus-custom-params) (defvar gnus-custom-method) (defvar gnus-custom-group) @@ -282,7 +339,25 @@ DOC is a documentation string for the parameter.") 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) @@ -290,7 +365,7 @@ DOC is a documentation string for the parameter.") (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) @@ -317,24 +392,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 @@ -347,14 +452,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 @@ -772,6 +877,163 @@ articles in the thread. (gnus-score-set 'touched '(t) alist)) (bury-buffer)) +(eval-when-compile + (defvar category-fields nil) + (defvar gnus-agent-cat-predicate nil) + (defvar gnus-agent-cat-score-file nil) + (defvar gnus-agent-cat-length-when-short nil) + (defvar gnus-agent-cat-length-when-long nil) + (defvar gnus-agent-cat-low-score nil) + (defvar gnus-agent-cat-high-score nil) + (defvar gnus-agent-cat-groups nil) + (defvar gnus-agent-cat-enable-expiration nil) + (defvar gnus-agent-cat-days-until-old nil) + (defvar gnus-agent-cat-name nil) +) + +(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 + (pp-to-string (,field defaults))) "]")))) + + (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)))) + (if (string-match "\n" deflt) + (progn (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") + + (set (make-local-variable ',field) + (if val + (widget-create type :value val) + (widget-create type))) + (widget-put ,field :default val) + (widget-put ,field :accessor ',field) + (push ,field 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 (ignore-errors (widget-value widget)))) + (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") + (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 gnus-agent-cat-groups :default (gnus-agent-cat-groups info)) + (widget-put gnus-agent-cat-groups :accessor 'gnus-agent-cat-groups) + (push gnus-agent-cat-groups 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) + + (use-local-map widget-keymap) + (widget-setup) + (buffer-enable-undo)))) + ;;; The End: (provide 'gnus-cus) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 55b2fe8..4d0bbf0 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -141,13 +141,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))) @@ -165,8 +172,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))))) @@ -248,6 +259,7 @@ (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) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index de23c64..e604886 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -446,6 +446,7 @@ 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.") @@ -740,7 +741,7 @@ simple manner.") (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." (and (boundp 'gnus-topic-mode) - gnus-topic-mode)) + (symbol-value 'gnus-topic-mode))) (defun gnus-group-make-menu-bar () (gnus-turn-off-edit-menu 'group) @@ -1490,7 +1491,7 @@ if it is a string, 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)) @@ -1917,6 +1918,8 @@ 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) @@ -3529,6 +3532,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. diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index bf014d3..b9afda8 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -348,7 +348,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (cond ((and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old)) - ((and gnus-agent gnus-agent-cache (gnus-online gnus-command-method) + ((and gnus-agent (gnus-online gnus-command-method) (gnus-agent-method-p gnus-command-method)) (gnus-agent-retrieve-headers articles group fetch-old)) (t @@ -420,9 +420,7 @@ If BUFFER, insert the article in that group." (setq res (cons group article) clean-up t)) ;; Check the agent cache. - ((and gnus-agent gnus-agent-cache gnus-plugged - (numberp article) - (gnus-agent-request-article article group)) + ((gnus-agent-request-article article group) (setq res (cons group article) clean-up t)) ;; Use `head' function. @@ -455,9 +453,7 @@ If BUFFER, insert the article in that group." (setq res (cons group article) clean-up t)) ;; Check the agent cache. - ((and gnus-agent gnus-agent-cache gnus-plugged - (numberp article) - (gnus-agent-request-article article group)) + ((gnus-agent-request-article article group) (setq res (cons group article) clean-up t)) ;; Use `head' function. @@ -527,18 +523,22 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (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-cache (gnus-agent-method-p gnus-command-method)) + (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) +(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) + (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-cache (gnus-agent-method-p gnus-command-method)) + (when (and result gnus-agent + (gnus-agent-method-p gnus-command-method)) (gnus-agent-expire (list article) group 'force)) result)) diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index dd6a774..41965a9 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -578,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) diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 92dc549..62baf32 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -147,7 +147,7 @@ mailcap-print-command)) (test . window-system)) ("pdf" - (viewer . ,(concat "pdftotext %s - | ")) + (viewer . ,(concat "pdftotext %s -")) (type . "application/pdf") ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) ("copiousoutput")) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 2488063..ae0185f 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -38,6 +38,7 @@ (require 'gnus-ems) (require 'message) (require 'gnus-art) +(require 'gnus-util) (defcustom gnus-post-method 'current "*Preferred method for posting USENET news. @@ -309,11 +310,23 @@ If nil, the address field will always be empty after invoking :group 'gnus-message :type 'boolean) -(defcustom gnus-version-expose-system nil - "If non-nil, `system-configuration' is exposed in `gnus-extended-version'. -Note that this variable is ineffective in T-gnus." +(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 'boolean) + :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. @@ -548,9 +561,11 @@ Gcc: header for archiving purposes." `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) (setq message-user-agent (gnus-extended-version)) - (when (not message-use-multi-frames) + (unless message-use-multi-frames (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill)) + `(if (gnus-buffer-exists-p ,buffer) + (set-window-configuration ,winconf)) + 'exit 'postpone 'kill)) (let ((to-be-marked (cond (yanked yanked) (article (if (listp article) article (list article))) @@ -933,7 +948,9 @@ header line with the old Message-ID." (forward-line 1)) (let ((mail-header-separator "")) (setq beg (point) - end (or (message-goto-body) beg))) + 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 "")) @@ -1941,9 +1958,7 @@ this is a reply." 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)) (let ((str (if (string-match ":" name) @@ -1957,6 +1972,16 @@ this is a reply." (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 (&optional group-name) diff --git a/lisp/gnus-offline.el b/lisp/gnus-offline.el index a30b47d..79eaa10 100644 --- a/lisp/gnus-offline.el +++ b/lisp/gnus-offline.el @@ -607,7 +607,7 @@ Please check your .emacs or .gnus.el to work nnspool fine.") (setq hdr (concat header " ")) (setq str (concat hdr string)) (setq hdr (concat str "\n")) - (insert-string hdr)))) + (insert hdr)))) ;; ;; Add X-Offline-Backend header. ;; diff --git a/lisp/gnus-ofsetup.el b/lisp/gnus-ofsetup.el index 4125f8a..839db29 100644 --- a/lisp/gnus-ofsetup.el +++ b/lisp/gnus-ofsetup.el @@ -35,8 +35,6 @@ (eval-when-compile (require 'cl)) -(require 'read-passwd) - (eval-and-compile (defvar gnus-offline-lang (cond ((and (featurep 'meadow) @@ -753,8 +751,6 @@ mail source specifier $B$H$+>e5-$N$h$&$J%-!<%o!<%I$K$D$$$F$b$C$H$h$/(B '(add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)) (eval-after-load "message" '(add-hook 'message-send-hook 'gnus-offline-message-add-header)) -(setq mail-source-read-passwd 'read-pw-read-passwd) -(add-hook 'gnus-setup-news-hook 'read-pw-set-mail-source-passwd-cache) (provide 'gnus-ofsetup) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 79b4ad5..6c11631 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -33,29 +33,53 @@ (require 'gnus-sum) (require 'nnmail) -;; (defcustom gnus-summary-article-spool-hook nil -;; "*A hook called after an article is spooled." -;; :group 'gnus-summary -;; :type 'hook) - -(defun regtest (action id from &optional to method) - (message "Registry: article %s %s from %s to %s" - id - (if method "respooling" "going") - (gnus-group-guess-full-name from) - (if to (gnus-group-guess-full-name to) "the Bit Bucket in the sky"))) - -(defun regtest-nnmail (id group) - (message "Registry: article %s spooled to %s" +(defvar gnus-registry-hashtb nil + "*The article registry by Message ID.") +(setq gnus-registry-hashtb (make-hash-table + :size 4096 + :test 'equal)) ; we test message ID strings equality + +;; sample data-header +;; (defvar tzz-header '(49 "Re[2]: good news" "\"Jonathan Pryor\" " "Mon, 17 Feb 2003 10:41:46 +-0800" "<88288020@dytqq>" "" 896 18 "lockgroove.bwh.harvard.edu spam.asian:49" nil)) + +;; (maphash (lambda (key value) (message "key: %s value: %s" key value)) gnus-registry-hashtb) +;; (clrhash gnus-registry-hashtb) + +;; 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-register-action (action data-header from &optional to method) + (let* ((id (mail-header-id data-header)) + (hash-entry (gethash id gnus-registry-hashtb))) + (gnus-message 5 "Registry: article %s %s from %s to %s" + id + (if method "respooling" "going") + (gnus-group-guess-full-name from) + (if to (gnus-group-guess-full-name to) "the Bit Bucket")) + (unless hash-entry + (setq hash-entry (puthash id (list data-header) gnus-registry-hashtb))) + (puthash id (cons (list action from to method) + (gethash id gnus-registry-hashtb)) gnus-registry-hashtb))) + +(defun gnus-register-spool-action (id group) + (gnus-message 5 "Registry: article %s spooled to %s" id - (gnus-group-prefixed-name group gnus-internal-registry-spool-current-method t))) - -;;(add-hook 'gnus-summary-article-move-hook 'regtest) ; also does copy, respool, and crosspost -;;(add-hook 'gnus-summary-article-delete-hook 'regtest) -;;(add-hook 'gnus-summary-article-expire-hook 'regtest) -(add-hook 'nnmail-spool-hook 'regtest-nnmail) - -;; TODO: + (gnus-group-prefixed-name + group + gnus-internal-registry-spool-current-method + t))) + +(add-hook 'gnus-summary-article-move-hook 'gnus-register-action) ; also does copy, respool, and crosspost +(add-hook 'gnus-summary-article-delete-hook 'gnus-register-action) +(add-hook 'gnus-summary-article-expire-hook 'gnus-register-action) +(add-hook 'nnmail-spool-hook 'gnus-register-spool-action) + +;; TODO: a lot of things +;; TODO: we have to load and save the registry through gnus-save-newsrc-file (provide 'gnus-registry) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index abb791e..4a6bea4 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1853,7 +1853,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)) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index dbd4ac5..a45f1ca 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -525,7 +525,7 @@ are supported for %s." (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") (n (length args))) (with-temp-buffer - (insert-string fstring) + (insert fstring) (goto-char (point-min)) (while (re-search-forward re nil t) (goto-char (match-end 0)) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index d007b35..c1a5ec2 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -49,6 +49,24 @@ :group 'gnus-start :type '(choice directory (const nil))) +(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." @@ -377,6 +395,11 @@ This hook is called as the first thing when Gnus is started." :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 @@ -604,16 +627,21 @@ 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-clear-quick-file-variables () "Clear all variables in quick startup files." @@ -1477,7 +1505,7 @@ newsgroup." t) (if (or debug-on-error debug-on-quit) (inline (gnus-request-group group dont-check method)) - (condition-case () + (condition-case nil (inline (gnus-request-group group dont-check method)) ;;(error nil) (quit @@ -1578,7 +1606,8 @@ 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))) @@ -2585,6 +2614,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 @@ -2611,16 +2646,64 @@ 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) - (save-buffer-as-coding-system gnus-ding-file-coding-system) + (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) + (output-coding-system 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) + (output-coding-system 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)) @@ -2639,17 +2722,15 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-save-newsrc-file))) (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)) - - (insert ";; -*- emacs-lisp -*-\n") - (insert ";; Gnus startup file.\n") - (insert "\ + "Print Gnus variables such as gnus-newsrc-alist in lisp format." + (princ ";; -*- emacs-lisp -*-\n") + (princ ";; Gnus startup file.\n") + (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 " - (gnus-prin1-to-string gnus-version) ")\n") + (princ "(setq gnus-newsrc-file-version ") + (princ (gnus-prin1-to-string gnus-version)) + (princ ")\n") (let* ((gnus-killed-list (if (and gnus-save-killed-list (stringp gnus-save-killed-list)) @@ -2667,9 +2748,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-product-variable-touch (&rest variables) (while variables @@ -2991,10 +3074,12 @@ If this variable is nil, don't do anything." (file-name-as-directory (expand-file-name gnus-default-directory)) default-directory))) -(defun gnus-display-time-event-handler () - "Like `display-time-event-handler', but test `display-time-timer'." - (when (gnus-boundp 'display-time-timer) - (display-time-event-handler))) +(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 () diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 054b0dd..5cc2b95 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -340,13 +340,13 @@ or not." (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-catchup-and-goto-next-group]' command will go to the next group without confirmation." :group 'gnus-summary-maneuvering :type '(choice (const :tag "off" nil) @@ -362,6 +362,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 @@ -379,6 +396,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 @@ -1077,9 +1097,10 @@ 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-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) @@ -1302,10 +1323,13 @@ end position and text.") "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.") + "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.") @@ -1520,7 +1544,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)) @@ -1536,7 +1560,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) @@ -3023,10 +3047,6 @@ display only a single character." (point) (current-buffer)))))) -(defun gnus-summary-buffer-name (group) - "Return the summary buffer name of GROUP." - (concat "*Summary " (gnus-group-decoded-name group) "*")) - (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." (let ((buffer (gnus-summary-buffer-name group)) @@ -3555,7 +3575,8 @@ If SHOW-ALL is non-nil, already read articles are also listed." (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))) @@ -5870,8 +5891,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) @@ -6034,7 +6054,7 @@ If EXCLUDE-GROUP, do not go to this group." (gnus-group-best-unread-group exclude-group)))) (defun gnus-summary-find-next (&optional unread article backward) - (if backward (gnus-summary-find-prev) + (if backward (gnus-summary-find-prev unread article) (let* ((dummy (gnus-summary-article-intangible-p)) (article (or article (gnus-summary-article-number))) (data (gnus-data-find-list article)) @@ -6049,7 +6069,14 @@ If EXCLUDE-GROUP, do not go to this group." (progn (while data (unless (memq (gnus-data-number (car data)) - gnus-newsgroup-unfetched) + (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))) @@ -6073,7 +6100,15 @@ If EXCLUDE-GROUP, do not go to this group." (if unread (progn (while data - (unless (memq (gnus-data-number (car data)) gnus-newsgroup-unfetched) + (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))) @@ -6478,14 +6513,13 @@ If FORCE (the prefix), also save the .newsrc file(s)." (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) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -6501,8 +6535,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-summary-clear-local-variables) (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-clear-local-variables)) - (when (get-buffer gnus-summary-buffer) - (kill-buffer gnus-summary-buffer))) + (gnus-kill-buffer gnus-summary-buffer)) (unless gnus-single-article-buffer (setq gnus-article-current nil)) (when gnus-use-trees @@ -6682,7 +6715,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. @@ -6690,6 +6723,10 @@ previous group instead." (let ((current-group gnus-newsgroup-name) (current-buffer (current-buffer)) entered) + ;; First we semi-exit this group to update Xrefs and all variables. + ;; We can't do a real exit, because the window conf must remain + ;; the same in case the user is prompted for info, and we don't + ;; want the window conf to change before that... (gnus-summary-exit t) (while (not entered) ;; Then we find what group we are supposed to enter. @@ -6715,20 +6752,10 @@ previous group instead." (let ((unreads (gnus-group-group-unread))) (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) - (progn - ;; Now we semi-exit this group to update Xrefs - ;; and all variables. We can't do a real exit, - ;; because the window conf must remain the same - ;; in case the user is prompted for info, and we - ;; don't want the window conf to change before - ;; that... - (when (gnus-buffer-live-p current-buffer) - (set-buffer current-buffer) - (gnus-summary-exit t)) - (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))))))) @@ -7124,7 +7151,8 @@ If STOP is non-nil, just stop when reaching the end of the message." (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 (stop (gnus-message 3 "End of message")) @@ -7983,13 +8011,18 @@ of what's specified by the `gnus-refer-thread-limit' variable." (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 (min - (+ (mail-header-number - (gnus-summary-article-header)) - limit) - gnus-newsgroup-end)) - gnus-newsgroup-name (* limit 2)) + (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")) @@ -8029,9 +8062,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))))))) @@ -8687,7 +8721,7 @@ If ARG is a negative number, hide the unwanted header lines." (1- (point)) (point-max)))) (insert-buffer-substring gnus-original-article-buffer s e) - (article-decode-encoded-words) + (run-hooks 'gnus-article-decode-hook) (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) @@ -8914,14 +8948,15 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (nnheader-get-report (car to-method)))) ((eq art-group 'junk) (when (eq action 'move) - (let ((id (mail-header-id (gnus-data-header - (assoc article (gnus-data-list nil)))))) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article) - ;; run the move/copy/crosspost/respool hook - (run-hook-with-args 'gnus-summary-article-delete-hook - action id gnus-newsgroup-name nil - select-method)))) + (gnus-summary-mark-article article gnus-canceled-mark) + (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)) @@ -9008,15 +9043,17 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." article gnus-newsgroup-name (current-buffer)))) ;; run the move/copy/crosspost/respool hook - (let ((id (mail-header-id (gnus-data-header - (assoc article (gnus-data-list nil)))))) (run-hook-with-args 'gnus-summary-article-move-hook - action id gnus-newsgroup-name to-newsgroup - select-method))) + 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)))) @@ -9188,8 +9225,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 @@ -9234,12 +9272,13 @@ This will be the case if the article has both been mailed and posted." (when (and (not (memq article es)) (gnus-data-find article)) (gnus-summary-mark-article article gnus-canceled-mark) - (let ((id (mail-header-id (gnus-data-header - (assoc article - (gnus-data-list nil)))))) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete id gnus-newsgroup-name nil - nil))))))) + (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 () @@ -9857,7 +9896,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." t) (defun gnus-summary-update-download-mark (article) - "Update the secondary (read, process, cache) mark." + "Update the download mark." (gnus-summary-update-mark (cond ((memq article gnus-newsgroup-undownloaded) gnus-undownloaded-mark) @@ -10382,8 +10421,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? @@ -11134,8 +11173,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen . (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 . (from (if (get-text-property beg gnus-mouse-face-prop) beg diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 7ef69f9..d2879d9 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -753,7 +753,7 @@ articles in the topic and its subtopics." (not (gnus-topic-goto-topic (caaar tp)))) (pop tp)) (if tp - (gnus-topic-forward-topic 1) + (forward-line 1) (gnus-topic-goto-missing-topic (caadr top))))) nil)) @@ -1104,7 +1104,7 @@ articles in the topic and its subtopics." ["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]) + ["Move matching..." gnus-topic-move-matching t]) ("Topics" ["Goto..." gnus-topic-jump-to-topic t] ["Show" gnus-topic-show-topic t] @@ -1181,6 +1181,8 @@ 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))) @@ -1203,7 +1205,8 @@ 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)))) @@ -1216,7 +1219,8 @@ Also see `gnus-group-catchup'." (save-excursion (let* ((groups (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))) (buffer-read-only nil) (gnus-group-marked groups)) (gnus-group-catchup-current) @@ -1425,9 +1429,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))) @@ -1435,20 +1439,20 @@ 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." diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 71cc93e..df890d1 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -131,13 +131,6 @@ (funcall (if (stringp buffer) 'get-buffer 'buffer-name) buffer)))) -(defmacro gnus-kill-buffer (buffer) - `(let ((buf ,buffer)) - (when (gnus-buffer-exists-p buf) - (when (boundp 'gnus-buffers) - (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))) - (kill-buffer buf)))) - (static-cond ((fboundp 'point-at-bol) (defalias 'gnus-point-at-bol 'point-at-bol)) @@ -181,7 +174,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) @@ -231,6 +224,12 @@ (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) (let ((eol (gnus-point-at-eol))) @@ -751,6 +750,19 @@ and `print-level' to nil." 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 ;;; from becoming corrupted when the user hits C-g, or if a hook or @@ -1066,6 +1078,32 @@ Return the modified alist." (while (search-backward "\\." nil t) (delete-char 1))))) +(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"))) + `(let* ((print-quoted t) + (print-readably t) + (print-escape-multibyte nil) + print-level + print-length + (,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 + (if (> ,leng 0) + (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) @@ -1283,10 +1321,10 @@ CHOICE is a list of the choice char and help message at IDX." (save-window-excursion (save-excursion (while (not tchar) - (message "%s (%s?): " + (message "%s (%s): " prompt (mapconcat (lambda (s) (char-to-string (car s))) - choice "")) + choice ", ")) (setq tchar (read-char)) (when (not (assq tchar choice)) (setq tchar nil) @@ -1375,4 +1413,38 @@ Return nil otherwise." (provide 'gnus-util) +(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))) + ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 0cdcc9a..3436670 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -861,7 +861,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)) @@ -1066,7 +1066,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 diff --git a/lisp/gnus-vers.el b/lisp/gnus-vers.el index 1265b18..a491d3a 100644 --- a/lisp/gnus-vers.el +++ b/lisp/gnus-vers.el @@ -40,10 +40,10 @@ ;; Product information of this gnus. (product-provide 'gnus-vers (product-define "T-gnus" nil - (list 6 15 15 + (list 6 15 16 (string-to-number gnus-revision-number)))) -(defconst gnus-original-version-number "0.15" +(defconst gnus-original-version-number "0.16" "Version number for this version of Gnus.") (provide 'running-pterodactyl-gnus-0_73-or-later) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 418e68e..7387944 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -791,9 +791,9 @@ XEmacs compatibility workaround." (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) (text-property-any b e 'gnus-undeletable t)))) -(defun gnus-xmas-mime-button-menu (event) +(defun gnus-xmas-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." - (interactive "e") + (interactive "e\nP") (let ((response (get-popup-menu-response `("MIME Part" ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) @@ -805,7 +805,7 @@ XEmacs compatibility workaround." (defun gnus-group-add-icon () "Add an icon to the current line according to `gnus-group-icon-list'." (let* ((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)))) (save-restriction diff --git a/lisp/gnus.el b/lisp/gnus.el index fec355f..2030ffb 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -674,9 +674,9 @@ be set in `.emacs' instead." (defface gnus-summary-high-undownloaded-face '((((class color) (background light)) - (:bold t :foreground "cyan4" :bold nil)) + (:bold t :foreground "cyan4")) (((class color) (background dark)) - (:bold t :foreground "LightGray" :bold nil)) + (:bold t :foreground "LightGray")) (t (:inverse-video t :bold t))) "Face used for high interest uncached articles.") @@ -771,6 +771,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 @@ -1516,7 +1523,7 @@ slower, and `std11-extract-address-components'." :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) @@ -1614,7 +1621,7 @@ to be desirable; see the manual for further details." ;; There should be special validation for this. (define-widget 'gnus-email-address 'string - "An email address") + "An email address.") (gnus-define-group-parameter to-address @@ -1872,6 +1879,10 @@ Only applicable to non-spam (unclassified and ham) groups.") "The BBDB summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") + (defvar gnus-group-ham-exit-processor-copy "copy" + "The ham copy exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + (gnus-define-group-parameter spam-process :type list @@ -1887,7 +1898,8 @@ Only applicable to non-spam (unclassified and ham) groups.") (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-BBDB) + (variable-item gnus-group-ham-exit-processor-copy)))) :function-document "Which spam or ham processors will be applied to the GROUP articles at summary exit." :variable gnus-spam-process-newsgroups @@ -1911,7 +1923,8 @@ for mail groups." (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-BBDB) + (variable-item gnus-group-ham-exit-processor-copy)))) :parameter-document "Which spam processors will be applied to the spam or ham GROUP articles at summary exit.") @@ -2096,8 +2109,9 @@ face." "Whether Gnus is plugged or not.") (defcustom gnus-agent-cache t - "Whether Gnus use agent cache. -You also need to enable `gnus-agent'." + "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) @@ -2105,7 +2119,7 @@ You also need to enable `gnus-agent'." (defcustom gnus-default-charset 'iso-8859-1 "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) @@ -2127,7 +2141,7 @@ Putting (gnus-agentize) in ~/.gnus is obsolete by (setq gnus-agent t)." (defcustom gnus-other-frame-parameters nil "Frame parameters used by `gnus-other-frame' to create a Gnus frame. -This should be an alist for FSF Emacs, or a plist for XEmacs." +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" @@ -2142,6 +2156,7 @@ This should be an alist for FSF Emacs, or a plist for XEmacs." (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") +(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*") @@ -3230,6 +3245,10 @@ native." (substring group 0 (match-end 0)) "")) +(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. You should probably use `gnus-find-method-for-group' instead." diff --git a/lisp/html2text.el b/lisp/html2text.el index 22ae79b..4b89f8f 100644 --- a/lisp/html2text.el +++ b/lisp/html2text.el @@ -1,6 +1,5 @@ ;;; html2text.el --- a simple html to plain text converter - -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. ;; Author: Joakim Hove @@ -287,9 +286,8 @@ formatting, and then moved afterward.") (while (< item-nr items) (setq item-nr (1+ item-nr)) (re-search-forward "
\\([ ]*\\)" (point-max) t) - (if (match-string 1) - (kill-region (point) (- (point) (string-width (match-string 1)))) - ) + (when (match-string 1) + (delete-region (point) (- (point) (string-width (match-string 1))))) (let ((def-p1 (point)) (def-p2 0)) (re-search-forward "\\([ ]*\\)\\(
\\|
\\)" (point-max) t) @@ -299,25 +297,17 @@ formatting, and then moved afterward.") (mw2 (string-width (match-string 2))) (mw (+ mw1 mw2))) (goto-char (- (point) mw)) - (kill-region (point) (+ (point) mw1)) - (setq def-p2 (point)) - ) - ) + (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) - ) - ) - ) - ) + (put-text-property def-p1 def-p2 'face 'bold))))) (defun html2text-delete-tags (p1 p2 p3 p4) - (kill-region p1 p2) - (kill-region (- p3 (- p2 p1)) (- p4 (- p2 p1))) - ) + (delete-region p1 p2) + (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1)))) (defun html2text-delete-single-tag (p1 p2) - (kill-region p1 p2) - ) + (delete-region p1 p2)) (defun html2text-clean-hr (p1 p2) (html2text-delete-single-tag p1 p2) @@ -379,7 +369,7 @@ formatting, and then moved afterward.") ;; surely improve upon this. (let* ((attr-list (html2text-get-attr p1 p2 "a")) (href (html2text-attr-value attr-list "href"))) - (kill-region p1 p4) + (delete-region p1 p4) (when href (goto-char p1) (insert (substring href 1 -1 )) @@ -446,17 +436,14 @@ fashion, quite close to pure guess-work. It does work in some cases though." ;; Removing lonely
on a single line, if they are left intact we ;; dont have any paragraphs at all. (html2text-buffer-head) - (while (< (point) (point-max)) + (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) - (if (< (point) (point-max)) - (forward-paragraph 1)) - ) - ) - ) + (when (not (eobp)) + (forward-paragraph 1))))) ;; ;; @@ -478,11 +465,7 @@ See the documentation for that variable." (while (re-search-forward (format "\\(]*>\\)" tag) (point-max) t) (let ((p1 (point))) (search-backward "<") - (kill-region (point) p1) - ) - ) - ) - ) + (delete-region (point) p1))))) (defun html2text-format-tags () "See the variable \"html2text-format-tag-list\" for documentation" diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index ae97c7e..4725651 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -52,7 +52,7 @@ "Textual token including full stop.") (defvar ietf-drums-qtext-token (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177") - "Non-white-space control characters, plus the rest of ASCII excluding + "Non-white-space control characters, plus the rest of ASCII excluding backslash and doublequote.") (defvar ietf-drums-tspecials "][()<>@,;:\\\"/?=" "Tspecials.") diff --git a/lisp/imap.el b/lisp/imap.el index 301086c..6e00ff9 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1,5 +1,5 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -142,7 +142,6 @@ (require 'base64) (eval-and-compile - (autoload 'open-ssl-stream "ssl") (autoload 'starttls-open-stream "starttls") (autoload 'starttls-negotiate "starttls") (autoload 'rfc2104-hash "rfc2104") @@ -409,22 +408,6 @@ sure of changing the value of `foo'." (setcdr alist (imap-remassoc key (cdr alist))) alist))) -(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 @@ -589,24 +572,21 @@ If ARGS, PROMPT is used as an argument to `format'." (let ((cmds (if (listp imap-ssl-program) imap-ssl-program (list imap-ssl-program))) cmd done) - (condition-case () - (require 'ssl) - (error)) (while (and (not done) (setq cmd (pop cmds))) (message "imap: Opening SSL connection with `%s'..." cmd) - (let* ((port (or port imap-default-ssl-port)) - (ssl-program-name shell-file-name) - (ssl-program-arguments - (list shell-command-switch - (format-spec cmd (format-spec-make - ?s server - ?p (number-to-string port))))) - process) - (when (setq process - (condition-case nil - (as-binary-process - (open-ssl-stream name buffer server port)) - (error nil))) + (let ((port (or port imap-default-ssl-port)) + (process-connection-type nil) + process) + (when (prog1 + (setq process (as-binary-process + (start-process + name buffer shell-file-name + shell-command-switch + (format-spec cmd + (format-spec-make + ?s server + ?p (number-to-string port)))))) + (process-kill-without-query process)) (with-current-buffer buffer (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) @@ -754,7 +734,7 @@ Returns t if login was successful, nil otherwise." "'): ") (or user imap-default-user)))) (setq passwd (or imap-password - (imap-read-passwd + (read-passwd (concat "IMAP password for " user "@" imap-server " (using authenticator `" (symbol-name imap-auth) "'): ")))) @@ -1287,7 +1267,7 @@ Returns non-nil if successful." 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. If ITEMS is a list of symbols, a list of values is -returned, if ITEMS is a symbol only it's value is returned." +returned, if ITEMS is a symbol only its value is returned." (with-current-buffer (or buffer (current-buffer)) (when (imap-ok-p (imap-send-command-wait (list "STATUS \"" @@ -2626,7 +2606,6 @@ Return nil if no complete line has arrived." (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/lpath.el b/lisp/lpath.el index 2e1e2e7..90bb882 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -50,7 +50,8 @@ enable-multibyte-characters language-info-alist mark-active mouse-selection-click-count mouse-selection-click-count-buffer pgg-parse-crc24 - temporary-file-directory transient-mark-mode))) + temporary-file-directory transient-mark-mode + mm-w3m-mode-map))) (maybe-fbind '(bbdb-complete-name delete-annotation device-connection dfw-device events-to-keys font-lock-set-defaults frame-device @@ -65,7 +66,7 @@ (maybe-bind '(help-echo-owns-message mail-mode-hook url-package-name url-package-version w3-meta-charset-content-type-regexp - w3-meta-content-type-charset-regexp))) + w3-meta-content-type-charset-regexp mm-w3m-mode-map))) ;; T-gnus. (let ((functions diff --git a/lisp/mail-source.el b/lisp/mail-source.el index b1e7abd..381f215 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -263,7 +263,23 @@ If non-nil, this maildrop will be checked periodically for new mail." :type 'integer) (defcustom mail-source-delete-incoming nil - "*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) @@ -484,15 +500,16 @@ Return the number of files that were found." (funcall function source callback) (error (if (and (not mail-source-ignore-errors) - (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)))) + (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))))))))) @@ -507,6 +524,34 @@ Return the number of files that were found." (setq newname (make-temp-name newprefix))) newname)))) +(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. Pass INFO on to CALLBACK." @@ -520,7 +565,7 @@ 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 @@ -529,7 +574,12 @@ Pass INFO on to CALLBACK." 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." @@ -606,22 +656,6 @@ 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))) @@ -665,8 +699,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 @@ -675,8 +708,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) @@ -694,7 +726,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)) @@ -763,7 +795,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))) @@ -954,14 +986,14 @@ This only works when `display-time' is enabled." (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (imap source) - (let ((from (format "%s:%s:%s" server user port)) - (found 0) - (buf (get-buffer-create - (format " *imap source %s:%s:%s *" server user mailbox))) - (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) + (let* ((from (format "%s:%s:%s" server user port)) + (found 0) + (buffer-name " *imap source*") + (buf (get-buffer-create (generate-new-buffer-name buffer-name))) + (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 buffer-name) (imap-authenticate user (or (cdr (assoc from mail-source-password-cache)) password) buf) @@ -1026,7 +1058,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/message.el b/lisp/message.el index c817653..7abec7f 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -792,6 +792,15 @@ Doing so would be even more evil than leaving it out." :group 'message-sending :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)) + :group 'message-sending) + ;; qmail-related stuff (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" "Location of the qmail-inject program." @@ -1489,6 +1498,12 @@ no, only reply back to the author." :group 'message-headers :type 'boolean) +(defcustom message-user-fqdn nil + "*Domain part of Messsage-Ids." + :group 'message-headers + :link '(custom-manual "(message)News Headers") + :type 'string) + ;;; Internal variables. (defvar message-sending-message "Sending...") @@ -1535,7 +1550,7 @@ no, only reply back to the author." ;; 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 @@ -1597,6 +1612,19 @@ no, only reply back to the author." (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 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") @@ -1945,7 +1973,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (not (string-match (regexp-quote target-group) (message-fetch-field "Newsgroups")))) (end-of-line) - (insert-string (concat "," target-group)))) + (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 @@ -2514,6 +2542,11 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (setq message-parameter-alist (copy-sequence message-startup-parameter-alist)) (message-setup-fill-variables) + (set + (make-local-variable 'paragraph-separate) + (format "\\(%s\\)\\|\\(%s\\)" + paragraph-separate + "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) ;; Allow using comment commands to add/remove quoting. (set (make-local-variable 'comment-start) message-yank-prefix) (if (featurep 'xemacs) @@ -3695,13 +3728,17 @@ used to distinguish whether the invisible text is a MIME part or not." 'mime-edit-invisible t)) (when (> mime-from mime-to) (setq hidden-start (or hidden-start mime-to)) - (put-text-property mime-to mime-from 'invisible nil)) + (add-text-properties mime-to mime-from + '(invisible nil face highlight + font-lock-face highlight))) (setq mime-to (or (text-property-not-all mime-from to 'mime-edit-invisible t) to))) (when (< mime-to to) (setq hidden-start (or hidden-start mime-to)) - (put-text-property mime-to to 'invisible nil))) + (add-text-properties mime-to to + '(invisible nil face highlight + font-lock-face highlight)))) (when hidden-start (goto-char hidden-start) (set-window-start (selected-window) (gnus-point-at-bol)) @@ -3720,14 +3757,15 @@ used to distinguish whether the invisible text is a MIME part or not." (memq (char-charset char) '(eight-bit-control eight-bit-graphic control-1))))) - (add-text-properties (point) (1+ (point)) '(highlight t)) + (add-text-properties (point) (1+ (point)) + '(font-lock-face highlight face highlight)) (setq found t)) (forward-char) (skip-chars-forward mm-7bit-chars)) (when found (setq choice (gnus-multiple-choice - "Illegible text found. Continue posting? " + "Illegible text found. Continue posting?" '((?d "Remove and continue posting") (?r "Replace with dots and continue posting") (?i "Ignore and continue posting") @@ -3744,10 +3782,11 @@ used to distinguish whether the invisible text is a MIME part or not." '(eight-bit-control eight-bit-graphic control-1))))) (if (eq choice ?i) - (remove-text-properties (point) (1+ (point)) '(highlight t)) + (remove-text-properties (point) (1+ (point)) + '(font-lock-face highlight face highlight)) (delete-char 1) - (if (eq choice ?r) - (insert ".")))) + (when (eq choice ?r) + (insert ".")))) (forward-char) (skip-chars-forward mm-7bit-chars)))))) @@ -3873,7 +3912,7 @@ This sub function is for exclusive use of `message-send-mail'." (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\n" id n total)) @@ -3951,6 +3990,7 @@ This sub function is for exclusive use of `message-send-mail'." (message-narrow-to-headers) (and news (or (message-fetch-field "cc") + (message-fetch-field "bcc") (message-fetch-field "to")) (let ((ct (mime-read-Content-Type))) (or (not ct) @@ -4011,7 +4051,7 @@ This sub function is for exclusive use of `message-send-mail'." ;; 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))) + (list "-f" (message-sendmail-envelope-from))) ;; These mean "report errors by mail" ;; and "deliver in background". (if (null message-interactive) '("-oem" "-odb")) @@ -4033,7 +4073,7 @@ This sub function is for exclusive use of `message-send-mail'." (replace-match "; ")) (if (not (zerop (buffer-size))) (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))))) + (buffer-string)))))) (when (bufferp errbuf) (kill-buffer errbuf))))) @@ -4459,8 +4499,9 @@ Otherwise, generate and save a value for `canlock-password' first." (gnus-groups-from-server method))) errors) (while groups - (unless (or (equal (car groups) "poster") - (member (car groups) known-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 @@ -5072,30 +5113,53 @@ 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 (std11-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)))) (cond - ((and (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-tickle-me"))))) @@ -6526,15 +6590,17 @@ Optional NEWS will use news to forward instead of mail." ;; We first set up a normal mail buffer. (unless (message-mail-user-agent) (set-buffer (get-buffer-create " *message resend*")) - (erase-buffer) - (let ((message-this-is-mail t) - ;; avoid to turn-on-mime-edit - message-setup-hook) - (message-setup `((To . ,address))))) + (erase-buffer)) + (let ((message-this-is-mail t) + message-setup-hook) + (message-setup `((To . ,address)))) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (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-")) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index e672e33..b28c50c 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -243,9 +243,10 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) -(defun mm-decode-body (charset &optional encoding type) +(defun mm-decode-body (charset &optional encoding type force) "Decode the current article that has been encoded with ENCODING. -The characters in CHARSET should then be decoded." +The characters in CHARSET should then be decoded. If FORCE is non-nil +use the supplied charset unconditionally." (if (stringp charset) (setq charset (intern (downcase charset)))) (if (or (not charset) @@ -271,7 +272,24 @@ 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)))))) + (if force + (mm-decode-coding-region (point-min) (point-max) + coding-system) + (mm-decode-coding-region-safely (point-min) (point-max) + coding-system))))))) + +(defun mm-decode-coding-region-safely (start end coding-system) + "Decode region between START and END with CODING-SYSTEM. +If CODING-SYSTEM is not a valid coding system for the text, let Emacs +decide which coding system to use." + (let* ((decoded (mm-decode-coding-string (buffer-substring start end) + coding-system)) + (charsets (find-charset-string decoded))) + (if (or (memq 'eight-bit-control charsets) + (memq 'eight-bit-graphic charsets)) + (mm-decode-coding-region start end 'undecided) + (delete-region start end) + (insert decoded)))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 02af749..8c47948 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -333,10 +333,10 @@ Ready-made functions include `upcase-initials'.") (defvar mm-path-name-rewrite-functions nil - "*List of functions used for rewriting path names of MIME parts. -This is used when viewing parts externally , and is meant for -transforming the path name so that non-compliant programs can -find the file where it's saved. + "*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.") @@ -1266,7 +1266,7 @@ If RECURSIVE, search recursively." (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) - (setq result (buffer-substring (point-min) (point-max))))))) + (setq result (buffer-string)))))) (forward-line 1) (setq start (point))) (when (and (not result) start) @@ -1279,7 +1279,7 @@ If RECURSIVE, search recursively." (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) - (setq result (buffer-substring (point-min) (point-max))))))) + (setq result (buffer-string)))))) result)) (defvar mm-security-handle nil) diff --git a/lisp/mm-url.el b/lisp/mm-url.el index aa3cfda..401d500 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -359,7 +359,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (with-temp-buffer (insert string) (mm-url-decode-entities) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) (defun mm-url-form-encode-xwfu (chunk) "Escape characters in a string for application/x-www-form-urlencoded. diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 80fb3f2..85c44f1 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -303,7 +303,9 @@ mail with multiple parts is preferred to sending a Unicode one.") "Return the MIME charset corresponding to the given Mule CHARSET." (if (fboundp 'find-coding-systems-for-charsets) (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 (coding-system-get cs 'mime-charset))))) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index ffc4353..df5566c 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -207,7 +207,7 @@ Return that buffer." (if (looking-at ".+") (setq file-name (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 0)))))) (defun mm-uu-binhex-filename () @@ -361,7 +361,7 @@ Return that buffer." ((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?"))))) + (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)))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index d5e5dc3..b569247 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -73,25 +73,28 @@ (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))) @@ -369,7 +372,8 @@ map."))) (set-text-properties (point-min) (point-max) nil) (when (or (equal type "enriched") (equal type "richtext")) - (enriched-decode (point-min) (point-max))) + (ignore-errors + (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/mml1991.el b/lisp/mml1991.el index ff44132..66cd459 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -1,5 +1,5 @@ -;;; mml-gpg-old.el --- Old PGP message format (RFC 1991) support for MML -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML +;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc. ;; Author: Sascha Ldecke , ;; Simon Josefsson (Mailcrypt interface, Gnus glue) @@ -53,10 +53,9 @@ ;; Save MIME Content[^ ]+: headers from signing (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (setq headers (buffer-substring (point-min) (point))) - (kill-region (point-min) (point)))) + (unless (bobp) + (setq headers (buffer-string)) + (delete-region (point-min) (point))) (goto-char (point-max)) (unless (bolp) (insert "\n")) @@ -74,7 +73,7 @@ (replace-match "" t t)) (quoted-printable-encode-region (point-min) (point-max)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) (if headers (insert headers)) (insert "\n") (insert-buffer signature) @@ -96,9 +95,8 @@ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (kill-region (point-min) (point)))) + (unless (bobp) + (delete-region (point-min) (point))) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer (setq cipher (current-buffer)) @@ -119,7 +117,7 @@ (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") @@ -138,10 +136,9 @@ ;; Save MIME Content[^ ]+: headers from signing (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (setq headers (buffer-substring (point-min) (point))) - (kill-region (point-min) (point)))) + (unless (bobp) + (setq headers (buffer-string)) + (delete-region (point-min) (point))) (goto-char (point-max)) (unless (bolp) (insert "\n")) @@ -159,7 +156,7 @@ (replace-match "" t t)) (quoted-printable-encode-region (point-min) (point-max)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) (if headers (insert headers)) (insert "\n") (insert-buffer signature) @@ -172,9 +169,8 @@ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (kill-region (point-min) (point)))) + (unless (bobp) + (delete-region (point-min) (point))) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer (flet ((gpg-encrypt-func @@ -207,7 +203,7 @@ (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") @@ -228,7 +224,7 @@ (unless (eobp) ;; no headers? (setq headers (buffer-substring (point-min) (point))) (forward-line) ;; skip header/body separator - (kill-region (point-min) (point))) + (delete-region (point-min) (point))) (quoted-printable-decode-region (point-min) (point-max)) (unless (let ((pgg-default-user-id (or (message-options-get 'message-sender) @@ -236,7 +232,7 @@ (pgg-sign-region (point-min) (point-max) t)) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) (insert-buffer pgg-output-buffer) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) @@ -252,9 +248,8 @@ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (kill-region (point-min) (point)))) + (unless (bobp) + (delete-region (point-min) (point))) (unless (pgg-encrypt-region (point-min) (point-max) (split-string @@ -266,7 +261,7 @@ sign) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") diff --git a/lisp/nndb.el b/lisp/nndb.el index d8fb469..cfcc0c6 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -286,7 +286,7 @@ Optional LAST is ignored." (nntp-send-buffer "^[23].*\n")) (set-buffer nntp-server-buffer) - (setq msg (buffer-substring (point-min) (point-max))) + (setq msg (buffer-string)) (or (string-match "^\\([0-9]+\\)" msg) (error "nndb: %s" msg)) (setq art (substring msg (match-beginning 1) (match-end 1))) @@ -312,7 +312,7 @@ Optional LAST is ignored." (deffoo nndb-status-message (&optional server) "Return server status as a string." (set-buffer nntp-server-buffer) - (buffer-substring (point-min) (point-max))) + (buffer-string)) ;; Import stuff from nntp diff --git a/lisp/nndoc.el b/lisp/nndoc.el index b675e26..7de053d 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -58,9 +58,6 @@ 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)) (nsmail (article-begin . "^From - ")) (news @@ -76,6 +73,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 . "^--.*$") @@ -630,7 +630,7 @@ from the document.") (setq subject (concat " (" (match-string 1) ")")) (when (re-search-forward "^From: \\(.*\\)" nil t) (setq from (concat "<" - (cadr (funcall gnus-extract-address-components + (cadr (funcall gnus-extract-address-components (match-string 1))) ">"))) (if (re-search-forward "^Date: +\\([^(]*\\)" nil t) (setq date (match-string 1)) @@ -890,7 +890,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/nndraft.el b/lisp/nndraft.el index 9ca7314..bd27cfe 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -196,6 +196,13 @@ '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 ((nnmh-allow-delete-final t)) + (nnoo-parent-function 'nndraft 'nndraft-request-move-article + (list article group server accept-form last)))) + (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) @@ -286,8 +293,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/nnfolder.el b/lisp/nnfolder.el index 251c6c7..448ada4 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -204,7 +204,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (goto-char (match-end 0)) (setq num (string-to-int (buffer-substring - (point) (progn (end-of-line) (point))))) + (point) (gnus-point-at-eol)))) (goto-char start) (< num article))) ;; Check that we are before an article with a @@ -214,7 +214,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (progn (setq num (string-to-int (buffer-substring - (point) (progn (end-of-line) (point))))) + (point) (gnus-point-at-eol)))) (> num article)) ;; Discard any article numbers before the one we're ;; now looking at. @@ -287,9 +287,8 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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) @@ -485,8 +484,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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) @@ -512,9 +510,9 @@ the group. Then the marks file will be regenerated properly by Gnus.") result art-group) (goto-char (point-min)) (when (looking-at "X-From-Line: ") - (save-match-data - (mail-header-unfold-field)) - (replace-match "From ")) + (replace-match "From ") + (while (progn (forward-line) (looking-at "[ \t]")) + (delete-char -1))) (with-temp-buffer (let ((nnmail-file-coding-system nnfolder-active-file-coding-system) (nntp-server-buffer (current-buffer))) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index aa94eaa..b44790b 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -880,7 +880,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)) @@ -888,8 +888,7 @@ the line could be found." (setq prev (point)) (while (and (not (numberp (setq num (read cur)))) (not (eobp))) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (gnus-delete-line)) (cond ((> num article) (setq max (point))) ((< num article) @@ -1176,7 +1175,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; 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 @@ -1303,7 +1302,8 @@ If FULL, translate everything." ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt))) + (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. @@ -1454,7 +1454,9 @@ without formatting." (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. + "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." (let ((path load-path) dir result) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 699059b..0ae687c 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -198,13 +198,22 @@ RFC2060 section 6.4.4." :group 'nnimap :type 'sexp) -(defcustom nnimap-split-download-body nil +(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." +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 'boolean) + :type '(choice (const :tag "Let system decide" deault) + boolean)) ;; Performance / bug workaround variables @@ -1446,7 +1455,7 @@ 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")) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index eb524c7..928165b 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -110,7 +110,7 @@ (setq num (string-to-int (match-string 2 xref)) group (match-string 1 xref)) (or (with-current-buffer buffer - (or (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))))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index e377b86..0cdc420 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -35,7 +35,8 @@ (require 'mail-source) (eval-and-compile - (autoload 'gnus-add-buffer "gnus")) + (autoload 'gnus-add-buffer "gnus") + (autoload 'gnus-kill-buffer "gnus")) (defgroup nnmail nil "Reading mail with Gnus." @@ -1038,7 +1039,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)) @@ -1511,12 +1512,16 @@ See the documentation for the variable `nnmail-split-fancy' for details." (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) (be nil) - (res 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 get-new-mail + (intern (format "%s-get-new-mail" (car be)))) + (boundp get-new-mail) + (symbol-value get-new-mail)) (setq res be))) res)) @@ -1532,8 +1537,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) - (progn (end-of-line) (point)))))))) + (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. diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index 66e82ec..e74bc81 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -41,16 +41,14 @@ ;; copying, restoring, etc. ;; ;; Todo: -;; * Merge the information from -;; into the Gnus manual. -;; * Allow create-directory = ".", and configurable prefix of maildir names, -;; stripped off to produce group names. +;; * Replace create-directory with target-prefix, so the maildirs can be in +;; the same directory as the symlinks, starting with, e.g., ".". ;; * Add a hook for when moving messages from new/ to cur/, to support ;; nnmail's duplicate detection. ;; * Allow each mark directory in a group to have its own inode for mark ;; files, to accommodate AFS. ;; * Improve generated Xrefs, so crossposts are detectable. -;; * Improve readability. +;; * Improve code readability. ;;; Code: @@ -86,8 +84,8 @@ by nnmaildir-request-article.") ;; Variables to generate filenames of messages being delivered: (defvar nnmaildir--delivery-time "") -(defconst nnmaildir--delivery-pid (number-to-string (emacs-pid))) -(defvar nnmaildir--delivery-ct nil) +(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: @@ -620,17 +618,13 @@ by nnmaildir-request-article.") (defun nnmaildir--parse-filename (file) (let ((prefix (car file)) timestamp len) - (if (string-match - "\\`\\([0-9]+\\)\\.\\([0-9]+\\)\\(_\\([0-9]+\\)\\)?\\(\\..*\\)\\'" - prefix) + (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)) - (string-to-number (match-string 2 prefix)) - (string-to-number (or (match-string 4 prefix) "-1")) - (match-string 5 prefix) + (match-string 2 prefix) file)) file))) @@ -643,11 +637,7 @@ by nnmaildir-request-article.") (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)) - (if (< (aref a 2) (aref b 2)) (throw 'return t)) - (if (> (aref a 2) (aref b 2)) (throw 'return nil)) - (if (< (aref a 3) (aref b 3)) (throw 'return t)) - (if (> (aref a 3) (aref b 3)) (throw 'return nil)) - (string-lessp (aref a 4) (aref b 4)))) + (string-lessp (aref a 2) (aref b 2)))) (defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls) (catch 'return @@ -703,7 +693,9 @@ by nnmaildir-request-article.") (when (or isnew nattr) (mapcar (lambda (file) - (rename-file (concat ndir file) (concat cdir file ":2,"))) + (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))) @@ -751,7 +743,7 @@ by nnmaildir-request-article.") files (sort files 'nnmaildir--sort-files)) (mapcar (lambda (file) - (setq file (if (consp file) file (aref file 5)) + (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) @@ -857,9 +849,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-update-info (gname info &optional server) (let ((group (nnmaildir--prepare server gname)) - pgname flist all always-marks never-marks old-marks dotfile num dir + 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 deactivate-mark) + old-mmth new-mmth mtime mark-sym existing missing deactivate-mark) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -876,6 +868,13 @@ by nnmaildir-request-article.") 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) @@ -893,13 +892,7 @@ by nnmaildir-request-article.") (catch 'got-ranges (if (memq mark-sym never-marks) (throw 'got-ranges nil)) (when (memq mark-sym always-marks) - (unless all - (setq all (nnmaildir--grp-nlist group) - all (mapcar 'car all) - all (nreverse all) - all (gnus-compress-sequence all 'always-list) - all (cons 'dummy-mark-symbol all))) - (setq ranges (cdr all)) + (setq ranges existing) (throw 'got-ranges nil)) (setq mtime (nth 5 (file-attributes markdir))) (set (intern mark new-mmth) mtime) @@ -918,7 +911,7 @@ by nnmaildir-request-article.") (if (eq mark-sym 'read) (setq read ranges) (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) markdirs) - (gnus-info-set-read info read) + (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))) @@ -1273,7 +1266,7 @@ by nnmaildir-request-article.") (buffer-file-coding-system nil) (file-coding-system nil) (file-coding-system-alist nil) - srv-dir dir file tmpfile curfile 24h article) + srv-dir dir file time tmpfile curfile 24h article) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -1287,15 +1280,17 @@ by nnmaildir-request-article.") (throw 'return nil)) (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir srv-dir gname) - file (format-time-string "%s" nil)) + time (current-time) + file (format-time-string "%s." time)) (unless (string-equal nnmaildir--delivery-time file) (setq nnmaildir--delivery-time file - nnmaildir--delivery-ct 0)) - (setq file (concat file "." nnmaildir--delivery-pid)) - (unless (zerop nnmaildir--delivery-ct) - (setq file (concat file "_" - (number-to-string nnmaildir--delivery-ct)))) - (setq file (concat file "." (system-name)) + 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 "." (system-name)) ;;;; FIXME: encode / and : tmpfile (concat (nnmaildir--tmp dir) file) curfile (concat (nnmaildir--cur dir) file ":2,")) (when (file-exists-p tmpfile) @@ -1306,7 +1301,7 @@ by nnmaildir-request-article.") (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "File exists: " curfile)) (throw 'return nil)) - (setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct) + (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count) 24h (run-with-timer 86400 nil (lambda () (nnmaildir--unlink tmpfile) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index fe4a30b..3cb586f 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -299,8 +299,7 @@ (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) @@ -425,9 +424,7 @@ (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 diff --git a/lisp/nnmh.el b/lisp/nnmh.el index d81bc2d..d326c06 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -297,8 +297,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 diff --git a/lisp/nnml.el b/lisp/nnml.el index 60595dd..d2f985e 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -424,8 +424,7 @@ marks file will be regenerated properly by Gnus.") (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...) @@ -699,7 +698,7 @@ marks file will be regenerated properly by Gnus.") (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." diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 6bbfeb0..d86efe1 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -462,7 +462,7 @@ ARTICLE is the article number of the current headline.") (mm-with-unibyte-buffer (insert string) (mm-url-decode-entities-nbsp) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) (defalias 'nnrss-insert 'nnrss-insert-w3) diff --git a/lisp/nntp.el b/lisp/nntp.el index 0c735f5..9d55a15 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -284,9 +284,12 @@ noticing asynchronous data.") (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) -(eval-and-compile - (autoload 'mail-source-read-passwd "mail-source") - (autoload 'open-ssl-stream "ssl")) +(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.") @@ -1109,9 +1112,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." @@ -1120,8 +1122,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. @@ -1135,7 +1137,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. @@ -1213,7 +1215,16 @@ password contained in '~/.nntp-authinfo'." "nntpd" buffer nntp-address nntp-port-number)) (defun nntp-open-ssl-stream (buffer) - (let ((proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number))) + (let* ((process-connection-type nil) + (proc (as-binary-process + (start-process "nntpd" buffer + shell-file-name + shell-command-switch + (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]") @@ -1345,7 +1356,7 @@ password contained in '~/.nntp-authinfo'." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) nntp-server-buffer)) - (let ((len (/ (point-max) 1024)) + (let ((len (/ (buffer-size) 1024)) message-log-max) (unless (< len 10) (setq nntp-have-messaged t) @@ -1380,16 +1391,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) - (save-excursion - (set-buffer nntp-server-buffer) - (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." @@ -1735,7 +1748,7 @@ via telnet.") 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 @@ -1793,7 +1806,8 @@ Please refer to the following variables to customize the connection: proc) (and nntp-pre-command (push nntp-pre-command command)) - (setq proc (apply 'start-process "nntpd" buffer command)) + (setq proc (as-binary-process + (apply 'start-process "nntpd" buffer command))) (save-excursion (set-buffer buffer) (nntp-wait-for-string "^\r*20[01]") @@ -1866,7 +1880,8 @@ Please refer to the following variables to customize the connection: (case-fold-search t) proc) (and nntp-pre-command (push nntp-pre-command command)) - (setq proc (apply 'start-process "nntpd" buffer command)) + (setq proc (as-binary-process + (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") @@ -1890,8 +1905,7 @@ Please refer to the following variables to customize the connection: (concat (or nntp-via-user-password (setq nntp-via-user-password - (mail-source-read-passwd - "Password: "))) + (read-passwd "Password: "))) "\n")) (nntp-wait-for-string nntp-via-shell-prompt) (let ((real-telnet-command `("exec" diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 855e938..76a4670 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -427,7 +427,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) diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index e780aa9..ed02567 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -41,7 +41,6 @@ (require 'gnus-bcklg) (require 'nnmail) (require 'mm-util) -(require 'mail-source) (require 'mm-url) (nnoo-declare nnwarchive) @@ -286,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 diff --git a/lisp/pop3.el b/lisp/pop3.el index b09c6a0..1e17432 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -133,7 +133,7 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.") ;; 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) @@ -185,7 +185,7 @@ Nil means no, t means yes, not-nil-or-t means yet to be determined.") ;; 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) @@ -305,17 +305,6 @@ Return the response string if optional second argument RETURN 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 @@ -558,7 +547,7 @@ Check whether the 4th argument CODING-SYSTEM is allowed" (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)) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 8fd737f..9bb8c0f 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -538,7 +538,7 @@ The buffer may be narrowed." 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)))))) + (mm-decode-coding-region-safely b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." @@ -555,7 +555,12 @@ The buffer may be narrowed." 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) + (let* ((decoded (mm-decode-coding-string string mail-parse-charset)) + (charsets (find-charset-string decoded))) + (if (or (memq 'eight-bit-control charsets) + (memq 'eight-bit-graphic charsets)) + (mm-decode-coding-string string 'undecided) + decoded)) string)))) (defun rfc2047-parse-and-decode (word) diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el index 9193577..b3015ab 100644 --- a/lisp/sieve-manage.el +++ b/lisp/sieve-manage.el @@ -166,23 +166,6 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun sieve-manage-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))) - - ;; Uses the dynamically bound `reason' variable. (defvar reason) (defun sieve-manage-interactive-login (buffer loginfunc) @@ -202,7 +185,7 @@ Returns t if login was successful, nil otherwise." sieve-manage-server ": ") (or user sieve-manage-default-user)))) (setq passwd (or sieve-manage-password - (sieve-manage-read-passwd + (read-passwd (concat "Managesieve password for " user "@" sieve-manage-server ": ")))) (when (and user passwd) diff --git a/lisp/spam.el b/lisp/spam.el index 9050c3a..dc44be1 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -42,6 +42,9 @@ (require 'gnus) ; for the definitions of group content classification and spam processors (require 'message) ;for the message-fetch-field functions +;; for nnimap-split-download-body-default +(eval-when-compile (require 'nnimap)) + ;; autoload query-dig (eval-and-compile (autoload 'query-dig "dig")) @@ -66,7 +69,15 @@ When nil, only ham and unclassified groups will have their spam moved to the spam-process-destination. When t, spam will also be moved from spam groups." :type 'boolean - :group 'spam-ifile) + :group 'spam) + +(defcustom spam-mark-ham-unread-before-move-from-spam-group nil + "Whether ham should be marked unread before it's 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-whitelist (expand-file-name "whitelist" spam-directory) "The location of the whitelist. @@ -109,6 +120,11 @@ are considered spam." :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 variable `spam-spam-regex-headers' and `spam-ham-regex-headers'." @@ -259,6 +275,16 @@ your main source of newsgroup names." :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-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" "The regex on `spam-bogofilter-header' for positive spam identification." :type 'regexp @@ -333,6 +359,9 @@ your main source of newsgroup names." (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)) + ;;; Summary entry and exit processing. (defun spam-summary-prepare () @@ -340,61 +369,68 @@ your main source of newsgroup names." (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) +;; The spam processors are invoked for any group, spam or ham or neither (defun spam-summary-prepare-exit () - ;; The spam processors are invoked for any group, spam or ham or neither - (gnus-message 6 "Exiting summary buffer and applying spam rules") - (when (and spam-bogofilter-path - (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name)) - (gnus-message 5 "Registering spam with bogofilter") - (spam-bogofilter-register-spam-routine)) + (unless gnus-group-is-exiting-without-update-p + (gnus-message 6 "Exiting summary buffer and applying spam rules") + (when (and spam-bogofilter-path + (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name)) + (gnus-message 5 "Registering spam with bogofilter") + (spam-bogofilter-register-spam-routine)) - (when (and spam-ifile-path - (spam-group-spam-processor-ifile-p gnus-newsgroup-name)) - (gnus-message 5 "Registering spam with ifile") - (spam-ifile-register-spam-routine)) + (when (and spam-ifile-path + (spam-group-spam-processor-ifile-p gnus-newsgroup-name)) + (gnus-message 5 "Registering spam with ifile") + (spam-ifile-register-spam-routine)) - (when (spam-group-spam-processor-stat-p gnus-newsgroup-name) - (gnus-message 5 "Registering spam with spam-stat") - (spam-stat-register-spam-routine)) - - (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name) - (gnus-message 5 "Registering spam with the blacklist") - (spam-blacklist-register-routine)) - - (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") - (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 - (spam-mark-spam-as-expired-and-move-routine nil) - - (when (spam-group-ham-contents-p gnus-newsgroup-name) - (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with the whitelist") - (spam-whitelist-register-routine)) - (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with ifile") - (spam-ifile-register-ham-routine)) - (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with Bogofilter") - (spam-bogofilter-register-ham-routine)) - (when (spam-group-ham-processor-stat-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with spam-stat") - (spam-stat-register-ham-routine)) - (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with the BBDB") - (spam-BBDB-register-routine))) - - ;; 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)))) + (when (spam-group-spam-processor-stat-p gnus-newsgroup-name) + (gnus-message 5 "Registering spam with spam-stat") + (spam-stat-register-spam-routine)) + + (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name) + (gnus-message 5 "Registering spam with the blacklist") + (spam-blacklist-register-routine)) + + (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 (spam-group-ham-contents-p gnus-newsgroup-name) + (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with the whitelist") + (spam-whitelist-register-routine)) + (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with ifile") + (spam-ifile-register-ham-routine)) + (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with Bogofilter") + (spam-bogofilter-register-ham-routine)) + (when (spam-group-ham-processor-stat-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with spam-stat") + (spam-stat-register-ham-routine)) + (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with the BBDB") + (spam-BBDB-register-routine))) + + (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) + (gnus-message 5 "Copying ham") + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name) t)) + + ;; 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))))) (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) @@ -411,28 +447,44 @@ your main source of newsgroup names." (gnus-summary-mark-article article gnus-spam-mark)))))) (defun spam-mark-spam-as-expired-and-move-routine (&optional group) + (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article) - (while articles - (setq article (pop articles)) + article tomove) + (dolist (article articles) (when (eq (gnus-summary-article-mark article) gnus-spam-mark) (gnus-summary-mark-article article gnus-expirable-mark) - (when (stringp group) - (let ((gnus-current-article article)) - (gnus-summary-move-article nil group))))))) + (push article tomove))) + + ;; now do the actual move + (when (and tomove + (stringp group)) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove (gnus-summary-move-article nil group)))) + (gnus-summary-yank-process-mark)) -(defun spam-ham-move-routine (&optional group) +(defun spam-ham-move-routine (&optional group copy) + (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article ham-mark-values mark) - - (dolist (mark spam-ham-marks) - (push (symbol-value mark) ham-mark-values)) - - (dolist (article articles) - (when (and (memq (gnus-summary-article-mark article) ham-mark-values) - (stringp group)) - (let ((gnus-current-article article)) - (gnus-summary-move-article nil group)))))) + article ham-mark-values mark tomove) + (when (stringp group) ; this routine will do nothing + ; without a valid group + (dolist (mark spam-ham-marks) + (push (symbol-value mark) ham-mark-values)) + (dolist (article articles) + (when (memq (gnus-summary-article-mark article) ham-mark-values) + (push article tomove))) + + ;; now do the actual move + (when tomove + (dolist (article tomove) + (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 copy + (gnus-summary-copy-article nil group) + (gnus-summary-move-article nil group))))) + (gnus-summary-yank-process-mark)) (defun spam-generic-register-routine (spam-func ham-func) (let ((articles gnus-newsgroup-articles) @@ -486,14 +538,15 @@ your main source of newsgroup names." (setq article-buffer (get-buffer gnus-article-buffer)))) article-buffer)) -(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))) +;; 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" @@ -520,6 +573,7 @@ your main source of newsgroup names." (spam-use-ifile . spam-check-ifile) (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 @@ -534,6 +588,11 @@ 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-stat spam-use-bogofilter) +"The spam-list-of-statistical-checks list contains all the mail +splitters that need to have the full message body available.") + (defun spam-split () "Split this message into the `spam' group if it is spam. This function can be used as an entry in `nnmail-split-fancy', for @@ -541,10 +600,14 @@ example like this: (: spam-split) See the Info node `(gnus)Fancy Mail Splitting' for more details." (interactive) - - ;; load the spam-stat tables if needed - (when spam-use-stat (spam-stat-load)) + (dolist (check spam-list-of-statistical-checks) + (when (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)) @@ -555,6 +618,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if (eq decision t) nil decision))) + +(defun spam-setup-widening () + (dolist (check spam-list-of-statistical-checks) + (when (symbol-value check) + (setq nnimap-split-download-body-default t)))) + +(add-hook 'gnus-get-new-news-hook 'spam-setup-widening) + ;;;; Regex headers @@ -602,7 +673,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if spam-use-dig (let ((query-result (query-dig query-string))) (when query-result - (gnus-message 5 "(DIG): positive blackhole check '%s'" 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 @@ -613,6 +685,20 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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 @@ -708,7 +794,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (let ((category (or category gnus-newsgroup-name)) (db-param (spam-get-ifile-database-parameter))) (with-temp-buffer - (insert-string article-string) + (insert article-string) (if db-param (call-process-region (point-min) (point-max) spam-ifile-path nil nil nil @@ -751,10 +837,9 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (lambda (article) (let ((article-string (spam-get-article-as-string article))) (with-temp-buffer - (insert-string article-string) + (insert article-string) (spam-stat-buffer-is-spam)))) - nil) - (spam-stat-save)) + nil)) (defun spam-stat-register-ham-routine () (spam-generic-register-routine @@ -762,9 +847,19 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (lambda (article) (let ((article-string (spam-get-article-as-string article))) (with-temp-buffer - (insert-string article-string) - (spam-stat-buffer-is-non-spam))))) - (spam-stat-save))) + (insert article-string) + (spam-stat-buffer-is-non-spam)))))) + + (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))) + + ;; 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)) (file-error (progn (defalias 'spam-stat-register-ham-routine 'ignore) @@ -914,9 +1009,10 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (defun spam-bogofilter-register-with-bogofilter (article-string spam) "Register an article, given as a string, as spam or non-spam." (when (stringp article-string) - (let ((switch (if spam "-s" "-n"))) + (let ((switch (if spam spam-bogofilter-spam-switch + spam-bogofilter-ham-switch))) (with-temp-buffer - (insert-string article-string) + (insert article-string) (if spam-bogofilter-database-directory (call-process-region (point-min) (point-max) spam-bogofilter-path diff --git a/texi/ChangeLog b/texi/ChangeLog index 477cd97..836dfed 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,124 @@ +2003-03-17 Reiner Steib + + * gnus.texi (Using MIME): Added gnus-mime-delete-part. + +2003-03-17 Lars Magne Ingebrigtsen + + * gnus.texi (Required Back End Functions): Add. + +2003-03-17 Simon Josefsson + + * pgg.texi: Fix setfilename. Tiny patch by Frank Haun + . + +2003-03-09 Paul Jarc + + * gnus.texi (Top): Added menu item for Maildir node. + +2003-03-11 Jesper Harder + + * gnus.texi (Paging the Article): Addition. + +2003-03-10 Jesper Harder + + * gnus.texi (Customizing Articles): Additions. + +2003-03-09 Paul Jarc + + * gnus.texi (Maildir): New node. + +2003-03-08 Jesper Harder + + * gnusref.tex: Update. + +2003-03-03 Reiner Steib + + * gnus.texi (Mail and Post): Updated `gnus-user-agent'. + (Mail Source Customization): Added `mail-source-delete-incoming' + and `mail-source-delete-old-incoming-confirm'. + +2003-03-01 Jesper Harder + + * gnus.texi (Troubleshooting): Fix typo. + (Group Parameters): Markup fix. + (Article Hiding, Splitting Mail, Fancy Mail Splitting) + (Document Server Internals, Score Variables, Adaptive Scoring) + (X-Face, Hashcash): do. + +2003-02-28 Vasily Korytov + + * gnus.texi: New values, 'to-list and 'cc-list, for + gnus-boring-article-headers. + +2003-02-28 Teodor Zlatanov + + * gnus.texi (Extending the spam elisp package): added mention of + spam-list-of-statistical-checks + +2003-02-27 ShengHuo ZHU + + * gnus.texi: Remove the dependence on ssl.el. + +2003-02-26 Jesper Harder + + * message.texi (Mail Variables): Add + message-sendmail-envelope-from. + +2003-02-24 Reiner Steib + + * gnus.texi (Mail and Post): Added `gnus-user-agent', removed + `gnus-version-expose-system'. + +2003-02-24 Jesper Harder + + * gnus.texi: Markup fixes. + + * message.texi: do. + + * emacs-mime.texi: do. + +2003-02-20 Reiner Steib + + * message.texi (News Headers): Update description of Message-ID. + +2003-02-23 Lars Magne Ingebrigtsen + + * gnus.texi (Startup Files): Addition. + +2003-02-22 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Source Specifiers): Addition. + +2003-02-22 Jesper Harder + + * emacs-mime.texi (Files and Directories): New node. + +2003-02-21 Jesper Harder + + * gnus.texi (Mailing List): Fix. + + * gnus.texi: Markup fixes. + +2003-02-18 Reiner Steib + + * gnus.texi (Article Washing): Mention `g'. + (Customizing Articles): Added cross reference. + +2003-02-12 Michael Shields + + * gnus.texi (Paging the Article): Document + gnus-article-boring-faces. + (Choosing Commands): Explain that SPACE in the summary buffer + is used for both selecting and scrolling. + + * gnus.texi (Article Keymap): Say that SPACE and DEL in the + summary buffer are the same as switching to the article buffer + and using SPACE and DEL; since now that is the case. + +2003-02-11 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + 2003-02-07 Teodor Zlatanov * gnus.texi (BBDB Whitelists, Blacklists and Whitelists): diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 2261722..f249157 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -117,6 +117,7 @@ returned as a result of this analysis. * Handles:: Handle manipulations. * Display:: Displaying handles. * Display Customization:: Variables that affect display. +* Files and Directories:: Saving and naming attachments. * New Viewers:: How to write your own viewers. @end menu @@ -400,6 +401,59 @@ The program used to start an external terminal. @end table +@node Files and Directories +@section Files and Directories + +@table @code + +@item mm-default-directory +@vindex mm-default-directory +The default directory for saving attachments. If @code{nil} use +@code{default-directory}. + +@item mm-tmp-directory +@vindex mm-tmp-directory +Directory for storing temporary files. + +@item mm-file-name-rewrite-functions +@vindex mm-file-name-rewrite-functions +A list of functions used for rewriting file names of @sc{mime} +parts. Each function is applied successively to the file name. +Ready-made functions include + +@table @code +@item mm-file-name-delete-whitespace +@findex mm-file-name-delete-whitespace +Remove all whitespace. + +@item mm-file-name-trim-whitespace +@findex mm-file-name-trim-whitespace +Remove leading and trailing whitespace. + +@item mm-file-name-collapse-whitespace +@findex mm-file-name-collapse-whitespace +Collapse multiple whitespace characters. + +@item mm-file-name-replace-whitespace +@findex mm-file-name-replace-whitespace +@vindex mm-file-name-replace-whitespace +Replace whitespace with underscores. Set the variable +@code{mm-file-name-replace-whitespace} to any other string if you do +not like underscores. + +@end table + +The standard Emacs functions @code{capitalize}, @code{downcase}, +@code{upcase} and @code{upcase-initials} might also prove useful. + +@item mm-path-name-rewrite-functions +@vindex mm-path-name-rewrite-functions +List of functions used for rewriting the full file names of @sc{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. + +@end table @node New Viewers @section New Viewers @@ -427,7 +481,7 @@ The two important helper functions here are @code{mm-insert-part} and handle in the current buffer. It handles charset and/or content transfer decoding. The second function just inserts whatever text you tell it to insert, but it also sets things up so that the text can be -``undisplayed' in a convenient manner. +``undisplayed'' in a convenient manner. @node Composing @@ -1390,7 +1444,7 @@ Take a time and return the number of days that represents. @item safe-date-to-time Take a date and return a time. If the date is not syntactically valid, -return a "zero" date. +return a ``zero'' date. @item time-less-p Take two times and say whether the first time is less (i. e., earlier) diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 5de1d72..231b115 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -665,8 +665,8 @@ Customizing Threading $B%I$K$9$kJ}K!(B * Filling In Threads:: $B%9%l%C%I$rKd$a$k(B * More Threading:: $B%9%l%C%I$r$$$8$/$k$5$i$KB?$/$NJQ?t(B -* Low-Level Threading:: $B$3$l$G=*$o$C$?$H;W$C$?$G$7$g$&(B... $B$G$b$"(B - $B$J$?$O4V0c$C$F$$$?(B! +* Low-Level Threading:: $B$3$l$G=*$o$C$?$H;W$C$?$G$7$g$&(B@dots{} $B$G(B + $B$b$"$J$?$O4V0c$C$F$$$?(B! Decoding Articles @@ -803,6 +803,7 @@ Choosing a Mail Back End $B%^%C%H$r;H$&(B * Mail Spool:: $B$"$J$?$N%a!<%k$r;dE*$J%9%W!<%k$KN/$a$k(B? * MH Spool:: mhspool $B$N$h$&$J%P%C%/%(%s%I(B +* Maildir:: $B$b$&0l$D$N#1%U%!%$%k(B/$B#1%a%C%;!<%87A<0(B * Mail Folders:: $B$=$l$>$l$N%0%k!<%W$KBP$7$F0l$D$N%U%!%$%k(B $B$r;}$D(B * Comparing Mail Back Ends:: $BF@<:$N?<$$F6;!(B @@ -824,7 +825,7 @@ Browsing the Web * Expiring in IMAP:: nnimap $B$K$h$k%a!<%k$N4|8B@Z$l>C5n(B * Editing IMAP ACLs:: $B%a!<%k%\%C%/%9$X$NB>$NMxMQA06u4V$r;H$&(B($B;H$o$J$$(B)$BJ}K!(B Other Sources @@ -1276,9 +1277,9 @@ Gnus $B$O!"?.Mj$G$-$k%W%m%0%i%`$N0l$D$H$7$F!"%5!<%P!<$H@\B3$G$-$J$$$H$-$O(B $B%9%l!<%V$r5/F0$9$k$H$-$K$b$7%^%9%?!<$N(B @file{.newsrc*} $B%U%!%$%k72$,%;!<(B $B%V$5$l$F$$$J$+$C$?$i!"<+F0J]B8$5$l$?%U%!%$%k$rFI$`$+$I$&$+$r?R$M$i$l$k$+(B -$B$b$7$l$^$;$s!#(B"yes" $B$HEz$($k$H!"%^%9%?!<$K%;!<%V$5$l$F$$$J$$JQ99$O%9%l!<(B -$B%V$KH?1G$5$l$^$;$s!#(B"no" $B$HEz$($k$H!"%^%9%?!<$GFI$^$l$?$$$/$D$+$N5-;v$,!"(B -$B%9%l!<%V$G$OL$FI$G$"$k$H8+$J$5$l$k$+$b$7$l$^$;$s!#(B +$B$b$7$l$^$;$s!#(B``yes'' $B$HEz$($k$H!"%^%9%?!<$K%;!<%V$5$l$F$$$J$$JQ99$O%9%l!<(B +$B%V$KH?1G$5$l$^$;$s!#(B``no'' $B$HEz$($k$H!"%^%9%?!<$GFI$^$l$?$$$/$D$+$N5-;v(B +$B$,!"%9%l!<%V$G$OL$FI$G$"$k$H8+$J$5$l$k$+$b$7$l$^$;$s!#(B @node Fetching a Group @section $B%0%k!<%W$rA0$H!"(Bkiboze $B%0%k!<%W$K!V4^$ $BL$FI!"4{FI5-;v$NN>J}$rA4$FI=<($7$^$9!#(B @item an integer -$B$=$N%0%k!<%W$N:G8e$N@0?t8D$N5-;v$rI=<($7$^$9!#$3$l$O(B C-u $B@0?t(B $B$G$=$N%0%k!<(B -$B%W$KF~$k$N$HF1$8$G$9!#(B +$B$=$N%0%k!<%W$N:G8e$N(B @var{integer} $B8D$N5-;v$rI=<($7$^$9!#$3$l$O(B C-u +@var{integer} $B$G$=$N%0%k!<%W$KF~$k$N$HF1$8$G$9!#(B @item default $B=i4|@_Dj$G$NI=<(5-;v$rI=<($7$^$9!#$3$l$ODL>o$OL$FI5-;v$H0uIU$-5-;v$G$9!#(B @@ -3063,7 +3069,7 @@ form $B$N(B @code{nil} $B$O$=$3$GI>2A$5$l$^$9!#(B $B$G$-$^$9!#$G$b$$$/$D$+$N%Q%i%a!<%?!"Nc$($P(B @code{visible} $B$O8zNO$rH/4x$7(B $B$^$;$s!#Nc$G$9!#(B -@example +@lisp (setq gnus-parameters '(("mail\\..*" (gnus-show-threads nil) @@ -3082,7 +3088,7 @@ form $B$N(B @code{nil} $B$O$=$3$GI>2A$5$l$^$9!#(B ("list\\..*" (total-expire . t) (broken-reply-to . t)))) -@end example +@end lisp $BJ8;zNs$NCM$O!"(B@code{to-group} $B$NNc$,<($9$h$&$K!"@55,I=8=$K$h$kCV$-49$($r(B $Bl9g!"$3$N%3%^%s(B +$B%I$OI{%H%T%C%/$KBP$7$F:F5"E*$KF/$-$^$9!#(B @item T M-# @kindex T M-# ($B%H%T%C%/(B) @findex gnus-topic-unmark-topic $B8=:_$N%H%T%C%/$K$"$kA4$F$N%0%k!<%W$+$i%W%m%;%9%^!<%/$r>C$7$^(B -$B$9(B (@code{gnus-topic-unmark-topic})$B!#(B +$B$9(B (@code{gnus-topic-unmark-topic})$B!#@\F,<-$,M?$($i$l$J$$>l9g!"$3$N%3%^(B +$B%s%I$OI{%H%T%C%/$KBP$7$F:F5"E*$KF/$-$^$9!#(B @item C-c C-x @kindex C-c C-x ($B%H%T%C%/(B) @@ -4054,9 +4062,9 @@ Gnus $B$3$N4X?t$O!"$?$H$(%a!<%k%0%k!<%W$G;H$o$l$?$H$7$F$b!"@\(B -$B%;!<%V$5$l$^$9!#BP1~$9$k%P%C%/%(%s%I$,Ej9F$N$?$a$N%a%=%C%I(B (request-post -method) $B$r;}$C$F$$$J$1$l$P$J$j$^$;$s$,!#(B +$B%a!<%k%0%k!<%W$K(B ``$BEj9F(B'' $B$9$k$N$KJXMx$G$9(B; $B$=$l$i$OEv$N%0%k!<%W$KC1$KD>(B +$B@\%;!<%V$5$l$^$9!#BP1~$9$k%P%C%/%(%s%I$,Ej9F$N$?$a$N%a%=%C(B +$B%I(B (request-post method) $B$r;}$C$F$$$J$1$l$P$J$j$^$;$s$,!#(B @end table $B0J2<$O%0%k!<%W%P%C%U%!$N$?$a$NJQ?t$G$9(B: @@ -4710,8 +4718,9 @@ Gnus $B$OJQ?t(B @code{gnus-extract-address-components} $B$NCM$r(B @code{From @vindex nnmail-extra-headers $B4XO"$7$?JQ?t$O(B @code{nnmail-extra-headers} $B$G!"(Boverview (@sc{nov}) $B%U%!(B $B%$%k$K$$$DDI2C$N%X%C%@!<$r4^$a$k$+$r@)8f$7$^$9!#8E$$(B overview $B%U%!%$%k$,(B -$B$"$k>l9g$O!"$3$NJQ?t$rJQ99$7$?8e$K%5!<%P!<%P%C%U%!$K(B `^' $B$GF~$C$FE,@Z$J(B -$B%a!<%k%5!<%P!<(B ($BNc$($P(B nnml) $B$G(B `g' $B$r2!$7!":F@8@.$9$kI,MW$,$"$j$^$9!#(B +$B$"$k>l9g$O!"$3$NJQ?t$rJQ99$7$?8e$K%5!<%P!<%P%C%U%!$K(B @kbd{^} $B$GF~$C$FE,(B +$B@Z$J%a!<%k%5!<%P!<(B ($BNc$($P(B nnml) $B$G(B @kbd{g} $B$r2!$7!":F@8@.$9$kI,MW$,$"$j(B +$B$^$9!#(B @vindex gnus-summary-line-format gnus $B$K!"(B@code{gnus-summary-line-format} $BJQ?t$N(B @code{%n} $B;EMM(B @@ -4933,6 +4942,10 @@ Summary Buffer} $B$r;2>H$7$F2<$5$$!#(B $B8=:_$N5-;v$+!"$=$l$,4{$KFI$^$l$F$$$k>l9g$OH$7$F2<$5$$!#(B @kbd{SPACE} $B$O5-;v$r0l%Z!<%8@h$K%9%/%m!<%k$7$^$9!#5-;v$N:G8e$K$$$k>l9g$O(B $B$7$+L5$$>l9g!"$=$l$O%9%-%C%W$5$l!"Be$o$j$KH$7$F2<$5$$!#(B $B$3$N4X?t$O!"$?$H$(%a!<%k%0%k!<%W$G;H$o$l$?$H$7$F$b!"@\(B -$B%;!<%V$5$l$^$9!#BP1~$9$k%P%C%/%(%s%I$,Ej9F$N$?$a$N%a%=%C%I(B (request-post -method) $B$r;}$C$F$$$J$1$l$P$J$j$^$;$s$,!#(B +$B%a!<%k%0%k!<%W$K(B ``$BEj9F(B'' $B$9$k$N$KJXMx$G$9(B; $B$=$l$i$OEv$N%0%k!<%W$KC1$KD>(B +$B@\%;!<%V$5$l$^$9!#BP1~$9$k%P%C%/%(%s%I$,Ej9F$N$?$a$N%a%=%C(B +$B%I(B (request-post method) $B$r;}$C$F$$$J$1$l$P$J$j$^$;$s$,!#(B @item S D b @kindex S D b ($B35N,(B) @@ -6279,8 +6301,8 @@ Gnus $B$O=i4|@_Dj$G5-;v$r%9%l%C%I$K$7$^$9!#(B@dfn{$B%9%l%C%I$K$9$k(B} $B$H$ $B%I$K$9$kJ}K!(B * Filling In Threads:: $B%9%l%C%I$rKd$a$k(B * More Threading:: $B%9%l%C%I$r$$$8$/$k$5$i$KB?$/$NJQ?t(B -* Low-Level Threading:: $B$3$l$G=*$o$C$?$H;W$C$?$G$7$g$&(B... $B$G$b$"(B - $B$J$?$O4V0c$C$F$$$?(B! +* Low-Level Threading:: $B$3$l$G=*$o$C$?$H;W$C$?$G$7$g$&(B@dots{} $B$G(B + $B$b$"$J$?$O4V0c$C$F$$$?(B! @end menu @node Loose Threads @@ -6730,13 +6752,13 @@ gnus $B$OA4$F$N5-;v$N40A4$J(B @code{References} $BMs$r8+$F!"F1$8%9%l%C%I$KB0$ @vindex gnus-thread-operation-ignore-subject $B%9%l%C%I$r:n@.$9$k$H$-$KI=Bj$rL5;k$9$k$H!"<+A3$K%9%l%C%I$K$O$$$/$D$+$N0c$C(B $B$?I=Bj$,$"$k$3$H$K$J$j$^$9!#$=$l$+(B -$B$i(B `T k' (@code{gnus-summary-kill-thread}) $B$N$h$&$JL?Na$rH/$9$k$H$-$K!"(B -$BA4BN$N%9%l%C%I$r:o=|$9$k$N$G$O$J$/!"8=:_$N5-;v$HF1$8I=Bj$r;}$DItJ,$@$1$r(B -$B:o=|$7$?$$$H$-$,$"$k$+$b$7$l$^$;$s!#$b$7$3$NH/A[$,NI$$$H;W$&$N$G$"$l$P!"(B -@code{gnus-thread-operation-ignore-subject} $B$r$$$8$/$k$3$H$,$G$-$^$9!#$3(B -$B$l$,(B @code{nil} $B$G$J$$$H(B ($B$3$l$,%G%#%U%)%k%H$G$9$,(B)$B!"%9%l%C%I$NL?Na$rJ,$J5-;v$NMW5a$H!"M>J,$J@\B3$G!#(B -$B$O$$!"$3$l$GK\Ev$O$3$N$h$&$J$3$H$r$9$Y$-$GL5$$;v$,J,$+$C$?$G$7$g$&(B... $BK\(B -$BEv$K$=$&$7$?$$$H;W$o$J$$8B$j$O!#(B +$B$O$$!"$3$l$GK\Ev$O$3$N$h$&$J$3$H$r$9$Y$-$GL5$$;v$,J,$+$C$?$G$7$g(B +$B$&(B@dots{} $BK\Ev$K$=$&$7$?$$$H;W$o$J$$8B$j$O!#(B @vindex gnus-asynchronous $B$3$l$,J}K!$G$9(B: @code{gnus-asynchronous} $B$r(B @code{t} $B$K@_Dj$7$F$/$@$5$$!#(B @@ -7267,7 +7289,7 @@ MH $B%i%$%V%i%j!<$N(B @code{rcvstore} $B$rMQ$$$k;v$K$h$C$F5-;v$r(B MH $B%U% $BO"A[%j%9%H(B @code{gnus-split-methods} $B$K@55,I=8=$rJ|$j9~$`;v$K$h$C$F!"(B gnus $B$K5-;v$rJ]B8$9$k>l=j$rDs0F$9$k;v$,$G$-$^$9!#Nc$($P!"(Bgnus $B$K4XO"$7$?(B $B5-;v$r%U%!%$%k(B @file{gnus-stuff} $B$K!"(BVM $B$K4XO"$7$?5-;v(B -$B$r(B @code{vm-stuff} $BJ]B8$7$?$1$l$P!"$3$NJQ?t$r0J2<$N$h$&$K$9$k;v$,$G$-$^(B +$B$r(B @file{vm-stuff} $BJ]B8$7$?$1$l$P!"$3$NJQ?t$r0J2<$N$h$&$K$9$k;v$,$G$-$^(B $B$9(B: @lisp @@ -7530,7 +7552,7 @@ Gnus $B$O%U%!%$%k$r1\Mw$9$k$N$r7hDj$9$k$N$K(B@dfn{$B5,B'JQ?t(B}$B$rMQ$$$^$9 @vindex gnus-uu-user-view-rules @cindex sox $B$3$NJQ?t$O%U%!%$%k$r1\Mw$9$k$H$-$K:G=i$KD4$Y$i$l$^$9!#Nc$($P!"$b(B -$B$7(B @samp{.au} $B2;%U%!%$%k$rJQ49$9$k$?$a$K(B @code{sox} $B$r;H$$$?$$$H$-$O!"$NI|9fAuCV$,B8:_$7$J$$$+$i$G$9!#(B($B$(!<$H!";d$O$=$l$r$9(B $B$k0l$D$N%Q%C%1!<%8$r8+$?;v$,$"$j$^$9!=!=(B@code{gnus-uu} $B$G$9!#$7$+$7$J$<(B -$B$+!"$=$l$,?t$N$&$A$KF~$k$H$O;W$($J$$$N$G$9(B...) $B%G%#%U%)%k%H(B +$B$+!"$=$l$,?t$N$&$A$KF~$k$H$O;W$($J$$$N$G$9(B@dots{}) $B%G%#%U%)%k%H(B $B$O(B @code{nil} $B$G$9!#(B @item gnus-uu-post-separate-description @@ -7987,14 +8009,15 @@ Fonts})$B!#F1$8%a%C%;!<%8$NCf$KJ#?t$N5-;v$+$i$N0zMQ$,$"$k$H!"(Bgnus $B$O$=$l$ @item gnus-article-address-banner-alist @vindex gnus-article-address-banner-alist $B%a!<%k%"%I%l%9$H%P%J!<$NO"A[%j%9%H$G$9!#$=$l$>$l$NMWAG(B -$B$O(B @code{(ADDRESS . BANNER)} $B$N7A<0$r;}$A!"$3$3$G(B ADDRESS $B$O(B From $B%X%C%@!<(B -$B$K$"$k%a!<%k%"%I%l%9$K%^%C%A$9$k@55,I=8=!"(BBANNER $B$O%7%s%\(B -$B%k(B @code{signature}$B!"(B@code{gnus-article-banner-alist} $B$NMWAG!"@55,I=8=$^(B -$B$?$O(B @code{nil} $B$N$&$A$N0l$D$G$9!#(BADDRESS $B$,CxC$7$^$9!#Nc$($P!"Aw?.l9g!"0J2<(B -$B$NMWAG$G$=$l$i$r>C$9$3$H$,$G$-$^$9!#(B +$B$O(B @code{(@var{address} . @var{banner})} $B$N7A<0$r;}$A!"$3$3(B +$B$G(B @var{address} $B$O(B From $B%X%C%@!<$K$"$k%a!<%k%"%I%l%9$K%^%C%A$9$k@55,I=(B +$B8=!"(B@var{banner} $B$O%7%s%\%k(B @code{signature}$B!"(B +@code{gnus-article-banner-alist} $B$NMWAG!"@55,I=8=$^$?$O(B @code{nil} $B$N$&(B +$B$A$N0l$D$G$9!#(B@var{address} $B$,CxC$7$^$9!#Nc$($P!"Aw?.l9g!"0J2<$NMWAG$G$=$l$i$r>C$9$3$H$,$G$-$^(B +$B$9!#(B @lisp ("@@yoo-hoo\\.co\\.jp\\'" . "\n_+\nDo You Yoo-hoo!\\?\n.*\n.*\n") @@ -8092,6 +8115,12 @@ gnus $B$,5-;v$rI=<($9$k4{Dj$N$d$jJ}$rJQ$($?$$$H$-(B $B$3$l$O5-;v@vBu$G$O$J$/$F!"$=$N5U$G$9!#$3$l$r%?%$%W$9$k$H!"%G%#%9%/$d%5!<(B $B%P!<$K$"$k$,$^$^$N5-;v$,8+$($^$9!#(B +@item g +$B8=:_$N5-;v$N:FI=<($r6/@)$7$^$9(B (@code{gnus-summary-show-article})$B!#$3$l(B +$B$b$^$?K\Ev$N@vBu$G$O$"$j$^$;$s!#$3$l$r%?%$%W$9$k$H!"0JA0$KE,MQ$5$l$?BPOC(B +$BE*$J@vBu5!G=$O$4GK;;$K$5$l!"$9$Y$F$N%G%#%U%)%k%H$N07$$(B (treatments) $B$r'$($l$PNI$$$G$7$g$&!#$3$l$K$h$C$F35N,%P%C%U%!$G$N0J2<$NL?Na$,;H$($k$h(B -$B$&$K$J$j$^$9!#(B +$B$3$l$K$h$C$F35N,%P%C%U%!$G$N0J2<$NL?Na$,;H$($k$h$&$K$J$j$^$9!#(B @table @kbd @item C-c C-n h @@ -9975,6 +9999,12 @@ Gnus $B$O%X%C%@!<$NJB$YBX$((B (sort) $B$b9T$$$^$9(B ($B$3$l$O%G%#%U%)%k%H$G @item to-address @code{To} $BMs$,8=:_$N%0%k!<%W$N(B @code{to-address} $B%Q%i%a!<%?$HF1$8$b$N$7(B $B$+4^$s$G$$$J$$>l9g$K$O>C5n$7$^$9!#(B +@item to-list +@code{To} $BMs$,8=:_$N%0%k!<%W$N(B @code{to-list} $B%Q%i%a!<%?$HF1$8$b$N$7$+4^(B +$B$s$G$$$J$$>l9g$K$O>C5n$7$^$9!#(B +@item cc-list +@code{CC} $BMs$,8=:_$N%0%k!<%W$N(B @code{to-list} $B%Q%i%a!<%?$HF1$8$b$N$7$+4^(B +$B$s$G$$$J$$>l9g$K$O>C5n$7$^$9!#(B @item date $B$=$N5-;v$,2a5n;0F|0JFb$N$b$N$G$"$l$P!"(B@code{Date} $BMs$r>C5n$7$^$9!#(B @item long-to @@ -10047,8 +10077,8 @@ GNUS $B$d(B Gnus $B$G$O!"$3$N$?$A$N0-$$LdBj$G6C$+$5$l$J$$$h$&$K$9$k$K$O!"35N, @cindex article customization $B5-;v$,$I$N$h$&$KB8:_$7$F$$$k$+$r%+%9%?%^%$%:$9$k$?$a$N$?$/$5$s$N4X?t$G$9!#(B -$B$3$l$i$N4X?t$rBPOCE*$K8F$V$3$H$b$G$-$^$9$7!"5-;v$rA*Br$7$?$H$-$K<+F0E*(B -$B$KA*Br$9$k$3$H$b$G$-$^$9!#(B +$B$3$l$i$N4X?t$rBPOCE*$K8F$V$3$H$b$G$-$^$9$7(B (@pxref{Article Washing})$B!"5-(B +$B;v$rA*Br$7$?$H$-$K<+F0E*$KA*Br$9$k$3$H$b$G$-$^$9!#(B $B<+F0E*$K8F$P$l$k$h$&$K$9$k$?$a$K$O!"BP1~$9$k(B ``treatment'' $BJQ?t$r@_Dj$7(B $B$^$9!#Nc$($P!"%X%C%@!<$r1#$9$?$a$K$O!"(B@code{gnus-treat-hide-headers} $B$r(B @@ -10168,6 +10198,8 @@ GNUS $B$d(B Gnus $B$G$O!"$3$N$?$A$N0-$$LdBj$G6C$+$5$l$J$$$h$&$K$9$k$K$O!"35N, @item gnus-treat-hide-citation-maybe (t, integer) @item gnus-treat-hide-headers (head) @item gnus-treat-hide-signature (t, last) +@item gnus-treat-strip-banner (t, last) +@item gnus-treat-strip-list-identifiers (head) @xref{Article Hiding}. @@ -10211,12 +10243,14 @@ GNUS $B$d(B Gnus $B$G$O!"$3$N$?$A$N0-$$LdBj$G6C$+$5$l$J$$$h$&$K$9$k$K$O!"35N, @item SPACE @kindex SPACE ($B5-;v(B) @findex gnus-article-next-page -$B0lJGA0$K$a$/$j$^$9(B (@code{gnus-article-next-page})$B!#(B +$B0lJGA0$K$a$/$j$^$9(B (@code{gnus-article-next-page})$B!#(B@kbd{h SPACE h} $B$H$^$C(B +$B$?$/F1$8$G$9!#(B @item DEL @kindex DEL ($B5-;v(B) @findex gnus-article-prev-page -$B0lJG8e$m$KLa$7$^$9(B (@code{gnus-article-prev-page})$B!#(B +$B0lJG8e$m$KLa$7$^$9(B (@code{gnus-article-prev-page})$B!#(B@kbd{h DEL h} $B$H$^$C(B +$B$?$/F1$8$G$9!#(B @item C-c ^ @kindex C-c ^ ($B5-;v(B) @@ -10454,11 +10488,13 @@ Manual})$B!#IaDL$O!"(Bgnus $B$O9VFIMQ$HF1$8A*BrJ}K!$r;H$C$FEj9F$7$^$9(B ($B $B$5$F!"$3$N@_Dj$r$7$?8e$G%5!<%P!<$,$"$J$?$N5-;v$r5qH]$7$?$j!"%5!<%P!<$,Mn(B $B$A$F$$$?$j$7$?$i!"$I$&$7$?$i$h$$$N$G$7$g$&(B? $B$3$NJQ?t$r>e=q$-$9$k$?$a$K!"(B -$BL?Na(B @kbd{C-c C-c} $B$KNm$G$J$$@\F,0z?t$rM?$($k;v$G!"Ej9F$K!X8=:_$N!Y%5!<(B -$B%P!<$r;H$o$;$k;v!"$9$J$o$A%G%#%U%)%k%H$NF0:n$KLa$9;v$,$G$-$^$9!#(B +$BL?Na(B @kbd{C-c C-c} $B$K%<%m$G$J$$?t$N@\F,0z?t$rM?$($k;v$G!"Ej9F(B +$B$K(B ``current'' ($B8=:_$N(B) $B%5!<%P!<$r;H$o$;$k;v!"$9$J$o$A%G%#%U%)%k%H$NF0(B +$B:n(B ($BLuCm(B: @code{gnus-post-method} $B$N%G%#%U%)%k%HCM$O(B @code{current}) $B$K(B +$BLa$9;v$,$G$-$^$9!#(B -$B$b$7!"Nm@\F,0z?t$r$=$NL?Na$KM?$($?$J$i(B ($B$9$J$o$A!"(B@kbd{C-u 0 C-c C-c})$B!"(B -gnus $B$OEj9F$K$I$NJ}K!$r;H$&$+$r$"$J$?$K?R$M$^$9!#(B +$B$b$7!"%<%m$r@\F,0z?t$r$=$NL?Na$KM?$($?$J$i(B ($B$9$J$o$A!"(B@kbd{C-u 0 C-c +C-c})$B!"(Bgnus $B$OEj9F$K$I$NJ}K!$r;H$&$+$r$"$J$?$K?R$M$^$9!#(B @code{gnus-post-method} $B$rA*BrJ}K!$N%j%9%H$K$9$k;v$b$G$-$^$9!#$=$N>l9g$O!"(B gnus $B$O>o$KEj9F$K$I$NJ}K!$r;H$&$+$r$"$J$?$K?R$M$^$9!#(B @@ -10515,13 +10551,18 @@ ISP $B$,(B POP-before-SMTP $B$NG'>Z$rMW5a$7$F$$$k>l9g$KM-MQ$G$9!#4X(B $B$3$l$i$N%0%k!<%W$KEj9F$9$k;v$O(B (@kbd{a}) $B$=$l$G$b6lDK$r0z$-5/$3$9$G$7$g(B $B$&$1$I!#(B -@item gnus-version-expose-system -@vindex gnus-version-expose-system - -$B%G%#%U%)%k%H$G%7%9%F%`%?%$%W(B (@samp{i686-pc-linux} $B$N$h$&(B -$B$J(B @code{system-configuration} $BJQ?t$NCM(B) $B$,<+F0E*$K@8@.$5$l(B -$B$k(B User-Agent $B%X%C%@!<$K8=$l$^$9!#$=$l$O(B ($BC$9$3$H(B -$B$,K>$^$l$k$+$b$7$l$^$;$s!#$=$&$$$&>l9g$O!"$3$l$r(B @code{nil} $B$K$7$F2<$5$$!#(B +@item gnus-user-agent +@vindex gnus-user-agent +@cindex User-Agent + +($BLuCm(B: T-gnus $B$G$O8=:_$3$NJQ?t$K$h$k@)8f$O5!G=$7$^$;$s!#(B) $B$3$NJQ?t$O!"$I(B +$B$N>pJs$,(B User-Agent $B%X%C%@!<$KDDNs$5$l$k$+$r@)8f$7$^$9!#$=$l$OH(B)$B!#(B @end table $B$"$J$?$O<+J,$,Aw$k%a%C%;!<%8$NDV$j$rD4$Y$?$$$H;W$&$+$bCN$l$^$;$s!#$b$7$/(B @@ -11337,8 +11378,8 @@ Remove security related MML tags from message. $BJQ?t$rDj5A$9$k0l$D$N$d$C$+$$$JE@$O(B ($B%P%C%/%(%s%I$H(B Emacs $B0lHL$NN>J}$G(B)$B!"(B $BJQ?t$NDj5A$,%m!<%I$5$l$F$$$k4V$K!"$$$/$D$+$NJQ?t$OB>$NJQ?t$G=i4|2=$5(B -$B$l$k$H$$$&;v$G$9!#$b$7(B "$B4p$H$J$k(B" $BJQ?t$,%m!<%I$5$l$?8e$KJQ99$7$F$b!"(B"$BF3(B -$B$-=P$5$l$?(B" $BJQ?t$OJQ99$5$l$^$;$s!#(B +$B$l$k$H$$$&;v$G$9!#$b$7(B ``$B4p$H$J$k(B'' $BJQ?t$,%m!<%I$5$l$?8e$KJQ99$7$F$b!"(B +``$BF3$-=P$5$l$?(B'' $BJQ?t$OJQ99$5$l$^$;$s!#(B $B$3$l$OIaDL$O%G%#%l%/%H%j!<$d%U%!%$%k$NJQ?t$K1F6A$7$^$9!#Nc$($P!"(B @code{nnml-directory} $B$O%G%#%U%)%k%H$G(B @file{~/Mail} $B$G$9$,!"A4$F(B @@ -11746,10 +11787,8 @@ LIST $B%3%^%s%I$N%*%W%7%g%s$K;H$C$F!"(B($B%5!<%P!<$N(B) $B%j%9%H=PNO$r@_Dj$ @findex nntp-open-ssl-stream @item nntp-open-ssl-stream @dfn{$B0BA4$J(B} $B%A%c%s%M%k$r;H$C$F%5!<%P!<$K@\B3$7$^$9!#$3$l$r;H$&$?$a$K$O!"(B -OpenSSL (@uref{http://www.openssl.org}) $B$+(B SSLeay -(@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL} $B$H(B @file{ssl.el} ($BNc$((B -$B$P(B W3 $B$NG[I[$+$i(B) $B$,I,MW(B) $B$,%$%s%9%H!<%k$5$l$F$$$J$1$l$P$J$j$^$;$s!#$=$l(B -$B$+$i%5!<%P!<$rH$9$kJQ?t$K1F6A$5$l$^$9(B (@pxref{Common Variables})$B!#(B +$B$O(B ``via'' $B@\B3$NCg4V$KB0$7$F$$$k$H$b8@$($k$N$G!"$=$l$rL@3N$K$9$k$?$a$K(B +$B$9$Y$F(B ``via'' $B$H$$$&@\F,<-$,IU$1$i$l$^$9!#$^$?!"$=$l$i$NF0:n$O$=$l$i$,(B +$B6&DL$K;2>H$9$kJQ?t$K1F6A$5$l$^$9(B (@pxref{Common Variables})$B!#(B @table @code @item nntp-open-via-rlogin-and-telnet @@ -12074,9 +12113,9 @@ Gnus $B$r;H$C$F?7$7$$%a!<%k$rFI$`;v$OHs>o$K4JC1$G$9!#$"$J$?$N%a!<%k%P%C%/(B $B%(%s%I$N$"$J$?$NA*Br$r(B @code{gnus-secondary-select-methods} $B$KJ|$j9~$`$@(B $B$1$G!"$"$H$N$3$H$O<+F0E*$K5/$3$j$^$9!#(B -$BNc$($P!"(B@code{nnml} ($B$3$l$O(B "$B0l%a!<%k0l%U%!%$%k(B" $B%P%C%/%(%s%I$G$9(B) $B$r;H(B -$B$$$?$$$J$i!"o$K4JC1$G$9!#$"$J$?$N%a!<%k%P%C%/(B $B:#$d!"$N%0%k!<%W$HF1$8$h$&$KFI$`;v$,$G$-$^(B $B$9!#(B @@ -12138,10 +12177,10 @@ Gnus $B$r;H$C$F?7$7$$%a!<%k$rFI$`;v$OHs>o$K4JC1$G$9!#$"$J$?$N%a!<%k%P%C%/(B $B$$CM$r5"$9I,MW$,$"$j$^$9!#(B $B$3$l$i$N:G8e$O>o$KAm9gE*$J$b$N$G$"$k$Y$-$G!"B>$N@55,I=8=$K9gCW$7$J$$%a!<(B -$B%k$K9gCW$9$k$?$a$K!"$3$N@55,I=8=$O(B @emph{$B$$$D$b(B} @samp{}$B$G$"$k$Y$-$G$9!#(B +$B%k$K9gCW$9$k$?$a$K!"$3$N@55,I=8=$O(B @emph{$B$$$D$b(B} @samp{*}$B$G$"$k$Y$-$G$9!#(B ($B$3$l$i$NK!B'$OO"A[%j%9%H$N=i$a$+$i=*$o$j$^$G=gHV$K!$A$^(B -$B$9(B"$B!#Aj8_Ej9F$r;HMQ2DG=$K$7$F$$$k>l9g!"A4$F$N9gCW$7$?K!B'$,(B "$B>!$A$^$9(B"$B!#(B) +$B9F(B (crosspost) $B$r;HMQ2DG=$K$7$F$$$J$$8B$j!":G=i$N9gCW$7$?K!B'$,(B ``$B>!$A$^(B +$B$9(B''$B!#Aj8_Ej9F$r;HMQ2DG=$K$7$F$$$k>l9g!"A4$F$N9gCW$7$?K!B'$,(B ``$B>!$A$^$9(B''$B!#(B) $B$b$7$"$J$?<+?H$G$3$l$r$$$8$/$j$^$o$7$?$$$H$-$O!"$"$J$?$NA*$s$@4X?t$r$3$N(B $BJQ?t$K@_Dj$9$k;v$,$G$-$^$9!#$3$N4X?t$OF~$C$FMh$?%a!<%k%a%C%;!<%8$N%X%C%@!<(B @@ -12158,7 +12197,7 @@ Gnus $B$r;H$C$F?7$7$$%a!<%k$rFI$`;v$OHs>o$K4JC1$G$9!#$"$J$?$N%a!<%k%P%C%/(B $B%a!<%k%P%C%/%(%s%I$O$9$Y$FAj8_Ej9F$N5!G=$rDs6!$7$F$$$^$9!#$$$/$D$+$N@55,(B $BI=8=$,9gCW$9$k$H!"%a!<%k$OA4$F$N%0%k!<%W$K(B ``$BAj8_Ej9F(B'' $B$5$l$^$9!#(B @code{nnmail-crosspost} $B$O$3$N5!G=$r;H$&$+$I$&$+$r;XDj$7$^$9!#$I$N5-;v$b(B -$BAm9g$N(B (@samp{}) $B%0%k!<%W$KAj8_Ej9F$5$l$J$$;v$KCm0U$7$F$/$@$5$$!#(B +$BAm9g$N(B (@samp{*}) $B%0%k!<%W$KAj8_Ej9F$5$l$J$$;v$KCm0U$7$F$/$@$5$$!#(B @vindex nnmail-crosspost-link-function @cindex crosspost @@ -12261,6 +12300,10 @@ POP $B%a!<%k%5!<%P!A0$G$9!#=i4|CM$O(B @code{MAIL} $B4D6-JQ?t$NCM(B $B$+(B @code{rmail-spool-directory} $B$NCM(B ($BIaDL(B $B$O(B @file{usr-mail/spool/user-name} $B$N$h$&$J$b$N(B) $B$G$9!#(B + +@item :prescript +@itemx :postscript +$B%a!<%k$rA0$G$9!#=i4|CM$O4D6-JQ(B -$B?t(B @code{MAILDIR} $B$+$iA0!#(B @item l -`imap-default-user' $B$G@_Dj$5$l$?%f!<%6L>!#(B +@code{imap-default-user} $B$G@_Dj$5$l$?%f!<%6L>!#(B @item p $B%5!<%P!<$N%]!<%HHV9f!#(B @@ -12688,7 +12731,18 @@ UNDELETED} $B$O$*$=$i$/$?$$$F$$$N?M$K$O:GNI$NA*Br$G$7$g$&$,!"$H$-$I(B @item mail-source-delete-incoming @vindex mail-source-delete-incoming @code{nil} $B$G$J$1$l$P!"F~$C$FMh$?%U%!%$%k$O!"$=$l$r=hM}$7$?8e$K>C5n$5$l(B -$B$^$9!#(B +$B$^$9!#(B@code{t} $B$G$O%U%!%$%k$r$?$@$A$K>C5n$7!"(B@code{nil} $B$G$O$$$+$J$k%U%!(B +$B%$%k$b>C$7$^$;$s!#@5$N?t$@$C$?>l9g$O!"$=$NF|?t0J>e$K8E$$%U%!%$%k$r>C5n$7(B +$B$^$9(B ($B$3$l$O?7Ce%a!<%k$rC5n$9$k$H$-$K3NG'$r5a$a$^$9!#$3$NJQ?t(B +$B$O(B @code{mail-source-delete-incoming} $B$,@5$N?t$G$"$k>l9g$@$1;H$o$l$^$9!#(B @item mail-source-ignore-errors @vindex mail-source-ignore-errors @@ -13574,10 +13628,7 @@ Gnus $B$O%a!<%k%0%k!<%W$rF0:n$9$k$h$&$K$9$k$H%a!<%k%9%W!<%k$rFI$_9~$_$^$9!#(B $BI8=`$N(B gnus $B$G$OO;$D$N0c$C$?%a!<%k%P%C%/%(%s%I$,$"$j!"8DJL$K$5$i$J$k%P%C(B $B%/%(%s%I$r;HMQ2DG=$G$9!#$[$H$s$I$N?M$,;H$&%a!<%k%P%C%/%(%s%I$O(B ($B$=$l$,$?(B -$B$V$s:GB.$@$+$i(B) @code{nnml} $B$G$9(B (@pxref{Mail Spool})$B!#$"$J$?$O0J2<$K8^(B -$B$D$N%P%C%/%(%s%I$7$+$J$$$3$H$K5$$,IU$/$G$7$g$&(B; @code{nnmaildir} $B$NJ88%(B -$B$O$^$@$3$N%^%K%e%"%k$K40A4$KJTF~$5$l$F$$$J$$$N$G$9!#$=$l$^$G(B -$B$O(B @uref{http://multivac.cwru.edu./nnmaildir/} $B$G8+$D$1$k$3$H$,$G$-$^$9!#(B +$B$V$s:GB.$@$+$i(B) @code{nnml} $B$G$9(B (@pxref{Mail Spool})$B!#(B @menu * Unix Mail Box:: ($B$H$F$b(B) $BI8=`E*$J(B Un*x mbox $B$r;H$&(B @@ -13585,6 +13636,7 @@ Gnus $B$O%a!<%k%0%k!<%W$rF0:n$9$k$h$&$K$9$k$H%a!<%k%9%W!<%k$rFI$_9~$_$^$9!#(B $B%^%C%H$r;H$&(B * Mail Spool:: $B$"$J$?$N%a!<%k$r;dE*$J%9%W!<%k$KN/$a$k(B? * MH Spool:: mhspool $B$N$h$&$J%P%C%/%(%s%I(B +* Maildir:: $B$b$&0l$D$N#1%U%!%$%k(B/$B#1%a%C%;!<%87A<0(B * Mail Folders:: $B$=$l$>$l$N%0%k!<%W$KBP$7$F0l$D$N%U%!%$%k(B $B$r;}$D(B * Comparing Mail Back Ends:: $BF@<:$N?<$$F6;!(B @@ -13702,17 +13754,17 @@ rmail box $B$N$?$a$N%"%/%F%#%V%U%!%$%k$NL>A0!#4{DjCM(B @item nnml-directory @vindex nnml-directory $BA4$F$N(B @code{nnml} $B%G%#%l%/%H%j!<$O$3$N%G%#%l%/%H%j!<$N2<$KCV$+$l$^$9!#(B -$B4{DjCM$O(B `message-directory' $B$NCM(B ($B$=$N4{DjCM$O(B @file{~/Mail}) $B$G$9!#(B +$B4{DjCM$O(B @code{message-directory} $B$NCM(B ($B$=$N4{DjCM$O(B @file{~/Mail}) $B$G$9!#(B @item nnml-active-file @vindex nnml-active-file @code{nnml} $B%5!<%P!<$N$?$a$N%"%/%F%#%V%U%!%$%k!#4{DjCM(B -$B$O(B @file{~/Mail/active"} $B$G$9!#(B +$B$O(B @file{~/Mail/active} $B$G$9!#(B @item nnml-newsgroups-file @vindex nnml-newgroups-file @code{nnml} $B%0%k!<%W5-=R%U%!%$%k!#(B@xref{Newsgroups File Format}$B!#4{DjCM(B -$B$O(B @file{~/Mail/newsgroups"} $B$G$9!#(B +$B$O(B @file{~/Mail/newsgroups} $B$G$9!#(B @item nnml-get-new-mail @vindex nnml-get-new-mail @@ -13789,6 +13841,227 @@ rmail box $B$N$?$a$N%"%/%F%#%V%U%!%$%k$NL>A0!#4{DjCM(B $B$kI,MW$O$"$j$^$;$s!#4{DjCM$O(B @code{nil} $B$G$9!#(B @end table +@node Maildir +@subsubsection Maildir +@cindex nnmaildir +@cindex maildir + +@code{nnmaildir} $B$O(B Gnus $B$N%0%k!<%W$KBP1~$7$?3F!9(B +$B$N(B maildir $B$K(B maildir $B%U%)!<%^%C%H$G%a!<%k$r3JG<$7$^$9!#$3$N%U%)!<%^%C(B +$B%H$O(B @uref{http://cr.yp.to/proto/maildir.html} $B$*$h(B +$B$S(B @uref{http://www.qmail.org/man/man5/maildir.html} $B$GJ8=q2=$5$l$F$$$^(B +$B$9!#$^$?(B nnmaildir $B$O(B maildir $B$NCf$N(B @file{.nnmaildir/} $B%G%#%l%/%H%j$KFC(B +$BJL$J>pJs$r3JG<$7$^$9!#(B + +Maildir $B%U%)!<%^%C%H$O%m%C%/$rI,MW$H$7$J$$F1;~G[Aw$H9VFI$r2DG=$K$9$k$?$a(B +$B$K@_7W$5$l$^$7$?!#B>$N%P%C%/%(%s%I$G$O!"%a!<%k$r2?$i$+$N%9%W!<%k$KEO$7$F(B +$B$=$N%9%W!<%k$+$i%0%k!<%W$KJ,3d$9$k$?$a$K(B Gnus $B$r@_Dj$7$J$1$l$P$J$i$J$$$G(B +$B$7$g$&!#$=$l$O:#$^$GDL$j(B nnmaildir $B$G9T$J$&$3$H$,$G$-$^$9$,!"$b$C$H0lHL(B +$BE*$J@_Dj$O(B Gnus $B$N%0%k!<%W$H$7$F8=$o$l$k(B maildir $B$K%a!<%k$rD>@\G[Aw$9$k(B +$B$3$H$G$9!#(B + +nnmaildir $B$O40A4$K?.Mj$G$-$k$3$H$rL\;X$7$F$$$^$9(B: @kbd{C-g} $B$O%a%b%j!$l$N(B maildir $B$K3JG<$7$^$9!#$=$l(B +$B$K$h$C$F!"$"$k(B Gnus $B$N4D6-$+$iJL$N>l=j$K(B maildir $BA4BN$r%3%T!<$9$k$3$H$,(B +$B$G$-!"0u$OJ]B8$5$l$^$9!#(B + +$B2>A[%5!<%P!<$N@_Dj(B: + +@table @code +@item directory +$B$=$l$>$l$N(B nnmaildir $B%5!<%P!<(B ($B0l$D$r1[$($k%5!<%P!<$,I,MW$@$H$O$H$F$b;W(B +$B$($^$;$s$,(B) $B$KBP$7$F!"%G%#%l%/%H%j$r:n$C$F(B maildir $B$X$N%7%s%\%j%C%/%j%s(B +$B%/$rD%$kI,MW$,$"$j$^$9(B ($BB>$NL\E*$N$?$a$K$9$G$K;H$o$l$F$$$k%G%#%l%/%H%j$r(B +$BA*$s$G$O$$$1$^$;$s(B)$B!#%5!<%P!<$N%G%#%l%/%H%j$KD>@\(B ($B%7%s%\%j%C%/%j%s%/$N(B +$BBe$o$j$K(B) nnmaildir $B$rCV$/$3$H$b$G$-$k$N$G$9$,!"$=$l(B +$B$O(B @code{nnmaildir-request-delete-group} $B$rGKC>$5$;!"(BGnus $B$G$=$l$i$N%0%k!<(B +$B%W$r>C$9$3$H$,$G$-$J$/$J$C$F$7$^$$$^$9(B ($B$=$l$i$r(B shell $B$+$i(B @code{rm -r +foo} $B$G>C$9$3$H$O$G$-$^$9(B)$B!#$=$l$>$l$N(B maildir $B$O!"$=$N%5!<%P!<$N%K%e!<(B +$B%9%0%k!<%W$H$7$F(B Gnus $B$K8=$l!"%7%s%\%j%C%/%j%s%/$N%U%!%$%kL>$,$=$N%0%k!<(B +$B%W$NL>A0$K$J$j$^$9!#%G%#%l%/%H%j$K$"$k(B `.' $B$G;O$^$k$I$s$J%U%!%$%kL>$bL5(B +$B;k$5$l$^$9!#%G%#%l%/%H%j$O:G=i$K(B Gnus $B$r5/F0$7$?$H$-$H%0%k!<%W%P%C%U%!(B +$B$G(B @kbd{g} $B$r%?%$%W$7$?$H$-$O$$$D$G$bAv::$5$l!"$I$l$+$N(B maildir $B$,:o=|$^(B +$B$?$ODI2C$5$l$?$H$-$KDLCN$7$^$9!#(B + +@code{directory} $B%Q%i%a!<%?$NCM$O(B Lisp $B<0$G$J$1$l$P$J$j$^$;$s!#(B +@code{eval} $B$G=hM}$5$l$?8e$G!"(B@code{expand-file-name} $B$K$h$C$F$3$N%5!<%P!<(B +$B$N$?$a$N%G%#%l%/%H%j$N%Q%9$r3MF@$7$^$9!#$=$N7k2LF@$i$l$?J8;zNs$,!"%5!<%P!<(B +$B$,JD$8$i$l$k$^$G;H$o$l$^$9(B ($B$b$7!"<0$d(B @code{eval} $B$rCN$i$J$/$G$b?4G[$4(B +$BL5MQ(B; $BC1$J$kJ8;zNs$GF0:n$7$^$9(B)$B!#$3$N%Q%i%a!<%?$OG$0U$G$O$J$/!"@_Dj$7$J(B +$B$1$l$P$J$j$^$;$s!#(B@file{~/Mail} $B$d%5%V%G%#%l%/%H%j$r;H$&$3$H$O?d>)$G$-$^(B +$B$;$s!#$$$/$D$+$N(B Gnus $B$NB>$NItJ,$,$=$l$r%G%#%U%)%k%H$G$$$m$s$J$b$N$K;H$&(B +$B$N$G!"(Bnnmaildir $B$G$b$=$l$r;H$&$H:.Mp$9$k$+$b$7$l$^$;$s!#(B +@file{~/.nnmaildir} $B$,0lHLE*$JCM$G$9!#(B + +@item create-directory +$B$3$l$O(B Lisp $B<0$G$J$1$l$P$J$j$^$;$s!#(B@code{eval} $B$G=hM}$5$l$?8e$G!"(B +@code{expand-file-name} $B$K$h$C$F?7$7$$(B maildir $B$,@8@.$5$l$k%G%#%l%/%H%j(B +$B$NL>A0$r3MF@$7$^$9!#<0$O%5!<%P!<$,3+DL$7$?$H$-$@$1I>2A$5$l!"$=$N7k2LF@$i(B +$B$l$?J8;zNs$,!"%5!<%P!<$,JD$8$i$l$k$^$G;H$o$l$^$9!#$3$N%Q%i%a!<%?$OG$0U$G(B +$B$9$,!"$=$l$rM?$($J$$$H(B Gnus $B$G?7$7$$%0%k!<%W$r:n$k$3$H$,$G$-$^$;$s(B ($B$=$l(B +$B$i$r(B shell $B$+$i(B @code{mkdir -m 0700 foo foo/tmp foo/new foo/cur} $B$G:n$k(B +$B$3$H$O$G$-$^$9(B)$B!#AjBPE*$J%Q%9$O(B @code{directory} $B%Q%9$X$NAjBPCM$G$"$k$b(B +$B$N$H2rC5n$,GKC>$7$F$7$^$$$^$9(B ($B$=$l$i$N5!(B +$BG=$,MW$i$J$$$N$G$"$l$P!"(B@code{create-directory} $B$r40`z$K>JN,$7$F$b9=$$$^(B +$B$;$s(B)$B!#(B + +@item directory-files +$B$3$l$O(B @code{directory-files} $B$HF1$8%$%s%?!<%U%'!<%9$N4X(B +$B?t(B ($B$^$?$O(B @code{directory-files} $B$=$N$b$N(B) $B$G$J$1$l$P$J$j$^$;$s!#$3$l(B +$B$O(B maildir $BMQ$N%5!<%P!<$N(B @code{directory} $B$rAv::$9$k$?$a$K;H$o$l$^$9!#(B +$B$3$N%Q%i%a!<%?$OG$0U$G$9!#%G%#%U%)%k%HCM$O!"(B +@code{nnheader-directory-files-is-safe} $B$,(B @code{nil} $B$@$C$?(B +$B$i(B @code{nnheader-directory-files-safe} $B$G!"$=$l0J30$N>l9g(B +$B$O(B @code{directory-files} $B$G(B +$B$9(B (@code{nnheader-directory-files-is-safe} $B$O%5!<%P!<$,3+DL$7$?$H$-$K0l(B +$B2s$@$18!::$5$l$^$9$,!"%G%#%l%/%H%j$,Av::$5$l$k$H$-$KKh2s%A%'%C%/$5$;$?$$(B +$B$N$J$i$P!"$=$l$r9T$J$&4X?t$r$"$J$?$,<+A0$GMQ0U$9$kI,MW$,$"$j$^$9(B)$B!#(B + +@item get-new-mail +$BHs(B-@code{nil} $B$K$7$F$*$/$H!"$$$D$b$NDL$j$K%0%k!<%W$N(B maildir $B<+BN$K$*$$(B +$B$F?7Ce%a!<%k$rAv::$7$?8e$G!"$3$N%5!<%P!<(B +$B$O(B @code{nnmail-split-methods} $B$+(B @code{nnmail-split-fancy} $B$K$h(B +$B$k(B @code{mail-sources} $B$+$i!"=>Mh$N(B Gnus $B$NJ}K!$G%a!<%k$rJ}$GF1$8(B maildir $B$r;H$C$F(B +$B$O(B @emph{$B$$$1$^$;$s(B}$B!#$=$N7k2L$O1?NI$/M-1W$K$J$k$+$b$7$l$^$;$s$,!"$=$s$J(B +$B0U?^$G$O@_7W$5$l$F$$$^$;$s!#>-Mh$O0c$&7k2L$r$b$?$i$92DG=@-$,$"$j$^$9!#$"(B +$B$J$?$NJ,3d5,B'$,?7$7$$%0%k!<%W$r:n$k$h$&$K$J$C$F$$$k>l9g$O!"(B +@code{create-directory} $B%5!<%P!<%Q%i%a!<%?$rM?$($k$3$H$rK:$l$J$$$G2<$5$$!#(B +@end table + +@subsubsection $B%0%k!<%W%Q%i%a!<%?(B + +nnmaildir $B$O$$$/$D$+$N%0%k!<%W%Q%i%a!<%?$r;H$$$^$9!#$3$l$i$N$9$Y$F$rL5;k(B +$B$7$F$b0BA4$G$9!#%G%#%U%)%k%H$N(B nnmaildir $B$NF0:n$O!"B>$N%a!<%k%P%C%/%(%s(B +$B%I$N%G%#%U%)%k%H(B ($B5-;v$,0l=54V8e$K>C5n$5$l$k!"$J$I(B) $B$HF1$8$G$9!#4|8B@Z$l(B +$B>C5n$N%Q%i%a!<%?$r=|$$$F!"$3$N5!G=$O$9$Y$F(B nnmaildir $B$KFCM-$G$9!#$7$?$,$C(B +$B$F!"JL$N%P%C%/%(%s%I$G$9$G$K9T$C$F$$$kF0:n$rC1$KF'=1$5$;$h$&$H$$$&$N$G$"(B +$B$l$P!"$3$l$rL5;k$9$k$3$H$,$G$-$^$9!#(B + +$B$3$l$i$N%Q%i%a!<%?$N$&$A$N$I$l$G$b!"$=$NCM$,%Y%/%H%k$G$"$k>l9g$O!"%*%j%8(B +$B%J%k$NCM$KBe$o$C$F!"Bh0l$NMWAG$,(B Lisp $B<0$H$7$FI>2A$5$l$?7k2L$,;H$o$l$^$9!#(B +$BCM$,%Y%/%H%k$G$J$$>l9g$O!"$=$NCM$=$N$b$N$,(B Lisp $B<0$H$7$FI>2A$5$l$^$9!#(B +($B$=$N$?$a!"$3$l$i$N%Q%i%a!<%?$OB>$H$O0c$&L>A0!"0c$&$1$l$I$b;w$?0UL#$r;}(B +$B$DB>$N%P%C%/%(%s%I$G%5%]!<%H$5$l$F$$$kF1MM$N%Q%i%a!<%?!"$r;H$$$^$9!#(B) +($B?t!"J8;zNs!"(B@code{nil}$B!"$*$h$S(B @code{t} $B$K$D$$$F$O!"(B@code{eval} $B$N4XM?(B +$B$r:F$SL5;k$9$k$3$H$,$G$-$^$9!#B>$NCM$K$D$$$F!"$=$l$,E,@Z$J>l9g$K$O!"M>J,(B +$B$J%/%*!<%H$r;H$$!"$+$D%Y%/%H%k$GCM$rJq$`$3$H$rK:$l$J$$$G2<$5$$!#(B) + +@table @code +@item expire-age +$B5-;v$,>C5n$5$l$k$^$G$NC5n$5$l$F$O$J$i$J$$$3$H$r;XDj$7$^$9!#$3$N%Q%i%a!<%?$,@_Dj(B +$B$5$l$F$$$J$$$H!"$$$D$b$N(B @code{nnmail-expiry-wait}(@code{-function}) $BJQ(B +$B?t(B (@code{expiry-wait}(@code{-function}) $B%0%k!<%W%Q%i%a!<%?$G>e=q$-$5$l(B +$B$k(B) $B$r:G8e$N$h$j$I$3$m$K$7$^$9!#(B3$BF|$NCM$,M_$7$$$J$i$P!"(B@code{[(* 3 24 60 +60)]} $B$N$h$&$J$b$N$r;H$C$F2<$5$$!#(Bnnmaildir $B$O<0$rI>2A$7$F!"$=$N7k2L$r;H(B +$B$$$^$9!#5-;v$No$3$l(B +$B$O5-;v$,G[Aw$5$l$?;~9o$HF1$8$G$9$,!"5-;v$NJT=8$O$=$l$rC5n0J30$N(B) $B5-;v$N0\F0$b$^$?!"5-;v$r(B) $B$G!"$+$D$=$N%Q%i%a!<%?$,F1$8L>A0$N%0%k!<%W$KB0(B +$B$5$J$$>l9g!"4|8B@Z$l>C5n$,9T$J$o$l$k:]$K!"5-;v$O>C5n$5$l$kA0$K;XDj$5$l$?(B +$B%0%k!<%W$K0\F0$5$;$i$l$^$9!#(B@emph{$B$3$l$,(B nnmaildir $B%0%k!<%W$K@_Dj$5$l$k(B +$B$H!"0\F0@h$N%0%k!<%W$K$*$$$F!"5-;v$,85$N%0%k!<%W$K$"$C$?$H$-$H$A$g$&$IF1(B +$B$8$@$18E$/$J$j$^$9!#(B} $B$7$?$,$C$F!"0\F0@h$N%0%k!<%W$K$*$1(B +$B$k(B @code{expire-age} $B$K$OCm0U$7$F2<$5$$!#(B + +@item read-only +$B$3$l$,(B @code{t} $B$K@_Dj$5$l$F$$$k$H!"(Bnnmaildir $B$O$=$N5-;v$r$3$N%0%k!<%W$G(B +$BFI$_=P$7@lMQ$H$7$F07$$$^$9!#$3$N0UL#$O!"5-;v$O(B @file{new/} $B$+(B +$B$i(B @file{cur/} $B$K2~L>$5$l$J$$!"5-;v$O(B @file{cur/} $B$G$O$J(B +$B$/(B @file{new/} $B$G$N$_8+$D$+$k!"5-;v$O>C5n$5$l$J$$!"5-;v$OJT=8$G$-$J$$!"(B +$B$H$$$&$3$H$G$9!#(B@file{new/} $B$OB>$N(B maildir $B$N(B @file{new/} $B%G%#%l%/%H%j!"(B +$BNc$($P$_$s$J$,6=L#$,$"$k%a!<%j%s%0%j%9%H$r4^$s$G$$$k%7%9%F%`$G6&DL$N%a!<(B +$B%k%\%C%/%9!"$X$N%7%s%\%j%C%/%j%s%/$G$"$k$HA[Dj$5$l$^$9!#(B@file{new/} $B0J30(B +$B$N(B maildir $B$K$"$k$9$Y$F$N$b$N$O!"FI$_=P$7@lMQ$H$7$F07$o$l(B @emph{$B$^$;$s(B}$B!#(B +$B$7$?$,$C$F6&M-$N%a!<%k%\%C%/%9$KBP$7$F$O!"$"$J$?<+?H$N(B maildir $B$r@_Dj$9(B +$B$k(B ($B$^$?$O(B $B6&M-$N%a!<%k%\%C%/%9$K=q$-9~$_8"8B$r;}$D(B) $BI,MW$,0MA3$H$7$F$"(B +$B$j$^$9!#$"$J$?$N(B maildir $B$O5-;v$NM>J,$J%3%T!<$r$^$C$?$/4^$^$J$$$G$7$g$&!#(B + +@item directory-files +@code{directory-files} $B$HF1$8%$%s%?!<%U%'!<%9$N4X?t$G$9!#5-;v$r8+$D$1$k(B +$B$?$a$K!"$3$N%0%k!<%W$KBP1~$9$k(B maildir $B$N%G%#%l%/%H%j$rAv::$9$k$?$a$K;H(B +$B$o$l$^$9!#%G%#%U%)%k%H$O%5!<%P!<$N(B @code{directory-files} $B%Q%i%a!<%?$G@_(B +$BDj$5$l$F$$$k4X?t$G$9!#(B + +@item always-marks +@code{['(read expire)]} $B$N$h$&$J0u%7%s%\%k$N%j%9%H$G$9!#(BGnus $B$,5-;v$N0u(B +$B$r(B nnmaildir $B$K?R$M$k$H$-$O$$$D$G$b!"%U%!%$%k%7%9%F%`$K3JG<$5$l$F$$$k0u(B +$B$,2?$G$"$k$+$H$OL54X78$K!"(Bnnmaildir $B$O$9$Y$F$N5-;v$,$3$l$i$N0u$r;}$C$F$$(B +$B$k$HEz$($^$9!#$3$l$O9=A[$r;n$9$?$a$N5!G=$G!"$*$=$i$/7k6I$O:o=|$5$l$k$G$7$g(B +$B$&!#$=$l$O(B Gnus $BK\BN$G9T$o$l$k$+!"$"$k$$$OM-1W$G$J$1$l$PJ|4~$5$l$k$Y$-$G(B +$B$9!#(B + +@item never-marks +@code{['(tick expire)]} $B$N$h$&$J0u%7%s%\%k$N%j%9%H$G$9!#(BGnus $B$,5-;v$N0u(B +$B$r(B nnmaildir $B$K?R$M$k$H$-$O$$$D$G$b!"%U%!%$%k%7%9%F%`$K3JG<$5$l$F$$$k0u(B +$B$,2?$G$"$k$+$H$OL54X78$K!"(Bnnmaildir $B$O$3$l$i$N0u$r;}$C$F$$$k5-;v$OL5$$$H(B +$BEz$($^$9!#(B@code{never-marks} $B$O(B @code{always-marks} $B$r>e=q$-$7$^$9!#$3$l(B +$B$O9=A[$r;n$9$?$a$N5!G=$G!"$*$=$i$/7k6I$O:o=|$5$l$k$G$7$g$&!#$=$l$O(B Gnus +$BK\BN$G9T$o$l$k$+!"$"$k$$$OM-1W$G$J$1$l$PJ|4~$5$l$k$Y$-$G$9!#(B + +@item nov-cache-size +NOV $B%a%b%j!<%-%c%C%7%e$N%5%$%:$r;XDj$9$k@0?t$G$9!#%9%T!<%I%"%C%W$N$?$a$K!"(B +nnmaildir $B$O$=$l$>$l$N%0%k!<%W$N8BDj$5$l$??t$N5-;v$KBP$7$F!"%a%b%j!<>e(B +$B$K(B NOV $B%G!<%?$rJ];}$7$^$9!#(B($B$3$l$O$?$V$sM-MQ$G$O$J$/!">-Mh$O$*$=$i$/:o=|(B +$B$5$l$k$G$7$g$&(B)$B!#$3$N%Q%i%a!<%?$NCM$O!"%5!<%P!<$,3+DL$7$?8e$G:G=i$K%0%k!<(B +$B%W$,8+$i$l$?$H$-!"$9$J$o$A0lHL$K$O:G=i$K(B Gnus $B$r5/F0$7$?$H$-!"$@$1CmL\$5(B +$B$l$^$9!#%5!<%P!<$,JD$8$i$l$F:F$S3+DL$5$l$k$^$G$O!"(BNOV $B%-%c%C%7%e$N%5%$%:(B +$B$OJQ99$5$l$^$;$s!#%G%#%U%)%k%H$O35N,%P%C%U%!$KI=<($5$l$k5-;v$N?t$N8+@Q(B +$B$j(B (@code{tick} $B0u$,$"$C$F(B @code{read} $B$,L5$$5-;v$N?t$K>/!9$NM>J,$r2C$((B +$B$?$b$N(B) $B$G$9!#(B +@end table + +@subsubsection $B5-;v$N<1JL(B +$B5-;v$O$=$l$>$l$N(B maildir $B$N(B @file{cur/} $B%G%#%l%/%H%j$K3JG<$5$l$^$9!#3F!9(B +$B$N5-;v$K$O(B @code{uniq:info} $B$N$h$&$JL>A0$,IU$1$i$l$^$9!#$3$3(B +$B$G(B @code{uniq} $B$O%3%m%s$r4^$_$^$;$s!#(Bnnmaildir $B$O(B @code{:info} $B$NItJ,$r(B +$BJ];}$7$^$9$,L5;k$7$^$9!#(B($BB>$N(B maildir $B%j!<%@!<$O0lHL$K0u$r3JG<$9$k$?$a$K(B +$B$3$NItJ,$r;H$$$^$9!#(B) @code{uniq} $B$NItJ,$O5-;v$r%f%K!<%/$K<1JL$7!"(B +maildir $B$N(B @file{.nnmaildir/} $B%5%V%G%#%l%/%H%j$N?'!9$J>l=j$K5-;v$K4XO"$7(B +$B$?>pJs$r3JG<$9$k$?$a$K;H$o$l$^$9!#35N,%P%C%U%!$G5-;v$rMW5a$7$?8e$G!"5-;v(B +$B$N40A4$J%Q%9L>$,(B @code{nnmaildir-article-file-name} $BJQ?t$+$iF@$i$l$^$9!#(B + +@subsubsection NOV $B%G!<%?(B +@code{uniq} $B$K$h$C$F<1JL$5$l$k5-;v$O!"$=$N(B NOV $B%G!<%?(B ($B35N,%P%C%U%!$N9T(B +$B$r@8@.$9$k$?$a$K;H$o$l$k(B) $B$r(B @code{.nnmaildir/nov/uniq} $B$K3JG<$7$^$9!#(B +@code{nnmaildir-generate-nov-databases} $B4X?t$O$"$j$^$;$s!#(B($B$=$NI,MW$O$"(B +$B$^$j$"$j$^$;$s!#5-;v$N(B NOV $B%G!<%?$O5-;v$+(B @code{nnmail-extra-headers} $B$,(B +$BJQ2=$7$?$H$-$K<+F0E*$K99?7$5$l$^$9!#(B) $BBP1~$9$k(B NOV $B%U%!%$%k$r$?$@>C$9$3(B +$B$H$K$h$C$FC10l$N5-;v$N(B NOV $B%G!<%?$N@8@.$r(B nnmaildir $B$K6/@)$9$k$3$H$O$G$-(B +$B$^$9!#$7$+$7(B @emph{$B$4MQ?4(B}$B!#$3$l$O(B nnmaildir $B$,$3$N5-;v$K?7$7$$5-;vHV9f(B +$B$r3d$j?6$i$;!"(B@code{seen} $B0u!"%(!<%8%'%s%H!"$*$h$S%-%c%C%7%e$K$H$C$FLLE](B +$B$J$3$H$K$J$j$^$9!#(B + +@subsubsection $B5-;v$N0u(B +@file{.nnmaildir/marks/flag/uniq} $B%U%!%$%k$,$"$k>l9g$K!"(B@code{uniq} $B$K$h$C(B +$B$F<1JL$5$l$k5-;v$O!"(B@code{flag} $B0u$r;}$D$b$N$H9M$($i$l$^$9!#(B +Gnus $B$,(B nnmaildir $B$K%0%k!<%W$N0u$r?R$M$k$H!"(Bnnmaildir $B$O$=$N$h$&$J%U%!%$(B +$B%k$rC5$7$F!"8+$D$1$?0u$N%;%C%H$rJs9p$7$^$9!#(BGnus $B$,(B nnmaildir $B$K0u$N%;%C(B +$B%H$N3JG<$rMW5a$9$k$H!"(Bnnmaildir $B$OI,MW$JBP1~$9$k%U%!%$%k$r@8@.$7!"$^$?$O(B +$B>C5n$7$^$9!#(B($B$l$N0u$N$?$a$K?7$7$$%U%!%$%k$r:n$k$N$G$O$J$/!"(B +i$B%N!<%I(B $B$r@aLs$9$k$?$a$KC1$K(B @file{.nnmaildir/markfile} $B$X$N%O!<%I%j%s%/(B +$B$rD%$j$^$9!#(B) + +@file{.nnmaildir/marks/} $B$K?7$7$$%G%#%l%/%H%j$r:n$k$3$H$K$h$C$F!"?7$7$$(B +$B0u$rAOB$$9$k$3$H$,$G$-$^$9!#0u$rJ];}$7$D$D(B maildir $B$r(B tar $B$G$^$H$a$F%5!<(B +$B%P!<$+$i$=$l$r:o=|$7!"8e$G(B tar $B$r$[$I$/$3$H$,$G$-$^$9!#0u%U%!%$%k$r:n@.(B +$B$^$?$O>C5n$9$k$3$H$K$h$C$F!"$"$J$?<+?H$,0u$rDI2C$^$?$O:o=|$9$k$3$H$,$G$-(B +$B$^$9!#(BGnus $B$,F0:n$7$F$$$F(B nnmaildir $B%5!<%P!<$,3+DL$7$F$$$k$H$-$K$3$l$r9T(B +$B$J$&>l9g$O!":G=i$K$9$Y$F$N(B nnmaildir $B%0%k!<%W$N35N,%P%C%U%!$+$iB`=P$7$F(B +$B%0%k!<%W%P%C%U%!$G(B @kbd{s} $B$r%?%$%W$7!"$=$N8e%0%k!<%W%P%C%U%!(B +$B$G(B @kbd{g} $B$+(B @kbd{M-g} $B$r%?%$%W$9$k$N$,:GNI$G$9!#$=$&$7$J$$$H(B Gnus $B$OJQ(B +$B99$rB*$($F$/$l$:$K!"$=$l$i$r85$KLa$7$F$7$^$&$+$b$7$l$^$;$s!#(B + @node Mail Folders @subsubsection $B%a!<%k%U%)%k%@!<(B @cindex nnfolder @@ -13989,9 +14262,9 @@ Rand MH $B%a!<%k1\Mw%7%9%F%`$O(B UNIX $B%7%9%F%`$K$+$J$jD9$$4VB8:_$7$F$$$^$9! @item nnfolder $B4pK\E*$K(B @code{nnfolder} $B$N8z2L$O%0%k!<%WKh$N(B @code{nnmbox} ($B>e$G@bL@$5(B -$B$l$F$$$k:G=i$NJ}K!(B) $B$G$9!#$9$J$o$A!"(B@code{nnmbox} $B<+?H$O(B *$BA4$F(B* $B$N%a!<%k(B -$B$r0l$D$N%U%!%$%k$KF~$l$^$9(B; @code{nnfolder} $B$O%a!<%k%0%k!<%W$=$l$>$l(B -$B$,(B Unix mail box $B%U%!%$%k$r;}$D$h$&$K>/$7:GE,2=$r$7$^$9!#(B +$B$l$F$$$k:G=i$NJ}K!(B) $B$G$9!#$9$J$o$A!"(B@code{nnmbox} $B<+?H$O(B @emph{$BA4$F(B} $B$N(B +$B%a!<%k$r0l$D$N%U%!%$%k$KF~$l$^$9(B; @code{nnfolder} $B$O%a!<%k%0%k!<%W$=$l$>(B +$B$l$,(B Unix mail box $B%U%!%$%k$r;}$D$h$&$K>/$7:GE,2=$r$7$^$9!#(B @code{nnmobx} $B$h$j$b!"$=$l$>$l$N%0%k!<%W$rJL$K2r@O$9$k$N$GB.$/!"$=$N$&$((B $B%a!<%k$r0\F0$5$;$k$N$K:G>.8B$NO+NO$rMW5a$9$kC1=c$J(B Unix mail box $B7A<0$r(B $BDs6!$7$^$9!#2C$($F!"(Bgnus $B$,$=$l$>$l$NJL$N%0%k!<%W$K$I$N$/$i$$$N%a%C%;!<(B @@ -14278,7 +14551,7 @@ Slashdot (@uref{http://slashdot.org/}) $B$O?M5$$N$"$k%K%e!<%9%5%$%H$G!"%K%e!<( @item nnslashdot-directory @vindex nnslashdot-directory @code{nnslashdot} $B$,%U%!%$%k$rJ]B8$9$k>l=j$G$9!#=i4|CM(B -$B$O(B @samp{~/News/slashdot/} $B$G$9!#(B +$B$O(B @file{~/News/slashdot/} $B$G$9!#(B @item nnslashdot-active-url @vindex nnslashdot-active-url @@ -14329,7 +14602,7 @@ http://www.tcj.com/messboard.ubbcgi/ RET}$B!#(B($B6=L#$N$"$k2q5D<<(B @item nnultimate-directory @vindex nnultimate-directory @code{nnultimate} $B$,%U%!%$%k$rJ]B8$9$k%G%#%l%/%H%j!<$G$9!#=i4|CM(B -$B$O(B @samp{~/News/ultimate/} $B$G$9!#(B +$B$O(B @file{~/News/ultimate/} $B$G$9!#(B @end table @node Web Archive @@ -14358,7 +14631,7 @@ an_egroup RET egroups RET www.egroups.comRET your@@email.address RET}$B!#(B @item nnwarchive-directory @vindex nnwarchive-directory @code{nnwarchive} $B$,%U%!%$%k$rJ]B8$9$k%G%#%l%/%H%j!<$G$9!#=i4|CM(B -$B$O(B @samp{~/News/warchive} $B$G$9!#(B +$B$O(B @file{~/News/warchive} $B$G$9!#(B @item nnwarchive-login @vindex nnwarchive-login @@ -14627,7 +14900,7 @@ Web Newspaper $B$K4X$9$k0J2<$N(B @code{nnshimbun} $BJQ?t$rJQ$($k$3$H$,2DG=$G$ @item nnrss-directory @vindex nnrss-directory @code{nnrss} $B$,%U%!%$%k$r=q$-9~$`%G%#%l%/%H%j!<$G!"%G%#%U%)%k%H(B -$B$O(B @samp{~/News/rss/} $B$G$9!#(B +$B$O(B @file{~/News/rss/} $B$G$9!#(B @end table $B35N,%P%C%U%!$K@bL@$rI=<($5$;$?$$$J$i$P!"0J2<$N%3!<%I$,Lr$KN)$D$G$7$g$&!#(B @@ -14702,10 +14975,10 @@ Gnus $B$O%&%'%V%Z!<%8$ro$K;w$F$$$F!"$=$N%5!<%P!<$N%M%C(B -$B%H%o!<%/%"%I%l%9$r;XDj$9$k$@$1$K$J$C$F$$$^$9!#(B +@sc{imap} $B$O%a!<%k(B ($B$b$7$/$O!"%K%e!<%9!"$b$7$/$O(B @dots{}) $B$rFI$`$?$a$N%M%C(B +$B%H%o!<%/%W%m%H%3%k$G$9!#8=BeIw$N(B @sc{nntp} $B$H9M$($F$/$@$5$$!#(B +@sc{imap} $B%5!<%P!<$X$N@\B3$O%K%e!<%9%5!<%P!<$X$N@\B3$HHs>o$K;w$F$$$F!"$=(B +$B$N%5!<%P!<$N%M%C%H%o!<%/%"%I%l%9$r;XDj$9$k$@$1$K$J$C$F$$$^$9!#(B @sc{imap} $B$K$OFs$D$NFCH$7$F2<$5$$!#(B) @@ -14829,7 +15102,7 @@ Gnus $B$O%&%'%V%Z!<%8$rC5n$7$^$9!#(B +$B=i4|@_Dj$N?6Iq$$!"%a!<%k%\%C%/%9$rJD$8$k$H$-$K(B ``Deleted'' $B$H0u$NIU$$$?(B +$B5-;v$r>C5n$7$^$9!#(B @item never $B7h$7$F5-;v$r>C5n$7$^$;$s!#8=:_$O!">C5n$N0u$,IU$$$?5-;v$r(B nnimap $B$GI=<($9(B $B$kJ}K!$O$"$j$^$;$s$,!"B>$N(B @sc{imap} $B%/%i%$%"%s%H$O$G$O$G$-$k$+$b$7$l$^(B @@ -14983,7 +15255,7 @@ nnimap $B$K5-;v$NFbItE*$JF|IU$NBe$o$j$K(B Date: $B$r;H$&$h$&$K$5$;$^$9!#$5$i$ * Expiring in IMAP:: nnimap $B$K$h$k%a!<%k$N4|8B@Z$l>C5n(B * Editing IMAP ACLs:: $B%a!<%k%\%C%/%9$X$NB>$NMxMQA06u4V$r;H$&(B($B;H$o$J$$(B)$BJ}K!(B @end menu @@ -15074,8 +15346,8 @@ Nnmail $B$NMxMQ!$A(B" $B$^$9!#Aj8_Ej9F(B -$B$r$7$F$$$k>l9g$O!"A4$F$N9gCW$7$?5,B'$,(B "$B>!$A(B" $B$^$9!#(B +$B;HMQ2DG=$K$J$C$F$$$J$$$+$.$j!":G=i$K9gCW$7$?5,B'$,(B ``$B>!$A(B'' $B$^$9!#Aj8_Ej(B +$B9F$r$7$F$$$k>l9g$O!"A4$F$N9gCW$7$?5,B'$,(B ``$B>!$A(B'' $B$^$9!#(B $B$3$NJQ?t$O$=$NCM$H$7$F4X?t$r;}$D$3$H$b$G$-$^$9!#$=$N4X?t$O5-;v$N%X%C%@$N(B $BItJ,$KHO0O$,69$a$i$l$?>uBV$G8F$P$l!"5-;v$N0\F0@h$@$H;W$&%0%k!<%W$rJV$9$b(B @@ -15173,7 +15445,7 @@ Nnmail $B$GBP1~$9$k$b$N(B: @code{nnmail-split-fancy}. @item nnmail-expiry-wait-function $B$3$l$i$NJQ?t$O40A4$K%5%]!<%H$5$l$F$$$^$9!#4|8B@Z$l>C5n$NCM$O!"?t!"%7%s%\(B -$B%k$N(B @var{immediate} $B$^$?$O(B @var{never} $B$G$9!#(B +$B%k$N(B @code{immediate} $B$^$?$O(B @code{never} $B$G$9!#(B @item nnmail-expiry-target @@ -15204,13 +15476,13 @@ ACL $B$O(B Access Control List ($B;HMQ@)8B0lMw(B) $B$NN,$G$9!#(B@sc{imap} @itemize @bullet @item -$B%a!<%j%s%0%j%9%H$N%a!<%k%\%C%/%9$G(B "anyone" $B$K(B "lrs" $B5v(B +$B%a!<%j%s%0%j%9%H$N%a!<%k%\%C%/%9$G(B ``anyone'' $B$K(B ``lrs'' $B5v(B $B2D(B (lookup, read, seen/unseen $B%U%i%0$NJ];}(B) $B$rM?$($k$3$H$G!"F1$8%5!<%P!<(B $B$NB>$NMxMQ/$J$/$H$b(B Cyrus $B$N%5!<%P!<$K$*$$$F$O!"(B"plussing" $B$,F0:n$9$k$?$a$K(B ($B$D$^(B -$B$j!"(Buser+mail@@domain $B$,(B INBOX.mailbox $B$H$$$&(B @sc{imap} $B$N%a!<%k%\%C%/%9(B -$B$K$J$k(B)$B!"MxMQ/$J$/$H$b(B Cyrus $B$N%5!<%P!<$K$*$$$F$O!"(B``plussing'' $B$,F0:n$9$k$?$a$K(B ($B$D(B +$B$^$j!"(Buser+mail@@domain $B$,(B INBOX.mailbox $B$H$$$&(B @sc{imap} $B$N%a!<%k%\%C%/(B +$B%9$K$J$k(B)$B!"MxMQl=j!#=i4|@_DjCM$O(B @file{~/}$B!#(B @item nnsoup-replies-directory @vindex nnsoup-replies-directory $BA4$F$NJV?.$O!"JV?.%Q%1%C%H$K:-Jq$5$l$kA0$K$3$N%G%#%l%/%H%j!<$K3JG<$5$l$k!#(B -$B=i4|@_Dj$O(B @file{~/SOUP/replies/"}$B!#(B +$B=i4|@_Dj$O(B @file{~/SOUP/replies/}$B!#(B @item nnsoup-replies-format-type @vindex nnsoup-replies-format-type @@ -16331,7 +16603,7 @@ PPP $B4X78(B($B$J$I(B)$B$rJD$8$^$9!#$=$&$7$F%K%e!<%9$r%*%U%i%$%s$GFI$`$3$H$ $B%@%&%s%m!<%IJ}?K$r7hDj$7$^$9!#(B@xref{Agent Categories}. @item -$B$($($H!D!"0J>e$G$9!#(B +$B$($($H(B@dots{}$B!"0J>e$G$9!#(B @end itemize @node Agent Categories @@ -16486,10 +16758,10 @@ gnus $B%(!<%8%'%s%H$,$=$N5-;v$r(B spam $B$@$H8+Pv$7$?$i??!#$3$NH/8+E*o$K3Ne$N=R8l$O$=$NJ,N`$KB0$9$k(B*$BA4$F(B*$B$N%0%k!<%W$KE,MQ$5$l$^$9!#$7$+$7!"J,N`Cf(B -$B$N8D!9$N%0%k!<%W$KFCDj$N=R8l$rK>$s$@$j!"BUBF2a$.$F?7$7$$J,N`$r@_Dj$G$-$J(B -$B$$$H$-$O!"%0%k!<%W$N8D!9$N=R8l$r%0%k!<%W%Q%i%a!<%?$Ge$N=R8l$O$=$NJ,N`$KB0$9$k(B @emph{$BA4$F(B} $B$N%0%k!<%W$KE,MQ$5$l$^$9!#$7$+$7!"(B +$BJ,N`Cf$N8D!9$N%0%k!<%W$KFCDj$N=R8l$rK>$s$@$j!"BUBF2a$.$F?7$7$$J,N`$r@_Dj(B +$B$G$-$J$$$H$-$O!"%0%k!<%W$N8D!9$N=R8l$r%0%k!<%W%Q%i%a!<%?$Ge$G=R$Y$i$l$F$$$k;HMQ2DG=$J%9%3%"IU$1%-!<%o!<%I(B -*$B$N$_(B* $B$G$"$kI,MW$,$"$j$^$9!#(B +$B$3$l$i$N%9%3%"%U%!%$%k$O>e$G=R$Y$i$l$F$$$k;HMQ2DG=$J%9%3%"IU$1%-!<%o!<(B +$B%I(B @emph{$B$N$_(B} $B$G$"$kI,MW$,$"$j$^$9!#(B $BNc(B: @@ -16597,7 +16869,7 @@ gnus $B%(!<%8%'%s%H$,$=$N5-;v$r(B spam $B$@$H8+Pv$7$?$i??!#$3$NH/8+E*C$;$P!"$"$J$?$,!VF14|!W$NA`:n$r9T$J$C$?$H$-(B -$B$K!"$=$N%U%i%0$O%;%C%H$5$l$F%5!<%P!<$+$i$O:o=|$5$l$^$9!#(B +$B5;=QE*CmC$;$P!"$"$J$?$,(B ``$BF14|(B'' $B$NA`:n$r9T$J$C(B +$B$?$H$-$K!"$=$N%U%i%0$O%;%C%H$5$l$F%5!<%P!<$+$i$O:o=|$5$l$^$9!#(B @c FIXMETGNUS Does it make sense? "The queued flag" $B$K4X$9$kF0:n$O!"%(!<%8%'%s%H%G%#%l%/%H%j$K$"$k%5!<%P!<(B $BKh$N(B @code{flags} $B%U%!%$%k$NCf$G8+$D$+$k$G$7$g$&!#$=$l$i$O$"$J$?$,%U%i%0(B @@ -17434,8 +17706,9 @@ File Editing})$B!#(B @code{Messsage-ID} $B%X%C%@!<$K%9%3%"$rIU$1$^$9!#(B @item e -$BDI2C$N%X%C%@!<(B (@code{gnus-extra-headers} $B$K@_Dj$5$l$F$$$F!"(B@sc{nntp} $B%5!<(B -$B%P!<$,(B overview $B$K$=$l$i$N>pJs$r5-O?$7$F$$$k(B) $B$K%9%3%"$rIU$1$^$9!#(B +``$BDI2C(B'' $B$N%X%C%@!<(B ($B$9$J$o$A!"(B(@code{gnus-extra-headers} $B$K@_Dj$5$l$F$$(B +$B$F!"(B@sc{nntp} $B%5!<%P!<$,(B overview $B$K$=$l$i$N>pJs$r5-O?$7$F$$$k(B) $B$K%9%3%"(B +$B$rIU$1$^$9!#(B @item f $B%U%)%m!<%"%C%W(B (followup) $B$K%9%3%"$rIU$1$^$9(B---$B$3$l$OCx$H$N9gCW$r$7!"(B @@ -17597,7 +17870,7 @@ Gnus $B$O2?EY$b%9%3%"O"A[%j%9%H$rFI$_9~$`$N$rHr$1$k$?$a$K!"$=$l$N%-%c%C%7%e(B @item gnus-score-file-suffix @vindex gnus-score-file-suffix $B%9%3%"%U%!%$%k$K$?$I$jCe$/$?$a$K%0%k!<%WL>$K2C$($k@\Hx8l$G$9(B ($B=i4|CM(B -$B$G(B @samp{SCORE} $B$G$9!#(B) +$B$G(B @file{SCORE} $B$G$9!#(B) @item gnus-score-uncacheable-files @vindex gnus-score-uncacheable-files @@ -17998,11 +18271,11 @@ ignore)} $B$rE,1~%9%3%"$r$7$?$/$J$$%0%k!<%W$KA^F~$9$k$G$7$g$&!#>/$7$N%0%k!<(B @item local @cindex local variables -$B$3$NEPO?$NCM$O(B @code{(VAR VALUE)} $BBP$N%j%9%H$G$"$k$Y$-$G$9!#$=$l$>$l(B -$B$N(B @var{var} $B$O8=:_$N35N,%P%C%U%!$N%P%C%U%!8GM-$K$J$j!";XDj$5$l$?(B -$BCM(B (value) $B$K@_Dj$5$l$^$9!#$3$l$OJXMx$J!"$b$7>/$7JQ$@$H$7$F$b!"%U%C%/$r(B -$B$"$^$j9%$^$J$$$$$/$D$+$N%0%k!<%W$GJQ?t$r@_Dj$9$kJ}K!$G$9!#(B@var{value} $B$O(B -$BI>2A$5$l$J$$;v$KCm0U$7$F$/$@$5$$!#(B +$B$3$NEPO?$NCM$O(B @code{(@var{var} @var{value})} $BBP$N%j%9%H$G$"$k$Y$-$G$9!#(B +$B$=$l$>$l$N(B @var{var} $B$O8=:_$N35N,%P%C%U%!$N%P%C%U%!8GM-$K$J$j!";XDj$5$l(B +$B$?CM(B (value) $B$K@_Dj$5$l$^$9!#$3$l$OJXMx$J!"$b$7>/$7JQ$@$H$7$F$b!"%U%C%/(B +$B$r$"$^$j9%$^$J$$$$$/$D$+$N%0%k!<%W$GJQ?t$r@_Dj$9$kJ}K!$G$9!#(B +@var{value} $B$OI>2A$5$l$J$$;v$KCm0U$7$F$/$@$5$$!#(B @end table @node Score File Editing @@ -18129,7 +18402,7 @@ gnus $B$K$O$3$l$i$rA4$F<+F0E*$K(B --- $B$^$k$GKbK!$G$b;H$C$?$h$&$K:n@.(B @vindex gnus-adaptive-file-suffix $BE,1~@-%9%3%"EPO?9`L\$O!"%0%k!<%WL>$K(B @code{gnus-adaptive-file-suffix} $B$r(B -$BIU2C$7$?L>A0$N%U%!%$%k$KF~$l$i$l$^$9!#=i4|@_DjCM$O(B @samp{ADAPT} $B$G$9!#(B +$BIU2C$7$?L>A0$N%U%!%$%k$KF~$l$i$l$^$9!#=i4|@_DjCM$O(B @file{ADAPT} $B$G$9!#(B @vindex gnus-score-exact-adapt-limit $BE,1~@-%9%3%"$r9T$&$H$-$O!"ItJ,J8;zNs0lCW$d%U%!%8!<$J0lCW$r9T$C$?J}$,!"$*(B @@ -18518,10 +18791,10 @@ gnus $B$r:F5/F0$7$F!"(B@kbd{M-x nnml-generate-nov-databases} $B%3%^%s%I(B $B$k$G$7$g$&$1$l$I$b!#(B @end itemize -... $B2L$?$7$FB>$N%K%e!<%9%j!<%@!<$O>-Mh!"%0%m!<%P%k%9%3%"%U%!%$%k$r%5%]!<(B -$B%H$9$k$G$7$g$&$+(B? @emph{$B$&$U$U(B}$B!#$=$&!"$I$&9M$($F$_$?$C$F!"(B -Blue Wave $B$d(B xrn $B$d(B 1stReader $B$H$+$$$C$?%K%e!<%9%j!<%@!<$O%9%3%"$r%5%]!<(B -$B%H$9$k$Y$-$@$M!#:#$O8GBC$r0{$s$G8+$N%K%e!<%9%j!<%@!<$O>-Mh!"%0%m!<%P%k%9%3%"%U%!%$%k$r%5(B +$B%]!<%H$9$k$G$7$g$&$+(B? @emph{$B$&$U$U(B}$B!#$=$&!"$I$&9M$($F$_$?$C$F!"(BBlue +Wave $B$d(B xrn $B$d(B 1stReader $B$H$+$$$C$?%K%e!<%9%j!<%@!<$O%9%3%"$r%5%]!<%H$9(B +$B$k$Y$-$@$M!#:#$O8GBC$r0{$s$G8+C5n%U%!%$%k(B @@ -19113,8 +19386,8 @@ Gnus $B$O0lF|$K0l2s%9%3%"$rIeGT$5$;$h$&$H$7$^$9!#Nc$($P!"$b$7(B gnus $B$r;MF| $BB?$/$N%3%^%s%I$O%W%m%;%9(B/$B@\F,0z?t$N=,47$r;H$$$^$;$s!#$H$$$&$3$H$O!"$3$N(B $B%^%K%e%"%k$G$O$C$-$j$H=R$Y$F$$$^$9!#%W%m%;%9(B/$B@\F,0z?t$N=,47$r;H$o$J$$%3(B $B%^%s%I$KE,MQ$9$k$K$O!"(B@kbd{M-&} $B%3%^%s%I$r;H$$$^$7$g$&!#Nc$($P!"$=$N%0%k!<(B -$B%W$N$9$Y$F$N5-;v$r4|8B@Z$l:o=|2DG=$H$7$F0u$rIU$1$k$K$O(B `M P b M-& E' $B$H(B -$B$7$^$9!#(B +$B%W$N$9$Y$F$N5-;v$r4|8B@Z$l:o=|2DG=$H$7$F0u$rIU$1$k$K(B +$B$O(B @kbd{M P b M-& E} $B$H$7$^$9!#(B @node Interactive @section $BBPOCE*(B @@ -20885,11 +21158,12 @@ Spam $B$H@o$&$?$a$N?7$7$$5;K!$O!"%a%C%;!<%8$rAw?.$9$k:]$K$$$/$P$/$+$NIiC4(B @item hashcash-payment-alist @vindex hashcash-payment-alist $B2??M$+$NWFM$N%S%C%H?t$G$9!#$3$l$O$^$?(B @samp{(ADDR STRING AMOUNT)} $B$NMW(B -$BAG$r;}$D$3$H$b2DG=$G!"(BSTRING $B$OJ8;zNs(B ($BDL>o$O%a!<%k%"%I%l%9$+%K%e!<%9%0(B -$B%k!<%WL>(B) $B$H$7$F;H$o$l$^$9!#(B +$BMW5a$9$k$+$b$7$l$^$;$s!#$3$NJQ?t$O(B @samp{(@var{addr} @var{amount})} $B$N7A(B +$B<0$NMWAG$N%j%9%H$G!"(B@var{addr} $B$OWFM$N%S%C%H?t$G$9!#$3$l$O$^(B +$B$?(B @samp{(@var{addr} @var{string} @var{amount})} $B$NMWAG$r;}$D$3$H$b2DG=(B +$B$G!"(B@var{string} $B$OJ8;zNs(B ($BDL>o$O%a!<%k%"%I%l%9$+%K%e!<%9%0%k!<%WL>(B) $B$H(B +$B$7$F;H$o$l$^$9!#(B @item hashcash @vindex hashcash @@ -20976,10 +21250,10 @@ Spam $B%0%k!<%W$G$O!"%G%#%U%)%k%H$G$9$Y$F$N%a%C%;!<%8$,(B spam $B$G$"$k$H2rC$5$J$1$l$P$J$j$^$;$s!#(B@samp{$} $B0u$r>C$9$K$O(B @kbd{M-u} $B$G(B -$B$=$N5-;v$r!VL$FI!W$K$9$k$+!"$"$k$$$O(B @kbd{d} $B$G(B spam $B$G$O$J$$$b$N$H$7$F(B -$BFI$s$@$3$H$r@k8@$9$l$PNI$$$G$7$g$&!#%0%k!<%W$rH4$1$k$H$-!"$9$Y$F$N(B spam -$B0u(B (@samp{$}) $B$,IU$$$?5-;v$O(B spam $B%W%m%;%C%5!<$KAw$i$l!"$=$l$i$r(B spam $B$N(B -$BI8K\$H$7$F3X=,$7$^$9!#(B +$B$=$N5-;v$r(B ``$BL$FI(B'' $B$K$9$k$+!"$"$k$$$O(B @kbd{d} $B$G(B spam $B$G$O$J$$$b$N$H$7(B +$B$FFI$s$@$3$H$r@k8@$9$l$PNI$$$G$7$g$&!#%0%k!<%W$rH4$1$k$H$-!"$9$Y$F(B +$B$N(B spam $B0u(B (@samp{$}) $B$,IU$$$?5-;v$O(B spam $B%W%m%;%C%5!<$KAw$i$l!"$=$l$i(B +$B$r(B spam $B$NI8K\$H$7$F3X=,$7$^$9!#(B $B%a%C%;!<%8$OB>$N$$$m$$$m$JJ}K!$K$h$C$F$b>C5n$5$l$k$+$b$7$l$^$;$s$7!"(B @code{spam-ham-marks} $B$,8e=R$N$h$&$K>e=q$-$5$l$J$1$l$P!"Dc$$%9%3%"$N$?$a(B @@ -21449,10 +21723,10 @@ Spam $B$H(B ham $B$N%W%m%;%C%5!<$H(B @code{spam-split} $B$N$?$a(B @item $B%3!<%I(B -@example +@lisp (defvar spam-use-blackbox nil "Blackbox $B$r;H$&$H$-$O(B t $B$K$9$k!#(B") -@end example +@end lisp @code{spam-list-of-checks} $B$K(B @example @@ -21466,6 +21740,11 @@ Spam $B$H(B ham $B$N%W%m%;%C%5!<$H(B @code{spam-split} $B$N$?$a(B @code{spam-check-blackbox} $B4X?t$r=q$$$F2<$5$$!#$=$l(B $B$O(B @samp{nil} $B$+(B @code{spam-split-group} $B$rJV$5$J$1$l$P$J$j$^$;$s!#$"$J(B $B$?$K$G$-$k$3$H$NNc$O!"4{B8$N(B @code{spam-check-*} $B4X?t$r;2>H$7$F$/$@$5$$!#(B + +$B%V%i%C%/%\%C%/%9$,!"$=$l$,F0:n$9$k$?$a$K%a%C%;!<%8A4BN$rI,MW$H$9$kE}7WE*(B +$B%a!<%kJ,@O4o$G$"$k$N$J$i$P!"(B +@code{spam-list-of-statistical-checks} $B$K(B @code{spam-use-blackbox} $B$rDI(B +$B2C$9$k$3$H$rK:$l$J$$$G2<$5$$!#(B @end enumerate Spam $B$H(B ham $B%a%C%;!<%8$r=hM}$9$k$K$O!"0J2<$rMQ0U$7$F2<$5$$(B: @@ -21479,7 +21758,7 @@ Spam $B$^$?$O(B ham $B$N%W%m%;%C%5!<$rMQ0U$9$kI,MW$O$"$j$^$;$s!#(B Blackbox $B$,(B spam $B$^$?$O(B ham $B$N=hM}$r%5%]!<%H$9$k>l9g$@$1!"$=$l$i$rMQ0U$7(B $B$F2<$5$$!#(B -@example +@lisp (defvar gnus-group-spam-exit-processor-blackbox "blackbox" "$B35N,$r=P$k$H$-$K8F$P$l$k(B blackbox $B$N(B spam $B%W%m%;%C%5!l9g!"<-=q$r:n$k$H$-$K==J,$KCm0U$7$J$1$l$P$J$j(B $B$^$;$s!#(B @@ -21684,12 +21963,12 @@ Spam $BMQ$N%0%k!<%W$G$9!#%G%#%U%)%k%H$O(B @samp{mail.spam} $B$G$9!#(B $B$-$NHs(B-spam $B%3%l%/%7%g%s$KN>J}$H$bF~$C$F$$$J$1$l$P$J$i$J$$$3$H$KCm0U$7$F(B $B2<$5$$!#(B -@example +@lisp (setq nnmail-split-fancy `(| (: spam-stat-split-fancy) ("Subject" "\\bspam-stat\\b" "mail.emacs") "mail.misc")) -@end example +@end lisp $B$3$l$rEAE}E*$J_I2a$HAH$_9g$o$;$k$3$H$b$G$-$^$9!#$3$3$G$O2f!9$O$9$Y$F(B $B$N(B HTML $B$@$1$N%a!<%k$r(B @samp{mail.spam.filtered} $B%0%k!<%W$KF~$l$k$b$N$H(B @@ -21697,13 +21976,13 @@ Spam $BMQ$N%0%k!<%W$G$9!#%G%#%U%)%k%H$O(B @samp{mail.spam} $B$G$9!#(B $B<-=q$r:n$k$H$-$K!"(B@samp{mail.spam.filtered} $B$N%a!<%k$,(B spam $B$^$?$O(B $BHs(B-spam $B%3%l%/%7%g%s$N$I$A$i$K$bF~$k$Y$-$G$O$J$$$3$H$KCm0U$7$F2<$5$$(B! -@example +@lisp (setq nnmail-split-fancy `(| ("Content-Type" "text/html" "mail.spam.filtered") (: spam-stat-split-fancy) ("Subject" "\\bspam-stat\\b" "mail.emacs") "mail.misc")) -@end example +@end lisp @node Low-level interface to the spam-stat dictionary @subsubsection spam-$BE}7W(B (spam-stat) $B<-=q$X$NDc3,AX%$%s%?!<%U%'!<%9(B @@ -21759,10 +22038,10 @@ Spam $B$G$O$J$$DL>o$N%a!<%k$@$H$O$b$O$d9M$($i$l$J$$%a!<%k$,$"$k%P%C%U%!$G(B $B$=$l$r;H$&A0$K!"I,$:<-=q$,(B load $B$5$l$F$$$k$h$&$K$7$F2<$5$$!#$3$l$K(B $B$O(B @file{~/.gnus} $B%U%!%$%k$K0J2<$,I,MW$G$9(B: -@example +@lisp (require 'spam-stat) (spam-stat-load) -@end example +@end lisp $BBeI=E*$J%F%9%H$O0J2<$N4X?t8F=P$7$rI,MW$H$7$^$9(B: @@ -22326,7 +22605,7 @@ type>$B!"$&$s!";d$O$9$0$K=P$=$&(B $B$$$d!"E;$&!"$=$l$OA4$/F0:n$7$J Micro$oft---$B$"$!!#%"%^%A%e%"!#;d$O(B @emph{$B$b$C$H(B} $B0-$$!#(B($B$b$7$/$O!"(B ``$B$h$j0-$$(B''? ``$B$b$C$H0-$$(B''? ``$B:G0-(B''?) -$B;d$O$3$N5!2q$K$3$N3X2q$K(B... $B$*$*$C$H!"0c$C$?!#(B +$B;d$O$3$N5!2q$K$3$N3X2q$K(B@dots{} $B$*$*$C$H!"0c$C$?!#(B @itemize @bullet @@ -23204,12 +23483,12 @@ Gnus $B$r%*%U%i%$%s%K%e!<%9%j!<%@!<$H$7$F;H$&?75!G=$,2C$($i$l$^$7$?!#2a>j(B @code{long-to}$B!#(B @item -@kbd{M-i} $B%7%s%\%k@\F,0z?tL?Na$,$"$j$^$9!#>\:Y$O(B "Symbolic Prefixes" $B$N(B -$BItJ,$r8+$F2<$5$$!#(B +@kbd{M-i} $B%7%s%\%k@\F,0z?tL?Na$,$"$j$^$9!#>\:Y$O(B ``Symbolic +Prefixes'' $B$NItJ,$r8+$F2<$5$$!#(B @item -$B35N,%P%C%U%!$N(B @kbd{L} $B$H(B @kbd{I} $B$O%U%!%$%k(B "all.SCORE" $B$K%9%3%"K!B'$r(B -$B2C$($k$?$a$K%7%s%\%k@\F,0z?t(B @kbd{a} $B$r@\$K(B elisp $B$N%(%i!<$r5/$3$5$J$$$b$N$N!"(Bgnus $B$,Hs>o$KCY$/$J$k(B $B$?$a$KL@$i$+$K$J$kLdBj$,$"$j$^$9!#$=$s$J>l9g$K$O(B @kbd{M-x -toggle-debug-on-quit} $B$r;H$C$F!"CY$/$J$C$?$H$-$K(B C-g $B$r2!$7!"$7$+$k8e$K(B -$B%P%C%/%H%l!<%9$r2r@O$7$F2<$5$$(B ($B$=$NeEy$J$N>l=j$G40A4$KJ8=q2=$5$l$F$$$k$O$:$G$9$,!"$=$l$r;O(B -$B$a$k$?$a$KI,MW$J/!9=q$$$F$*$-$^$7$g$&!#Bh0l$K!"%W%m%U%!%$%k$7$F$_(B -$B$?$$(B gnus $B$NItJ,$r7WB,$9$k$?$a$N@_Dj$r!"Nc$($P(B @kbd{M-x +toggle-debug-on-quit} $B$r;H$C$F!"CY$/$J$C$?$H$-$K(B @kbd{C-g} $B$r2!$7!"$7$+(B +$B$k8e$K%P%C%/%H%l!<%9$r2r@O$7$F2<$5$$(B ($B$=$NeEy$J$N>l=j$G40A4$KJ8=q2=$5$l$F$$$k$O$:$G$9$,!"$=(B +$B$l$r;O$a$k$?$a$KI,MW$J/!9=q$$$F$*$-$^$7$g$&!#Bh0l$K!"%W%m%U%!%$%k(B +$B$7$F$_$?$$(B gnus $B$NItJ,$r7WB,$9$k$?$a$N@_Dj$r!"Nc$($P(B @kbd{M-x elp-instrument-package RET gnus} $B$d(B @kbd{M-x elp-instrument-package RET message} $B$G9T$J$C$F2<$5$$!#$=$7$F!"CY$$F0:n$r9T$J$o$;$F$+$i(B @kbd{M-x elp-results} $B$r2!$7$^$7$g$&!#$9$k$H!"$I$NF0:n$,;~4V$r?)$C$F$$$k$+$r8+$F!"(B $B8e$G$=$l$i$r%G%P%C%0$9$k$3$H$,$G$-$^$9!#F0:nA4BN$,!"%W%m%U%!%$%i!<$N=PNO(B -$B$NCf$G$G:G$bCY$$4X?t$GHq$d$5$l$?;~4V$h$j$O$k$+$KD9$/$+$+$k$N$O!"$?$V(B +$B$NCf$G:G$bCY$$4X?t$GHq$d$5$l$?;~4V$h$j$O$k$+$KD9$/$+$+$k$N$O!"$?$V(B $B$s(B gnus $B$N4V0c$C$F$$$kItJ,$r%W%m%U%!%$%k$7$?$;$$$G$7$g$&!#%W%m%U%!%$%k$N(B $BE}7W$r%j%;%C%H$9$k$K$O(B @kbd{M-x elp-reset-all} $B$r;H$C$F2<$5$$!#(B@kbd{M-x elp-restore-all} $B$O%W%m%U%!%$%k$9$kF0:n$rJ,$J%X%C%@!o!"(B@code{articles} $B$NCf$N:G>.HV9f$N5-;v$h(B -$B$j$b>.$5$$5-;v$+$i(B ($B>/$J$/$H$b(B) @var{fetch-old} $B8D$NM>J,$J%X%C%@!<$r$&$3$H$r(B -$BHQ$o$7$$$H;W$C$?>l9g$K$O!"$3$N%Q%i%a!<%?$NB8:_$OL5;k$5$l$k$3$H$b$"$j$^$9!#(B -$B$3$NCM$,(B @code{nil} $B$G$b?t;z$G$b$J$1$l$P!":GBg8B$NJ,$J%X%C(B +$B%@!<(B'' $B$ro!"(B@code{articles} $B$NCf$N:G>.HV9f(B +$B$N5-;v$h$j$b>.$5$$5-;v$+$i(B ($B>/$J$/$H$b(B) @var{fetch-old} $B8D$NM>J,$J%X%C%@!<(B +$B$r$&(B +$B$3$H$rHQ$o$7$$$H;W$C$?>l9g$K$O!"$3$N%Q%i%a!<%?$NB8:_$OL5;k$5$l$k$3$H$b$"(B +$B$j$^$9!#$3$NCM$,(B @code{nil} $B$G$b?t;z$G$b$J$1$l$P!":GBg8B$N " Article retrieved." eol header = eol @end example +@cindex BNF +($B$3$3$G;H$C$?(B BNF $B$NHG$O(B RFC822 $B$G;H$o$l$F$$$k$b$N$G$9!#(B) + $B$b$7JV5QCM$,(B @code{nov} $B$G$"$l$P!"%G!<%?%P%C%U%!!<$K(B $B$O(B @dfn{network overview database} $B9T$,4^$^$l$F$J$/$F$O$J$j$^$;$s!#(B $B$3$l$O4pK\E*$K$OJ#?t$NMs$r%?%V$G6h@Z$C$?$b$N$G$9!#(B @example nov-buffer = *nov-line -nov-line = 8*9 [ field ] eol +nov-line = field 7*8[ field ] eol field = @end example @@ -24483,8 +24766,7 @@ description-buffer = *description-line $BJV$5$l$k7k2L$N%G!<%?$O$"$j$^$;$s!#(B -@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM -&optional LAST) +@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST) $B$3$N4X?t$O(B @var{article} ($BHV9f(B) $B$r!"(B@var{group} $B$+(B $B$i(B @var{accept-form} $B$r8F$S=P$7$F0\F0$7$^$9!#(B @@ -24625,9 +24907,9 @@ description-buffer = *description-line $B$3$N%^%/%m$O!"$[$H$s$IA4It$N%P%C%/%(%s%I$,;}$D$Y$-6&DL4X?t$r$$$/$D$+Dj5A(B $B$7$^$9!#(B -@example +@lisp (nnoo-define-basics nndir) -@end example +@end lisp @item deffoo $B$3$N%^%/%m$O$^$5$K(B @code{defun} $B$N$h$&$J$b$N$G!"F10l$N0z?t$r no, wait, that absolutely does not work'' policy for releases. Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that ``worser''? ``much worser''? ``worsest''?) -I would like to take this opportunity to thank the Academy for... oops, +I would like to take this opportunity to thank the Academy for@dots{} oops, wrong show. @itemize @bullet @@ -23674,12 +23973,12 @@ re-highlighting of the article buffer. New element in @code{gnus-boring-article-headers}---@code{long-to}. @item - @kbd{M-i} symbolic prefix command. See the section "Symbolic -Prefixes" in the Gnus manual for details. + @kbd{M-i} symbolic prefix command. See the section ``Symbolic +Prefixes'' in the Gnus manual for details. @item @kbd{L} and @kbd{I} in the summary buffer now take the symbolic prefix -@kbd{a} to add the score rule to the "all.SCORE" file. +@kbd{a} to add the score rule to the @file{all.SCORE} file. @item @code{gnus-simplify-subject-functions} variable to allow greater @@ -23749,7 +24048,7 @@ been added. @code{gnus-adaptive-word-minimum} variable. @item - The "lapsed date" article header can be kept continually + The ``lapsed date'' article header can be kept continually updated by the @code{gnus-start-date-timer} command. @item @@ -24346,14 +24645,14 @@ evaluate expressions using @kbd{M-:} or inspect variables using @cindex slow Sometimes, a problem do not directly generate a elisp error but manifests itself by causing Gnus to be very slow. In these cases, you -can use @kbd{M-x toggle-debug-on-quit} and press C-j when things are +can use @kbd{M-x toggle-debug-on-quit} and press @kbd{C-j} when things are slow, and then try to analyze the backtrace (repeating the procedure helps isolating the real problem areas). A fancier approach is to use the elisp profiler, ELP. The profiler is (or should be) fully documented elsewhere, but to get you started there are a few steps that need to be followed. First, instrument the part of Gnus you are interested in for profiling, e.g. @kbd{M-x elp-instrument-package RET -gnus} or @kbd{M-x elp-instrument-packagre RET message}. Then perform +gnus} or @kbd{M-x elp-instrument-package RET message}. Then perform the operation that is slow and press @kbd{M-x elp-results}. You will then see which operations that takes time, and can debug them further. If the entire operation takes much longer than the time spent in the @@ -24368,8 +24667,8 @@ If you just need help, you are better off asking on @cindex gnu.emacs.gnus @cindex ding mailing list -You can also ask on the ding mailing list---@samp{ding@@gnus.org}. -Write to @samp{ding-request@@gnus.org} to subscribe. +You can also ask on the ding mailing list---@email{ding@@gnus.org}. +Write to @email{ding-request@@gnus.org} to subscribe. @page @@ -24628,8 +24927,8 @@ value should either be @code{headers} or @code{nov} to reflect this. This might later be expanded to @code{various}, which will be a mixture of HEADs and @sc{nov} lines, but this is currently not supported by Gnus. -If @var{fetch-old} is non-@code{nil} it says to try fetching "extra -headers", in some meaning of the word. This is generally done by +If @var{fetch-old} is non-@code{nil} it says to try fetching ``extra +headers'', in some meaning of the word. This is generally done by fetching (at most) @var{fetch-old} extra headers less than the smallest article number in @code{articles}, and filling the gaps as well. The presence of this parameter can be ignored if the back end finds it @@ -24667,13 +24966,16 @@ valid-message = "221 " " Article retrieved." eol header = eol @end example +@cindex BNF +(The version of BNF used here is the one used in RFC822.) + If the return value is @code{nov}, the data buffer should contain @dfn{network overview database} lines. These are basically fields separated by tabs. @example nov-buffer = *nov-line -nov-line = 8*9 [ field ] eol +nov-line = field 7*8[ field ] eol field = @end example @@ -25011,8 +25313,7 @@ able to delete. There should be no result data returned. -@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM -&optional LAST) +@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST) This function should move @var{article} (which is a number) from @var{group} by calling @var{accept-form}. @@ -25162,9 +25463,9 @@ of @code{nndir}. (The same with @code{nnmh}.) This macro defines some common functions that almost all back ends should have. -@example +@lisp (nnoo-define-basics nndir) -@end example +@end lisp @item deffoo This macro is just like @code{defun} and takes the same parameters. In @@ -25175,11 +25476,11 @@ function as being public so that other back ends can inherit it. This macro allows mapping of functions from the current back end to functions from the parent back ends. -@example +@lisp (nnoo-map-functions nndir (nnml-retrieve-headers 0 nndir-current-group 0 0) (nnmh-request-article 0 nndir-current-group 0 0)) -@end example +@end lisp This means that when @code{nndir-retrieve-headers} is called, the first, third, and fourth parameters will be passed on to @@ -25191,13 +25492,13 @@ This macro allows importing functions from back ends. It should be the last thing in the source file, since it will only define functions that haven't already been defined. -@example +@lisp (nnoo-import nndir (nnmh nnmh-request-list nnmh-request-newgroups) (nnml)) -@end example +@end lisp This means that calls to @code{nndir-request-list} should just be passed on to @code{nnmh-request-list}, while all public functions from diff --git a/texi/gnusref.tex b/texi/gnusref.tex index abb47eb..208c8e4 100644 --- a/texi/gnusref.tex +++ b/texi/gnusref.tex @@ -586,9 +586,8 @@ W d & Treat {\bf dumbquotes}.\\ W e & Treat {\bf emphasized} text.\\ W h & Treat {\bf HTML}.\\ - W k & Deuglify broken Outlook (Express) articles and redisplay.\\ W l & (w) Remove page breaks ({\bf\^{}L}) from the article.\\ - W m & Toggle {\bf MIME} processing.\\ + W m & {\bf Morse} decode article.\\ W o & Treat {\bf overstrike} or underline (\^{}H\_) in the article.\\ W p & Verify X-{\bf PGP}-Sig header.\\ W q & Treat {\bf quoted}-printable in the article.\\ @@ -606,6 +605,11 @@ W G u & {\bf Unfold} folded header lines.\\ W G f & {\bf Fold} all header lines.\\ W G n & Unfold {\bf Newsgroups:} and Follow-Up-To:.\\ + % + W Y c & Repair broken {\bf citations}.\\ + W Y a & Repair broken {\bf attribution} lines.\\ + W Y u & {\bf Unwrap} broken citation lines.\\ + W Y f & Do a {\bf full} deuglification (W Y c, W Y a, W Y u).\\ \end{keys} } } @@ -632,6 +636,7 @@ \begin{keys}{W D D} W D s & (W g) Display {\bf smilies}.\\ W D x & (W f) Look for and display any X-{\bf Face} headers.\\ + W D d & Display any Face headers.\\ W D n & Toggle picons in {\bf Newsgroups} and Followup-To.\\ W D m & Toggle picons in {\bf mail} headers (To and Cc).\\ W D f & Toggle picons in {\bf From}.\\ @@ -668,9 +673,6 @@ W W c & Hide {\bf citation}.\\ W W C-c & Hide {\bf citation} using a more intelligent algorithm.\\ W W C & Hide cited text in articles that aren't roots.\\ - % - W e & {\bf Emphasize} article.\\ - % W H a & Highlight {\bf all} parts. Calls W b, W H c, W H h, W H s.\\ W H c & Highlight article {\bf citations}.\\ W H h & Highlight article {\bf headers}.\\ @@ -682,9 +684,9 @@ \newcommand{\MIMEArticleMode}{% {\esamepage - \begin{keys}{M-RET} + \begin{keys}{RET} RET & (BUTTON-2) Toggle display of the MIME object.\\ - v & (M-RET) Prompt for a method and then view object using this method.\\ + v & Prompt for a method and then view object using this method.\\ o & Prompt for a filename and save the MIME object.\\ C-o & Prompt for a filename to save the MIME object to and remove it.\\ c & {\bf Copy} the MIME object to a new buffer and display this buffer.\\ diff --git a/texi/message-ja.texi b/texi/message-ja.texi index a355ff7..21c7f00 100644 --- a/texi/message-ja.texi +++ b/texi/message-ja.texi @@ -705,7 +705,7 @@ MFT $B$rB:=E$9$k$3$H$ONI$$%M%A%1%C%H(B (nettiquette) $B$G$"$k$H9M$($i$l$F$$$^ @findex message-change-subject @cindex Subject $B8=:_$N(B @samp{Subject} $B%X%C%@!<$rJQ99$7$^$9!#?7$7$$(B @samp{Subject} $B$r?R$M(B -$B$F(B @code{(was: <$B8E$$BjL>(B>)} $B$rDI2C$7$^$9!#8E$$BjL>$OJV?.$9$k$H$-$K:o=|$9(B +$B$F(B @samp{(was: <$B8E$$BjL>(B>)} $B$rDI2C$7$^$9!#8E$$BjL>$OJV?.$9$k$H$-$K:o=|$9(B $B$k$3$H$,$G$-$^$9!#(B@code{message-subject-trailing-was-query} (@pxref{Message Headers}) $B$r8+$F2<$5$$!#(B @@ -923,10 +923,10 @@ message a single part tag will be used. This way, message mode will do the Right Thing (TM) with signed/encrypted multipart messages. @vindex mml-signencrypt-style-alist -By default, when encrypting a message, Gnus will use the "signencrypt" +By default, when encrypting a message, Gnus will use the ``signencrypt'' mode. If you would like to disable this for a particular message, -give the mml-secure-message-encrypt-* command a prefix argument. (for -example, C-u C-c C-m c p). Additionally, by default Gnus will +give the @code{mml-secure-message-encrypt-* command a prefix argument}. (for +example, @kbd{C-u C-c C-m c p}). Additionally, by default Gnus will separately sign, then encrypt a message which has the mode signencrypt. If you would like to change this behavior you can customize the @code{mml-signencrypt-style-alist} variable. For @@ -1423,6 +1423,13 @@ qmail-inject $B%W%m%0%i%`$KEO$90z?t$G$9!#$3$l$OJ8;zNs$N%j%9%H$G!"$=$l$>$l(B $BHs(B-@code{nil} $B$G(B sendmail $B$N%3%^%s%I9T$K(B @samp{-f username} $B$rIU2C$7$^$;(B $B$s!#$=$&$9$k$3$H$O!"IU2C$7$J$$$h$jl9g$O!"(B @@ -1481,15 +1488,18 @@ qmail-inject $B%W%m%0%i%`$KEO$90z?t$G$9!#$3$l$OJ8;zNs$N%j%9%H$G!"$=$l$>$l(B @item Message-ID @cindex Message-ID +@vindex message-user-fqdn @vindex mail-host-address +@vindex user-mail-address @findex system-name @cindex Sun +@cindex i-did-not-set--mail-host-address--so-tickle-me $B$3$NI,MW$J%X%C%@!<$O(B Message $B$K$h$j:n@.$5$l$^$9!#F|IU!";~4V!"MxMQ!"(B -$B%7%9%F%`L>$K4p$E$$$?B>$KL5$$(B ID $B$,:n@.$5$l$^$9!#(B -Message $B$O(B @code{system-name} $B$r%7%9%F%`L>$r7h$a$k$?$a$K;H$$$^$9!#$b$7$3(B -$B$l$,(B fully qualified domain name (FQDN) ($B40A4$K>r7o$rK~$?$7$?%I%a%$%s(B -$BL>(B) $B$G$J$$$J$i(B $B$P!"(BMessage $B$O(B @code{mail-host-address} $B$r(B FQDN $B$H$7$F;H(B -$B$$$^$9!#(B +$B%7%9%F%`L>$K4p$E$$$?B>$KL5$$(B ID $B$,:n@.$5$l$^$9!#%I%a%$%s$N9`$K$D$$$F$O!"(B +$BM-8z$J(B FQDN ($B40A4$K>r7o$rK~$?$7$?%I%a%$%sL>(B) $B$i$7$$$b$N$,8+$D$+$i$J$$>l(B +$B9g!"(Bmessage $B$O(B @code{message-user-fqdn}, @code{system-name}, +@code{mail-host-address} $B$*$h$S(B @code{message-user-mail-address} ($B$9$J$o(B +$B$A(B @code{user-mail-address}) $B$r(B ($B$3$N=g$G(B) $BC5$7$^$9!#(B @item User-Agent @cindex User-Agent diff --git a/texi/message.texi b/texi/message.texi index aad61a9..c387174 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -687,7 +687,7 @@ headers if necessary. @findex message-change-subject @cindex Subject Change the current @samp{Subject} header. Ask for new @samp{Subject} -header and append @code{(was: )}. The old subject can be +header and append @samp{(was: )}. The old subject can be stripped on replying, see @code{message-subject-trailing-was-query} (@pxref{Message Headers}). @@ -908,10 +908,10 @@ message a single part tag will be used. This way, message mode will do the Right Thing (TM) with signed/encrypted multipart messages. @vindex mml-signencrypt-style-alist -By default, when encrypting a message, Gnus will use the "signencrypt" +By default, when encrypting a message, Gnus will use the ``signencrypt'' mode. If you would like to disable this for a particular message, -give the mml-secure-message-encrypt-* command a prefix argument. (for -example, C-u C-c C-m c p). Additionally, by default Gnus will +give the @code{mml-secure-message-encrypt-*} command a prefix argument. (for +example, @kbd{C-u C-c C-m c p}). Additionally, by default Gnus will separately sign, then encrypt a message which has the mode signencrypt. If you would like to change this behavior you can customize the @code{mml-signencrypt-style-alist} variable. For @@ -1420,6 +1420,13 @@ might set this variable to @code{'("-f" "you@@some.where")}. Non-@code{nil} means don't add @samp{-f username} to the sendmail command line. Doing so would be even more evil than leaving it out. +@item message-sendmail-envelope-from +@vindex message-sendmail-envelope-from +When @code{message-sendmail-f-is-evil} is @code{nil}, this specifies +the address to use in the SMTP envelope. If it is @code{nil}, use +@code{user-mail-address}. If it is the symbol @code{header}, use the +@samp{From} header of the message. + @item message-mailer-swallows-blank-line @vindex message-mailer-swallows-blank-line Set this to non-@code{nil} if the system's mailer runs the header and @@ -1482,14 +1489,18 @@ This optional header will be computed by Message. @item Message-ID @cindex Message-ID +@vindex message-user-fqdn @vindex mail-host-address +@vindex user-mail-address @findex system-name @cindex Sun +@cindex i-did-not-set--mail-host-address--so-tickle-me This required header will be generated by Message. A unique ID will be -created based on the date, time, user name and system name. Message -will use @code{system-name} to determine the name of the system. If -this isn't a fully qualified domain name (FQDN), Message will use -@code{mail-host-address} as the FQDN of the machine. +created based on the date, time, user name and system name. For the +domain part, message will look (in this order) at +@code{message-user-fqdn}, @code{system-name}, @code{mail-host-address} +and @code{message-user-mail-address} (i.e. @code{user-mail-address}) +until a probably valid fully qualified domain name (FQDN) was found. @item User-Agent @cindex User-Agent -- 1.7.10.4