From: yamaoka Date: Tue, 30 Dec 2003 10:00:54 +0000 (+0000) Subject: Import Gnus v5.10.3. X-Git-Tag: gnus-5_10_3~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2081c04cfde82ce1f92ae6f5cb46454bb6fe3040;p=elisp%2Fgnus.git- Import Gnus v5.10.3. --- diff --git a/.cvsignore b/.cvsignore index cfd4873..28cbaa5 100644 --- a/.cvsignore +++ b/.cvsignore @@ -9,3 +9,5 @@ cvs-access cup-page admin oort +pgg +smilies diff --git a/ChangeLog b/ChangeLog index 847593c..d0015f1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2003-12-23 Reiner Steib + + * GNUS-NEWS: Mention change of `e' in draft groups. + 2003-05-01 Jesper Harder * etc/gnus-tut.txt (http): Update. diff --git a/GNUS-NEWS b/GNUS-NEWS index 9d08766..97aa520 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -8,6 +8,9 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** In draft groups, `e' is now bound to `gnus-draft-edit-message'. +Use `B w' for `gnus-summary-edit-article' instead. + ** The revised Gnus FAQ is included in the manual. See the info node "Frequently Asked Questions". @@ -453,6 +456,13 @@ This also obsoletes `gnus-article-hide-pgp-hook'. This change was made to avoid conflict with the standard binding of `back-to-indentation', which is also useful in message mode. +** The default for message-forward-show-mml changed to symbol best. + +The behaviour for the `best' value is to show MML (i.e., convert MIME +to MML) when appropriate. MML will not be used when forwarding signed +or encrypted messages, as the conversion invalidate the digital +signature. + ** Bug fixes. diff --git a/README b/README index bb5c232..11f90cb 100644 --- a/README +++ b/README @@ -20,6 +20,7 @@ Then you have to tell Emacs where Gnus is. You might put something like (setq load-path (cons (expand-file-name "~/gnus-5.6.53/lisp") load-path)) + (require 'gnus-load) in your .emacs file, or wherever you keep such things. diff --git a/contrib/ChangeLog b/contrib/ChangeLog index e290ca9..999d5d9 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,23 @@ +2003-11-15 Simon Josefsson + + * starttls.el: Sync with recent gnu.emacs.sources post. + +2003-10-24 Steve Youngs + + * nnir.el: Autoload `read-kbd-macro' at compile time. + +2003-09-30 Kai Grossjohann + From Torsten Hilbrich . + + * nnir.el (nnir-imap-search-field, nnir-imap-search-arguments) + (nnir-imap-search-argument-history): New variables. + (nnir-engines, nnir-run-imap): Use them. + (nnir-read-parm): Support reading the new IMAP query parameters. + +2003-06-03 Kai Gro,A_(Bjohann + + * README: Explain purpose of each file (well, most files). + 2003-05-01 Vasily Korytov * gpg.el (gpg-passphrase-forget): Check that gpg-passphrase is diff --git a/contrib/README b/contrib/README index 76d0e5c..7c3c3fc 100644 --- a/contrib/README +++ b/contrib/README @@ -1,3 +1,59 @@ -The files in this directory are not (yet) part of the -Gnus distribution proper. They may later become part -of the distribution, or they may disappear altogether. +The files in this directory are not (yet) part of the Gnus +distribution proper. They may later become part of the distribution, +or they may disappear altogether. + +Please note that it is not good to just add this directory to +load-path: a number of files in this directory will become part of +more recent Emacs versions, so that you might be running obsolete +libraries with all kinds of ill effects. + +The suggested method for installation is to copy those files that you +need to a directory which is in load-path. + +Here is an overview of the files: + +base64.el + + As of Emacs 21, base64 encoding and decoding is available + natively. So this file appears to be needed for Emacs 20 + only. + +gpg-ring.el +gpg.el + +hashcash.el + +md5.el + + MD5 encoding is part of Emacs as of Emacs 21.2. Hence, this + file is not needed for those Emacs versions. + +one-line-cookie.diff + +ssl.el + +ucs-tables.el + + This file provides improved Unicode functionality. It defines + functions unify-8859-on-encoding-mode and + unify-8859-on-decoding-mode which unify the Latin-N charsets. + Without unify-8859-on-encoding-mode, composing a Latin-9 reply + to a Latin-1 posting, say, will produce a multipart posting (a + Latin-1 part and a Latin-9 part), or perhaps UTF-8. With + unify-8859-on-encoding-mode, the outgoing posting can be all + Latin-1 or all Latin-9 in most cases. + + It is harmless to turn on unify-8859-on-encoding-mode, but + unify-8859-on-decoding-mode may unexpectedly change files in + certain situations. (If the file contains different Latin-N + charsets which should not be unified.) + + This is part of Emacs 21.3 and later, which also turns on + unify-8859-on-encoding-mode by default. + +vcard.el + +xml.el + + This is used for parsing RSS feeds. Part of Emacs 21.3 and + later. diff --git a/contrib/hashcash.el b/contrib/hashcash.el index 8a3ab4e..d130bb2 100644 --- a/contrib/hashcash.el +++ b/contrib/hashcash.el @@ -1,8 +1,8 @@ ;;; hashcash.el --- Add hashcash payments to email -;; $Revision: 1.1.1.4 $ -;; Copyright (C) 1997--2002 Paul E. Foley +;; $Revision: 1.1.1.5 $ ;; Copyright (C) 2003 Free Software Foundation +;; Copyright (C) 1997--2002 Paul E. Foley ;; Maintainer: Paul Foley ;; Keywords: mail, hashcash @@ -60,37 +60,30 @@ is used instead.") (require 'mail-utils) -(if (fboundp 'point-at-bol) - (defalias 'hashcash-point-at-bol 'point-at-bol) - (defalias 'hashcash-point-at-bol 'line-beginning-position)) +(eval-and-compile + (if (fboundp 'point-at-bol) + (defalias 'hashcash-point-at-bol 'point-at-bol) + (defalias 'hashcash-point-at-bol 'line-beginning-position)) -(if (fboundp 'point-at-eol) - (defalias 'hashcash-point-at-eol 'point-at-eol) - (defalias 'hashcash-point-at-eol 'line-end-position)) + (if (fboundp 'point-at-eol) + (defalias 'hashcash-point-at-eol 'point-at-eol) + (defalias 'hashcash-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)) - (concat (subseq addr 0 (match-beginning 1)) (subseq addr (match-end 1))) + (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr)) + (concat (match-string 1 addr) (match-string 2 addr)) addr)) (defun hashcash-payment-required (addr) "Return the hashcash payment value required for the given address." (let ((val (assoc addr hashcash-payment-alist))) - (if val - (if (cddr val) - (caddr val) - (cadr val)) - hashcash-default-payment))) + (or (nth 2 val) (nth 1 val) hashcash-default-payment))) (defun hashcash-payment-to (addr) "Return the string with which hashcash payments should collide." (let ((val (assoc addr hashcash-payment-alist))) - (if val - (if (cddr val) - (cadr val) - (car val)) - addr))) + (or (nth 1 val) (nth 0 val) addr))) (defun hashcash-generate-payment (str val) "Generate a hashcash payment by finding a VAL-bit collison on STR." @@ -99,7 +92,7 @@ is used instead.") (set-buffer (get-buffer-create " *hashcash*")) (erase-buffer) (call-process hashcash-path nil t nil - (concat "-b " (number-to-string val)) str) + "-m" "-q" "-b" (number-to-string val) str) (goto-char (point-min)) (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol))) nil)) @@ -135,17 +128,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 " - (number-to-string (hashcash-version pay)) " " - 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 (if (< (hashcash-version token) 1.2) - (cadr (split-string token ":")) - (caddr (split-string token ":"))))) + (nth 1 (split-string token ":")) + (nth 2 (split-string token ":"))))) (cond ((null resource) (let ((elt (assoc key hashcash-accept-resources))) (and elt (hashcash-check-payment token (car elt) @@ -180,7 +173,7 @@ for each recipient address. Prefix arg sets default payment temporarily." (when (and hashcash-in-news ng) (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) (when addrlist - (mapc #'hashcash-insert-payment addrlist))))) + (mapcar #'hashcash-insert-payment addrlist))))) ; mapc t) ;;;###autoload diff --git a/contrib/nnir.el b/contrib/nnir.el new file mode 100644 index 0000000..1d4eaea --- /dev/null +++ b/contrib/nnir.el @@ -0,0 +1,1559 @@ +;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*- +;; Copyright (C) 1998 Kai Großjohann + +;; Author: Kai Großjohann +;; Keywords: news, mail, searching, ir, glimpse, wais, hyrex + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; 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: + +;; The most recent version of this can always be fetched from the Gnus +;; CVS repository. See http://www.gnus.org/ for more information. + +;; This code is still in the development stage but I'd like other +;; people to have a look at it. Please do not hesitate to contact me +;; with your ideas. + +;; What does it do? Well, it allows you to index your mail using some +;; search engine (freeWAIS-sf, Glimpse and others -- see later), +;; then type `G G' in the Group buffer and issue a query to the search +;; engine. You will then get a buffer which shows all articles +;; matching the query, sorted by Retrieval Status Value (score). + +;; When looking at the retrieval result (in the Summary buffer) you +;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an +;; article. You will be teleported into the group this article came +;; from, showing the thread this article is part of. (See below for +;; restrictions.) + +;; The Lisp installation is simple: just put this file on your +;; load-path, byte-compile it, and load it from ~/.gnus or something. +;; This will install a new command `G G' in your Group buffer for +;; searching your mail. Note that you also need to configure a number +;; of variables, as described below. + +;; Restrictions: +;; +;; * If you don't use HyREX as your search engine, this expects that +;; you use nnml or another one-file-per-message backend, because the +;; others doesn't support nnfolder. +;; * It can only search the mail backend's which are supported by one +;; search engine, because of different query languages. +;; * There are restrictions to the Glimpse setup. +;; * There are restrictions to the Wais setup. +;; * There are restrictions to the imap setup. +;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before +;; limiting to the right articles. This is much too slow, of +;; course. May issue a query for number of articles to fetch; you +;; must accept the default of all articles at this point or things +;; may break. + +;; The Lisp setup involves setting a few variables and setting up the +;; search engine. You can define the variables in the server definition +;; like this : +;; (setq gnus-secondary-select-methods '( +;; (nnimap "" (nnimap-address "localhost") +;; (nnir-search-engine hyrex) +;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml")) +;; ))) +;; Or you can define the global ones. The variables set in the mailer- +;; definition will be used first. +;; The variable to set is `nnir-search-engine'. Choose one of the engines +;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, +;; type `C-h v nnir-engines RET' for more information; this includes +;; examples for setting `nnir-search-engine', too.) +;; +;; The variable nnir-mail-backend isn't used anymore. +;; + +;; You must also set up a search engine. I'll tell you about the two +;; search engines currently supported: + +;; 1. freeWAIS-sf +;; +;; As always with freeWAIS-sf, you need a so-called `format file'. I +;; use the following file: +;; +;; ,----- +;; | # Kai's format file for freeWAIS-sf for indexing mails. +;; | # Each mail is in a file, much like the MH format. +;; | +;; | # Document separator should never match -- each file is a document. +;; | record-sep: /^@this regex should never match@$/ +;; | +;; | # Searchable fields specification. +;; | +;; | region: /^[sS]ubject:/ /^[sS]ubject: */ +;; | subject "Subject header" stemming TEXT BOTH +;; | end: /^[^ \t]/ +;; | +;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */ +;; | to "To and Cc headers" SOUNDEX BOTH +;; | end: /^[^ \t]/ +;; | +;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */ +;; | from "From header" SOUNDEX BOTH +;; | end: /^[^ \t]/ +;; | +;; | region: /^$/ +;; | stemming TEXT GLOBAL +;; | end: /^@this regex should never match@$/ +;; `----- +;; +;; 1998-07-22: waisindex would dump core on me for large articles with +;; the above settings. I used /^$/ as the end regex for the global +;; field. That seemed to work okay. + +;; There is a Perl module called `WAIS.pm' which is available from +;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This +;; module comes with a nifty tool called `makedb', which I use for +;; indexing. Here's my `makedb.conf': +;; +;; ,----- +;; | # Config file for makedb +;; | +;; | # Global options +;; | waisindex = /usr/local/bin/waisindex +;; | wais_opt = -stem -t fields +;; | # `-stem' option necessary when `stemming' is specified for the +;; | # global field in the *.fmt file +;; | +;; | # Own variables +;; | homedir = /home/kai +;; | +;; | # The mail database. +;; | database = mail +;; | files = `find $homedir/Mail -name \*[0-9] -print` +;; | dbdir = $homedir/.wais +;; | limit = 100 +;; `----- +;; +;; The Lisp setup involves the `nnir-wais-*' variables. The most +;; difficult to understand variable is probably +;; `nnir-wais-remove-prefix'. Here's what it does: the output of +;; `waissearch' basically contains the file name and the (full) +;; directory name. As Gnus works with group names rather than +;; directory names, the directory name is transformed into a group +;; name as follows: first, a prefix is removed from the (full) +;; directory name, then all `/' are replaced with `.'. The variable +;; `nnir-wais-remove-prefix' should contain a regex matching exactly +;; this prefix. It defaults to `$HOME/Mail/' (note the trailing +;; slash). + +;; 2. Glimpse +;; +;; The code expects you to have one Glimpse index which contains all +;; your mail files. The Lisp setup involves setting the +;; `nnir-glimpse-*' variables. The most difficult to understand +;; variable is probably `nnir-glimpse-remove-prefix', it corresponds +;; to `nnir-wais-remove-prefix', see above. The `nnir-glimpse-home' +;; variable should be set to the value of the `-H' option which allows +;; one to search this Glimpse index. I have indexed my whole home +;; directory with Glimpse, so I assume a default of `$HOME'. + +;; 3. Namazu +;; +;; The Namazu backend requires you to have one directory containing all +;; index files, this is controlled by the `nnir-namazu-index-directory' +;; variable. To function the `nnir-namazu-remove-prefix' variable must +;; also be correct, see the documentation for `nnir-wais-remove-prefix' +;; above. +;; +;; It is particularly important not to pass any any switches to namazu +;; that will change the output format. Good switches to use include +;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu +;; documentation for further information on valid switches. +;; +;; To index my mail with the `mknmz' program I use the following +;; configuration file: +;; +;; ,---- +;; | package conf; # Don't remove this line! +;; | +;; | # Paths which will not be indexed. Don't use `^' or `$' anchors. +;; | $EXCLUDE_PATH = "spam|sent"; +;; | +;; | # Header fields which should be searchable. case-insensitive +;; | $REMAIN_HEADER = "from|date|message-id|subject"; +;; | +;; | # Searchable fields. case-insensitive +;; | $SEARCH_FIELD = "from|date|message-id|subject"; +;; | +;; | # The max length of a word. +;; | $WORD_LENG_MAX = 128; +;; | +;; | # The max length of a field. +;; | $MAX_FIELD_LENGTH = 256; +;; `---- +;; +;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and +;; ~/Mail/archive/, so to index them I go to the directory set in +;; `nnir-namazu-index-directory' and issue the following command. +;; +;; mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ +;; +;; For maximum searching efficiency I have a cron job set to run this +;; command every four hours. + +;; 4. HyREX +;; +;; The HyREX backend requires you to have one directory from where all +;; your relative paths are to, if you use them. This directory must be +;; set in the `nnir-hyrex-index-directory' variable, which defaults to +;; your home directory. You must also pass the base, class and +;; directory options or simply your dll to the `nnir-hyrex-programm' by +;; setting the `nnir-hyrex-additional-switches' variable accordently. +;; To function the `nnir-hyrex-remove-prefix' variable must also be +;; correct, see the documentation for `nnir-wais-remove-prefix' above. + +;; Developer information: + +;; I have tried to make the code expandable. Basically, it is divided +;; into two layers. The upper layer is somewhat like the `nnvirtual' +;; or `nnkiboze' backends: given a specification of what articles to +;; show from another backend, it creates a group containing exactly +;; those articles. The lower layer issues a query to a search engine +;; and produces such a specification of what articles to show from the +;; other backend. + +;; The interface between the two layers consists of the single +;; function `nnir-run-query', which just selects the appropriate +;; function for the search engine one is using. The input to +;; `nnir-run-query' is a string, representing the query as input by +;; the user. The output of `nnir-run-query' is supposed to be a +;; vector, each element of which should in turn be a three-element +;; vector. The first element should be full group name of the article, +;; the second element should be the article number, and the third +;; element should be the Retrieval Status Value (RSV) as returned from +;; the search engine. An RSV is the score assigned to the document by +;; the search engine. For Boolean search engines like Glimpse, the +;; RSV is always 1000 (or 1 or 100, or whatever you like). + +;; The sorting order of the articles in the summary buffer created by +;; nnir is based on the order of the articles in the above mentioned +;; vector, so that's where you can do the sorting you'd like. Maybe +;; it would be nice to have a way of displaying the search result +;; sorted differently? + +;; So what do you need to do when you want to add another search +;; engine? You write a function that executes the query. Temporary +;; data from the search engine can be put in `nnir-tmp-buffer'. This +;; function should return the list of articles as a vector, as +;; described above. Then, you need to register this backend in +;; `nnir-engines'. Then, users can choose the backend by setting +;; `nnir-search-engine'. + +;; Todo, or future ideas: + +;; * Make it so that Glimpse can also be called without `-F'. +;; +;; * It should be possible to restrict search to certain groups. +;; +;; * There is currently no error checking. +;; +;; * The summary buffer display is currently really ugly, with all the +;; added information in the subjects. How could I make this +;; prettier? +;; +;; * A function which can be called from an nnir summary buffer which +;; teleports you into the group the current article came from and +;; shows you the whole thread this article is part of. +;; Implementation suggestions? +;; (1998-07-24: There is now a preliminary implementation, but +;; it is much too slow and quite fragile.) +;; +;; * Support other mail backends. In particular, probably quite a few +;; people use nnfolder. How would one go about searching nnfolders +;; and producing the right data needed? The group name and the RSV +;; are simple, but what about the article number? +;; - The article number is encoded in the `X-Gnus-Article-Number' +;; header of each mail. +;; - The HyREX engine supports nnfolder. +;; +;; * Support compressed mail files. Probably, just stripping off the +;; `.gz' or `.Z' file name extension is sufficient. +;; +;; * Support a find/grep combination. +;; +;; * At least for imap, the query is performed twice. +;; + +;; Have you got other ideas? + +;;; Setup Code: + +(defconst nnir-version "$Id: nnir.el,v 1.1.1.1 2003-12-30 10:00:25 yamaoka Exp $" + "Version of NNIR.") + +(require 'cl) +(require 'nnoo) +(require 'gnus-group) +(require 'gnus-sum) +(eval-and-compile + (require 'gnus-util)) +(eval-when-compile + (require 'nnimap) + (autoload 'read-kbd-macro "edmacro" nil t)) + +(nnoo-declare nnir) +(nnoo-define-basics nnir) + +(gnus-declare-backend "nnir" 'mail) + +(defvar nnir-imap-search-field "TEXT" + "The IMAP search item when doing an nnir search") + +(defvar nnir-imap-search-arguments + '(("Whole message" . "TEXT") + ("Subject" . "SUBJECT") + ("To" . "TO") + ("From" . "FROM") + (nil . "HEADER \"%s\"")) + "Mapping from user readable strings to IMAP search items for use in nnir") + +(defvar nnir-imap-search-argument-history () + "The history for querying search options in nnir") + +;;; Developer Extension Variable: + +(defvar nnir-engines + `((glimpse nnir-run-glimpse + ((group . "Group spec: "))) + (wais nnir-run-waissearch + ()) + (excite nnir-run-excite-search + ()) + (imap nnir-run-imap + ((criteria + "Search in: " ; Prompt + ,nnir-imap-search-arguments ; alist for completing + nil ; no filtering + nil ; allow any user input + nil ; initial value + nnir-imap-search-argument-history ; the history to use + ,nnir-imap-search-field ; default + ))) + (swish++ nnir-run-swish++ + ((group . "Group spec: "))) + (swish-e nnir-run-swish-e + ((group . "Group spec: "))) + (namazu nnir-run-namazu + ()) + (hyrex nnir-run-hyrex + ((group . "Group spec: ")))) + "Alist of supported search engines. +Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). +ENGINE is a symbol designating the searching engine. FUNCTION is also +a symbol, giving the function that does the search. The third element +ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, +the FUNCTION will issue a query for each of the PARAMs, using PROMPT. + +The value of `nnir-search-engine' must be one of the ENGINE symbols. +For example, use the following line for searching using freeWAIS-sf: + (setq nnir-search-engine 'wais) +Use the following line if you read your mail via IMAP and your IMAP +server supports searching: + (setq nnir-search-engine 'imap) +Note that you have to set additional variables for most backends. For +example, the `wais' backend needs the variables `nnir-wais-program', +`nnir-wais-database' and `nnir-wais-remove-prefix'. + +Add an entry here when adding a new search engine.") + +;;; User Customizable Variables: + +(defgroup nnir nil + "Search nnmh and nnml groups in Gnus with Glimpse, freeWAIS-sf, or EWS.") + +;; Mail backend. + +;; TODO: +;; If `nil', use server parameters to find out which server to search. CCC +;; +(defcustom nnir-mail-backend '(nnml "") + "*Specifies which backend should be searched. +More precisely, this is used to determine from which backend to fetch the +messages found. + +This must be equal to an existing server, so maybe it is best to use +something like the following: + (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods)) +The above line works fine if the mail backend you want to search is +the first element of gnus-secondary-select-methods (`nth' starts counting +at zero)." + :type '(sexp) + :group 'nnir) + +;; Search engine to use. + +(defcustom nnir-search-engine 'wais + "*The search engine to use. Must be a symbol. +See `nnir-engines' for a list of supported engines, and for example +settings of `nnir-search-engine'." + :type '(sexp) + :group 'nnir) + +;; Glimpse engine. + +(defcustom nnir-glimpse-program "glimpse" + "*Name of Glimpse executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-glimpse-home (getenv "HOME") + "*Value of `-H' glimpse option. +`~' and environment variables must be expanded, see the functions +`expand-file-name' and `substitute-in-file-name'." + :type '(directory) + :group 'nnir) + +(defcustom nnir-glimpse-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by Glimpse +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +For example, suppose that Glimpse returns file names such as +\"/home/john/Mail/mail/misc/42\". For this example, use the following +setting: (setq nnir-glimpse-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." + :type '(regexp) + :group 'nnir) + +(defcustom nnir-glimpse-additional-switches '("-i") + "*A list of strings, to be given as additional arguments to glimpse. +The switches `-H', `-W', `-l' and `-y' are always used -- calling +glimpse without them does not make sense in our situation. +Suggested elements to put here are `-i' and `-w'. + +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-glimpse-additional-switches \"-i -w\") ; wrong! +Instead, use this: + (setq nnir-glimpse-additional-switches '(\"-i\" \"-w\"))" + :type '(repeat (string)) + :group 'nnir) + +;; freeWAIS-sf. + +(defcustom nnir-wais-program "waissearch" + "*Name of waissearch executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-wais-database (expand-file-name "~/.wais/mail") + "*Name of Wais database containing the mail. + +Note that this should be a file name without extension. For example, +if you have a file /home/john/.wais/mail.fmt, use this: + (setq nnir-wais-database \"/home/john/.wais/mail\") +The string given here is passed to `waissearch -d' as-is." + :type '(file) + :group 'nnir) + +(defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each directory name returned by waissearch +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +This variable is similar to `nnir-glimpse-remove-prefix', only for Wais, +not Glimpse." + :type '(regexp) + :group 'nnir) + +;; EWS (Excite for Web Servers) engine. + +(defcustom nnir-excite-aquery-program "aquery.pl" + "*Name of the EWS query program. Should be `aquery.pl' or a path to same." + :type '(string) + :group 'nnir) + +(defcustom nnir-excite-collection "Mail" + "*Name of the EWS collection to search." + :type '(string) + :group 'nnir) + +(defcustom nnir-excite-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by EWS +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +This variable is very similar to `nnir-glimpse-remove-prefix', except +that it is for EWS, not Glimpse." + :type '(regexp) + :group 'nnir) + +;; Swish++. Next three variables Copyright (C) 2000, 2001 Christoph +;; Conrad . +;; Swish++ home page: http://homepage.mac.com/pauljlucas/software/swish/ + +(defcustom nnir-swish++-configuration-file + (expand-file-name "~/Mail/swish++.conf") + "*Configuration file for swish++." + :type '(file) + :group 'nnir) + +(defcustom nnir-swish++-program "search" + "*Name of swish++ search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-swish++-additional-switches '() + "*A list of strings, to be given as additional arguments to swish++. + +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-swish++-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by swish++ +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +This variable is very similar to `nnir-glimpse-remove-prefix', except +that it is for swish++, not Glimpse." + :type '(regexp) + :group 'nnir) + +;; Swish-E. Next three variables Copyright (C) 2000 Christoph Conrad +;; . +;; URL: http://sunsite.berkeley.edu/SWISH-E/ +;; New version: http://www.boe.es/swish-e + +(defcustom nnir-swish-e-index-file + (expand-file-name "~/Mail/index.swish-e") + "*Index file for swish-e. +This could be a server parameter." + :type '(file) + :group 'nnir) + +(defcustom nnir-swish-e-program "swish-e" + "*Name of swish-e search executable. +This cannot be a server parameter." + :type '(string) + :group 'nnir) + +(defcustom nnir-swish-e-additional-switches '() + "*A list of strings, to be given as additional arguments to swish-e. + +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\")) + +This could be a server parameter." + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by swish-e +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +This variable is very similar to `nnir-glimpse-remove-prefix', except +that it is for swish-e, not Glimpse. + +This could be a server parameter." + :type '(regexp) + :group 'nnir) + +;; HyREX engine, see + +(defcustom nnir-hyrex-program "nnir-search" + "*Name of the nnir-search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-hyrex-additional-switches '() + "*A list of strings, to be given as additional arguments for nnir-search. +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! +Instead, use this: + (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-hyrex-index-directory (getenv "HOME") + "*Index directory for HyREX." + :type '(directory) + :group 'nnir) + +(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by HyREX +in order to get a group name (albeit with / instead of .). + +For example, suppose that HyREX returns file names such as +\"/home/john/Mail/mail/misc/42\". For this example, use the following +setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." + :type '(directory) + :group 'nnir) + +;; Namazu engine, see + +(defcustom nnir-namazu-program "namazu" + "*Name of Namazu search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") + "*Index directory for Namazu." + :type '(directory) + :group 'nnir) + +(defcustom nnir-namazu-additional-switches '() + "*A list of strings, to be given as additional arguments to namazu. +The switches `-q', `-a', and `-s' are always used, very few other switches +make any sense in this context. + +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-namazu-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by Namazu +in order to get a group name (albeit with / instead of .). + +This variable is very similar to `nnir-glimpse-remove-prefix', except +that it is for Namazu, not Glimpse." + :type '(directory) + :group 'nnir) + +;;; Internal Variables: + +(defvar nnir-current-query nil + "Internal: stores current query (= group name).") + +(defvar nnir-current-server nil + "Internal: stores current server (does it ever change?).") + +(defvar nnir-current-group-marked nil + "Internal: stores current list of process-marked groups.") + +(defvar nnir-artlist nil + "Internal: stores search result.") + +(defvar nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + +;;; Code: + +;; Gnus glue. + +(defun gnus-group-make-nnir-group (extra-parms query) + "Create an nnir group. Asks for query." + (interactive "P\nsQuery: ") + (setq nnir-current-query nil + nnir-current-server nil + nnir-current-group-marked nil + nnir-artlist nil) + (let ((parms nil)) + (if extra-parms + (setq parms (nnir-read-parms query)) + (setq parms (list (cons 'query query)))) + (gnus-group-read-ephemeral-group + (concat "nnir:" (prin1-to-string parms)) '(nnir "") t + (cons (current-buffer) + gnus-current-window-configuration) + nil))) + +;; Emacs 19 compatibility? +(or (fboundp 'kbd) (defalias 'kbd 'read-kbd-macro)) + +(defun nnir-group-mode-hook () + (define-key gnus-group-mode-map + (if (fboundp 'read-kbd-macro) + (kbd "G G") + "GG") ; XEmacs 19 compat + 'gnus-group-make-nnir-group)) +(add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) + + + +;; Summary mode commands. + +(defun gnus-summary-nnir-goto-thread () + "Only applies to nnir groups. Go to group this article came from +and show thread that contains this article." + (interactive) + (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name))) + (error "Can't execute this command unless in nnir group.")) + (let* ((cur (gnus-summary-article-number)) + (group (nnir-artlist-artitem-group nnir-artlist cur)) + (backend-number (nnir-artlist-artitem-number nnir-artlist cur)) + server backend-group) + (setq server (nnir-group-server group)) + (setq backend-group (gnus-group-real-name group)) + (gnus-group-read-ephemeral-group + backend-group + (gnus-server-to-method server) + t ; activate + (cons (current-buffer) + 'summary) ; window config + nil + (list backend-number)) + (gnus-summary-limit (list backend-number)) + (gnus-summary-refer-thread))) + +(if (fboundp 'eval-after-load) + (eval-after-load "gnus-sum" + '(define-key gnus-summary-goto-map + "T" 'gnus-summary-nnir-goto-thread)) + (add-hook 'gnus-summary-mode-hook + (function (lambda () + (define-key gnus-summary-goto-map + "T" 'gnus-summary-nnir-goto-thread))))) + + + +;; Gnus backend interface functions. + +(deffoo nnir-open-server (server &optional definitions) + ;; Just set the server variables appropriately. + (nnoo-change-server 'nnir server definitions)) + +(deffoo nnir-request-group (group &optional server fast) + "GROUP is the query string." + (nnir-possibly-change-server server) + ;; Check for cache and return that if appropriate. + (if (and (equal group nnir-current-query) + (equal gnus-group-marked nnir-current-group-marked) + (or (null server) + (equal server nnir-current-server))) + nnir-artlist + ;; Cache miss. + (setq nnir-artlist (nnir-run-query group))) + (save-excursion + (set-buffer nntp-server-buffer) + (if (zerop (length nnir-artlist)) + (progn + (setq nnir-current-query nil + nnir-current-server nil + nnir-current-group-marked nil + nnir-artlist nil) + (nnheader-report 'nnir "Search produced empty results.")) + ;; Remember data for cache. + (setq nnir-current-query group) + (when server (setq nnir-current-server server)) + (setq nnir-current-group-marked gnus-group-marked) + (nnheader-insert "211 %d %d %d %s\n" + (nnir-artlist-length nnir-artlist) ; total # + 1 ; first # + (nnir-artlist-length nnir-artlist) ; last # + group)))) ; group name + +(deffoo nnir-retrieve-headers (articles &optional group server fetch-old) + (save-excursion + (let ((artlist (copy-sequence articles)) + (idx 1) + (art nil) + (artitem nil) + (artgroup nil) (artno nil) + (artrsv nil) + (artfullgroup nil) + (novitem nil) + (novdata nil) + (foo nil) + server) + (while (not (null artlist)) + (setq art (car artlist)) + (or (numberp art) + (nnheader-report + 'nnir + "nnir-retrieve-headers doesn't grok message ids: %s" + art)) + (setq artitem (nnir-artlist-article nnir-artlist art)) + (setq artrsv (nnir-artitem-rsv artitem)) + (setq artfullgroup (nnir-artitem-group artitem)) + (setq artno (nnir-artitem-number artitem)) + (setq artgroup (gnus-group-real-name artfullgroup)) + (setq server (nnir-group-server artfullgroup)) + ;; retrieve NOV or HEAD data for this article, transform into + ;; NOV data and prepend to `novdata' + (set-buffer nntp-server-buffer) + (nnir-possibly-change-server server) + (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) + (nov + (goto-char (point-min)) + (setq novitem (nnheader-parse-nov)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-nov returned nil for article %s in group %s" + artno artfullgroup))) + (headers + (goto-char (point-min)) + (setq novitem (nnheader-parse-head)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-head returned nil for article %s in group %s" + artno artfullgroup))) + (t (nnheader-report 'nnir "Don't support header type %s." foo))) + ;; replace article number in original group with article number + ;; in nnir group + (mail-header-set-number novitem idx) + (mail-header-set-from novitem + (mail-header-from novitem)) + (mail-header-set-subject + novitem + (format "[%d: %s/%d] %s" + artrsv artgroup artno + (mail-header-subject novitem))) + ;;-(mail-header-set-extra novitem nil) + (push novitem novdata) + (setq artlist (cdr artlist)) + (setq idx (1+ idx))) + (setq novdata (nreverse novdata)) + (set-buffer nntp-server-buffer) (erase-buffer) + (mapcar 'nnheader-insert-nov novdata) + 'nov))) + +(deffoo nnir-request-article (article + &optional group server to-buffer) + (save-excursion + (let* ((artitem (nnir-artlist-article nnir-artlist + article)) + (artfullgroup (nnir-artitem-group artitem)) + (artno (nnir-artitem-number artitem)) + ;; Bug? + ;; Why must we bind nntp-server-buffer here? It won't + ;; work if `buf' is used, say. (Of course, the set-buffer + ;; line below must then be updated, too.) + (nntp-server-buffer (or to-buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (message "Requesting article %d from group %s" + artno artfullgroup) + (gnus-request-article artno artfullgroup nntp-server-buffer) + (cons artfullgroup artno)))) + + +(nnoo-define-skeleton nnir) + +;;; Search Engine Interfaces: + +;; Glimpse interface. +(defun nnir-run-glimpse (query server &optional group) + "Run given query against glimpse. Returns a vector of (group name, file name) +pairs (also vectors, actually)." + (save-excursion + (let ((artlist nil) + (groupspec (cdr (assq 'group query))) + (qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-glimps-remove-prefix server)) + artno dirnam) + (when (and group groupspec) + (error (concat "It does not make sense to use a group spec" + " with process-marked groups."))) + (when group + (setq groupspec (gnus-group-real-name group))) + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (if groupspec + (message "Doing glimpse query %s on %s..." query groupspec) + (message "Doing glimpse query %s..." query)) + (let* ((cp-list + `( ,nnir-glimpse-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-H" ,(nnir-read-server-parm 'nnir-glimpse-home server) ; search home dir + "-W" ; match pattern in file + "-l" "-y" ; misc options + ,@(nnir-read-server-parm 'nnir-glimpse-additional-switches server) + "-F" ,prefix ; restrict output to mail + ,qstring ; the query, in glimpse format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-glimpse-program + (mapconcat 'identity (cddddr cp-list) " ")) + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run glimpse: %s" exitstatus) + ;; Glimpse failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + (when groupspec + (keep-lines groupspec)) + (if groupspec + (message "Doing glimpse query %s on %s...done" query groupspec) + (message "Doing glimpse query %s...done" query)) + (sit-for 0) + ;; remove superfluous stuff from glimpse output + (goto-char (point-min)) + (delete-non-matching-lines "/[0-9]+$") + ;;(delete-matching-lines "\\.overview~?$") + (goto-char (point-min)) + (while (re-search-forward (concat "^" prefix "\\(.+\\)" "/\\([0-9]\\)+$") nil t) + ;; replace / with . in group names + (setq dirnam (substitute ?. ?/ (match-string 1)) + artno (match-string 2)) + (push (vector (nnir-group-full-name dirnam server) + (string-to-int artno)) artlist)) + + (sort* artlist + (function (lambda (x y) + (if (string-lessp (nnir-artitem-group x) + (nnir-artitem-group y)) + t + (< (nnir-artitem-number x) + (nnir-artitem-number y)))))) + ))) + +;; freeWAIS-sf interface. +(defun nnir-run-waissearch (query server &optional group) + "Run given query agains waissearch. Returns vector of (group name, file name) +pairs (also vectors, actually)." + (when group + (error "The freeWAIS-sf backend cannot search specific groups.")) + (save-excursion + (let ((qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) + (artlist nil) + (score nil) (artno nil) (dirnam nil) (group nil)) + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (message "Doing WAIS query %s..." query) + (call-process nnir-wais-program + nil ; input from /dev/null + t ; output to current buffer + nil ; don't redisplay + "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search + qstring) + (message "Massaging waissearch output...") + ;; remove superfluous lines + (keep-lines "Score:") + ;; extract data from result lines + (goto-char (point-min)) + (while (re-search-forward + "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t) + (setq score (match-string 1) + artno (match-string 2) + dirnam (match-string 3)) + (unless (string-match prefix dirnam) + (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" + dirnam prefix)) + (setq group (substitute ?. ?/ (replace-match "" t t dirnam))) + (push (vector (nnir-group-full-name group server) + (string-to-int artno) + (string-to-int score)) + artlist)) + (message "Massaging waissearch output...done") + (apply 'vector + (sort* artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +;; EWS (Excite for Web Servers) interface +(defun nnir-run-excite-search (query server &optional group) + "Run a given query against EWS. Returns vector of (group name, file name) +pairs (also vectors, actually)." + (when group + (error "Searching specific groups not implemented for EWS.")) + (save-excursion + (let ((qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-excite-remove-prefix server)) + artlist group article-num article) + (setq nnir-current-query query) + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (message "Doing EWS query %s..." qstring) + (call-process nnir-excite-aquery-program + nil ; input from /dev/null + t ; output to current buffer + nil ; don't redisplay + (nnir-read-server-parm 'nnir-excite-collection server) + (if (string= (substring qstring 0 1) "(") + qstring + (format "(concept %s)" qstring))) + (message "Gathering query output...") + + (goto-char (point-min)) + (while (re-search-forward + "^[0-9]+\\s-[0-9]+\\s-[0-9]+\\s-\\(\\S-*\\)" nil t) + (setq article (match-string 1)) + (unless (string-match + (concat "^" (regexp-quote prefix) + "\\(.*\\)/\\([0-9]+\\)") article) + (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" + article prefix)) + (setq group (substitute ?. ?/ (match-string 1 article))) + (setq group (nnir-group-full-name group server)) + (setq article-num (match-string 2 article)) + (setq artlist (vconcat artlist (vector (vector group + (string-to-int article-num) + 1000))))) + (message "Gathering query output...done") + artlist))) + +;; IMAP interface. The following function is Copyright (C) 1998 Simon +;; Josefsson . +;; todo: +;; nnir invokes this two (2) times???! +;; we should not use nnimap at all but open our own server connection +;; we should not LIST * but use nnimap-list-pattern from defs +;; send queries as literals +;; handle errors + +(defun nnir-run-imap (query srv &optional group-option) + (require 'imap) + (require 'nnimap) + (save-excursion + (let ((qstring (cdr (assq 'query query))) + (server (cadr (gnus-server-to-method srv))) + (group (or group-option (gnus-group-group-name))) + (defs (caddr (gnus-server-to-method srv))) + (criteria (or (cdr (assq 'criteria query)) + nnir-imap-search-field)) + artlist buf) + (message "Opening server %s" server) + (condition-case () + (when (nnimap-open-server server defs) ;; xxx + (setq buf nnimap-server-buffer) ;; xxx + (message "Searching %s..." group) + (let ((arts 0) + (mbx (gnus-group-real-name group))) + (when (imap-mailbox-select mbx nil buf) + (mapcar + (lambda (artnum) + (push (vector group artnum 1) artlist) + (setq arts (1+ arts))) + (imap-search (concat criteria " \"" qstring "\"") buf)) + (message "Searching %s... %d matches" mbx arts))) + (message "Searching %s...done" group)) + (quit nil)) + (reverse artlist)))) + +;; Swish++ interface. The following function is Copyright (C) 2000, +;; 2001 Christoph Conrad . +;; -cc- Todo +;; Search by +;; - group +;; Sort by +;; - rank (default) +;; - article number +;; - file size +;; - group +(defun nnir-run-swish++ (query server &optional group) + "Run given query against swish++. +Returns a vector of (group name, file name) pairs (also vectors, +actually). + +Tested with swish++ 4.7 on GNU/Linux and with with swish++ 5.0b2 on +Windows NT 4.0." + + (when group + (error "The swish++ backend cannot search specific groups.")) + + (save-excursion + (let ( (qstring (cdr (assq 'query query))) + (groupspec (cdr (assq 'group query))) + (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) + (artlist nil) + (score nil) (artno nil) (dirnam nil) (group nil) ) + + (when (equal "" qstring) + (error "swish++: You didn't enter anything.")) + + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (if groupspec + (message "Doing swish++ query %s on %s..." qstring groupspec) + (message "Doing swish++ query %s..." qstring)) + + (let* ((cp-list `( ,nnir-swish++-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server) + ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server) + ,qstring ; the query, in swish++ format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-swish++-program + (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) + ;; swish++ failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; V 4.7 Linux + ;; rank relative-path-name file-size file-title + ;; V 5.0b2: + ;; rank relative-path-name file-size topic?? + ;; where rank is an integer from 1 to 100. + (goto-char (point-min)) + (while (re-search-forward + "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t) + (setq score (match-string 1) + artno (file-name-nondirectory (match-string 2)) + dirnam (file-name-directory (match-string 2))) + + ;; don't match directories + (when (string-match "^[0-9]+$" artno) + (when (not (null dirnam)) + + ;; maybe limit results to matching groups. + (when (or (not groupspec) + (string-match groupspec dirnam)) + + ;; remove nnir-swish++-remove-prefix from beginning of dirname + (when (string-match (concat "^" prefix) + dirnam) + (setq dirnam (replace-match "" t t dirnam))) + + (setq dirnam (substring dirnam 0 -1)) + ;; eliminate all ".", "/", "\" from beginning. Always matches. + (string-match "^[./\\]*\\(.*\\)$" dirnam) + ;; "/" -> "." + (setq group (substitute ?. ?/ (match-string 1 dirnam))) + ;; "\\" -> "." + (setq group (substitute ?. ?\\ group)) + + (push (vector (nnir-group-full-name group server) + (string-to-int artno) + (string-to-int score)) + artlist))))) + + (message "Massaging swish++ output...done") + + ;; Sort by score + (apply 'vector + (sort* artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +;; Swish-E interface. The following function is Copyright (C) 2000, +;; 2001 by Christoph Conrad . +(defun nnir-run-swish-e (query server &optional group) + "Run given query against swish-e. +Returns a vector of (group name, file name) pairs (also vectors, +actually). + +Tested with swish-e-2.0.1 on Windows NT 4.0." + + ;; swish-e crashes with empty parameter to "-w" on commandline... + (when group + (error "The swish-e backend cannot search specific groups.")) + + (save-excursion + (let ((qstring (cdr (assq 'query query))) + (prefix + (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server) + (error "Missing parameter `nnir-swish-e-remove-prefix'"))) + (artlist nil) + (score nil) (artno nil) (dirnam nil) (group nil) ) + + (when (equal "" qstring) + (error "swish-e: You didn't enter anything.")) + + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (message "Doing swish-e query %s..." query) + (let* ((index-file + (or (nnir-read-server-parm + 'nnir-swish-e-index-file server) + (error "Missing parameter `nnir-swish-e-index-file'"))) + (additional-switches + (nnir-read-server-parm + 'nnir-swish++-additional-switches server)) + (cp-list `(,nnir-swish-e-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-f" ,index-file + ,@additional-switches + "-w" + ,qstring ; the query, in swish-e format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-swish-e-program + (mapconcat 'identity (cddddr cp-list) " ")) + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) + ;; swish-e failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; rank path-name file-title file-size + (goto-char (point-min)) + (while (re-search-forward + "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t) + (setq score (match-string 1) + artno (match-string 3) + dirnam (file-name-directory (match-string 2))) + + ;; don't match directories + (when (string-match "^[0-9]+$" artno) + (when (not (null dirnam)) + + ;; remove nnir-swish-e-remove-prefix from beginning of dirname + (when (string-match (concat "^" prefix) dirnam) + (setq dirnam (replace-match "" t t dirnam))) + + (setq dirnam (substring dirnam 0 -1)) + ;; eliminate all ".", "/", "\" from beginning. Always matches. + (string-match "^[./\\]*\\(.*\\)$" dirnam) + ;; "/" -> "." + (setq group (substitute ?. ?/ (match-string 1 dirnam))) + ;; Windows "\\" -> "." + (setq group (substitute ?. ?\\ group)) + + (push (vector (nnir-group-full-name group server) + (string-to-int artno) + (string-to-int score)) + artlist)))) + + (message "Massaging swish-e output...done") + + ;; Sort by score + (apply 'vector + (sort* artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +;; HyREX interface +(defun nnir-run-hyrex (query server &optional group) + (save-excursion + (let ((artlist nil) + (groupspec (cdr (assq 'group query))) + (qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) + score artno dirnam) + (when (and group groupspec) + (error (concat "It does not make sense to use a group spec" + " with process-marked groups."))) + (when group + (setq groupspec (gnus-group-real-name group))) + (when (and group (not (equal group (nnir-group-full-name groupspec server)))) + (message "%s vs. %s" group (nnir-group-full-name groupspec server)) + (error "Server with groupspec doesn't match group !")) + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (if groupspec + (message "Doing hyrex-search query %s on %s..." query groupspec) + (message "Doing hyrex-search query %s..." query)) + (let* ((cp-list + `( ,nnir-hyrex-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory + ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server) + ,qstring ; the query, in hyrex-search format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-hyrex-program + (mapconcat 'identity (cddddr cp-list) " ")) + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) + ;; nnir-search failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! + (if groupspec + (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec) + (message "Doing hyrex-search query \"%s\"...done" qstring)) + (sit-for 0) + ;; nnir-search returns: + ;; for nnml/nnfolder: "filename mailid weigth" + ;; for nnimap: "group mailid weigth" + (goto-char (point-min)) + (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") + ;; HyREX couldn't search directly in groups -- so filter out here. + (when groupspec + (keep-lines groupspec)) + ;; extract data from result lines + (goto-char (point-min)) + (while (re-search-forward + "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t) + (setq dirnam (match-string 1) + artno (match-string 2) + score (match-string 3)) + (when (string-match prefix dirnam) + (setq dirnam (replace-match "" t t dirnam))) + (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server) + (string-to-int artno) + (string-to-int score)) + artlist)) + (message "Massaging hyrex-search output...done.") + (apply 'vector + (sort* artlist + (function (lambda (x y) + (if (string-lessp (nnir-artitem-group x) + (nnir-artitem-group y)) + t + (< (nnir-artitem-number x) + (nnir-artitem-number y))))))) + ))) + +;; Namazu interface +(defun nnir-run-namazu (query server &optional group) + "Run given query against Namazu. Returns a vector of (group name, file name) +pairs (also vectors, actually). + +Tested with Namazu 2.0.6 on a GNU/Linux system." + (when group + (error "The Namazu backend cannot search specific groups")) + (save-excursion + (let ( + (artlist nil) + (qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server)) + (score nil) + (group nil) + (article nil) + (process-environment (copy-sequence process-environment)) + ) + (setenv "LC_MESSAGES" "C") + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (let* ((cp-list + `( ,nnir-namazu-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-q" ; don't be verbose + "-a" ; show all matches + "-s" ; use short format + ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server) + ,qstring ; the query, in namazu format + ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory + )) + (exitstatus + (progn + (message "%s args: %s" nnir-namazu-program + (mapconcat 'identity (cddddr cp-list) " ")) + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) + ;; Namazu failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; Namazu output looks something like this: + ;; 2. Re: Gnus agent expire broken (score: 55) + ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes) + + (goto-char (point-min)) + (while (re-search-forward + "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" + nil t) + (setq score (match-string 3) + group (file-name-directory (match-string 4)) + article (file-name-nondirectory (match-string 4))) + + ;; make sure article and group is sane + (when (and (string-match "^[0-9]+$" article) + (not (null group))) + (when (string-match (concat "^" prefix) group) + (setq group (replace-match "" t t group))) + + ;; remove trailing slash from groupname + (setq group (substring group 0 -1)) + + ;; stuff results into artlist vector + (push (vector (nnir-group-full-name (substitute ?. ?/ group) server) + (string-to-int article) + (string-to-int score)) artlist))) + + ;; sort artlist by score + (apply 'vector + (sort* artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +;;; Util Code: + +(defun nnir-read-parms (query) + "Reads additional search parameters according to `nnir-engines'." + (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) + (cons (cons 'query query) + (mapcar 'nnir-read-parm parmspec)))) + +(defun nnir-read-parm (parmspec) + "Reads a single search parameter. +`parmspec' is a cons cell, the car is a symbol, the cdr is a prompt." + (let ((sym (car parmspec)) + (prompt (cdr parmspec))) + (if (listp prompt) + (let* ((result (apply 'completing-read prompt)) + (mapping (or (assoc result nnir-imap-search-arguments) + (assoc nil nnir-imap-search-arguments)))) + (cons sym (format (cdr mapping) result))) + (cons sym (read-string prompt))))) + +(defun nnir-run-query (query) + "Invoke appropriate search engine function (see `nnir-engines'). +If some groups were process-marked, run the query for each of the groups +and concat the results." + (let ((q (car (read-from-string query)))) + (if gnus-group-marked + (apply 'vconcat + (mapcar (lambda (x) + (let ((server (nnir-group-server x)) + search-func) + (setq search-func (cadr + (assoc + (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) + (if search-func + (funcall search-func q server x) + nil))) + gnus-group-marked) + ) + (apply 'vconcat + (mapcar (lambda (x) + (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) + (let ((server (format "%s:%s" (caar x) (cadar x))) + search-func) + (setq search-func (cadr + (assoc + (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) + (if search-func + (funcall search-func q server nil) + nil)) + nil)) + gnus-opened-servers) + )) + )) + +(defun nnir-read-server-parm (key server) + "Returns the parameter value of for the given server, where server is of +form 'backend:name'." + (let ((method (gnus-server-to-method server))) + (cond ((and method (assq key (cddr method))) + (nth 1 (assq key (cddr method)))) + ((and nnir-mail-backend + (gnus-method-equal method nnir-mail-backend)) + (symbol-value key)) + ((null nnir-mail-backend) + (symbol-value key)) + (t nil)))) +;; (if method +;; (if (assq key (cddr method)) +;; (nth 1 (assq key (cddr method))) +;; (symbol-value key)) +;; (symbol-value key)) +;; )) + +(defmacro nnir-group-server (group) + "Returns the server for a foreign newsgroup in the format as gnus-server-to-method needs it. Compare to gnus-group-real-prefix and gnus-group-real-name." + `(let ((gname ,group)) + (if (string-match "^\\([^:]+\\):" gname) + (setq gname (match-string 1 gname)) + nil) + (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname) + (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) + (concat gname ":")) + )) + +(defun nnir-group-full-name (shortname server) + "For the given group name, return a full Gnus group name. +The Gnus backend/server information is added." + (gnus-group-prefixed-name shortname (gnus-server-to-method server))) + +(defun nnir-possibly-change-server (server) + (unless (and server (nnir-server-opened server)) + (nnir-open-server server))) + + +;; Data type article list. + +(defun nnir-artlist-length (artlist) + "Returns number of articles in artlist." + (length artlist)) + +(defun nnir-artlist-article (artlist n) + "Returns from ARTLIST the Nth artitem (counting starting at 1)." + (elt artlist (1- n))) + +(defun nnir-artitem-group (artitem) + "Returns the group from the ARTITEM." + (elt artitem 0)) + +(defun nnir-artlist-artitem-group (artlist n) + "Returns from ARTLIST the group of the Nth artitem (counting from 1)." + (nnir-artitem-group (nnir-artlist-article artlist n))) + +(defun nnir-artitem-number (artitem) + "Returns the number from the ARTITEM." + (elt artitem 1)) + +(defun nnir-artlist-artitem-number (artlist n) + "Returns from ARTLIST the number of the Nth artitem (counting from 1)." + (nnir-artitem-number (nnir-artlist-article artlist n))) + +(defun nnir-artitem-rsv (artitem) + "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." + (elt artitem 2)) + +(defun nnir-artlist-artitem-rsv (artlist n) + "Returns from ARTLIST the Retrieval Status Value of the Nth artitem +(counting from 1)." + (nnir-artitem-rsv (nnir-artlist-article artlist n))) + +;; unused? +(defun nnir-artlist-groups (artlist) + "Returns a list of all groups in the given ARTLIST." + (let ((res nil) + (with-dups nil)) + ;; from each artitem, extract group component + (setq with-dups (mapcar 'nnir-artitem-group artlist)) + ;; remove duplicates from above + (mapcar (function (lambda (x) (add-to-list 'res x))) + with-dups) + res)) + + +;; The end. +(provide 'nnir) diff --git a/contrib/starttls.el b/contrib/starttls.el new file mode 100644 index 0000000..95db27f --- /dev/null +++ b/contrib/starttls.el @@ -0,0 +1,227 @@ +;;; starttls.el --- STARTTLS support via wrapper around GNU TLS + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: comm, tls, gnutls, ssl + +;; 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 implements a simple wrapper around the GNU TLS command +;; line application "gnutls-cli" to make Emacs support STARTTLS. It +;; is backwards compatible (same API functions) with the "starttls.el" +;; that is part of Emacs 21 written by Daiki Ueno . +;; (That version used an external program "starttls" that isn't widely +;; installed, and was based on OpenSSL.) + +;; This package require GNUTLS 0.9.90 (released 2003-10-08) or later. + +;; Usage is similar to `open-network-stream'. Evaluating the following: +;; +;; (progn +;; (setq tmp (open-starttls-stream "test" (current-buffer) "mail.example.com" 143)) +;; (process-send-string tmp ". starttls\n") +;; (sit-for 4) +;; (message "STARTTLS output:\n%s" (negotiate-starttls tmp)) +;; (process-send-string tmp ". capability\n")) +;; +;; in, e.g., the *scratch* buffer, yields the following output: +;; +;; * OK imap.example.com Cyrus IMAP4 v2.1.15 server ready +;; . OK Begin TLS negotiation now +;; * CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA ... +;; . OK Completed +;; nil +;; +;; And the message buffer contains: +;; +;; STARTTLS output: +;; *** Starting TLS handshake +;; - Server's trusted authorities: +;; [0]: O=Sendmail,OU=Sendmail Server,CN=imap.example.com,EMAIL=admin@imap.example.com +;; - Certificate type: X.509 +;; - Got a certificate list of 1 certificates. +;; +;; - Certificate[0] info: +;; # The hostname in the certificate matches 'imap.example.com'. +;; # valid since: Wed Aug 28 12:47:00 CEST 2002 +;; # expires at: Thu Aug 28 12:47:00 CEST 2003 +;; # serial number: 00 +;; # fingerprint: 06 3f 25 cb 44 aa 5c 1e 79 d7 63 86 f8 b1 9a cf +;; # version: #3 +;; # public key algorithm: RSA +;; # Modulus: 1024 bits +;; # Subject's DN: O=Sendmail,OU=Sendmail Server,CN=imap.example.com,EMAIL=admin@imap.example.com +;; # Issuer's DN: O=Sendmail,OU=Sendmail Server,CN=imap.example.com,EMAIL=admin@imap.example.com +;; +;; +;; - Peer's certificate issuer is unknown +;; - Peer's certificate is NOT trusted +;; - Version: TLS 1.0 +;; - Key Exchange: RSA +;; - Cipher: ARCFOUR 128 +;; - MAC: SHA +;; - Compression: NULL + +;; Revision history: +;; +;; 2003-09-20: Added to Gnus CVS. +;; 2003-10-02: Minor fixes. +;; 2003-11-15: Cleanup, and posted to gnu.emacs.sources. +;; 2003-11-28: Fixes variable name conflicts, various other fixes, posted g.e.s. + +;;; Code: + +(defgroup starttls nil + "Negotiated Transport Layer Security (STARTTLS) parameters." + :group 'comm) + +(defcustom starttls-file-name "gnutls-cli" + "Name of the program to run in a subprocess to open an STARTTLS connection. +The program should read input on stdin, write output to stdout, +and initiate TLS negotiation when receiving the SIGALRM signal. +Also see `starttls-connect', `starttls-failure', and +`starttls-success' for what the program should output after +initial connection and successful negotiation respectively." + :type 'string + :group 'starttls) + +(defcustom starttls-extra-arguments nil + "List of extra arguments to `starttls-file-name'. +E.g., (\"--protocols\" \"ssl3\")." + :type '(repeat string) + :group 'starttls) + +(defcustom starttls-process-connection-type nil + "*Value for `process-connection-type' to use when starting STARTTLS process." + :type 'boolean + :group 'starttls) + +(defcustom starttls-connect "- Simple Client Mode:\n\n" + "*Regular expression indicating successful connection. +The default is what GNUTLS's \"gnutls-cli\" outputs." + ;; GNUTLS cli.c:main() print this string when it is starting to run + ;; in the application read/write phase. If the logic, or the string + ;; itself, is modified, this must be updated. + :type 'regexp + :group 'starttls) + +(defcustom starttls-failure "*** Handshake has failed" + "*Regular expression indicating failed TLS handshake. +The default is what GNUTLS's \"gnutls-cli\" outputs." + ;; GNUTLS cli.c:do_handshake() print this string on failure. If the + ;; logic, or the string itself, is modified, this must be updated. + :type 'regexp + :group 'starttls) + +(defcustom starttls-success "- Compression: " + "*Regular expression indicating completed TLS handshakes. +The default is what GNUTLS's \"gnutls-cli\" outputs." + ;; GNUTLS cli.c:do_handshake() calls, on success, + ;; common.c:print_info(), that unconditionally print this string + ;; last. If that logic, or the string itself, is modified, this + ;; must be updated. + :type 'regexp + :group 'starttls) + +(defun negotiate-starttls (process) + "Negotiate TLS on process opened by `open-starttls-stream'. +This should typically only be done once. It typically return a +multi-line informational message with information about the +handshake, or NIL on failure." + (let (buffer info old-max done-ok done-bad) + (if (null (setq buffer (process-buffer process))) + ;; XXX How to remove/extract the TLS negotiation junk? + (signal-process (process-id process) 'SIGALRM) + (with-current-buffer buffer + (save-excursion + (setq old-max (goto-char (point-max))) + (signal-process (process-id process) 'SIGALRM) + (while (and (processp process) + (eq (process-status process) 'run) + (save-excursion + (goto-char old-max) + (not (or (setq done-ok (re-search-forward + starttls-success nil t)) + (setq done-bad (re-search-forward + starttls-failure nil t)))))) + (accept-process-output process 1 100) + (sit-for 0.1)) + (setq info (buffer-substring-no-properties old-max (point-max))) + (delete-region old-max (point-max)) + (if (or (and done-ok (not done-bad)) + ;; Prevent mitm that fake success msg after failure msg. + (and done-ok done-bad (< done-ok done-bad))) + info + (message "STARTTLS negotiation failed: %s" info) + nil)))))) + +(defun open-starttls-stream (name buffer host service) + "Open a TLS connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (message "Opening STARTTLS connection to `%s'..." host) + (let* (done + (old-max (with-current-buffer buffer (point-max))) + (process-connection-type starttls-process-connection-type) + (process (apply #'start-process name buffer + starttls-file-name "-s" host + "-p" (if (integerp service) + (int-to-string service) + service) + starttls-extra-arguments))) + (process-kill-without-query process) + (while (and (processp process) + (eq (process-status process) 'run) + (save-excursion + (set-buffer buffer) + (goto-char old-max) + (not (setq done (re-search-forward + starttls-connect nil t))))) + (accept-process-output process 0 100) + (sit-for 0.1)) + (if done + (with-current-buffer buffer + (delete-region old-max done)) + (delete-process process) + (setq process nil)) + (message "Opening STARTTLS connection to `%s'...%s" + host (if done "done" "failed")) + process)) + +;; Compatibility with starttls.el by Daiki Ueno : +(defvaralias 'starttls-program 'starttls-file-name) +(make-obsolete-variable 'starttls-program 'starttls-file-name) +(defvaralias 'starttls-extra-args 'starttls-extra-arguments) +(make-obsolete-variable 'starttls-extra-args 'starttls-extra-arguments) +(defalias 'starttls-open-stream 'open-starttls-stream) +(defalias 'starttls-negotiate 'negotiate-starttls) + +(provide 'starttls) + +;;; starttls.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1540485..44d78ed 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,34 +1,2181 @@ +2003-12-30 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.10.3 is released. + +2003-12-29 Simon Josefsson + + * gnus-agent.el (gnus-agentize): Improve auto-agentizing logic. + Suggested by Steinar Bang . + (gnus-agent-auto-agentize-methods): Customize. + +2003-12-29 Kevin Greiner + * gnus.el (gnus-server-to-method): Fixed bug in 2003-12-22 + check-in. + +2003-12-28 Adrian Lanz + + * mail-source.el (mail-source-fetch-imap): Prevent storing of + identical entries for imap mail sources, when retrieving mail + messages from an imap server within the same Gnus session several + times (tiny change). + +2003-12-28 Jesper Harder + + * mm-view.el (mm-text-html-washer-alist): Use + mm-inline-wash-with-stdin for w3m-standalone. + + * mm-decode.el (mm-text-html-renderer): Add w3m-standalone. + + * mml1991.el (mml1991-pgg-encrypt): Decode according to CTE before + encrypting. + +2003-12-28 Jesper Harder + + * mml1991.el (mml1991-pgg-sign): Use unibyte when re-encoding. + From Ivan Boldyrev (tiny change). + +2003-12-26 Katsumi Yamaoka + + * dgnushack.el: Add an advice to byte-optimize-form-code-walker to + avoid the warning ``...called for effect'' for the pop form when + running Emacs 21.3. + +2003-12-26 Jesper Harder + + * mm-bodies.el (mm-body-encoding): Don't use 7bit if the body + contains "^From " and mm-use-ultra-safe-encoding is true. + +2003-12-25 Jesper Harder + + * mml1991.el (mml1991-pgg-sign): Encode and decode according to + CTE header. Don't insert gpg output as unibyte. + +2003-12-25 Katsumi Yamaoka + + * lpath.el: Remove display-time-event-handler and open-ssl-stream; + add delete-extent for Emacs; rearrange bindings assuming w3 may + not be available and XEmacs without the file-coding feature may be + used. + +2003-12-24 Katsumi Yamaoka + + * dgnushack.el (dgnushack-compile): Increase the value for + max-specpdl-size when compiling Gnus with Emacs 20. + +2003-12-22 Kevin Greiner + * gnus-int.el (gnus-open-server): Fixed the server status such + that an agentized server, when opened offline, has a status of + offline. Also fixes bug whereby the agent's backend was called + twice to open each server. + + * gnus-start.el (gnus-get-unread-articles-in-group): Autoload + gnus-agent-possibly-alter-active rather than inline to resolve + compiler warnings. + + * gnus.el (gnus-server-to-method): Added fallback of iterating + over gnus-newsrc-alist to resolve names of foreign servers. + Should fix recent agent bug. + +2003-12-22 Reiner Steib + + * gnus-score.el (gnus-summary-lower-score) + (gnus-summary-increase-score): Mention symbolic prefix in the + doc-string. Suggested by Karl Pfl,Ad(Bsterer . + +2003-12-21 Jesper Harder + + * gnus-agent.el (gnus-agent-read-agentview): Use + car-less-than-car. + +2003-12-20 Artem Chuprina (tiny change) + + * message.el (message-yank-buffer): Bind message-reply-buffer to + a buffer rather than a string. + +2003-12-19 Jesper Harder + + * gnus-msg.el (gnus-summary-followup): Correct documentation. + +2003-12-18 Jesper Harder + + * gnus-msg.el (gnus-inews-add-send-actions): `yanked' can be a + list of lists. Reported by Dmitri Paduchikh . + +2003-12-18 Reiner Steib + + * mm-url.el (mm-url-insert-file-contents-external) + (mm-url-insert-file-contents): Added doc-strings. Autoload. + +2003-12-18 Jesper Harder + + * gnus-cus.el (defvar): defvar + gnus-agent-cat-disable-undownloaded-faces. + +2003-12-17 Katsumi Yamaoka + + * message.el (message-forward-subject-name-subject): Use + gnus-extract-address-components instead of + mail-header-parse-address because it may be called with non-ascii + text. + +2003-12-16 Per Abrahamsen + + * nnmail.el (nnmail-split-fancy): The widget now supports + restrictions. + +2003-12-16 Katsumi Yamaoka + + * nnheader.el (nnheader-find-etc-directory): Find the newest one. + +2003-12-16 Simon Josefsson + + * sha1-el.el (autoload): Don't use ignore-errors. + (sha1-use-external): Use condition-case. Suggested by Katsumi + Yamaoka . + +2003-12-15 Katsumi Yamaoka + + * nnmail.el (nnmail-split-fancy): Make it customizable with Emacs + 20 as well. + +2003-12-15 Simon Josefsson + + * sha1-el.el (autoload): Ignore errors for + executable-find. (XEmacs ecrypto does not require sh-script where + executable.el is located.) + (sha1-use-external): Likewise. + + * sha1-el.el (sha1): Add defgroup. + (sha1-maximum-internal-length, sha1-program, sha1-use-external) + (sha1-program): Use 'sha1sum' from GNU CoreUtils instead of OpenSSL. + (sha1): Autoload. + + * nndraft.el (nndraft-request-move-article): Copy definition of + nnmh-request-move-article instead of calling it, because the nnmh + version uses nnmh-request-article which isn't the same as the + nndraft version. + +2003-12-13 Teodor Zlatanov + + * spam.el: added some gnus-registry autoloads + (spam-split-symbolic-return): makes spam-split return 'spam + instead of the value of spam-split-group when spam is detected + (spam-split-symbolic-return-positive): makes spam-split return + 'ham instead of nil when ham is detected + (spam-autodetect-recheck-messages): tells spam.el whether it + should recheck all messages in a group, or only the unseen ones + (spam-split-last-successful-check): spam-split will set this to + the last successful check; this was seen as a cleaner approach + than returning a cell like '(spam spam-use-bogofilter) + (spam-list-of-checks): documentation appended + (spam-split): accomodate the spam-split-symbolic-return and + spam-split-symbolic-return-positive variables + (spam-find-spam): new function called when the summary is built + (spam-log-registered-p): checks if a ham or spam registration has + already been done for an article + (spam-check-regex-headers, spam-check-blackholes, spam-check-BBDB) + (spam-check-ifile, spam-check-stat, spam-check-whitelist) + (spam-check-blacklist, spam-check-bogofilter-headers) + (spam-check-spamoracle): respect the spam-split-symbolic-return + and spam-split-symbolic-return-positive variables + (spam-initialize): add spam-find-spam to gnus-summary-prepare-hook + (spam-unload-hook): remove spam-find-spam from + gnus-summary-prepare-hook + + * gnus.el (spam-autodetect, spam-autodetect-methods): new + configuration items for spam autodetection + +2003-12-12 Reiner Steib + + * gnus-draft.el (gnus-draft-mode-map): Bind `e' to + `gnus-draft-edit-message'. We still have `B w' for + `gnus-summary-edit-article'. + +2003-12-12 Katsumi Yamaoka + + * nnheaderxm.el (nnheader-xmas-run-at-time): Use a simple function + definition if there is not a bug in start-itimer. + + * pgg.el (pgg-run-at-time): Ditto. + +2003-12-11 Kevin Greiner + + * gnus-agent.el (gnus-agent-possibly-alter-active): New Function. + (gnus-agent-regenerate-group): When necessary, alter the group's + active range to include articles newly recognized as being + downloaded. + (gnus-agent-regenerate): Removed code that updated the agent's + active file as the new gnus-agent-possibly-alter-active function + obsolesced it. + + * gnus-cus.el (gnus-agent-customize-category): Added missing + agent-disable-undownloaded-faces parameter. + + * gnus-start.el (gnus-activate-group): Backed out my 2003-11-29 + patch as it was too late at adjusting the active range. + (gnus-get-unread-articles-in-group): Added call to new + gnus-agent-possibly-alter-active to adjust the active range. + +2003-12-10 Jesper Harder + + * message.el (message-get-reply-headers): Narrow to headers. + +2003-12-10 Teodor Zlatanov + + * spam.el (spam-disable-spam-split-during-ham-respool): new + variable. From lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly) + (spam-ham-copy-or-move-routine): respect + spam-disable-spam-split-during-ham-respool. From + lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly) + (spam-split-disabled): new variable. From + lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly) + (spam-split): respect spam-split-disabled. From + lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly) + +2003-12-10 Katsumi Yamaoka + + * nnheaderxm.el (nnheader-xmas-run-at-time): Make it work + correctly for the first argument. + + * pgg.el (pgg-run-at-time): New function. + (pgg-add-passphrase-cache): Use it. + +2003-12-10 Simon Josefsson + + * pgg-parse.el (pgg-decode-packets): Rewrite to handle corrupt + input. + (pgg-decode-armor-region): Don't parse packet if decoding fail. + +2003-12-09 Teodor Zlatanov + + * spam.el (spam-check-bogofilter): run in the correct buffer. + From lorentey@elte.hu (L,Bu(Brentey K,Ba(Broly). + (spam-bogofilter-database-directory): correct customization + group. From Xavier Maillard . + +2003-12-09 Per Abrahamsen + + * nnmail.el (nnmail-lazy, nnmail-split-fancy): New widgets. + (nnmail-split-fancy): Use it. + +2003-12-08 Joel Ray Holveck (tiny change) + + * gnus-sum.el (gnus-summary-save-parts-1): Consider the "name" + parameter of Content-Type. + +2003-12-08 Katsumi Yamaoka + + * gnus-util.el: Revert 2003-12-03 change, instead, provide the + compiler macro for rmail-select-summary if rmail is not available, + and bind rmail-summary-displayed and rmail-maybe-display-summary + in order to silence the compiler even if tm is not available. + +2003-12-08 Simon Josefsson + + * flow-fill.el (fill-flowed-encode-tests, fill-flowed-test): Add. + +2003-12-08 Jesper Harder + + * gnus-msg.el (gnus-extended-version): Bind float-output-format to + nil. + +2003-12-08 Simon Josefsson + + * mml-smime.el (mml-smime-sign): Replace CRLF with LF in OpenSSL + output. Reported by Arne J,Ax(Brgensen . + +2003-12-07 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-recipient-arg): Add. + (pgg-gpg-encrypt-region): Use it. Tiny patch from Lloyd Zusman + . + (pgg-gpg-recipient-argument): Doc fix. Renamed fro p-g-r-a. + (pgg-gpg-encrypt-region): Update. + +2003-12-07 Jesper Harder + + * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Don't + use = or zerop to test the return value of call-process, because + it can be a string. + + * mail-source.el (mail-source-fetch-with-program): do. + + * mailcap.el (mailcap-viewer-passes-test): do. + + * gnus-uu.el (gnus-uu-treat-archive, gnus-uu-post-encode-mime) + (gnus-uu-post-encode-file): do. + + * gnus-soup.el (gnus-soup-pack, gnus-soup-unpack-packet): do. + + * message.el (message-fix-before-sending): Fix detection of + non-printables. Don't replace unencodable utf-8. + +2003-12-05 Jesper Harder + + * mm-url.el (mm-url-predefined-programs): Add user-agent for wget. + (mm-url-insert-file-contents-external): Signal an error if program + fails. + +2003-12-04 Teodor Zlatanov + + * spam-report.el (spam-report-gmane): iterate over articles + instead of a single one; remove interactive usage + +2003-12-03 Katsumi Yamaoka + + * dns.el: Fix misplaced eval-when-compile. + + * gnus-util.el: Require alist and provide tm-view when compiling + with XEmacs. + +2003-12-03 Steve Youngs + + * gnus-xmas.el: Add autoloads for macros defined in gnus.el. + From Jerry James . + + * gnus-util.el: Get rmail definitions when compiling. + From Jerry James . + + * dns.el: Require gnus-xmas at compile time instead of trying to + autoload `gnus-xmas-open-network-stream' because it wasn't picking + up the macro. + From Jerry James . + +2003-12-01 Kevin Greiner + * gnus-agent.el (gnus-agent-consider-all-articles): Updated + docstring. + (gnus-predicate-implies-unread, gnus-predicate-implies-unread-1): + Fixed implementation such that the predicate `true' no longer + evaluates to t. + +2003-12-01 Teodor Zlatanov + + * spam.el (spam-check-bogofilter): check the bogofilter headers + AFTER the save-excursion scope is over. From Adrian Lanz + . + (spam-fetch-field-message-id-fast): doc fix + +2003-12-01 Simon Josefsson + + * gnus-agent.el (gnus-agent-expire-days): Doc fix. + +2003-11-30 Simon Josefsson + + * gnus-agent.el (gnus-agent-expire-group-1): Bind message-log-max + when messaging "X % completed" to inhibit logging them to the + message buffer. + (gnus-agent-expire-group-1): Mention group name in messages. + (gnus-agent-expire-group-1): Only print a message for an article + when there actually was something done to it. + + * mm-util.el (mm-enable-multibyte): Call set-buffer-multibyte with + 'to argument. Fixes something or other in Emacs 22, and is + backwards compatible. From Kenichi Handa . + + * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Custom fix. + +2003-11-30 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-covered-methods): Remove nil methods. + +2003-11-29 Kevin Greiner + * gnus-start.el (gnus-activate-group): The active range of the + group must include the articles known to the agent. + + * gnus.el (gnus-agent-method-p): Accept a server name as the + method being tested. + +2003-11-29 Alexander Kreuzer (tiny change) + + * nnrss.el (nnrss-check-group): Set xml when nnrss-use-local is t. + +2003-11-29 Jesper Harder + + * gnus-group.el (gnus-group-make-menu-bar): Add + gnus-group-make-rss-group. + +2003-11-28 Reiner Steib + + * message.el: Added custom-manual links to all variables that have + an index entry in the message manual. + (message-generate-headers-first): Fixed doc-string. + +2003-11-27 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-yank-message): Don't bind + gnus-display-mime-function to nil so that non-ascii text is + decoded and attachments are not shown. + + * message.el (message-cite-original-without-signature): Replace + the value of message-reply-headers with the yanked article since + it may be a different article from the original. + (message-cite-original): Ditto. + +2003-11-25 Teodor Zlatanov + + * spam.el (spam-blacklist-ignored-regexes): new variable, so + blacklisting can ignore certain regular expressions (e.g. the + user's e-mail address) + (spam-bogofilter-spam-strong-switch, + spam-bogofilter-ham-strong-switch): options used when articles are + already registered as the opposite classification + (spam-old-ham-articles, spam-old-spam-articles): lists of ham and + spam articles, generated when a summary buffer is entered, and + consulted when it's exited so we know what articles are changing + state from spam to ham or vice-versa + (spam-xor): everyone needs a little convenience + (spam-list-of-processors): lookup table for old-style spam/ham + exits processors + (spam-group-processor-p): support old-style and new-style spam/ham + exit processors + (spam-group-processor-multiple-p): handle new-style spam/ham exit + processors + (spam-summary-prepare): use spam-old-{ham,spam}-articles; change + logic to iterate over list of processors instead of manual + individual lookup, unregister any articles that change from ham to + spam or vice-versa in the course of the summary buffer usage; use + the new spam-register-routine + (spam-ham-copy-routine, spam-ham-move-routine, + spam-mark-spam-as-expired-and-move-routine): check that the list + of groups is not nil, because apply doesn't like to apply a + function across nil + (spam-registration-functions): variable for looking up spam/ham + registration/unregistration functions based on a spam-use-* symbol + (spam-classification-valid-p, spam-process-type-valid-p) + (spam-registration-check-valid-p) + (spam-unregistration-check-valid-p): convenience functions + (spam-registration-function, spam-unregistration-function): look + up the registration/unregistration function based on a + classification and the check (spam-use-* symbol) + (spam-list-articles): generate list of spam/ham articles from a + given list of articles + (spam-register-routine): do the heavy work of registering and + unregistering articles, using all the articles in the group or + specific ones as needed + (spam-generic-register-routine): removed, no longer used + (spam-log-unregistration-needed-p, spam-log-undo-registration): + handle article registration/unregistration with a given spam/ham + processor and group + (BBDB, ifile, spam-stat, blacklists, whitelists, spam-report, + bogofilter, spamoracle): rewrite registration/unregistration + functions to take a list of articles and the unregister option. + Much hilarity ensues. + (spam-initialize): spam-stat-maybe-{save,load} already respect spam-use-stat + (spam-stat-register-ham-routine, spam-stat-register-spam-routine): + don't load and save unnecessarily + + * spam-stat.el (spam-stat-dirty): new variable, set when the stats + database is modified + (spam-stat-buffer-is-spam, spam-stat-buffer-is-non-spam) + (spam-stat-buffer-change-to-spam, spam-stat-to-hash-table) + (spam-stat-buffer-change-to-non-spam): set spam-stat-dirty when + needed + (spam-stat-save): respect spam-stat-dirty, unless the force + parameter is specified + (spam-stat-load): clear spam-stat-dirty + + * gnus.el (gnus-install-group-spam-parameters): marked the + old-style exit processors as obsolete in the docs, added the + new-style exit processors while the old ones are still allowed + + +2003-11-25 Jesper Harder + + * gnus-art.el (article-hide-boring-headers): Don't hide Reply-To + unless its list of addresses is identical to From. + +2003-11-25 Katsumi Yamaoka + + * dgnushack.el (mapc): Add the compiler macro for Emacs 20. + +2003-11-24 Kevin Greiner + * gnus-srvr.el (gnus-server-insert-server-line): The server names + used in gnus-agent are different (for example, the native server + uses the alias "native") from the names in gnus-srvr. + Compensating by adding a second text property storing the name + expected by gnus-agent. + (gnus-server-named-server): New function. + * gnus-agent.el (gnus-agent-remove-server, gnus-agent-add-server): + No longer expect an argument as it was ignored anyway. Uses the + new gnus-server-named-server function to get gnus-agent compatible + names from the server buffer. + +2003-11-20 Kevin Greiner + + * gnus.el (gnus-agent-covered-methods): Documented use of + named servers, not methods, to identity agentized groups. + Users may now change their server configurations without having + the server become "unagentized". + (gnus-agent-covered-methods): Removed from gnus-variable-list to + avoid storing two copies of gnus-agent-covered-methods, one in + .newsrc.eld and the other in agent/lib/servers. + (gnus-server-to-method): Do not cache server for the nil method. + (gnus-method-to-server): New function. Associate named server + with all, even foreign, methods. + (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated + simple last-response cache to offset performance lose of having to + always convert methods to named servers. + * gnus-agent.el (gnus-agent-expire-days): Removed obsolete + documentation. + (gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server): + Modified to support new definition of gnus-agent-covered-method. + (gnus-agent-read-servers): Rewritten to convert old method data + into server names. + (gnus-agent-read-servers-validate) + (gnus-agent-read-servers-validate-native): New functions. + (gnus-agent-write-servers): No longer use gnus-method-simplify as + it failed to simplify foreign methods. + (gnus-agent-close-connections, gnus-agent-synchronize-flags) + (gnus-agent-possibly-synchronize-flags, gnus-agent-fetch-session) + (gnus-agent-regenerate): Uses new gnus-agent-covered-methods + function as gnus-agent-covered-methods variable no longer provides + methods. + (gnus-agent-covered-methods): New function + (gnus-agent-expire-group, gnus-agent-expire): Final message will, + if gnus-verbose is greater than 4, report statistics of NOV + entries and files deleted as well as total bytes recovered. + (gnus-agent-expire-done-message): New function + (gnus-agent-unread-articles): Bug fix. No longer drops last + unread article onto read list. + (gnus-agent-regenerate-group): Changed prompt to use typical + style. + (gnus-agent-group-covered-p): Rewrote to internally use + gnus-agent-method-p. + * gnus-int.el (gnus-start-news-server): Partially convert old + gnus-agent-covered-methods to new format so that gnus-open-server + functions correctly. + * gnus-srvr.el (gnus-server-insert-server-line): Replaced + gnus-agent-covered-methods with gnus-agent-method-p. + * gnus-start.el (gnus-clear-system): Added + gnus-agent-covered-methods to compensate for removing it from + gnus-variable-list. + (gnus-setup-news): Complete conversion of old + gnus-agent-covered-methods to new format so that secondary and + foreign servers can be correctly opened. + +2003-11-20 Teodor Zlatanov + + * spam.el (spam-ham-copy-or-move-routine): add respooling + support, not working well yet + + * gnus.el (ham-process-destination): make 'respool option the + only one, so it can't be chosen together with other groups + +2003-11-19 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-track-extra): make it a set of + choices instead of a boolean + (gnus-registry-track-subject-p, gnus-registry-track-sender-p): + new convenience functions + (gnus-registry-split-fancy-with-parent): use convenience + functions, also don't return extra tracking info if sender or + subject is found in more than one groups + (gnus-registry-add-group): use new convenience functions to + decide if sender and subject should be tracked + + * gnus.el (ham-process-destination): add 'respool option, + unused by spam.el yet + +2003-11-19 Katsumi Yamaoka + + * gnus-score.el (gnus-decay-score): Return a surely smaller value + than the argument in XEmacs. + +2003-11-18 Reiner Steib + + * message.el (message-insert-to): Don't use `gnus-message'. + (message-header-synonyms): New variable. + (message-carefully-insert-headers): Use it (check for synonyms). + Added doc-string. From Sam Steingold . + +2003-11-17 Lars Magne Ingebrigtsen + + * html2text.el (html2text-remove-tags): Remove the tag in a + simpler way to avoid inflooping. + +2003-11-17 Simon Josefsson + + * imap.el (imap-gssapi-auth-p): Don't check capability (some + servers remove AUTH=GSSAPI from capability response returned after + successful authentication). + +2003-11-16 Jesper Harder + + * gnus.el (gnus-getenv-nntpserver): Fix regexp and simplify. + Reported by Artem Chuprina . + +2003-11-14 Simon Josefsson + + * mm-util.el (mm-charset-synonym-alist): Map BIG5-HKSCS to BIG5 + when it isn't available. + +2003-11-13 Alex Schroeder + + * nnrss.el (nnrss-check-group): Use dc:contributor if neither + rss:author nor dc:creator is provided. + +2003-11-13 Katsumi Yamaoka + + * mm-decode.el (mm-dissect-buffer): Save start="" value + contained in Content-Type header of multipart/related messages. + + * mm-view.el (mm-w3m-cid-retrieve-1): New function. + (mm-w3m-cid-retrieve): Use it. + + * mml.el (mml-generate-mime-1): Add start="" to Content-Type. + (mml-insert-mime-headers): Insert Content-ID header. + (mml-insert-mml-markup): Insert start="" value. + +2003-11-12 Teodor Zlatanov + + * nnml.el (nnml-request-accept-article): pass sender to + nnmail-cache-insert + + * nnmh.el (nnmh-request-accept-article): pass sender to + nnmail-cache-insert + + * nnmbox.el (nnmbox-request-accept-article): pass sender to + nnmail-cache-insert + + * nnfolder.el (nnfolder-request-accept-article): pass sender to + nnmail-cache-insert + + * nnbabyl.el (nnbabyl-request-accept-article): pass sender to + nnmail-cache-insert + + * nnmail.el (nnmail-cache-insert): accept sender parameter and + pass it to the nnmail-spool-hook + + * gnus-registry.el (gnus-registry-track-extra): clarify doc + (gnus-registry-action): add sender lexical var and pass it to + gnus-registry-add-group + (gnus-registry-spool-action): take a sender parameter, pass to + gnus-registry-add-group + (gnus-registry-split-fancy-with-parent): trace by sender in + addition to subject + (gnus-registry-fetch-sender-fast): new function + (gnus-registry-add-group): accept sender parameter + +2003-11-11 Teodor Zlatanov + + * spam.el (spam-ham-copy-routine, spam-ham-move-routine) + (spam-mark-spam-as-expired-and-move-routine): allow for the + groups to be a list of a single item + + * gnus.el (gnus-install-group-spam-parameters): + ham-process-destination and spam-process-destination allow lists now + +2003-11-10 Reiner Steib + + * message.el (message-insert-to): Do error out when the user + requested no Cc. Don't insert empty To. Can be added to + `message-setup-hook' now. From Sam Steingold . + (message-mode-field-menu): Moved some entries, added + `message-insert-wide-reply'. + (message-change-subject): Fixed comment. + +2003-11-10 Simon Josefsson + + * pgg-def.el (pgg-encrypt-for-me): Change default from nil to t. + +2003-11-09 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-encrypt-region): Cache passphrase under hex + key id too (for decryption). + (pgg-gpg-sign-region): Likewise. + +2003-11-09 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-all-secret-keys): New variable. + (pgg-gpg-lookup-all-secret-keys): New function. + (pgg-gpg-select-matching-key): Likewise. + (pgg-gpg-decrypt-region): Use new functions. From Satyaki Das + . + +2003-11-07 Teodor Zlatanov + + * nnmail.el (nnmail-cache-insert): make sure that the + nnmail-spool-hook is called with a valid newsgroup name (though + it may be wrong) + + * gnus.el (gnus-group-real-prefix): return nil if group is not a + string, instead of triggering an error + +2003-11-06 Teodor Zlatanov + + * gnus.el (gnus-group-guess-full-name-from-command-method): new function + + * gnus-registry.el (gnus-registry-fetch-group): use long names if + requested + (gnus-registry-split-fancy-with-parent): when long names are in + use, strip the name if we're in the native server, or else return nothing + (gnus-registry-spool-action, gnus-registry-action): use + gnus-group-guess-full-name-from-command-method instead of + gnus-group-guess-full-name + + * spam.el (spam-mark-spam-as-expired-and-move-routine) + (spam-ham-copy-or-move-routine): prevent article deletions or + moves unless the backend allows it + + * gnus.el (gnus-install-group-spam-parameters): fixed parameters + to list spamoracle as well, suggested by Jean-Marc Lasgouttes + + + * spam.el (spam-spamoracle): doc change, suggested by Jean-Marc + Lasgouttes + +2003-11-04 Katsumi Yamaoka + + * gnus-score.el (gnus-decay-score): Protect against arithmetic + errors. Tiny patch from Norbert Koch . + +2003-10-31 Teodor Zlatanov + + * spam.el + (spam-log-processing-to-registry): improved message and comments + (spam-log-unregistration-needed-p): new function + (spam-ifile-register-spam-routine) + (spam-ifile-register-ham-routine, spam-stat-register-spam-routine) + (spam-stat-register-ham-routine) + (spam-blacklist-register-routine) + (spam-whitelist-register-routine) + (spam-bogofilter-register-spam-routine) + (spam-bogofilter-register-ham-routine) + (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): change + spam-log-processing-to-registry invocations appropriately + +2003-10-31 Simon Josefsson + + * imap.el (imap-kerberos4-open): Ignore output from ATHENA imtest. + Tiny patch from Derek Atkins . + (imap-process-connection-type): Improve docstring. Suggested by + Derek Atkins . + +2003-10-31 Teodor Zlatanov + + * spam.el (autoload): autoload the gnus-registry functions we'll + need + (spam-log-to-registry): new variable for interfacing with the + gnus-registry + (spam-install-hooks): variable had the wrong customization group + (spam-fetch-field-message-id-fast): convenience function for fetch + a message ID quickly + (spam-log-processing-to-registry): new function + (spam-ifile-register-spam-routine) + (spam-ifile-register-ham-routine, spam-stat-register-spam-routine) + (spam-stat-register-ham-routine) + (spam-blacklist-register-routine) + (spam-whitelist-register-routine) + (spam-bogofilter-register-spam-routine) + (spam-bogofilter-register-ham-routine) + (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): add + spam-log-processing-to-registry invocations + + * gnus-registry.el: fixed docs in the preface to mention + gnus-registry-initialize + (gnus-registry-store-extra): remove cached extra entry + information when new extra entry is stored + +2003-10-29 Simon Josefsson + + * message.el (message-forward-make-body-plain): Fix ARG=1 mode + after separating m-f-m-b. + +2003-10-29 Simon Josefsson + + * message.el (message-forward-make-body-plain): Remove ignored + headers. Tiny patch from Andre Srinivasan . + (message-forward-make-body-plain): Fix ARG=1. + +2003-10-28 Jesper Harder + + * message.el (message-forward-subject-name-subject) + (message-forward-subject-author-subject): Decode non-ASCII + newsgroup names. + (autoload): Autoload gnus-group-decoded-name. + +2003-10-27 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): New optional + parameter key, overrides the key id used to store passphrase + under (uses true key id from gpg output if nil). + (pgg-gpg-encrypt-region): Search for passphrase using user suplied + string STR, instead of (pgg-lookup-key STR t). + (pgg-gpg-encrypt-region): Store passphrase under user suplied + string, instead of real key id taken from gpg output. + (pgg-gpg-decrypt-region): Likewise. + (pgg-gpg-sign-region): Likewise. + * pgg.el (pgg-decrypt-region): Don't set pgg-default-user-id. + +2003-10-27 Romain FRANCOISE + + * gnus-art.el (gnus-article-goto-prev-page): Doc fix. + +2003-10-27 Simon Josefsson + + * mm-bodies.el (mm-body-encoding): Don't use QP when message body + only consists of short lines and ASCII, when + mm-use-ultra-safe-encoding. Refer to 'About foo' thread in + gnus-bug, e.g. , for more discussion. + This make it possible to pipe the raw RFC 822 message into 'gpg' + and have the signature work. Potential problem: what if message + contain data that would be dash-escaped by OpenPGP + implementations? Then PGP 2.x might not be able to parse the raw + RFC 822 message correctly. If that problem is worth fixing, it + should be fixed by detecting the situation, instead of applying QP + to everything. Based on discussion with "John A. Martin" + . + +2003-10-27 Teodor Zlatanov + + * spam.el (spam-mark-spam-as-expired-and-move-routine) + (spam-ham-copy-or-move-routine): don't ask when deleting copied + articles, and use move instead of copy when possible + (spam-split): added the option of specifying a string as a + spam-split parameter; such a string will override + spam-split-group temporarily. + + * nnmail.el (nnmail-cache-insert): protect from nil message IDs, + but should we do something else? + + * gnus-registry.el (gnus-registry-spool-action): protect from nil + message IDs + +2003-10-26 Simon Josefsson + + * gnus-art.el (gnus-button-alist): Allow & in mailto URLs. + (gnus-header-button-alist): Likewise. + (gnus-url-mailto): Handle ?to parameters. Replace \r\n with \n. + Reverse parameter list to use same order as in the URL. Reported + by f95-msv@f.kth.se (M,Ae(Brten Svantesson). + +2003-10-25 Teodor Zlatanov + + * spam.el (spam-move-spam-nonspam-groups-only): documentation fix + for the variable + +2003-10-25 Steve Youngs + + * Makefile.in (clean-some): Remove auto-autoloads.* and + custom-load.* as well. + (distclean): Ditto. + + * dgnushack.el (dgnushack-make-load): Add a local vars section to + the dummy gnus-load.el. + +2003-10-24 Teodor Zlatanov + + * spam.el (spam-ham-copy-or-move-routine): do not delete if copy + is t, also don't intepret the list of groups as a list of lists + (spam-mark-spam-as-expired-and-move-routine) + (spam-ham-copy-or-move-routine): delete articles only if 1 or + more groups were specified (and "copy" was not specified for + spam-ham-copy-or-move-routine) (fixed twice) + +2003-10-24 Katsumi Yamaoka + + * nndoc.el (nndoc-guess-type): Reverse the sort order. Suggested + by ARISAWA Akihiro . + (nndoc-dissect-buffer): Don't miss even-numbered articles. + +2003-10-24 Steve Youngs + + * dgnushack.el (dgnushack-gnus-load-file): Set to + "auto-autoloads.el" if building with XEmacs. + (dgnushack-cus-load-file): Set to "custom-load.el" if building + with XEmacs. + (dgnushack-make-cus-load): We don't delete the resulting file if + building with XEmacs so byte-compile it. + (dgnushack-make-load): When building with XEmacs do nothing except + byte-compile the autoload file and create a dummy gnus-load.el + file. + +2003-10-23 Katsumi Yamaoka + + * message.el (message-make-fqdn): Bind case-fold-search. + Suggested by Christopher Richards . + +2003-10-23 Teodor Zlatanov + + * gnus.el (spam-process-destination, ham-process-destination): + allow multiple groups as a choice + + * spam.el (spam-check-blackholes): remove "[IP address]" + requirement, now just "IP address" is enough for detection for + blackhole checking + (spam-check-blackholes): oops, the dots were not escaped + (spam-mark-spam-as-expired-and-move-routine): added multiple group + support (multiple copies, then delete) + (spam-ham-copy-routine): new function + (spam-ham-move-routine): new function + (spam-ham-copy-or-move-routine): new function (used to be + spam-ham-move-routine), handle multiple groups + (spam-summary-prepare-exit): call the new functions + +2003-10-23 Simon Josefsson + + * flow-fill.el (fill-flowed-encode, fill-flowed): Autoload. + +2003-10-22 Katsumi Yamaoka + + * gnus-art.el (gnus-emphasis-strikethru): Use the :strike-through + attribute in Emacs. + +2003-10-21 Katsumi Yamaoka + + * message.el (message-bounce): Don't erase except bounced header. + +2003-10-21 Teodor Zlatanov + + * spam.el (spam-reverse-ip-string): new function to reverse an IP + address in a string + (spam-check-blackholes): use spam-reverse-ip-string + +2003-10-21 Katsumi Yamaoka + + * gnus-art.el (gnus-narrow-to-page): Clear as well as set the + value for gnus-page-broken. + + * gnus-sum.el (gnus-summary-beginning-of-article): Use + gnus-break-pages instead of gnus-page-broken. + (gnus-summary-end-of-article): Use gnus-break-pages instead of + gnus-page-broken; narrow to the end of a page beforehand. + (gnus-summary-toggle-header): Use gnus-break-pages instead of + gnus-page-broken; remove delimiter buttons unless gnus-break-pages + is non-nil. + +2003-10-21 Lars Magne Ingebrigtsen + + * gnus-picon.el (gnus-picon-transform-address): Protect against + errors. + +2003-10-20 Katsumi Yamaoka + + * gnus-msg.el (nnspool-rejected-article-hook): Remove defvar. + (xemacs-codename): Move defvar to gnus-util.el. + + * gnus-util.el (xemacs-codename): Defvar when compiling. + +2003-10-20 Lars Magne Ingebrigtsen + + * spam-report.el (spam-report-url-ping-plain): Include a + User-Agent. + + * gnus-msg.el (gnus-extended-version): Use it. + + * gnus-util.el (gnus-emacs-version): Separated out into own + function. + +2003-10-19 Reiner Steib + + * message.el (message-mode-field-menu): Added + message-generate-unsubscribed-mail-followup-to. + (message-forward-subject-fwd): Avoid double "Fwd: " + (message-change-subject): Added comment. + +2003-10-19 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-nov-parse-line): Remove condition-cases. + + * mml.el (mml-insert-mime): Quote mml. + +2003-10-19 Katsumi Yamaoka + + * gnus-sum.el (gnus-remove-odd-characters): Use + mm-subst-char-in-string instead of subst-char-in-string. + (gnus-summary-refer-article): Use gnus-replace-in-string instead + of replace-regexp-in-string. + +2003-10-19 Jesper Harder + + * gnus-uu.el (gnus-uu-uustrip-article): Really strip directory + from file name. + +2003-10-18 Jesper Harder + + * gnus-sum.el (gnus-summary-save-parts-last-directory): Default + to mm-default-directory. + (gnus-summary-save-parts-1): Use mm-file-name-rewrite-functions. + +2003-10-18 Lars Magne Ingebrigtsen + + * pop3.el (pop3-read-response): Check whether the process is + alive. + + * gnus-sum.el (gnus-summary-refer-article): Strip spaces. + + * rfc2047.el (rfc2047-encode-region): Do error out on invalid + strings. + + * nntp.el (nntp-retrieve-headers-with-xover): Get error messages + right. + + * gnus-agent.el (gnus-agent-read-servers): Remove sit-for. + + * gnus-art.el (article-treat-dumbquotes): Doc fix. + + * message.el (message-field-value): New function. + (message-insert-disposition-notification-to): Use Reply-To, too. + + * imap.el (imap-mailbox-status): Upcase STATUS commands. + + * gnus-sum.el (gnus-remove-odd-characters): New function. + (gnus-nov-parse-line): Use it. + +2003-10-18 Matt Swift + + * mm-decode.el (mm-inline-media-tests): Recognize pjpeg as jpeg. + +2003-10-18 Romain FRANCOISE + + * message.el (message-forward-make-body): does both + m-f-make-body-mml and m-f-make-body-plain, resulting in a strange + message buffer. + +2003-10-18 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-narrow-to-page): Only break page if it's + broken. + + * nnrss.el (nnrss-find-rss-via-syndic8): Return nil if xml-rpc + isn't available. + + * message.el (message-hidden-headers): Doc fix. + +2003-10-18 Jesper Harder + + * gnus-msg.el (gnus-summary-resend-message-edit): Avoid error when + fields aren't found. + +2003-10-18 Simon Josefsson + + * message.el (message-forward-make-body-plain) + (message-forward-make-body-mime, message-forward-make-body-mml) + (message-forward-make-body-digest-plain) + (message-forward-make-body-digest-mime) + (message-forward-make-body-digest): New, derived from + message-forward-make-body. + (message-forward-make-body): Use them. + (message-forward-show-mml): New default 'best. + (message-forward-make-body): Support it. + +2003-10-18 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-mode): Set gnus-page-broken to nil. + (gnus-article-prepare): Don't set to t. + (gnus-narrow-to-page): Set to t if we break. + +2003-06-11 Daniel N,Ai(Bri + + * message.el (message-resend): Generate Resent-Message-ID header. + +2003-10-18 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-next-page): Don't go to the next line + before checking end-of-buffer. + (gnus-mime-delete-part): Don't insert parts twice. + +2003-10-17 Lars Magne Ingebrigtsen + + * gnus-art.el (article-update-date-lapsed): Make sure point + doesn't move around (much). + +2003-07-28 Vasily Korytov + + * mail-source.el (mail-source-keyword-map): List "cur" before + "new" for maildirs. + +2003-10-17 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-enter-digest-group): ogroup, nor + group. + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the parent + name for gcc-self. + (gnus-inews-insert-archive-gcc): Paren mistake. + + * gnus-sum.el (gnus-summary-enter-digest-group): Add + parent-group. + + * gnus-art.el (gnus-ignored-headers): Add more headers. + + * rfc2047.el (rfc2047-encode): See which encoding is shorter -- + base64 or QP. + + * nnmail.el (nnmail-article-group): Default to "bogus". + + * mail-source.el (mail-source-delete-incoming): Change to nil. + +2003-10-16 Katsumi Yamaoka + + * mail-source.el (mail-source-fetch-imap): Fix mismatched parens. + +2003-10-16 Lars Magne Ingebrigtsen + + * mail-source.el (defvar): Add post/pre/scripts. + (mail-source-fetch-imap): Use them. + + * nndraft.el (nndraft-request-move-article): Fix infinite + recursion. + + * gnus-group.el (gnus-group-mark-regexp): Jump to groups. + +2003-10-16 Ed L. Cashin + + * imap.el (imap-interactive-login): Set imap-password to nil if + login fails. + +2003-10-16 Lars Magne Ingebrigtsen + + * message.el (message-inserted-headers): New variable. + (message-mode): Make local. + (message-mode): Set all the local action variables to nil. + +2003-10-16 Katsumi Yamaoka + + * mm-decode.el (mm-inline-text-html-with-images): Doc fix. + (mm-w3m-safe-url-regexp): Doc fix. + +2003-10-12 Jesper Harder + + * gnus-sum.el (gnus-summary-respool-query): Don't narrow to head, + it's done by nnmail-article-group. + + * gnus-uu.el (gnus-uu-grab-articles): Fix misplaced parens. + From Mark Hood (tiny change) + +2003-10-10 Jesper Harder + + * mm-decode.el (mm-file-name-delete-gotchas): Avoid infloop in + XEmacs. + +2003-10-10 Teodor Zlatanov + + * spam.el (spam-initialize): new function, does the spam-face + update and all the hooks, replaces spam-install-hooks-function + + * gnus-registry.el (gnus-registry-initialize): new autoloaded + function to explicitly initialize the registry + +2003-10-10 Katsumi Yamaoka + + * mm-decode.el (mm-w3m-safe-url-regexp): Doc fix. + + * mm-view.el (mm-w3m-mode-map): Doc fix. + (mm-inline-text-html-render-with-w3m): Add a comment. + +2003-10-10 Lars Magne Ingebrigtsen + + * gnus-group.el: Remove superfluous eval-when-compiles. + +2003-10-10 Jesper Harder + + * gnus-group.el (gnus-group-suspend): Reset gnus-backlog-articles. + +2003-10-08 Lars Magne Ingebrigtsen + + * dns.el (query-dns): Don't error out on malformed resolv files. + +2003-10-06 Jesper Harder + + * gnus.el (gnus-group-faq-directory): Update .tw entry. From + Albert Chun-Chieh Huang + +2003-10-03 Teodor Zlatanov + + * spam.el (spam-check-blackholes): exit the loop if matches are + found (idea from Adrian Lanz ) + (spam-check-bogofilter-headers, spam-check-blackholes, spam-check-BBDB) + (spam-from-listed-p): use nnmail-fetch-field instead of message-fetch-field + + +2003-10-03 Katsumi Yamaoka + + * mm-decode.el (mm-attachment-file-modes): Change the default + value into 384 from ?\600 which doesn't mean an integer in XEmacs. + +2003-10-03 Jesper Harder + + * mm-decode.el (mm-file-name-delete-control) + (mm-file-name-delete-gotchas): New functions. + (mm-file-name-rewrite-functions): Use them. + (mm-attachment-file-modes): New option. + (mm-save-part-to-file): Use it. + +2003-10-02 Reiner Steib + + * spam.el (spam-install-hooks-function): Added Autoload cookie. + +2003-10-02 Jesper Harder + + * pgg-def.el (pgg-default-keyserver-address): Change to + subkeys.pgp.net. From Michael Shields + +2003-10-01 Simon Josefsson + + * message.el (message-idna-to-ascii-rhs-1): RHS can be terminated + by ',', as in 'foo@example.org, bar@example.org'. + +2003-10-01 Jesper Harder + + * message.el (message-send): Fix reversed logic of supersedes + check. + +2003-09-30 Reiner Steib + + * gnus-art.el (gnus-article-view-part-as-charset): Doc fix, + suggested by Norbert Koch . + +2003-09-29 Katsumi Yamaoka + + * gnus-topic.el (gnus-topic-goto-missing-topic): Revert 2003-02-09 + change in order to correct the position where an invisible topic + (because gnus-topic-display-empty-topics is nil) may be inserted. + +2003-09-22 Katsumi Yamaoka + + * message.el (message-ignored-supersedes-headers): Add X-Payment. + +2003-09-20 Jesper Harder + + * rfc2047.el (rfc2047-encode): Limit line length to 76 characters. + +2003-09-20 Simon Josefsson + + * tls.el (tls-process-connection-type): Doc fix. + + * imap.el (imap-starttls-open): Rewrite, should support both old + starttls.el and new starttls.el that uses GNUTLS. + +2003-09-18 Katsumi Yamaoka + + * gnus-art.el (gnus-treat-display-x-face): Use set-default instead + of custom-set-default which isn't available in old XEmacsen. + +2003-09-17 Jesper Harder + + * gnus-msg.el (gnus-summary-resend-message-edit): Don't convert + to MML. MIME -> MML -> MIME does not work for PGP/MIME. + + * message.el (message-bounce, message-forward-show-mml): do. + +2003-09-13 Jesper Harder + + * rfc2047.el (rfc2047-charset-encoding-alist): Add viscii. + (rfc2047-encode): Add factors for big5, gb2312 and euc-kr. + + * nnweb.el (nnweb-google-parse-1): Fix parsing. + +2003-09-12 Jesper Harder + + * gnus-group.el (gnus-group-fetch-control): ISC changed + compression from .Z to .gz. + + * rfc2047.el (rfc2047-header-encoding-alist): Add "Approved" to + address-mime. + +2003-09-11 Jesper Harder + + * rfc2047.el (rfc2047-encode): Restrict encoded-words to 75 + characters. + +2003-09-10 Jesper Harder + + * gnus.el (gnus-group-charter-alist): Update. + +2003-09-10 Teodor Zlatanov + + * spam-report.el: use mm-url.el functions for external URL + loading when the built-in HTTP GET is insufficient (e.g. proxies + are in the way). From Eric Knauel + . + (spam-report-url-ping-function): new option, defaults to the + built-in HTTP GET (spam-report-url-ping-plain) + (spam-report-url-ping): calls spam-report-url-ping-function now + (spam-report-url-ping-plain): new function, does what + spam-report-url-ping used to do + (spam-report-url-ping-mm-url): function that delegates to + mm-url.el (autoloaded) + +2003-09-08 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-delete-id): function to + completely delete an ID, including all the cache hashtables + (gnus-registry-delete-group): use gnus-registry-delete-id + (gnus-registry-simplify-subject): only run if the argument is a + string, return nil otherwise + +2003-09-07 Jesper Harder + + * gnus-msg.el (gnus-summary-resend-bounced-mail): Docstring fix. + +2003-09-05 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): yet + another error *sigh* + + * gnus-registry.el (gnus-registry-fetch-extra-entry): don't use + puthash unless gnus-registry-entry-caching is on + (gnus-registry-split-fancy-with-parent): misplaced parenthesis + made everything a part of the 'else' + (gnus-registry-save): used 'entry-caching' instead of 'caching' + +2003-09-05 Jesper Harder + + * gnus-art.el (gnus-button-alist): Improve Info regexp. + +2003-09-04 Teodor Zlatanov + + * gnus-registry.el: added brief explanation of basics + (gnus-registry-track-extra): new variable for tracking of message + subjects + (gnus-registry-entry-caching): caching parameter, used for extra + data + (gnus-registry-minimum-subject-length): minimum subject length + before it's considered when tracing subjects + (gnus-registry-save): accomodate extra data entry caching + (gnus-registry-action): change function name, add the subject and + pass it to gnus-registry-add-group + (gnus-registry-spool-action): change function name, add the + subject and pass it to gnus-registry-add-group + (gnus-registry-split-fancy-with-parent): add subject tracking + (gnus-registry-register-message-ids): pass subject to + gnus-registry-add-group + (gnus-registry-simplify-subject) + (gnus-registry-fetch-simplified-message-subject-fast): new + functions + (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): add + extra data entry caching + (gnus-registry-add-group): handle the extra subject parameter + (gnus-registry-install-hooks, gnus-registry-unload-hook): fix the + gnus-register-* function names + + * nnmail.el (nnmail-cache-insert): add subject parameter, pass it + on to the nnmail-spool-hook + + * nnbabyl.el (nnbabyl-request-accept-article): added subject to + nnmail-cache-insert call + + * nndiary.el (nndiary-request-accept-article): added subject to + nnmail-cache-insert call + + * nnfolder.el (nnfolder-request-accept-article): added subject to + nnmail-cache-insert call + + * nnimap.el (nnimap-split-articles): added subject to + nnmail-cache-insert call + (nnimap-request-accept-article): added subject to + nnmail-cache-insert call + + * nnmbox.el (nnmbox-request-accept-article): added subject to + nnmail-cache-insert call + + * nnmh.el (nnmh-request-accept-article): added subject to + nnmail-cache-insert call + + * nnml.el (nnml-request-accept-article): added subject to + nnmail-cache-insert call + +2003-09-04 Jesper Harder + + * gnus-art.el (gnus-button-handle-info-url) + (gnus-button-handle-info-url-gnome) + (gnus-button-handle-info-url-kde, gnus-button-alist): Handle GNOME + and KDE style Info URLs. + + * gnus-util.el (gnus-url-unhex-string): Don't replace "+" with " ". + +2003-09-02 Jesper Harder + + * rfc2047.el (rfc2047-fold-region): Don't fold at the beginning + of the field. + +2003-09-01 Simon Josefsson + + * mml.el (mml-insert-mime-headers-always): New variable. + (mml-insert-mime-headers): Use it. Based on (tiny) patch from + Lars Balker Rasmussen . + +2003-08-30 Simon Josefsson + + * mail-source.el (mail-source-fetch-imap): Pass correct buffer to + imap-open, reverts 2003-03-17 change. Reverse remove before + calling gnus-compress-sequence. From Gaute Strokkenes + (tiny change). + +2003-08-29 Simon Josefsson + + * gnus-group.el (gnus-group-delete-group): Doc fix. Suggested by + Jochen K,A|(Bpper . + +2003-08-29 Katsumi Yamaoka + + * gnus-art.el (article-display-x-face): Make it possible to set + the gnus-article-x-face-command variable to the lambda form. + +2003-08-27 Simon Josefsson + + * mm-decode.el (mm-remove-part): Try to kill external displayers + cleanly first (if it refuses, C-g aborts loop and kill process + unconditionally). Also make sure process is dead before we remove + the files it may be using. Reported by David Coe + . + +2003-08-27 Jesper Harder + + * gnus-cache.el (gnus-cache-generate-active): Fix bug in + replacement. From Vagn Johansen (tiny + change). + +2003-08-25 Katsumi Yamaoka + + * gnus-art.el: Don't use defvaralias. + (gnus-treat-display-x-face): Warn if the obsolete variable + `gnus-treat-display-xface' exists. + +2003-08-25 Jesper Harder + + * gnus-art.el (gnus-treat-display-face): Fix typo. + (gnus-treat-display-xface): Rename to gnus-treat-display-x-face + (reported by Jochen K,A|(Bpper ) + +2003-08-24 Jesper Harder + + * gnus-art.el (gnus-header-button-alist, gnus-button-alist): Fix + type. + +2003-08-22 Jesper Harder + + * message.el (message-make-forward-subject-function): Fix + customize mismatch. + + * gnus.el (gnus-message-archive-method): do. + +2003-08-20 Reiner Steib + + * gnus.el (gnus-read-group): Offer to continue only if the invalid + char is `/' and add more information for the user. + + * gnus-art.el (gnus-button-alist): Add `+' (gnus-button-handle-man). + (gnus-header-button-alist): Added `In-Reply-To'. + + * nnimap.el (nnimap-open-connection): Allow different user names + on the same server (and in the same authinfo file). + +2003-08-20 Jesper Harder + + * gnus-sieve.el (gnus-sieve-crosspost): Fix type. + + * message.el (message-make-forward-subject-function): Add + message-forward-subject-name-subject to choices. + + * gnus-art.el (gnus-article-edit-done, gnus-article-edit-exit): + Redisplay article after editing. + +2003-08-20 Simon Josefsson + + * gnus.el (gnus-read-group): Added check to ask confirmation if + Group name contains invalid character. You can use '/' in IMAP, + but not in filenames. G m cannot know what the user is creating, + so let user decide. See thread m2oeysiev3.fsf@naima.lensflare.org. + Tiny patch from letters@hotpop.com (Jari Aalto+mail.linux). + +2003-08-13 Reiner Steib + + * gnus-score.el (gnus-summary-score-effect): Fix interactive use. + +2003-08-10 Teodor Zlatanov + + * gnus-draft.el (gnus-draft-send-all-messages): ask if all drafts + should be sent unless gnus-expert-user is on + +2003-08-09 Jesper Harder + + * pgg-gpg.el (pgg-gpg-extra-args): Fix customization type. + +2003-08-07 Jesper Harder + + * pgg-gpg.el (pgg-gpg-process-region): Bind + default-enable-multibyte-characters to nil. + +2003-08-07 Katsumi Yamaoka + + * canlock.el (canlock-password): Fix customization type. + (canlock-password-for-verify): Ditto. + * deuglify.el (gnus-outlook-deuglify-unwrap-min): Ditto. + (gnus-outlook-deuglify-unwrap-max): Ditto. + (gnus-outlook-deuglify-unwrap-stop-chars): Ditto. + * gnus-sum.el (gnus-sum-thread-tree-root): Ditto. + (gnus-sum-thread-tree-false-root): Ditto. + (gnus-sum-thread-tree-single-indent): Ditto. + * message.el (message-archive-note): Ditto. + (message-subscribed-address-file): Ditto. + (message-user-fqdn): Ditto. + * spam-report.el (spam-report-gmane-regex): Ditto. + * spam.el (spam-blackhole-good-server-regex): Ditto. + + * gnus-start.el (gnus-save-killed-list): Fix last change. + * message.el (message-courtesy-message): Ditto. + +2003-08-07 Jesper Harder + + * gnus-art.el (gnus-header-face-alist): Revert previous change. + (gnus-header-newsgroups-face): Explain that it's only used for + crossposts. + +2003-08-07 Katsumi Yamaoka + + * gnus-registry.el (gnus-registry-max-entries): Fix customization + type. + * gnus-score.el (gnus-adaptive-word-length-limit): Ditto. + * gnus.el (gnus-refer-article-method): Ditto. + * message.el (message-courtesy-message): Ditto. + +2003-08-06 Jesper Harder + + * gnus-art.el (gnus-header-face-alist): Fix "Newsgroups" entry. + From Chunyu Wang (tiny patch) + +2003-08-05 Katsumi Yamaoka + + * gnus-start.el (gnus-save-killed-list): Fix customization type. + * gnus-sum.el (gnus-thread-hide-subtree): Ditto. + * gnus.el (gnus-use-long-file-name): Ditto. + +2003-08-04 Jesper Harder + + * gnus-group.el (gnus-group-rename-group): Don't allow renaming to + an existing name. + + * gnus-sum.el (gnus-summary-highlight): Add uncached to docstring. + + * nnmail.el (nnmail-large-newsgroup): Docstring fix. + + * nntp.el (nntp-large-newsgroup): do. + + * nnspool.el (nnspool-large-newsgroup): do. + + * gnus-cus.el (gnus-group-parameters): Typo. + +2003-07-31 Simon Josefsson + + * mml-sec.el (mml-signencrypt-style-alist): Use separate S/MIME + method by default (revert partial 2003-07-10 patch). + +2003-07-28 Dave Love + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el: Require cl when compiling. + +2003-07-26 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-install): add an initial + registry read to the loading when gnus-registry-install is set + +2003-07-26 Kai Gro,A_(Bjohann + + * flow-fill.el (fill-flowed): Empty lines separate paragraphs + even if the preceding line ends with a soft break. Tiny patch + from Mark Thomas . + +2003-07-25 Teodor Zlatanov + + * spam.el (spam-use-regex-body, spam-regex-body-spam) + (spam-regex-body-ham): new variables, default to nil/empty/empty + (spam-install-hooks): added spam-use-regex-body to list or + pre-install conditions + (spam-list-of-checks): added spam-use-regex-body and + spam-check-regex-body to list of checks + (spam-list-of-statistical-checks): added spam-use-regex-body to + list of statistical checks + (spam-check-regex-body): invokes spam-check-regex-headers with + appropriate variable masking + (spam-check-regex-headers): changes to print "body" or "header" + where appropriate + +2003-07-25 Jesper Harder + + * smime.el (smime-ask-passphrase): Use read-passwd rather than + comint-read-noecho. The former is more secure. + +2003-07-24 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-cache-whitespace): make "adding + whitespace" message level 5 instead of 4 + (gnus-registry-clean-empty-function): new function to remove empty + registry entries + (gnus-registry-clean-empty): new variable to enable cleaning the + registry when saving it by calling gnus-registry-clean-empty-function + + * spam.el (spam-summary-prepare-exit): use spam-process-ham-in-spam-groups + (spam-process-ham-in-spam-groups): new variable + +2003-07-24 Jesper Harder + + * pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options. + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el, pgg.el: Reapply changes + from 2003-04-03 to fix security problem. See + http://www.debian.org/security/2003/dsa-339 + +2003-07-23 Teodor Zlatanov + + * gnus.el (gnus-install-group-spam-parameters): add the + gnus-ticked-mark to the possible choices of ham marks + + * spam.el (spam-process-ham-in-nonham-groups): new variable + (spam-summary-prepare-exit): use spam-process-ham-in-nonham-groups + +2003-07-23 Jesper Harder + + * rfc2047.el (rfc2047-header-encoding-alist): Add Mail-Followup-To + and Mail-Copies-To to address-mime. + (rfc2047-narrow-to-field): Use rfc2047-point-at-bol. + +2003-07-19 Jesper Harder + + * mm-util.el (mm-coding-system-priorities): Docstring improvement. + +2003-07-17 Jesper Harder + + * gnus-sum.el (gnus-thread-latest-date): Move condition-case to + the right place. + +2003-07-14 Simon Josefsson + + * mail-source.el (mail-source-fetch-imap): Don't assume + imap-error-text returns something. + +2003-07-12 Nevin Kapur + + * nnimap.el (nnimap-request-newgroups): Use the pattern in + nnimap-list-pattern instead of "*". + +2003-07-10 Simon Josefsson + + * mml-sec.el (mml-signencrypt-style-alist): Use "combined" by + default. Improve docstring. + +2003-07-10 Kai Gro,A_(Bjohann + + * imap.el (imap-arrival-filter): Fix test for missing process + buffer. + +2003-07-09 Kai Gro,A_(Bjohann + From Gaute B Strokkenes (tiny patch). + + * imap.el (imap-wait-for-tag): Clarify comment. Use timeout zero + for second, after-process-has-died, accept-process-output. + (imap-arrival-filter): If PROC has no buffer, do nothing. + +2003-07-09 Jesper Harder + + * flow-fill.el: Docstring and message fixes. + + * deuglify.el: do. + + * gnus-int.el: do. + + * gnus-msg.el: do. + + * gnus-util.el: do. + + * gnus-draft.el: do. + + * gnus-start.el: do. + + * gnus.el: do. + + * gnus-group.el: do. + + * gnus-art.el: do. + + * gnus-sum.el: do. + + * mail-source.el (mail-source-movemail): Handle non-numerical + return values. + +2003-07-08 Jesper Harder + + * mailcap.el (mailcap-parse-args-syntax-table) + (mailcap-viewer-passes-test): Docstring fix. + + * mm-bodies.el (mm-long-lines-p): Docstring fix. + + * mm-decode.el (mm-w3m-safe-url-regexp, mm-verify-option) + (mm-decrypt-option, mm-handle-set-external-undisplayer) + (mm-file-name-replace-whitespace): Docstring fix. + + * mm-uu.el (mm-uu-emacs-sources-regexp): Docstring fix. + (mm-uu-pgp-signed-test): Fix message. + + * mml.el (mml-tweak-sexp-alist): Docstring fix. + (mml-parse-1, mml-insert-mime-headers): Fix message. + + * message.el (message-archive-header) + (message-subscribed-address-functions) + (message-subscribed-addresses, message-subscribed-regexps) + (message-canlock-generate) + (message-generate-new-buffer-clone-locals): Docstring fixes. + +2003-07-07 Kai Gro,A_(Bjohann + + * imap.el (imap-wait-for-tag): After the process has died, look + for more output still pending. From Gaute B Strokkenes + (tiny patch). + +2003-07-07 Teodor Zlatanov + + * spam.el (spam-bogofilter-score): redisplay article normally + after spam-bogofilter-score is called + +2003-07-06 Jesper Harder + + * message.el (message-send-mail-with-sendmail): Handle + non-numeric return values. + + * gnus-sum.el (gnus-print-buffer): Apply emphasis. + From Michael Piotrowski (tiny change). + + * gnus-start.el (gnus-clear-system): Revert change from + 2003-06-19. + +2003-07-04 Dave Love + + * rfc2047.el (rfc2047-q-encode-region): Exclude especials from + characters not encoded, and make the list more legible. + +2003-07-04 Jesper Harder + + * message.el (message-make-from): Revert change from 2002-01-08. + +2003-06-29 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-init-server-buffer): Don't add + nntp-server-buffer to list of Gnus buffers. + +2003-06-25 Teodor Zlatanov + + * spam.el (spam-parse-list): prevent empty ("") strings + +2003-06-24 Teodor Zlatanov + + * spam.el (spam-parse-list): use gnus-extract-address-components + instead of ietf-drums-parse-addresses + (spam-from-listed-p): let* was unnecessary + +2003-06-24 Lars Magne Ingebrigtsen + + * gnus-ems.el (gnus-put-image): Mark the right text segment with + gnus-image-category. + + * gnus-srvr.el (gnus-browse-unsubscribe-group): Strip prefix from + native groups. + + * gnus-topic.el (gnus-group-prepare-topics): Update topic line + format specs. + + * gnus-picon.el: Written by moi, moi, moi. + + * gnus-group.el (gnus-group-kill-group): Clean up. + +2003-06-23 Teodor Zlatanov + + * spam.el (spam-from-listed-p, spam-parse-list): use + ietf-drums-parse-addresses to extract the address portion of the + whitelist/blacklist file if it looks like an address can be found + +2003-06-23 Didier Verna + + * gnus-ems.el (gnus-put-image): New argument CATEGORY. Add it as a + text property. + (gnus-remove-image): New argument CATEGORY. Only remove if + category matches. + * gnus-xmas.el (gnus-xmas-put-image): + (gnus-xmas-remove-image): Ditto, with extents. + * gnus-art.el (gnus-delete-images): Pass CATEGORY argument to + gnus-[xmas-]remove-image. + (article-display-face): Don't always act as a toggle. Call + `gnus-put-image' with CATEGORY argument. + (article-display-x-face): Call `gnus-put-image' with CATEGORY + argument. + * smiley.el (smiley-region): Ditto. + * gnus-fun.el (gnus-display-x-face-in-from): Ditto. + * gnus-picon.el (gnus-picon-insert-glyph): Ditto. + (gnus-treat-mail-picon): Don't always act as a toggle. + * gnus-picon.el (gnus-treat-newsgroups-picon): Ditto. + +2003-06-23 Didier Verna + + * gnus-art.el (article-display-face): Check for existence of the + original article buffer before switching to it. + +2003-06-20 Jesper Harder + + * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by + Dan Jacobson . + + * mm-view.el (mm-inline-message): Bind + gnus-original-article-buffer to the buffer in the mml handle + holding the message. + +2003-06-20 Katsumi Yamaoka + + * message.el (sender, from): No need to bind them. + +2003-06-19 Teodor Zlatanov + + * spam.el (spam-enter-list): search-forward specified wrong + +2003-06-19 Lars Magne Ingebrigtsen + + * gnus-art.el: Comment fix. + +2003-06-20 Jesper Harder + + * gnus-msg.el (gnus-configure-posting-styles): Remove unused + variable. From Jan Rychter . + + * spam.el (spam-spamoracle-learn): insert-string is obsolete. + +2003-06-19 Teodor Zlatanov + + * spam.el (spam-enter-list): do not enter duplicate addresses into + the whitelist/blacklist + +2003-06-19 Jesper Harder + + * nnheader.el (nnheader-init-server-buffer): Add + nntp-server-buffer to gnus-buffers. + + * gnus-start.el (gnus-clear-system): Now we don't need to kill + nntp-server-buffer separately. + +2003-06-18 Didier Verna + + * gnus-art.el (article-display-face): Correctly toggle between + display and hiding. Handle multiple Face headers. + +2003-06-17 Dave Love + + * nnimap.el: Require cl when compiling. + + * message.el (message-fix-before-sending): Reinstate nullifying + the invisible text property. + (sender, from): Defvar when compiling. + (message-is-yours-p): Remove autoload cookie. + +2003-06-17 Reiner Steib + + * gnus-util.el (gnus-extract-address-components): Added + doc-string. + +2003-06-16 Kai Gro,A_(Bjohann + + * nnml.el (nnml-current-group-article-to-file-alist): Don't read + overview when using compressed files. From Michael Albinus + . + +2003-06-16 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-refer-parent-article): Extract + Message-ID from In-Reply-To header. + +2003-06-16 Katsumi Yamaoka + + * message.el (message-is-yours-p): Narrow to head; extract from + and sender by itself. + (message-cancel-news, message-supersede): Remove useless things. + +2003-06-15 Reiner Steib + + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind + `gnus-article-emulate-mime'. + +2003-06-15 Kai Gro,A_(Bjohann + From Tommi Vainikainen . + + * message.el (message-is-yours-p): New function. Separated common + code from message-cancel-news and message-supersede. Added + matching code which uses message-alternative-emails regexp as last + resort. + (message-cancel-news, message-supersede): Use message-is-yours-p. + +2003-06-13 Kai Gro,A_(Bjohann + + * nnimap.el (nnimap-split-articles): Narrow the right buffer to + the headers. From Niklas Morberg . + +2003-06-12 Dave Love + + * nnheader.el (nnheader-functionp): Deleted. + + * nnmail.el (nnmail-split-fancy-syntax-table): Define all in + defvar. + (nnmail-version): Deleted. + (nnmail-check-duplication, nnmail-expiry-target-group): Don't use + nnheader-functionp. + +2003-06-10 Teodor Zlatanov + + * spam.el (spam-check-bogofilter-headers): fix for when the score + is requested but the message is not spam + +2003-06-09 Teodor Zlatanov + From Eric + + + * spam.el (spam-use-spamoracle): new variable + (spam-install-hooks): add spamoracle to the list of conditions + for activation of spam-install-hooks + (spam-spamoracle): new variable customization group + (spam-spamoracle, spam-spamoracle): new variables + (spam-group-spam-processor-spamoracle-p) + (spam-group-ham-processor-spamoracle-p): new functions + (spam-summary-prepare-exit): added spamoracle ham/spam exit processing + (spam-list-of-checks, spam-list-of-statistical-checks): add + spam-use-spamoracle + (spam-check-spamoracle, spam-spamoracle-learn) + (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): new functions + + * gnus.el (gnus-group-spam-exit-processor-spamoracle) + (gnus-group-ham-exit-processor-spamoracle): new variables for SpamOracle + (spam-process, ham-process): added spamoracle spam/ham processors + +2003-06-08 Jesper Harder + + * message.el (message-beginning-of-line): Docstring improvement. + Suggested by Michael R. Wolf + +2003-06-07 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-make-menu-bar): Removed ["Add buttons" + gnus-summary-display-buttonized t] + +2003-06-07 Kai Gro,A_(Bjohann + + * nnmail.el (nnmail-split-fancy-match-partial-words): Doc string + fix. Reported by Johan Bockg,Ae(Brd . + +2003-06-07 Jesper Harder + + * message.el (message-beginning-of-line): Docstring improvement. + +2003-06-06 Jesper Harder + + * gnus-srvr.el (gnus-browse-foreign-server): Parse garbage NNTP + groups correctly. + +2003-06-06 Kai Gro,A_(Bjohann + From Benjamin Rutt . + + * message.el (message-fetch-field): Augment documentation to state + the narrowed-to-headers restriction. + (message-change-subject, message-reduce-to-to-cc) + (message-generate-unsubscribed-mail-followup-to) + (message-insert-importance-high, message-insert-importance-low) + (message-insert-or-toggle-importance) + (message-insert-disposition-notification-to): Narrow to headers + before calling message-fetch-field or message-remove-header. + +2003-06-06 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-trim): fix for when + gnus-registry-max-entries is nil + +2003-06-05 Lars Magne Ingebrigtsen + + * qp.el (quoted-printable-decode-region): Don't error out on + malformed text. + +2003-06-04 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-encode-region): Don't error out on invalid + strings. + +2003-06-04 Jesper Harder + + * mml1991.el (mml1991-pgg-sign): Insert pgg output as unibyte. + From: Ivan Boldyrev (tiny + change) + +2003-06-03 Dave Love + + * gnus-soup.el (gnus-soup-send-packet): Don't use + message-functionp. + + * gnus.el (gnus-agent-cache): Doc fix. + (gnus-other-frame): Quote lambda used as hook. + + * message.el: Doc fixes. + (message-functionp): Deleted. Callers changed. + (message-fix-before-sending): Highlight with overlays. Clarify + `illegible text' messages. + (rmail-enable-mime-composing, gnus-message-group-art): Defvar when + compiling. + (gnus-find-method-for-group, nnvirtual-find-group-art): Autoload. + +2003-06-03 Kai Gro,A_(Bjohann + + * nnmail.el (nnmail-split-fancy-match-partial-words): New user + option. + (nnmail-split-it): Obey it. Don't let-bind regexp twice. + + * message.el (message-fetch-field): Mention narrow-to-headers + requirement. + +2003-06-03 Jesper Harder + + * gnus-xmas.el (gnus-xmas-create-image): Use + insert-file-contents-literally. From: Eric Eide + + +2003-06-02 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-fetch-group): always return the + short name of the group + +2003-06-02 Jesper Harder + + * gnus-cus.el (defvar): Silence byte-compiler warnings. + + * gnus-sum.el (gnus-get-newsgroup-headers): Unfold headers. + +2003-05-31 Jesper Harder + + * gnus-art.el (article-unsplit-urls): Use gnus-treat-article + rather than gnus-display-mime-function. + +2003-05-30 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-use-long-group-names): new variable + (gnus-registry-add-group): use it + (gnus-registry-trim-articles-without-groups): new variable + (gnus-registry-delete-group): use it + (gnus-registry-unload-hook): uninstall all the hooks + + * spam.el (spam-install-hooks-function, spam-unload-hook): new + functions so users that load spam.el for customization don't get + all the hooks installed + (spam-install-hooks): new variable, set to t by default if user + has one of the spam-use-* variables set + + * spam-stat.el (spam-stat-install-hooks, spam-stat-unload-hook): new + functions so users that load spam-stat.el for customization don't get + all the hooks installed + +2003-05-30 Dave Love + + * rfc2047.el (rfc2047-decode): Don't use + mm-with-unibyte-current-buffer. + + * qp.el (quoted-printable-decode-string): Use + mm-with-unibyte-buffer. + +2003-05-29 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-save): allow forced saving even + when registry is not dirty. Use gnus-registry-trim to shorten the + gnus-registry-alist. + (gnus-registry-max-entries): new variable + (gnus-registry-trim): new function, trim gnus-registry-alist to + size gnus-registry-max-entries, sorting by entry mtime so the + newest entries stick around + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): instead of + just one specific variable, allow a list of specific variables + +2003-05-28 Dave Love + + * rfc2047.el (rfc2047-encode-region): Skip ASCII at beginning and + end of region. + +2003-05-28 Jesper Harder + + * lpath.el: Add put-char-table and get-char-table. + +2003-05-28 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-dirty): flag for modified registry + (gnus-registry-save, gnus-registry-read) + (gnus-registry-store-extra, gnus-registry-clear): use it (note + that gnus-registry-store-extra is invoked for all modifications to + set the mtime, so gnus-registry-dirty only needs to be set there) + +2003-05-23 Simon Josefsson + + * mml1991.el (mml1991-pgg-sign): Use mml-sender instead of + message-sender. + + * gnus-art.el (gnus-use-idna): Check if idna-program is installed. + + * message.el (message-use-idna): Ditto. + +2003-05-20 Dave Love + + * rfc2047.el (rfc2047-q-encoding-alist): Deleted. + (rfc2047-q-encode-region): Don't use it. + (rfc2047-encode-message-header) <(eq method 'mime)>: Bind + rfc2047-encoding-type to `mime'. + (rfc2047-encode-string, rfc2047-encode): Doc fix. + +2003-05-20 Jesper Harder + + * message.el (message-send-mail): Don't insert a courtesy copy + notice in base64 encoded messages. + +2003-05-16 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-move-article): Don't copy expirable + marks if the destination group is not auto-expirable. + +2003-05-14 Katsumi Yamaoka + + * dgnushack.el (assq-delete-all): Removed the compiler macro. + +2003-05-14 Kevin Greiner + + * gnus-agent.el (gnus-agentize): Updated documentation to match + usage. + (gnus-agent-expire-group-1): Do not skip over a group when the + force argument is set. + * gnus.el (gnus-agent): Updated documentation to reflect that + gnus-agent now defaults to t. + +2003-05-14 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + 2003-05-14 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.10.2 is released. 2003-05-14 Lars Magne Ingebrigtsen - * mail-source.el (mail-source-delete-incoming): Changed to t. + * mail-source.el (mail-source-delete-incoming): Changed to t. * rfc2047.el (rfc2047-syntax-table): Funcall. - * lpath.el ((featurep 'xemacs)): Added set-char-table-range. + * lpath.el ((featurep 'xemacs)): Added set-char-table-range. ((featurep 'xemacs)): No, don't. - * rfc2047.el (rfc2047-encodable-p): Use the header charset. + * rfc2047.el (rfc2047-encodable-p): Use the header charset. * gnus-sum.el (gnus-summary-reselect-current-group): Supply - leave-hidden. + leave-hidden. 2003-05-14 Jonathan Kamens * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny - patch.) + patch.) 2003-05-13 Lars Magne Ingebrigtsen * gnus-registry.el (gnus-registry-store-extra-entry): Use - gnus-assq-delete-all. + gnus-assq-delete-all. * gnus-xmas.el (gnus-xmas-assq-delete-all): New function. - * message.el (message-ignored-bounced-headers): Add Delivered-To. + * message.el (message-ignored-bounced-headers): Add Delivered-To. * gnus-sum.el (gnus-summary-find-next): Indent. (gnus-summary-find-prev): Ditto. @@ -38,7 +2185,7 @@ * gnus-util.el (gnus-user-date): Use %d instead of %m. (gnus-user-date): Use floating point time so that we don't get - overflows. + overflows. * gnus-sum.el (gnus-summary-local-variables): Clean up. @@ -64,8 +2211,8 @@ 2003-05-12 Teodor Zlatanov * gnus-registry.el (gnus-registry-install): new variable - (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry) - (gnus-registry-store-extra-entry, gnus-registry-delete-group) + (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry) + (gnus-registry-store-extra-entry, gnus-registry-delete-group) (gnus-registry-add-group): add a modification timestamp to each entry (gnus-registry-install-hooks): new function @@ -82,10 +2229,17 @@ references to each field's symbol. gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable. (gnus-select-newgroup): Initialize it. - (gnus-summary-highlight-line): Use it. + (gnus-summary-highlight-line): Use it. 2003-05-12 Dave Love + * mm-util.el (mm-read-charset): Deleted. + (mm-coding-system-mime-charset): New. + (mm-read-coding-system, mm-mule-charset-to-mime-charset) + (mm-charset-to-coding-system, mm-mime-charset) + (mm-find-mime-charset-region): Use it. + (mm-default-multibyte-p): Fix non-mule case. + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval and compile. (rfc2047-syntax-table): Fix building table to work in Emacs 22. @@ -100,7 +2254,7 @@ 2003-05-11 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added - space. + space. 2003-05-11 Jesper Harder @@ -204,7 +2358,7 @@ * message.el (message-setup-1): Setup alternative email before generate-headers. - + (message-forward-subject-name-subject): Fix the case when the field "from" doesn't exist. @@ -378,9 +2532,9 @@ * gnus.el (gnus-install-group-spam-parameters): docstring fix. From Jon Ericson (tiny change) - * gnus-registry.el (gnus-registry-fetch-extra) + * gnus-registry.el (gnus-registry-fetch-extra) (gnus-registry-store-extra, gnus-registry-group-count): new functions - (gnus-registry-fetch-group, gnus-registry-delete-group) + (gnus-registry-fetch-group, gnus-registry-delete-group) (gnus-registry-add-group): changed to work with extra data element if present @@ -413,12 +2567,12 @@ 2003-05-01 Lars Magne Ingebrigtsen - * spam-stat.el (spam-stat-test-directory): Compare against zero. + * spam-stat.el (spam-stat-test-directory): Compare against zero. 2003-05-01 Trey Jackson (tiny change) * spam-stat.el (spam-stat-test-directory): Skip 0 length files. - + 2003-05-01 Lars Magne Ingebrigtsen * message.el (message-forward-subject-name-subject): Decode @@ -466,7 +2620,7 @@ 2003-05-01 Lars Magne Ingebrigtsen * message.el (message-check-news-header-syntax): Alter "posting" - message. + message. * nnrss.el (nnrss-node-text): Don't use char classes. @@ -568,7 +2722,7 @@ (gnus-registry-add-group): new function (gnus-register-spool-action): use it (gnus-register-action): use it - (gnus-registry-translate-from-alist) + (gnus-registry-translate-from-alist) (gnus-registry-translate-to-alist): remove the headers registry for now @@ -638,8 +2792,8 @@ 2003-04-27 Reiner Steib - * gnus-art.el (gnus-mime-display-multipart-as-mixed) - (gnus-mime-display-multipart-alternative-as-mixed) + * gnus-art.el (gnus-mime-display-multipart-as-mixed) + (gnus-mime-display-multipart-alternative-as-mixed) (gnus-mime-display-multipart-related-as-mixed): Added doc-strings, allow customization. @@ -650,7 +2804,7 @@ 2003-04-27 Lars Magne Ingebrigtsen - * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages. + * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages. (gnus-summary-mark-read-and-unread-as-read): Take an optional mark. @@ -670,13 +2824,13 @@ * gnus-sum.el (gnus-summary-catchup-from-here): Doc fix. * nnrss.el (nnrss-node-text): Use only one - gnus-replace-in-string. + gnus-replace-in-string. * gnus.el: Remove gnus-functionp throughout. * gnus-util.el (gnus-functionp): Removed. - * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. + * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. * message.el (message-required-headers): Add In-Reply-To. @@ -730,7 +2884,7 @@ systems property. * mml-sec.el (mml2015, mml1991): Don't require. - (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt) + (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt) (message-goto-body, mml-insert-tag): Autoload. * mm-decode.el (mm-tmp-directory): Re-write to help avoid warnings. @@ -749,7 +2903,7 @@ 2003-04-24 Reiner Steib - * gnus-group.el (gnus-large-ephemeral-newsgroup) + * gnus-group.el (gnus-large-ephemeral-newsgroup) (gnus-fetch-old-ephemeral-headers): News variables. (gnus-group-read-ephemeral-group): Use them. @@ -1039,7 +3193,7 @@ * message.el (message-hide-headers): Don't do intangible. * gnus.el (gnus-group-prefixed-name): Comment out the test for - colon. + colon. * gnus-srvr.el (gnus-browse-read-group): Don't give the real name to the ephemeral entry, but the prefixed name. @@ -1068,7 +3222,7 @@ 2003-04-13 Lars Magne Ingebrigtsen - * gnus-draft.el (gnus-draft-send): Add message-hidden-headers. + * gnus-draft.el (gnus-draft-send): Add message-hidden-headers. 2003-04-12 Lars Magne Ingebrigtsen @@ -1079,7 +3233,7 @@ * message.el (message-newline-and-reformat): Place a boundary before filling. (message-make-forward-subject-function): Changed default to - message-forward-subject-name-subject. + message-forward-subject-name-subject. (message-forward-subject-name-subject): New function. * nnimap.el (nnimap-split-fancy): Ditto. @@ -1095,7 +3249,7 @@ (message-fix-before-sending): Make hidden headers visible. (message-hide-headers): Bind after-change-functions to nil. (message-forbidden-properties): Put invisible and intangible - back. + back. (message-strip-forbidden-properties): Ignore message-hidden text. * gnus-msg.el: Hide headers. @@ -1105,7 +3259,7 @@ (message-hide-header-p): New function. (message-hide-header-p): Change logic. (message-forbidden-properties): Remove intangible nil invisible - nil. + nil. (message-hide-headers): Narrow to headers. * lpath.el (featurep): Bind Info-directory, Info-menu. @@ -1244,7 +3398,7 @@ (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do. * pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do. - + 2003-04-05 Teodor Zlatanov * spam.el (spam-split): (save-excursion) around (widen) @@ -1362,7 +3516,7 @@ nnheader-accept-process-output. (pop3-retr): Ditto. - * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. + * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. (mm-text-html-washer-alist): Ditto. 2003-03-31 Simon Josefsson @@ -1406,7 +3560,7 @@ 2003-03-30 Lars Magne Ingebrigtsen - * nndoc.el (nndoc-type-alist): Move mime-parts further ahead. + * nndoc.el (nndoc-type-alist): Move mime-parts further ahead. * gnus-registry.el (gnus-registry-translate-to-alist): Make a valid lambda. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 38099cb..b0b5447 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -19,7 +19,7 @@ all total: clean-some gnus-load.el $(EMACS_COMP) -f dgnushack-compile clean-some: - rm -f *.elc gnus-load.el + rm -f *.elc gnus-load.el auto-autoloads.* custom-load.* warn: clean-some gnus-load.el $(EMACS_COMP) --eval '(dgnushack-compile t)' 2>&1 | egrep -v "variable G|inhibit-point-motion-hooks|coding-system|temp-results|variable gnus|variable nn|scroll-in-place|deactivate-mark|filladapt-mode|byte-code-function-p|print-quoted|ps-right-header|ps-left-header|article-inhibit|print-escape|ssl-program-arguments|message-log-max" @@ -75,7 +75,7 @@ gnus-load.el: $(EMACS_COMP) -f dgnushack-make-load distclean: - rm -f *.orig *.rej *.elc *~ Makefile + rm -f *.orig *.rej *.elc auto-autoloads.* custom-load.* *~ Makefile Makefile: $(srcdir)/Makefile.in ../config.status cd .. \ diff --git a/lisp/canlock.el b/lisp/canlock.el index ee97fd3..55b2e59 100644 --- a/lisp/canlock.el +++ b/lisp/canlock.el @@ -83,12 +83,14 @@ (defcustom canlock-password nil "Password to use when signing a Cancel-Lock or a Cancel-Key header." - :type 'string + :type '(radio (const :format "Not specified " nil) + (string :tag "Password" :size 0)) :group 'canlock) (defcustom canlock-password-for-verify canlock-password "Password to use when verifying a Cancel-Lock or a Cancel-Key header." - :type 'string + :type '(radio (const :format "Not specified " nil) + (string :tag "Password" :size 0)) :group 'canlock) (defcustom canlock-force-insert-header nil diff --git a/lisp/deuglify.el b/lisp/deuglify.el index 7327e1b..383841e 100644 --- a/lisp/deuglify.el +++ b/lisp/deuglify.el @@ -204,7 +204,7 @@ ;; Renamed `gnus-outlook-deuglify-article' to ;; `gnus-article-outlook-deuglify-article'. ;; Made it easier to deuglify the article while being in Gnus' Article -;; Edit Mode. (suggested by Phil Nitschke) +;; Edit Mode. (suggested by Phil Nitschke) ;; ;; ;; Revision 1.3 2002/01/02 23:35:54 rscholz @@ -235,13 +235,13 @@ ;;;###autoload (defcustom gnus-outlook-deuglify-unwrap-min 45 "Minimum length of the cited line above the (possibly) wrapped line." - :type 'number + :type 'integer :group 'gnus-outlook-deuglify) ;;;###autoload (defcustom gnus-outlook-deuglify-unwrap-max 95 "Maximum length of the cited line after unwrapping." - :type 'number + :type 'integer :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-cite-marks ">|#%" @@ -251,7 +251,8 @@ (defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line." - :type 'string + :type '(radio (const :format "None " nil) + (string :size 0 :value ".?!")) :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-no-wrap-chars "`" @@ -300,10 +301,10 @@ It is run after `gnus-article-prepare-hook'." ;;;###autoload (defun gnus-article-outlook-unwrap-lines (&optional nodisplay) - "Unwrap lines that appear to be wrapped citation lines. + "Unwrap lines that appear to be wrapped citation lines. You can control what lines will be unwrapped by frobbing `gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max', -indicating the miminum and maximum length of an unwrapped citation line. If +indicating the minimum and maximum length of an unwrapped citation line. If NODISPLAY is non-nil, don't redisplay the article buffer." (interactive "P") (save-excursion @@ -324,13 +325,13 @@ NODISPLAY is non-nil, don't redisplay the article buffer." (len3 (- (match-end 3) (match-beginning 3)))) (if (and (> len12 gnus-outlook-deuglify-unwrap-min) (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max)) - (progn + (progn (replace-match "\\1\\2 \\3") (goto-char (match-beginning 0))))))))) (unless nodisplay (gnus-outlook-display-article-buffer))) (defun gnus-outlook-rearrange-article (attr-start) - "Put the text from `attr-start' to the end of buffer at the top of the article buffer." + "Put the text from ATTR-START to the end of buffer at the top of the article buffer." (save-excursion (let ((inhibit-read-only t) (cite-marks gnus-outlook-deuglify-cite-marks)) diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 1064b5f..4d4b30b 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -50,18 +50,6 @@ ;; Define compiler macros for the functions provided by cl in old Emacsen. (unless (featurep 'xemacs) - (define-compiler-macro assq-delete-all (&whole form key alist) - (if (>= emacs-major-version 21) - form - `(let* ((key ,key) - (alist ,alist) - (tail alist)) - (while tail - (if (and (consp (car tail)) (eq (car (car tail)) key)) - (setq alist (delq (car tail) alist))) - (setq tail (cdr tail))) - alist))) - (define-compiler-macro butlast (&whole form x &optional n) (if (>= emacs-major-version 21) form @@ -90,7 +78,24 @@ (define-compiler-macro remove (&whole form item seq) (if (>= emacs-major-version 21) form - `(delete ,item (copy-sequence ,seq))))) + `(delete ,item (copy-sequence ,seq)))) + + (define-compiler-macro mapc (&whole form fn seq &rest rest) + (if (>= emacs-major-version 21) + form + (if rest + `(let* ((fn ,fn) + (seq ,seq) + (args (list seq ,@rest)) + (m (apply (function min) (mapcar (function length) args))) + (n 0)) + (while (< n m) + (apply fn (mapcar (function (lambda (arg) (nth n arg))) args)) + (setq n (1+ n))) + seq) + `(let ((seq ,seq)) + (mapcar ,fn seq) + seq))))) ;; If we are building w3 in a different directory than the source ;; directory, we must read *.el from source directory and write *.elc @@ -120,6 +125,43 @@ ; (cons 'progn (cdr form))) ;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun) +(when (and (not (featurep 'xemacs)) + (= emacs-major-version 21) + (= emacs-minor-version 3) + (condition-case code + (let ((byte-compile-error-on-warn t)) + (byte-optimize-form (quote (pop x)) t) + nil) + (error (string-match "called for effect" + (error-message-string code))))) + (defadvice byte-optimize-form-code-walker (around silence-warn-for-pop + (form for-effect) + activate) + "Silence the warning \"...called for effect\" for the `pop' form. +It is effective only when the `pop' macro is defined by cl.el rather +than subr.el." + (let (tmp) + (if (and (eq (car-safe form) 'car) + for-effect + (setq tmp (get 'car 'side-effect-free)) + (not byte-compile-delete-errors) + (not (eq tmp 'error-free)) + (eq (car-safe (cadr form)) 'prog1) + (let ((var (cadr (cadr form))) + (last (nth 2 (cadr form)))) + (and (symbolp var) + (null (nthcdr 3 (cadr form))) + (eq (car-safe last) 'setq) + (eq (cadr last) var) + (eq (car-safe (nth 2 last)) 'cdr) + (eq (cadr (nth 2 last)) var)))) + (progn + (put 'car 'side-effect-free 'error-free) + (unwind-protect + ad-do-it + (put 'car 'side-effect-free tmp))) + ad-do-it)))) + (push srcdir load-path) (load (expand-file-name "lpath.el" srcdir) nil t) @@ -202,6 +244,9 @@ dgnushack-compile." (defun dgnushack-compile (&optional warn) ;;(setq byte-compile-dynamic t) + (when (and (not (featurep 'xemacs)) + (< emacs-major-version 21)) + (setq max-specpdl-size 1200)) (unless warn (setq byte-compile-warnings '(free-vars unresolved callargs redefine))) @@ -265,15 +310,25 @@ Modify to suit your needs.")) (require 'gnus) (byte-recompile-directory "." 0)) -(defvar dgnushack-gnus-load-file (expand-file-name "gnus-load.el")) -(defvar dgnushack-cus-load-file (expand-file-name "cus-load.el")) +(defvar dgnushack-gnus-load-file + (if (featurep 'xemacs) + (expand-file-name "auto-autoloads.el") + (expand-file-name "gnus-load.el"))) + +(defvar dgnushack-cus-load-file + (if (featurep 'xemacs) + (expand-file-name "custom-load.el") + (expand-file-name "cus-load.el"))) (defun dgnushack-make-cus-load () (load "cus-dep") (let ((cusload-base-file dgnushack-cus-load-file)) (if (fboundp 'custom-make-dependencies) (custom-make-dependencies) - (Custom-make-dependencies)))) + (Custom-make-dependencies)) + (when (featurep 'xemacs) + (message "Compiling %s..." dgnushack-cus-load-file) + (byte-compile-file dgnushack-cus-load-file)))) (defun dgnushack-make-auto-load () (require 'autoload) @@ -302,43 +357,44 @@ Modify to suit your needs.")) (batch-update-autoloads))) (defun dgnushack-make-load () - (message "Generating %s..." dgnushack-gnus-load-file) - (with-temp-file dgnushack-gnus-load-file - (insert-file-contents dgnushack-cus-load-file) - (delete-file dgnushack-cus-load-file) - (goto-char (point-min)) - (search-forward ";;; Code:") - (forward-line) - (delete-region (point-min) (point)) - (insert "\ + (unless (featurep 'xemacs) + (message "Generating %s..." dgnushack-gnus-load-file) + (with-temp-file dgnushack-gnus-load-file + (insert-file-contents dgnushack-cus-load-file) + (delete-file dgnushack-cus-load-file) + (goto-char (point-min)) + (search-forward ";;; Code:") + (forward-line) + (delete-region (point-min) (point)) + (insert "\ ;;; gnus-load.el --- automatically extracted custom dependencies and autoload ;; ;;; Code: ") - (goto-char (point-max)) - (if (search-backward "custom-versions-load-alist" nil t) + (goto-char (point-max)) + (if (search-backward "custom-versions-load-alist" nil t) + (forward-line -1) + (forward-line -1) + (while (eq (char-after) ?\;) + (forward-line -1)) + (forward-line)) + (delete-region (point) (point-max)) + (insert "\n") + ;; smiley-* are duplicated. Remove them all. + (let ((point (point))) + (insert-file-contents dgnushack-gnus-load-file) + (goto-char point) + (while (search-forward "smiley-" nil t) + (beginning-of-line) + (if (looking-at "(autoload ") + (delete-region (point) (progn (forward-sexp) (point))) + (forward-line)))) + ;; + (goto-char (point-max)) + (when (search-backward "\n(provide " nil t) (forward-line -1) - (forward-line -1) - (while (eq (char-after) ?\;) - (forward-line -1)) - (forward-line)) - (delete-region (point) (point-max)) - (insert "\n") - ;; smiley-* are duplicated. Remove them all. - (let ((point (point))) - (insert-file-contents dgnushack-gnus-load-file) - (goto-char point) - (while (search-forward "smiley-" nil t) - (beginning-of-line) - (if (looking-at "(autoload ") - (delete-region (point) (progn (forward-sexp) (point))) - (forward-line)))) - ;; - (goto-char (point-max)) - (when (search-backward "\n(provide " nil t) - (forward-line -1) - (delete-region (point) (point-max))) - (insert "\ + (delete-region (point) (point-max))) + (insert "\ \(provide 'gnus-load) @@ -349,18 +405,22 @@ Modify to suit your needs.")) ;;; End: ;;; gnus-load.el ends here ") - ;; Workaround the bug in some version of XEmacs. - (when (featurep 'xemacs) - (condition-case nil - (require 'cus-load) - (error nil)) - (goto-char (point-min)) - (when (and (fboundp 'custom-add-loads) - (not (search-forward "\n(autoload 'custom-add-loads " nil t))) - (search-forward "\n;;; Code:" nil t) - (forward-line 1) - (insert "\n(autoload 'custom-add-loads \"cus-load\")\n")))) + )) (message "Compiling %s..." dgnushack-gnus-load-file) - (byte-compile-file dgnushack-gnus-load-file)) + (byte-compile-file dgnushack-gnus-load-file) + (when (featurep 'xemacs) + (message "Creating dummy gnus-load.el...") + (with-temp-file (expand-file-name "gnus-load.el") + (insert "\ + +\(provide 'gnus-load) + +;;; Local Variables: +;;; version-control: never +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: +;;; gnus-load.el ends here")))) + ;;; dgnushack.el ends here diff --git a/lisp/dns.el b/lisp/dns.el index f23e87a..5d572fa 100644 --- a/lisp/dns.el +++ b/lisp/dns.el @@ -281,8 +281,9 @@ If TCP-P, the first two bytes of the package with be the length field." (setq dns-servers (nreverse dns-servers))))) ;;; Interface functions. - -(autoload 'gnus-xmacs-open-network-stream "gnus-xmas" nil nil 'macro) +(eval-when-compile + (when (featurep 'xemacs) + (require 'gnus-xmas))) (defmacro dns-make-network-process (server) (if (featurep 'xemacs) @@ -311,45 +312,46 @@ If TCP-P, the first two bytes of the package with be the length field." If FULLP, return the entire record returned." (setq type (or type 'A)) (unless dns-servers - (dns-parse-resolv-conf) - (unless dns-servers - (error "No DNS server configuration found"))) - (mm-with-unibyte-buffer - (let ((process (condition-case () - (dns-make-network-process (car dns-servers)) - (error - (message "dns: Got an error while trying to talk to %s" - (car dns-servers)) - nil))) - (tcp-p (and (not (fboundp 'make-network-process)) - (not (featurep 'xemacs)))) - (step 100) - (times (* dns-timeout 1000)) - (id (random 65000))) - (when process - (process-send-string - process - (dns-write `((id ,id) - (opcode query) - (queries ((,name (type ,type)))) - (recursion-desired-p t)) - tcp-p)) - (while (and (zerop (buffer-size)) - (> times 0)) - (accept-process-output process 0 step) - (decf times step)) - (ignore-errors - (delete-process process)) - (when tcp-p - (goto-char (point-min)) - (delete-region (point) (+ (point) 2))) - (unless (zerop (buffer-size)) - (let ((result (dns-read (buffer-string)))) - (if fullp - result - (let ((answer (car (dns-get 'answers result)))) - (when (eq type (dns-get 'type answer)) - (dns-get 'data answer)))))))))) + (dns-parse-resolv-conf)) + + (if (not dns-servers) + (message "No DNS server configuration found") + (mm-with-unibyte-buffer + (let ((process (condition-case () + (dns-make-network-process (car dns-servers)) + (error + (message "dns: Got an error while trying to talk to %s" + (car dns-servers)) + nil))) + (tcp-p (and (not (fboundp 'make-network-process)) + (not (featurep 'xemacs)))) + (step 100) + (times (* dns-timeout 1000)) + (id (random 65000))) + (when process + (process-send-string + process + (dns-write `((id ,id) + (opcode query) + (queries ((,name (type ,type)))) + (recursion-desired-p t)) + tcp-p)) + (while (and (zerop (buffer-size)) + (> times 0)) + (accept-process-output process 0 step) + (decf times step)) + (ignore-errors + (delete-process process)) + (when tcp-p + (goto-char (point-min)) + (delete-region (point) (+ (point) 2))) + (unless (zerop (buffer-size)) + (let ((result (dns-read (buffer-string)))) + (if fullp + result + (let ((answer (car (dns-get 'answers result)))) + (when (eq type (dns-get 'type answer)) + (dns-get 'data answer))))))))))) (provide 'dns) diff --git a/lisp/flow-fill.el b/lisp/flow-fill.el index dcdd475..cec7739 100644 --- a/lisp/flow-fill.el +++ b/lisp/flow-fill.el @@ -1,6 +1,6 @@ ;;; flow-fill.el --- interprete RFC2646 "flowed" text -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: mail @@ -47,6 +47,7 @@ ;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule ;; work when first line is at level 0. ;; 2002-01-12 probably incomplete encoding support +;; 2003-12-08 started working on test harness. ;;; Code: @@ -54,7 +55,7 @@ (defcustom fill-flowed-display-column 'fill-column "Column beyond which format=flowed lines are wrapped, when displayed. -This can be a lisp expression or an integer." +This can be a Lisp expression or an integer." :type '(choice (const :tag "Standard `fill-column'" fill-column) (const :tag "Fit Window" (- (window-width) 5)) (sexp) @@ -62,7 +63,7 @@ This can be a lisp expression or an integer." (defcustom fill-flowed-encode-column 66 "Column beyond which format=flowed lines are wrapped, in outgoing messages. -This can be a lisp expression or an integer. +This can be a Lisp expression or an integer. RFC 2646 suggests 66 characters for readability." :type '(choice (const :tag "Standard fill-column" fill-column) (const :tag "RFC 2646 default (66)" 66) @@ -80,6 +81,7 @@ RFC 2646 suggests 66 characters for readability." 'point-at-eol 'line-end-position))) +;;;###autoload (defun fill-flowed-encode (&optional buffer) (with-current-buffer (or buffer (current-buffer)) ;; No point in doing this unless hard newlines is used. @@ -101,6 +103,7 @@ RFC 2646 suggests 66 characters for readability." (goto-char (setq start (1+ end))))) t))) +;;;###autoload (defun fill-flowed (&optional buffer) (save-excursion (set-buffer (or (current-buffer) buffer)) @@ -127,7 +130,7 @@ RFC 2646 suggests 66 characters for readability." (save-excursion (unless (eobp) (forward-char 1) - (looking-at (format "^\\(%s\\)\\([^>]\\)" + (looking-at (format "^\\(%s\\)\\([^>\n\r]\\)" (or quote " ?")))))) (save-excursion (replace-match (if (string= (match-string 2) " ") @@ -147,6 +150,71 @@ RFC 2646 suggests 66 characters for readability." (forward-line 1) nil)))))))) +;; Test vectors. + +(eval-when-compile + (defvar show-trailing-whitespace)) + +(defvar fill-flowed-encode-tests + '( + ;; The syntax of each list element is: + ;; (INPUT . EXPECTED-OUTPUT) + ("> Thou villainous ill-breeding spongy dizzy-eyed +> reeky elf-skinned pigeon-egg! +>> Thou artless swag-bellied milk-livered +>> dismal-dreaming idle-headed scut! +>>> Thou errant folly-fallen spleeny reeling-ripe +>>> unmuzzled ratsbane! +>>>> Henceforth, the coding style is to be strictly +>>>> enforced, including the use of only upper case. +>>>>> I've noticed a lack of adherence to the coding +>>>>> styles, of late. +>>>>>> Any complaints? +" . "> Thou villainous ill-breeding spongy dizzy-eyed reeky elf-skinned +> pigeon-egg! +>> Thou artless swag-bellied milk-livered dismal-dreaming idle-headed +>> scut! +>>> Thou errant folly-fallen spleeny reeling-ripe unmuzzled ratsbane! +>>>> Henceforth, the coding style is to be strictly enforced, +>>>> including the use of only upper case. +>>>>> I've noticed a lack of adherence to the coding styles, of late. +>>>>>> Any complaints? +") +; (" +;> foo +;> +;> +;> bar +;" . " +;> foo bar +;") + )) + +(defun fill-flowed-test () + (interactive "") + (switch-to-buffer (get-buffer-create "*Format=Flowed test output*")) + (erase-buffer) + (setq show-trailing-whitespace t) + (dolist (test fill-flowed-encode-tests) + (let (start output) + (insert "***** BEGIN TEST INPUT *****\n") + (insert (car test)) + (insert "***** END TEST INPUT *****\n\n") + (insert "***** BEGIN TEST OUTPUT *****\n") + (setq start (point)) + (insert (car test)) + (save-restriction + (narrow-to-region start (point)) + (fill-flowed)) + (setq output (buffer-substring start (point-max))) + (insert "***** END TEST OUTPUT *****\n") + (unless (string= output (cdr test)) + (insert "\n***** BEGIN TEST EXPECTED OUTPUT *****\n") + (insert (cdr test)) + (insert "***** END TEST EXPECTED OUTPUT *****\n")) + (insert "\n\n"))) + (goto-char (point-max))) + (provide 'flow-fill) ;;; flow-fill.el ends here diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index b75ed8b..04b3342 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -70,11 +70,9 @@ (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 you wish to disable Agent expiring, see `gnus-agent-enable-expiration'." :group 'gnus-agent - :type '(choice (number :tag "days") - (sexp :tag "List" nil))) + :type '(number :tag "days")) (defcustom gnus-agent-expire-all nil "If non-nil, also expire unread, ticked and dormant articles. @@ -146,7 +144,13 @@ If this is `ask' the hook will query the user." :group 'gnus-agent) (defcustom gnus-agent-consider-all-articles nil - "If non-nil, consider also the read articles for downloading." + "When non-`nil', the agent will let the agent predicate decide +whether articles need to be downloaded or not, for all articles. When +`nil', the default, the agent will only let the predicate decide +whether unread articles are downloaded or not. If you enable this, +groups with large active ranges may open slower and you may also want +to look into the agent expiry settings to block the expiration of +read articles as they would just be downloaded again." :version "21.4" :type 'boolean :group 'gnus-agent) @@ -170,9 +174,19 @@ enable expiration per categories, topics, and groups." (const :format "Disable " DISABLE))) (defcustom gnus-agent-expire-unagentized-dirs t -"Have gnus-agent-expire scan the directories under -\(gnus-agent-directory) for groups that are no longer agentized. When -found, offer to remove them.") + "*Whether expiration should expire in unagentized directories. +Have gnus-agent-expire scan the directories under +\(gnus-agent-directory) for groups that are no longer agentized. +When found, offer to remove them." + :type 'boolean + :group 'gnus-agent) + +(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap) + "Initially, all servers from these methods are agentized. +The user may remove or add servers using the Server buffer. +See Info node `(gnus)Server Buffer'." + :type '(repeat symbol) + :group 'gnus-agent) ;;; Internal variables @@ -202,11 +216,6 @@ NOTES: (defvar gnus-agent-file-loading-cache nil) (defvar gnus-agent-file-header-cache nil) -(defvar gnus-agent-auto-agentize-methods '(nntp nnimap) - "Initially, all servers from these methods are agentized. -The user may remove or add servers using the Server buffer. See Info -node `(gnus)Server Buffer'.") - ;; Dynamic variables (defvar gnus-headers) (defvar gnus-score) @@ -556,7 +565,7 @@ manipulated as follows: (defun gnus-agent-close-connections () "Close all methods covered by the Gnus agent." - (let ((methods gnus-agent-covered-methods)) + (let ((methods (gnus-agent-covered-methods))) (while methods (gnus-close-server (pop methods))))) @@ -584,10 +593,10 @@ manipulated as follows: ;;;###autoload (defun gnus-agentize () "Allow Gnus to be an offline newsreader. -The normal usage of this command is to put the following as the -last form in your `.gnus.el' file: -\(gnus-agentize) +The gnus-agentize function is now called internally by gnus when +gnus-agent is set. If you wish to avoid calling gnus-agentize, +customize gnus-agent to nil. This will modify the `gnus-setup-news-hook', and `message-send-mail-real-function' variables, and install the Gnus agent @@ -598,18 +607,24 @@ 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 - (mapcar - (lambda (server) - (if (memq (car (gnus-server-to-method server)) - gnus-agent-auto-agentize-methods) - (setq gnus-agent-covered-methods - (cons (gnus-server-to-method server) - gnus-agent-covered-methods )))) - (append (list gnus-select-method) gnus-secondary-select-methods)))) + ;; If the servers file doesn't exist, auto-agentize some servers and + ;; save the servers file so this auto-agentizing isn't invoked + ;; again. + (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers")) + (gnus-message 3 "First time agent user, agentizing remote groups...") + (mapc + (lambda (server-or-method) + (let ((method (gnus-server-to-method server-or-method))) + (when (memq (car method) + gnus-agent-auto-agentize-methods) + (push (gnus-method-to-server method) + gnus-agent-covered-methods) + (setq gnus-agent-method-p-cache nil)))) + (cons gnus-select-method gnus-secondary-select-methods)) + (gnus-agent-write-servers))) (defun gnus-agent-queue-setup (&optional group-name) "Make sure the queue group exists. @@ -747,7 +762,7 @@ be a select method." "Synchronize unplugged flags with servers." (interactive) (save-excursion - (dolist (gnus-command-method gnus-agent-covered-methods) + (dolist (gnus-command-method (gnus-agent-covered-methods)) (when (file-exists-p (gnus-agent-lib-file "flags")) (gnus-agent-synchronize-flags-server gnus-command-method))))) @@ -755,7 +770,7 @@ be a select method." "Synchronize flags according to `gnus-agent-synchronize-flags'." (interactive) (save-excursion - (dolist (gnus-command-method gnus-agent-covered-methods) + (dolist (gnus-command-method (gnus-agent-covered-methods)) (when (file-exists-p (gnus-agent-lib-file "flags")) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) @@ -790,46 +805,80 @@ be a select method." ;;; Server mode commands ;;; -(defun gnus-agent-add-server (server) +(defun gnus-agent-add-server () "Enroll SERVER in the agent program." - (interactive (list (gnus-server-server-name))) - (unless server - (error "No server on the current line")) - (let ((method (gnus-server-get-method nil (gnus-server-server-name)))) + (interactive) + (let* ((server (gnus-server-server-name)) + (named-server (gnus-server-named-server)) + (method (and server + (gnus-server-get-method nil server)))) + (unless server + (error "No server on the current line")) + (when (gnus-agent-method-p method) (error "Server already in the agent program")) - (push method gnus-agent-covered-methods) + + (push named-server gnus-agent-covered-methods) + + (setq gnus-agent-method-p-cache nil) (gnus-server-update-server server) (gnus-agent-write-servers) (gnus-message 1 "Entered %s into the Agent" server))) -(defun gnus-agent-remove-server (server) +(defun gnus-agent-remove-server () "Remove SERVER from the agent program." - (interactive (list (gnus-server-server-name))) - (unless server - (error "No server on the current line")) - (let ((method (gnus-server-get-method nil (gnus-server-server-name)))) - (unless (gnus-agent-method-p method) + (interactive) + (let* ((server (gnus-server-server-name)) + (named-server (gnus-server-named-server))) + (unless server + (error "No server on the current line")) + + (unless (member named-server gnus-agent-covered-methods) (error "Server not in the agent program")) - (setq gnus-agent-covered-methods - (delete method gnus-agent-covered-methods)) + + (setq gnus-agent-covered-methods + (delete named-server gnus-agent-covered-methods) + gnus-agent-method-p-cache nil) + (gnus-server-update-server server) (gnus-agent-write-servers) (gnus-message 1 "Removed %s from the agent" server))) (defun gnus-agent-read-servers () "Read the alist of covered servers." - (mapcar (lambda (m) - (let ((method (gnus-server-get-method - nil - (or m "native")))) - (if method - (unless (member method gnus-agent-covered-methods) - (push method gnus-agent-covered-methods)) - (gnus-message 1 "Ignoring disappeared server `%s'" m) - (sit-for 1)))) - (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/servers")))) + (setq gnus-agent-covered-methods + (gnus-agent-read-file + (nnheader-concat gnus-agent-directory "lib/servers")) + gnus-agent-method-p-cache nil) + + ;; I am called so early in start-up that I can not validate server + ;; names. When that is the case, I skip the validation. That is + ;; alright as the gnus startup code calls the validate methods + ;; directly. + (if gnus-server-alist + (gnus-agent-read-servers-validate))) + +(defun gnus-agent-read-servers-validate () + (mapcar (lambda (server-or-method) + (let* ((server (if (stringp server-or-method) + server-or-method + (gnus-method-to-server server-or-method))) + (method (gnus-server-to-method server))) + (if method + (unless (member server gnus-agent-covered-methods) + (push server gnus-agent-covered-methods) + (setq gnus-agent-method-p-cache nil)) + (gnus-message 1 "Ignoring disappeared server `%s'" server)))) + (prog1 gnus-agent-covered-methods + (setq gnus-agent-covered-methods nil)))) + +(defun gnus-agent-read-servers-validate-native (native-method) + (setq gnus-agent-covered-methods + (mapcar (lambda (method) + (if (or (not method) + (equal method native-method)) + "native" + method)) gnus-agent-covered-methods))) (defun gnus-agent-write-servers () "Write the alist of covered servers." @@ -837,7 +886,7 @@ be a select method." (let ((coding-system-for-write nnheader-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 (mapcar 'gnus-method-simplify gnus-agent-covered-methods) + (prin1 gnus-agent-covered-methods (current-buffer))))) ;;; @@ -1109,6 +1158,27 @@ This can be added to `gnus-select-article-hook' or ;; will add it while reading the file. (gnus-write-active-file file old nil)))) +(defun gnus-agent-possibly-alter-active (group active) + "Possibly expand a group's active range to include articles +downloaded into the agent." + +;; I can't use the agent's active file here as there is no practical +;; mechanism to update the active ranges in that file as the oldest +;; articles are removed from the agent. + (let* ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (alist (gnus-agent-load-alist group))) + + (let ((new-min (or (caar gnus-agent-article-alist) + (car active))) + (new-max (or (caar (last gnus-agent-article-alist)) + (cdr active)))) + + (when (< new-min (car active)) + (setcar active new-min)) + (when (> new-max (cdr active)) + (setcdr active new-max))))) + (defun gnus-agent-save-groups (method) (gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format)) @@ -1176,6 +1246,10 @@ This can be added to `gnus-select-article-hook' or (require 'nnagent) 'nnagent)) +(defun gnus-agent-covered-methods () + "Return the subset of methods that are covered by the agent." + (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods))) + ;;; History functions (defun gnus-agent-history-buffer () @@ -1700,9 +1774,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (setq uncomp (cons (cons article-id state) uncomp))) sequence))) alist) - (setq alist (sort uncomp - (lambda (first second) - (< (car first) (car second)))))))) + (setq alist (sort uncomp 'car-less-than-car))))) (when changed-version (let ((gnus-agent-article-alist alist)) (gnus-agent-save-alist gnus-agent-read-agentview))) @@ -1784,7 +1856,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (error "No servers are covered by the Gnus agent")) (unless gnus-plugged (error "Can't fetch articles while Gnus is unplugged")) - (let ((methods gnus-agent-covered-methods) + (let ((methods (gnus-agent-covered-methods)) groups group gnus-command-method) (save-excursion (while methods @@ -2405,22 +2477,58 @@ The following commands are available: (defun gnus-predicate-implies-unread (predicate) "Say whether PREDICATE implies unread articles only. It is okay to miss some cases, but there must be no false positives. -That is, if this function returns true, then indeed the predicate must +That is, if this predicate returns true, then indeed the predicate must return only unread articles." - (gnus-function-implies-unread-1 (gnus-category-make-function predicate))) + (eq t (gnus-function-implies-unread-1 + (gnus-category-make-function-1 predicate)))) (defun gnus-function-implies-unread-1 (function) - (cond ((eq function (symbol-function 'gnus-agent-read-p)) - nil) - ((not function) - nil) - ((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)))) + "Recursively evaluate a predicate function to determine whether it can select +any read articles. Returns t if the function is known to never +return read articles, nil when it is known to always return read +articles, and t_nil when the function may return both read and unread +articles." + (let ((func (car function)) + (args (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (cond ((eq func 'and) + (cond ((memq t args) ; if any argument returns only unread articles + ;; then that argument constrains the result to only unread articles. + t) + ((memq 't_nil args) ; if any argument is indeterminate + ;; then the result is indeterminate + 't_nil))) + ((eq func 'or) + (cond ((memq nil args) ; if any argument returns read articles + ;; then that argument ensures that the results includes read articles. + nil) + ((memq 't_nil args) ; if any argument is indeterminate + ;; then that argument ensures that the results are indeterminate + 't_nil) + (t ; if all arguments return only unread articles + ;; then the result returns only unread articles + t))) + ((eq func 'not) + (cond ((eq (car args) 't_nil) ; if the argument is indeterminate + ; then the result is indeterminate + (car args)) + (t ; otherwise + ; toggle the result to be the opposite of the argument + (not (car args))))) + ((eq func 'gnus-agent-read-p) + nil) ; The read predicate NEVER returns unread articles + ((eq func 'gnus-agent-false) + t) ; The false predicate returns t as the empty set excludes all read articles + ((eq func 'gnus-agent-true) + nil) ; The true predicate ALWAYS returns read articles + ((catch 'found-match + (let ((alist gnus-category-predicate-alist)) + (while alist + (if (eq func (cdar alist)) + (throw 'found-match t) + (setq alist (cdr alist)))))) + 't_nil) ; All other predicates return read and unread articles + (t + (error "Unknown predicate function: %s" function))))) (defun gnus-group-category (group) "Return the category GROUP belongs to." @@ -2459,29 +2567,32 @@ FORCE is equivalent to setting the expiration predicates to true." (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 - (let ((active-file (gnus-agent-lib-file "active"))) - (when (file-exists-p active-file) - (with-temp-buffer - (nnheader-insert-file-contents active-file) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (save-excursion - (gnus-agent-expire-group-1 - group overview (gnus-gethash-safe group orig) - articles force)) - (gnus-agent-write-active active-file orig t))) - (kill-buffer overview)))) - (gnus-message 4 "Expiry...done"))) + (let ( ;; Bind gnus-agent-expire-stats to enable tracking of + ;; expiration statistics of this single group + (gnus-agent-expire-stats (list 0 0 0.0))) + (if (or (not (eq articles t)) + (yes-or-no-p + (concat "Are you sure that you want to " + "expire all articles in " group "."))) + (let ((gnus-command-method (gnus-find-method-for-group group)) + (overview (gnus-get-buffer-create " *expire overview*")) + orig) + (unwind-protect + (let ((active-file (gnus-agent-lib-file "active"))) + (when (file-exists-p active-file) + (with-temp-buffer + (nnheader-insert-file-contents active-file) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (save-excursion + (gnus-agent-expire-group-1 + group overview (gnus-gethash-safe group orig) + articles force)) + (gnus-agent-write-active active-file orig t))) + (kill-buffer overview)))) + (gnus-message 4 (gnus-agent-expire-done-message))))) (defun gnus-agent-expire-group-1 (group overview active articles force) ;; Internal function - requires caller to have set @@ -2494,12 +2605,18 @@ FORCE is equivalent to setting the expiration predicates to true." (cons dir (symbol-value 'gnus-agent-expire-current-dirs)))) - (if (eq 'DISABLE (gnus-agent-find-parameter group - 'agent-enable-expiration)) + (if (and (not force) + (eq 'DISABLE (gnus-agent-find-parameter group + 'agent-enable-expiration))) (gnus-message 5 "Expiry skipping over %s" group) (gnus-message 5 "Expiring articles in %s" group) (gnus-agent-load-alist group) - (let* ((info (gnus-get-info group)) + (let* ((stats (if (boundp 'gnus-agent-expire-stats) + ;; Use the list provided by my caller + (symbol-value 'gnus-agent-expire-stats) + ;; otherwise use my own temporary list + (list 0 0 0.0))) + (info (gnus-get-info group)) (alist gnus-agent-article-alist) (day (- (time-to-days (current-time)) (gnus-agent-find-parameter group 'agent-days-until-old))) @@ -2539,7 +2656,7 @@ FORCE is equivalent to setting the expiration predicates to true." (cons (caar alist) (caar (last alist)))) (sort articles '<))))) - (marked ;; More articles that are exluded from the + (marked ;; More articles that are excluded from the ;; expiration process (cond (gnus-agent-expire-all ;; All articles are unmarked by global decree @@ -2677,7 +2794,8 @@ line." (point) nov-file))) (while dlist (let ((new-completed (truncate (* 100.0 (/ (setq cnt (1+ cnt)) - len))))) + len)))) + message-log-max) (when (> new-completed completed) (setq completed new-completed) (gnus-message 7 "%3d%% completed..." completed))) @@ -2691,16 +2809,16 @@ line." (point) nov-file))) ;; Kept articles are unread, marked, or special. (keep (gnus-agent-message 10 - "gnus-agent-expire: Article %d: Kept %s article." - article-number keep) + "gnus-agent-expire: %s:%d: Kept %s article%s." + group article-number keep (if fetch-date " and file" "")) (when fetch-date (unless (file-exists-p (concat dir (number-to-string article-number))) (setf (nth 1 entry) nil) (gnus-agent-message 3 "gnus-agent-expire cleared \ -download flag on article %d as the cached article file is missing." - (caar dlist))) +download flag on %s:%d as the cached article file is missing." + group (caar dlist))) (unless marker (gnus-message 1 "gnus-agent-expire detected a \ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) @@ -2736,8 +2854,11 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (let ((actions nil)) (when (memq type '(forced expired)) (ignore-errors ; Just being paranoid. - (delete-file (concat dir (number-to-string - article-number))) + (let ((file-name (concat dir (number-to-string + article-number)))) + (incf (nth 2 stats) (nth 7 (file-attributes file-name))) + (incf (nth 1 stats)) + (delete-file file-name)) (push "expired cached article" actions)) (setf (nth 1 entry) nil) ) @@ -2745,7 +2866,13 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (when marker (push "NOV entry removed" actions) (goto-char marker) - (gnus-delete-line)) + + (incf (nth 0 stats)) + + (let ((from (gnus-point-at-bol)) + (to (progn (forward-line 1) (point)))) + (incf (nth 2 stats) (- to from)) + (delete-region from to))) ;; If considering all articles is set, I can only ;; expire article IDs that are no longer in the @@ -2759,13 +2886,14 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (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 ", ")))) + (when actions + (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" + group article-number + (mapconcat 'identity actions ", "))))) (t (gnus-agent-message - 10 "gnus-agent-expire: Article %d: Article kept as \ -expiration tests failed." article-number) + 10 "gnus-agent-expire: %s:%d: Article kept as \ +expiration tests failed." group article-number) (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) ) @@ -2820,10 +2948,13 @@ FORCE is equivalent to setting the expiration predicates to true." (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) + (let ((methods (gnus-agent-covered-methods)) ;; Bind gnus-agent-expire-current-dirs to enable tracking ;; of agent directories. (gnus-agent-expire-current-dirs nil) + ;; Bind gnus-agent-expire-stats to enable tracking of + ;; expiration statistics across all groups + (gnus-agent-expire-stats (list 0 0 0.0)) gnus-command-method overview orig) (setq overview (gnus-get-buffer-create " *expire overview*")) (unwind-protect @@ -2848,7 +2979,25 @@ articles in every agentized group.")) (gnus-agent-write-active active-file orig t)))) (kill-buffer overview)) (gnus-agent-expire-unagentized-dirs) - (gnus-message 4 "Expiry...done"))))) + (gnus-message 4 (gnus-agent-expire-done-message)))))) + +(defun gnus-agent-expire-done-message () + (if (and (> gnus-verbose 4) + (boundp 'gnus-agent-expire-stats)) + (let* ((stats (symbol-value 'gnus-agent-expire-stats)) + (size (nth 2 stats)) + (units '(B KB MB GB))) + (while (and (> size 1024.0) + (cdr units)) + (setq size (/ size 1024.0) + units (cdr units))) + + (format "Expiry recovered %d NOV entries, deleted %d files,\ + and freed %f %s." + (nth 0 stats) + (nth 1 stats) + size (car units))) + "Expiry...done")) (defun gnus-agent-expire-unagentized-dirs () (when (and gnus-agent-expire-unagentized-dirs @@ -2959,7 +3108,12 @@ articles in every agentized group.")) (gnus-agent-append-to-list tail-unread candidate) nil) ((> candidate max) - (setq read (cdr read)))))))) + (setq read (cdr read)) + ;; return t so that I always loop one more + ;; time. If I just iterated off the end of + ;; read, min will become nil and the current + ;; candidate will be added to the unread list. + t)))))) (while known (gnus-agent-append-to-list tail-unread (car (pop known)))) (cdr unread))) @@ -3164,236 +3318,227 @@ If REREAD is not nil, downloaded articles are marked as unread." 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))) - (file (gnus-agent-article-name ".overview" group)) - (dir (file-name-directory file)) - point - (downloaded (if (file-exists-p dir) - (sort (mapcar (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)) - '>) - (progn (gnus-make-directory dir) nil))) - dl nov-arts - alist header - regenerated) - - (mm-with-unibyte-buffer - (if (file-exists-p file) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-file-contents file))) - (set-buffer-modified-p nil) - - ;; Load the article IDs found in the overview file. As a - ;; side-effect, validate the file contents. - (let ((load t)) - (while load - (setq load nil) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond ((and (looking-at "[0-9]+\t") - (<= (- (match-end 0) (match-beginning 0)) 9)) - (push (read (current-buffer)) nov-arts) - (forward-line 1) - (let ((l1 (car nov-arts)) - (l2 (cadr nov-arts))) - (cond ((not l2) - nil) - ((< l1 l2) - (gnus-message 3 "gnus-agent-regenerate-group: NOV\ + (catch 'mark + (while (let ((c (read-char-exclusive + "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n)" + ))) + (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N)) + (throw 'mark nil)) + ((or (eq c ?a) (eq c ?A)) + (throw 'mark t)) + ((or (eq c ?d) (eq c ?D)) + (throw 'mark 'some))) + (message "Ignoring unexpected input") + (sit-for 1) + t))))) + + (when group + (gnus-message 5 "Regenerating in %s" group) + (let* ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (file (gnus-agent-article-name ".overview" group)) + (dir (file-name-directory file)) + point + (downloaded (if (file-exists-p dir) + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '>) + (progn (gnus-make-directory dir) nil))) + dl nov-arts + alist header + regenerated) + + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (set-buffer-modified-p nil) + + ;; Load the article IDs found in the overview file. As a + ;; side-effect, validate the file contents. + (let ((load t)) + (while load + (setq load nil) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((and (looking-at "[0-9]+\t") + (<= (- (match-end 0) (match-beginning 0)) 9)) + (push (read (current-buffer)) nov-arts) + (forward-line 1) + (let ((l1 (car nov-arts)) + (l2 (cadr nov-arts))) + (cond ((not l2) + nil) + ((< l1 l2) + (gnus-message 3 "gnus-agent-regenerate-group: NOV\ entries are NOT in ascending order.") - ;; Don't sort now as I haven't verified - ;; that every line begins with a number - (setq load t)) - ((= l1 l2) - (forward-line -1) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + ;; Don't sort now as I haven't verified + ;; that every line begins with a number + (setq load t)) + ((= l1 l2) + (forward-line -1) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ entries contained duplicate of article %s. Duplicate deleted." l1) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)))))) - (t - (gnus-message 1 "gnus-agent-regenerate-group: NOV\ + (gnus-delete-line) + (setq nov-arts (cdr nov-arts)))))) + (t + (gnus-message 1 "gnus-agent-regenerate-group: NOV\ entries contained line that did not begin with an article number. Deleted\ line.") - (gnus-delete-line)))) - (if load - (progn - (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ + (gnus-delete-line)))) + (if load + (progn + (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ entries into ascending order.") - (sort-numeric-fields 1 (point-min) (point-max)) + (sort-numeric-fields 1 (point-min) (point-max)) (setq nov-arts nil))))) - (gnus-agent-check-overview-buffer) - - ;; Construct a new article alist whose nodes match every header - ;; in the .overview file. As a side-effect, missing headers are - ;; reconstructed from the downloaded article file. - (while (or downloaded nov-arts) - (cond ((and downloaded - (or (not nov-arts) - (> (car downloaded) (car nov-arts)))) - ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group - (car downloaded)) - (let ((file (concat dir (number-to-string (car downloaded))))) - (mm-with-unibyte-buffer - (nnheader-insert-file-contents file) - (nnheader-remove-body) - (setq header (nnheader-parse-naked-head))) - (mail-header-set-number header (car downloaded)) - (if nov-arts - (let ((key (concat "^" (int-to-string (car nov-arts)) - "\t"))) - (or (re-search-backward key nil t) - (re-search-forward key)) - (forward-line 1)) - (goto-char (point-min))) - (nnheader-insert-nov header)) - (setq nov-arts (cons (car downloaded) nov-arts))) - ((eq (car downloaded) (car nov-arts)) - ;; This entry in the overview has been downloaded - (push (cons (car downloaded) - (time-to-days - (nth 5 (file-attributes - (concat dir (number-to-string - (car downloaded))))))) alist) - (setq downloaded (cdr downloaded)) - (setq nov-arts (cdr nov-arts))) - (t - ;; This entry in the overview has not been downloaded - (push (cons (car nov-arts) nil) alist) - (setq nov-arts (cdr nov-arts))))) - - ;; When gnus-agent-consider-all-articles is set, - ;; gnus-agent-regenerate-group should NOT remove article IDs from - ;; the alist. Those IDs serve as markers to indicate that an - ;; attempt has been made to fetch that article's header. - - ;; When gnus-agent-consider-all-articles is NOT set, - ;; gnus-agent-regenerate-group can remove the article ID of every - ;; article (with the exception of the last ID in the list - it's - ;; special) that no longer appears in the overview. In this - ;; situtation, the last article ID in the list implies that it, - ;; and every article ID preceeding it, have been fetched from the - ;; server. - (if gnus-agent-consider-all-articles - ;; Restore all article IDs that were not found in the overview file. - (let* ((n (cons nil alist)) - (merged n) - (o (gnus-agent-load-alist group))) - (while o - (let ((nID (caadr n)) - (oID (caar o))) - (cond ((not nID) - (setq n (setcdr n (list (list oID)))) - (setq o (cdr o))) - ((< oID nID) - (setcdr n (cons (list oID) (cdr n))) - (setq o (cdr o))) - ((= oID nID) - (setq o (cdr o)) - (setq n (cdr n))) - (t - (setq n (cdr n)))))) - (setq alist (cdr merged))) - ;; Restore the last article ID if it is not already in the new alist - (let ((n (last alist)) - (o (last (gnus-agent-load-alist group)))) - (cond ((not o) - nil) - ((not n) - (push (cons (caar o) nil) alist)) - ((< (caar n) (caar o)) - (setcdr n (list (car o))))))) - - (let ((inhibit-quit t)) - (if (setq regenerated (buffer-modified-p)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent))) - - (setq regenerated (or regenerated - (and reread gnus-agent-article-alist) - (not (equal alist gnus-agent-article-alist))) - ) - - (setq gnus-agent-article-alist alist) - - (when regenerated - (gnus-agent-save-alist group))) - ) - - (when (and reread gnus-agent-article-alist) - (gnus-make-ascending-articles-unread - group - (delq nil (mapcar (function (lambda (c) - (cond ((eq reread t) - (car c)) - ((cdr c) - (car c))))) - gnus-agent-article-alist))) - - (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t) - (sit-for 0)) - ) - - (gnus-message 5 nil) - regenerated)) + (gnus-agent-check-overview-buffer) + + ;; Construct a new article alist whose nodes match every header + ;; in the .overview file. As a side-effect, missing headers are + ;; reconstructed from the downloaded article file. + (while (or downloaded nov-arts) + (cond ((and downloaded + (or (not nov-arts) + (> (car downloaded) (car nov-arts)))) + ;; This entry is missing from the overview file + (gnus-message 3 "Regenerating NOV %s %d..." group + (car downloaded)) + (let ((file (concat dir (number-to-string (car downloaded))))) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (nnheader-remove-body) + (setq header (nnheader-parse-naked-head))) + (mail-header-set-number header (car downloaded)) + (if nov-arts + (let ((key (concat "^" (int-to-string (car nov-arts)) + "\t"))) + (or (re-search-backward key nil t) + (re-search-forward key)) + (forward-line 1)) + (goto-char (point-min))) + (nnheader-insert-nov header)) + (setq nov-arts (cons (car downloaded) nov-arts))) + ((eq (car downloaded) (car nov-arts)) + ;; This entry in the overview has been downloaded + (push (cons (car downloaded) + (time-to-days + (nth 5 (file-attributes + (concat dir (number-to-string + (car downloaded))))))) alist) + (setq downloaded (cdr downloaded)) + (setq nov-arts (cdr nov-arts))) + (t + ;; This entry in the overview has not been downloaded + (push (cons (car nov-arts) nil) alist) + (setq nov-arts (cdr nov-arts))))) + + ;; When gnus-agent-consider-all-articles is set, + ;; gnus-agent-regenerate-group should NOT remove article IDs from + ;; the alist. Those IDs serve as markers to indicate that an + ;; attempt has been made to fetch that article's header. + + ;; When gnus-agent-consider-all-articles is NOT set, + ;; gnus-agent-regenerate-group can remove the article ID of every + ;; article (with the exception of the last ID in the list - it's + ;; special) that no longer appears in the overview. In this + ;; situtation, the last article ID in the list implies that it, + ;; and every article ID preceeding it, have been fetched from the + ;; server. + + (if gnus-agent-consider-all-articles + ;; Restore all article IDs that were not found in the overview file. + (let* ((n (cons nil alist)) + (merged n) + (o (gnus-agent-load-alist group))) + (while o + (let ((nID (caadr n)) + (oID (caar o))) + (cond ((not nID) + (setq n (setcdr n (list (list oID)))) + (setq o (cdr o))) + ((< oID nID) + (setcdr n (cons (list oID) (cdr n))) + (setq o (cdr o))) + ((= oID nID) + (setq o (cdr o)) + (setq n (cdr n))) + (t + (setq n (cdr n)))))) + (setq alist (cdr merged))) + ;; Restore the last article ID if it is not already in the new alist + (let ((n (last alist)) + (o (last (gnus-agent-load-alist group)))) + (cond ((not o) + nil) + ((not n) + (push (cons (caar o) nil) alist)) + ((< (caar n) (caar o)) + (setcdr n (list (car o))))))) + + (let ((inhibit-quit t)) + (if (setq regenerated (buffer-modified-p)) + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent))) + + (setq regenerated (or regenerated + (and reread gnus-agent-article-alist) + (not (equal alist gnus-agent-article-alist)))) + + (setq gnus-agent-article-alist alist) + + (when regenerated + (gnus-agent-save-alist group) + + ;; I have to alter the group's active range NOW as + ;; gnus-make-ascending-articles-unread will use it to + ;; recalculate the number of unread articles in the group + + (let ((group (gnus-group-real-name group)) + (group-active (gnus-active group))) + (when group-active + (let ((new-min (or (caar gnus-agent-article-alist) + (car group-active))) + (new-max (or (caar (last gnus-agent-article-alist)) + (cdr group-active)))) + + (when (< new-min (car group-active)) + (setcar group-active new-min)) + + (when (> new-max (cdr group-active)) + (setcdr group-active new-max)))))))) + + (when (and reread gnus-agent-article-alist) + (gnus-make-ascending-articles-unread + group + (delq nil (mapcar (function (lambda (c) + (cond ((eq reread t) + (car c)) + ((cdr c) + (car c))))) + gnus-agent-article-alist))) + + (when (gnus-buffer-live-p gnus-group-buffer) + (gnus-group-update-group group t) + (sit-for 0))) + + (gnus-message 5 nil) + regenerated))) ;;;###autoload (defun gnus-agent-regenerate (&optional clean reread) "Regenerate all agent covered files. -If CLEAN, don't read existing active files." +If CLEAN, obsolete (ignore)." (interactive "P") (let (regenerated) (gnus-message 4 "Regenerating Gnus agent files...") - (dolist (gnus-command-method gnus-agent-covered-methods) - (let ((active-file (gnus-agent-lib-file "active")) - active-hashtb active-changed - point) - (gnus-make-directory (file-name-directory active-file)) - (if clean - (setq active-hashtb (gnus-make-hashtable 1000)) - (mm-with-unibyte-buffer - (if (file-exists-p active-file) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-file-contents active-file)) - (setq active-changed t)) - (gnus-active-to-gnus-format - nil (setq active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))))) + (dolist (gnus-command-method (gnus-agent-covered-methods)) (dolist (group (gnus-groups-from-server gnus-command-method)) (setq regenerated (or (gnus-agent-regenerate-group group reread) - regenerated)) - (let ((min (or (caar gnus-agent-article-alist) 1)) - (max (or (caar (last gnus-agent-article-alist)) 0)) - (active (gnus-gethash-safe (gnus-group-real-name group) - active-hashtb)) - (read (gnus-info-read (gnus-get-info group)))) - (if (not active) - (progn - (setq active (cons min max) - active-changed t) - (gnus-sethash group active active-hashtb)) - (when (> (car active) min) - (setcar active min) - (setq active-changed t)) - (when (< (cdr active) max) - (setcdr active max) - (setq active-changed t))))) - (when active-changed - (setq regenerated t) - (gnus-message 4 "Regenerate %s" active-file) - (let ((nnmail-active-file-coding-system - gnus-agent-file-coding-system)) - (gnus-write-active-file active-file active-hashtb))))) + regenerated)))) (gnus-message 4 "Regenerating Gnus agent files...done") + regenerated)) (defun gnus-agent-go-online (&optional force) @@ -3422,8 +3567,7 @@ If CLEAN, don't read existing active files." (if (eq status 'offline) 'online 'offline)))) (defun gnus-agent-group-covered-p (group) - (member (gnus-group-method group) - gnus-agent-covered-methods)) + (gnus-agent-method-p (gnus-group-method group))) (add-hook 'gnus-group-prepare-hook (lambda () diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d8121ff..556d7c3 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -149,7 +149,7 @@ "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" - "X-Abuse-and-DMCA-Info" "X-Postfilter")) + "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -243,8 +243,8 @@ regexp. If it matches, the text in question is not a signature." :type 'sexp :group 'gnus-article-hiding) -;; Fixme: This isn't the right thing for mixed graphical and and -;; non-graphical frames in a session. +;; Fixme: This isn't the right thing for mixed graphical and non-graphical +;; frames in a session. (defcustom gnus-article-x-face-command (if (featurep 'xemacs) (if (or (gnus-image-type-available-p 'xface) @@ -396,7 +396,9 @@ and the latter avoids underlining any whitespace at all." Example: (_/*word*/_)." :group 'gnus-article-emphasis) -(defface gnus-emphasis-strikethru '((t (:strikethru t))) +(defface gnus-emphasis-strikethru (if (featurep 'xemacs) + '((t (:strikethru t))) + '((t (:strike-through t)))) "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) @@ -628,7 +630,9 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (:foreground "MidnightBlue" :italic t)) (t (:italic t))) - "Face used for displaying newsgroups headers." + "Face used for displaying newsgroups headers. +In the default setup this face is only used for crossposted +articles." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -662,17 +666,17 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." ("Subject" nil gnus-header-subject-face) ("Newsgroups:.*," nil gnus-header-newsgroups-face) ("" gnus-header-name-face gnus-header-content-face)) - "*Controls highlighting of article header. + "*Controls highlighting of article headers. An alist of the form (HEADER NAME CONTENT). -HEADER is a regular expression which should match the name of an -header header and NAME and CONTENT are either face names or nil. +HEADER is a regular expression which should match the name of a +header and NAME and CONTENT are either face names or nil. The name of each header field will be displayed using the face -specified by the first element in the list where HEADER match the -header name and NAME is non-nil. Similarly, the content will be -displayed by the first non-nil matching CONTENT face." +specified by the first element in the list where HEADER matches +the header name and NAME is non-nil. Similarly, the content will +be displayed by the first non-nil matching CONTENT face." :group 'gnus-article-headers :group 'gnus-article-highlight :type '(repeat (list (regexp :tag "Header") @@ -981,7 +985,7 @@ See Info node `(gnus)Customizing Articles' for details." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(make-obsolete-variable 'gnus-treat-strip-pgp +(make-obsolete-variable 'gnus-treat-strip-pgp "This option is obsolete in Gnus 5.10.") (defcustom gnus-treat-strip-pem nil @@ -1143,7 +1147,10 @@ See Info node `(gnus)Customizing Articles' for details." :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) -(defcustom gnus-treat-display-xface +(make-obsolete-variable 'gnus-treat-display-xface + 'gnus-treat-display-x-face) + +(defcustom gnus-treat-display-x-face (and (not noninteractive) (or (and (fboundp 'image-type-available-p) (image-type-available-p 'xbm) @@ -1160,8 +1167,25 @@ See Info node `(gnus)Customizing Articles' and Info node :version "21.1" :link '(custom-manual "(gnus)Customizing Articles") :link '(custom-manual "(gnus)X-Face") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-xface 'highlight t) + :type gnus-article-treat-head-custom + :set (lambda (symbol value) + (set-default + symbol + (cond ((or (boundp symbol) (get symbol 'saved-value)) + value) + ((boundp 'gnus-treat-display-xface) + (message "\ +** gnus-treat-display-xface is an obsolete variable;\ + use gnus-treat-display-x-face instead") + (default-value 'gnus-treat-display-xface)) + ((get 'gnus-treat-display-xface 'saved-value) + (message "\ +** gnus-treat-display-xface is an obsolete variable;\ + use gnus-treat-display-x-face instead") + (eval (car (get 'gnus-treat-display-xface 'saved-value)))) + (t + value))))) +(put 'gnus-treat-display-x-face 'highlight t) (defcustom gnus-treat-display-face (and (not noninteractive) @@ -1179,7 +1203,7 @@ See Info node `(gnus)Customizing Articles' and Info node :link '(custom-manual "(gnus)Customizing Articles") :link '(custom-manual "(gnus)X-Face") :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-xface 'highlight t) +(put 'gnus-treat-display-face 'highlight t) (defcustom gnus-treat-display-smileys (if (or (and (featurep 'xemacs) @@ -1324,7 +1348,8 @@ It is a string, such as \"PGP\". If nil, ask user." "Function used for converting HTML into text.") (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) - (mm-coding-system-p 'utf-8)) + (mm-coding-system-p 'utf-8) + (executable-find idna-program)) "Whether IDNA decoding of headers is used when viewing messages. This requires GNU Libidn, and by default only enabled if it is found." :group 'gnus-article-headers @@ -1364,7 +1389,7 @@ This requires GNU Libidn, and by default only enabled if it is found." (gnus-treat-date-original gnus-article-date-original) (gnus-treat-date-user-defined gnus-article-date-user) (gnus-treat-date-iso8601 gnus-article-date-iso8601) - (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-display-x-face gnus-article-display-x-face) (gnus-treat-display-face gnus-article-display-face) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) @@ -1670,12 +1695,19 @@ always hide." (gnus-article-hide-header "reply-to") (let ((from (message-fetch-field "from")) (reply-to (message-fetch-field "reply-to"))) - (when (and - from reply-to - (ignore-errors - (gnus-string-equal - (nth 1 (mail-extract-address-components from)) - (nth 1 (mail-extract-address-components reply-to))))) + (when + (and + from reply-to + (ignore-errors + (equal + (sort (mapcar + (lambda (x) (downcase (cadr x))) + (mail-extract-address-components from t)) + 'string<) + (sort (mapcar + (lambda (x) (downcase (cadr x))) + (mail-extract-address-components reply-to t)) + 'string<)))) (gnus-article-hide-header "reply-to"))))) ((eq elem 'date) (let ((date (message-fetch-field "date"))) @@ -1763,14 +1795,15 @@ always hide." (forward-line 1)))))) (defun article-treat-dumbquotes () - "Translate M****s*** sm*rtq**t*s into proper text. + "Translate M****s*** sm*rtq**t*s and other symbols into proper text. Note that this function guesses whether a character is a sm*rtq**t* or not, so it should only be used interactively. -Sm*rtq**t*s are M****s***'s unilateral extension to the character map -in an attempt to provide more quoting characters. If you see -something like \\222 or \\264 where you're expecting some kind of -apostrophe or quotation mark, then try this wash." +Sm*rtq**t*s are M****s***'s unilateral extension to the +iso-8859-1 character map in an attempt to provide more quoting +characters. If you see something like \\222 or \\264 where +you're expecting some kind of apostrophe or quotation mark, then +try this wash." (interactive) (article-translate-strings gnus-article-dumbquotes-map)) @@ -1975,20 +2008,40 @@ unfolded." (defun article-display-face () "Display any Face headers in the header." (interactive) - (gnus-with-article-headers - (let ((face (message-fetch-field "face"))) - (when face - (let ((png (gnus-convert-face-to-png face)) - image) - (when png - (setq image (gnus-create-image png 'png t)) - (gnus-article-goto-header "from") - (when (bobp) - (insert "From: [no `from' set]\n") - (forward-char -17)) - (gnus-add-wash-type 'face) - (gnus-add-image 'face image) - (gnus-put-image image))))))) + (let ((wash-face-p buffer-read-only)) + (gnus-with-article-headers + ;; When displaying parts, this function can be called several times on + ;; the same article, without any intended toggle semantic (as typing `W + ;; D d' would have). So face deletion must occur only when we come from + ;; an interactive command, that is when the *Article* buffer is + ;; read-only. + (if (and wash-face-p (memq 'face gnus-article-wash-types)) + (gnus-delete-images 'face) + (let (face faces) + (save-excursion + (when (and wash-face-p + (progn + (goto-char (point-min)) + (not (re-search-forward "^Face:[\t ]*" nil t))) + (gnus-buffer-live-p gnus-original-article-buffer)) + (set-buffer gnus-original-article-buffer)) + (save-restriction + (mail-narrow-to-head) + (while (gnus-article-goto-header "Face") + (push (mail-header-field-value) faces)))) + (while (setq face (pop faces)) + (let ((png (gnus-convert-face-to-png face)) + image) + (when png + (setq image (gnus-create-image png 'png t)) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'face) + (gnus-add-image 'face image) + (gnus-put-image image nil 'face)))))) + ))) (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." @@ -1998,7 +2051,8 @@ unfolded." ;; Delete the old process, if any. (when (process-status "article-x-face") (delete-process "article-x-face")) - (if (memq 'xface gnus-article-wash-types) + ;; See the comment in `article-display-face'. + (if (and wash-face-p (memq 'xface gnus-article-wash-types)) ;; We have already displayed X-Faces, so we remove them ;; instead. (gnus-delete-images 'xface) @@ -2033,23 +2087,25 @@ unfolded." (not (string-match gnus-article-x-face-too-ugly from))))) ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command face) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" - (point-min) (point-max))) - (process-send-eof "article-x-face"))))))))) + (cond ((stringp gnus-article-x-face-command) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name + shell-command-switch gnus-article-x-face-command)) + (with-temp-buffer + (insert face) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face"))) + ((functionp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (funcall gnus-article-x-face-command face)) + (t + (error "%s is not a function" + gnus-article-x-face-command))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." @@ -2271,8 +2327,8 @@ If READ-CHARSET, ask for a coding system." (while (re-search-forward "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) - (when (and gnus-display-mime-function (interactive-p)) - (funcall gnus-display-mime-function)))) + (when (interactive-p) + (gnus-treat-article nil)))) (defun article-wash-html (&optional read-charset) @@ -2891,9 +2947,12 @@ function and want to see what the date was before converting." (lambda (w) (set-buffer (window-buffer w)) (when (eq major-mode 'gnus-article-mode) - (goto-char (point-min)) - (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t)))) + (let ((mark (point-marker))) + (goto-char (point-min)) + (when (re-search-forward "^X-Sent:" nil t) + (article-date-lapsed t)) + (goto-char (marker-position mark)) + (move-marker mark nil)))) nil 'visible))))) (defun gnus-start-date-timer (&optional n) @@ -3226,7 +3285,7 @@ The directory to save in defaults to `gnus-article-save-directory'." (shell-command-on-region (point-min) (point-max) command nil))) (setq gnus-last-shell-command command)) -(defmacro gnus-read-string (prompt &optional initial-contents history +(defmacro gnus-read-string (prompt &optional initial-contents history default-value) "Like `read-string' but allow for older XEmacsen that don't have the 5th arg." (if (and (featurep 'xemacs) @@ -3552,7 +3611,7 @@ commands: (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (make-local-variable 'gnus-page-broken) + (set (make-local-variable 'gnus-page-broken) nil) (make-local-variable 'gnus-button-marker-list) (make-local-variable 'gnus-article-current-summary) (make-local-variable 'gnus-article-mime-handles) @@ -3736,10 +3795,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-prepare-display) ;; Do page break. (goto-char (point-min)) - (setq gnus-page-broken - (when gnus-break-pages - (gnus-narrow-to-page) - t))) + (when gnus-break-pages + (gnus-narrow-to-page))) (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)) @@ -3968,8 +4025,6 @@ Replace it with some information about the removed part." (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" @@ -3977,10 +4032,12 @@ Replace it with some information about the removed part." "| Filename: " filename "\n" "| Size (encoded): " bsize " Byte\n" "| Description: " description "\n" - "`----\n" - "<#/part>")) + "`----\n")) (setcdr data - (cdr (mm-make-handle nil `("text/plain")))))) + (cdr (mm-make-handle + nil `("text/plain") nil nil + (list "attachment") + (format "Deleted attachment (%s bytes)" bsize)))))) (set-buffer gnus-summary-buffer) ;; FIXME: maybe some of the following code (borrowed from ;; `gnus-mime-save-part-and-strip') isn't necessary? @@ -4106,7 +4163,7 @@ The uncompress method used is derived from `buffer-file-name'." (message "%s %s..." message basename)) (unwind-protect (unless (memq (apply 'call-process-region - (point-min) (point-max) + (point-min) (point-max) prog t (list t err-file) nil args) @@ -4293,7 +4350,8 @@ If no internal viewer is available, use an external viewer." (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-view-part-as-charset (n) - "Copy MIME part N, which is the numerical prefix." + "View MIME part N using a specified charset. +N is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) @@ -4840,7 +4898,7 @@ is the string to use when it is inactive.") "Delete all images in CATEGORY." (let ((entry (assq category gnus-article-image-alist))) (dolist (image (cdr entry)) - (gnus-remove-image image)) + (gnus-remove-image image category)) (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) (gnus-delete-wash-type category))) @@ -4884,27 +4942,32 @@ If given a numerical ARG, move forward ARG pages." (let ((buffer-read-only nil)) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))) - (when + (if (cond ((< arg 0) (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) ((> arg 0) (re-search-forward page-delimiter nil 'move arg))) - (goto-char (match-end 0))) - (narrow-to-region - (point) - (if (re-search-forward page-delimiter nil 'move) - (match-beginning 0) - (point))) - (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) + (goto-char (match-end 0)) (save-excursion (goto-char (point-min)) - (gnus-insert-prev-page-button))) - (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) - (save-excursion - (goto-char (point-max)) - (gnus-insert-next-page-button))))) + (setq gnus-page-broken + (and (re-search-forward page-delimiter nil t) t)))) + (when gnus-page-broken + (narrow-to-region + (point) + (if (re-search-forward page-delimiter nil 'move) + (match-beginning 0) + (point))) + (when (and (gnus-visual-p 'page-marker) + (not (= (point-min) 1))) + (save-excursion + (goto-char (point-min)) + (gnus-insert-prev-page-button))) + (when (and (gnus-visual-p 'page-marker) + (< (+ (point-max) 2) (buffer-size))) + (save-excursion + (goto-char (point-max)) + (gnus-insert-next-page-button)))))) ;; Article mode commands @@ -4917,7 +4980,7 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-prev-page () - "Show the next page of the article." + "Show the previous page of the article." (interactive) (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) @@ -4951,7 +5014,8 @@ Argument LINES specifies lines to be scrolled up." (if (or (not gnus-page-broken) (save-excursion (save-restriction - (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? + (widen) + (eobp)))) ;Real end-of-buffer? (progn (when gnus-article-over-scroll (gnus-article-next-page-1 lines)) @@ -5575,7 +5639,8 @@ groups." (set-window-configuration winconf) (set-buffer buf) (set-window-start (get-buffer-window buf) start) - (set-window-point (get-buffer-window buf) (point)))) + (set-window-point (get-buffer-window buf) (point))) + (gnus-summary-show-article)) (defun gnus-article-edit-exit () "Exit the article editing without updating." @@ -5596,7 +5661,8 @@ groups." (save-current-buffer (set-buffer curbuf) (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p)))))) + (goto-char p)))) + (gnus-summary-show-article))) (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." @@ -5932,7 +5998,7 @@ Calls `describe-variable' or `describe-function'." "*Integer that says how many TeX-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to -specifific groups. Setting it higher in TeX groups is probably a good idea. +specific groups. Setting it higher in TeX groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." :group 'gnus-article-buttons @@ -5943,7 +6009,7 @@ how to set variables in specific groups." "*Integer that says how many man-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to -specifific groups. Setting it higher in Unix groups is probably a good idea. +specific groups. Setting it higher in Unix groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." :group 'gnus-article-buttons @@ -5954,7 +6020,7 @@ how to set variables in specific groups." "*Integer that says how many emacs-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to -specifific groups. Setting it higher in Emacs or Gnus related groups is +specific groups. Setting it higher in Emacs or Gnus related groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." :group 'gnus-article-buttons @@ -5990,7 +6056,7 @@ positives are possible." 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) - ("mailto:\\([-a-z.@_+0-9%=?]+\\)" + ("mailto:\\([-a-z.@_+0-9%=?&]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) @@ -6008,9 +6074,15 @@ positives are possible." gnus-button-ctan-directory-regexp "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) - ;; This is info - ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) + ;; This is info (home-grown style) + ("\\binfo://\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1) + ;; Info GNOME style + ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1) + ;; Info KDE style + ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>" + 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2) ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) ("\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" @@ -6067,7 +6139,7 @@ positives are possible." gnus-button-handle-man 1) ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) - ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W" + ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W" 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) ;; MID or mail: To avoid too many false positives we don't try to catch ;; all kind of allowed MIDs or mail addresses. Domain part must contain @@ -6080,9 +6152,9 @@ positives are possible." Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string (case insensitive) matching text around the button (can -also be lisp expression evaluating to a string), +also be Lisp expression evaluating to a string), BUTTON: is the number of the regexp grouping actually matching the button, -FORM: is a lisp expression which must eval to true for the button to +FORM: is a Lisp expression which must eval to true for the button to be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. @@ -6090,7 +6162,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons - :type '(repeat (list (choice regexp variable) + :type '(repeat (list (choice regexp variable sexp) (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -6099,7 +6171,7 @@ variable it the real callback function." (integer :tag "Regexp group"))))) (defcustom gnus-header-button-alist - '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>" + '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>" 0 (>= gnus-button-message-level 0) gnus-button-message-id 0) ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 (>= gnus-button-message-level 0) gnus-button-reply 1) @@ -6111,7 +6183,7 @@ variable it the real callback function." 0 (>= gnus-button-browse-level 0) browse-url 0) ("^[^:]+:" gnus-button-url-regexp 0 (>= gnus-button-browse-level 0) browse-url 0) - ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)" + ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) @@ -6127,7 +6199,7 @@ HEADER is a regexp to match a header. For a fuller explanation, see :group 'gnus-article-buttons :group 'gnus-article-headers :type '(repeat (list (regexp :tag "Header") - regexp + (choice regexp variable) (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -6460,6 +6532,7 @@ specified by `gnus-button-alist'." (defun gnus-button-handle-info-url (url) "Fetch an info URL." + (setq url (mm-subst-char-in-string ?+ ?\ url)) (cond ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) (gnus-info-find-node @@ -6473,6 +6546,24 @@ specified by `gnus-button-alist'." (gnus-info-find-node url)) (t (error "Can't parse %s" url)))) +(defun gnus-button-handle-info-url-gnome (url) + "Fetch GNOME style info URL." + (setq url (mm-subst-char-in-string ?_ ?\ url)) + (if (string-match "\\([^#]+\\)#?\\(.*\\)" url) + (gnus-info-find-node + (concat "(" + (gnus-url-unhex-string + (match-string 1 url)) + ")" + (or (gnus-url-unhex-string + (match-string 2 url)) + "Top"))) + (error "Can't parse %s" url))) + +(defun gnus-button-handle-info-url-kde (url) + "Fetch KDE style info URL." + (gnus-info-find-node (gnus-url-unhex-string url))) + (defun gnus-button-handle-info-keystrokes (url) "Call `info' when pushing the corresponding URL button." ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'. @@ -6529,12 +6620,14 @@ specified by `gnus-button-alist'." (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) (let (to args subject func) - (if (string-match (regexp-quote "?") url) - (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) - args (gnus-url-parse-query-string - (substring url (match-end 0) nil) t)) - (setq to (gnus-url-unhex-string url))) - (setq args (cons (list "to" to) args) + (setq args (gnus-url-parse-query-string + (if (string-match "^\\?" url) + (substring url 1) + (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) + (concat "to=" (match-string 1 url) "&" + (match-string 2 url)) + (concat "to=" url))) + t) subject (cdr-safe (assoc "subject" args))) (gnus-msg-mail) (while args @@ -6542,7 +6635,9 @@ specified by `gnus-button-alist'." (if (fboundp func) (funcall func) (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) + (insert (gnus-replace-in-string + (mapconcat 'identity (reverse (cdar args)) ", ") + "\r\n" "\n" t)) (setq args (cdr args))) (if subject (message-goto-body) @@ -6655,7 +6750,7 @@ specified by `gnus-button-alist'." This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups whose names match REGEXP. For example: diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 7e10353..d8bdd35 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -677,7 +677,7 @@ If LOW, update the lower bound instead." (gnus-message 5 "Generating the cache active file...") (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) (when (string-match "^\\(nn[^_]+\\)_" group) - (setq group (replace-match "\\1:" t t group))) + (setq group (replace-match "\\1:" t nil group))) ;; Separate articles from all other files and directories. (while files (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index e0d299e..e713f79 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -204,8 +204,7 @@ Which articles to display on entering the group. An arbitrary comment on the group.") (visible (const :tag "Permanently visible" t) "\ -Always display this group, even when there are no unread articles -in it..") +Always display this group, even when there are no unread articles in it.") (highlight-words (choice :tag "Highlight words" @@ -888,6 +887,17 @@ articles in the thread. (eval-when-compile (defvar category-fields nil) + (defvar gnus-agent-cat-name) + (defvar gnus-agent-cat-score-file) + (defvar gnus-agent-cat-length-when-short) + (defvar gnus-agent-cat-length-when-long) + (defvar gnus-agent-cat-low-score) + (defvar gnus-agent-cat-high-score) + (defvar gnus-agent-cat-enable-expiration) + (defvar gnus-agent-cat-days-until-old) + (defvar gnus-agent-cat-predicate) + (defvar gnus-agent-cat-groups) + (defvar gnus-agent-cat-disable-undownloaded-faces) ) (defun gnus-trim-whitespace (s) @@ -1035,6 +1045,10 @@ articles in the thread. (gnus-agent-cat-prepare-category-field agent-enable-expiration) (gnus-agent-cat-prepare-category-field agent-days-until-old) + (widget-insert "\nVisual Settings ") + + (gnus-agent-cat-prepare-category-field agent-disable-undownloaded-faces) + (use-local-map widget-keymap) (widget-setup) (buffer-enable-undo)))) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index cb98655..f8286b4 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -46,6 +46,7 @@ (gnus-define-keys gnus-draft-mode-map "Dt" gnus-draft-toggle-sending + "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' "De" gnus-draft-edit-message "Ds" gnus-draft-send-message "DS" gnus-draft-send-all-messages)) @@ -185,8 +186,12 @@ (defun gnus-draft-send-all-messages () "Send all the sendable drafts." (interactive) - (gnus-uu-mark-buffer) - (gnus-draft-send-message)) + (when (or + gnus-expert-user + (gnus-y-or-n-p + "Send all drafts? ")) + (gnus-uu-mark-buffer) + (gnus-draft-send-message))) (defun gnus-group-send-queue () "Send all sendable articles from the queue group." @@ -218,7 +223,7 @@ (dolist (group '("nndraft:drafts" "nndraft:queue")) (setq active (gnus-activate-group group)) (if (and active (>= (cdr active) (car active))) - (if (y-or-n-p "There are unsent drafts. Confirm to exit?") + (if (y-or-n-p "There are unsent drafts. Confirm to exit? ") (throw 'continue t) (error "Stop!")))))))) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index a9ab259..153a02b 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -219,16 +219,20 @@ (setq props (plist-put props :background (face-background face)))) (apply 'create-image file type data-p props))) -(defun gnus-put-image (glyph &optional string) - (insert-image glyph (or string " ")) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t)) - glyph) - -(defun gnus-remove-image (image) +(defun gnus-put-image (glyph &optional string category) + (let ((point (point))) + (insert-image glyph (or string " ")) + (put-text-property point (point) 'gnus-image-category category) + (unless string + (put-text-property (1- (point)) (point) + 'gnus-image-text-deletable t)) + glyph)) + +(defun gnus-remove-image (image &optional category) (dolist (position (message-text-with-property 'display)) - (when (equal (get-text-property position 'display) image) + (when (and (equal (get-text-property position 'display) image) + (equal (get-text-property position 'gnus-image-category) + category)) (put-text-property position (1+ position) 'display nil) (when (get-text-property position 'gnus-image-text-deletable) (delete-region position (1+ position)))))) diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el index a174779..ca5cdea 100644 --- a/lisp/gnus-fun.el +++ b/lisp/gnus-fun.el @@ -192,7 +192,7 @@ colors of the displayed X-Faces." (concat "X-Face: " data) 'xface t :face 'gnus-x-face) (gnus-create-image - pbm 'pbm t :face 'gnus-x-face)))) + pbm 'pbm t :face 'gnus-x-face)) nil 'xface)) (gnus-add-wash-type 'xface)))))) (defun gnus-grab-cam-x-face () diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index e6bbddc..a1bd82e 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -180,8 +180,8 @@ with some simple extensions. %E Icon as defined by `gnus-group-icon-list'. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed a - single dummy parameter as argument.. The function should return a + where X is the letter following %u. The function will be passed a + single dummy parameter as argument. The function should return a string, which will be inserted into the buffer just like information from any other group specifier. @@ -732,7 +732,7 @@ simple manner.") (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." - (and (boundp 'gnus-topic-mode) + (and (boundp 'gnus-topic-mode) (symbol-value 'gnus-topic-mode))) (defun gnus-group-make-menu-bar () @@ -750,7 +750,7 @@ simple manner.") ["Select" gnus-group-select-group :included (not (gnus-topic-mode-p)) :active (gnus-group-group-name)] - ["Select " gnus-topic-select-group + ["Select " gnus-topic-select-group :included (gnus-topic-mode-p)] ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC" :active (gnus-group-group-name)] @@ -759,7 +759,7 @@ simple manner.") :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil '(:help "Mark unread articles in the current group as read"))] - ["Catch up " gnus-topic-catchup-articles + ["Catch up " gnus-topic-catchup-articles :included (gnus-topic-mode-p) ,@(if (featurep 'xemacs) nil '(:help "Mark unread articles in the current group or topic as read"))] @@ -794,13 +794,13 @@ simple manner.") '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) - ["Expire articles" gnus-group-expire-articles + ["Expire articles" gnus-group-expire-articles :included (not (gnus-topic-mode-p)) :active (or (and (gnus-group-group-name) (gnus-check-backend-function 'request-expire-articles (gnus-group-group-name))) gnus-group-marked)] - ["Expire articles " gnus-topic-expire-articles + ["Expire articles " gnus-topic-expire-articles :included (gnus-topic-mode-p)] ["Set group level..." gnus-group-set-current-level (gnus-group-group-name)] @@ -891,6 +891,7 @@ simple manner.") ["Make a kiboze group..." gnus-group-make-kiboze-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] ["Add a group to a virtual..." gnus-group-add-to-virtual t] + ["Make an RSS group..." gnus-group-make-rss-group t] ["Rename group..." gnus-group-rename-group (gnus-check-backend-function 'request-rename-group (gnus-group-group-name))] @@ -1387,7 +1388,7 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-qualified-group (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) group-name-charset)) - (gnus-tmp-comment + (gnus-tmp-comment (or (gnus-group-get-parameter gnus-tmp-group 'comment t) gnus-tmp-group)) (gnus-tmp-newsgroup-description @@ -1736,9 +1737,11 @@ If UNMARK, remove the mark instead." (interactive "sMark (regexp): ") (let ((alist (cdr gnus-newsrc-alist)) group) - (while alist - (when (string-match regexp (setq group (gnus-info-group (pop alist)))) - (gnus-group-set-mark group)))) + (save-excursion + (while alist + (when (string-match regexp (setq group (gnus-info-group (pop alist)))) + (gnus-group-jump-to-group group) + (gnus-group-set-mark group))))) (gnus-group-position-point)) (defun gnus-group-remove-mark (group &optional test-marked) @@ -2242,7 +2245,7 @@ ADDRESS." (forward-line -1) (gnus-group-position-point) - ;; Load the backend and try to make the backend create + ;; Load the back end and try to make the back end create ;; the group as well. (when (assoc (symbol-name (setq backend (car (gnus-server-get-method nil meth)))) @@ -2267,21 +2270,23 @@ ADDRESS." (lambda (group) (gnus-group-delete-group group nil t)))))) -(eval-when-compile (defvar gnus-cache-active-altered)) +(defvar gnus-cache-active-altered) (defun gnus-group-delete-group (group &optional force no-prompt) "Delete the current group. Only meaningful with editable groups. If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face of the Earth\". There is no undo. The user will be prompted before -doing the deletion." +doing the deletion. +Note that you also have to specify FORCE if you want the group to +be removed from the server, even when it's empty." (interactive (list (gnus-group-group-name) current-prefix-arg)) (unless group (error "No group to delete")) (unless (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) + (error "This back end does not support group deletion")) (prog1 (if (and (not no-prompt) (not (gnus-yes-or-no-p @@ -2313,12 +2318,12 @@ and NEW-NAME will be prompted for." (progn (unless (gnus-check-backend-function 'request-rename-group (gnus-group-group-name)) - (error "This backend does not support renaming groups")) + (error "This back end does not support renaming groups")) (gnus-read-group "Rename group to: " (gnus-group-real-name (gnus-group-group-name)))))) (unless (gnus-check-backend-function 'request-rename-group group) - (error "This backend does not support renaming groups")) + (error "This back end does not support renaming groups")) (unless group (error "No group to rename")) (when (equal (gnus-group-real-name group) new-name) @@ -2334,6 +2339,9 @@ and NEW-NAME will be prompted for." (gnus-group-real-name new-name) (gnus-info-method (gnus-get-info group))))) + (when (gnus-active new-name) + (error "The group %s already exists" new-name)) + (gnus-message 6 "Renaming group %s to %s..." group new-name) (prog1 (if (progn @@ -2552,22 +2560,23 @@ If SOLID (the prefix), create a solid group." (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) -(eval-when-compile (defvar nnrss-group-alist) - (defun nnrss-discover-feed (arg)) - (defun nnrss-save-server-data (arg))) +(eval-when-compile + (defvar nnrss-group-alist) + (defun nnrss-discover-feed (arg)) + (defun nnrss-save-server-data (arg))) (defun gnus-group-make-rss-group (&optional url) - "Given a URL, discover if there is an RSS feed. If there is, -use Gnus' to create an nnrss group" + "Given a URL, discover if there is an RSS feed. +If there is, use Gnus to create an nnrss group" (interactive) (require 'nnrss) (if (not url) (setq url (read-from-minibuffer "URL to Search for RSS: "))) (let ((feedinfo (nnrss-discover-feed url))) (if feedinfo - (let ((title (read-from-minibuffer "Title: " - (cdr (assoc 'title + (let ((title (read-from-minibuffer "Title: " + (cdr (assoc 'title feedinfo)))) - (desc (read-from-minibuffer "Description: " + (desc (read-from-minibuffer "Description: " (cdr (assoc 'description feedinfo)))) (href (cdr (assoc 'href feedinfo)))) @@ -2654,7 +2663,7 @@ mail messages or news articles in files that have numeric names." (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(eval-when-compile (defvar nnkiboze-score-file)) +(defvar nnkiboze-score-file) (defun gnus-group-make-kiboze-group (group address scores) "Create an nnkiboze group. The user will be prompted for a name, a regexp to match groups, and @@ -2859,7 +2868,7 @@ If REVERSE, sort in reverse order." (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. + "Sort the group buffer alphabetically by back end name. If REVERSE, sort in reverse order." (interactive "P") (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) @@ -2948,7 +2957,7 @@ sort in reverse order." (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) - "Sort the group buffer alphabetically by backend name. + "Sort the group buffer alphabetically by back end name. Obeys the process/prefix convention. If REVERSE (the symbolic prefix), sort in reverse order." (interactive (gnus-interactive "P\ny")) @@ -2977,7 +2986,7 @@ sort in reverse order." (< (gnus-info-level info1) (gnus-info-level info2))) (defun gnus-group-sort-by-method (info1 info2) - "Sort alphabetically by backend name." + "Sort alphabetically by back end name." (string< (car (gnus-find-method-for-group (gnus-info-group info1) info1)) (car (gnus-find-method-for-group @@ -3236,26 +3245,22 @@ Uses the process/prefix convention." "Toggle subscription of the current group. If given numerical prefix, toggle the N next groups." (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (while groups - (setq group (car groups) - groups (cdr groups)) - (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group - group - (cond - ((eq do-sub 'unsubscribe) - gnus-level-default-unsubscribed) - ((eq do-sub 'subscribe) - gnus-level-default-subscribed) - ((<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed) - (t - gnus-level-default-subscribed)) - t) - (gnus-group-update-group-line)) - (gnus-group-next-group 1))) + (dolist (group (gnus-group-process-prefix n)) + (gnus-group-remove-mark group) + (gnus-group-unsubscribe-group + group + (cond + ((eq do-sub 'unsubscribe) + gnus-level-default-unsubscribed) + ((eq do-sub 'subscribe) + gnus-level-default-subscribed) + ((<= (gnus-group-group-level) gnus-level-subscribed) + gnus-level-default-unsubscribed) + (t + gnus-level-default-subscribed)) + t) + (gnus-group-update-group-line)) + (gnus-group-next-group 1)) (defun gnus-group-unsubscribe-group (group &optional level silent) "Toggle subscription to GROUP. @@ -3371,29 +3376,27 @@ of groups killed." (message "Killed group %s" group)) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. - (let (entry) - (setq groups (nreverse groups)) - (while groups - (gnus-group-remove-mark (setq group (pop groups))) - (gnus-delete-line) - (push group gnus-killed-list) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function - group gnus-level-killed 3)) - (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups) - (setcdr (cdr entry) (cdddr entry))) - ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list)))) - ;; There may be more than one instance displayed. - (while (gnus-group-goto-group group) - (gnus-delete-line))) - (gnus-make-hashtable-from-newsrc-alist))) + (dolist (group (nreverse groups)) + (gnus-group-remove-mark group) + (gnus-delete-line) + (push group gnus-killed-list) + (setq gnus-newsrc-alist + (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist)) + (when gnus-group-change-level-function + (funcall gnus-group-change-level-function + group gnus-level-killed 3)) + (cond + ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (push (cons (car entry) (nth 2 entry)) + gnus-list-of-killed-groups) + (setcdr (cdr entry) (cdddr entry))) + ((member group gnus-zombie-list) + (setq gnus-zombie-list (delete group gnus-zombie-list)))) + ;; There may be more than one instance displayed. + (while (gnus-group-goto-group group) + (gnus-delete-line))) + (gnus-make-hashtable-from-newsrc-alist)) (gnus-group-position-point) (if (< (length out) 2) (car out) (nreverse out)))) @@ -3458,7 +3461,7 @@ yanked) a list of yanked groups is returned." (defun gnus-group-list-all-groups (&optional arg) "List all newsgroups with level ARG or lower. -Default is gnus-level-unsubscribed, which lists all subscribed and most +Default is `gnus-level-unsubscribed', which lists all subscribed and most unsubscribed groups." (interactive "P") (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) @@ -3668,7 +3671,7 @@ If given a prefix argument, prompt for a group." (browse-url (eval url)) (setq url (concat "http://" hierarchy ".news-admin.org/charters/" name)) - (if (and (fboundp 'url-http-file-exists-p) + (if (and (fboundp 'url-http-file-exists-p) (url-http-file-exists-p url)) (browse-url url) (gnus-group-fetch-control group)))))) @@ -3689,14 +3692,14 @@ If given a prefix argument, prompt for a group." (setq hierarchy (match-string 1 name)) (if gnus-group-fetch-control-use-browse-url (browse-url (concat "ftp://ftp.isc.org/usenet/control/" - hierarchy "/" name ".Z")) + hierarchy "/" name ".gz")) (let ((enable-local-variables nil)) (gnus-group-read-ephemeral-group group - `(nndoc ,group (nndoc-address + `(nndoc ,group (nndoc-address ,(find-file-noselect - (concat "/ftp@ftp.isc.org:/usenet/control/" - hierarchy "/" name ".Z"))) + (concat "/ftp@ftp.isc.org:/usenet/control/" + hierarchy "/" name ".gz"))) (nndoc-article-type mbox)) t nil nil)))))) (defun gnus-group-describe-group (force &optional group) @@ -3794,7 +3797,7 @@ If given a prefix argument, prompt for a group." (pop-to-buffer obuf))) (defun gnus-group-description-apropos (regexp) - "List all newsgroups that have names or descriptions that match a regexp." + "List all newsgroups that have names or descriptions that match REGEXP." (interactive "sGnus description apropos (regexp): ") (when (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) @@ -3893,10 +3896,12 @@ If GROUP, edit that local kill file instead." (interactive) (gnus-save-newsrc-file)) +(defvar gnus-backlog-articles) + (defun gnus-group-suspend () "Suspend the current Gnus session. In fact, cleanup buffers except for group mode buffer. -The hook gnus-suspend-gnus-hook is called before actually suspending." +The hook `gnus-suspend-gnus-hook' is called before actually suspending." (interactive) (gnus-run-hooks 'gnus-suspend-gnus-hook) (gnus-offer-save-summaries) @@ -3910,6 +3915,7 @@ The hook gnus-suspend-gnus-hook is called before actually suspending." (eq major-mode 'message-mode)))) (gnus-kill-buffer buf))) (gnus-buffers)) + (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) (when group-buf (bury-buffer group-buf) @@ -3982,10 +3988,10 @@ If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive (list (let ((how (completing-read - "Which backend: " + "Which back end: " (append gnus-valid-select-methods gnus-server-alist) nil t (cons "nntp" 0) 'gnus-method-history))) - ;; We either got a backend name or a virtual server name. + ;; We either got a back end name or a virtual server name. ;; If the first, we also need an address. (if (assoc how gnus-valid-select-methods) (list (intern how) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 7c4b636..0acdf81 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -33,6 +33,7 @@ (require 'gnus-range) (autoload 'gnus-agent-expire "gnus-agent") +(autoload 'gnus-agent-read-servers-validate-native "gnus-agent") (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." @@ -105,6 +106,18 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." (require 'nntp))) (setq gnus-current-select-method gnus-select-method) (gnus-run-hooks 'gnus-open-server-hook) + + ;; Partially validate agent covered methods now that the + ;; gnus-select-method is known. + + (if gnus-agent + ;; NOTE: This is here for one purpose only. By validating + ;; the current select method, it converts the old 5.10.3, + ;; and earlier, format to the current format. That enables + ;; the agent code within gnus-open-server to function + ;; correctly. + (gnus-agent-read-servers-validate-native gnus-select-method)) + (or ;; gnus-open-server-hook might have opened it (gnus-server-opened gnus-select-method) @@ -200,52 +213,66 @@ If it is down, start it up (again)." (gnus-message 1 "Denied server") nil) ;; Open the server. - (let ((result - (condition-case err - (funcall (gnus-get-function gnus-command-method 'open-server) - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)) - (error - (gnus-message 1 (format + (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) + (result + (condition-case err + (funcall open-server-function + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)) + (error + (gnus-message 1 (format "Unable to open server due to: %s" (error-message-string err))) nil) - (quit - (gnus-message 1 "Quit trying to open server") - nil)))) + (quit + (gnus-message 1 "Quit trying to open server") + nil))) + open-offline) ;; If this hasn't been opened before, we add it to the list. (unless elem (setq elem (list gnus-command-method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. - (setcar (cdr elem) - (if result - (if (eq (cadr elem) 'offline) - 'offline - 'ok) - (if (and gnus-agent - (not (eq (cadr elem) 'offline)) - (gnus-agent-method-p gnus-command-method)) - (or gnus-server-unopen-status - (if (gnus-y-or-n-p - (format "Unable to open %s:%s, go offline? " - (car gnus-command-method) - (cadr gnus-command-method))) - 'offline - 'denied)) - 'denied))) - ;; Return the result from the "open" call. - (cond ((eq (cadr elem) 'offline) - ;; I'm avoiding infinite recursion by binding unopen - ;; status to denied (The logic of this routine - ;; guarantees that I can't get to this point with - ;; unopen status already bound to denied). - (unless (eq gnus-server-unopen-status 'denied) - (let ((gnus-server-unopen-status 'denied)) - (gnus-open-server gnus-command-method))) - t) - (t - result)))))) + (setcar (cdr elem) + (cond (result + (if (eq open-server-function #'nnagent-open-server) + ;; The agent's backend has a "special" status + 'offline + 'ok)) + ((and gnus-agent + (gnus-agent-method-p gnus-command-method)) + (cond (gnus-server-unopen-status + ;; Set the server's status to the unopen + ;; status. If that status is offline, + ;; recurse to open the agent's backend. + (setq open-offline (eq gnus-server-unopen-status 'offline)) + gnus-server-unopen-status) + ((gnus-y-or-n-p + (format "Unable to open %s:%s, go offline? " + (car gnus-command-method) + (cadr gnus-command-method))) + (setq open-offline t) + 'offline) + (t + ;; This agentized server was still denied + 'denied))) + (t + ;; This unagentized server must be denied + 'denied))) + + ;; NOTE: I MUST set the server's status to offline before this + ;; recursive call as this status will drive the + ;; gnus-get-function (called above) to return the agent's + ;; backend. + (if open-offline + ;; Recursively open this offline server to perform the + ;; open-server function of the agent's backend. + (let ((gnus-server-unopen-status 'denied)) + ;; Bind gnus-server-unopen-status to avoid recursively + ;; prompting with "go offline?". This is only a concern + ;; when the agent's backend fails to open the server. + (gnus-open-server gnus-command-method)) + result))))) (defun gnus-close-server (gnus-command-method) "Close the connection to GNUS-COMMAND-METHOD." @@ -287,8 +314,8 @@ If it is down, start it up (again)." (defun gnus-status-message (gnus-command-method) "Return the status message from GNUS-COMMAND-METHOD. -If GNUS-COMMAND-METHOD is a string, it is interpreted as a group name. The method -this group uses will be queried." +If GNUS-COMMAND-METHOD is a string, it is interpreted as a group +name. The method this group uses will be queried." (let ((gnus-command-method (if (stringp gnus-command-method) (gnus-find-method-for-group gnus-command-method) @@ -383,7 +410,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (gnus-group-real-name group) article)))) (defun gnus-request-set-mark (group action) - "Set marks on articles in the backend." + "Set marks on articles in the back end." (let ((gnus-command-method (gnus-find-method-for-group group))) (if (not (gnus-check-backend-function 'request-set-mark (car gnus-command-method))) @@ -393,7 +420,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (nth 1 gnus-command-method))))) (defun gnus-request-update-mark (group article mark) - "Allow the backend to change the mark the user tries to put on an article." + "Allow the back end to change the mark the user tries to put on an article." (let ((gnus-command-method (gnus-find-method-for-group group))) (if (not (gnus-check-backend-function 'request-update-mark (car gnus-command-method))) @@ -521,8 +548,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (defun gnus-request-expire-articles (articles group &optional force) (let* ((gnus-command-method (gnus-find-method-for-group group)) - (not-deleted - (funcall + (not-deleted + (funcall (gnus-get-function gnus-command-method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 gnus-command-method) force))) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 5f90549..a14d340 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -248,7 +248,7 @@ See also the `mml-default-encrypt-method' variable." (defcustom gnus-message-replysignencrypted t - "Setting this causes automatically encryped messages to also be signed." + "Setting this causes automatically encrypted messages to also be signed." :group 'gnus-message :type 'boolean) @@ -535,7 +535,9 @@ Gcc: header for archiving purposes." (set-window-configuration ,winconf)) 'exit 'postpone 'kill) (let ((to-be-marked (cond - (yanked yanked) + (yanked + (mapcar + (lambda (x) (if (listp x) (car x) x)) yanked)) (article (if (listp article) article (list article))) (t nil)))) (message-add-action @@ -587,7 +589,7 @@ If ARG is 1, prompt for group name to post to. This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the -network. The corresponding backend must have a 'request-post method." +network. The corresponding back end must have a 'request-post method." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. @@ -666,7 +668,7 @@ If ARG, don't do that. If ARG is 1, prompt for group name to post to. This function prepares a news even when using mail groups. This is useful for posting messages to mail groups without actually sending them over the -network. The corresponding backend must have a 'request-post method." +network. The corresponding back end must have a 'request-post method." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. @@ -720,8 +722,7 @@ a news." If prefix argument YANK is non-nil, the original article is yanked automatically. YANK is a list of elements, where the car of each element is the -article number, and the two following numbers is the region to be -yanked." +article number, and the cdr is the string to be yanked." (interactive (list (and current-prefix-arg (gnus-summary-work-articles 1)))) @@ -1038,52 +1039,16 @@ If SILENT, don't prompt the user." -;; Dummies to avoid byte-compile warning. -(eval-when-compile - (defvar nnspool-rejected-article-hook) - (defvar xemacs-codename)) - (defun gnus-extended-version () "Stringified Gnus version and Emacs version. See the variable `gnus-user-agent'." (interactive) - (let* ((gnus-v + (let* ((float-output-format nil) + (gnus-v (concat "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t) " (" gnus-version ")")) - (system-v - (cond - ((eq gnus-user-agent 'emacs-gnus-config) - system-configuration) - ((eq gnus-user-agent 'emacs-gnus-type) - (symbol-name system-type)) - (t nil))) - (emacs-v - (cond - ((eq gnus-user-agent 'gnus) - nil) - ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) - (concat "Emacs/" (match-string 1 emacs-version) - (if system-v - (concat " (" system-v ")") - ""))) - ((string-match - "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" - emacs-version) - (concat - (match-string 1 emacs-version) - (format "/%d.%d" emacs-major-version emacs-minor-version) - (if (match-beginning 3) - (match-string 3 emacs-version) - "") - (if (boundp 'xemacs-codename) - (concat - " (" xemacs-codename - (if system-v - (concat ", " system-v ")") - ")")) - ""))) - (t emacs-version)))) + (emacs-v (gnus-emacs-version))) (if (stringp gnus-user-agent) gnus-user-agent (concat gnus-v @@ -1108,7 +1073,7 @@ If VERY-WIDE, make a very wide reply." (gnus-summary-work-articles 1)))) ;; Allow user to require confirmation before replying by mail to the ;; author of a news article (or mail message). - (when (or + (when (or (not (or (gnus-news-group-p gnus-newsgroup-name) gnus-confirm-treat-mail-like-news)) (not (cond ((stringp gnus-confirm-mail-reply-to-news) @@ -1312,7 +1277,6 @@ composing a new message." ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "Resend" to)) (insert-buffer-substring cur) - (mime-to-mml) (message-narrow-to-head-1) ;; Gnus will generate a new one when sending. (message-remove-header "Message-ID") @@ -1321,8 +1285,8 @@ composing a new message." (goto-char (point-max)) (insert mail-header-separator) (goto-char (point-min)) - (re-search-forward "^To:\\|^Newsgroups:" nil 'move) - (forward-char 1) + (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move) + (forward-char 1)) (widen))))) (defun gnus-summary-post-forward (&optional arg) @@ -1418,7 +1382,7 @@ The current group name will be inserted at \"%s\".") ;; This mail group doesn't have a `to-list', so we add one ;; here. Magic! (when (gnus-y-or-n-p - (format "Do you want to add this as `to-list': %s " to-address)) + (format "Do you want to add this as `to-list': %s? " to-address)) (gnus-group-add-parameter group (cons 'to-list to-address)))))) (defun gnus-put-message () @@ -1518,8 +1482,7 @@ If YANK is non-nil, include the original article." (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) current-prefix-arg)) (gnus-summary-iterate n - (let ((gnus-display-mime-function nil) - (gnus-inhibit-treatment t)) + (let ((gnus-inhibit-treatment t)) (gnus-summary-select-article)) (save-excursion (set-buffer buffer) @@ -1586,7 +1549,7 @@ The source file has to be in the Emacs load path." (defun gnus-summary-resend-bounced-mail (&optional fetch) "Re-mail the current message. -This only makes sense if the current message is a bounce message than +This only makes sense if the current message is a bounce message that contains some mail you have written which has been bounced back to you. If FETCH, try to fetch the article that this is a reply to, if indeed @@ -1784,9 +1747,14 @@ this is a reply." (if (string-match " " gcc-self-val) (concat "\"" gcc-self-val "\"") gcc-self-val) - (if (string-match " " group) - (concat "\"" group "\"") - group))) + ;; In nndoc groups, we use the parent group name + ;; instead of the current group. + (let ((group (or (gnus-group-find-parameter + gnus-newsgroup-name 'parent-group) + group))) + (if (string-match " " group) + (concat "\"" group "\"") + group)))) (if (not (eq gcc-self-val 'none)) (insert "\n") (gnus-delete-line))) @@ -1820,7 +1788,7 @@ this is a reply." (unless gnus-inhibit-posting-styles (let ((group (or group-name gnus-newsgroup-name "")) (styles gnus-posting-styles) - style match variable attribute value v results + style match attribute value v results filep name address element) ;; If the group has a posting-style parameter, add it at the end with a ;; regexp matching everything, to be sure it takes precedence over all @@ -1868,7 +1836,6 @@ this is a reply." ;; We have a match, so we set the variables. (dolist (attribute style) (setq element (pop attribute) - variable nil filep nil) (setq value (cond diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 9844b07..9303dc1 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. -;; Author: Wes Hardaker +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news xpm annotation glyph faces ;; This file is part of GNU Emacs. @@ -35,7 +35,9 @@ ;; domain/dom/subdomain/unknown/face.gif ;; Groups: comp.lang.lisp ;; news/comp/lang/lisp/unknown/face.gif - +;; +;; Original implementation by Wes Hardaker . +;; ;;; Code: (require 'gnus) @@ -139,7 +141,7 @@ GLYPH can be either a glyph or a string." (insert glyph) (gnus-add-wash-type category) (gnus-add-image category (car glyph)) - (gnus-put-image (car glyph) (cdr glyph)))) + (gnus-put-image (car glyph) (cdr glyph) category))) (defun gnus-picon-create-glyph (file) (or (cdr (assoc file gnus-picon-glyph-alist)) @@ -154,8 +156,11 @@ GLYPH can be either a glyph or a string." (mail-header-parse-addresses ;; mail-header-parse-addresses does not work (reliably) on ;; decoded headers. - (mail-encode-encoded-word-string - (or (mail-fetch-field header) "")))) + (or + (ignore-errors + (mail-encode-encoded-word-string + (or (mail-fetch-field header) ""))) + (mail-fetch-field header)))) spec file point cache) (dolist (address addresses) (setq address (car address)) @@ -231,37 +236,46 @@ GLYPH can be either a glyph or a string." ;;; Commands: +;; #### NOTE: the test for buffer-read-only is the same as in +;; article-display-[x-]face. See the comment up there. + ;;;###autoload (defun gnus-treat-from-picon () "Display picons in the From header. If picons are already displayed, remove them." (interactive) - (gnus-with-article-buffer - (if (memq 'from-picon gnus-article-wash-types) - (gnus-delete-images 'from-picon) - (gnus-picon-transform-address "from" 'from-picon)))) + (let ((wash-picon-p buffer-read-only)) + (gnus-with-article-buffer + (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) + (gnus-delete-images 'from-picon) + (gnus-picon-transform-address "from" 'from-picon))) + )) ;;;###autoload (defun gnus-treat-mail-picon () "Display picons in the Cc and To headers. If picons are already displayed, remove them." (interactive) - (gnus-with-article-buffer - (if (memq 'mail-picon gnus-article-wash-types) - (gnus-delete-images 'mail-picon) - (gnus-picon-transform-address "cc" 'mail-picon) - (gnus-picon-transform-address "to" 'mail-picon)))) + (let ((wash-picon-p buffer-read-only)) + (gnus-with-article-buffer + (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) + (gnus-delete-images 'mail-picon) + (gnus-picon-transform-address "cc" 'mail-picon) + (gnus-picon-transform-address "to" 'mail-picon))) + )) ;;;###autoload (defun gnus-treat-newsgroups-picon () "Display picons in the Newsgroups and Followup-To headers. If picons are already displayed, remove them." (interactive) - (gnus-with-article-buffer - (if (memq 'newsgroups-picon gnus-article-wash-types) - (gnus-delete-images 'newsgroups-picon) - (gnus-picon-transform-newsgroups "newsgroups") - (gnus-picon-transform-newsgroups "followup-to")))) + (let ((wash-picon-p buffer-read-only)) + (gnus-with-article-buffer + (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) + (gnus-delete-images 'newsgroups-picon) + (gnus-picon-transform-newsgroups "newsgroups") + (gnus-picon-transform-newsgroups "followup-to"))) + )) (provide 'gnus-picon) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index e97b1e4..900eeab 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -24,6 +24,34 @@ ;;; Commentary: +;; This is the gnus-registry.el package, works with other backends +;; besides nnmail. The major issue is that it doesn't go across +;; backends, so for instance if an article is in nnml:sys and you see +;; a reference to it in nnimap splitting, the article will end up in +;; nnimap:sys + +;; gnus-registry.el intercepts article respooling, moving, deleting, +;; and copying for all backends. If it doesn't work correctly for +;; you, submit a bug report and I'll be glad to fix it. It needs +;; documentation in the manual (also on my to-do list). + +;; Put this in your startup file (~/.gnus.el for instance) + +;; (setq gnus-registry-max-entries 2500 +;; gnus-registry-use-long-group-names t) + +;; (gnus-registry-initialize) + +;; Then use this in your fancy-split: + +;; (: gnus-registry-split-fancy-with-parent) + +;; TODO: + +;; - get the correct group on spool actions + +;; - articles that are spooled to a different backend should be handled + ;;; Code: (eval-when-compile (require 'cl)) @@ -33,6 +61,9 @@ (require 'gnus-sum) (require 'nnmail) +(defvar gnus-registry-dirty t + "Boolean set to t when the registry is modified") + (defgroup gnus-registry nil "The Gnus registry." :group 'gnus) @@ -51,11 +82,53 @@ The group names are matched, they don't have to be fully qualified." :group 'gnus-registry :type 'boolean) +(defcustom gnus-registry-clean-empty t + "Whether the empty registry entries should be deleted. +Registry entries are considered empty when they have no groups." + :group 'gnus-registry + :type 'boolean) + +(defcustom gnus-registry-use-long-group-names nil + "Whether the registry should use long group names (BUGGY)." + :group 'gnus-registry + :type 'boolean) + +(defcustom gnus-registry-track-extra nil + "Whether the registry should track extra data about a message. +The Subject and Sender (From:) headers are currently tracked this +way." + :group 'gnus-registry + :type + '(set :tag "Tracking choices" + (const :tag "Track by subject (Subject: header)" subject) + (const :tag "Track by sender (From: header)" sender))) + +(defcustom gnus-registry-entry-caching t + "Whether the registry should cache extra information." + :group 'gnus-registry + :type 'boolean) + +(defcustom gnus-registry-minimum-subject-length 5 + "The minimum length of a subject before it's considered trackable." + :group 'gnus-registry + :type 'integer) + +(defcustom gnus-registry-trim-articles-without-groups t + "Whether the registry should clean out message IDs without groups." + :group 'gnus-registry + :type 'boolean) + (defcustom gnus-registry-cache-file "~/.gnus.registry.eld" "File where the Gnus registry will be stored." :group 'gnus-registry :type 'file) +(defcustom gnus-registry-max-entries nil + "Maximum number of entries in the registry, nil for unlimited." + :group 'gnus-registry + :type '(radio (const :format "Unlimited " nil) + (integer :format "Maximum number: %v\n" :size 0))) + ;; Function(s) missing in Emacs 20 (when (memq nil (mapcar 'fboundp '(puthash))) (require 'cl) @@ -63,6 +136,12 @@ The group names are matched, they don't have to be fully qualified." ;; alias puthash is missing from Emacs 20 cl-extra.el (defalias 'puthash 'cl-puthash))) +(defun gnus-registry-track-subject-p () + (memq 'subject gnus-registry-track-extra)) + +(defun gnus-registry-track-sender-p () + (memq 'sender gnus-registry-track-extra)) + (defun gnus-registry-cache-read () "Read the registry cache file." (interactive) @@ -77,7 +156,6 @@ The group names are matched, they don't have to be fully qualified." (interactive) (let ((file gnus-registry-cache-file)) (save-excursion - ;; Save .newsrc.eld. (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*")) (make-local-variable 'version-control) (setq version-control gnus-backup-startup-file) @@ -138,7 +216,7 @@ The group names are matched, they don't have to be fully qualified." ;; Idea from Dan Christensen ;; Save the gnus-registry file with extra line breaks. (defun gnus-registry-cache-whitespace (filename) - (gnus-message 4 "Adding whitespace to %s" filename) + (gnus-message 5 "Adding whitespace to %s" filename) (save-excursion (goto-char (point-min)) (while (re-search-forward "^(\\|(\\\"" nil t) @@ -147,13 +225,66 @@ The group names are matched, they don't have to be fully qualified." (while (re-search-forward " $" nil t) (replace-match "" t t)))) -(defun gnus-registry-save () - (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb)) - (gnus-registry-cache-save)) +(defun gnus-registry-save (&optional force) + (when (or gnus-registry-dirty force) + (let ((caching gnus-registry-entry-caching)) + ;; turn off entry caching, so mtime doesn't get recorded + (setq gnus-registry-entry-caching nil) + ;; remove entry caches + (maphash + (lambda (key value) + (if (hash-table-p value) + (remhash key gnus-registry-hashtb))) + gnus-registry-hashtb) + ;; remove empty entries + (when gnus-registry-clean-empty + (gnus-registry-clean-empty-function)) + ;; now trim the registry appropriately + (setq gnus-registry-alist (gnus-registry-trim + (hashtable-to-alist gnus-registry-hashtb))) + ;; really save + (gnus-registry-cache-save) + (setq gnus-registry-entry-caching caching) + (setq gnus-registry-dirty nil)))) + +(defun gnus-registry-clean-empty-function () + "Remove all empty entries from the registry. Returns count thereof." + (let ((count 0)) + (maphash + (lambda (key value) + (unless (gnus-registry-fetch-group key) + (incf count) + (remhash key gnus-registry-hashtb))) + gnus-registry-hashtb) + count)) (defun gnus-registry-read () (gnus-registry-cache-read) - (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))) + (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)) + (setq gnus-registry-dirty nil)) + +(defun gnus-registry-trim (alist) + "Trim alist to size, using gnus-registry-max-entries." + (if (null gnus-registry-max-entries) + alist ; just return the alist + ;; else, when given max-entries, trim the alist + (let ((timehash (make-hash-table + :size 4096 + :test 'equal))) + (maphash + (lambda (key value) + (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) + gnus-registry-hashtb) + + ;; we use the return value of this setq, which is the trimmed alist + (setq alist + (nthcdr + (- (length alist) gnus-registry-max-entries) + (sort alist + (lambda (a b) + (time-less-p + (cdr (gethash (car a) timehash)) + (cdr (gethash (car b) timehash)))))))))) (defun alist-to-hashtable (alist) "Build a hashtable from the values in ALIST." @@ -175,12 +306,15 @@ The group names are matched, they don't have to be fully qualified." hash) list)) -(defun gnus-register-action (action data-header from &optional to method) +(defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) - (from (gnus-group-guess-full-name from)) - (to (if to (gnus-group-guess-full-name to) nil)) - (to-name (if to to "the Bit Bucket")) - (old-entry (gethash id gnus-registry-hashtb))) + (subject (gnus-registry-simplify-subject + (mail-header-subject data-header))) + (sender (mail-header-from data-header)) + (from (gnus-group-guess-full-name-from-command-method from)) + (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) + (to-name (if to to "the Bit Bucket")) + (old-entry (gethash id gnus-registry-hashtb))) (gnus-message 5 "Registry: article %s %s from %s to %s" id (if method "respooling" "going") @@ -191,21 +325,18 @@ The group names are matched, they don't have to be fully qualified." (gnus-registry-delete-group id from) (when (equal 'copy action) - (gnus-registry-add-group id from)) ; undo the delete - - (gnus-registry-add-group id to))) - -(defun gnus-register-spool-action (id group) - ;; do not process the draft IDs -; (unless (string-match "totally-fudged-out-message-id" id) -; (let ((group (gnus-group-guess-full-name group))) - (when (string-match "\r$" id) - (setq id (substring id 0 -1))) - (gnus-message 5 "Registry: article %s spooled to %s" - id - group) - (gnus-registry-add-group id group)) -;) + (gnus-registry-add-group id from subject sender)) ; undo the delete + + (gnus-registry-add-group id to subject sender))) + +(defun gnus-registry-spool-action (id group &optional subject sender) + (let ((group (gnus-group-guess-full-name-from-command-method group))) + (when (and (stringp id) (string-match "\r$" id)) + (setq id (substring id 0 -1))) + (gnus-message 5 "Registry: article %s spooled to %s" + id + group) + (gnus-registry-add-group id group subject sender))) ;; Function for nn{mail|imap}-split-fancy: look up all references in ;; the cache and if a match is found, return that group. @@ -227,23 +358,101 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nnmail-split-fancy-with-parent-ignore-groups (list nnmail-split-fancy-with-parent-ignore-groups))) references res) - (when refstr - (setq references (nreverse (gnus-split-references refstr))) - (mapcar (lambda (x) - (setq res (or (gnus-registry-fetch-group x) res)) - (when (or (gnus-registry-grep-in-list - res - gnus-registry-unfollowed-groups) - (gnus-registry-grep-in-list - res - nnmail-split-fancy-with-parent-ignore-groups)) - (setq res nil))) - references) - (gnus-message - 5 - "gnus-registry-split-fancy-with-parent traced %s to group %s" - refstr (if res res "nil")) - res))) + (if refstr + (progn + (setq references (nreverse (gnus-split-references refstr))) + (mapcar (lambda (x) + (setq res (or (gnus-registry-fetch-group x) res)) + (when (or (gnus-registry-grep-in-list + res + gnus-registry-unfollowed-groups) + (gnus-registry-grep-in-list + res + nnmail-split-fancy-with-parent-ignore-groups)) + (setq res nil))) + references)) + + ;; else: there were no references, now try the extra tracking + (let ((sender (message-fetch-field "from")) + (subject (gnus-registry-simplify-subject + (message-fetch-field "subject"))) + (single-match t)) + (when (and single-match + (gnus-registry-track-sender-p) + sender) + (maphash + (lambda (key value) + (let ((this-sender (cdr + (gnus-registry-fetch-extra key 'sender)))) + (when (and single-match + this-sender + (equal sender this-sender)) + ;; too many matches, bail + (unless (equal res (gnus-registry-fetch-group key)) + (setq single-match nil)) + (setq res (gnus-registry-fetch-group key)) + (gnus-message + ;; raise level of messaging if gnus-registry-track-extra + (if gnus-registry-track-extra 5 9) + "%s (extra tracking) traced sender %s to group %s" + "gnus-registry-split-fancy-with-parent" + sender + (if res res "nil"))))) + gnus-registry-hashtb)) + (when (and single-match + (gnus-registry-track-subject-p) + subject + (< gnus-registry-minimum-subject-length (length subject))) + (maphash + (lambda (key value) + (let ((this-subject (cdr + (gnus-registry-fetch-extra key 'subject)))) + (when (and single-match + this-subject + (equal subject this-subject)) + ;; too many matches, bail + (unless (equal res (gnus-registry-fetch-group key)) + (setq single-match nil)) + (setq res (gnus-registry-fetch-group key)) + (gnus-message + ;; raise level of messaging if gnus-registry-track-extra + (if gnus-registry-track-extra 5 9) + "%s (extra tracking) traced subject %s to group %s" + "gnus-registry-split-fancy-with-parent" + subject + (if res res "nil"))))) + gnus-registry-hashtb)) + (unless single-match + (gnus-message + 5 + "gnus-registry-split-fancy-with-parent: too many extra matches for %s" + refstr) + (setq res nil)))) + (gnus-message + 5 + "gnus-registry-split-fancy-with-parent traced %s to group %s" + refstr (if res res "nil")) + + (when (and res gnus-registry-use-long-group-names) + (let ((m1 (gnus-find-method-for-group res)) + (m2 (or gnus-command-method + (gnus-find-method-for-group gnus-newsgroup-name))) + (short-res (gnus-group-short-name res))) + (if (gnus-methods-equal-p m1 m2) + (progn + (gnus-message + 9 + "gnus-registry-split-fancy-with-parent stripped group %s to %s" + res + short-res) + (setq res short-res)) + ;; else... + (gnus-message + 5 + "gnus-registry-split-fancy-with-parent ignored foreign group %s" + res) + (setq res nil)))) + res)) (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group" @@ -253,8 +462,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (unless (gnus-registry-fetch-group id) (gnus-message 9 "Registry: Registering article %d with group %s" article gnus-newsgroup-name) - (gnus-registry-add-group (gnus-registry-fetch-message-id-fast article) - gnus-newsgroup-name)))))) + (gnus-registry-add-group + (gnus-registry-fetch-message-id-fast article) + gnus-newsgroup-name + (gnus-registry-fetch-simplified-message-subject-fast article) + (gnus-registry-fetch-sender-fast article))))))) (defun gnus-registry-fetch-message-id-fast (article) "Fetch the Message-ID quickly, using the internal gnus-data-list function" @@ -263,6 +475,28 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil)))) nil)) +(defun gnus-registry-simplify-subject (subject) + (if (stringp subject) + (gnus-simplify-subject subject) + nil)) + +(defun gnus-registry-fetch-simplified-message-subject-fast (article) + "Fetch the Subject quickly, using the internal gnus-data-list function" + (if (and (numberp article) + (assoc article (gnus-data-list nil))) + (gnus-registry-simplify-subject + (mail-header-subject (gnus-data-header + (assoc article (gnus-data-list nil))))) + nil)) + +(defun gnus-registry-fetch-sender-fast (article) + "Fetch the Sender quickly, using the internal gnus-data-list function" + (if (and (numberp article) + (assoc article (gnus-data-list nil))) + (mail-header-from (gnus-data-header + (assoc article (gnus-data-list nil)))) + nil)) + (defun gnus-registry-grep-in-list (word list) (when word (memq nil @@ -275,15 +509,40 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun gnus-registry-fetch-extra (id &optional entry) "Get the extra data of a message, based on the message ID. Returns the first place where the trail finds a nonstring." - (let ((trail (gethash id gnus-registry-hashtb))) - (dolist (crumb trail) - (unless (stringp crumb) - (return (gnus-registry-fetch-extra-entry crumb entry)))))) - -(defun gnus-registry-fetch-extra-entry (alist &optional entry) - "Get the extra data of a message, or a specific entry in it." - (if entry - (assq entry alist) + (let ((entry-cache (gethash entry gnus-registry-hashtb))) + (if (and entry + (hash-table-p entry-cache) + (gethash id entry-cache)) + (gethash id entry-cache) + ;; else, if there is no caching possible... + (let ((trail (gethash id gnus-registry-hashtb))) + (when (listp trail) + (dolist (crumb trail) + (unless (stringp crumb) + (return (gnus-registry-fetch-extra-entry crumb entry id))))))))) + +(defun gnus-registry-fetch-extra-entry (alist &optional entry id) + "Get the extra data of a message, or a specific entry in it. +Update the entry cache if needed." + (if (and entry id) + (let ((entry-cache (gethash entry gnus-registry-hashtb)) + entree) + (when gnus-registry-entry-caching + ;; create the hash table + (unless (hash-table-p entry-cache) + (setq entry-cache (make-hash-table + :size 4096 + :test 'equal)) + (puthash entry entry-cache gnus-registry-hashtb)) + + ;; get the entree from the hash table or from the alist + (setq entree (gethash id entry-cache))) + + (unless entree + (setq entree (assq entry alist)) + (when gnus-registry-entry-caching + (puthash id entree entry-cache))) + entree) alist)) (defun gnus-registry-store-extra (id extra) @@ -292,9 +551,17 @@ The message must have at least one group name." (when (gnus-registry-group-count id) ;; we now know the trail has at least 1 group name, so it's not empty (let ((trail (gethash id gnus-registry-hashtb)) - (old-extra (gnus-registry-fetch-extra id))) + (old-extra (gnus-registry-fetch-extra id)) + entry-cache) + (dolist (crumb trail) + (unless (stringp crumb) + (dolist (entry crumb) + (setq entry-cache (gethash (car entry) gnus-registry-hashtb)) + (when entry-cache + (remhash id entry-cache)))) (puthash id (cons extra (delete old-extra trail)) - gnus-registry-hashtb)))) + gnus-registry-hashtb) + (setq gnus-registry-dirty t))))) (defun gnus-registry-store-extra-entry (id key value) "Put a specific entry in the extras field of the registry entry for id." @@ -311,7 +578,9 @@ Returns the first place where the trail finds a group name." (let ((trail (gethash id gnus-registry-hashtb))) (dolist (crumb trail) (when (stringp crumb) - (return crumb)))))) + (return (if gnus-registry-use-long-group-names + crumb + (gnus-group-short-name crumb)))))))) (defun gnus-registry-group-count (id) "Get the number of groups of a message, based on the message ID." @@ -331,47 +600,100 @@ Returns the first place where the trail finds a group name." nil) gnus-registry-hashtb)) ;; now, clear the entry if there are no more groups - (unless (gnus-registry-group-count id) - (remhash id gnus-registry-hashtb)) + (when gnus-registry-trim-articles-without-groups + (unless (gnus-registry-group-count id) + (gnus-registry-delete-id id))) (gnus-registry-store-extra-entry id 'mtime (current-time))))) -(defun gnus-registry-add-group (id group &rest extra) +(defun gnus-registry-delete-id (id) + "Delete a message ID from the registry." + (when (stringp id) + (remhash id gnus-registry-hashtb) + (maphash + (lambda (key value) + (when (hash-table-p value) + (remhash id value))) + gnus-registry-hashtb))) + +(defun gnus-registry-add-group (id group &optional subject sender) "Add a group for a message, based on the message ID." - ;; make sure there are no duplicate entries (when group (when (and id (not (string-match "totally-fudged-out-message-id" id))) - (let ((group (gnus-group-short-name group))) - (gnus-registry-delete-group id group) + (let ((full-group group) + (group (if gnus-registry-use-long-group-names + group + (gnus-group-short-name group)))) + (gnus-registry-delete-group id group) + + (unless gnus-registry-use-long-group-names ;; unnecessary in this case + (gnus-registry-delete-group id full-group)) + (let ((trail (gethash id gnus-registry-hashtb))) (puthash id (if trail (cons group trail) (list group)) gnus-registry-hashtb) - (when extra (gnus-registry-store-extra id extra)) + + (when (and (gnus-registry-track-subject-p) + subject) + (gnus-registry-store-extra-entry + id + 'subject + (gnus-registry-simplify-subject subject))) + (when (and (gnus-registry-track-sender-p) + sender) + (gnus-registry-store-extra-entry + id + 'sender + sender)) + (gnus-registry-store-extra-entry id 'mtime (current-time))))))) (defun gnus-registry-clear () "Clear the Gnus registry." (interactive) (setq gnus-registry-alist nil) - (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))) + (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)) + (setq gnus-registry-dirty t)) + +;;;###autoload +(defun gnus-registry-initialize () + (interactive) + (setq gnus-registry-install t) + (gnus-registry-install-hooks) + (gnus-registry-read)) +;;;###autoload (defun gnus-registry-install-hooks () "Install the registry hooks." (interactive) - (add-hook 'gnus-summary-article-move-hook 'gnus-register-action) - (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) + (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) + (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) + (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) + (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) +(defun gnus-registry-unload-hook () + "Uninstall the registry hooks." + (interactive) + (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) + (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) + (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) + (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) + + (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) + (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) + + (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) + (when gnus-registry-install - (gnus-registry-install-hooks)) + (gnus-registry-install-hooks) + (gnus-registry-read)) ;; TODO: a lot of things diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index b2188ed..3bd29b5 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -238,7 +238,8 @@ This variable allows the same syntax as `gnus-home-score-file'." (defcustom gnus-adaptive-word-length-limit nil "*Words of a length lesser than this limit will be ignored when doing adaptive scoring." :group 'gnus-score-adapt - :type 'integer) + :type '(radio (const :format "Unlimited " nil) + (integer :format "Maximum length: %v\n" :size 0))) (defcustom gnus-ignored-adaptive-words nil "List of words to be ignored when doing adaptive word scoring." @@ -491,7 +492,8 @@ of the last successful match.") "Make a score entry based on the current article. The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be -used as score." +used as score. A symbolic prefix of `a' says to use the `all.SCORE' +file for the command instead of the current score file." (interactive (gnus-interactive "P\ny")) (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp)) @@ -505,7 +507,8 @@ used as score." "Make a score entry based on the current article. The user will be prompted for header to score on, match type, permanence, and the string to be used. The numerical prefix will be -used as score." +used as score. A symbolic prefix of `a' says to use the `all.SCORE' +file for the command instead of the current score file." (interactive (gnus-interactive "P\ny")) (let* ((nscore (gnus-score-delta-default score)) (prefix (if (< nscore 0) ?L ?I)) @@ -874,7 +877,7 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header." ;; Return the new scoring rule. new)) -(defun gnus-summary-score-effect (header match type score extra) +(defun gnus-summary-score-effect (header match type score &optional extra) "Simulate the effect of a score file entry. HEADER is the header being scored. MATCH is the string we are looking for. @@ -886,8 +889,8 @@ EXTRA is the possible non-standard header." (lambda (x) (fboundp (nth 2 x))) t) (read-string "Match: ") - (y-or-n-p "Use regexp match? ") - (prefix-numeric-value current-prefix-arg))) + (if (y-or-n-p "Use regexp match? ") 'r 's) + (string-to-int (read-string "Score: ")))) (save-excursion (unless (and (stringp match) (> (length match) 0)) (error "No match")) @@ -2917,13 +2920,19 @@ If ADAPT, return the home adaptive file instead." (defun gnus-decay-score (score) "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (floor - (- score - (* (if (< score 0) -1 1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) + (let ((n (- score + (* (if (< score 0) -1 1) + (min (abs score) + (max gnus-score-decay-constant + (* (abs score) + gnus-score-decay-scale))))))) + (if (and (featurep 'xemacs) + ;; XEmacs' floor can handle only the floating point + ;; number below the half of the maximum integer. + (> (abs n) (lsh -1 -2))) + (string-to-number + (car (split-string (number-to-string n) "\\."))) + (floor n)))) (defun gnus-decay-scores (alist day) "Decay non-permanent scores in ALIST." diff --git a/lisp/gnus-sieve.el b/lisp/gnus-sieve.el index b11ade5..824e66c 100644 --- a/lisp/gnus-sieve.el +++ b/lisp/gnus-sieve.el @@ -66,7 +66,7 @@ For example: \"nnimap:mailbox\"" (defcustom gnus-sieve-crosspost t "Whether the generated Sieve script should do crossposting." - :type 'bool + :type 'boolean :group 'gnus-sieve) (defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s" diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index b444032..b7c1a23 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -357,9 +357,9 @@ If NOT-ALL, don't pack ticked articles." (gnus-make-directory dir) (setq gnus-soup-areas nil) (gnus-message 4 "Packing %s..." packer) - (if (zerop (call-process shell-file-name - nil nil nil shell-command-switch - (concat "cd " dir " ; " packer))) + (if (eq 0 (call-process shell-file-name + nil nil nil shell-command-switch + (concat "cd " dir " ; " packer))) (progn (call-process shell-file-name nil nil nil shell-command-switch (concat "cd " dir " ; rm " files)) @@ -496,10 +496,10 @@ Return whether the unpacking was successful." (gnus-make-directory dir) (gnus-message 4 "Unpacking: %s" (format unpacker packet)) (prog1 - (zerop (call-process - shell-file-name nil nil nil shell-command-switch - (format "cd %s ; %s" (expand-file-name dir) - (format unpacker packet)))) + (eq 0 (call-process + shell-file-name nil nil nil shell-command-switch + (format "cd %s ; %s" (expand-file-name dir) + (format unpacker packet)))) (gnus-message 4 "Unpacking...done"))) (defun gnus-soup-send-packet (packet) @@ -549,7 +549,7 @@ Return whether the unpacking was successful." (sit-for 1) (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) - (method (if (message-functionp message-post-method) + (method (if (functionp message-post-method) (funcall message-post-method) message-post-method)) result) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index cf3d24c..6c57939 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -281,8 +281,7 @@ The following commands are available: "(closed)") ((error) "(error)"))))) (gnus-tmp-agent (if (and gnus-agent - (member method - gnus-agent-covered-methods)) + (gnus-agent-method-p method)) " (agent)" ""))) (beginning-of-line) @@ -291,7 +290,8 @@ The following commands are available: (prog1 (1+ (point)) ;; Insert the text. (eval gnus-server-line-format-spec)) - (list 'gnus-server (intern gnus-tmp-name))))) + (list 'gnus-server (intern gnus-tmp-name) + 'gnus-named-server (intern (gnus-method-to-server method)))))) (defun gnus-enter-server-buffer () "Set up the server buffer." @@ -345,6 +345,12 @@ The following commands are available: (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) (and server (symbol-name server)))) +(defun gnus-server-named-server () + "Returns a server name that matches one of the names returned by +gnus-method-to-server." + (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server))) + (and server (symbol-name server)))) + (defalias 'gnus-server-position-point 'gnus-goto-colon) (defconst gnus-server-edit-buffer "*Gnus edit server*") @@ -713,31 +719,46 @@ The following commands are available: 1 "Couldn't request list: %s" (gnus-status-message method)) nil) (t - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (let ((cur (current-buffer))) (goto-char (point-min)) (unless (string= gnus-ignored-newsgroups "") (delete-matching-lines gnus-ignored-newsgroups)) - (while (not (eobp)) - (ignore-errors - (push (cons - (if (eq (char-after) ?\") - (read cur) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) + ;; We treat NNTP as a special case to avoid problems with + ;; garbage group names like `"foo' that appear in some badly + ;; managed active files. -jh. + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (cons + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) + (let ((last (read cur))) + (cons (read cur) last))) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (cons + (if (eq (char-after) ?\") + (read cur) + (let ((p (point)) (name "")) (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - name)) - (let ((last (read cur))) - (cons (read cur) last))) - groups)) - (forward-line)))) + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + name)) + (let ((last (read cur))) + (cons (read cur) last))) + groups)) + (forward-line))))) (setq groups (sort groups (lambda (l1 l2) (string< (car l1) (car l2))))) @@ -896,6 +917,8 @@ buffer. (unless (eq (char-after) ? ) (setq sub t)) (setq group (gnus-browse-group-name)) + (when (gnus-server-equal gnus-browse-current-method "native") + (setq group (gnus-group-real-name group))) (if sub (progn ;; Make sure the group has been properly removed before we diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index f530bc6..c1c5091 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -33,6 +33,8 @@ (require 'gnus-range) (require 'gnus-util) (autoload 'message-make-date "message") +(autoload 'gnus-agent-read-servers-validate "gnus-agent") +(autoload 'gnus-agent-possibly-alter-active "gnus-agent") (eval-when-compile (require 'cl)) (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") @@ -242,7 +244,12 @@ nil if you set this variable to nil. This variable can also be a regexp. In that case, all groups that do not match this regexp will be removed before saving the list." :group 'gnus-newsrc - :type 'boolean) + :type '(radio (sexp :format "Non-nil\n" + :match (lambda (widget value) + (and value (not (stringp value)))) + :value t) + (const nil) + (regexp :format "%t: %v\n" :size 0))) (defcustom gnus-ignored-newsgroups (mapconcat 'identity @@ -281,8 +288,8 @@ claim them." (repeat function))) (defcustom gnus-subscribe-newsgroup-hooks nil - "*Hooks run after you subscribe to a new group. The hooks will be called -with new group's name as argument." + "*Hooks run after you subscribe to a new group. +The hooks will be called with new group's name as argument." :group 'gnus-group-new :type 'hook) @@ -381,7 +388,7 @@ This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) -(defcustom gnus-setup-news-hook +(defcustom gnus-setup-news-hook '(gnus-fixup-nnimap-unread-after-getting-new-news) "A hook after reading the .newsrc file, but before generating the buffer." :group 'gnus-start @@ -398,7 +405,7 @@ This hook is called as the first thing when Gnus is started." :type 'hook) (defcustom gnus-after-getting-new-news-hook - '(gnus-display-time-event-handler + '(gnus-display-time-event-handler gnus-fixup-nnimap-unread-after-getting-new-news) "*A hook run after Gnus checks for new news when Gnus is already running." :group 'gnus-group-new @@ -552,7 +559,7 @@ Can be used to turn version control on or off." (gnus-subscribe-newsgroup newsgroup)) (defun gnus-subscribe-alphabetically (newgroup) - "Subscribe new NEWSGROUP and insert it in alphabetical order." + "Subscribe new NEWGROUP and insert it in alphabetical order." (let ((groups (cdr gnus-newsrc-alist)) before) (while (and (not before) groups) @@ -562,7 +569,7 @@ Can be used to turn version control on or off." (gnus-subscribe-newsgroup newgroup before))) (defun gnus-subscribe-hierarchically (newgroup) - "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." + "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (save-excursion (set-buffer (nnheader-find-file-noselect gnus-current-startup-file)) @@ -653,6 +660,8 @@ the first newsgroup." ;; Clear other internal variables. (setq gnus-list-of-killed-groups nil gnus-have-read-active-file nil + gnus-agent-covered-methods nil + gnus-server-method-cache nil gnus-newsrc-alist nil gnus-newsrc-hashtb nil gnus-killed-list nil @@ -947,6 +956,15 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (eq gnus-read-active-file 'some)) (gnus-update-active-hashtb-from-killed)) + ;; Validate agent covered methods now that gnus-server-alist has + ;; been initialized. + ;; NOTE: This is here for one purpose only. By validating the + ;; agentized server's, it converts the old 5.10.3, and earlier, + ;; format to the current format. That enables the agent code + ;; within gnus-read-active-file to function correctly. + (if gnus-agent + (gnus-agent-read-servers-validate)) + ;; Read the active file and create `gnus-active-hashtb'. ;; If `gnus-read-active-file' is nil, then we just create an empty ;; hash table. The partial filling out of the hash table will be @@ -1242,7 +1260,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-message 7 "`A k' to list killed groups")))))) (defun gnus-subscribe-group (group &optional previous method) - "Subcribe GROUP and put it after PREVIOUS." + "Subscribe GROUP and put it after PREVIOUS." (gnus-group-change-level (if method (list t group gnus-level-default-subscribed nil nil method) @@ -1490,6 +1508,7 @@ newsgroup." (zerop (cdr active)) (gnus-active group)) (gnus-active group) + (gnus-set-active group active) ;; Return the new active info. active))))) @@ -1509,6 +1528,12 @@ newsgroup." (when (and gnus-use-cache info) (inline (gnus-cache-possibly-alter-active (gnus-info-group info) active))) + + ;; If the agent is enabled, we may have to alter the active info. + (when (and gnus-agent info) + (gnus-agent-possibly-alter-active + (gnus-info-group info) active)) + ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the ;; number to the group hash table entry. @@ -1958,7 +1983,7 @@ newsgroup." (gnus-message 5 "%sdone" mesg))))))) (defun gnus-read-active-file-2 (groups method) - "Read an active file for GROUPS in METHOD using gnus-retrieve-groups." + "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'." (when groups (save-excursion (set-buffer nntp-server-buffer) @@ -2631,8 +2656,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-dribble-delete-file) (gnus-group-set-mode-line))))) -(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name specific-variable) - "Print Gnus variables such as gnus-newsrc-alist in lisp format." +(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables) + "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format." (princ ";; -*- emacs-lisp -*-\n") (if name (princ (format ";; %s\n" name)) @@ -2658,13 +2683,12 @@ If FORCE is non-nil, the .newsrc file is read." (stringp gnus-save-killed-list)) (gnus-strip-killed-list) gnus-killed-list)) - (variables - (if specific-variable - (list specific-variable) - (if gnus-save-killed-list gnus-variable-list - ;; Remove the `gnus-killed-list' from the list of variables - ;; to be saved, if required. - (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) + (variables + (or specific-variables + (if gnus-save-killed-list gnus-variable-list + ;; Remove the `gnus-killed-list' from the list of variables + ;; to be saved, if required. + (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) ;; Peel off the "dummy" group. (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) @@ -2910,7 +2934,7 @@ If FORCE is non-nil, the .newsrc file is read." ;;;###autoload (defun gnus-declare-backend (name &rest abilities) - "Declare backend NAME with ABILITIES as a Gnus backend." + "Declare back end NAME with ABILITIES as a Gnus back end." (setq gnus-valid-select-methods (nconc gnus-valid-select-methods (list (apply 'list name abilities)))) @@ -2926,7 +2950,7 @@ If this variable is nil, don't do anything." default-directory))) (eval-and-compile -(defalias 'gnus-display-time-event-handler +(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. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 23d350a..b76a3e5 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -253,7 +253,12 @@ If threads are hidden, you have to run the command `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' to expose hidden threads." :group 'gnus-thread - :type 'boolean) + :type '(radio (sexp :format "Non-nil\n" + :match (lambda (widget value) + (not (or (consp value) (functionp value)))) + :value t) + (const nil) + (sexp :tag "Predicate specifier" :size 0))) (defcustom gnus-thread-hide-killed t "*If non-nil, hide killed threads automatically." @@ -951,7 +956,8 @@ default: The default article score. default-high: The default score for high scored articles. default-low: The default score for low scored articles. below: The score below which articles are automatically marked as read. -mark: The articles mark." +mark: The article's mark. +uncached: Non-nil if the article is uncached." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) face))) @@ -1062,7 +1068,7 @@ type of files to save." (defcustom gnus-read-all-available-headers nil "Whether Gnus should parse all headers made available to it. -This is mostly relevant for slow backends where the user may +This is mostly relevant for slow back ends where the user may wish to widen the summary buffer to include all headers that were fetched. Say, for nnultimate groups." :group 'gnus-summary @@ -1112,7 +1118,7 @@ the normal Gnus MIME machinery." "Function called to sort the articles within a thread after it has been gathered together.") (defvar gnus-summary-save-parts-type-history nil) -(defvar gnus-summary-save-parts-last-directory nil) +(defvar gnus-summary-save-parts-last-directory mm-default-directory) ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) @@ -2106,7 +2112,6 @@ increase the score of each group you read." ["Extract all parts" gnus-summary-save-parts t] ("Multipart" ["Repair multipart" gnus-summary-repair-multipart t] - ["Add buttons" gnus-summary-display-buttonized t] ["Pipe part" gnus-article-pipe-part t] ["Inline part" gnus-article-inline-part t] ["Encrypt body" gnus-article-encrypt-body @@ -2367,7 +2372,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup from here" gnus-summary-catchup-from-here t] - ["Catchup region" gnus-summary-mark-region-as-read + ["Catchup region" gnus-summary-mark-region-as-read (gnus-mark-active-p)] ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) ("Mark Various" @@ -3289,7 +3294,7 @@ buffer that was in action when the last article was fetched." gnus-unseen-mark) (t gnus-no-mark))) (gnus-tmp-downloaded - (cond (undownloaded + (cond (undownloaded gnus-undownloaded-mark) (gnus-newsgroup-agentized gnus-downloaded-mark) @@ -3317,7 +3322,7 @@ buffer that was in action when the last article was fetched." (setq gnus-tmp-lines -1)) (if (= gnus-tmp-lines -1) (setq gnus-tmp-lines "?") - (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) + (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -3645,7 +3650,7 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-run-hooks 'gnus-summary-prepare-hook))) (defsubst gnus-general-simplify-subject (subject) - "Simply subject by the same rules as gnus-gather-threads-by-subject." + "Simplify subject by the same rules as `gnus-gather-threads-by-subject'." (setq subject (cond ;; Truncate the subject. @@ -3971,6 +3976,13 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) +(defsubst gnus-remove-odd-characters (string) + "Translate STRING into something that doesn't contain weird characters." + (mm-subst-char-in-string + ?\r ?\- + (mm-subst-char-in-string + ?\n ?\- string))) + ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) @@ -3989,12 +4001,14 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (make-full-mail-header number ; number (condition-case () ; subject - (funcall gnus-decode-encoded-word-function - (setq x (nnheader-nov-field))) + (gnus-remove-odd-characters + (funcall gnus-decode-encoded-word-function + (setq x (nnheader-nov-field)))) (error x)) (condition-case () ; from - (funcall gnus-decode-encoded-word-function - (setq x (nnheader-nov-field))) + (gnus-remove-odd-characters + (funcall gnus-decode-encoded-word-function + (setq x (nnheader-nov-field)))) (error x)) (nnheader-nov-field) ; date (nnheader-nov-read-message-id) ; id @@ -4086,7 +4100,7 @@ the id of the parent article (if any)." (forward-line 1))))))) (defun gnus-summary-update-article-line (article header) - "Update the line for ARTICLE using HEADERS." + "Update the line for ARTICLE using HEADER." (let* ((id (mail-header-id header)) (thread (gnus-id-to-thread id))) (unless thread @@ -4102,7 +4116,7 @@ the id of the parent article (if any)." (let ((inserted (- (point) (progn (gnus-summary-insert-line - header level nil + header level nil (memq article gnus-newsgroup-undownloaded) (gnus-article-mark article) (memq article gnus-newsgroup-replied) @@ -4129,7 +4143,7 @@ the id of the parent article (if any)." (point))))) (when (cdr datal) (gnus-data-update-list - (cdr datal) + (cdr datal) (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted))))))) (defun gnus-summary-update-article (article &optional iheader) @@ -4526,10 +4540,10 @@ Unscored articles will be counted as having a score of zero." (mapcar (lambda (header) (setq previous-time - (time-to-seconds - (condition-case () - (mail-header-parse-date (mail-header-date header)) - (error previous-time))))) + (condition-case () + (time-to-seconds (mail-header-parse-date + (mail-header-date header))) + (error previous-time)))) (sort (message-flatten-list thread) (lambda (h1 h2) @@ -4567,17 +4581,17 @@ Unscored articles will be counted as having a score of zero." (defcustom gnus-sum-thread-tree-root "> " "With %B spec, used for the root of a thread. If nil, use subject instead." - :type 'string + :type '(radio (const :format "%v " nil) (string :size 0)) :group 'gnus-thread) (defcustom gnus-sum-thread-tree-false-root "> " "With %B spec, used for a false root of a thread. If nil, use subject instead." - :type 'string + :type '(radio (const :format "%v " nil) (string :size 0)) :group 'gnus-thread) (defcustom gnus-sum-thread-tree-single-indent "" "With %B spec, used for a thread with just one message. If nil, use subject instead." - :type 'string + :type '(radio (const :format "%v " nil) (string :size 0)) :group 'gnus-thread) (defcustom gnus-sum-thread-tree-vertical "| " "With %B spec, used for drawing a vertical line." @@ -4820,7 +4834,7 @@ or a straight list of headers." gnus-unseen-mark) (t gnus-no-mark)) gnus-tmp-downloaded - (cond ((memq number gnus-newsgroup-undownloaded) + (cond ((memq number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) (gnus-newsgroup-agentized gnus-downloaded-mark) @@ -5029,7 +5043,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-set-active group (cons (caar alist) (cdr active))))) (setq gnus-summary-use-undownloaded-faces - (not (gnus-agent-find-parameter + (not (gnus-agent-find-parameter group 'agent-disable-undownloaded-faces)))) @@ -5346,7 +5360,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." 'list)) (defun gnus-article-unpropagatable-p (mark) - "Return whether MARK should be propagated to backend." + "Return whether MARK should be propagated to back end." (memq mark gnus-article-unpropagated-mark-lists)) (defun gnus-adjust-marked-articles (info) @@ -5713,6 +5727,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Translate all TAB characters into SPACE characters. (subst-char-in-region (point-min) (point-max) ?\t ? t) (subst-char-in-region (point-min) (point-max) ?\r ? t) + (ietf-drums-unfold-fws) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) in-reply-to header p lines chars) @@ -6110,7 +6125,7 @@ If EXCLUDE-GROUP, do not go to this group." (if unread (progn (while data - (unless (memq (gnus-data-number (car data)) + (unless (memq (gnus-data-number (car data)) (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) @@ -6360,7 +6375,7 @@ displayed, no centering will be performed." (defun gnus-summary-toggle-truncation (&optional arg) "Toggle truncation of summary lines. -With arg, turn line truncation on if arg is positive." +With ARG, turn line truncation on if ARG is positive." (interactive "P") (setq truncate-lines (if (null arg) (not truncate-lines) @@ -6824,7 +6839,7 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially." "Go to the first subject satisfying any non-nil constraint. If UNREAD is non-nil, the article should be unread. If UNDOWNLOADED is non-nil, the article should be undownloaded. -If UNSEED is non-nil, the article should be unseen. +If UNSEEN is non-nil, the article should be unseen. Returns the article selected or nil if there are no matching articles." (interactive "P") (cond @@ -6849,7 +6864,7 @@ Returns the article selected or nil if there are no matching articles." (and unseen (memq num gnus-newsgroup-unseen))))))) (setq data (cdr data))) - (prog1 + (prog1 (if data (progn (goto-char (gnus-data-pos (car data))) @@ -7030,6 +7045,7 @@ be displayed." (interactive) (let ((mm-verify-option 'known) (mm-decrypt-option 'known) + (gnus-article-emulate-mime t) (gnus-buttonized-mime-types (append (list "multipart/signed" "multipart/encrypted") gnus-buttonized-mime-types))) @@ -7694,7 +7710,7 @@ article." (gnus-summary-position-point)))) (defun gnus-summary-insert-dormant-articles () - "Insert all the dormat articles for this group into the current buffer." + "Insert all the dormant articles for this group into the current buffer." (interactive) (let ((gnus-verbose (max 6 gnus-verbose))) (if (not gnus-newsgroup-dormant) @@ -7847,7 +7863,7 @@ If ALL, mark even excluded ticked and dormants as read." thread) (defun gnus-cut-threads (threads) - "Cut off all uninteresting articles from the beginning of threads." + "Cut off all uninteresting articles from the beginning of THREADS." (when (or (eq gnus-fetch-old-headers 'some) (eq gnus-fetch-old-headers 'invisible) (numberp gnus-fetch-old-headers) @@ -8017,7 +8033,8 @@ The difference between N and the number of articles fetched is returned." (set-buffer gnus-original-article-buffer) (nnheader-narrow-to-headers) (unless (setq ref (message-fetch-field "references")) - (setq ref (message-fetch-field "in-reply-to"))) + (when (setq ref (message-fetch-field "in-reply-to")) + (setq ref (gnus-extract-message-id-from-in-reply-to ref)))) (widen)) (setq ref ;; It's not the current article, so we take a bet on @@ -8080,7 +8097,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." gnus-newsgroup-name limit)) 'nov) (gnus-build-all-threads) - (error "Can't fetch thread from backends that don't support NOV")) + (error "Can't fetch thread from back ends that don't support NOV")) (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) (gnus-summary-limit-include-thread id))) @@ -8089,6 +8106,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (interactive "sMessage-ID: ") (when (and (stringp message-id) (not (zerop (length message-id)))) + (setq message-id (gnus-replace-in-string message-id " " "")) ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. (unless (string-match "^<" message-id) @@ -8180,6 +8198,7 @@ to guess what the document format is." (ogroup gnus-newsgroup-name) (params (append (gnus-info-params (gnus-get-info ogroup)) (list (cons 'to-group ogroup)) + (list (cons 'parent-group ogroup)) (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) @@ -8487,7 +8506,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (gnus-eval-in-buffer-window gnus-article-buffer (widen) (goto-char (point-min)) - (when gnus-page-broken + (when gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () @@ -8499,7 +8518,9 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (widen) (goto-char (point-max)) (recenter -3) - (when gnus-page-broken + (when gnus-break-pages + (when (re-search-backward page-delimiter nil t) + (narrow-to-region (match-end 0) (point-max))) (gnus-narrow-to-page)))) (defun gnus-summary-print-truncate-and-quote (string &optional len) @@ -8533,14 +8554,15 @@ to save in." (progn (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) - (gnus-article-delete-invisible-text) (gnus-remove-text-with-property 'gnus-decoration) (when (gnus-visual-p 'article-highlight 'highlight) ;; Copy-to-buffer doesn't copy overlay. So redo ;; highlight. (let ((gnus-article-buffer buffer)) (gnus-article-highlight-citation t) - (gnus-article-highlight-signature))) + (gnus-article-highlight-signature) + (gnus-article-emphasize) + (gnus-article-delete-invisible-text))) (let ((ps-left-header (list (concat "(" @@ -8688,10 +8710,12 @@ If ARG is a negative number, hide the unwanted header lines." (widen) (if window (set-window-start window (goto-char (point-min)))) - (setq gnus-page-broken - (when gnus-break-pages - (gnus-narrow-to-page) - t)) + (if gnus-break-pages + (gnus-narrow-to-page) + (when (gnus-visual-p 'page-marker) + (let ((buffer-read-only nil)) + (gnus-remove-text-with-property 'gnus-prev) + (gnus-remove-text-with-property 'gnus-next)))) (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () @@ -8922,7 +8946,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (list (cdr art-group))))) ;; See whether the article is to be put in the cache. - (let ((marks gnus-article-mark-lists) + (let ((marks (if (gnus-group-auto-expirable-p to-group) + gnus-article-mark-lists + (delete '(expirable . expire) + (copy-sequence gnus-article-mark-lists)))) (to-article (cdr art-group))) ;; Enter the article into the cache in the new group, @@ -8981,9 +9008,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." article gnus-newsgroup-name (current-buffer)))) ;; run the move/copy/crosspost/respool hook - (run-hook-with-args 'gnus-summary-article-move-hook + (run-hook-with-args 'gnus-summary-article-move-hook action - (gnus-data-header + (gnus-data-header (assoc article (gnus-data-list nil))) gnus-newsgroup-name to-newsgroup @@ -9270,7 +9297,7 @@ confirmation before the articles are deleted." (unless (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (let* ((article (car articles)) - (id (mail-header-id (gnus-data-header + (id (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil)))))) (run-hook-with-args 'gnus-summary-article-delete-hook 'delete id gnus-newsgroup-name nil @@ -9464,15 +9491,13 @@ groups." (gnus-summary-select-article) (save-excursion (set-buffer gnus-original-article-buffer) - (save-restriction - (message-narrow-to-head) - (let ((groups (nnmail-article-group 'identity trace))) - (unless silent - (if groups - (message "This message would go to %s" - (mapconcat 'car groups ", ")) - (message "This message would go to no groups")) - groups)))))) + (let ((groups (nnmail-article-group 'identity trace))) + (unless silent + (if groups + (message "This message would go to %s" + (mapconcat 'car groups ", ")) + (message "This message would go to no groups")) + groups))))) (defun gnus-summary-respool-trace () "Trace where the respool algorithm would put this article. @@ -9886,7 +9911,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (defun gnus-summary-update-download-mark (article) "Update the download mark." (gnus-summary-update-mark - (cond ((memq article gnus-newsgroup-undownloaded) + (cond ((memq article gnus-newsgroup-undownloaded) gnus-undownloaded-mark) (gnus-newsgroup-agentized gnus-downloaded-mark) @@ -10969,13 +10994,17 @@ If REVERSE, save parts that do not match TYPE." (not (string-match type (mm-handle-media-type handle))) (string-match type (mm-handle-media-type handle))) (let ((file (expand-file-name - (file-name-nondirectory - (or - (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (concat gnus-newsgroup-name - "." (number-to-string - (cdr gnus-article-current))))) + (gnus-map-function + mm-file-name-rewrite-functions + (file-name-nondirectory + (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (mail-content-type-get + (mm-handle-type handle) 'name) + (concat gnus-newsgroup-name + "." (number-to-string + (cdr gnus-article-current)))))) dir))) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) @@ -11207,7 +11236,7 @@ If REVERSE, save parts that do not match TYPE." (defvar gnus-summary-highlight-line-trigger nil) (defun gnus-summary-highlight-line-0 () - (if (and (eq gnus-summary-highlight-line-trigger + (if (and (eq gnus-summary-highlight-line-trigger gnus-summary-highlight) gnus-summary-highlight-line-cached) gnus-summary-highlight-line-cached diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 708e779..05dbadf 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -435,6 +435,8 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (and gnus-group-listed-groups (copy-sequence gnus-group-listed-groups)))) + (gnus-update-format-specifications nil 'topic) + (when (or (not gnus-topic-alist) (not gnus-topology-checked-p)) (gnus-topic-check-topology)) @@ -752,7 +754,7 @@ articles in the topic and its subtopics." (not (gnus-topic-goto-topic (caaar tp)))) (pop tp)) (if tp - (forward-line 1) + (gnus-topic-forward-topic 1) (gnus-topic-goto-missing-topic (caadr top))))) nil)) @@ -927,8 +929,8 @@ articles in the topic and its subtopics." ? )) (yanked (list group)) alist talist end) - ;; Then we enter the yanked groups into the topics they belong - ;; to. + ;; Then we enter the yanked groups into the topics + ;; they belong to. (when (setq alist (assoc (save-excursion (forward-line -1) (or diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index acbf843..abd382d 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -138,7 +138,7 @@ ;; It's harmless, though, so the main purpose of this alias is to shut ;; up the byte compiler. (defalias 'gnus-make-local-hook - (if (eq (get 'make-local-hook 'byte-compile) + (if (eq (get 'make-local-hook 'byte-compile) 'byte-compile-obsolete) 'ignore ; Emacs 'make-local-hook)) ; XEmacs @@ -170,6 +170,11 @@ (cons 'progn (cddr fval))))) (defun gnus-extract-address-components (from) + "Extract address components from a From header. +Given an RFC-822 address FROM, extract full name and canonical address. +Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple +solution than `mail-extract-address-components', which works much better, but +is slower." (let (name address) ;; First find the address - the thing with the @ in it. This may ;; not be accurate in mail addresses, but does the trick most of @@ -337,18 +342,18 @@ ;; the full date if it's older) (defun gnus-seconds-today () - "Returns the number of seconds passed today" + "Return the number of seconds passed today." (let ((now (decode-time (current-time)))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) (defun gnus-seconds-month () - "Returns the number of seconds passed this month" + "Return the number of seconds passed this month." (let ((now (decode-time (current-time)))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) (* (- (car (nthcdr 3 now)) 1) 3600 24)))) (defun gnus-seconds-year () - "Returns the number of seconds passed this year" + "Return the number of seconds passed this year." (let ((now (decode-time (current-time))) (days (format-time-string "%j" (current-time)))) (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) @@ -379,7 +384,7 @@ seconds passed since the start of today, of this month, of this year, respectively.") (defun gnus-user-date (messy-date) - "Format the messy-date acording to gnus-user-date-format-alist. + "Format the messy-date according to gnus-user-date-format-alist. Returns \" ? \" if there's bad input or if an other error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () @@ -579,7 +584,7 @@ If N, return the Nth ancestor instead." gname))) (defun gnus-make-sort-function (funs) - "Return a composite sort condition based on the functions in FUNC." + "Return a composite sort condition based on the functions in FUNS." (cond ;; Just a simple function. ((functionp funs) funs) @@ -596,7 +601,7 @@ If N, return the Nth ancestor instead." (car funs)))) (defun gnus-make-sort-function-1 (funs) - "Return a composite sort condition based on the functions in FUNC." + "Return a composite sort condition based on the functions in FUNS." (let ((function (car funs)) (first 't1) (last 't2)) @@ -798,6 +803,23 @@ with potentially long computations." ;;; Functions for saving to babyl/mail files. (eval-when-compile + (condition-case nil + (progn + (require 'rmail) + (autoload 'rmail-update-summary "rmailsum")) + (error + (define-compiler-macro rmail-select-summary (&rest body) + ;; Rmail of the XEmacs version is supplied by the package, and + ;; requires tm and apel packages. However, there may be those + ;; who haven't installed those packages. This macro helps such + ;; people even if they install those packages later. + `(eval '(rmail-select-summary ,@body))) + ;; If there's rmail but there's no tm (or there's apel of the + ;; mainstream, not the XEmacs version), loading rmail of the XEmacs + ;; version fails halfway, however it provides the rmail-select-summary + ;; macro which uses the following functions: + (autoload 'rmail-summary-displayed "rmail") + (autoload 'rmail-maybe-display-summary "rmail"))) (defvar rmail-default-rmail-file) (defvar mm-text-coding-system)) @@ -926,7 +948,7 @@ with potentially long computations." (insert "\^_"))) (defun gnus-map-function (funs arg) - "Applies the result of the first function in FUNS to the second, and so on. + "Apply the result of the first function in FUNS to the second, and so on. ARG is passed to the first function." (while funs (setq arg (funcall (pop funs) arg))) @@ -983,7 +1005,7 @@ Return the modified alist." `(setq ,alist (delq (,fun ,key ,alist) ,alist)))) (defun gnus-globalify-regexp (re) - "Returns a regexp that matches a whole line, iff RE matches a part of it." + "Return a regexp that matches a whole line, iff RE matches a part of it." (concat (unless (string-match "^\\^" re) "^.*") re (unless (string-match "\\$$" re) ".*$"))) @@ -1182,7 +1204,6 @@ If you find some problem with the directory separator character, try If optional second argument ALLOW-NEWLINES is non-nil, then allow the decoding of carriage returns and line feeds in the string, which is normally forbidden in URL encoding." - (setq str (or (mm-subst-char-in-string ?+ ? str) "")) ; why `or'? (let ((tmp "") (case-fold-search t)) (while (string-match "%[0-9a-f][0-9a-f]" str) @@ -1227,8 +1248,8 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (t (list 'local-map map)))) -(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate - require-match initial-contents +(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate + require-match initial-contents history default) "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen." `(completing-read ,prompt ,table ,predicate ,require-match @@ -1428,6 +1449,43 @@ predicate on the elements." (push (pop list1) res))) (nconc (nreverse res) list1 list2)))) +(eval-when-compile + (defvar xemacs-codename)) + +(defun gnus-emacs-version () + (let ((system-v + (cond + ((eq gnus-user-agent 'emacs-gnus-config) + system-configuration) + ((eq gnus-user-agent 'emacs-gnus-type) + (symbol-name system-type)) + (t nil)))) + (cond + ((eq gnus-user-agent 'gnus) + nil) + ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) + (concat "Emacs/" (match-string 1 emacs-version) + (if system-v + (concat " (" system-v ")") + ""))) + ((string-match + "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" + emacs-version) + (concat + (match-string 1 emacs-version) + (format "/%d.%d" emacs-major-version emacs-minor-version) + (if (match-beginning 3) + (match-string 3 emacs-version) + "") + (if (boundp 'xemacs-codename) + (concat + " (" xemacs-codename + (if system-v + (concat ", " system-v ")") + ")")) + ""))) + (t emacs-version)))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 0129ef0..7a1ae40 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1352,23 +1352,23 @@ When called interactively, prompt for REGEXP." (setq process-state (list 'error)) (gnus-message 2 "No begin part at the beginning") (sleep-for 2)) - (setq state 'middle))) - + (setq state 'middle)))) + ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t))))) + (if result-files + (message "") + (cond + ((not has-been-begin) + (gnus-message 2 "Wrong type file")) + ((memq 'error process-state) + (gnus-message 2 "An error occurred during decoding")) + ((not (or (memq 'ok process-state) + (memq 'end process-state))) + (gnus-message 2 "End of articles reached before end of file"))) + ;; Make unsuccessfully decoded articles unread. + (when gnus-uu-unmark-articles-not-decoded + (while article-series + (gnus-summary-tick-article (pop article-series) t)))) ;; The original article buffer is hosed, shoot it down. (gnus-kill-buffer gnus-original-article-buffer) @@ -1438,9 +1438,9 @@ When called interactively, prompt for REGEXP." ;; This is the beginning of a uuencoded article. ;; We replace certain characters that could make things messy. (setq gnus-uu-file-name - (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) - (nnheader-translate-file-chars (match-string 1)))) + (gnus-map-function + mm-file-name-rewrite-functions + (file-name-nondirectory (match-string 1)))) (replace-match (concat "begin 644 " gnus-uu-file-name) t t) ;; Remove any non gnus-uu-body-line right after start. @@ -1630,7 +1630,7 @@ Gnus might fail to display all of it.") (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - (if (= 0 (call-process shell-file-name nil + (if (eq 0 (call-process shell-file-name nil (gnus-get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") @@ -1912,8 +1912,8 @@ The user will be asked for a file name." ;; Encodes with base64 and adds MIME headers (defun gnus-uu-post-encode-mime (path file-name) - (when (zerop (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s -o %s" "mmencode" path file-name))) + (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch + (format "%s %s -o %s" "mmencode" path file-name))) (gnus-uu-post-make-mime file-name "base64") t)) @@ -1938,8 +1938,8 @@ The user will be asked for a file name." ;; Encodes a file PATH with COMMAND, leaving the result in the ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) - (= 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s %s" command path file-name)))) + (eq 0 (call-process shell-file-name nil t nil shell-command-switch + (format "%s %s %s" command path file-name)))) (defun gnus-uu-post-news-inews () "Posts the composed news article and encoded file. diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index a01366a..54b8e88 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -27,6 +27,14 @@ ;;; Code: +(eval-when-compile + (autoload 'gnus-active "gnus" nil nil 'macro) + (autoload 'gnus-group-entry "gnus" nil nil 'macro) + (autoload 'gnus-info-level "gnus" nil nil 'macro) + (autoload 'gnus-info-marks "gnus" nil nil 'macro) + (autoload 'gnus-info-method "gnus" nil nil 'macro) + (autoload 'gnus-info-score "gnus" nil nil 'macro)) + (require 'text-props) (defvar menu-bar-mode (featurep 'menubar)) (require 'messagexmas) @@ -812,7 +820,7 @@ XEmacs compatibility workaround." (with-temp-buffer (if data-p (insert file) - (insert-file-contents file)) + (insert-file-contents-literally file)) (shell-command-on-region (point-min) (point-max) "ppmtoxpm 2>/dev/null" t) (setq file (buffer-string) @@ -824,7 +832,7 @@ XEmacs compatibility workaround." (with-temp-buffer (if data-p (insert file) - (insert-file-contents file)) + (insert-file-contents-literally file)) (make-glyph (vector (or (intern type) @@ -834,7 +842,7 @@ XEmacs compatibility workaround." (set-glyph-face glyph face)) glyph)) -(defun gnus-xmas-put-image (glyph &optional string) +(defun gnus-xmas-put-image (glyph &optional string category) "Insert STRING, but display GLYPH. Warning: Don't insert text immediately after the image." (let ((begin (point)) @@ -845,21 +853,21 @@ Warning: Don't insert text immediately after the image." (insert string) (setq begin (1- begin))) (setq extent (make-extent begin (point))) - (set-extent-property extent 'gnus-image t) + (set-extent-property extent 'gnus-image category) (set-extent-property extent 'duplicable t) (if string (set-extent-property extent 'invisible t)) (set-extent-property extent 'end-glyph glyph)) glyph) -(defun gnus-xmas-remove-image (image) +(defun gnus-xmas-remove-image (image &optional category) (map-extents (lambda (ext unused) (when (equal (extent-end-glyph ext) image) (set-extent-property ext 'invisible nil) (set-extent-property ext 'end-glyph nil)) nil) - nil nil nil nil nil 'gnus-image)) + nil nil nil nil nil 'gnus-image category)) (defun gnus-xmas-completing-read (prompt table &optional predicate require-match history) diff --git a/lisp/gnus.el b/lisp/gnus.el index 672c0d2..80efafd 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -282,7 +282,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.10.2" +(defconst gnus-version-number "5.10.3" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -1093,21 +1093,17 @@ used to 899, you would say something along these lines: :group 'gnus-server :type 'file) -;; This function is used to check both the environment variable -;; NNTPSERVER and the /etc/nntpserver file to see whether one can find -;; an nntp server name default. (defun gnus-getenv-nntpserver () + "Find default nntp server. +Check the NNTPSERVER environment variable and the +`gnus-nntpserver-file' file." (or (getenv "NNTPSERVER") (and (file-readable-p gnus-nntpserver-file) - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus nntp*")) + (with-temp-buffer (insert-file-contents gnus-nntpserver-file) (let ((name (buffer-string))) - (prog1 - (if (string-match "\\'[ \t\n]*$" name) - nil - name) - (kill-buffer (current-buffer)))))))) + (unless (string-match "\\`[ \t\n]*$" name) + name)))))) (defcustom gnus-select-method (condition-case nil @@ -1149,7 +1145,8 @@ see the manual for details." This should be a mail method." :group 'gnus-server :group 'gnus-message - :type 'gnus-select-method) + :type '(choice (const :tag "Default archive method" "archive") + gnus-select-method)) (defcustom gnus-message-archive-group nil "*Name of the group in which to save the messages you've written. @@ -1238,6 +1235,7 @@ It can also be a list of select methods, as well as the special symbol list, Gnus will try all the methods in the list until it finds a match." :group 'gnus-server :type '(choice (const :tag "default" nil) + (const current) (const :tag "Google" (nnweb "refer" (nnweb-type google))) gnus-select-method (repeat :menu-tag "Try multiple" @@ -1258,7 +1256,7 @@ list, Gnus will try all the methods in the list until it finds a match." "/ftp@rtfm.mit.edu:/pub/usenet/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.edu.tw:/USENET/FAQ/" + "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/" "/ftp@hwarang.postech.ac.kr:/pub/usenet/" "/ftp@ftp.hk.super.net:/mirror/faqs/") "*Directory where the group FAQs are stored. @@ -1282,7 +1280,7 @@ If the default site is too slow, try one of these: src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet ftp.pasteur.fr /pub/FAQ - Asia: nctuccca.edu.tw /USENET/FAQ + Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/ hwarang.postech.ac.kr /pub/usenet ftp.hk.super.net /mirror/faqs" :group 'gnus-group-various @@ -1295,22 +1293,21 @@ If the default site is too slow, try one of these: ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) ("england" . (concat "http://england.news-admin.org/charters/" name)) ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) - ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" + ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" (gnus-replace-in-string name "europa\\." "") ".html")) ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) - ("aus" . (concat "http://aus.news-admin.org/groupinfo.php/" name)) + ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name)) ("pl" . (concat "http://www.usenet.pl/opisy/" name)) ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) - ("wales" . (concat "http://www.wales-usenet.org/english/groups/" name ".html")) ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) - ("se" . (concat "http://www.usenet-se.net/Reglementen/" + ("se" . (concat "http://www.usenet-se.net/Reglementen/" (gnus-replace-in-string name "\\." "_") ".html")) - ("milw" . (concat "http://usenet.mil.wi.us/" + ("milw" . (concat "http://usenet.mil.wi.us/" (gnus-replace-in-string name "milw\\." "") "-charter")) ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) - ("netins" . (concat "http://www.netins.net/usenet/charter/" + ("netins" . (concat "http://www.netins.net/usenet/charter/" (gnus-replace-in-string name "\\." "-") "-charter.html"))) "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. When FORM is evaluated `name' is bound to the name of the group." @@ -1364,7 +1361,14 @@ Note that the default for this variable varies according to what system type you're using. On `usg-unix-v' and `xenix' this variable defaults to nil while on all other systems it defaults to t." :group 'gnus-start - :type 'boolean) + :type '(radio (sexp :format "Non-nil\n" + :match (lambda (widget value) + (and value (not (listp value)))) + :value t) + (const nil) + (checklist (const :format "%v " not-score) + (const :format "%v " not-save) + (const not-kill)))) (defcustom gnus-kill-files-directory gnus-directory "*Name of the directory where kill files will be stored (default \"~/News\")." @@ -1447,7 +1451,7 @@ It calls `gnus-summary-expire-articles' by default." :type 'hook) (defcustom gnus-novice-user t - "*Non-nil means that you are a usenet novice. + "*Non-nil means that you are a Usenet novice. If non-nil, verbose messages may be displayed and confirmations may be required." :group 'gnus-meta @@ -1577,7 +1581,7 @@ If this variable is nil, screen refresh may be quicker." (defcustom gnus-mode-non-string-length nil "*Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest -of the modeline intact. Note that the default of nil is unlikely +of the mode line intact. Note that the default of nil is unlikely to be desirable; see the manual for further details." :group 'gnus-various :type '(choice (const nil) @@ -1775,7 +1779,7 @@ total number of articles in the group.") ;; group parameters for spam processing added by Ted Zlatanov (defcustom gnus-install-group-spam-parameters t - "*Disable the group parameters for spam detection. + "*Disable the group parameters for spam detection. Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." :type 'boolean :group 'gnus-start) @@ -1810,7 +1814,7 @@ regexps that should match all groups in which to do automatic spam tagging, associated with a classification (spam, ham, or neither). This only makes sense for mail groups." :variable-group spam - :variable-type '(repeat + :variable-type '(repeat (list :tag "Group contents spam/ham classification" (regexp :tag "Group") (choice @@ -1828,65 +1832,89 @@ This only makes sense for mail groups." When a spam group is entered, all unread articles are marked as spam.") (defvar gnus-group-spam-exit-processor-ifile "ifile" - "The ifile summary exit spam processor.") + "OBSOLETE: The ifile summary exit spam processor.") (defvar gnus-group-spam-exit-processor-stat "stat" - "The spam-stat summary exit spam processor.") + "OBSOLETE: The spam-stat summary exit spam processor.") (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter" - "The Bogofilter summary exit spam processor.") + "OBSOLETE: The Bogofilter summary exit spam processor.") (defvar gnus-group-spam-exit-processor-blacklist "blacklist" - "The Blacklist summary exit spam processor.") + "OBSOLETE: The Blacklist summary exit spam processor.") (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane" - "The Gmane reporting summary exit spam processor. + "OBSOLETE: The Gmane reporting summary exit spam processor. Only applicable to NNTP groups with articles from Gmane. See spam-report.el") + (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam" + "OBSOLETE: The spamoracle summary exit spam processor.") + (defvar gnus-group-ham-exit-processor-ifile "ifile-ham" - "The ifile summary exit ham processor. + "OBSOLETE: The ifile summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham" - "The Bogofilter summary exit ham processor. + "OBSOLETE: The Bogofilter summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (defvar gnus-group-ham-exit-processor-stat "stat-ham" - "The spam-stat summary exit ham processor. + "OBSOLETE: The spam-stat summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (defvar gnus-group-ham-exit-processor-whitelist "whitelist" - "The whitelist summary exit ham processor. + "OBSOLETE: The whitelist summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (defvar gnus-group-ham-exit-processor-BBDB "bbdb" - "The BBDB summary exit ham processor. + "OBSOLETE: 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. + "OBSOLETE: The ham copy exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + + (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham" + "OBSOLETE: The spamoracle summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") (gnus-define-group-parameter spam-process :type list - :parameter-type '(choice :tag "Spam Summary Exit Processor" - :value nil - (list :tag "Spam Summary Exit Processor Choices" - (set - (variable-item gnus-group-spam-exit-processor-ifile) - (variable-item gnus-group-spam-exit-processor-stat) - (variable-item gnus-group-spam-exit-processor-bogofilter) - (variable-item gnus-group-spam-exit-processor-blacklist) - (variable-item gnus-group-spam-exit-processor-report-gmane) - (variable-item gnus-group-ham-exit-processor-bogofilter) - (variable-item gnus-group-ham-exit-processor-ifile) - (variable-item gnus-group-ham-exit-processor-stat) - (variable-item gnus-group-ham-exit-processor-whitelist) - (variable-item gnus-group-ham-exit-processor-BBDB) - (variable-item gnus-group-ham-exit-processor-copy)))) + :parameter-type + '(choice + :tag "Spam Summary Exit Processor" + :value nil + (list :tag "Spam Summary Exit Processor Choices" + (set + (variable-item gnus-group-spam-exit-processor-ifile) + (variable-item gnus-group-spam-exit-processor-stat) + (variable-item gnus-group-spam-exit-processor-bogofilter) + (variable-item gnus-group-spam-exit-processor-blacklist) + (variable-item gnus-group-spam-exit-processor-spamoracle) + (variable-item gnus-group-spam-exit-processor-report-gmane) + (variable-item gnus-group-ham-exit-processor-bogofilter) + (variable-item gnus-group-ham-exit-processor-ifile) + (variable-item gnus-group-ham-exit-processor-stat) + (variable-item gnus-group-ham-exit-processor-whitelist) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-spamoracle) + (variable-item gnus-group-ham-exit-processor-copy) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) :function-document - "Which spam or ham processors will be applied to the GROUP articles at summary exit." + "Which spam or ham processors will be applied when the summary is exited." :variable gnus-spam-process-newsgroups :variable-default nil :variable-document @@ -1895,29 +1923,133 @@ a backend on summary exit. If non-nil, this should be a list of group name regexps that should match all groups in which to do automatic spam processing, associated with the appropriate processor." :variable-group spam - :variable-type '(repeat :tag "Spam/Ham Processors" - (list :tag "Spam Summary Exit Processor Choices" - (regexp :tag "Group Regexp") - (set :tag "Spam/Ham Summary Exit Processor" - (variable-item gnus-group-spam-exit-processor-ifile) - (variable-item gnus-group-spam-exit-processor-stat) - (variable-item gnus-group-spam-exit-processor-bogofilter) - (variable-item gnus-group-spam-exit-processor-blacklist) - (variable-item gnus-group-spam-exit-processor-report-gmane) - (variable-item gnus-group-ham-exit-processor-bogofilter) - (variable-item gnus-group-ham-exit-processor-ifile) - (variable-item gnus-group-ham-exit-processor-stat) - (variable-item gnus-group-ham-exit-processor-whitelist) - (variable-item gnus-group-ham-exit-processor-BBDB) - (variable-item gnus-group-ham-exit-processor-copy)))) + :variable-type + '(repeat :tag "Spam/Ham Processors" + (list :tag "Spam Summary Exit Processor Choices" + (regexp :tag "Group Regexp") + (set + :tag "Spam/Ham Summary Exit Processor" + (variable-item gnus-group-spam-exit-processor-ifile) + (variable-item gnus-group-spam-exit-processor-stat) + (variable-item gnus-group-spam-exit-processor-bogofilter) + (variable-item gnus-group-spam-exit-processor-blacklist) + (variable-item gnus-group-spam-exit-processor-spamoracle) + (variable-item gnus-group-spam-exit-processor-report-gmane) + (variable-item gnus-group-ham-exit-processor-bogofilter) + (variable-item gnus-group-ham-exit-processor-ifile) + (variable-item gnus-group-ham-exit-processor-stat) + (variable-item gnus-group-ham-exit-processor-whitelist) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-spamoracle) + (variable-item gnus-group-ham-exit-processor-copy) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) + :parameter-document - "Which spam processors will be applied to the spam or ham GROUP articles at summary exit.") + "Which spam or ham processors will be applied when the summary is exited.") + + (gnus-define-group-parameter + spam-autodetect + :type list + :parameter-type + '(boolean :tag "Spam autodetection") + :function-document + "Should spam be autodetected (with spam-split) in this group?" + :variable gnus-spam-autodetect + :variable-default nil + :variable-document + "*Groups in which spam should be autodetected when they are entered. + Only unseen articles will be examined, unless + spam-autodetect-recheck-messages is set." + :variable-group spam + :variable-type + '(repeat + :tag "Autodetection setting" + (list + (regexp :tag "Group Regexp") + boolean)) + :parameter-document + "Spam autodetection. +Only unseen articles will be examined, unless +spam-autodetect-recheck-messages is set.") + + (gnus-define-group-parameter + spam-autodetect-methods + :type list + :parameter-type + '(choice :tag "Spam autodetection-specific methods" + (const none) + (const default) + (set :tag "Use specific methods" + (variable-item spam-use-blacklist) + (variable-item spam-use-regex-headers) + (variable-item spam-use-regex-body) + (variable-item spam-use-whitelist) + (variable-item spam-use-BBDB) + (variable-item spam-use-ifile) + (variable-item spam-use-spamoracle) + (variable-item spam-use-stat) + (variable-item spam-use-blackholes) + (variable-item spam-use-hashcash) + (variable-item spam-use-bogofilter-headers) + (variable-item spam-use-bogofilter))) + :function-document + "Methods to be used for autodetection in each group" + :variable gnus-spam-autodetect-methods + :variable-default nil + :variable-document + "*Methods for autodetecting spam per group. +Requires the spam-autodetect parameter. Only unseen articles +will be examined, unless spam-autodetect-recheck-messages is +set." + :variable-group spam + :variable-type + '(repeat + :tag "Autodetection methods" + (list + (regexp :tag "Group Regexp") + (choice + (const none) + (const default) + (set :tag "Use specific methods" + (variable-item spam-use-blacklist) + (variable-item spam-use-regex-headers) + (variable-item spam-use-regex-body) + (variable-item spam-use-whitelist) + (variable-item spam-use-BBDB) + (variable-item spam-use-ifile) + (variable-item spam-use-spamoracle) + (variable-item spam-use-stat) + (variable-item spam-use-blackholes) + (variable-item spam-use-hashcash) + (variable-item spam-use-bogofilter-headers) + (variable-item spam-use-bogofilter))))) + :parameter-document + "Spam autodetection methods. +Requires the spam-autodetect parameter. Only unseen articles +will be examined, unless spam-autodetect-recheck-messages is +set.") (gnus-define-group-parameter spam-process-destination - :parameter-type '(choice :tag "Destination for spam-processed articles at summary exit" - (string :tag "Move to a group") - (const :tag "Expire" nil)) + :type list + :parameter-type + '(choice :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Expire" nil)) :function-document "Where spam-processed articles will go at summary exit." :variable gnus-spam-process-destinations @@ -1930,23 +2062,31 @@ to do spam-processed article moving, associated with the destination group or nil for explicit expiration. This only makes sense for mail groups." :variable-group spam - :variable-type '(repeat - :tag "Spam-processed articles destination" - (list - (regexp :tag "Group Regexp") - (choice - :tag "Destination for spam-processed articles at summary exit" - (string :tag "Move to a group") - (const :tag "Expire" nil)))) + :variable-type + '(repeat + :tag "Spam-processed articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for spam-processed articles at summary exit" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Expire" nil)))) :parameter-document "Where spam-processed articles will go at summary exit.") - + (gnus-define-group-parameter ham-process-destination - :parameter-type '(choice - :tag "Destination for ham articles at summary exit from a spam group" - (string :tag "Move to a group") - (const :tag "Do nothing" nil)) + :type list + :parameter-type + '(choice + :tag "Destination for ham articles at summary exit from a spam group" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Respool" respool) + (const :tag "Do nothing" nil)) :function-document "Where ham articles will go at summary exit from a spam group." :variable gnus-ham-process-destinations @@ -1959,24 +2099,29 @@ to do ham article moving, associated with the destination group or nil for explicit ignoring. This only makes sense for mail groups, and only works in spam groups." :variable-group spam - :variable-type '(repeat - :tag "Ham articles destination" - (list - (regexp :tag "Group Regexp") - (choice - :tag "Destination for ham articles at summary exit from spam group" - (string :tag "Move to a group") - (const :tag "Expire" nil)))) + :variable-type + '(repeat + :tag "Ham articles destination" + (list + (regexp :tag "Group Regexp") + (choice + :tag "Destination for ham articles at summary exit from spam group" + (string :tag "Move to a group") + (repeat :tag "Move to multiple groups" + (string :tag "Destination group")) + (const :tag "Respool" respool) + (const :tag "Expire" nil)))) :parameter-document "Where ham articles will go at summary exit from a spam group.") - (gnus-define-group-parameter + (gnus-define-group-parameter ham-marks :type 'list :parameter-type '(list :tag "Ham mark choices" - (set + (set (variable-item gnus-del-mark) (variable-item gnus-read-mark) + (variable-item gnus-ticked-mark) (variable-item gnus-killed-mark) (variable-item gnus-kill-file-mark) (variable-item gnus-low-score-mark))) @@ -1985,20 +2130,20 @@ mail groups, and only works in spam groups." "Marks considered ham (positively not spam). Such articles will be processed as ham (non-spam) on group exit. When nil, the global spam-ham-marks variable takes precedence." - :variable-default '((".*" ((gnus-del-mark + :variable-default '((".*" ((gnus-del-mark gnus-read-mark - gnus-killed-mark + gnus-killed-mark gnus-kill-file-mark gnus-low-score-mark)))) :variable-group spam :variable-document "*Groups in which to explicitly set the ham marks to some value.") - (gnus-define-group-parameter + (gnus-define-group-parameter spam-marks :type 'list :parameter-type '(list :tag "Spam mark choices" - (set + (set (variable-item gnus-spam-mark) (variable-item gnus-killed-mark) (variable-item gnus-kill-file-mark) @@ -2137,9 +2282,10 @@ face." "Whether Gnus is plugged or not.") (defcustom gnus-agent-cache t - "Controls use of the agent cache while plugged. When set, Gnus will prefer -using the locally stored content rather than re-fetching it from the server. -You also need to enable `gnus-agent' for this to have any affect." + "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) @@ -2152,9 +2298,13 @@ covered by that variable." :type 'symbol :group 'gnus-charset) +;; Fixme: Doc reference to agent. (defcustom gnus-agent t "Whether we want to use the Gnus agent or not. -Putting (gnus-agentize) in ~/.gnus is obsoleted by (setq gnus-agent t)." + +You may customize gnus-agent to disable its use. However, some +back ends have started to use the agent as a client-side cache. +Disabling the agent may result in noticeable loss of performance." :version "21.3" :group 'gnus-agent :type 'boolean) @@ -2184,6 +2334,10 @@ This should be an alist for 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-method-p-cache nil + ; Reset each time gnus-agent-covered-methods is changed else + ; gnus-agent-method-p may mis-report a methods status. + ) (defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") (defvar gnus-draft-meta-information-header "X-Draft-From") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) @@ -2195,7 +2349,8 @@ This should be an alist for Emacs, or a plist for XEmacs." (defvar gnus-agent-fetching nil "Whether Gnus agent is in fetching mode.") -(defvar gnus-agent-covered-methods nil) +(defvar gnus-agent-covered-methods nil + "A list of servers, NOT methods, showing which servers are covered by the agent.") (defvar gnus-command-method nil "Dynamically bound variable that says what the current back end is.") @@ -2307,25 +2462,25 @@ such as a mark that says whether an article is stored in the cache gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list gnus-topic-topology gnus-topic-alist - gnus-agent-covered-methods gnus-format-specs) + gnus-format-specs) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-alist nil "Assoc list of read articles. -gnus-newsrc-hashtb should be kept so that both hold the same information.") +`gnus-newsrc-hashtb' should be kept so that both hold the same information.") (defvar gnus-registry-alist nil "Assoc list of registry data. gnus-registry.el will populate this if it's loaded.") (defvar gnus-newsrc-hashtb nil - "Hashtable of gnus-newsrc-alist.") + "Hashtable of `gnus-newsrc-alist'.") (defvar gnus-killed-list nil "List of killed newsgroups.") (defvar gnus-killed-hashtb nil - "Hash table equivalent of gnus-killed-list.") + "Hash table equivalent of `gnus-killed-list'.") (defvar gnus-zombie-list nil "List of almost dead newsgroups.") @@ -3107,10 +3262,59 @@ that that variable is buffer-local to the summary buffers." (not (equal server (format "%s:%s" (caar servers) (cadar servers))))) (pop servers)) - (car servers))))) - (push (cons server result) gnus-server-method-cache) + (car servers)) + ;; This could be some sort of foreign server that I + ;; simply haven't opened (yet). Do a brute-force scan + ;; of the entire gnus-newsrc-alist for the server name + ;; of every method. As a side-effect, loads the + ;; gnus-server-method-cache so this only happens once, + ;; if at all. + (let (match) + (mapcar + (lambda (info) + (let ((info-method (gnus-info-method info))) + (unless (stringp info-method) + (let ((info-server (gnus-method-to-server info-method))) + (when (equal server info-server) + (setq match info-method)))))) + (cdr gnus-newsrc-alist)) + match)))) + (when result + (push (cons server result) gnus-server-method-cache)) result))) +(defsubst gnus-method-to-server (method) + (catch 'server-name + (setq method (or method gnus-select-method)) + + ;; Perhaps it is already in the cache. + (mapc (lambda (name-method) + (if (equal (cdr name-method) method) + (throw 'server-name (car name-method)))) + gnus-server-method-cache) + + (mapc + (lambda (server-alist) + (mapc (lambda (name-method) + (when (gnus-methods-equal-p (cdr name-method) method) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + (throw 'server-name (car name-method)))) + server-alist)) + (let ((alists (list gnus-server-alist + gnus-predefined-server-alist))) + (if gnus-select-method + (push (list (cons "native" gnus-select-method)) alists)) + alists)) + + (let* ((name (if (member (cadr method) '(nil "")) + (format "%s" (car method)) + (format "%s:%s" (car method) (cadr method)))) + (name-method (cons name method))) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + name))) + (defsubst gnus-server-get-method (group method) ;; Input either a server name, and extended server name, or a ;; select method, and return a select method. @@ -3216,8 +3420,7 @@ server is native)." group))) (defun gnus-group-full-name (group method) - "Return the full name from GROUP and METHOD, even if the method is -native." + "Return the full name from GROUP and METHOD, even if the method is native." (gnus-group-prefixed-name group method t)) (defun gnus-group-guess-full-name (group) @@ -3226,11 +3429,19 @@ native." group (gnus-group-full-name group (gnus-find-method-for-group group)))) +(defun gnus-group-guess-full-name-from-command-method (group) + "Guess the full name from GROUP, even if the method is native." + (if (gnus-group-prefixed-p group) + group + (gnus-group-full-name group gnus-command-method))) + (defun gnus-group-real-prefix (group) "Return the prefix of the current group name." - (if (string-match "^[^:]+:" group) - (substring group 0 (match-end 0)) - "")) + (if (stringp group) + (if (string-match "^[^:]+:" group) + (substring group 0 (match-end 0)) + "") + nil)) (defun gnus-group-short-name (group) "Return the short group name." @@ -3692,8 +3903,24 @@ Disallow invalid group names." (setq group (read-string (concat prefix prompt) (cons (or default "") 0) 'gnus-group-history))) - (setq prefix (format "Invalid group name: \"%s\". " group) - group nil))) + (let ((match (match-string 0 group))) + ;; `/' may be okay (e.g. for nnimap), so ask the user: + (unless (and (string-match "/" match) + (message-y-or-n-p + "Proceed and create group anyway? " t +"The group name \"" group "\" contains a forbidden character: \"" match "\". + +Usually, it's dangerous to create a group with this name, because it's not +supported by all back ends and servers. On some IMAP servers, it's valid to +use the character \"/\". + +If you are really sure, you can proceed anyway and create the group. + +You may customize the variable `gnus-invalid-group-regexp', which currently is +set to \"" gnus-invalid-group-regexp +"\", if you want to get rid of this query.")) + (setq prefix (format "Invalid group name: \"%s\". " group) + group nil))))) group)) (defun gnus-read-method (prompt) @@ -3737,7 +3964,13 @@ Allow completion over sensible values." (defun gnus-agent-method-p (method) "Say whether METHOD is covered by the agent." - (member method gnus-agent-covered-methods)) + (or (eq (car gnus-agent-method-p-cache) method) + (setq gnus-agent-method-p-cache + (cons method + (member (if (stringp method) + method + (gnus-method-to-server method)) gnus-agent-covered-methods)))) + (cdr gnus-agent-method-p-cache)) (defun gnus-online (method) (not @@ -3812,11 +4045,11 @@ current display is used." (switch-to-buffer gnus-group-buffer) (funcall gnus-other-frame-function arg) (add-hook 'gnus-exit-gnus-hook - (lambda nil - (when (and (frame-live-p gnus-other-frame-object) - (cdr (frame-list))) - (delete-frame gnus-other-frame-object)) - (setq gnus-other-frame-object nil))))))) + '(lambda nil + (when (and (frame-live-p gnus-other-frame-object) + (cdr (frame-list))) + (delete-frame gnus-other-frame-object)) + (setq gnus-other-frame-object nil))))))) ;;(setq thing ? ; this is a comment ;; more 'yes) diff --git a/lisp/html2text.el b/lisp/html2text.el index 4b89f8f..41fea4b 100644 --- a/lisp/html2text.el +++ b/lisp/html2text.el @@ -463,9 +463,7 @@ See the documentation for that variable." (dolist (tag tag-list) (html2text-buffer-head) (while (re-search-forward (format "\\(]*>\\)" tag) (point-max) t) - (let ((p1 (point))) - (search-backward "<") - (delete-region (point) p1))))) + (delete-region (match-beginning 0) (match-end 0))))) (defun html2text-format-tags () "See the variable \"html2text-format-tag-list\" for documentation" diff --git a/lisp/imap.el b/lisp/imap.el index a83cee1..3ff0ffb 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -125,6 +125,7 @@ ;; o Don't use `read' at all (important places already fixed) ;; o Accept list of articles instead of message set string in most ;; imap-message-* functions. +;; o Send strings as literal if they contain, e.g., ". ;; ;; Revision history: ;; @@ -220,7 +221,13 @@ until a successful connection is made." :type '(repeat string)) (defcustom imap-process-connection-type nil - "*Value for `process-connection-type' to use for Kerberos4 and GSSAPI." + "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL. +The `process-connection-type' variable control type of device +used to communicate with subprocesses. Values are nil to use a +pipe, or t or `pty' to use a pty. The value has no effect if the +system has no ptys or if all ptys are busy: then a pipe is used +in any case. The value takes effect when a IMAP server is +opened, changing it after that has no effect.." :group 'imap :type 'boolean) @@ -498,6 +505,13 @@ sure of changing the value of `foo'." (while (and (memq (process-status process) '(open run)) (set-buffer buffer) ;; XXX "blue moon" nntp.el bug (goto-char (point-min)) + ;; Athena IMTEST can output SSL verify errors + (or (while (looking-at "^verify error:num=") + (forward-line)) + t) + (or (while (looking-at "^TLS connection established") + (forward-line)) + t) ;; cyrus 1.6.x (13? < x <= 22) queries capabilities (or (while (looking-at "^C:") (forward-line)) @@ -752,36 +766,36 @@ sure of changing the value of `foo'." (coding-system-for-read imap-coding-system-for-read) (coding-system-for-write imap-coding-system-for-write) (process (starttls-open-stream name buffer server port)) - done) + done tls-info) (message "imap: Connecting with STARTTLS...") (when process (while (and (memq (process-status process) '(open run)) (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) + (goto-char (point-max)) + (forward-line -1) (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) + (imap-send-command "STARTTLS") + (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug + (goto-char (point-max)) + (forward-line -1) + (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t))) + (accept-process-output process 1) + (sit-for 1)) (and imap-log (with-current-buffer (get-buffer-create imap-log-buffer) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer))) - (let ((imap-process process)) - (unwind-protect - (progn - (set-process-filter imap-process 'imap-arrival-filter) - (when (and (eq imap-stream 'starttls) - (imap-ok-p (imap-send-command-wait "STARTTLS"))) - (starttls-negotiate imap-process))) - (set-process-filter imap-process nil))) - (when (memq (process-status process) '(open run)) + (when (and (setq tls-info (starttls-negotiate process)) + (memq (process-status process) '(open run))) (setq done process))) - (if done - (progn - (message "imap: Connecting with STARTTLS...done") - done) - (message "imap: Connecting with STARTTLS...failed") - nil))) + (if (stringp tls-info) + (message "imap: STARTTLS info: %s" tls-info)) + (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed")) + done)) ;; Server functions; authenticator stuff: @@ -817,6 +831,7 @@ Returns t if login was successful, nil otherwise." (setq imap-password passwd))) (message "Login failed...") (setq passwd nil) + (setq imap-password nil) (sit-for 1)))) ;; (quit (with-current-buffer buffer ;; (setq user nil @@ -827,8 +842,7 @@ Returns t if login was successful, nil otherwise." ret))) (defun imap-gssapi-auth-p (buffer) - (and (imap-capability 'AUTH=GSSAPI buffer) - (eq imap-stream 'gssapi))) + (eq imap-stream 'gssapi)) (defun imap-gssapi-auth (buffer) (message "imap: Authenticating using GSSAPI...%s" @@ -1340,10 +1354,11 @@ returned, if ITEMS is a symbol only its value is returned." (imap-send-command-wait (list "STATUS \"" (imap-utf7-encode mailbox) "\" " - (format "%s" - (if (listp items) - items - (list items)))))) + (upcase + (format "%s" + (if (listp items) + items + (list items))))))) (if (listp items) (mapcar (lambda (item) (imap-mailbox-get item mailbox)) @@ -1754,6 +1769,13 @@ on failure." (truncate (* (- imap-read-timeout (truncate imap-read-timeout)) 1000))))) + ;; A process can die _before_ we have processed everything it + ;; has to say. Moreover, this can happen in between the call to + ;; accept-process-output and the call to process-status in an + ;; iteration of the loop above. + (when (and (null imap-continuation) + (< imap-reached-tag tag)) + (accept-process-output imap-process 0 0)) (when imap-have-messaged (message "")) (and (memq (process-status imap-process) '(open run)) @@ -1780,34 +1802,37 @@ Return nil if no complete line has arrived." (defun imap-arrival-filter (proc string) "IMAP process filter." - (with-current-buffer (process-buffer proc) - (goto-char (point-max)) - (insert string) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert string))) - (let (end) - (goto-char (point-min)) - (while (setq end (imap-find-next-line)) - (save-restriction - (narrow-to-region (point-min) end) - (delete-backward-char (length imap-server-eol)) - (goto-char (point-min)) - (unwind-protect - (cond ((eq imap-state 'initial) - (imap-parse-greeting)) - ((or (eq imap-state 'auth) - (eq imap-state 'nonauth) - (eq imap-state 'selected) - (eq imap-state 'examine)) - (imap-parse-response)) - (t - (message "Unknown state %s in arrival filter" - imap-state))) - (delete-region (point-min) (point-max)))))))) + ;; Sometimes, we are called even though the process has died. + ;; Better abstain from doing stuff in that case. + (when (buffer-name (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (goto-char (point-max)) + (insert string) + (and imap-log + (with-current-buffer (get-buffer-create imap-log-buffer) + (imap-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (insert string))) + (let (end) + (goto-char (point-min)) + (while (setq end (imap-find-next-line)) + (save-restriction + (narrow-to-region (point-min) end) + (delete-backward-char (length imap-server-eol)) + (goto-char (point-min)) + (unwind-protect + (cond ((eq imap-state 'initial) + (imap-parse-greeting)) + ((or (eq imap-state 'auth) + (eq imap-state 'nonauth) + (eq imap-state 'selected) + (eq imap-state 'examine)) + (imap-parse-response)) + (t + (message "Unknown state %s in arrival filter" + imap-state))) + (delete-region (point-min) (point-max))))))))) ;; Imap parser. diff --git a/lisp/lpath.el b/lisp/lpath.el index 51f5eca..996d4e3 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -11,39 +11,35 @@ (maybe-fbind '(Info-directory Info-menu bbdb-create-internal bbdb-records create-image - display-graphic-p display-time-event-handler find-coding-system - find-image image-size image-type-available-p insert-image - make-mode-line-mouse-map make-temp-file open-ssl-stream - propertize put-image replace-regexp-in-string + display-graphic-p find-coding-system find-image image-size + image-type-available-p insert-image make-mode-line-mouse-map + make-temp-file propertize put-image replace-regexp-in-string rmail-msg-is-pruned rmail-msg-restore-non-pruned-header sort-coding-systems spam-BBDB-register-routine spam-enter-ham-BBDB string-to-multibyte tool-bar-add-item tool-bar-add-item-from-menu tool-bar-local-item-from-menu - url-http-file-exists-p vcard-pretty-print w32-focus-frame - w3m-charset-to-coding-system x-focus-frame)) + url-generic-parse-url url-http-file-exists-p + url-insert-file-contents vcard-pretty-print w32-focus-frame + w3m-charset-to-coding-system w3m-region x-focus-frame)) (maybe-bind '(filladapt-mode - mc-pgp-always-sign mm-w3m-mode-map rmail-enable-mime-composing - rmail-insert-mime-forwarded-message-function + mc-pgp-always-sign rmail-insert-mime-forwarded-message-function + url-current-object url-package-name url-package-version + w3-meta-charset-content-type-regexp + w3-meta-content-type-charset-regexp w3m-cid-retrieve-function-alist w3m-current-buffer w3m-display-inline-images w3m-meta-content-type-charset-regexp w3m-minor-mode-map)) (if (featurep 'xemacs) (progn - (maybe-fbind '(Info-directory - Info-menu ccl-execute-on-string char-charset charsetp - coding-system-get coding-system-list coding-system-p - decode-coding-region decode-coding-string - define-ccl-program delete-overlay detect-coding-region - encode-coding-region encode-coding-string + (maybe-fbind '(delete-overlay event-click-count event-end event-start - find-charset-region find-coding-systems-for-charsets + find-coding-systems-for-charsets find-coding-systems-region find-coding-systems-string - get-charset-property mail-abbrevs-setup - mouse-minibuffer-check mouse-movement-p mouse-scroll-subr - overlay-lists pgg-parse-crc24-string posn-point - posn-window read-event set-buffer-multibyte track-mouse - window-edges w3m-region)) + mail-abbrevs-setup mouse-minibuffer-check + mouse-movement-p mouse-scroll-subr overlay-lists + posn-point posn-window read-event set-buffer-multibyte + track-mouse window-edges)) (maybe-bind '(adaptive-fill-first-line-regexp buffer-display-table buffer-file-coding-system current-language-environment @@ -51,31 +47,31 @@ enable-multibyte-characters gnus-agent-expire-current-dirs language-info-alist mark-active mouse-selection-click-count mouse-selection-click-count-buffer pgg-parse-crc24 - temporary-file-directory transient-mark-mode - w3-meta-content-type-charset-regexp - w3-meta-charset-content-type-regexp))) + temporary-file-directory transient-mark-mode))) (maybe-fbind '(bbdb-complete-name - delete-annotation device-connection dfw-device + delete-annotation delete-extent device-connection dfw-device events-to-keys font-lock-set-defaults frame-device - glyph-height glyph-width mail-aliases-setup make-annotation - make-event make-glyph make-network-process map-extents - message-xmas-redefine set-extent-property temp-directory - url-generic-parse-url url-insert-file-contents + get-char-table glyph-height glyph-width mail-aliases-setup + make-annotation make-event make-glyph make-network-process + map-extents message-xmas-redefine put-char-table + set-extent-property temp-directory valid-image-instantiator-format-p w3-coding-system-for-mime-charset w3-do-setup - w3-prepare-buffer w3-region w3m-region window-pixel-height + w3-prepare-buffer w3-region window-pixel-height window-pixel-width)) - (maybe-bind '(help-echo-owns-message - mail-mode-hook - url-current-object url-package-name url-package-version - w3-meta-charset-content-type-regexp - w3-meta-content-type-charset-regexp))) + (maybe-bind '(help-echo-owns-message mail-mode-hook mm-w3m-mode-map))) (when (and (featurep 'xemacs) (not (featurep 'mule))) - (progn - (maybe-fbind '(coding-system-base find-charset-string)))) - + (maybe-fbind '(ccl-execute-on-string + char-charset charsetp coding-system-get define-ccl-program + find-charset-region get-charset-property + pgg-parse-crc24-string)) + (unless (featurep 'file-coding) + (maybe-fbind '(coding-system-base + coding-system-list coding-system-p decode-coding-region + decode-coding-string detect-coding-region + encode-coding-region encode-coding-string)))) (defun nnkiboze-score-file (a) ) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 87dd3ca..d75db56 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -344,7 +344,7 @@ Common keywords should be listed here.") (:authentication password)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) - (:subdirs ("new" "cur")) + (:subdirs ("cur" "new")) (:function)) (imap (:server (getenv "MAILHOST")) @@ -357,6 +357,9 @@ Common keywords should be listed here.") (:mailbox "INBOX") (:predicate "UNSEEN UNDELETED") (:fetchflag "\\Deleted") + (:prescript) + (:prescript-delay) + (:postscript) (:dontexpunge)) (webmail (:subtype hotmail) @@ -608,7 +611,8 @@ Pass INFO on to CALLBACK." (set-file-modes to mail-source-default-file-modes)) (if (and (or (not (buffer-modified-p errors)) (zerop (buffer-size errors))) - (zerop result)) + (and (numberp result) + (zerop result))) ;; No output => movemail won. t (set-buffer errors) @@ -644,8 +648,8 @@ Pass INFO on to CALLBACK." (delete-file from))) (defun mail-source-fetch-with-program (program) - (zerop (call-process shell-file-name nil nil nil - shell-command-switch program))) + (eq 0 (call-process shell-file-name nil nil nil + shell-command-switch program))) (defun mail-source-run-script (script spec &optional delay) (when script @@ -965,14 +969,17 @@ 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) - (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) + (mail-source-run-script + prescript (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user) + prescript-delay) + (let ((from (format "%s:%s:%s" server user port)) + (found 0) + (buf (generate-new-buffer " *imap source*")) + (mail-source-string (format "imap:%s:%s" server mailbox)) + (imap-shell-program (or (list program) imap-shell-program)) + remove) + (if (and (imap-open server port stream authentication buf) (imap-authenticate user (or (cdr (assoc from mail-source-password-cache)) password) buf) @@ -985,8 +992,8 @@ This only works when `display-time' is enabled." (mm-disable-multibyte) ;; remember password (with-current-buffer buf - (when (or imap-password - (assoc from mail-source-password-cache)) + (when (and imap-password + (not (assoc from mail-source-password-cache))) (push (cons from imap-password) mail-source-password-cache))) ;; if predicate is nil, use all uids (dolist (uid (imap-search (or predicate "1:*") buf)) @@ -1005,6 +1012,7 @@ This only works when `display-time' is enabled." (nnheader-ms-strip-cr)) (incf found (mail-source-callback callback server)) (when (and remove fetchflag) + (setq remove (nreverse remove)) (imap-message-flags-add (imap-range-to-message-set (gnus-compress-sequence remove)) fetchflag nil buf)) @@ -1018,8 +1026,12 @@ This only works when `display-time' is enabled." (setq mail-source-password-cache (delq (assoc from mail-source-password-cache) mail-source-password-cache)) - (error (imap-error-text buf))) + (error "IMAP error: %s" (imap-error-text buf))) (kill-buffer buf) + (mail-source-run-script + postscript + (format-spec-make ?p password ?t mail-source-crash-box + ?s server ?P port ?u user)) found))) (eval-and-compile diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 6f57a4d..e6aa0cc 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -47,7 +47,7 @@ (modify-syntax-entry ?{ "(" table) (modify-syntax-entry ?} ")" table) table) - "A syntax table for parsing sgml attributes.") + "A syntax table for parsing SGML attributes.") (eval-and-compile (when (featurep 'xemacs) @@ -627,7 +627,7 @@ Also return non-nil if no test clause is present." (defun mailcap-viewer-passes-test (viewer-info type-info) "Return non-nil iff viewer specified by VIEWER-INFO passes its test clause. -Also retun non-nil if it has no test clause. TYPE-INFO is an argument +Also return non-nil if it has no test clause. TYPE-INFO is an argument to supply to the test." (let* ((test-info (assq 'test viewer-info)) (test (cdr test-info)) @@ -656,7 +656,7 @@ to supply to the test." test (list shell-file-name nil nil nil shell-command-switch test) status (apply 'call-process test)) - (= 0 status)))) + (eq 0 status)))) (push (list otest result) mailcap-viewer-test-cache) result))) diff --git a/lisp/message.el b/lisp/message.el index 1dc96a2..8a36f51 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -32,6 +32,7 @@ (eval-when-compile (require 'cl) + (defvar gnus-message-group-art) (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary (require 'canlock) (require 'mailheader) @@ -46,7 +47,10 @@ (require 'mml) (require 'rfc822) (eval-and-compile - (autoload 'sha1 "sha1-el")) + (autoload 'sha1 "sha1-el") + (autoload 'gnus-find-method-for-group "gnus") + (autoload 'nnvirtual-find-group-art "nnvirtual") + (autoload 'gnus-group-decoded-name "gnus-group")) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -142,7 +146,7 @@ If the string contains the format spec \"%s\", the Newsgroups the article has been posted to will be inserted there. If this variable is nil, no such courtesy message will be added." :group 'message-sending - :type 'string) + :type '(radio (string :format "%t: %v\n" :size 0) (const nil))) (defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\|Delivered-To\\):" @@ -190,7 +194,8 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys', `approved', `sender', `empty', `empty-headers', `message-id', `from', `subject', `shorten-followup-to', `existing-newsgroups', `buffer-file-name', `unchanged', `newsgroups', `reply-to', -'continuation-headers', and `long-header-lines'." +`continuation-headers', `long-header-lines', `invisible-text' and +`illegible-text'." :group 'message-news :type '(repeat sexp)) ; Fixme: improve this @@ -201,12 +206,14 @@ Also see `message-required-news-headers' and `message-required-mail-headers'." :group 'message-news :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) (defcustom message-draft-headers '(References From) "*Headers to be generated when saving a draft message." :group 'message-news :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) (defcustom message-required-news-headers @@ -220,6 +227,7 @@ User-Agent are optional. If don't you want message to insert some header, remove it from this list." :group 'message-news :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) (defcustom message-required-mail-headers @@ -230,11 +238,13 @@ It is recommended that From, Date, To, Subject and Message-ID be included. Organization and User-Agent are optional." :group 'message-mail :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) (defcustom message-deletable-headers '(Message-ID Date Lines) "Headers to be deleted if they already exist and were generated by message previously." :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type 'sexp) (defcustom message-ignored-news-headers @@ -242,6 +252,7 @@ included. Organization and User-Agent are optional." "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type 'regexp) (defcustom message-ignored-mail-headers @@ -249,25 +260,27 @@ included. Organization and User-Agent are optional." "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers + :link '(custom-manual "(message)Mail Headers") :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." :group 'message-interface + :link '(custom-manual "(message)Superseding") :type 'regexp) (defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" "*Regexp matching \"Re: \" in the subject line." :group 'message-various + :link '(custom-manual "(message)Message Headers") :type 'regexp) ;;; Start of variables adopted from `message-utils.el'. (defcustom message-subject-trailing-was-query 'ask - ;; should it default to nil or ask? "*What to do with trailing \"(was: )\" in subject lines. If nil, leave the subject unchanged. If it is the symbol `ask', query the user what do do. In this case, the subject is matched against @@ -278,6 +291,7 @@ used." :type '(choice (const :tag "never" nil) (const :tag "always strip" t) (const ask)) + :link '(custom-manual "(message)Message Headers") :group 'message-various) (defcustom message-subject-trailing-was-ask-regexp @@ -291,6 +305,7 @@ the variable is t instead of `ask', use It is okay to create some false positives here, as the user is asked." :group 'message-various + :link '(custom-manual "(message)Message Headers") :type 'regexp) (defcustom message-subject-trailing-was-regexp @@ -302,6 +317,7 @@ matched against `message-subject-trailing-was-regexp' in `message-strip-subject-trailing-was'. You should use a regexp creating very few false positives here." :group 'message-various + :link '(custom-manual "(message)Message Headers") :type 'regexp) ;; Fixme: Why are all these things autoloaded? @@ -313,6 +329,7 @@ few false positives here." "--8<---------------cut here---------------start------------->8---\n" "How to mark the beginning of some inserted text." :type 'string + :link '(custom-manual "(message)Insertion Variables") :group 'message-various) ;;;###autoload @@ -320,14 +337,16 @@ few false positives here." "--8<---------------cut here---------------end--------------->8---\n" "How to mark the end of some inserted text." :type 'string + :link '(custom-manual "(message)Insertion Variables") :group 'message-various) ;;;###autoload (defcustom message-archive-header "X-No-Archive: Yes\n" "Header to insert when you don't want your article to be archived. -Archives \(such as groups.googgle.com\) respect this header." +Archives \(such as groups.google.com\) respect this header." :type 'string + :link '(custom-manual "(message)Header Commands") :group 'message-various) ;;;###autoload @@ -335,7 +354,9 @@ Archives \(such as groups.googgle.com\) respect this header." "X-No-Archive: Yes - save http://groups.google.com/" "Note to insert why you wouldn't want this posting archived. If nil, don't insert any text in the body." - :type 'string + :type '(radio (string :format "%t: %v\n" :size 0) + (const nil)) + :link '(custom-manual "(message)Header Commands") :group 'message-various) ;;; Crossposts and Followups @@ -385,11 +406,13 @@ for `message-cross-post-insert-note'." (defcustom message-signature-separator "^-- *$" "Regexp matching the signature separator." :type 'regexp + :link '(custom-manual "(message)Various Message Variables") :group 'message-various) (defcustom message-elide-ellipsis "\n[...]\n\n" "*The string which is inserted for elided text." :type 'string + :link '(custom-manual "(message)Various Commands") :group 'message-various) (defcustom message-interactive t @@ -397,6 +420,7 @@ for `message-cross-post-insert-note'." nil means let mailer mail back a message to report errors." :group 'message-sending :group 'message-mail + :link '(custom-manual "(message)Sending Variables") :type 'boolean) (defcustom message-generate-new-buffers 'unique @@ -405,6 +429,7 @@ If this is a function, call that function with three parameters: The type, the to address and the group name. (Any of these may be nil.) The function should return the new buffer name." :group 'message-buffers + :link '(custom-manual "(message)Message Buffers") :type '(choice (const :tag "off" nil) (const :tag "unique" unique) (const :tag "unsent" unsent) @@ -413,6 +438,7 @@ should return the new buffer name." (defcustom message-kill-buffer-on-exit nil "*Non-nil means that the message buffer will be killed after sending a message." :group 'message-buffers + :link '(custom-manual "(message)Message Buffers") :type 'boolean) (eval-when-compile @@ -433,52 +459,68 @@ If t, use `message-user-organization-file'." (defcustom message-user-organization-file "/usr/lib/news/organization" "*Local news organization file." :type 'file + :link '(custom-manual "(message)News Headers") :group 'message-headers) (defcustom message-make-forward-subject-function - 'message-forward-subject-name-subject + #'message-forward-subject-name-subject "*List of functions called to generate subject headers for forwarded messages. The subject generated by the previous function is passed into each successive function. The provided functions are: -* `message-forward-subject-author-subject' (Source of article (author or - newsgroup)), in brackets followed by the subject -* `message-forward-subject-name-subject' (Source of article (name of author - or newsgroup)), in brackets followed by the subject -* `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended +* `message-forward-subject-author-subject' Source of article (author or + newsgroup), in brackets followed by the subject +* `message-forward-subject-name-subject' Source of article (name of author + or newsgroup), in brackets followed by the subject +* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended to it." :group 'message-forwarding + :link '(custom-manual "(message)Forwarding") :type '(radio (function-item message-forward-subject-author-subject) (function-item message-forward-subject-fwd) + (function-item message-forward-subject-name-subject) (repeat :tag "List of functions" function))) (defcustom message-forward-as-mime t - "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message." + "*Non-nil means forward messages as an inline/rfc822 MIME section. +Otherwise, directly inline the old message in the forwarded message." :version "21.1" :group 'message-forwarding + :link '(custom-manual "(message)Forwarding") :type 'boolean) -(defcustom message-forward-show-mml t - "*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged." +(defcustom message-forward-show-mml 'best + "*Non-nil means show forwarded messages as MML (decoded from MIME). +Otherwise, forwarded messages are unchanged. +Can also be the symbol `best' to indicate that MML should be +used, except when it is a bad idea to use MML. One example where +it is a bad idea is when forwarding a signed or encrypted +message, because converting MIME to MML would invalidate the +digital signature." :version "21.1" :group 'message-forwarding - :type 'boolean) + :type '(choice (const :tag "use MML" t) + (const :tag "don't use MML " nil) + (const :tag "use MML when appropriate" best))) (defcustom message-forward-before-signature t - "*If non-nil, put forwarded message before signature, else after." + "*Non-nil means put forwarded message before signature, else after." :group 'message-forwarding :type 'boolean) (defcustom message-wash-forwarded-subjects nil - "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward." + "*Non-nil means try to remove as much cruft as possible from the subject. +Done before generating the new subject of a forward." :group 'message-forwarding + :link '(custom-manual "(message)Forwarding") :type 'boolean) (defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From " "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface + :link '(custom-manual "(message)Resending") :type 'regexp) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" @@ -491,6 +533,7 @@ The provided functions are: (defcustom message-ignored-cited-headers "." "*Delete these headers from the messages you yank." :group 'message-insertion + :link '(custom-manual "(message)Insertion Variables") :type 'regexp) (defcustom message-cite-prefix-regexp @@ -513,11 +556,13 @@ The provided functions are: "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." :group 'message-insertion + :link '(custom-manual "(message)Insertion Variables") :type 'regexp) (defcustom message-cancel-message "I am canceling my own article.\n" "Message to be inserted in the cancel message." :group 'message-interface + :link '(custom-manual "(message)Canceling News") :type 'string) ;; Useful to set in site-init.el @@ -540,6 +585,7 @@ See also `send-mail-function'." (function-item feedmail-send-it) (function :tag "Other")) :group 'message-sending + :link '(custom-manual "(message)Mail Variables") :group 'message-mail) (defcustom message-send-news-function 'message-send-news @@ -548,6 +594,7 @@ The headers should be delimited by a line whose contents match the variable `mail-header-separator'." :group 'message-sending :group 'message-news + :link '(custom-manual "(message)News Variables") :type 'function) (defcustom message-reply-to-function nil @@ -555,6 +602,7 @@ variable `mail-header-separator'." This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface + :link '(custom-manual "(message)Reply") :type '(choice function (const nil))) (defcustom message-wide-reply-to-function nil @@ -562,6 +610,7 @@ and respond with new To and Cc headers." This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface + :link '(custom-manual "(message)Wide Reply") :type '(choice function (const nil))) (defcustom message-followup-to-function nil @@ -569,6 +618,7 @@ and respond with new To and Cc headers." This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface + :link '(custom-manual "(message)Followup") :type '(choice function (const nil))) (defcustom message-use-followup-to 'ask @@ -578,6 +628,7 @@ query before using the \"poster\" value. If it is the symbol `ask', always query the user whether to use the value. If it is the symbol `use', always use the value." :group 'message-interface + :link '(custom-manual "(message)Followup") :type '(choice (const :tag "ignore" nil) (const :tag "use & query" t) (const use) @@ -589,18 +640,20 @@ If nil, always ignore the header. If it is the symbol `ask', always query the user whether to use the value. If it is the symbol `use', always use the value." :group 'message-interface + :link '(custom-manual "(message)Mailing Lists") :type '(choice (const :tag "ignore" nil) (const use) (const ask))) (defcustom message-subscribed-address-functions nil "*Specifies functions for determining list subscription. -If nil, do not attempt to determine list subscribtion with functions. +If nil, do not attempt to determine list subscription with functions. If non-nil, this variable contains a list of functions which return regular expressions to match lists. These functions can be used in conjunction with `message-subscribed-regexps' and `message-subscribed-addresses'." :group 'message-interface + :link '(custom-manual "(message)Mailing Lists") :type '(repeat sexp)) (defcustom message-subscribed-address-file nil @@ -608,22 +661,26 @@ conjunction with `message-subscribed-regexps' and If nil, do not look at any files to determine list subscriptions. If non-nil, each line of this file should be a mailing list address." :group 'message-interface - :type 'string) + :link '(custom-manual "(message)Mailing Lists") + :type '(radio (file :format "%t: %v\n" :size 0) + (const nil))) (defcustom message-subscribed-addresses nil "*Specifies a list of addresses the user is subscribed to. If nil, do not use any predefined list subscriptions. This list of -addresses can be used in conjuction with +addresses can be used in conjunction with `message-subscribed-address-functions' and `message-subscribed-regexps'." :group 'message-interface + :link '(custom-manual "(message)Mailing Lists") :type '(repeat string)) (defcustom message-subscribed-regexps nil "*Specifies a list of addresses the user is subscribed to. If nil, do not use any predefined list subscriptions. This list of -regular expressions can be used in conjuction with +regular expressions can be used in conjunction with `message-subscribed-address-functions' and `message-subscribed-addresses'." :group 'message-interface + :link '(custom-manual "(message)Mailing Lists") :type '(repeat regexp)) (defcustom message-allow-no-recipients 'ask @@ -632,6 +689,7 @@ If it is the symbol `always', the posting is allowed. If it is the symbol `never', the posting is not allowed. If it is the symbol `ask', you are prompted." :group 'message-interface + :link '(custom-manual "(message)Message Headers") :type '(choice (const always) (const never) (const ask))) @@ -640,6 +698,7 @@ symbol `never', the posting is not allowed. If it is the symbol "*Non-nil means don't add \"-f username\" to the sendmail command line. Doing so would be even more evil than leaving it out." :group 'message-sending + :link '(custom-manual "(message)Mail Variables") :type 'boolean) (defcustom message-sendmail-envelope-from nil @@ -649,12 +708,14 @@ If this is nil, use `user-mail-address'. If it is the symbol :type '(choice (string :tag "From name") (const :tag "Use From: header from message" header) (const :tag "Use `user-mail-address'" nil)) + :link '(custom-manual "(message)Mail Variables") :group 'message-sending) ;; qmail-related stuff (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" "Location of the qmail-inject program." :group 'message-sending + :link '(custom-manual "(message)Mail Variables") :type 'file) (defcustom message-qmail-inject-args nil @@ -666,6 +727,7 @@ For e.g., if you wish to set the envelope sender address so that bounces go to the right place or to deal with listserv's usage of that address, you might set this variable to '(\"-f\" \"you@some.where\")." :group 'message-sending + :link '(custom-manual "(message)Mail Variables") :type '(choice (function) (repeat string))) @@ -699,16 +761,16 @@ variable isn't used." ;; will *not* have a `References:' header if `message-generate-headers-first' ;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 (defcustom message-generate-headers-first '(references) - "*If non-nil, generate all required headers before composing. -The variables `message-required-news-headers' and + "Which headers should be generated before starting to compose a message. +If `t', generate all required headers. This can also be a list of headers to +generate. The variables `message-required-news-headers' and `message-required-mail-headers' specify which headers to generate. -This can also be a list of headers that should be generated before -composing. Note that the variable `message-deletable-headers' specifies headers which are to be deleted and then re-generated before sending, so this variable will not have a visible effect for those headers." :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "None" nil) (const :tag "References" '(references)) (const :tag "All" t) @@ -718,11 +780,13 @@ will not have a visible effect for those headers." "Normal hook, run each time a new outgoing message is initialized. The function `message-setup' runs this hook." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-cancel-hook nil "Hook run when cancelling articles." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-signature-setup-hook nil @@ -730,6 +794,7 @@ The function `message-setup' runs this hook." It is run after the headers have been inserted and before the signature is inserted." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-mode-hook nil @@ -745,6 +810,7 @@ the signature is inserted." (defcustom message-header-setup-hook nil "Hook called narrowed to the headers when setting up a message buffer." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-minibuffer-local-map @@ -762,6 +828,7 @@ Note that Gnus provides a feature where the reader can click on people who read your message will have to change their Gnus configuration. See the variable `gnus-cite-attribution-suffix'." :type 'function + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ;;;###autoload @@ -770,6 +837,7 @@ configuration. See the variable `gnus-cite-attribution-suffix'." Fix `message-cite-prefix-regexp' if it is set to an abnormal value. See also `message-yank-cited-prefix'." :type 'string + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) (defcustom message-yank-cited-prefix ">" @@ -777,12 +845,14 @@ See also `message-yank-cited-prefix'." Fix `message-cite-prefix-regexp' if it is set to an abnormal value. See also `message-yank-prefix'." :type 'string + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) (defcustom message-indentation-spaces 3 "*Number of spaces to insert at the beginning of each cited line. Used by `message-yank-original' via `message-yank-cite'." :group 'message-insertion + :link '(custom-manual "(message)Insertion Variables") :type 'integer) ;;;###autoload @@ -795,6 +865,7 @@ Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." (function-item message-cite-original-without-signature) (function-item sc-cite-original) (function :tag "Other")) + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ;;;###autoload @@ -804,6 +875,7 @@ This can also be a list of functions. Each function can find the citation between (point) and (mark t). And each function should leave point and mark around the citation text as modified." :type 'function + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ;;;###autoload @@ -813,6 +885,7 @@ If t, the `message-signature-file' file will be inserted instead. If a function, the result from the function will be used instead. If a form, the result from the form will be used instead." :type 'sexp + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ;;;###autoload @@ -821,18 +894,21 @@ If a form, the result from the form will be used instead." Ignored if the named file doesn't exist. If nil, don't insert a signature." :type '(choice file (const :tags "None" nil)) + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) ;;;###autoload (defcustom message-signature-insert-empty-line t "*If non-nil, insert an empty line before the signature separator." :type 'boolean + :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) (defcustom message-distribution-function nil "*Function called to return a Distribution header." :group 'message-news :group 'message-headers + :link '(custom-manual "(message)News Headers") :type '(choice function (const nil))) (defcustom message-expires 14 @@ -881,18 +957,21 @@ It is a vector of the following headers: It is inserted before you edit the message, so you can edit or delete these lines." :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type 'message-header-lines) (defcustom message-default-mail-headers "" "*A string of header lines to be inserted in outgoing mails." :group 'message-headers :group 'message-mail + :link '(custom-manual "(message)Mail Headers") :type 'message-header-lines) (defcustom message-default-news-headers "" "*A string of header lines to be inserted in outgoing news articles." :group 'message-headers :group 'message-news + :link '(custom-manual "(message)News Headers") :type 'message-header-lines) ;; Note: could use /usr/ucb/mail instead of sendmail; @@ -920,6 +999,7 @@ these lines." The value should be an expression to test whether the problem will actually occur." :group 'message-sending + :link '(custom-manual "(message)Mail Variables") :type 'sexp) ;;;###autoload @@ -958,6 +1038,7 @@ mail aliases off." "*Directory where Message auto-saves buffers if Gnus isn't running. If nil, Message won't auto-save." :group 'message-buffers + :link '(custom-manual "(message)Various Message Variables") :type '(choice directory (const :tag "Don't auto-save" nil))) (defcustom message-default-charset @@ -966,6 +1047,7 @@ If nil, Message won't auto-save." If nil, you might be asked to input the charset." :version "21.1" :group 'message + :link '(custom-manual "(message)Various Message Variables") :type 'symbol) (defcustom message-dont-reply-to-names @@ -974,6 +1056,7 @@ If nil, you might be asked to input the charset." A value of nil means exclude your own user name only." :version "21.1" :group 'message + :link '(custom-manual "(message)Wide Reply") :type '(choice (const :tag "Yourself" nil) regexp)) @@ -996,8 +1079,9 @@ candidates: (defcustom message-hidden-headers nil "Regexp of headers to be hidden when composing new messages. This can also be a list of regexps to match headers. Or a list -starting with `not' and followed by regexps.." +starting with `not' and followed by regexps." :group 'message + :link '(custom-manual "(message)Message Headers") :type '(repeat regexp)) ;;; Internal variables. @@ -1209,6 +1293,7 @@ The cdr of each entry is a function for applying the face to a region.") This hook is run quite early when sending." :group 'message-various :options '(ispell-message) + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-send-mail-hook nil @@ -1216,6 +1301,7 @@ This hook is run quite early when sending." This hook is run very late -- just before the message is sent as mail." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-send-news-hook nil @@ -1223,6 +1309,7 @@ mail." This hook is run very late -- just before the message is sent as news." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'hook) (defcustom message-sent-hook nil @@ -1246,6 +1333,7 @@ The lower bound of message size in characters, beyond which the message should be sent in several parts. If it is nil, the size is unlimited." :version "21.1" :group 'message-buffers + :link '(custom-manual "(message)Mail Variables") :type '(choice (const :tag "unlimited" nil) (integer 1000000))) @@ -1253,6 +1341,7 @@ should be sent in several parts. If it is nil, the size is unlimited." "A regexp to match the alternative email addresses. The first matched address (not primary one) is used in the From field." :group 'message-headers + :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "Always use primary" nil) regexp)) @@ -1298,20 +1387,24 @@ answers yes, reply to all recipients as usual. If the user answers no, only reply back to the author." :version "21.3" :group 'message-headers + :link '(custom-manual "(message)Wide Reply") :type 'boolean) (defcustom message-user-fqdn nil "*Domain part of Messsage-Ids." :group 'message-headers :link '(custom-manual "(message)News Headers") - :type 'string) + :type '(radio (const :format "%v " nil) + (string :format "FQDN: %v\n" :size 0))) (defcustom message-use-idna (and (condition-case nil (require 'idna) (file-error)) (mm-coding-system-p 'utf-8) + (executable-find idna-program) 'ask) "Whether to encode non-ASCII in domain names into ASCII according to IDNA." :group 'message-headers + :link '(custom-manual "(message)IDNA") :type '(choice (const :tag "Ask" ask) (const :tag "Never" nil) (const :tag "Always" t))) @@ -1325,6 +1418,7 @@ no, only reply back to the author." (defvar message-draft-article nil) (defvar message-mime-part nil) (defvar message-posting-charset nil) +(defvar message-inserted-headers nil) ;; Byte-compiler warning (eval-when-compile @@ -1456,7 +1550,8 @@ no, only reply back to the author." (autoload 'gnus-groups-from-server "gnus") (autoload 'rmail-output "rmailout") (autoload 'gnus-delay-article "gnus-delay") - (autoload 'gnus-make-local-hook "gnus-util")) + (autoload 'gnus-make-local-hook "gnus-util") + (autoload 'gnus-extract-address-components "gnus-util")) @@ -1532,7 +1627,9 @@ is used by default." (looking-at message-unix-mail-delimiter)))) (defun message-fetch-field (header &optional not-all) - "The same as `mail-fetch-field', only remove all newlines." + "The same as `mail-fetch-field', only remove all newlines. +The buffer is expected to be narrowed to just the header of the message; +see `message-narrow-to-headers-or-head'." (let* ((inhibit-point-motion-hooks t) (case-fold-search t) (value (mail-fetch-field header nil (not not-all)))) @@ -1542,6 +1639,13 @@ is used by default." (set-text-properties 0 (length value) nil value) value))) +(defun message-field-value (header &optional not-all) + "The same as `message-fetch-field', only narrow to the headers first." + (save-excursion + (save-restriction + (message-narrow-to-headers-or-head) + (message-fetch-field header not-all)))) + (defun message-narrow-to-field () "Narrow the buffer to the header on the current line." (beginning-of-line) @@ -1590,12 +1694,6 @@ is used by default." (mail-narrow-to-head) (message-fetch-field header)))) -(defun message-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)) - (byte-code-function-p form))) - (defun message-strip-list-identifiers (subject) "Remove list identifiers in `gnus-list-identifiers' from string SUBJECT." (require 'gnus-sum) ; for gnus-list-identifiers @@ -1656,6 +1754,7 @@ Leading \"Re: \" is not stripped by this function. Use the function ;;;###autoload (defun message-change-subject (new-subject) "Ask for NEW-SUBJECT header, append (was: )." + ;; (interactive (list (read-from-minibuffer "New subject: "))) @@ -1663,7 +1762,10 @@ Leading \"Re: \" is not stripped by this function. Use the function (zerop (string-width new-subject)) (string-match "^[ \t]*$" new-subject)))) (save-excursion - (let ((old-subject (message-fetch-field "Subject"))) + (let ((old-subject + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "Subject")))) (cond ((not old-subject) (error "No current subject")) ((not (string-match @@ -1687,7 +1789,7 @@ Leading \"Re: \" is not stripped by this function. Use the function See `message-mark-insert-begin' and `message-mark-insert-end'." (interactive "r") (save-excursion - ; add to the end of the region first, otherwise end would be invalid + ;; add to the end of the region first, otherwise end would be invalid (goto-char end) (insert message-mark-insert-end) (goto-char beg) @@ -1849,19 +1951,26 @@ With prefix-argument just set Follow-Up, don't cross-post." (defun message-reduce-to-to-cc () "Replace contents of To: header with contents of Cc: or Bcc: header." (interactive) - (let ((cc-content (message-fetch-field "cc")) + (let ((cc-content + (save-restriction (message-narrow-to-headers) + (message-fetch-field "cc"))) (bcc nil)) (if (and (not cc-content) - (setq cc-content (message-fetch-field "bcc"))) + (setq cc-content + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "bcc")))) (setq bcc t)) (cond (cc-content (save-excursion (message-goto-to) (message-delete-line) (insert (concat "To: " cc-content "\n")) - (message-remove-header (if bcc - "bcc" - "cc"))))))) + (save-restriction + (message-narrow-to-headers) + (message-remove-header (if bcc + "bcc" + "cc")))))))) ;;; End of functions adopted from `message-utils.el'. @@ -2116,11 +2225,11 @@ Point is left at the beginning of the narrowed-to region." ["Insert Signature" message-insert-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] - ["Elide Region" message-elide-region + ["Elide Region" message-elide-region :active (message-mark-active-p) ,@(if (featurep 'xemacs) nil '(:help "Replace text in region with an ellipsis"))] - ["Delete Outside Region" message-delete-not-region + ["Delete Outside Region" message-delete-not-region :active (message-mark-active-p) ,@(if (featurep 'xemacs) nil '(:help "Delete all quoted text outside region"))] @@ -2155,9 +2264,6 @@ Point is left at the beginning of the narrowed-to region." (easy-menu-define message-mode-field-menu message-mode-map "" `("Field" - ["Fetch To" message-insert-to t] - ["Fetch Newsgroups" message-insert-newsgroups t] - "----" ["To" message-goto-to t] ["From" message-goto-from t] ["Subject" message-goto-subject t] @@ -2181,6 +2287,7 @@ Point is left at the beginning of the narrowed-to region." ["Summary" message-goto-summary t] ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] + ["Fetch Newsgroups" message-insert-newsgroups t] ["Followup-To" message-goto-followup-to t] ;; ["Followup-To (with note in body)" message-cross-post-followup-to t] ["Crosspost / Followup-To..." message-cross-post-followup-to t] @@ -2188,8 +2295,19 @@ Point is left at the beginning of the narrowed-to region." ["X-No-Archive:" message-add-archive-header t ] "----" ;; (typical) mailing-lists stuff + ["Fetch To" message-insert-to + ,@(if (featurep 'xemacs) '(t) + '(:help "Insert a To header that points to the author."))] + ["Fetch To and Cc" message-insert-wide-reply + ,@(if (featurep 'xemacs) '(t) + '(:help + "Insert To and Cc headers as if you were doing a wide reply."))] + "----" ["Send to list only" message-to-list-only t] ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to + ,@(if (featurep 'xemacs) '(t) + '(:help "Insert a reasonable `Mail-Followup-To:' header."))] ["Reduce To: to Cc:" message-reduce-to-to-cc t] "----" ["Sort Headers" message-sort-headers t] @@ -2219,6 +2337,7 @@ packages requires these properties to be present in order to work. If you use one of these packages, turn this option off, and hope the message composition doesn't break too bad." :group 'message-various + :link '(custom-manual "(message)Various Message Variables") :type 'boolean) (defconst message-forbidden-properties @@ -2302,11 +2421,12 @@ C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags). M-RET `message-newline-and-reformat' (break the line and reformat)." (setq local-abbrev-table text-mode-abbrev-table) (set (make-local-variable 'message-reply-buffer) nil) - (make-local-variable 'message-send-actions) - (make-local-variable 'message-exit-actions) - (make-local-variable 'message-kill-actions) - (make-local-variable 'message-postpone-actions) - (make-local-variable 'message-draft-article) + (set (make-local-variable 'message-inserted-headers) nil) + (set (make-local-variable 'message-send-actions) nil) + (set (make-local-variable 'message-exit-actions) nil) + (set (make-local-variable 'message-kill-actions) nil) + (set (make-local-variable 'message-postpone-actions) nil) + (set (make-local-variable 'message-draft-article) nil) (setq buffer-offer-save t) (set (make-local-variable 'facemenu-add-face-function) (lambda (face end) @@ -2347,7 +2467,8 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (when (eq message-mail-alias-type 'abbrev) (if (fboundp 'mail-abbrevs-setup) (mail-abbrevs-setup) - (mail-aliases-setup))) + (if (fboundp 'mail-aliases-setup) ; warning avoidance + (mail-aliases-setup)))) (unless buffer-file-name (message-set-auto-save-file-name)) (unless (buffer-base-buffer) @@ -2511,11 +2632,14 @@ If the optional argument INCLUDE-CC is non-nil, the addresses in the Cc: header are also put into the MFT." (interactive "P") - (message-remove-header "Mail-Followup-To") - (let* ((cc (and include-cc (message-fetch-field "Cc"))) - (tos (if cc - (concat (message-fetch-field "To") "," cc) - (message-fetch-field "To")))) + (let* (cc tos) + (save-restriction + (message-narrow-to-headers) + (message-remove-header "Mail-Followup-To") + (setq cc (and include-cc (message-fetch-field "Cc"))) + (setq tos (if cc + (concat (message-fetch-field "To") "," cc) + (message-fetch-field "To")))) (message-goto-mail-followup-to) (insert (concat tos ", " user-mail-address)))) @@ -2523,22 +2647,24 @@ Cc: header are also put into the MFT." (defun message-insert-to (&optional force) "Insert a To header that points to the author of the article being replied to. -If the original author requested not to be sent mail, the function signals -an error. -With the prefix argument FORCE, insert the header anyway." +If the original author requested not to be sent mail, don't insert unless the +prefix FORCE is given." (interactive "P") - (let ((co (message-fetch-reply-field "mail-copies-to"))) - (when (and (null force) - co - (or (equal (downcase co) "never") - (equal (downcase co) "nobody"))) - (error "The user has requested not to have copies sent via mail"))) - (message-carefully-insert-headers - (list (cons 'To - (or (message-fetch-reply-field "mail-reply-to") - (message-fetch-reply-field "reply-to") - (message-fetch-reply-field "from") - ""))))) + (let* ((mct (message-fetch-reply-field "mail-copies-to")) + (dont (and mct (or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")))) + (to (or (message-fetch-reply-field "mail-reply-to") + (message-fetch-reply-field "reply-to") + (message-fetch-reply-field "from")))) + (when (and dont to) + (message + (if force + "Ignoring the user request not to have copies sent via mail" + "Complying with the user request not to have copies sent via mail"))) + (when (and force (not to)) + (error "No mail address in the article")) + (when (and to (or force (not dont))) + (message-carefully-insert-headers (list (cons 'To to)))))) (defun message-insert-wide-reply () "Insert To and Cc headers as if you were doing a wide reply." @@ -2547,15 +2673,34 @@ With the prefix argument FORCE, insert the header anyway." (message-get-reply-headers t)))) (message-carefully-insert-headers headers))) +(defvar message-header-synonyms + '((To Cc Bcc)) + "List of lists of header synonyms. +E.g., if this list contains a member list with elements `Cc' and `To', +then `message-carefully-insert-headers' will not insert a `To' header +when the message is already `Cc'ed to the recipient.") + (defun message-carefully-insert-headers (headers) + "Insert the HEADERS, an alist, into the message buffer. +Does not insert the headers when they are already present there +or in the synonym headers, defined by `message-header-synonyms'." (dolist (header headers) - (let ((header-name (symbol-name (car header)))) - (when (and (message-position-on-field header-name) - (mail-fetch-field header-name) - (not (string-match "\\` *\\'" - (mail-fetch-field header-name)))) - (insert ", ")) - (insert (cdr header))))) + (let* ((header-name (symbol-name (car header))) + (new-header (cdr header)) + (synonyms (loop for synonym in message-header-synonyms + when (memq (car header) synonym) return synonym)) + (old-header + (loop for synonym in synonyms + for old-header = (mail-fetch-field (symbol-name synonym)) + when (and old-header (string-match new-header old-header)) + return synonym))) + (if old-header + (message "already have `%s' in `%s'" new-header old-header) + (when (and (message-position-on-field header-name) + (setq old-header (mail-fetch-field header-name)) + (not (string-match "\\` *\\'" old-header))) + (insert ", ")) + (insert new-header))))) (defun message-widen-reply () "Widen the reply to include maximum recipients." @@ -2748,7 +2893,7 @@ Prefix arg means justify as well." ((and (null message-signature) force) t) - ((message-functionp message-signature) + ((functionp message-signature) (funcall message-signature)) ((listp message-signature) (eval message-signature)) @@ -2778,7 +2923,9 @@ Prefix arg means justify as well." "Insert header to mark message as important." (interactive) (save-excursion - (message-remove-header "Importance") + (save-restriction + (message-narrow-to-headers) + (message-remove-header "Importance")) (message-goto-eoh) (insert "Importance: high\n"))) @@ -2786,7 +2933,9 @@ Prefix arg means justify as well." "Insert header to mark message as unimportant." (interactive) (save-excursion - (message-remove-header "Importance") + (save-restriction + (message-narrow-to-headers) + (message-remove-header "Importance")) (message-goto-eoh) (insert "Importance: low\n"))) @@ -2799,14 +2948,16 @@ and `low'." (let ((valid '("high" "normal" "low")) (new "high") cur) - (when (setq cur (message-fetch-field "Importance")) - (message-remove-header "Importance") - (setq new (cond ((string= cur "high") - "low") - ((string= cur "low") - "normal") - (t - "high")))) + (save-restriction + (message-narrow-to-headers) + (when (setq cur (message-fetch-field "Importance")) + (message-remove-header "Importance") + (setq new (cond ((string= cur "high") + "low") + ((string= cur "low") + "normal") + (t + "high"))))) (message-goto-eoh) (insert (format "Importance: %s\n" new))))) @@ -2815,10 +2966,14 @@ and `low'." Note that this should not be used in newsgroups." (interactive) (save-excursion - (message-remove-header "Disposition-Notification-To") + (save-restriction + (message-narrow-to-headers) + (message-remove-header "Disposition-Notification-To")) (message-goto-eoh) (insert (format "Disposition-Notification-To: %s\n" - (or (message-fetch-field "From") (message-make-from)))))) + (or (message-field-value "Reply-to") + (message-field-value "From") + (message-make-from)))))) (defun message-elide-region (b e) "Elide the text in the region. @@ -2996,7 +3151,7 @@ prefix, and don't delete any headers." (defun message-yank-buffer (buffer) "Insert BUFFER into the current buffer and quote it." (interactive "bYank buffer: ") - (let ((message-reply-buffer buffer)) + (let ((message-reply-buffer (get-buffer buffer))) (save-window-excursion (message-yank-original)))) @@ -3013,13 +3168,27 @@ prefix, and don't delete any headers." (defun message-cite-original-without-signature () "Cite function in the standard Message manner." - (let ((start (point)) - (end (mark t)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) + (let* ((start (point)) + (end (mark t)) + (functions + (when message-indent-citation-function + (if (listp message-indent-citation-function) + message-indent-citation-function + (list message-indent-citation-function)))) + ;; This function may be called by `gnus-summary-yank-message' and + ;; may insert a different article from the original. So, we will + ;; modify the value of `message-reply-headers' with that article. + (message-reply-headers + (save-restriction + (narrow-to-region start end) + (message-narrow-to-head-1) + (vector 0 + (or (message-fetch-field "subject") "none") + (message-fetch-field "from") + (message-fetch-field "date") + (message-fetch-field "message-id" t) + (message-fetch-field "references") + 0 0 "")))) (mml-quote-region start end) ;; Allow undoing. (undo-boundary) @@ -3048,13 +3217,27 @@ prefix, and don't delete any headers." (if (and (boundp 'mail-citation-hook) mail-citation-hook) (run-hooks 'mail-citation-hook) - (let ((start (point)) - (end (mark t)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) + (let* ((start (point)) + (end (mark t)) + (functions + (when message-indent-citation-function + (if (listp message-indent-citation-function) + message-indent-citation-function + (list message-indent-citation-function)))) + ;; This function may be called by `gnus-summary-yank-message' and + ;; may insert a different article from the original. So, we will + ;; modify the value of `message-reply-headers' with that article. + (message-reply-headers + (save-restriction + (narrow-to-region start end) + (message-narrow-to-head-1) + (vector 0 + (or (message-fetch-field "subject") "none") + (message-fetch-field "from") + (message-fetch-field "date") + (message-fetch-field "message-id" t) + (message-fetch-field "references") + 0 0 "")))) (mml-quote-region start end) (goto-char start) (while functions @@ -3210,7 +3393,7 @@ It should typically alter the sending method in some way or other." (when (funcall (cadr elem)) (when (and (or (not (memq (car elem) message-sent-message-via)) - (not (message-fetch-field "supersedes")) + (message-fetch-field "supersedes") (if (or (message-gnksa-enable-p 'multiple-copies) (not (eq (car elem) 'news))) (y-or-n-p @@ -3292,16 +3475,18 @@ It should typically alter the sending method in some way or other." (add-text-properties point (1+ point) '(invisible nil intangible nil))))) ;; Make invisible text visible. + ;; It doesn't seem as if this is useful, since the invisible property + ;; is clobbered by an after-change hook anyhow. (message-check 'invisible-text (let ((points (message-text-with-property 'invisible))) (when points (goto-char (car points)) (dolist (point points) - (add-text-properties point (1+ point) - '(invisible nil face highlight - font-lock-face highlight))) + (put-text-property point (1+ point) 'invisible nil) + (message-overlay-put (message-make-overlay point (1+ point)) + 'face 'highlight)) (unless (yes-or-no-p - "Invisible text found and made visible; continue posting? ") + "Invisible text found and made visible; continue sending? ") (error "Invisible text found and made visible"))))) (message-check 'illegible-text (let (found choice) @@ -3313,34 +3498,40 @@ It should typically alter the sending method in some way or other." (and (mm-multibyte-p) (memq (char-charset char) '(eight-bit-control eight-bit-graphic - control-1))))) - (add-text-properties (point) (1+ (point)) - '(font-lock-face highlight face highlight)) + control-1)) + (not (get-text-property + (point) 'untranslated-utf-8))))) + (message-overlay-put (message-make-overlay (point) (1+ (point))) + 'face 'highlight) (setq found t)) (forward-char) (skip-chars-forward mm-7bit-chars)) (when found (setq choice (gnus-multiple-choice - "Illegible text found. Continue posting?" - '((?d "Remove and continue posting") - (?r "Replace with dots and continue posting") - (?i "Ignore and continue posting") + "Non-printable characters found. Continue sending?" + '((?d "Remove non-printable characters and send") + (?r "Replace non-printable characters with dots and send") + (?i "Ignore non-printable characters and send") (?e "Continue editing")))) (if (eq choice ?e) - (error "Illegible text found")) + (error "Non-printable characters")) (message-goto-body) (skip-chars-forward mm-7bit-chars) (while (not (eobp)) (when (let ((char (char-after))) (or (< (mm-char-int char) 128) (and (mm-multibyte-p) + ;; Fixme: Wrong for Emacs 22 and for things + ;; like undecable utf-8. Should at least + ;; use find-coding-systems-region. (memq (char-charset char) '(eight-bit-control eight-bit-graphic - control-1))))) + control-1)) + (not (get-text-property + (point) 'untranslated-utf-8))))) (if (eq choice ?i) - (remove-text-properties (point) (1+ (point)) - '(font-lock-face highlight face highlight)) + (message-kill-all-overlays) (delete-char 1) (when (eq choice ?r) (insert ".")))) @@ -3367,7 +3558,7 @@ It should typically alter the sending method in some way or other." (ignore-errors (cond ;; A simple function. - ((message-functionp (car actions)) + ((functionp (car actions)) (funcall (car actions))) ;; Something to be evaled. (t @@ -3499,6 +3690,9 @@ It should typically alter the sending method in some way or other." (or (= (preceding-char) ?\n) (insert ?\n)) (message-cleanup-headers) + ;; FIXME: we're inserting the courtesy copy after encoding. + ;; This is wrong if the courtesy copy string contains + ;; non-ASCII characters. -- jh (when (save-restriction (message-narrow-to-headers) @@ -3506,13 +3700,19 @@ It should typically alter the sending method in some way or other." (or (message-fetch-field "cc") (message-fetch-field "bcc") (message-fetch-field "to")) - (let ((content-type (message-fetch-field "content-type"))) - (or - (not content-type) - (string= "text/plain" - (car - (mail-header-parse-content-type - content-type))))))) + (let ((content-type (message-fetch-field + "content-type"))) + (and + (or + (not content-type) + (string= "text/plain" + (car + (mail-header-parse-content-type + content-type)))) + (not + (string= "base64" + (message-fetch-field + "content-transfer-encoding"))))))) (message-insert-courtesy-copy)) (if (or (not message-send-mail-partially-limit) (< (point-max) message-send-mail-partially-limit) @@ -3604,7 +3804,7 @@ If you always want Gnus to send messages in one piece, set (if resend-to-addresses (list resend-to-addresses) '("-t")))))) - (unless (or (null cpr) (zerop cpr)) + (unless (or (null cpr) (and (numberp cpr) (zerop cpr))) (error "Sending...failed with exit value %d" cpr))) (when message-interactive (save-excursion @@ -3651,7 +3851,7 @@ to find out how to use this." ;; free for -inject-arguments -- a big win for the user and for us ;; since we don't have to play that double-guessing game and the user ;; gets full control (no gestapo'ish -f's, for instance). --sj - (if (message-functionp message-qmail-inject-args) + (if (functionp message-qmail-inject-args) (funcall message-qmail-inject-args) message-qmail-inject-args))) ;; qmail-inject doesn't say anything on it's stdout/stderr, @@ -3690,7 +3890,7 @@ documentation for the function `mail-source-touch-pop'." (smtpmail-send-it)) (defun message-canlock-generate () - "Return a string that is non-trival to guess. + "Return a string that is non-trivial to guess. Do not use this for anything important, it is cryptographically weak." (let (sha1-maximum-internal-length) (sha1 (concat (message-unique-id) @@ -3715,7 +3915,7 @@ Otherwise, generate and save a value for `canlock-password' first." (defun message-send-news (&optional arg) (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) (case-fold-search nil) - (method (if (message-functionp message-post-method) + (method (if (functionp message-post-method) (funcall message-post-method arg) message-post-method)) (newsgroups-field (save-restriction @@ -3962,7 +4162,7 @@ Otherwise, generate and save a value for `canlock-password' first." (if followup-to (concat newsgroups "," followup-to) newsgroups))) - (post-method (if (message-functionp message-post-method) + (post-method (if (functionp message-post-method) (funcall message-post-method) message-post-method)) ;; KLUDGE to handle nnvirtual groups. Doing this right @@ -4401,7 +4601,7 @@ If NOW, use that time instead." "Make an Organization header." (let* ((organization (when message-user-organization - (if (message-functionp message-user-organization) + (if (functionp message-user-organization) (funcall message-user-organization) message-user-organization)))) (with-temp-buffer @@ -4456,7 +4656,7 @@ If NOW, use that time instead." (defun message-make-distribution () "Make a Distribution header." (let ((orig-distribution (message-fetch-reply-field "distribution"))) - (cond ((message-functionp message-distribution-function) + (cond ((functionp message-distribution-function) (funcall message-distribution-function)) (t orig-distribution)))) @@ -4506,6 +4706,16 @@ If NOW, use that time instead." (aset tmp (1- (match-end 0)) ?-)) (string-match "[\\()]" tmp))))) (insert fullname) + (goto-char (point-min)) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) + ;; Quote fullname, escaping specials. + (goto-char (point-min)) + (insert "\"") + (while (re-search-forward "[\"\\]" nil 1) + (replace-match "\\\\\\&" t)) + (insert "\"")) (insert " <" login ">")) (t ; 'parens or default (insert login " (") @@ -4564,7 +4774,8 @@ give as trustworthy answer as possible." (user-domain (if (and user-mail (string-match "@\\(.*\\)\\'" user-mail)) - (match-string 1 user-mail)))) + (match-string 1 user-mail))) + (case-fold-search t)) (cond ((and message-user-fqdn (stringp message-user-fqdn) @@ -4590,7 +4801,8 @@ give as trustworthy answer as possible." user-domain) ;; Default to this bogus thing. (t - (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me"))))) + (concat system-name + ".i-did-not-set--mail-host-address--so-tickle-me"))))) (defun message-make-host-name () "Return the name of the host." @@ -4686,7 +4898,7 @@ I.e., calling it on a Subject: header is useless." (let (rhs ace start startpos endpos ovl) (goto-char (point-min)) (while (re-search-forward (concat "^" header) nil t) - (while (re-search-forward "@\\([^ \t\r\n>]+\\)" + (while (re-search-forward "@\\([^ \t\r\n>,]+\\)" (or (save-excursion (re-search-forward "^[^ \t]" nil t)) (point-max)) @@ -4745,7 +4957,7 @@ Headers already prepared in the buffer are not modified." (Expires (message-make-expires)) (case-fold-search t) (optionalp nil) - header value elem) + header value elem header-string) ;; First we remove any old generated headers. (let ((headers message-deletable-headers)) (unless (buffer-modified-p) @@ -4770,13 +4982,12 @@ Headers already prepared in the buffer are not modified." optionalp t) (setq header (car elem))) (setq header elem)) + (setq header-string (if (stringp header) + header + (symbol-name header))) (when (or (not (re-search-forward (concat "^" - (regexp-quote - (downcase - (if (stringp header) - header - (symbol-name header)))) + (regexp-quote (downcase header-string)) ":") nil t)) (progn @@ -4789,12 +5000,13 @@ Headers already prepared in the buffer are not modified." (setq value (cond ((and (consp elem) - (eq (car elem) 'optional)) + (eq (car elem) 'optional) + (not (member header-string message-inserted-headers))) ;; This is an optional header. If the cdr of this ;; is something that is nil, then we do not insert ;; this header. (setq header (cdr elem)) - (or (and (message-functionp (cdr elem)) + (or (and (functionp (cdr elem)) (funcall (cdr elem))) (and (boundp (cdr elem)) (symbol-value (cdr elem))))) @@ -4805,7 +5017,7 @@ Headers already prepared in the buffer are not modified." ;; this function. (or (and (stringp (cdr elem)) (cdr elem)) - (and (message-functionp (cdr elem)) + (and (functionp (cdr elem)) (funcall (cdr elem))))) ((and (boundp header) (symbol-value header)) @@ -4829,9 +5041,7 @@ Headers already prepared in the buffer are not modified." (cdr (assq header message-header-format-alist)))) (if formatter (funcall formatter header value) - (insert (if (stringp header) - header (symbol-name header)) - ": " value)) + (insert header-string ": " value)) ;; We check whether the value was ended by a ;; newline. If now, we insert one. (unless (bolp) @@ -4843,6 +5053,7 @@ Headers already prepared in the buffer are not modified." ;; If the header is optional, and the header was ;; empty, we con't insert it anyway. (unless optionalp + (push header-string message-inserted-headers) (insert value))) ;; Add the deletable property to the headers that require it. (and (memq header message-deletable-headers) @@ -5038,12 +5249,25 @@ than 988 characters long, and if they are not, trim them until they are." (sit-for 0))) (defcustom message-beginning-of-line t - "Whether C-a goes to beginning of header values." + "Whether \\\\[message-beginning-of-line]\ + goes to beginning of header values." :group 'message-buffers + :link '(custom-manual "(message)Movement") :type 'boolean) (defun message-beginning-of-line (&optional n) - "Move point to beginning of header value or to beginning of line." + "Move point to beginning of header value or to beginning of line. +The prefix argument N is passed directly to `beginning-of-line'. + +This command is identical to `beginning-of-line' if point is +outside the message header or if the option `message-beginning-of-line' +is nil. + +If point is in the message header and on a (non-continued) header +line, move point to the beginning of the header value. If point +is already there, move point to beginning of line. Therefore, +repeated calls will toggle point between beginning of field and +beginning of line." (interactive "p") (let ((zrs 'zmacs-region-stays)) (when (and (interactive-p) (boundp zrs)) @@ -5075,7 +5299,7 @@ than 988 characters long, and if they are not, trim them until they are." "*"))) ;; Check whether `message-generate-new-buffers' is a function, ;; and if so, call it. - ((message-functionp message-generate-new-buffers) + ((functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) ((eq message-generate-new-buffers 'unsent) (generate-new-buffer-name @@ -5359,15 +5583,17 @@ OTHER-HEADERS is an alist of header/value pairs." (defun message-get-reply-headers (wide &optional to-address address-headers) (let (follow-to mct never-mct to cc author mft recipients) ;; Find all relevant headers we need. - (setq to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - author (or (message-fetch-field "mail-reply-to") - (message-fetch-field "reply-to") - (message-fetch-field "from") - "") - mft (and message-use-mail-followup-to - (message-fetch-field "mail-followup-to"))) + (save-restriction + (message-narrow-to-headers-or-head) + (setq to (message-fetch-field "to") + cc (message-fetch-field "cc") + mct (message-fetch-field "mail-copies-to") + author (or (message-fetch-field "mail-reply-to") + (message-fetch-field "reply-to") + (message-fetch-field "from") + "") + mft (and message-use-mail-followup-to + (message-fetch-field "mail-followup-to")))) ;; Handle special values of Mail-Copies-To. (when mct @@ -5492,11 +5718,11 @@ responses here are directed to other addresses."))) ;; Allow customizations to have their say. (if (not wide) ;; This is a regular reply. - (when (message-functionp message-reply-to-function) + (when (functionp message-reply-to-function) (save-excursion (setq follow-to (funcall message-reply-to-function)))) ;; This is a followup. - (when (message-functionp message-wide-reply-to-function) + (when (functionp message-wide-reply-to-function) (save-excursion (setq follow-to (funcall message-wide-reply-to-function))))) @@ -5556,7 +5782,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (if (search-forward "\n\n" nil t) (1- (point)) (point-max))) - (when (message-functionp message-followup-to-function) + (when (functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) (setq from (message-fetch-field "from") @@ -5649,6 +5875,48 @@ responses here are directed to other newsgroups.")) cur))) +(defun message-is-yours-p () + "Non-nil means current article is yours. +If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles +are yours except those that have Cancel-Lock header not belonging to you. +Instead of shooting GNKSA feet, you should modify 'message-alternative-emails' +regexp to match all of yours addresses." + ;; Canlock-logic as suggested by Per Abrahamsen + ;; + ;; + ;; IF article has cancel-lock THEN + ;; IF we can verify it THEN + ;; issue cancel + ;; ELSE + ;; error: cancellock: article is not yours + ;; ELSE + ;; Use old rules, comparing sender... + (save-excursion + (save-restriction + (message-narrow-to-head-1) + (if (message-fetch-field "Cancel-Lock") + (if (null (canlock-verify)) + t + (error "Failed to verify Cancel-lock: This article is not yours")) + (let (sender from) + (or + (message-gnksa-enable-p 'cancel-messages) + (and (setq sender (message-fetch-field "sender")) + (string-equal (downcase sender) + (downcase (message-make-sender)))) + ;; Email address in From field equals to our address + (and (setq from (message-fetch-field "from")) + (string-equal + (downcase (cadr (mail-extract-address-components from))) + (downcase (cadr (mail-extract-address-components + (message-make-from)))))) + ;; Email address in From field matches + ;; 'message-alternative-emails' regexp + (and from + message-alternative-emails + (string-match + message-alternative-emails + (cadr (mail-extract-address-components from)))))))))) ;;;###autoload (defun message-cancel-news (&optional arg) @@ -5657,42 +5925,17 @@ If ARG, allow editing of the cancellation message." (interactive "P") (unless (message-news-p) (error "This is not a news article; canceling is impossible")) - (let (from newsgroups message-id distribution buf sender) + (let (from newsgroups message-id distribution buf) (save-excursion ;; Get header info from original article. (save-restriction (message-narrow-to-head-1) (setq from (message-fetch-field "from") - sender (message-fetch-field "sender") newsgroups (message-fetch-field "newsgroups") message-id (message-fetch-field "message-id" t) distribution (message-fetch-field "distribution"))) ;; Make sure that this article was written by the user. - (unless (or - ;; Canlock-logic as suggested by Per Abrahamsen - ;; - ;; - ;; IF article has cancel-lock THEN - ;; IF we can verify it THEN - ;; issue cancel - ;; ELSE - ;; error: cancellock: article is not yours - ;; ELSE - ;; Use old rules, comparing sender... - (if (message-fetch-field "Cancel-Lock") - (if (null (canlock-verify)) - t - (error "Failed to verify Cancel-lock: This article is not yours")) - nil) - (message-gnksa-enable-p 'cancel-messages) - (and sender - (string-equal - (downcase sender) - (downcase (message-make-sender)))) - (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (cadr (mail-extract-address-components - (message-make-from)))))) + (unless (message-is-yours-p) (error "This article is not yours")) (when (yes-or-no-p "Do you really want to cancel this article? ") ;; Make control message. @@ -5724,35 +5967,9 @@ If ARG, allow editing of the cancellation message." This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (let ((cur (current-buffer)) - (sender (message-fetch-field "sender")) - (from (message-fetch-field "from"))) + (let ((cur (current-buffer))) ;; Check whether the user owns the article that is to be superseded. - (unless (or - ;; Canlock-logic as suggested by Per Abrahamsen - ;; - ;; - ;; IF article has cancel-lock THEN - ;; IF we can verify it THEN - ;; issue cancel - ;; ELSE - ;; error: cancellock: article is not yours - ;; ELSE - ;; Use old rules, comparing sender... - (if (message-fetch-field "Cancel-Lock") - (if (null (canlock-verify)) - t - (error "Failed to verify Cancel-lock: This article is not yours")) - nil) - (message-gnksa-enable-p 'cancel-messages) - (and sender - (string-equal - (downcase sender) - (downcase (message-make-sender)))) - (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (cadr (mail-extract-address-components - (message-make-from)))))) + (unless (message-is-yours-p) (error "This article is not yours")) ;; Get a normal message buffer. (message-pop-to-buffer (message-buffer-name "supersede")) @@ -5829,43 +6046,48 @@ Previous forwarders, replyers, etc. may add it." (defvar message-forward-decoded-p nil "Non-nil means the original message is decoded.") -(defun message-forward-subject-author-subject (subject) +(defun message-forward-subject-name-subject (subject) "Generate a SUBJECT for a forwarded message. The form is: [Source] Subject, where if the original message was mail, -Source is the sender, and if the original message was news, Source is -the list of newsgroups is was posted to." - (concat "[" - (let ((prefix - (or (message-fetch-field "newsgroups") - (message-fetch-field "from") - "(nowhere)"))) +Source is the name of the sender, and if the original message was +news, Source is the list of newsgroups is was posted to." + (let* ((group (message-fetch-field "newsgroups")) + (from (message-fetch-field "from")) + (prefix + (if group + (gnus-group-decoded-name group) + (or (and from (car (gnus-extract-address-components from))) + "(nowhere)")))) + (concat "[" (if message-forward-decoded-p prefix - (mail-decode-encoded-word-string prefix))) - "] " subject)) + (mail-decode-encoded-word-string prefix)) + "] " subject))) -(defun message-forward-subject-name-subject (subject) +(defun message-forward-subject-author-subject (subject) "Generate a SUBJECT for a forwarded message. The form is: [Source] Subject, where if the original message was mail, -Source is the name of the sender, and if the original message was -news, Source is the list of newsgroups is was posted to." - (concat "[" - (let ((prefix - (or (message-fetch-field "newsgroups") - (let ((from (message-fetch-field "from"))) - (and from - (cdr (mail-header-parse-address from)))) - "(nowhere)"))) +Source is the sender, and if the original message was news, Source is +the list of newsgroups is was posted to." + (let* ((group (message-fetch-field "newsgroups")) + (prefix + (if group + (gnus-group-decoded-name group) + (or (message-fetch-field "from") + "(nowhere)")))) + (concat "[" (if message-forward-decoded-p prefix - (mail-decode-encoded-word-string prefix))) - "] " subject)) + (mail-decode-encoded-word-string prefix)) + "] " subject))) (defun message-forward-subject-fwd (subject) "Generate a SUBJECT for a forwarded message. The form is: Fwd: Subject, where Subject is the original subject of the message." - (concat "Fwd: " subject)) + (if (string-match "^Fwd: " subject) + subject + (concat "Fwd: " subject))) (defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." @@ -5889,7 +6111,7 @@ the message." ;; Apply funcs in order, passing subject generated by previous ;; func to the next one. (while funcs - (when (message-functionp (car funcs)) + (when (functionp (car funcs)) (setq subject (funcall (car funcs) subject))) (setq funcs (cdr funcs))) subject)))) @@ -5915,6 +6137,108 @@ Optional DIGEST will use digest to forward." (message-mail nil subject)) (message-forward-make-body cur digest))) +(defun message-forward-make-body-plain (forward-buffer) + (insert + "\n-------------------- Start of forwarded message --------------------\n") + (let ((b (point)) e) + (insert + (with-temp-buffer + (mm-disable-multibyte) + (insert + (with-current-buffer forward-buffer + (mm-with-unibyte-current-buffer (buffer-string)))) + (mm-enable-multibyte) + (mime-to-mml) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ")) + (buffer-string))) + (setq e (point)) + (insert + "\n-------------------- End of forwarded message --------------------\n") + (when (and (not current-prefix-arg) + message-forward-ignored-headers) + (save-restriction + (narrow-to-region b e) + (goto-char b) + (narrow-to-region (point) + (or (search-forward "\n\n" nil t) (point))) + (message-remove-header message-forward-ignored-headers t))))) + +(defun message-forward-make-body-mime (forward-buffer) + (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") + (let ((b (point)) e) + (save-restriction + (narrow-to-region (point) (point)) + (mml-insert-buffer forward-buffer) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ")) + (goto-char (point-max))) + (setq e (point)) + (insert "<#/part>\n"))) + +(defun message-forward-make-body-mml (forward-buffer) + (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") + (let ((b (point)) e) + (if (not message-forward-decoded-p) + (insert + (with-temp-buffer + (mm-disable-multibyte) + (insert + (with-current-buffer forward-buffer + (mm-with-unibyte-current-buffer (buffer-string)))) + (mm-enable-multibyte) + (mime-to-mml) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ")) + (buffer-string))) + (save-restriction + (narrow-to-region (point) (point)) + (mml-insert-buffer forward-buffer) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ")) + (goto-char (point-max)))) + (setq e (point)) + (insert "<#/mml>\n") + (when (and (not current-prefix-arg) + message-forward-ignored-headers) + (save-restriction + (narrow-to-region b e) + (goto-char b) + (narrow-to-region (point) + (or (search-forward "\n\n" nil t) (point))) + (message-remove-header message-forward-ignored-headers t))))) + +(defun message-forward-make-body-digest-plain (forward-buffer) + (insert + "\n-------------------- Start of forwarded message --------------------\n") + (let ((b (point)) e) + (mml-insert-buffer forward-buffer) + (setq e (point)) + (insert + "\n-------------------- End of forwarded message --------------------\n"))) + +(defun message-forward-make-body-digest-mime (forward-buffer) + (insert "\n<#multipart type=digest>\n") + (let ((b (point)) e) + (insert-buffer-substring forward-buffer) + (setq e (point)) + (insert "<#/multipart>\n") + (save-restriction + (narrow-to-region b e) + (goto-char b) + (narrow-to-region (point) + (or (search-forward "\n\n" nil t) (point))) + (delete-region (point-min) (point-max))))) + +(defun message-forward-make-body-digest (forward-buffer) + (if message-forward-as-mime + (message-forward-make-body-digest-mime forward-buffer) + (message-forward-make-body-digest-plain forward-buffer))) + ;;;###autoload (defun message-forward-make-body (forward-buffer &optional digest) ;; Put point where we want it before inserting the forwarded @@ -5922,64 +6246,19 @@ Optional DIGEST will use digest to forward." (if message-forward-before-signature (message-goto-body) (goto-char (point-max))) - (if message-forward-as-mime - (if digest - (insert "\n<#multipart type=digest>\n") - (if message-forward-show-mml - (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") - (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n"))) - (insert "\n-------------------- Start of forwarded message --------------------\n")) - (let ((b (point)) e) - (if digest - (if message-forward-as-mime - (insert-buffer-substring forward-buffer) - (mml-insert-buffer forward-buffer)) - (if (and message-forward-show-mml - (not message-forward-decoded-p)) - (insert - (with-temp-buffer - (mm-disable-multibyte) - (insert - (with-current-buffer forward-buffer - (mm-with-unibyte-current-buffer (buffer-string)))) - (mm-enable-multibyte) - (mime-to-mml) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (buffer-string))) - (save-restriction - (narrow-to-region (point) (point)) - (mml-insert-buffer forward-buffer) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (goto-char (point-max))))) - (setq e (point)) + (if digest + (message-forward-make-body-digest forward-buffer) (if message-forward-as-mime - (if digest - (insert "<#/multipart>\n") - (if message-forward-show-mml - (insert "<#/mml>\n") - (insert "<#/part>\n"))) - (insert "\n-------------------- End of forwarded message --------------------\n")) - (if (and digest message-forward-as-mime) - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (delete-region (point-min) (point-max))) - (when (and (not current-prefix-arg) - message-forward-ignored-headers - ;; don't remove CTE, X-Gnus etc when doing "raw" forward: - message-forward-show-mml) - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (message-remove-header message-forward-ignored-headers t))))) + (if (and message-forward-show-mml + (not (and (eq message-forward-show-mml 'best) + (with-current-buffer forward-buffer + (goto-char (point-min)) + (re-search-forward + "Content-Type: *multipart/\\(signed\\|encrypted\\)" + nil t))))) + (message-forward-make-body-mml forward-buffer) + (message-forward-make-body-mime forward-buffer)) + (message-forward-make-body-plain forward-buffer))) (message-position-point)) ;;;###autoload @@ -5992,9 +6271,12 @@ Optional DIGEST will use digest to forward." (rmail-msg-restore-non-pruned-header))) (message-forward-make-body forward-buffer)) +(eval-when-compile (defvar rmail-enable-mime-composing)) + +;; Fixme: Should have defcustom. ;;;###autoload (defun message-insinuate-rmail () - "Let RMAIL uses message to forward." + "Let RMAIL use message to forward." (interactive) (setq rmail-enable-mime-composing t) (setq rmail-insert-mime-forwarded-message-function @@ -6017,7 +6299,7 @@ Optional DIGEST will use digest to forward." message-setup-hook) (message-setup `((To . ,address)))) ;; Insert our usual headers. - (message-generate-headers '(From Date To)) + (message-generate-headers '(From Date To Message-ID)) (message-narrow-to-headers) ;; Remove X-Draft-From header etc. (message-remove-header message-ignored-mail-headers t) @@ -6073,20 +6355,23 @@ you." (mm-insert-part handles) (undo-boundary) (goto-char (point-min)) - (search-forward "\n\n" nil t) - (if (or (and (re-search-forward message-unsent-separator nil t) - (forward-line 1)) - (re-search-forward "^Return-Path:.*\n" nil t)) - ;; We remove everything before the bounced mail. - (delete-region - (point-min) - (if (re-search-forward "^[^ \n\t]+:" nil t) - (match-beginning 0) - (point))) + (re-search-forward "\n\n+" nil t) + (setq boundary (point)) + ;; We remove everything before the bounced mail. + (if (or (re-search-forward message-unsent-separator nil t) + (progn + (search-forward "\n\n" nil 'move) + (re-search-backward "^Return-Path:.*\n" boundary t))) + (progn + (forward-line 1) + (delete-region (point-min) + (if (re-search-forward "^[^ \n\t]+:" nil t) + (match-beginning 0) + (point)))) + (goto-char boundary) (when (re-search-backward "^.?From .*\n" nil t) (delete-region (match-beginning 0) (match-end 0))))) (mm-enable-multibyte) - (mime-to-mml) (save-restriction (message-narrow-to-head-1) (message-remove-header message-ignored-bounced-headers t) @@ -6194,6 +6479,10 @@ which specify the range to operate on." (defalias 'message-make-overlay 'make-overlay) (defalias 'message-delete-overlay 'delete-overlay) (defalias 'message-overlay-put 'overlay-put) +(defun message-kill-all-overlays () + (if (featurep 'xemacs) + (map-extents (lambda (extent ignore) (delete-extent extent))) + (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))) ;; Support for toolbar (eval-when-compile @@ -6269,6 +6558,7 @@ which specify the range to operate on." "*Function to execute when `message-tab' (TAB) is executed in the body. If nil, the function bound in `text-mode-map' or `global-map' is executed." :group 'message + :link '(custom-manual "(message)Various Commands") :type 'function) (defun message-tab () @@ -6362,10 +6652,10 @@ The following arguments may contain lists of values." (list list)))) (defun message-generate-new-buffer-clone-locals (name &optional varstr) - "Create and return a buffer with name based on NAME using `generate-new-buffer.' + "Create and return a buffer with name based on NAME using `generate-new-buffer'. Then clone the local variables and values from the old buffer to the new one, cloning only the locals having a substring matching the -regexp varstr." +regexp VARSTR." (let ((oldbuf (current-buffer))) (save-excursion (set-buffer (generate-new-buffer name)) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 219c903..3475168 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -109,7 +109,7 @@ If no encoding was done, nil is returned." )))))) (defun mm-long-lines-p (length) - "Say whether any of the lines in the buffer is longer than LINES." + "Say whether any of the lines in the buffer is longer than LENGTH." (save-excursion (goto-char (point-min)) (end-of-line) @@ -130,8 +130,9 @@ If no encoding was done, nil is returned." (longp (mm-long-lines-p 1000))) (require 'message) (cond - ((and (not mm-use-ultra-safe-encoding) - (not longp) + ((and (not longp) + (not (and mm-use-ultra-safe-encoding + (save-excursion (re-search-forward "^From " nil t)))) (eq bits '7bit)) bits) ((and (not mm-use-ultra-safe-encoding) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 3cf9a0b..80a2d96 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -100,20 +100,23 @@ (defcustom mm-text-html-renderer (cond ((locate-library "w3") 'w3) ((locate-library "w3m") 'w3m) + ((executable-find "w3m") 'w3m-standalone) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) (t 'html2text)) "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: -`w3' : using Emacs/W3; -`w3m' : using emacs-w3m; -`links': using links; -`lynx' : using lynx; -`html2text' : using html2text; -nil : using external viewer." +`w3' : use Emacs/W3; +`w3m' : use emacs-w3m; +`w3m-standalone': use w3m; +`links': use links; +`lynx' : use lynx; +`html2text' : use html2text; +nil : use external viewer." :type '(choice (const w3) (const w3m) + (const w3m-standalone) (const links) (const lynx) (const html2text) @@ -127,20 +130,24 @@ nil : using external viewer." It is suggested to customize `mm-text-html-renderer' instead.") (defcustom mm-inline-text-html-with-images nil - "If non-nil, Gnus will allow retrieving images in the HTML contents -with tags. It has no effect on Emacs/w3. See also -the documentation for the option `mm-w3m-safe-url-regexp'." + "If non-nil, Gnus will allow retrieving images in HTML contents with +the tags. It has no effect on Emacs/w3. See also the +documentation for the `mm-w3m-safe-url-regexp' variable." :type 'boolean :group 'mime-display) (defcustom mm-w3m-safe-url-regexp "\\`cid:" - "Regexp that matches safe url names. Some HTML mails might have a -trick of spammers using tags. It is likely to be intended to -verify whether you have read the mail. You can prevent your personal -informations from leaking by setting this to the regexp which matches -the safe url names. The value of the variable `w3m-safe-url-regexp' -will be bound with this value. You may set this value to nil if you -consider all the urls to be safe." + "Regexp matching URLs which are considered to be safe. +Some HTML mails might contain a nasty trick used by spammers, using +the tag which is far more evil than the [Click Here!] button. +It is most likely intended to check whether the ominous spam mail has +reached your eyes or not, in which case the spammer knows for sure +that your email address is valid. It is done by embedding an +identifier string into a URL that you might automatically retrieve +when displaying the image. The default value is \"\\\\`cid:\" which only +matches parts embedded to the Multipart/Related type MIME contents and +Gnus will never connect to the spammer's site arbitrarily. You may +set this variable to nil if you consider all urls to be safe." :type '(choice (regexp :tag "Regexp") (const :tag "All URLs are safe" nil)) :group 'mime-display) @@ -151,7 +158,7 @@ consider all the urls to be safe." :group 'mime-display) (defcustom mm-inline-media-tests - '(("image/jpeg" + '(("image/p?jpeg" mm-inline-image (lambda (handle) (mm-valid-and-fit-image-p 'jpeg handle))) @@ -237,7 +244,7 @@ consider all the urls to be safe." ;; Default to displaying as text (".*" mm-inline-text mm-readable-p)) "Alist of media types/tests saying whether types can be displayed inline." - :type '(repeat (list (string :tag "MIME type") + :type '(repeat (list (regexp :tag "MIME type") (function :tag "Display function") (function :tag "Display test"))) :group 'mime-display) @@ -322,11 +329,14 @@ to: :type 'boolean :group 'mime-display) -(defvar mm-file-name-rewrite-functions nil +(defvar mm-file-name-rewrite-functions + '(mm-file-name-delete-control mm-file-name-delete-gotchas) "*List of functions used for rewriting file names of MIME parts. Each function takes a file name as input and returns a file name. Ready-made functions include +`mm-file-name-delete-control' +`mm-file-name-delete-gotchas' `mm-file-name-delete-whitespace', `mm-file-name-trim-whitespace', `mm-file-name-collapse-whitespace', @@ -351,6 +361,11 @@ If not set, `default-directory' will be used." :type '(choice directory (const :tag "Default" nil)) :group 'mime-display) +(defcustom mm-attachment-file-modes 384 + "Set the mode bits of saved attachments to this integer." + :type 'integer + :group 'mime-display) + (defcustom mm-external-terminal-program "xterm" "The program to start an external terminal." :type 'string @@ -384,7 +399,7 @@ If not set, `default-directory' will be used." (defcustom mm-verify-option 'never "Option of verifying signed parts. `never', not verify; `always', always verify; -`known', only verify known protocols. Otherwise, ask user." +`known', only verify known protocols. Otherwise, ask user." :type '(choice (item always) (item never) (item :tag "only known protocols" known) @@ -402,7 +417,7 @@ If not set, `default-directory' will be used." (defcustom mm-decrypt-option nil "Option of decrypting encrypted parts. `never', not decrypt; `always', always decrypt; -`known', only decrypt known protocols. Otherwise, ask user." +`known', only decrypt known protocols. Otherwise, ask user." :type '(choice (item always) (item never) (item :tag "only known protocols" known) @@ -458,8 +473,9 @@ The original alist is not modified. See also `destructive-alist-to-plist'." (throw 'found t)))))) (defun mm-handle-set-external-undisplayer (handle function) - "Set the undisplayer for this handle; postpone undisplaying of viewers -for types in mm-keep-viewer-alive-types." + "Set the undisplayer for HANDLE to FUNCTION. +Postpone undisplaying of viewers for types in +`mm-keep-viewer-alive-types'." (if (mm-keep-viewer-alive-p handle) (let ((new-handle (copy-sequence handle))) (mm-handle-set-undisplayer new-handle function) @@ -515,7 +531,8 @@ for types in mm-keep-viewer-alive-types." ((equal type "multipart") (let ((mm-dissect-default-type (if (equal subtype "digest") "message/rfc822" - "text/plain"))) + "text/plain")) + (start (cdr (assq 'start (cdr ctl))))) (add-text-properties 0 (length (car ctl)) (mm-alist-to-plist (cdr ctl)) (car ctl)) @@ -525,10 +542,9 @@ for types in mm-keep-viewer-alive-types." ;; the mm-handle API so we simply store the multipart buffert ;; name as a text property of the "multipart/whatever" string. (add-text-properties 0 (length (car ctl)) - (list 'buffer (mm-copy-to-buffer)) - (car ctl)) - (add-text-properties 0 (length (car ctl)) - (list 'from from) + (list 'buffer (mm-copy-to-buffer) + 'from from + 'start start) (car ctl)) (cons (car ctl) (mm-dissect-multipart ctl)))) (t @@ -842,9 +858,18 @@ external if displayed external." (funcall object)) ;; Externally displayed part. ((consp object) + (condition-case () + (while (get-buffer-process (cdr object)) + (interrupt-process (get-buffer-process (cdr object))) + (message "Waiting for external displayer to die...") + (sit-for 1)) + (quit) + (error)) + (ignore-errors (and (cdr object) (kill-buffer (cdr object)))) + (message "Waiting for external displayer to die...done") (ignore-errors (delete-file (car object))) - (ignore-errors (delete-directory (file-name-directory (car object)))) - (ignore-errors (and (cdr object) (kill-buffer (cdr object))))) + (ignore-errors (delete-directory (file-name-directory + (car object))))) ((bufferp object) (when (buffer-live-p object) (kill-buffer object))))) @@ -1001,13 +1026,22 @@ external if displayed external." (defun mm-file-name-replace-whitespace (file-name) "Replace whitespace characters in FILE-NAME with underscores. -Set `mm-file-name-replace-whitespace' to any other string if you do not -like underscores." +Set the option `mm-file-name-replace-whitespace' to any other +string if you do not like underscores." (let ((s (or mm-file-name-replace-whitespace "_"))) (while (string-match "\\s-" file-name) (setq file-name (replace-match s t t file-name)))) file-name) +(defun mm-file-name-delete-control (filename) + "Delete control characters from FILENAME." + (gnus-replace-in-string filename "[\x00-\x1f\x7f]" "")) + +(defun mm-file-name-delete-gotchas (filename) + "Delete shell gotchas from FILENAME." + (setq filename (gnus-replace-in-string filename "[<>|]" "")) + (gnus-replace-in-string filename "^[.-]+" "")) + (defun mm-save-part (handle) "Write HANDLE to a file." (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) @@ -1033,13 +1067,17 @@ like underscores." (mm-with-unibyte-buffer (mm-insert-part handle) (let ((coding-system-for-write 'binary) + (current-file-modes (default-file-modes)) ;; Don't re-compress .gz & al. Arguably we should make ;; `file-name-handler-alist' nil, but that would chop ;; ange-ftp, which is reasonable to use here. (inhibit-file-name-operation 'write-region) (inhibit-file-name-handlers (cons 'jka-compr-handler inhibit-file-name-handlers))) - (write-region (point-min) (point-max) file)))) + (set-default-file-modes mm-attachment-file-modes) + (unwind-protect + (write-region (point-min) (point-max) file) + (set-default-file-modes current-file-modes))))) (defun mm-pipe-part (handle) "Pipe HANDLE to a process." diff --git a/lisp/mm-url.el b/lisp/mm-url.el index 5fb925e..f6294e9 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -53,7 +53,7 @@ :group 'mm-url) (defvar mm-url-predefined-programs - '((wget "wget" "-q" "-O" "-") + '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-") (w3m "w3m" "-dump_source") (lynx "lynx" "-source") (curl "curl"))) @@ -272,7 +272,10 @@ This is taken from RFC 2396.") (require 'w3-vars) (require 'url))) +;;;###autoload (defun mm-url-insert-file-contents (url) + "Insert file contents of URL. +If `mm-url-use-external' is non-nil, use `mm-url-program'." (if mm-url-use-external (progn (if (string-match "^file:/+" url) @@ -280,7 +283,7 @@ This is taken from RFC 2396.") (mm-url-insert-file-contents-external url)) (goto-char (point-min)) (if (fboundp 'url-generic-parse-url) - (setq url-current-object + (setq url-current-object (url-generic-parse-url url))) (list url (buffer-size))) (mm-url-load-url) @@ -303,7 +306,9 @@ This is taken from RFC 2396.") (car result)))) result))) +;;;###autoload (defun mm-url-insert-file-contents-external (url) + "Insert file contents of URL using `mm-url-program'." (let (program args) (if (symbolp mm-url-program) (let ((item (cdr (assq mm-url-program mm-url-predefined-programs)))) @@ -311,7 +316,8 @@ This is taken from RFC 2396.") args (append (cdr item) (list url)))) (setq program mm-url-program args (append mm-url-arguments (list url)))) - (apply 'call-process program nil t nil args))) + (unless (eq 0 (apply 'call-process program nil t nil args)) + (error "Couldn't fetch %s" url)))) (defvar mm-url-timeout 30 "The number of seconds before timing out an URL fetch.") diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 3b18916..cbd85b1 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -145,6 +145,9 @@ In XEmacs, also return non-nil if CS is a coding system object." ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! ,@(unless (mm-coding-system-p 'iso-8859-15) '((iso-8859-15 . iso-8859-1))) + ;; BIG-5HKSCS is similar to, but different than, BIG-5. + ,@(unless (mm-coding-system-p 'big5-hkscs) + '((big5-hkscs . big5))) ;; Windows-1252 is actually a superset of Latin-1. See also ;; `gnus-article-dumbquotes-map'. ,@(unless (mm-coding-system-p 'windows-1252) @@ -308,12 +311,12 @@ Valid elements include: ;; Japanese users may prefer iso-2022-jp to shift-jis. '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis iso-latin-1 utf-8))))) - "Preferred coding systems for encoding outgoing mails. + "Preferred coding systems for encoding outgoing messages. -More than one suitable coding system may be found for some text. By -default, the coding system with the highest priority is used to encode -outgoing mails (see `sort-coding-systems'). If this variable is set, -it overrides the default priority." +More than one suitable coding system may be found for some text. +By default, the coding system with the highest priority is used +to encode outgoing messages (see `sort-coding-systems'). If this +variable is set, it overrides the default priority." :type '(repeat (symbol :tag "Coding system")) :group 'mime) @@ -410,7 +413,7 @@ used as the line break code type of the coding system." "Set the multibyte flag of the current buffer. Only do this if the default value of `enable-multibyte-characters' is non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte t)) + (set-buffer-multibyte 'to)) (defalias 'mm-enable-multibyte 'ignore)) (if mm-emacs-mule @@ -700,10 +703,10 @@ Equivalent to `progn' in XEmacs" (defun mm-insert-file-contents (filename &optional visit beg end replace inhibit) - "Like `insert-file-contents', q.v., but only reads in the file. + "Like `insert-file-contents', but only reads in the file. A buffer may be modified in several ways after reading into the buffer due to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. +`find-file-hooks', etc. If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. This function ensures that none of these modifications will take place." (let ((format-alist nil) @@ -742,7 +745,8 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (append mm-inhibit-file-name-handlers inhibit-file-name-handlers) inhibit-file-name-handlers))) - (append-to-file start end filename))) + (write-region start end filename t 'no-message) + (message "Appended to %s" filename))) (defun mm-write-region (start end filename &optional append visit lockname coding-system inhibit) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index accc32d..5db13b6 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -76,7 +76,7 @@ decoder, such as hexbin." This can be either \"inline\" or \"attachment\".") (defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources" - "The regexp of emacs sources groups.") + "The regexp of Emacs sources groups.") (defcustom mm-uu-diff-groups-regexp "gnus\\.commits" "*Regexp matching diff groups." @@ -335,7 +335,7 @@ Return that buffer." ((eq mm-verify-option 'never) nil) ((eq mm-verify-option 'always) t) ((eq mm-verify-option 'known) t) - (t (y-or-n-p "Verify pgp signed part?"))))) + (t (y-or-n-p "Verify pgp signed part? "))))) (eval-when-compile (defvar gnus-newsgroup-charset)) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 9de2f94..f6e4a66 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -54,7 +54,7 @@ (defvar mm-text-html-washer-alist '((w3 . gnus-article-wash-html-with-w3) (w3m . gnus-article-wash-html-with-w3m) - (w3m-standalone mm-inline-render-with-stdin nil + (w3m-standalone mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html") (links mm-inline-wash-with-file mm-links-remove-leading-blank @@ -197,27 +197,33 @@ (setq mm-w3m-setup t)) (setq w3m-display-inline-images mm-inline-text-html-with-images)) +(defun mm-w3m-cid-retrieve-1 (url handle) + (dolist (elem handle) + (when (and (listp elem) + (equal url (mm-handle-id elem))) + (mm-insert-part elem) + (throw 'found-handle (mm-handle-media-type elem))))) + (defun mm-w3m-cid-retrieve (url &rest args) "Insert a content pointed by URL if it has the cid: scheme." (when (string-match "\\`cid:" url) (setq url (concat "<" (substring url (match-end 0)) ">")) (catch 'found-handle - (dolist (handle (with-current-buffer w3m-current-buffer - gnus-article-mime-handles)) - (when (and (listp handle) - (equal url (mm-handle-id handle))) - (mm-insert-part handle) - (throw 'found-handle (mm-handle-media-type handle))))))) + (let ((handles (with-current-buffer w3m-current-buffer + gnus-article-mime-handles))) + (if (mm-multiple-handles handles) + (dolist (handle handles) + (mm-w3m-cid-retrieve-1 url handle)) + (mm-w3m-cid-retrieve-1 url handles)))))) (eval-and-compile (unless (or (featurep 'xemacs) (>= emacs-major-version 21)) (defvar mm-w3m-mode-map nil - "Keymap for text/html part rendered by `mm-w3m-preview-text/html'. -This map is overwritten by `mm-w3m-local-map-property' based on the -value of `w3m-minor-mode-map'. Therefore, in order to add some -commands to this map, add them to `w3m-minor-mode-map' instead of this -map."))) + "Keymap for text/html parts rendered by emacs-w3m. +This keymap will be bound only when Emacs 20 is running and overwritten +by the value of `w3m-minor-mode-map'. In order to add some commands to +this keymap, add them to `w3m-minor-mode-map' instead of this keymap."))) (defun mm-w3m-local-map-property () (when (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map) @@ -255,6 +261,7 @@ map."))) (add-text-properties (point-min) (point-max) (nconc (mm-w3m-local-map-property) + ;; Put the mark meaning this part was rendered by emacs-w3m. '(mm-inline-text-html-with-w3m t))))) (mm-handle-set-undisplayer handle @@ -439,7 +446,8 @@ map."))) gnus-article-prepare-hook (gnus-newsgroup-charset (or charset gnus-newsgroup-charset))) - (run-hooks 'gnus-article-decode-hook) + (let ((gnus-original-article-buffer (mm-handle-buffer handle))) + (run-hooks 'gnus-article-decode-hook)) (gnus-article-prepare-display) (setq handles gnus-article-mime-handles)) (goto-char (point-min)) diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el index c18cf2f..757a0f8 100644 --- a/lisp/mml-sec.el +++ b/lisp/mml-sec.el @@ -55,17 +55,20 @@ (defcustom mml-signencrypt-style-alist '(("smime" separate) - ("pgp" separate) - ("pgpauto" separate) - ("pgpmime" separate)) + ("pgp" combined) + ("pgpauto" combined) + ("pgpmime" combined)) "Alist specifying if `signencrypt' results in two separate operations or not. The first entry indicates the MML security type, valid entries include the strings \"smime\", \"pgp\", and \"pgpmime\". The second entry is a symbol `separate' or `combined' where `separate' means that MML signs and encrypt messages in a two step process, and `combined' means that MML signs and encrypt the message in one step. -Note that the `combined' mode is NOT supported by all OpenPGP implementations, -in particular PGP version 2 does not support it!" + +Note that the output generated by using a `combined' mode is NOT +understood by all PGP implementations, in particular PGP version +2 does not support it! See Info node `(message)Security' for +details." :type '(repeat (list (choice (const :tag "S/MIME" "smime") (const :tag "PGP" "pgp") (const :tag "PGP/MIME" "pgpmime") diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el index 82d13df..45e06d7 100644 --- a/lisp/mml-smime.el +++ b/lisp/mml-smime.el @@ -34,6 +34,9 @@ (customize-variable 'smime-keys) (error "No S/MIME keys configured, use customize to add your key")) (smime-sign-buffer (cdr (assq 'keyfile cont))) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) (goto-char (point-max))) (defun mml-smime-encrypt (cont) diff --git a/lisp/mml.el b/lisp/mml.el index 77f49eb..5e35f16 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -54,6 +54,12 @@ These parameters are generated in Content-Disposition header if exists." :type '(repeat (symbol :tag "Parameter")) :group 'message) +(defcustom mml-insert-mime-headers-always nil + "If non-nil, always put Content-Type: text/plain at top of empty parts. +It is necessary to work against a bug in certain clients." + :type 'boolean + :group 'message) + (defvar mml-tweak-type-alist nil "A list of (TYPE . FUNCTION) for tweaking MML parts. TYPE is a string containing a regexp to match the MIME type. FUNCTION @@ -70,7 +76,7 @@ handle to tweak the part.") (defvar mml-tweak-sexp-alist '((mml-externalize-attachments . mml-tweak-externalize-attachments)) "A list of (SEXP . FUNCTION) for tweaking MML parts. -SEXP is a s-expression. If the evaluation of SEXP is non-nil, FUNCTION +SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION is called. FUNCTION is a Lisp function which is called with the MML handle to tweak the part.") @@ -210,12 +216,12 @@ one charsets.") (if (or (memq 'unknown-encoding mml-confirmation-set) (message-options-get 'unknown-encoding) (and (y-or-n-p "\ -Message contains characters with unknown encoding. Really send?") +Message contains characters with unknown encoding. Really send? ") (message-options-set 'unknown-encoding t))) (if (setq use-ascii (or (memq 'use-ascii mml-confirmation-set) (message-options-get 'use-ascii) - (and (y-or-n-p "Use ASCII as charset?") + (and (y-or-n-p "Use ASCII as charset? ") (message-options-set 'use-ascii t)))) (setq charsets (delq nil charsets)) (setq warn nil)) @@ -524,8 +530,11 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (funcall (cdr handler) cont) ;; No specific handler. Use default one. (let ((mml-boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" - type mml-boundary)) + (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" + type mml-boundary) + (if (cdr (assq 'start cont)) + (format "; start=\"%s\"\n" (cdr (assq 'start cont))) + "\n")) (let ((cont cont) part) (while (setq part (pop cont)) ;; Skip `multipart' and attributes. @@ -601,17 +610,18 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." mml-base-boundary)) (defun mml-insert-mime-headers (cont type charset encoding flowed) - (let (parameters disposition description) + (let (parameters id disposition description) (setq parameters (mml-parameter-string cont mml-content-type-parameters)) (when (or charset parameters flowed - (not (equal type mml-generate-default-type))) + (not (equal type mml-generate-default-type)) + mml-insert-mime-headers-always) (when (consp charset) (error - "Can't encode a part with several charsets.")) + "Can't encode a part with several charsets")) (insert "Content-Type: " type) (when charset (insert "; " (mail-header-encode-parameter @@ -622,6 +632,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (mml-insert-parameter-string cont mml-content-type-parameters)) (insert "\n")) + (when (setq id (cdr (assq 'id cont))) + (insert "Content-ID: " id "\n")) (setq parameters (mml-parameter-string cont mml-content-disposition-parameters)) @@ -748,10 +760,12 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (insert "<#/multipart>\n")) (textp (let ((charset (mail-content-type-get - (mm-handle-type handle) 'charset))) + (mm-handle-type handle) 'charset)) + (start (point))) (if (eq charset 'gnus-decoded) (mm-insert-part handle) - (insert (mm-decode-string (mm-get-part handle) charset)))) + (insert (mm-decode-string (mm-get-part handle) charset))) + (mml-quote-region start (point))) (goto-char (point-max))) (t (insert "<#/part>\n"))))) @@ -759,8 +773,12 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) "Take a MIME handle and insert an MML tag." (if (stringp (car handle)) - (insert "<#multipart type=" (mm-handle-media-subtype handle) - ">\n") + (progn + (insert "<#multipart type=" (mm-handle-media-subtype handle)) + (let ((start (mm-handle-multipart-ctl-parameter handle 'start))) + (when start + (insert " start=\"" start "\""))) + (insert ">\n")) (if mmlp (insert "<#mml type=" (mm-handle-media-type handle)) (insert "<#part type=" (mm-handle-media-type handle))) @@ -768,6 +786,8 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (cdr (mm-handle-disposition handle)))) (unless (symbolp (cdr elem)) (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))) + (when (mm-handle-id handle) + (insert " id=\"" (mm-handle-id handle) "\"")) (when (mm-handle-disposition handle) (insert " disposition=" (car (mm-handle-disposition handle)))) (when buffer diff --git a/lisp/mml1991.el b/lisp/mml1991.el index 60c3156..50daea8 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -223,7 +223,7 @@ (defvar pgg-errors-buffer) (defun mml1991-pgg-sign (cont) - (let (headers) + (let (headers cte) ;; Don't sign headers. (goto-char (point-min)) (while (not (looking-at "^$")) @@ -232,31 +232,39 @@ (setq headers (buffer-substring (point-min) (point))) (forward-line) ;; skip header/body separator (delete-region (point-min) (point))) - (quoted-printable-decode-region (point-min) (point-max)) + (when (string-match "^Content-Transfer-Encoding: \\(.+\\)" headers) + (setq cte (intern (match-string 1 headers)))) + (mm-decode-content-transfer-encoding cte) (unless (let ((pgg-default-user-id - (or (message-options-get 'message-sender) + (or (message-options-get 'mml-sender) pgg-default-user-id))) (pgg-sign-region (point-min) (point-max) t)) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) (delete-region (point-min) (point-max)) - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (quoted-printable-encode-region (point-min) (point-max)) - (goto-char (point-min)) - (if headers (insert headers)) - (insert "\n") + (mm-with-unibyte-current-buffer + (insert-buffer-substring pgg-output-buffer) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (mm-encode-content-transfer-encoding cte) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n")) t)) (defun mml1991-pgg-encrypt (cont &optional sign) - (let (headers) + (let (cte) ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) + (while (looking-at "^Content[^ ]+:") + (when (looking-at "^Content-Transfer-Encoding: \\(.+\\)") + (setq cte (intern (match-string 1)))) + (forward-line)) (unless (bobp) (delete-region (point-min) (point))) + (mm-decode-content-transfer-encoding cte) (unless (pgg-encrypt-region (point-min) (point-max) (split-string diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index 504fdca..9a1b353 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -349,7 +349,10 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (setq result (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -365,7 +368,10 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) diff --git a/lisp/nndiary.el b/lisp/nndiary.el index 42cb838..51cbd9a 100644 --- a/lisp/nndiary.el +++ b/lisp/nndiary.el @@ -759,7 +759,9 @@ all. This may very well take some time.") (when (nndiary-schedule) (let (result) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject"))) (if (stringp group) (and (nnmail-activate 'nndiary) diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 28b783d..169ea63 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -394,7 +394,7 @@ from the document.") (error "Document is not of any recognized type")) (if result (car entry) - (cadar (sort results 'car-less-than-car))))) + (cadar (last (sort results 'car-less-than-car)))))) ;;; ;;; Built-in type predicates and functions @@ -772,7 +772,7 @@ from the document.") "Go through the document and partition it into heads/bodies/articles." (let ((i 0) (first t) - head-begin head-end body-begin body-end) + art-begin head-begin head-end body-begin body-end) (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) @@ -788,8 +788,11 @@ from the document.") ;; Go through the file. (while (if (and first nndoc-first-article) (nndoc-search nndoc-first-article) - (nndoc-article-begin)) - (setq first nil) + (if art-begin + (goto-char art-begin) + (nndoc-article-begin))) + (setq first nil + art-begin nil) (cond (nndoc-head-begin-function (funcall nndoc-head-begin-function)) (nndoc-head-begin @@ -809,7 +812,8 @@ from the document.") (funcall nndoc-body-end-function)) (and nndoc-body-end (nndoc-search nndoc-body-end)) - (nndoc-article-begin) + (and (nndoc-article-begin) + (setq art-begin (point))) (progn (goto-char (point-max)) (when nndoc-file-end diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 2b384b0..5685084 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -199,9 +199,19 @@ (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)))) + (let ((buf (get-buffer-create " *nndraft move*")) + result) + (and + (nndraft-request-article article group server) + (save-excursion + (set-buffer buf) + (erase-buffer) + (insert-buffer-substring nntp-server-buffer) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result) + (null (nndraft-request-expire-articles (list article) group server 'force)) + result))) (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index ce3da7e..4ac87bc 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -524,7 +524,10 @@ the group. Then the marks file will be regenerated properly by Gnus.") (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (setq result (if (stringp group) (list (cons group (nnfolder-active-number group))) (setq art-group diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 9debd98..01b573c 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -74,10 +74,10 @@ Integer values will in effect be rounded up to the nearest multiple of (defvar nnheader-read-timeout (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" (symbol-name system-type)) - 1.0 + 1.0 ; why? 0.1) "How long nntp should wait between checking for the end of output. -Shorter values mean quicker response, but is more CPU intensive.") +Shorter values mean quicker response, but are more CPU intensive.") (defvar nnheader-file-name-translation-alist (let ((case-fold-search t)) @@ -856,11 +856,6 @@ without formatting." ((numberp file) (int-to-string file)) (t file)))) -(defun nnheader-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - (defun nnheader-concat (dir &rest files) "Concat DIR as directory to FILES." (apply 'concat (file-name-as-directory dir) files)) @@ -874,13 +869,15 @@ without formatting." "Return the file size of FILE or 0." (or (nth 7 (file-attributes file)) 0)) -(defun nnheader-find-etc-directory (package &optional file) +(defun nnheader-find-etc-directory (package &optional file first) "Go through `load-path' and find the \"../etc/PACKAGE\" directory. This function will look in the parent directory of each `load-path' entry, and look for the \"etc\" directory there. -If FILE, find the \".../etc/PACKAGE\" file instead." +If FILE, find the \".../etc/PACKAGE\" file instead. +If FIRST is non-nil, return the directory or the file found at the +first. Otherwise, find the newest one, though it may take a time." (let ((path load-path) - dir result) + dir results) ;; We try to find the dir by looking at the load path, ;; stripping away the last component and adding "etc/". (while path @@ -892,10 +889,14 @@ If FILE, find the \".../etc/PACKAGE\" file instead." "etc/" package (if file "" "/")))) (or file (file-directory-p dir))) - (setq result dir - path nil) + (progn + (or (member dir results) + (push dir results)) + (setq path (if first nil (cdr path)))) (setq path (cdr path)))) - result)) + (if (or first (not (cdr results))) + (car results) + (car (sort results 'file-newer-than-file-p))))) (eval-when-compile (defvar ange-ftp-path-format) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index 972067b..5b6805a 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -1,6 +1,6 @@ ;;; nnheaderxm.el --- making Gnus backends work under XEmacs -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -27,12 +27,67 @@ ;;; Code: -(defun nnheader-xmas-run-at-time (time repeat function &rest args) - (start-itimer - "nnheader-run-at-time" - `(lambda () - (,function ,@args)) - time repeat)) +(if (condition-case nil + (progn + (unless (or itimer-process itimer-timer) + (itimer-driver-start)) + ;; Check whether there is a bug to which the difference of + ;; the present time and the time when the itimer driver was + ;; woken up is subtracted from the initial itimer value. + (let* ((inhibit-quit t) + (ctime (current-time)) + (itimer-timer-last-wakeup + (prog1 + ctime + (setcar ctime (1- (car ctime))))) + (itimer-list nil) + (itimer (start-itimer "nnheader-run-at-time" 'ignore 5))) + (sleep-for 0.1) ;; Accept the timeout interrupt. + (prog1 + (> (itimer-value itimer) 0) + (delete-itimer itimer)))) + (error nil)) + (defun nnheader-xmas-run-at-time (time repeat function &rest args) + "Emulating function run as `run-at-time'. +TIME should be nil meaning now, or a number of seconds from now. +Return an itimer object which can be used in either `delete-itimer' +or `cancel-timer'." + (apply #'start-itimer "nnheader-run-at-time" + function (if time (max time 1e-9) 1e-9) + repeat nil t args)) + (defun nnheader-xmas-run-at-time (time repeat function &rest args) + "Emulating function run as `run-at-time' in the right way. +TIME should be nil meaning now, or a number of seconds from now. +Return an itimer object which can be used in either `delete-itimer' +or `cancel-timer'." + (let ((itimers (list nil))) + (setcar + itimers + (apply #'start-itimer "nnheader-run-at-time" + (lambda (itimers repeat function &rest args) + (let ((itimer (car itimers))) + (if repeat + (progn + (set-itimer-function + itimer + (lambda (itimer repeat function &rest args) + (set-itimer-restart itimer repeat) + (set-itimer-function itimer function) + (set-itimer-function-arguments itimer args) + (apply function args))) + (set-itimer-function-arguments + itimer + (append (list itimer repeat function) args))) + (set-itimer-function + itimer + (lambda (itimer function &rest args) + (delete-itimer itimer) + (apply function args))) + (set-itimer-function-arguments + itimer + (append (list itimer function) args))))) + 1e-9 (if time (max time 1e-9) 1e-9) + nil t itimers repeat function args))))) (defalias 'nnheader-run-at-time 'nnheader-xmas-run-at-time) (defalias 'nnheader-cancel-timer 'delete-itimer) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 31a7837..cf33d13 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -70,6 +70,8 @@ (require 'gnus-start) (require 'gnus-int) +(eval-when-compile (require 'cl)) + (nnoo-declare nnimap) (defconst nnimap-version "nnimap 1.0") @@ -718,9 +720,11 @@ If EXAMINE is non-nil the group is selected read-only." (port (if nnimap-server-port (int-to-string nnimap-server-port) "imap")) - (alist (gnus-netrc-machine list (or nnimap-server-address - nnimap-address server) - port "imap")) + (alist (or (gnus-netrc-machine list server port "imap") + (gnus-netrc-machine list + (or nnimap-server-address + nnimap-address) + port "imap"))) (user (gnus-netrc-get alist "login")) (passwd (gnus-netrc-get alist "password"))) (if (imap-authenticate user passwd nnimap-server-buffer) @@ -1271,7 +1275,7 @@ function is generally only called when Gnus is shutting down." nnimap-split-download-body-default nnimap-split-download-body) (and (nnimap-request-article article) - (mail-narrow-to-head)) + (with-current-buffer nntp-server-buffer (mail-narrow-to-head))) (nnimap-request-head article)) ;; copy article to right group(s) (setq removeorig nil) @@ -1290,7 +1294,9 @@ function is generally only called when Gnus is shutting down." (let (msgid) (and (setq msgid (nnmail-fetch-field "message-id")) - (nnmail-cache-insert msgid to-group))))) + (nnmail-cache-insert msgid + to-group + (nnmail-fetch-field "subject")))))) ;; Add the group-art list to the history list. (push (list (cons to-group 0)) nnmail-split-history)) (t @@ -1324,7 +1330,7 @@ function is generally only called when Gnus is shutting down." (nnimap-before-find-minmax-bugworkaround) (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) - (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil + (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil nnimap-server-buffer)) (or (catch 'found (dolist (mailbox (imap-mailbox-get 'list-flags mbx @@ -1467,7 +1473,8 @@ function is generally only called when Gnus is shutting down." (replace-match "\r\n")) (when nnmail-cache-accepted-message-ids (nnmail-cache-insert (nnmail-fetch-field "message-id") - group))) + group + (nnmail-fetch-field "subject")))) (when (and last nnmail-cache-accepted-message-ids) (nnmail-cache-close)) ;; this 'or' is for Cyrus server bug diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 1f15ab3..c5d9392 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -356,13 +356,77 @@ discarded after running the split process." :type 'hook) (defcustom nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup or nil. -If the number of the articles is greater than the value, verbose + "*The number of articles which indicates a large newsgroup or nil. +If the number of articles is greater than the value, verbose messages will be shown to indicate the current status." :group 'nnmail-various :type '(choice (const :tag "infinite" nil) (number :tag "count"))) +(define-widget 'nnmail-lazy 'default + "Base widget for recursive datastructures. + +This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility." + :format "%{%t%}: %v" + :convert-widget 'widget-value-convert-widget + :value-create (lambda (widget) + (let ((value (widget-get widget :value)) + (type (widget-get widget :type))) + (widget-put widget :children + (list (widget-create-child-value + widget (widget-convert type) value))))) + :value-delete 'widget-children-value-delete + :value-get (lambda (widget) + (widget-value (car (widget-get widget :children)))) + :value-inline (lambda (widget) + (widget-apply (car (widget-get widget :children)) + :value-inline)) + :default-get (lambda (widget) + (widget-default-get + (widget-convert (widget-get widget :type)))) + :match (lambda (widget value) + (widget-apply (widget-convert (widget-get widget :type)) + :match value)) + :validate (lambda (widget) + (widget-apply (car (widget-get widget :children)) :validate))) + +(define-widget 'nnmail-split-fancy 'nnmail-lazy + "Widget for customizing splits in the variable of the same name." + :tag "Split" + :type '(menu-choice :value (any ".*value.*" "misc") + :tag "Type" + (string :tag "Destination") + (list :tag "Use first match (|)" :value (|) + (const :format "" |) + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Use all matches (&)" :value (&) + (const :format "" &) + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Function with fixed arguments (:)" + :value (: nil) + (const :format "" :value :) + function + (editable-list :inline t (sexp :tag "Arg")) + ) + (list :tag "Function with split arguments (!)" + :value (! nil) + (const :format "" !) + function + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Field match" + (choice :tag "Field" + regexp symbol) + (choice :tag "Match" + regexp + (symbol :value mail)) + (repeat :inline t + :tag "Restrictions" + (group :inline t + (const :format "" -) + regexp)) + nnmail-split-fancy) + (const :tag "Junk (delete mail)" junk))) + (defcustom nnmail-split-fancy "mail.misc" "Incoming mail can be split according to this fancy variable. To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. @@ -438,8 +502,7 @@ Example: ;; Unmatched mail goes to the catch all group. \"misc.misc\"))" :group 'nnmail-split - ;; Sigh! - :type 'sexp) + :type 'nnmail-split-fancy) (defcustom nnmail-split-abbrev-alist '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") @@ -503,6 +566,15 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type 'boolean) +(defcustom nnmail-split-fancy-match-partial-words nil + "Whether to match partial words when fancy splitting. +Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded +by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ + surrounded +by anything." + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -511,13 +583,12 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-split-history nil "List of group/article elements that say where the previous split put messages.") -(defvar nnmail-split-fancy-syntax-table nil +(defvar nnmail-split-fancy-syntax-table + (let ((table (make-syntax-table))) + ;; support the %-hack + (modify-syntax-entry ?\% "." table) + table) "Syntax table used by `nnmail-split-fancy'.") -(unless (syntax-table-p nnmail-split-fancy-syntax-table) - (setq nnmail-split-fancy-syntax-table - (copy-syntax-table (standard-syntax-table))) - ;; support the %-hack - (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table)) (defvar nnmail-prepare-save-mail-hook nil "Hook called before saving mail.") @@ -527,11 +598,6 @@ parameter. It should return nil, `warn' or `delete'." -(defconst nnmail-version "nnmail 1.0" - "nnmail version.") - - - (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) @@ -1102,7 +1168,10 @@ FUNC will be called with the group name to determine the article number." (unless group-art (setq group-art (list (cons (car method) - (funcall func (car method))))))))) + (funcall func (car method)))))))) + ;; Fall back on "bogus" if all else fails. + (unless group-art + (setq group-art (list (cons "bogus" (funcall func "bogus")))))) ;; Produce a trace if non-empty. (when (and trace nnmail-split-trace) (let ((restore (current-buffer))) @@ -1342,8 +1411,9 @@ See the documentation for the variable `nnmail-split-fancy' for details." (t (let* ((field (nth 0 split)) (value (nth 1 split)) - partial-front regexp - partial-rear regexp) + partial-front + partial-rear + regexp) (if (symbolp value) (setq value (cdr (assq value nnmail-split-abbrev-alist)))) (if (and (>= (length value) 2) @@ -1355,6 +1425,9 @@ See the documentation for the variable `nnmail-split-fancy' for details." (string= ".*" (substring value -2))) (setq value (substring value 0 -2) partial-rear "")) + (when nnmail-split-fancy-match-partial-words + (setq partial-front "" + partial-rear "")) (setq regexp (concat "^\\(\\(" (if (symbolp field) (cdr (assq field nnmail-split-abbrev-alist)) @@ -1485,31 +1558,34 @@ See the documentation for the variable `nnmail-split-fancy' for details." (defvar group) (defvar group-art-list) (defvar group-art) -(defun nnmail-cache-insert (id grp) - (run-hook-with-args 'nnmail-spool-hook - id grp) - (when nnmail-treat-duplicates - ;; Store some information about the group this message is written - ;; to. This is passed in as the grp argument -- all locations this - ;; has been called from have been checked and the group is available. - ;; The only ambiguous case is nnmail-check-duplication which will only - ;; pass the first (of possibly >1) group which matches. -Josh - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (if (and grp (not (string= "" grp)) - (gnus-methods-equal-p gnus-command-method - (nnmail-cache-primary-mail-backend))) - (let ((regexp (if (consp nnmail-cache-ignore-groups) - (mapconcat 'identity nnmail-cache-ignore-groups - "\\|") - nnmail-cache-ignore-groups))) - (unless (and regexp (string-match regexp grp)) - (insert id "\t" grp "\n"))) - (insert id "\n"))))) - +(defun nnmail-cache-insert (id grp &optional subject sender) + (when (stringp id) + ;; this will handle cases like `B r' where the group is nil + (let ((grp (or grp gnus-newsgroup-name "UNKNOWN"))) + (run-hook-with-args 'nnmail-spool-hook + id grp subject sender)) + (when nnmail-treat-duplicates + ;; Store some information about the group this message is written + ;; to. This is passed in as the grp argument -- all locations this + ;; has been called from have been checked and the group is available. + ;; The only ambiguous case is nnmail-check-duplication which will only + ;; pass the first (of possibly >1) group which matches. -Josh + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) + (save-excursion + (set-buffer nnmail-cache-buffer) + (goto-char (point-max)) + (if (and grp (not (string= "" grp)) + (gnus-methods-equal-p gnus-command-method + (nnmail-cache-primary-mail-backend))) + (let ((regexp (if (consp nnmail-cache-ignore-groups) + (mapconcat 'identity nnmail-cache-ignore-groups + "\\|") + nnmail-cache-ignore-groups))) + (unless (and regexp (string-match regexp grp)) + (insert id "\t" grp "\n"))) + (insert id "\n")))))) + (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) (be nil) @@ -1596,7 +1672,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (cond ((memq nnmail-treat-duplicates '(warn delete)) nnmail-treat-duplicates) - ((nnheader-functionp nnmail-treat-duplicates) + ((functionp nnmail-treat-duplicates) (funcall nnmail-treat-duplicates message-id)) (t nnmail-treat-duplicates)))) @@ -1762,7 +1838,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (let (nnmail-cache-accepted-message-ids) ;; Don't enter Message-IDs into cache. ;; Let users hack it in TARGET function. - (when (nnheader-functionp target) + (when (functionp target) (setq target (funcall target group))) (unless (eq target 'delete) (when (or (gnus-request-group target) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index 9b35048..8afd19a 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -331,7 +331,10 @@ (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (setq result (if (stringp group) (list (cons group (nnmbox-active-number group))) (nnmail-article-group 'nnmbox-active-number))) diff --git a/lisp/nnmh.el b/lisp/nnmh.el index ee2dd79..414f20a 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -316,7 +316,10 @@ as unread by Gnus.") (nnmh-possibly-change-directory group server) (nnmail-check-syntax) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (nnheader-init-server-buffer) (prog1 (if (stringp group) diff --git a/lisp/nnml.el b/lisp/nnml.el index 822ffd4..0767962 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -369,7 +369,10 @@ marks file will be regenerated properly by Gnus.") (nnmail-check-syntax) (let (result) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") group)) + (nnmail-cache-insert (nnmail-fetch-field "message-id") + group + (nnmail-fetch-field "subject") + (nnmail-fetch-field "from"))) (if (stringp group) (and (nnmail-activate 'nnml) @@ -886,7 +889,8 @@ Use the nov database for that directory if available." (defun nnml-current-group-article-to-file-alist () "Return an alist of article/file pairs in the current group. Use the nov database for the current group if available." - (if (or gnus-nov-is-evil + (if (or nnml-use-compressed-files + gnus-nov-is-evil nnml-nov-is-evil (not (file-exists-p (expand-file-name nnml-nov-file-name diff --git a/lisp/nnrss.el b/lisp/nnrss.el index f42e101..35739a6 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -424,7 +424,7 @@ ARTICLE is the article number of the current headline.") (nnrss-translate-file-chars (concat group ".xml")) nnrss-directory)))) - (nnrss-fetch file t) + (setq xml (nnrss-fetch file t)) (setq url (or (nth 2 (assoc group nnrss-server-data)) (second (assoc group nnrss-group-alist)))) (unless url @@ -457,7 +457,8 @@ ARTICLE is the article number of the current headline.") (setq extra (or (nnrss-node-text content-ns 'encoded item) (nnrss-node-text rss-ns 'description item))) (setq author (or (nnrss-node-text rss-ns 'author item) - (nnrss-node-text dc-ns 'creator item))) + (nnrss-node-text dc-ns 'creator item) + (nnrss-node-text dc-ns 'contributor item))) (setq date (or (nnrss-node-text dc-ns 'date item) (nnrss-node-text rss-ns 'pubDate item) (message-make-date))) @@ -685,7 +686,9 @@ whether they are `offsite' or `onsite'." (defun nnrss-find-rss-via-syndic8 (url) "query syndic8 for the rss feeds it has for the url." (if (not (locate-library "xml-rpc")) - (message "XML-RPC is not available... not checking Syndic8.") + (progn + (message "XML-RPC is not available... not checking Syndic8.") + nil) (require 'xml-rpc) (let ((feedid (xml-rpc-method-call "http://www.syndic8.com/xmlrpc.php" diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 080c5e7..d4eba69 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -72,8 +72,8 @@ If you are using Cnews, you probably should set this variable to nil.") "Local news active date file.") (defvoo nnspool-large-newsgroup 50 - "The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose + "The number of articles which indicates a large newsgroup. +If the number of articles is greater than the value, verbose messages will be shown to indicate the current status.") (defvoo nnspool-nov-is-evil nil diff --git a/lisp/nntp.el b/lisp/nntp.el index c1228e5..4213bdc 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -139,8 +139,8 @@ If non-nil, there will be no prompt for a login name.") This variable is used by the `nntp-open-via-telnet-and-telnet' method.") (defvoo nntp-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose + "*The number of articles which indicates a large newsgroup. +If the number of articles is greater than the value, verbose messages will be shown to indicate the current status.") (defvoo nntp-maximum-request 400 @@ -470,8 +470,7 @@ be restored and the command retried." (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (gnus-point-at-bol)))) - ))) + (gnus-point-at-bol))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -1425,8 +1424,7 @@ password contained in '~/.nntp-authinfo'." in-process-buffer-p (buf nntp-server-buffer) (process-buffer (nntp-find-connection-buffer nntp-server-buffer)) - first - last) + first last status) ;; We have to check `nntp-server-xover'. If it gets set to nil, ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. @@ -1460,15 +1458,22 @@ password contained in '~/.nntp-authinfo'." (while (progn (goto-char (or last-point (point-min))) ;; Count replies. - (while (re-search-forward "^[0-9][0-9][0-9] .*\n" nil t) - (incf received)) + (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n" + nil t) + (incf received) + (setq status (match-string 1)) + (if (string-match "^[45]" status) + (setq status 'error) + (setq status 'ok))) (setq last-point (point)) (or (< received count) - ;; I haven't started reading the final response - (progn - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "^\\.\r?\n"))))) + (if (eq status 'error) + nil + ;; I haven't started reading the final response + (progn + (goto-char (point-max)) + (forward-line -1) + (not (looking-at "^\\.\r?\n")))))) ;; I haven't read the end of the final response (nntp-accept-response) (set-buffer process-buffer)))) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 402d865..893cd17 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -357,7 +357,7 @@ Valid types include `google', `dejanews', and `gmane'.") (setq Subject (buffer-string)) (goto-char (point-max)) (widen) - (forward-line 1) + (forward-line 2) (when (looking-at "
]+>") (goto-char (match-end 0))) (if (not (looking-at "]+>")) diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el index 9a5d7ff..5209ba4 100644 --- a/lisp/pgg-def.el +++ b/lisp/pgg-def.el @@ -43,7 +43,7 @@ :group 'pgg :type 'string) -(defcustom pgg-default-keyserver-address "wwwkeys.pgp.net" +(defcustom pgg-default-keyserver-address "subkeys.pgp.net" "Host name of keyserver." :group 'pgg :type 'string) @@ -53,7 +53,7 @@ :group 'pgg :type 'boolean) -(defcustom pgg-encrypt-for-me nil +(defcustom pgg-encrypt-for-me t "If t, encrypt all outgoing messages with user's public key." :group 'pgg :type 'boolean) diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el index 4a4f6f7..94c1b3a 100644 --- a/lisp/pgg-gpg.el +++ b/lisp/pgg-gpg.el @@ -25,13 +25,15 @@ ;;; Code: -(eval-when-compile (require 'pgg)) +(eval-when-compile + (require 'cl) ; for gpg macros + (require 'pgg)) (defgroup pgg-gpg () "GnuPG interface" :group 'pgg) -(defcustom pgg-gpg-program "gpg" +(defcustom pgg-gpg-program "gpg" "The GnuPG executable." :group 'pgg-gpg :type 'string) @@ -39,20 +41,23 @@ (defcustom pgg-gpg-extra-args nil "Extra arguments for every GnuPG invocation." :group 'pgg-gpg - :type '(choice - (const :tag "None" nil) - (string :tag "Arguments"))) + :type '(repeat (string :tag "Argument"))) + +(defcustom pgg-gpg-recipient-argument "--recipient" + "GnuPG option to specify recipient." + :group 'pgg-gpg + :type '(choice (const :tag "New `--recipient' option" "--recipient") + (const :tag "Old `--remote-user' option" "--remote-user"))) (defvar pgg-gpg-user-id nil "GnuPG ID of your default identity.") (defun pgg-gpg-process-region (start end passphrase program args) - (let* ((output-file-name - (expand-file-name (make-temp-name "pgg-output") - pgg-temporary-file-directory)) + (let* ((output-file-name (pgg-make-temp-file "pgg-output")) (args `("--status-fd" "2" ,@(if passphrase '("--passphrase-fd" "0")) + "--yes" ; overwrite "--output" ,output-file-name ,@pgg-gpg-extra-args ,@args)) (output-buffer pgg-output-buffer) @@ -66,15 +71,16 @@ (unwind-protect (progn (set-default-file-modes 448) - (let* ((coding-system-for-write 'binary) - (input (buffer-substring-no-properties start end))) - (with-temp-buffer - (when passphrase - (insert passphrase "\n")) - (insert input) - (setq exit-status - (apply #'call-process-region (point-min) (point-max) program - nil errors-buffer nil args)))) + (let ((coding-system-for-write 'binary) + (input (buffer-substring-no-properties start end)) + (default-enable-multibyte-characters nil)) + (with-temp-buffer + (when passphrase + (insert passphrase "\n")) + (insert input) + (setq exit-status + (apply #'call-process-region (point-min) (point-max) program + nil errors-buffer nil args)))) (with-current-buffer (get-buffer-create output-buffer) (buffer-disable-undo) (erase-buffer) @@ -84,24 +90,45 @@ (set-buffer errors-buffer) (if (not (equal exit-status 0)) (insert (format "\n%s exited abnormally: '%s'\n" - program exit-status))))) + program exit-status))))) (if (file-exists-p output-file-name) (delete-file output-file-name)) (set-default-file-modes orig-mode)))) -(defun pgg-gpg-possibly-cache-passphrase (passphrase) +(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key) (if (and pgg-cache-passphrase (progn (goto-char (point-min)) (re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t))) (pgg-add-passphrase-cache - (progn - (goto-char (point-min)) - (if (re-search-forward - "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t) - (substring (match-string 0) -8))) + (or key + (progn + (goto-char (point-min)) + (if (re-search-forward + "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t) + (substring (match-string 0) -8)))) passphrase))) +(defvar pgg-gpg-all-secret-keys 'unknown) + +(defun pgg-gpg-lookup-all-secret-keys () + "Return all secret keys present in secret key ring." + (when (eq pgg-gpg-all-secret-keys 'unknown) + (setq pgg-gpg-all-secret-keys '()) + (let ((args (list "--with-colons" "--no-greeting" "--batch" + "--list-secret-keys"))) + (with-temp-buffer + (apply #'call-process pgg-gpg-program nil t nil args) + (goto-char (point-min)) + (while (re-search-forward "^\\(sec\\|pub\\):" nil t) + (push (substring + (nth 3 (split-string + (buffer-substring (match-end 0) + (progn (end-of-line) (point))) + ":")) 8) + pgg-gpg-all-secret-keys))))) + pgg-gpg-all-secret-keys) + (defun pgg-gpg-lookup-key (string &optional type) "Search keys associated with STRING." (let ((args (list "--with-colons" "--no-greeting" "--batch" @@ -125,7 +152,7 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt." (when sign (pgg-read-passphrase (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt)))) + pgg-gpg-user-id))) (args (append (list "--batch" "--armor" "--always-trust" "--encrypt") @@ -133,7 +160,7 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt." (if recipients (apply #'nconc (mapcar (lambda (rcpt) - (list "--remote-user" rcpt)) + (list pgg-gpg-recipient-argument rcpt)) (append recipients (if pgg-encrypt-for-me (list pgg-gpg-user-id))))))))) @@ -141,30 +168,47 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt." (pgg-gpg-process-region start end passphrase pgg-gpg-program args)) (when sign (with-current-buffer pgg-errors-buffer + ;; Possibly cache passphrase under, e.g. "jas", for future sign. + (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) + ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt. (pgg-gpg-possibly-cache-passphrase passphrase))) (pgg-process-when-success))) (defun pgg-gpg-decrypt-region (start end) "Decrypt the current region between START and END." - (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) + (let* ((current-buffer (current-buffer)) + (message-keys (with-temp-buffer + (insert-buffer-substring current-buffer) + (pgg-decode-armor-region (point-min) (point-max)))) + (secret-keys (pgg-gpg-lookup-all-secret-keys)) + (key (pgg-gpg-select-matching-key message-keys secret-keys)) + (pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id)) (passphrase (pgg-read-passphrase (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - (pgg-gpg-lookup-key pgg-gpg-user-id 'encrypt))) + pgg-gpg-user-id)) (args '("--batch" "--decrypt"))) (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (with-current-buffer pgg-errors-buffer - (pgg-gpg-possibly-cache-passphrase passphrase) + (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) (goto-char (point-min)) (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t)))) +(defun pgg-gpg-select-matching-key (message-keys secret-keys) + "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS." + (loop for message-key in message-keys + for message-key-id = (and (equal (car message-key) 1) + (cdr (assq 'key-identifier message-key))) + for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt)) + when (and key (member key secret-keys)) return key)) + (defun pgg-gpg-sign-region (start end &optional cleartext) "Make detached signature from text between START and END." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) (passphrase (pgg-read-passphrase (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - (pgg-gpg-lookup-key pgg-gpg-user-id 'sign))) + pgg-gpg-user-id)) (args (list (if cleartext "--clearsign" "--detach-sign") "--armor" "--batch" "--verbose" @@ -174,6 +218,9 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt." (pgg-as-lbt start end 'CRLF (pgg-gpg-process-region start end passphrase pgg-gpg-program args)) (with-current-buffer pgg-errors-buffer + ;; Possibly cache passphrase under, e.g. "jas", for future sign. + (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) + ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt. (pgg-gpg-possibly-cache-passphrase passphrase)) (pgg-process-when-success))) diff --git a/lisp/pgg-parse.el b/lisp/pgg-parse.el index bff16f0..1515887 100644 --- a/lisp/pgg-parse.el +++ b/lisp/pgg-parse.el @@ -47,21 +47,21 @@ '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG)) "Alist of the assigned number to the public key algorithm." :group 'pgg-parse - :type '(repeat + :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-parse-symmetric-key-algorithm-alist '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128)) "Alist of the assigned number to the simmetric key algorithm." :group 'pgg-parse - :type '(repeat + :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-parse-hash-algorithm-alist '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2)) "Alist of the assigned number to the cryptographic hash algorithm." :group 'pgg-parse - :type '(repeat + :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-parse-compression-algorithm-alist @@ -70,7 +70,7 @@ (2 . ZLIB)) "Alist of the assigned number to the compression algorithm." :group 'pgg-parse - :type '(repeat + :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-parse-signature-type-alist @@ -89,7 +89,7 @@ (64 . "Timestamp signature.")) "Alist of the assigned number to the signature type." :group 'pgg-parse - :type '(repeat + :type '(repeat (cons (sexp :tag "Number") (sexp :tag "Type")))) (defcustom pgg-ignore-packet-checksum t; XXX @@ -276,7 +276,7 @@ (list (pgg-byte-after (+ (cdr length-type) (point))) (1- (car length-type)) (1+ (cdr length-type))))) - + (defun pgg-parse-signature-subpacket (ptag) (case (car ptag) (2 ;signature creation time @@ -293,7 +293,7 @@ (cons 'trust-level (pgg-read-byte))) (6 ;regular expression (cons 'regular-expression - (pgg-read-body-string ptag))) + (pgg-read-body-string ptag))) (7 ;revocable (cons 'revocability (pgg-read-byte))) (9 ;key expiration time @@ -303,13 +303,13 @@ ;; 10 = placeholder for backward compatibility (11 ;preferred symmetric algorithms (cons 'preferred-symmetric-key-algorithm - (cdr (assq (pgg-read-byte) - pgg-parse-symmetric-key-algorithm-alist)))) + (cdr (assq (pgg-read-byte) + pgg-parse-symmetric-key-algorithm-alist)))) (12 ;revocation key ) (16 ;issuer key ID (cons 'key-identifier - (pgg-format-key-identifier (pgg-read-body-string ptag)))) + (pgg-format-key-identifier (pgg-read-body-string ptag)))) (20 ;notation data (pgg-skip-bytes 4) (cons 'notation @@ -323,12 +323,12 @@ (nth 1 value-bytes))))))) (21 ;preferred hash algorithms (cons 'preferred-hash-algorithm - (cdr (assq (pgg-read-byte) - pgg-parse-hash-algorithm-alist)))) + (cdr (assq (pgg-read-byte) + pgg-parse-hash-algorithm-alist)))) (22 ;preferred compression algorithms (cons 'preferred-compression-algorithm - (cdr (assq (pgg-read-byte) - pgg-parse-compression-algorithm-alist)))) + (cdr (assq (pgg-read-byte) + pgg-parse-compression-algorithm-alist)))) (23 ;key server preferences (cons 'key-server-preferences (pgg-read-body ptag))) @@ -381,7 +381,7 @@ (when (>= 10000 (setq n (pgg-read-bytes 2) n (logior (lsh (car n) 8) (nth 1 n)))) - (save-restriction + (save-restriction (narrow-to-region (point)(+ n (point))) (nconc result (mapcar (function cdr) ;remove packet types @@ -462,22 +462,25 @@ (cdr (assq (cdr field) pgg-parse-public-key-algorithm-alist))) result)) - + (defun pgg-decode-packets () - (let* ((marker - (set-marker (make-marker) - (and (re-search-forward "^=") - (match-beginning 0)))) - (checksum (buffer-substring (point) (+ 4 (point))))) - (delete-region marker (point-max)) - (base64-decode-region (point-min) marker) - (when (fboundp 'pgg-parse-crc24-string) - (or pgg-ignore-packet-checksum - (string-equal - (base64-encode-string (pgg-parse-crc24-string - (buffer-string))) - checksum) - (error "PGP packet checksum does not match"))))) + (if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t) + (let ((p (match-beginning 0)) + (checksum (match-string 1))) + (delete-region p (point-max)) + (if (ignore-errors (base64-decode-region (point-min) p)) + (or (not (fboundp 'pgg-parse-crc24-string)) + pgg-ignore-packet-checksum + (string-equal (base64-encode-string (pgg-parse-crc24-string + (buffer-string))) + checksum) + (progn + (message "PGP packet checksum does not match") + nil)) + (message "PGP packet contain invalid base64") + nil)) + (message "PGP packet checksum not found") + nil)) (defun pgg-decode-armor-region (start end) (save-restriction @@ -487,9 +490,9 @@ (delete-region (point-min) (and (search-forward "\n\n") (match-end 0))) - (pgg-decode-packets) - (goto-char (point-min)) - (pgg-parse-packets))) + (when (pgg-decode-packets) + (goto-char (point-min)) + (pgg-parse-packets)))) (defun pgg-parse-armor (string) (with-temp-buffer diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el index d246537..4eb76ee 100644 --- a/lisp/pgg-pgp.el +++ b/lisp/pgg-pgp.el @@ -25,7 +25,9 @@ ;;; Code: -(eval-when-compile (require 'pgg)) +(eval-when-compile + (require 'cl) ; for pgg macros + (require 'pgg)) (defgroup pgg-pgp () "PGP 2.* and 6.* interface" @@ -58,9 +60,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "PGP ID of your default identity.") (defun pgg-pgp-process-region (start end passphrase program args) - (let* ((errors-file-name - (expand-file-name (make-temp-name "pgg-errors") - pgg-temporary-file-directory)) + (let* ((errors-file-name (pgg-make-temp-file "pgg-errors")) (args (append args pgg-pgp-extra-args @@ -184,8 +184,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." - (let* ((basename (expand-file-name "pgg" temporary-file-directory)) - (orig-file (make-temp-name basename)) + (let* ((orig-file (pgg-make-temp-file "pgg")) (args '("+verbose=1" "+batchmode" "+language=us")) (orig-mode (default-file-modes))) (unwind-protect @@ -225,8 +224,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp-snarf-keys-region (start end) "Add all public keys in region between START and END to the keyring." (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id)) - (basename (expand-file-name "pgg" temporary-file-directory)) - (key-file (make-temp-name basename)) + (key-file (pgg-make-temp-file "pgg")) (args (list "+verbose=1" "+batchmode" "+language=us" "-kaf" key-file))) diff --git a/lisp/pgg-pgp5.el b/lisp/pgg-pgp5.el index db954dc..c18671f 100644 --- a/lisp/pgg-pgp5.el +++ b/lisp/pgg-pgp5.el @@ -25,7 +25,9 @@ ;;; Code: -(eval-when-compile (require 'pgg)) +(eval-when-compile + (require 'cl) ; for pgg macros + (require 'pgg)) (defgroup pgg-pgp5 () "PGP 5.* interface" @@ -73,9 +75,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." "PGP 5.* ID of your default identity.") (defun pgg-pgp5-process-region (start end passphrase program args) - (let* ((errors-file-name - (expand-file-name (make-temp-name "pgg-errors") - pgg-temporary-file-directory)) + (let* ((errors-file-name (pgg-make-temp-file "pgg-errors")) (args (append args pgg-pgp5-extra-args @@ -196,10 +196,9 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp5-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." - (let* ((basename (expand-file-name "pgg" pgg-temporary-file-directory)) - (orig-file (make-temp-name basename)) - (args '("+verbose=1" "+batchmode=1" "+language=us")) - (orig-mode (default-file-modes))) + (let ((orig-file (pgg-make-temp-file "pgg")) + (args '("+verbose=1" "+batchmode=1" "+language=us")) + (orig-mode (default-file-modes))) (unwind-protect (progn (set-default-file-modes 448) @@ -234,8 +233,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp5-snarf-keys-region (start end) "Add all public keys in region between START and END to the keyring." (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id)) - (basename (expand-file-name "pgg" pgg-temporary-file-directory)) - (key-file (make-temp-name basename)) + (key-file (pgg-make-temp-file "pgg")) (args (list "+verbose=1" "+batchmode=1" "+language=us" "-a" key-file))) diff --git a/lisp/pgg.el b/lisp/pgg.el index b51bf2c..673e24a 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -42,13 +42,6 @@ (require 'w3) (require 'url))) -;; Fixme: Avoid this and use mm-make-temp-file (especially for -;; something sensitive like pgp). -(defvar pgg-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/"))) - ;;; @ utility functions ;;; @@ -103,13 +96,91 @@ (symbol-value (intern-soft key pgg-passphrase-cache))) (read-passwd prompt))) +(eval-when-compile + (defvar itimer-process) + (defvar itimer-timer) + (autoload 'delete-itimer "itimer") + (autoload 'itimer-driver-start "itimer") + (autoload 'itimer-value "itimer") + (autoload 'set-itimer-function "itimer") + (autoload 'set-itimer-function-arguments "itimer") + (autoload 'set-itimer-restart "itimer") + (autoload 'start-itimer "itimer")) + +(eval-and-compile + (defalias + 'pgg-run-at-time + (if (featurep 'xemacs) + (if (condition-case nil + (progn + (unless (or itimer-process itimer-timer) + (itimer-driver-start)) + ;; Check whether there is a bug to which the difference of + ;; the present time and the time when the itimer driver was + ;; woken up is subtracted from the initial itimer value. + (let* ((inhibit-quit t) + (ctime (current-time)) + (itimer-timer-last-wakeup + (prog1 + ctime + (setcar ctime (1- (car ctime))))) + (itimer-list nil) + (itimer (start-itimer "pgg-run-at-time" 'ignore 5))) + (sleep-for 0.1) ;; Accept the timeout interrupt. + (prog1 + (> (itimer-value itimer) 0) + (delete-itimer itimer)))) + (error nil)) + (lambda (time repeat function &rest args) + "Emulating function run as `run-at-time'. +TIME should be nil meaning now, or a number of seconds from now. +Return an itimer object which can be used in either `delete-itimer' +or `cancel-timer'." + (apply #'start-itimer "pgg-run-at-time" + function (if time (max time 1e-9) 1e-9) + repeat nil t args)) + (lambda (time repeat function &rest args) + "Emulating function run as `run-at-time' in the right way. +TIME should be nil meaning now, or a number of seconds from now. +Return an itimer object which can be used in either `delete-itimer' +or `cancel-timer'." + (let ((itimers (list nil))) + (setcar + itimers + (apply #'start-itimer "pgg-run-at-time" + (lambda (itimers repeat function &rest args) + (let ((itimer (car itimers))) + (if repeat + (progn + (set-itimer-function + itimer + (lambda (itimer repeat function &rest args) + (set-itimer-restart itimer repeat) + (set-itimer-function itimer function) + (set-itimer-function-arguments itimer args) + (apply function args))) + (set-itimer-function-arguments + itimer + (append (list itimer repeat function) args))) + (set-itimer-function + itimer + (lambda (itimer function &rest args) + (delete-itimer itimer) + (apply function args))) + (set-itimer-function-arguments + itimer + (append (list itimer function) args))))) + 1e-9 (if time (max time 1e-9) 1e-9) + nil t itimers repeat function args))))) + 'run-at-time))) + (defun pgg-add-passphrase-cache (key passphrase) (setq key (pgg-truncate-key-identifier key)) (set (intern key pgg-passphrase-cache) passphrase) - (run-at-time pgg-passphrase-cache-expiry nil - #'pgg-remove-passphrase-cache - key)) + (pgg-run-at-time pgg-passphrase-cache-expiry nil + #'pgg-remove-passphrase-cache + key)) (defun pgg-remove-passphrase-cache (key) (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache)))) @@ -149,6 +220,19 @@ `(with-current-buffer pgg-output-buffer (if (zerop (buffer-size)) nil ,@body t))) +(defalias 'pgg-make-temp-file + (if (fboundp 'make-temp-file) + 'make-temp-file + (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file)))) + ;;; @ interface functions ;;; @@ -186,15 +270,6 @@ the region." "Decrypt the current region between START and END." (interactive "r") (let* ((buf (current-buffer)) - (packet (cdr (assq 1 (with-temp-buffer - (insert-buffer-substring buf) - (pgg-decode-armor-region - (point-min) (point-max)))))) - (key (cdr (assq 'key-identifier packet))) - (pgg-default-user-id - (if key - (concat "0x" (pgg-truncate-key-identifier key)) - pgg-default-user-id)) (status (pgg-save-coding-system start end (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme) diff --git a/lisp/pop3.el b/lisp/pop3.el index b192853..6c53a48 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -173,7 +173,8 @@ Return the response string if optional second argument is non-nil." (save-excursion (set-buffer (process-buffer process)) (goto-char pop3-read-point) - (while (not (search-forward "\r\n" nil t)) + (while (and (memq (process-status process) '(open run)) + (not (search-forward "\r\n" nil t))) (nnheader-accept-process-output process) (goto-char pop3-read-point)) (setq match-end (point)) diff --git a/lisp/qp.el b/lisp/qp.el index 149d30a..f87ec66 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -74,15 +74,17 @@ them into characters should be done separately." (mm-insert-byte byte 1) (delete-char 3))) (t - (error "Malformed quoted-printable text") + (message "Malformed quoted-printable text") (forward-char))))) (if coding-system (mm-decode-coding-region (point-min) (point-max) coding-system))))) (defun quoted-printable-decode-string (string &optional coding-system) "Decode the quoted-printable encoded STRING and return the result. -If CODING-SYSTEM is non-nil, decode the region with coding-system." - (with-temp-buffer +If CODING-SYSTEM is non-nil, decode the region with coding-system. +Use of CODING-SYSTEM is deprecated; this function should deal with +raw bytes, and coding conversion should be done separately." + (mm-with-unibyte-buffer (insert string) (quoted-printable-decode-region (point-min) (point-max) coding-system) (buffer-string))) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 1c14bef..d4d6e96 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -71,8 +71,8 @@ Value is what BODY returns." '(("Newsgroups" . nil) ("Followup-To" . nil) ("Message-ID" . nil) - ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" . - address-mime) + ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\ +\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime) (t . mime)) "*Header/encoding method alist. The list is traversed sequentially. The keys can either be @@ -110,7 +110,8 @@ The values can be: (cn-gb-2312 . B) (euc-kr . B) (iso-2022-jp-2 . B) - (iso-2022-int-1 . B)) + (iso-2022-int-1 . B) + (viscii . Q)) "Alist of MIME charsets to RFC2047 encodings. Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding, quoted-printable and base64 respectively.") @@ -121,15 +122,6 @@ quoted-printable and base64 respectively.") (nil . ignore)) "Alist of RFC2047 encodings to encoding functions.") -(defvar rfc2047-q-encoding-alist - '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" - . "-A-Za-z0-9!*+/" ) - ;; = (\075), _ (\137), ? (\077) are used in the encoded word. - ;; Avoid using 8bit characters. - ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" - ("." . "\010\012\014\040-\074\076\100-\136\140-\177")) - "Alist of header regexps and valid Q characters.") - ;;; ;;; Functions for encoding RFC2047 messages ;;; @@ -142,9 +134,7 @@ quoted-printable and base64 respectively.") (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (progn - (beginning-of-line) - (point)) + (rfc2047-point-at-bol) (point-max)))) (goto-char (point-min))) @@ -207,7 +197,7 @@ Should be called narrowed to the head of the message." ((eq method 'address-mime) (rfc2047-encode-region (point) (point-max))) ((eq method 'mime) - (let (rfc2047-encoding-type) + (let ((rfc2047-encoding-type 'mime)) (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) (if (and (featurep 'mule) @@ -299,13 +289,23 @@ Dynamically bind `rfc2047-encoding-type' to change that." (save-restriction (narrow-to-region b e) (if (eq 'mime rfc2047-encoding-type) - ;; Simple case -- treat as single word. + ;; Simple case. Treat as single word after any initial ASCII + ;; part and before any tailing ASCII part. The leading ASCII + ;; is relevant for instance in Subject headers with `Re:' for + ;; interoperability with non-MIME clients, and we might as + ;; well avoid the tail too. (progn (goto-char (point-min)) ;; Does it need encoding? - (skip-chars-forward "\000-\177" e) + (skip-chars-forward "\000-\177") (unless (eobp) - (rfc2047-encode b e))) + (skip-chars-backward "^ \n") ; beginning of space-delimited word + (rfc2047-encode (point) (progn + (goto-char e) + (skip-chars-backward "\000-\177") + (skip-chars-forward "^ \n") + ;; end of space-delimited word + (point))))) ;; `address-mime' case -- take care of quoted words, comments. (with-syntax-table rfc2047-syntax-table (let ((start) ; start of current token @@ -377,14 +377,15 @@ Dynamically bind `rfc2047-encoding-type' to change that." end (1+ end))) (rfc2047-encode start end) (setq last-encoded t))))) - (error (error "Invalid data for rfc2047 encoding: %s" - (buffer-substring b e))))))) + (error + (error "Invalid data for rfc2047 encoding: %s" + (buffer-substring b e))))))) (rfc2047-fold-region b (point)))) (defun rfc2047-encode-string (string) "Encode words in STRING. By default, the string is treated as containing addresses (see -`rfc2047-special-chars')." +`rfc2047-encoding-type')." (with-temp-buffer (insert string) (rfc2047-encode-region (point-min) (point-max)) @@ -393,7 +394,7 @@ By default, the string is treated as containing addresses (see (defun rfc2047-encode (b e) "Encode the word(s) in the region B to E. By default, the region is treated as containing addresses (see -`rfc2047-special-chars')." +`rfc2047-encoding-type')." (let* ((mime-charset (mm-find-mime-charset-region b e)) (cs (if (> (length mime-charset) 1) ;; Fixme: Instead of this, try to break region into @@ -404,14 +405,36 @@ By default, the region is treated as containing addresses (see (mm-charset-to-coding-system mime-charset))) ;; Fixme: Better, calculate the number of non-ASCII ;; characters, at least for 8-bit charsets. - (encoding (if (assq mime-charset - rfc2047-charset-encoding-alist) - (cdr (assq mime-charset + (encoding (or (cdr (assq mime-charset rfc2047-charset-encoding-alist)) - 'B)) + ;; For the charsets that don't have a preferred + ;; encoding, choose the one that's shorter. + (save-restriction + (narrow-to-region b e) + (if (eq (mm-qp-or-base64) 'base64) + 'B + 'Q)))) (start (concat "=?" (downcase (symbol-name mime-charset)) "?" (downcase (symbol-name encoding)) "?")) + (factor (case mime-charset + ((iso-8859-5 iso-8859-7 iso-8859-8 koi8-r) 1) + ((big5 gb2312 euc-kr) 2) + (utf-8 4) + (t 8))) + (pre (- b (save-restriction + (widen) + (rfc2047-point-at-bol)))) + ;; encoded-words must not be longer than 75 characters, + ;; including charset, encoding etc. This leaves us with + ;; 75 - (length start) - 2 - 2 characters. The last 2 is for + ;; possible base64 padding. In the worst case (iso-2022-*) + ;; each character expands to 8 bytes which is expanded by a + ;; factor of 4/3 by base64 encoding. + (length (floor (- 75 (length start) 4) (* factor (/ 4.0 3.0)))) + ;; Limit line length to 76 characters. + (length1 (max 1 (floor (- 76 (length start) 4 pre) + (* factor (/ 4.0 3.0))))) (first t)) (if mime-charset (save-restriction @@ -420,9 +443,14 @@ By default, the region is treated as containing addresses (see ;; break into lines before encoding (goto-char (point-min)) (while (not (eobp)) - (goto-char (min (point-max) (+ 15 (point)))) + (if first + (progn + (goto-char (min (point-max) (+ length1 (point)))) + (setq first nil)) + (goto-char (min (point-max) (+ length (point))))) (unless (eobp) - (insert ?\n)))) + (insert ?\n))) + (setq first t)) (if (and (mm-multibyte-p) (mm-coding-system-p cs)) (mm-encode-coding-region (point-min) (point-max) cs)) @@ -492,7 +520,9 @@ By default, the region is treated as containing addresses (see (if (eq (char-after) ?=) (forward-char 1) (skip-chars-forward "^ \t\n\r=")) - (setq qword-break (point)) + ;; Don't break at the start of the field. + (unless (= (point) b) + (setq qword-break (point))) (skip-chars-forward "^ \t\n\r"))) (t (skip-chars-forward "^ \t\n\r")))) @@ -553,16 +583,21 @@ By default, the region is treated as containing addresses (see (save-excursion (save-restriction (narrow-to-region (goto-char b) e) - (let ((alist rfc2047-q-encoding-alist) - (bol (save-restriction + (let ((bol (save-restriction (widen) (rfc2047-point-at-bol)))) - (while alist - (when (looking-at (caar alist)) - (quoted-printable-encode-region b e nil (cdar alist)) - (subst-char-in-region (point-min) (point-max) ? ?_) - (setq alist nil)) - (pop alist)) + (quoted-printable-encode-region + b e nil + ;; = (\075), _ (\137), ? (\077) are used in the encoded word. + ;; Avoid using 8bit characters. + ;; This list excludes `especials' (see the RFC2047 syntax), + ;; meaning that some characters in non-structured fields will + ;; get encoded when they con't need to be. The following is + ;; what it used to be. +;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?" +;;; "\010\012\014\040-\074\076\100-\136\140-\177") + "-\b\n\f !#-'*+0-9A-Z\\^`-~\d") + (subst-char-in-region (point-min) (point-max) ? ?_) ;; The size of QP encapsulation is about 20, so set limit to ;; 56=76-20. (unless (< (- (point-max) (point-min)) 56) @@ -589,6 +624,12 @@ By default, the region is treated as containing addresses (see ;; Also check whether it needs to worry about delimiting fields like ;; encoding. +;; In fact it's reported that (invalid) encoding of mailboxes in +;; addr-specs is in use, so delimiting fields might help. Probably +;; not decoding a word which isn't properly delimited is good enough +;; and worthwhile (is it more correct or not?), e.g. something like +;; `=?iso-8859-1?q?foo?=@'. + (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." (interactive "r") @@ -705,19 +746,16 @@ If your Emacs implementation can't decode CHARSET, return nil." (when (and (eq cs 'ascii) mail-parse-charset) (setq cs mail-parse-charset)) - ;; Fixme: What's this for? The following comment makes no sense. -- fx - (mm-with-unibyte-current-buffer - ;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode. - (mm-decode-coding-string - (cond - ((equal "B" encoding) - (base64-decode-string - (rfc2047-pad-base64 string))) - ((equal "Q" encoding) - (quoted-printable-decode-string - (mm-replace-chars-in-string string ?_ ? ))) - (t (error "Invalid encoding: %s" encoding))) - cs))))) + (mm-decode-coding-string + (cond + ((equal "B" encoding) + (base64-decode-string + (rfc2047-pad-base64 string))) + ((equal "Q" encoding) + (quoted-printable-decode-string + (mm-replace-chars-in-string string ?_ ? ))) + (t (error "Invalid encoding: %s" encoding))) + cs)))) (provide 'rfc2047) diff --git a/lisp/sha1-el.el b/lisp/sha1-el.el index 4e2da43..ab5804d 100644 --- a/lisp/sha1-el.el +++ b/lisp/sha1-el.el @@ -1,6 +1,6 @@ ;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp. -;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2001, 2003 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: SHA1, FIPS 180-1 @@ -60,21 +60,32 @@ ;;; external SHA1 function. ;;; -(defvar sha1-maximum-internal-length 500 +(defgroup sha1 nil + "Elisp interface for SHA1 hash computation." + :group 'extensions) + +(defcustom sha1-maximum-internal-length 500 "*Maximum length of message to use lisp version of SHA1 function. If message is longer than this, `sha1-program' is used instead. If this variable is set to 0, use extarnal program only. -If this variable is set to nil, use internal function only.") +If this variable is set to nil, use internal function only." + :type 'integer + :group 'sha1) -(defvar sha1-program '("openssl" "sha1") +(defcustom sha1-program '("sha1sum") "*Name of program to compute SHA1. -It must be a string \(program name\) or list of strings \(name and its args\).") - -(defvar sha1-use-external - (executable-find (car sha1-program)) - "*Use external sh1 program. -If this variable is set to nil, use internal function only.") +It must be a string \(program name\) or list of strings \(name and its args\)." + :type '(repeat string) + :group 'sha1) + +(defcustom sha1-use-external (condition-case () + (executable-find (car sha1-program)) + (error)) + "*Use external SHA1 program. +If this variable is set to nil, use internal function only." + :type 'boolean + :group 'sha1) (defun sha1-string-external (string) ;; `with-temp-buffer' is new in v20, so we do not use it. @@ -416,6 +427,7 @@ If this variable is set to nil, use internal function only.") (sha1-string-external string) (sha1-string-internal string))) +;;;###autoload (defun sha1 (object &optional beg end) "Return the SHA1 (Secure Hash Algorithm) of an object. OBJECT is either a string or a buffer. diff --git a/lisp/smiley.el b/lisp/smiley.el index a85a170..8c1282d 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -132,7 +132,7 @@ A list of images is returned." (push image images) (gnus-add-wash-type 'smiley) (gnus-add-image 'smiley image) - (gnus-put-image image string)))) + (gnus-put-image image string 'smiley)))) images)))) ;;;###autoload diff --git a/lisp/smime.el b/lisp/smime.el index 7dc6b52..b14e24a 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -119,7 +119,6 @@ ;;; Code: (require 'dig) -(require 'comint) (eval-when-compile (require 'cl)) (defgroup smime nil @@ -211,8 +210,8 @@ If nil, use system defaults." (defun smime-ask-passphrase () "Asks the passphrase to unlock the secret key." (let ((passphrase - (comint-read-noecho - "Passphrase for secret key (RET for no passphrase): " t))) + (read-passwd + "Passphrase for secret key (RET for no passphrase): "))) (if (string= passphrase "") nil passphrase))) diff --git a/lisp/spam-report.el b/lisp/spam-report.el index 0d4c3e2..e10639b 100644 --- a/lisp/spam-report.el +++ b/lisp/spam-report.el @@ -31,6 +31,9 @@ (require 'gnus) (require 'gnus-sum) +(eval-and-compile + (autoload 'mm-url-insert "mm-url")) + (defgroup spam-report nil "Spam reporting configuration.") @@ -39,7 +42,8 @@ If you are using spam.el, consider setting gnus-spam-process-newsgroups or the gnus-group-spam-exit-processor-report-gmane group/topic parameter instead." - :type 'regexp + :type '(radio (const nil) + (regexp :format "%t: %v\n" :size 0 :value "^nntp\+.*:gmane\.")) :group 'spam-report) (defcustom spam-report-gmane-spam-header @@ -53,18 +57,28 @@ instead." :type 'boolean :group 'spam-report) -(defun spam-report-gmane (article) +(defcustom spam-report-url-ping-function + 'spam-report-url-ping-plain + "Function to use for url ping spam reporting." + :type '(choice + (const :tag "Connect directly" + spam-report-url-ping-plain) + (const :tag "Use the external program specified in `mm-url-program'" + spam-report-url-ping-mm-url)) + :group 'spam-report) + +(defun spam-report-gmane (&rest articles) "Report an article as spam through Gmane" - (interactive "nEnter the article number: ") - (when (and gnus-newsgroup-name - (or (null spam-report-gmane-regex) - (string-match spam-report-gmane-regex gnus-newsgroup-name))) - (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article) + (dolist (article articles) + (when (and gnus-newsgroup-name + (or (null spam-report-gmane-regex) + (string-match spam-report-gmane-regex gnus-newsgroup-name))) + (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article) (if spam-report-gmane-use-article-number (spam-report-url-ping "spam.gmane.org" - (format "/%s:%d" - (gnus-group-real-name gnus-newsgroup-name) - article)) + (format "/%s:%d" + (gnus-group-real-name gnus-newsgroup-name) + article)) (with-current-buffer nntp-server-buffer (gnus-request-head article gnus-newsgroup-name) (goto-char (point-min)) @@ -75,11 +89,15 @@ instead." (gnus-message 10 "Reporting spam through URL %s..." url) (spam-report-url-ping host report)) (gnus-message 10 "Could not find X-Report-Spam in article %d..." - article)))))) - + article))))))) (defun spam-report-url-ping (host report) - "Ping a host through HTTP, addressing a specific GET resource" + "Ping a host through HTTP, addressing a specific GET resource using +the function specified by `spam-report-url-ping-function'." + (funcall spam-report-url-ping-function host report)) + +(defun spam-report-url-ping-plain (host report) + "Ping a host through HTTP, addressing a specific GET resource." (let ((tcp-connection)) (with-temp-buffer (or (setq tcp-connection @@ -90,9 +108,18 @@ instead." 80)) (error "Could not open connection to %s" host)) (set-marker (process-mark tcp-connection) (point-min)) - (process-send-string tcp-connection - (format "GET %s HTTP/1.1\nHost: %s\n\n" - report host))))) + (process-send-string + tcp-connection + (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n" + report (gnus-emacs-version) host))))) + +(defun spam-report-url-ping-mm-url (host report) + "Ping a host through HTTP, addressing a specific GET resource. Use +the external program specified in `mm-url-program' to connect to +server." + (with-temp-buffer + (let ((url (concat "http://" host "/" report))) + (mm-url-insert url t)))) (provide 'spam-report) diff --git a/lisp/spam-stat.el b/lisp/spam-stat.el index 96df016..e85e057 100644 --- a/lisp/spam-stat.el +++ b/lisp/spam-stat.el @@ -183,6 +183,9 @@ effect when spam-stat is invoked through spam.el." "Syntax table used when processing mails for statistical analysis. The important part is which characters are word constituents.") +(defvar spam-stat-dirty nil + "Whether the spam-stat database needs saving.") + (defvar spam-stat-buffer nil "Buffer to use for scoring while splitting. This is set by hooking into Gnus.") @@ -238,12 +241,6 @@ This uses `gnus-article-buffer'." (set-buffer gnus-original-article-buffer) (spam-stat-store-current-buffer))) -(when spam-stat-install-hooks - (add-hook 'nnmail-prepare-incoming-message-hook - 'spam-stat-store-current-buffer) - (add-hook 'gnus-select-article-hook - 'spam-stat-store-gnus-article-buffer)) - ;; Data -- not using defstruct in order to save space and time (defvar spam-stat (make-hash-table :test 'equal) @@ -347,7 +344,8 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good', (setq entry (spam-stat-make-entry 0 count))) (spam-stat-set-score entry (spam-stat-compute-score entry)) (puthash word entry spam-stat))) - (spam-stat-buffer-words))) + (spam-stat-buffer-words)) + (setq spam-stat-dirty t)) (defun spam-stat-buffer-is-non-spam () "Consider current buffer to be a new non-spam mail." @@ -360,7 +358,8 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good', (setq entry (spam-stat-make-entry count 0))) (spam-stat-set-score entry (spam-stat-compute-score entry)) (puthash word entry spam-stat))) - (spam-stat-buffer-words))) + (spam-stat-buffer-words)) + (setq spam-stat-dirty t)) (defun spam-stat-buffer-change-to-spam () "Consider current buffer no longer normal mail but spam." @@ -375,7 +374,8 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good', (spam-stat-set-bad entry (+ (spam-stat-bad entry) count)) (spam-stat-set-score entry (spam-stat-compute-score entry)) (puthash word entry spam-stat)))) - (spam-stat-buffer-words))) + (spam-stat-buffer-words)) + (setq spam-stat-dirty t)) (defun spam-stat-buffer-change-to-non-spam () "Consider current buffer no longer spam but normal mail." @@ -390,32 +390,37 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good', (spam-stat-set-bad entry (- (spam-stat-bad entry) count)) (spam-stat-set-score entry (spam-stat-compute-score entry)) (puthash word entry spam-stat)))) - (spam-stat-buffer-words))) + (spam-stat-buffer-words)) + (setq spam-stat-dirty t)) ;; Saving and Loading -(defun spam-stat-save () +(defun spam-stat-save (&optional force) "Save the `spam-stat' hash table as lisp file." (interactive) - (with-temp-buffer - (let ((standard-output (current-buffer)) - (font-lock-maximum-size 0)) - (insert "(setq spam-stat-ngood " - (number-to-string spam-stat-ngood) - " spam-stat-nbad " - (number-to-string spam-stat-nbad) - " spam-stat (spam-stat-to-hash-table '(") - (maphash (lambda (word entry) - (prin1 (list word - (spam-stat-good entry) - (spam-stat-bad entry)))) - spam-stat) - (insert ")))") - (write-file spam-stat-file)))) + (when (or force spam-stat-dirty) + (with-temp-buffer + (let ((standard-output (current-buffer)) + (font-lock-maximum-size 0)) + (insert "(setq spam-stat-ngood " + (number-to-string spam-stat-ngood) + " spam-stat-nbad " + (number-to-string spam-stat-nbad) + " spam-stat (spam-stat-to-hash-table '(") + (maphash (lambda (word entry) + (prin1 (list word + (spam-stat-good entry) + (spam-stat-bad entry)))) + spam-stat) + (insert ")))") + (write-file spam-stat-file))) + (setq spam-stat-dirty nil))) (defun spam-stat-load () "Read the `spam-stat' hash table from disk." - (load-file spam-stat-file)) + ;; TODO: maybe we should warn the user if spam-stat-dirty is t? + (load-file spam-stat-file) + (setq spam-stat-dirty nil)) (defun spam-stat-to-hash-table (entries) "Turn list ENTRIES into a hash table and store as `spam-stat'. @@ -438,7 +443,8 @@ This deletes all the statistics." (interactive) (setq spam-stat (make-hash-table :test 'equal) spam-stat-ngood 0 - spam-stat-nbad 0)) + spam-stat-nbad 0) + (setq spam-stat-dirty t)) ;; Scoring buffers @@ -567,6 +573,25 @@ COUNT defaults to 5" (remhash key spam-stat))) spam-stat)) +(defun spam-stat-install-hooks-function () + "Install the spam-stat function hooks" + (interactive) + (add-hook 'nnmail-prepare-incoming-message-hook + 'spam-stat-store-current-buffer) + (add-hook 'gnus-select-article-hook + 'spam-stat-store-gnus-article-buffer)) + +(when spam-stat-install-hooks + (spam-stat-install-hooks-function)) + +(defun spam-stat-unload-hook () + "Uninstall the spam-stat function hooks" + (interactive) + (remove-hook 'nnmail-prepare-incoming-message-hook + 'spam-stat-store-current-buffer) + (remove-hook 'gnus-select-article-hook + 'spam-stat-store-gnus-article-buffer)) + (provide 'spam-stat) ;;; spam-stat.el ends here diff --git a/lisp/spam.el b/lisp/spam.el index 5518eb1..1014d7c 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -1,3 +1,5 @@ +;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting, remote processing, training through files + ;;; spam.el --- Identifying spam ;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. @@ -39,8 +41,9 @@ (require 'gnus-sum) (require 'gnus-uu) ; because of key prefix issues -(require 'gnus) ; for the definitions of group content classification and spam processors -(require 'message) ;for the message-fetch-field functions +;;; for the definitions of group content classification and spam processors +(require 'gnus) +(require 'message) ;for the message-fetch-field functions ;; for nnimap-split-download-body-default (eval-when-compile (require 'nnimap)) @@ -58,6 +61,13 @@ (eval-and-compile (autoload 'spam-report-gmane "spam-report")) +;; autoload gnus-registry +(eval-and-compile + (autoload 'gnus-registry-group-count "gnus-registry") + (autoload 'gnus-registry-add-group "gnus-registry") + (autoload 'gnus-registry-store-extra-entry "gnus-registry") + (autoload 'gnus-registry-fetch-extra "gnus-registry")) + ;; autoload query-dns (eval-and-compile (autoload 'query-dns "dns")) @@ -74,12 +84,39 @@ (defcustom spam-move-spam-nonspam-groups-only t "Whether spam should be moved in non-spam groups only. -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 +When t, only ham and unclassified groups will have their spam moved +to the spam-process-destination. When nil, spam will also be moved from spam groups." :type 'boolean :group 'spam) +(defcustom spam-process-ham-in-nonham-groups nil + "Whether ham should be processed in non-ham groups." + :type 'boolean + :group 'spam) + +(defcustom spam-log-to-registry nil + "Whether spam/ham processing should be logged in the registry." + :type 'boolean + :group 'spam) + +(defcustom spam-split-symbolic-return nil + "Whether spam-split should work with symbols or group names." + :type 'boolean + :group 'spam) + +(defcustom spam-split-symbolic-return-positive nil + "Whether spam-split should ALWAYS work with symbols or group + names. Do not set this if you use spam-split in a fancy split + method." + :type 'boolean + :group 'spam) + +(defcustom spam-process-ham-in-spam-groups nil + "Whether ham should be processed in spam groups." + :type 'boolean + :group 'spam) + (defcustom spam-mark-only-unseen-as-spam t "Whether only unseen articles should be marked as spam in spam groups. When nil, all unread articles in a spam group are marked as @@ -96,6 +133,21 @@ Competition." :type 'boolean :group 'spam) +(defcustom spam-disable-spam-split-during-ham-respool nil + "Whether spam-split should be ignored while resplitting ham in +a process destination. This is useful to prevent ham from ending +up in the same spam group after the resplit. Don't set this to t +if you have spam-split as the last rule in your split +configuration." + :type 'boolean + :group 'spam) + +(defcustom spam-autodetect-recheck-messages nil + "Should spam.el recheck all meessages when autodetecting? +Normally this is nil, so only unseen messages will be checked." + :type 'boolean + :group 'spam) + (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory) "The location of the whitelist. The file format is one regular expression per line. @@ -120,6 +172,11 @@ The regular expression is matched against the address." :type 'boolean :group 'spam) +(defcustom spam-blacklist-ignored-regexes nil + "Regular expressions that the blacklist should ignore." + :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting")) + :group 'spam) + (defcustom spam-use-whitelist nil "Whether the whitelist should be used by spam-split." :type 'boolean @@ -148,6 +205,12 @@ Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'." :type 'boolean :group 'spam) +(defcustom spam-use-regex-body nil + "Whether a body regular expression match should be used by spam-split. +Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'." + :type 'boolean + :group 'spam) + (defcustom spam-use-bogofilter-headers nil "Whether bogofilter headers should be used by spam-split. Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them." @@ -182,12 +245,42 @@ considered spam." :type 'boolean :group 'spam) +(defcustom spam-use-spamoracle nil + "Whether spamoracle should be used by spam-split." + :type 'boolean + :group 'spam) + +(defcustom spam-install-hooks (or + spam-use-dig + spam-use-blacklist + spam-use-whitelist + spam-use-whitelist-exclusive + spam-use-blackholes + spam-use-hashcash + spam-use-regex-headers + spam-use-regex-body + spam-use-bogofilter-headers + spam-use-bogofilter + spam-use-BBDB + spam-use-BBDB-exclusive + spam-use-ifile + spam-use-stat + spam-use-spamoracle) + "Whether the spam hooks should be installed, default to t if one of +the spam-use-* variables is set." + :group 'spam + :type 'boolean) + (defcustom spam-split-group "spam" "Group name where incoming spam should be put by spam-split." :type 'string :group 'spam) -(defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel")) +;;; TODO: deprecate this variable, it's confusing since it's a list of strings, +;;; not regular expressions +(defcustom spam-junk-mailgroups (cons + spam-split-group + '("mail.junk" "poste.pourriel")) "Mailgroups with spam contents. All unmarked article in such group receive the spam mark on group entry." :type '(repeat (string :tag "Group")) @@ -201,7 +294,8 @@ All unmarked article in such group receive the spam mark on group entry." (defcustom spam-blackhole-good-server-regex nil "String matching IP addresses that should not be checked in the blackholes" - :type 'regexp + :type '(radio (const nil) + (regexp :format "%t: %v\n" :size 0)) :group 'spam) (defcustom spam-face 'gnus-splash-face @@ -219,6 +313,16 @@ All unmarked article in such group receive the spam mark on group entry." :type '(repeat (regexp :tag "Regular expression to match ham header")) :group 'spam) +(defcustom spam-regex-body-spam '() + "Regular expression for positive body spam matches" + :type '(repeat (regexp :tag "Regular expression to match spam body")) + :group 'spam) + +(defcustom spam-regex-body-ham '() + "Regular expression for positive body ham matches" + :type '(repeat (regexp :tag "Regular expression to match ham body")) + :group 'spam) + (defgroup spam-ifile nil "Spam ifile configuration." :group 'spam) @@ -244,7 +348,7 @@ All unmarked article in such group receive the spam mark on group entry." "Name of the ham ifile category. If nil, the current group name will be used." :type '(choice (string :tag "Use a fixed category") - (const :tag "Use the current group name")) + (const :tag "Use the current group name")) :group 'spam-ifile) (defcustom spam-ifile-all-categories nil @@ -279,6 +383,16 @@ your main source of newsgroup names." :type 'string :group 'spam-bogofilter) +(defcustom spam-bogofilter-spam-strong-switch "-S" + "The switch that Bogofilter uses to unregister ham messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-ham-strong-switch "-N" + "The switch that Bogofilter uses to unregister spam messages." + :type 'string + :group 'spam-bogofilter) + (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" "The regex on `spam-bogofilter-header' for positive spam identification." :type 'regexp @@ -286,9 +400,27 @@ your main source of newsgroup names." (defcustom spam-bogofilter-database-directory nil "Directory path of the Bogofilter databases." - :type '(choice (directory :tag "Location of the Bogofilter database directory") + :type '(choice (directory + :tag "Location of the Bogofilter database directory") (const :tag "Use the default")) - :group 'spam-ifile) + :group 'spam-bogofilter) + +(defgroup spam-spamoracle nil + "Spam spamoracle configuration." + :group 'spam) + +(defcustom spam-spamoracle-database nil + "Location of spamoracle database file. When nil, use the default +spamoracle database." + :type '(choice (directory :tag "Location of spamoracle database file.") + (const :tag "Use the default")) + :group 'spam-spamoracle) + +(defcustom spam-spamoracle-binary (executable-find "spamoracle") + "Location of the spamoracle binary." + :type '(choice (directory :tag "Location of the spamoracle binary") + (const :tag "Use the default")) + :group 'spam-spamoracle) ;;; Key bindings for spam control. @@ -299,14 +431,23 @@ your main source of newsgroup names." "Msx" gnus-summary-mark-as-spam "\M-d" gnus-summary-mark-as-spam) -;;; How to highlight a spam summary line. +(defvar spam-old-ham-articles nil + "List of old ham articles, generated when a group is entered.") -;; TODO: How do we redo this every time spam-face is customized? +(defvar spam-old-spam-articles nil + "List of old spam articles, generated when a group is entered.") -(push '((eq mark gnus-spam-mark) . spam-face) - gnus-summary-highlight) +(defvar spam-split-disabled nil + "If non-nil, spam-split is disabled, and always returns nil.") + +(defvar spam-split-last-successful-check nil + "spam-split will set this to nil or a spam-use-XYZ check if it + finds ham or spam.") ;; convenience functions +(defun spam-xor (a b) ; logical exclusive or + (and (or a b) (not (and a b)))) + (defun spam-group-ham-mark-p (group mark &optional spam) (when (stringp group) (let* ((marks (spam-group-ham-marks group spam)) @@ -321,8 +462,8 @@ your main source of newsgroup names." (defun spam-group-ham-marks (group &optional spam) (when (stringp group) (let* ((marks (if spam - (gnus-parameter-spam-marks group) - (gnus-parameter-ham-marks group))) + (gnus-parameter-spam-marks group) + (gnus-parameter-ham-marks group))) (marks (car marks)) (marks (if (listp (car marks)) (car marks) marks))) marks))) @@ -343,12 +484,46 @@ your main source of newsgroup names." (gnus-parameter-spam-contents group)) nil)) +(defvar spam-list-of-processors + '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) + (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) + (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) + (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) + (gnus-group-spam-exit-processor-stat spam spam-use-stat) + (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) + (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) + (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) + (gnus-group-ham-exit-processor-stat ham spam-use-stat) + (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) + (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) + (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) + (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) + "The spam-list-of-processors list contains pairs associating a +ham/spam exit processor variable with a classification and a +spam-use-* variable.") + (defun spam-group-processor-p (group processor) (if (and (stringp group) (symbolp processor)) - (member processor (car (gnus-parameter-spam-process group))) + (or (member processor (nth 0 (gnus-parameter-spam-process group))) + (spam-group-processor-multiple-p + group + (cdr-safe (assoc processor spam-list-of-processors)))) nil)) +(defun spam-group-processor-multiple-p (group processor-info) + (let* ((classification (nth 0 processor-info)) + (check (nth 1 processor-info)) + (parameters (nth 0 (gnus-parameter-spam-process group))) + found) + (dolist (parameter parameters) + (when (and (null found) + (listp parameter) + (eq classification (nth 0 parameter)) + (eq check (nth 1 parameter))) + (setq found t))) + found)) + (defun spam-group-spam-processor-report-gmane-p (group) (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane)) @@ -364,6 +539,9 @@ your main source of newsgroup names." (defun spam-group-ham-processor-ifile-p (group) (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile)) +(defun spam-group-spam-processor-spamoracle-p (group) + (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle)) + (defun spam-group-ham-processor-bogofilter-p (group) (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter)) @@ -382,44 +560,64 @@ your main source of newsgroup names." (defun spam-group-ham-processor-copy-p (group) (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy)) +(defun spam-group-ham-processor-spamoracle-p (group) + (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle)) + ;;; Summary entry and exit processing. (defun spam-summary-prepare () + (setq spam-old-ham-articles + (spam-list-articles gnus-newsgroup-articles 'ham)) + (setq spam-old-spam-articles + (spam-list-articles gnus-newsgroup-articles 'spam)) (spam-mark-junk-as-spam-routine)) -(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 () (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 (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)) - (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name) - (gnus-message 5 "Registering spam with the Gmane report") - (spam-report-gmane-register-routine)) + ;; first of all, unregister any articles that are no longer ham or spam + ;; we have to iterate over the processors, or else we'll be too slow + (dolist (classification '(spam ham)) + (let* ((old-articles (if (eq classification 'spam) + spam-old-spam-articles + spam-old-ham-articles)) + (new-articles (spam-list-articles + gnus-newsgroup-articles + classification)) + (changed-articles (gnus-set-difference old-articles new-articles))) + ;; now that we have the changed articles, we go through the processors + (dolist (processor-param spam-list-of-processors) + (let ((processor (nth 0 processor-param)) + (processor-classification (nth 1 processor-param)) + (check (nth 2 processor-param)) + unregister-list) + (dolist (article changed-articles) + (let ((id (spam-fetch-field-message-id-fast article))) + (when (spam-log-unregistration-needed-p + id 'process classification check) + (push article unregister-list)))) + ;; call spam-register-routine with specific articles to unregister, + ;; when there are articles to unregister and the check is enabled + (when (and unregister-list (symbol-value check)) + (spam-register-routine classification check t unregister-list)))))) + + ;; find all the spam processors applicable to this group + (dolist (processor-param spam-list-of-processors) + (let ((processor (nth 0 processor-param)) + (classification (nth 1 processor-param)) + (check (nth 2 processor-param))) + (when (and (eq 'spam classification) + (spam-group-processor-p gnus-newsgroup-name processor)) + (spam-register-routine classification check)))) (if spam-move-spam-nonspam-groups-only (when (not (spam-group-spam-contents-p gnus-newsgroup-name)) (spam-mark-spam-as-expired-and-move-routine (gnus-parameter-spam-process-destination gnus-newsgroup-name))) - (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name) + (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))) @@ -428,35 +626,32 @@ your main source of newsgroup names." (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 (or (spam-group-ham-contents-p gnus-newsgroup-name) + (and (spam-group-spam-contents-p gnus-newsgroup-name) + spam-process-ham-in-spam-groups) + spam-process-ham-in-nonham-groups) + ;; find all the ham processors applicable to this group + (dolist (processor-param spam-list-of-processors) + (let ((processor (nth 0 processor-param)) + (classification (nth 1 processor-param)) + (check (nth 2 processor-param))) + (when (and (eq 'ham classification) + (spam-group-processor-p gnus-newsgroup-name processor)) + (spam-register-routine classification check))))) (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) (gnus-message 5 "Copying ham") - (spam-ham-move-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name) t)) + (spam-ham-copy-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name))) ;; now move all ham articles out of spam groups (when (spam-group-spam-contents-p gnus-newsgroup-name) (gnus-message 5 "Moving ham messages from spam group") (spam-ham-move-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name))))) + (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) -(add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (setq spam-old-ham-articles nil) + (setq spam-old-spam-articles nil)) (defun spam-mark-junk-as-spam-routine () ;; check the global list of group names spam-junk-mailgroups and the @@ -472,67 +667,105 @@ your main source of newsgroup names." (dolist (article articles) (gnus-summary-mark-article article gnus-spam-mark))))) -(defun spam-mark-spam-as-expired-and-move-routine (&optional group) +(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) + (if (and (car-safe groups) (listp (car-safe groups))) + (apply 'spam-mark-spam-as-expired-and-move-routine (car groups)) + (gnus-summary-kill-process-mark) + (let ((articles gnus-newsgroup-articles) + (backend-supports-deletions + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)) + article tomove deletep) + (dolist (article articles) + (when (eq (gnus-summary-article-mark article) gnus-spam-mark) + (gnus-summary-mark-article article gnus-expirable-mark) + (push article tomove))) + + ;; now do the actual copies + (dolist (group groups) + (when (and tomove + (stringp group)) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove + (if (or (not backend-supports-deletions) + (> (length groups) 1)) + (progn + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-summary-move-article nil group))))) + + ;; now delete the articles, if there was a copy done, and the + ;; backend allows it + (when (and deletep backend-supports-deletions) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil)))) + + (gnus-summary-yank-process-mark)))) + +(defun spam-ham-copy-or-move-routine (copy groups) (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article tomove) + (backend-supports-deletions + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)) + (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) + article mark todo deletep respool) (dolist (article articles) - (when (eq (gnus-summary-article-mark article) gnus-spam-mark) - (gnus-summary-mark-article article gnus-expirable-mark) - (push article tomove))) + (when (spam-group-ham-mark-p gnus-newsgroup-name + (gnus-summary-article-mark article)) + (push article todo))) - ;; 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 copy) - (gnus-summary-kill-process-mark) - (let ((articles gnus-newsgroup-articles) - article mark tomove) - (when (stringp group) ; this routine will do nothing - ; without a valid group - (dolist (article articles) - (when (spam-group-ham-mark-p gnus-newsgroup-name - (gnus-summary-article-mark article)) - (push article tomove))) + (when (member 'respool groups) + (setq respool t) ; boolean for later + (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it - ;; now do the actual move - (when tomove - (dolist (article tomove) + ;; now do the actual move + (dolist (group groups) + (when (and todo (stringp group)) + (dolist (article todo) (when spam-mark-ham-unread-before-move-from-spam-group - (gnus-summary-mark-article article gnus-unread-mark)) + (gnus-summary-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))))) + + (if respool ; respooling is with a "fake" group + (let ((spam-split-disabled + (or spam-split-disabled + spam-disable-spam-split-during-ham-respool))) + (gnus-summary-respool-article nil respool-method)) + (if (or (not backend-supports-deletions) ; else, we are not respooling + (> (length groups) 1)) + (progn ; if copying, copy and set deletep + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-summary-move-article nil group))))) ; else move articles + + ;; now delete the articles, unless a) copy is t, and there was a copy done + ;; b) a move was done to a single group + ;; c) backend-supports-deletions is nil + (unless copy + (when (and deletep backend-supports-deletions) + (dolist (article todo) + (gnus-summary-set-process-mark article)) + (when todo + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil)))))) + (gnus-summary-yank-process-mark)) -(defun spam-generic-register-routine (spam-func ham-func) - (let ((articles gnus-newsgroup-articles) - article mark ham-articles spam-articles) - - (while articles - (setq article (pop articles) - mark (gnus-summary-article-mark article)) - (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark) - (push article spam-articles)) - ((memq article gnus-newsgroup-saved)) - ((spam-group-ham-mark-p gnus-newsgroup-name mark) - (push article ham-articles)))) - - (when (and ham-articles ham-func) - (mapc ham-func ham-articles)) ; we use mapc because unlike - ; mapcar it discards the - ; return values - (when (and spam-articles spam-func) - (mapc spam-func spam-articles)))) ; we use mapc because unlike - ; mapcar it discards the - ; return values - +(defun spam-ham-copy-routine (&rest groups) + (if (and (car-safe groups) (listp (car-safe groups))) + (apply 'spam-ham-copy-routine (car groups)) + (spam-ham-copy-or-move-routine t groups))) + +(defun spam-ham-move-routine (&rest groups) + (if (and (car-safe groups) (listp (car-safe groups))) + (apply 'spam-ham-move-routine (car groups)) + (spam-ham-copy-or-move-routine nil groups))) + (eval-and-compile (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol @@ -540,12 +773,12 @@ your main source of newsgroup names." (defun spam-get-article-as-string (article) (let ((article-buffer (spam-get-article-as-buffer article)) - article-string) + article-string) (when article-buffer (save-window-excursion (set-buffer article-buffer) (setq article-string (buffer-string)))) - article-string)) + article-string)) (defun spam-get-article-as-buffer (article) (let ((article-buffer)) @@ -560,8 +793,10 @@ your main source of newsgroup names." ;; (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))) +;; (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))) @@ -570,99 +805,396 @@ your main source of newsgroup names." "Fetch the `from' field quickly, using the internal gnus-data-list function" (if (and (numberp article) (assoc article (gnus-data-list nil))) - (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil)))) + (mail-header-from + (gnus-data-header (assoc article (gnus-data-list nil)))) nil)) (defun spam-fetch-field-subject-fast (article) - "Fetch the `subject' field quickly, using the internal gnus-data-list function" + "Fetch the `subject' field quickly, using the internal + gnus-data-list function" (if (and (numberp article) (assoc article (gnus-data-list nil))) - (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil)))) + (mail-header-subject + (gnus-data-header (assoc article (gnus-data-list nil)))) + nil)) + +(defun spam-fetch-field-message-id-fast (article) + "Fetch the `Message-ID' field quickly, using the internal + gnus-data-list function" + (if (and (numberp article) + (assoc article (gnus-data-list nil))) + (mail-header-message-id + (gnus-data-header (assoc article (gnus-data-list nil)))) nil)) ;;;; Spam determination. (defvar spam-list-of-checks - '((spam-use-blacklist . spam-check-blacklist) - (spam-use-regex-headers . spam-check-regex-headers) - (spam-use-whitelist . spam-check-whitelist) - (spam-use-BBDB . spam-check-BBDB) - (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 -variable with a spam checking function. If the parameter variable is -true, then the checking function is called, and its value decides what -happens. Each individual check may return nil, t, or a mailgroup -name. The value nil means that the check does not yield a decision, -and so, that further checks are needed. The value t means that the -message is definitely not spam, and that further spam checks should be -inhibited. Otherwise, a mailgroup name is returned where the mail -should go, and further checks are also inhibited. The usual mailgroup -name is the value of `spam-split-group', meaning that the message is + '((spam-use-blacklist . spam-check-blacklist) + (spam-use-regex-headers . spam-check-regex-headers) + (spam-use-regex-body . spam-check-regex-body) + (spam-use-whitelist . spam-check-whitelist) + (spam-use-BBDB . spam-check-BBDB) + (spam-use-ifile . spam-check-ifile) + (spam-use-spamoracle . spam-check-spamoracle) + (spam-use-stat . spam-check-stat) + (spam-use-blackholes . spam-check-blackholes) + (spam-use-hashcash . spam-check-hashcash) + (spam-use-bogofilter-headers . spam-check-bogofilter-headers) + (spam-use-bogofilter . spam-check-bogofilter)) + "The spam-list-of-checks list contains pairs associating a +parameter variable with a spam checking function. If the +parameter variable is true, then the checking function is called, +and its value decides what happens. Each individual check may +return nil, t, or a mailgroup name. The value nil means that the +check does not yield a decision, and so, that further checks are +needed. The value t means that the message is definitely not +spam, and that further spam checks should be inhibited. +Otherwise, a mailgroup name or the symbol 'spam (depending on +spam-split-symbolic-return) is returned where the mail should go, +and further checks are also inhibited. The usual mailgroup name +is the value of `spam-split-group', meaning that the message is definitely a spam.") -(defvar spam-list-of-statistical-checks - '(spam-use-ifile spam-use-stat spam-use-bogofilter) -"The spam-list-of-statistical-checks list contains all the mail +(defvar spam-list-of-statistical-checks + '(spam-use-ifile + spam-use-regex-body + spam-use-stat + spam-use-bogofilter + spam-use-spamoracle) + "The spam-list-of-statistical-checks list contains all the mail splitters that need to have the full message body available.") +;;;TODO: modify to invoke self with each check if invoked without specifics (defun spam-split (&rest specific-checks) "Split this message into the `spam' group if it is spam. -This function can be used as an entry in `nnmail-split-fancy', for -example like this: (: spam-split). It can take checks as parameters. +This function can be used as an entry in `nnmail-split-fancy', +for example like this: (: spam-split). It can take checks as +parameters. A string as a parameter will set the +spam-split-group to that string. See the Info node `(gnus)Fancy Mail Splitting' for more details." (interactive) - (save-excursion - (save-restriction - (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)) - (let ((pair (pop list-of-checks))) - (when (and (symbol-value (car pair)) - (or (null specific-checks) - (memq (car pair) specific-checks))) - (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair))) - (setq decision (funcall (cdr pair)))))) - (if (eq decision t) - nil - decision))))) + (setq spam-split-last-successful-check nil) + (unless spam-split-disabled + (let ((spam-split-group-choice spam-split-group)) + (dolist (check specific-checks) + (when (stringp check) + (setq spam-split-group-choice check) + (setq specific-checks (delq check specific-checks)))) + + (let ((spam-split-group spam-split-group-choice)) + (save-excursion + (save-restriction + (dolist (check spam-list-of-statistical-checks) + (when (and (symbolp check) (symbol-value check)) + (widen) + (gnus-message 8 "spam-split: widening the buffer (%s requires it)" + (symbol-name check)) + (return))) + ;; (progn (widen) (debug (buffer-string))) + (let ((list-of-checks spam-list-of-checks) + decision) + (while (and list-of-checks (not decision)) + (let ((pair (pop list-of-checks))) + (when (and (symbol-value (car pair)) + (or (null specific-checks) + (memq (car pair) specific-checks))) + (gnus-message 5 "spam-split: calling the %s function" + (symbol-name (cdr pair))) + (setq decision (funcall (cdr pair))) + ;; if we got a decision at all, save the current check + (when decision + (setq spam-split-last-successful-check (car pair))) + + (when (eq decision 'spam) + (if spam-split-symbolic-return + (setq decision spam-split-group) + (gnus-error + 5 + (format "spam-split got %s but %s is nil" + (symbol-name decision) + (symbol-name spam-split-symbolic-return)))))))) + (if (eq decision t) + (if spam-split-symbolic-return-positive 'ham nil) + decision)))))))) + +(defun spam-find-spam () + "This function will detect spam in the current newsgroup using spam-split" + (interactive) + (let* ((group gnus-newsgroup-name) + (autodetect (gnus-parameter-spam-autodetect group)) + (methods (gnus-parameter-spam-autodetect-methods group)) + (first-method (nth 0 methods))) + (when (and autodetect + (not (equal first-method 'none))) + (mapcar + (lambda (article) + (let ((id (spam-fetch-field-message-id-fast article)) + (subject (spam-fetch-field-subject-fast article)) + (sender (spam-fetch-field-from-fast article))) + (unless (and spam-log-to-registry + (spam-log-registered-p id 'incoming)) + (let* ((spam-split-symbolic-return t) + (spam-split-symbolic-return-positive t) + (split-return + (with-temp-buffer + (gnus-request-article-this-buffer + article + group) + (if (or (null first-method) + (equal first-method 'default)) + (spam-split) + (apply 'spam-split methods))))) + (if (equal split-return 'spam) + (gnus-summary-mark-article article gnus-spam-mark)) + + (when (and split-return spam-log-to-registry) + (when (zerop (gnus-registry-group-count id)) + (gnus-registry-add-group + id group subject sender)) + + (spam-log-processing-to-registry + id + 'incoming + split-return + spam-split-last-successful-check + group)))))) + (if spam-autodetect-recheck-messages + gnus-newsgroup-articles + gnus-newsgroup-unseen))))) + +(defvar spam-registration-functions + ;; first the ham register, second the spam register function + ;; third the ham unregister, fourth the spam unregister function + '((spam-use-blacklist nil + spam-blacklist-register-routine + nil + spam-blacklist-unregister-routine) + (spam-use-whitelist spam-whitelist-register-routine + nil + spam-whitelist-unregister-routine + nil) + (spam-use-BBDB spam-BBDB-register-routine + nil + spam-BBDB-unregister-routine + nil) + (spam-use-ifile spam-ifile-register-ham-routine + spam-ifile-register-spam-routine + spam-ifile-unregister-ham-routine + spam-ifile-unregister-spam-routine) + (spam-use-spamoracle spam-spamoracle-learn-ham + spam-spamoracle-learn-spam + spam-spamoracle-unlearn-ham + spam-spamoracle-unlearn-spam) + (spam-use-stat spam-stat-register-ham-routine + spam-stat-register-spam-routine + spam-stat-unregister-ham-routine + spam-stat-unregister-spam-routine) + ;; note that spam-use-gmane is not a legitimate check + (spam-use-gmane nil + spam-report-gmane-register-routine + ;; does Gmane support unregistration? + nil + nil) + (spam-use-bogofilter spam-bogofilter-register-ham-routine + spam-bogofilter-register-spam-routine + spam-bogofilter-unregister-ham-routine + spam-bogofilter-unregister-spam-routine)) + "The spam-registration-functions list contains pairs +associating a parameter variable with the ham and spam +registration functions, and the ham and spam unregistration +functions") + +(defun spam-classification-valid-p (classification) + (or (eq classification 'spam) + (eq classification 'ham))) + +(defun spam-process-type-valid-p (process-type) + (or (eq process-type 'incoming) + (eq process-type 'process))) + +(defun spam-registration-check-valid-p (check) + (assoc check spam-registration-functions)) + +(defun spam-unregistration-check-valid-p (check) + (assoc check spam-registration-functions)) + +(defun spam-registration-function (classification check) + (let ((flist (cdr-safe (assoc check spam-registration-functions)))) + (if (eq classification 'spam) + (nth 1 flist) + (nth 0 flist)))) + +(defun spam-unregistration-function (classification check) + (let ((flist (cdr-safe (assoc check spam-registration-functions)))) + (if (eq classification 'spam) + (nth 3 flist) + (nth 2 flist)))) + +(defun spam-list-articles (articles classification) + (let ((mark-check (if (eq classification 'spam) + 'spam-group-spam-mark-p + 'spam-group-ham-mark-p)) + mark list) + (dolist (article articles) + (when (funcall mark-check + gnus-newsgroup-name + (gnus-summary-article-mark article)) + (push article list))) + list)) + +(defun spam-register-routine (classification + check + &optional unregister + specific-articles) + (when (and (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let* ((register-function + (spam-registration-function classification check)) + (unregister-function + (spam-unregistration-function classification check)) + (run-function (if unregister + unregister-function + register-function)) + (log-function (if unregister + 'spam-log-undo-registration + 'spam-log-processing-to-registry)) + article articles) + + (when run-function + ;; make list of articles, using specific-articles if given + (setq articles (or specific-articles + (spam-list-articles + gnus-newsgroup-articles + classification))) + ;; process them + (gnus-message 5 "%s %d %s articles with classification %s, check %s" + (if unregister "Unregistering" "Registering") + (length articles) + (if specific-articles "specific" "") + (symbol-name classification) + (symbol-name check)) + (funcall run-function articles) + ;; now log all the registrations (or undo them, depending on unregister) + (dolist (article articles) + (funcall log-function + (spam-fetch-field-message-id-fast article) + 'process + classification + check + gnus-newsgroup-name)))))) + +;;; log a ham- or spam-processor invocation to the registry +(defun spam-log-processing-to-registry (id type classification check group) + (when spam-log-to-registry + (if (and (stringp id) + (stringp group) + (spam-process-type-valid-p type) + (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + (cell (list classification check group))) + (push cell cell-list) + (gnus-registry-store-extra-entry + id + type + cell-list)) + + (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group" + "spam-log-processing-to-registry"))))) + +;;; check if a ham- or spam-processor registration has been done +(defun spam-log-registered-p (id type) + (when spam-log-to-registry + (if (and (stringp id) + (spam-process-type-valid-p type)) + (cdr-safe (gnus-registry-fetch-extra id type)) + (progn + (gnus-message 5 (format "%s called with bad ID, type, classification, or check" + "spam-log-registered-p")) + nil)))) + +;;; check if a ham- or spam-processor registration needs to be undone +(defun spam-log-unregistration-needed-p (id type classification check) + (when spam-log-to-registry + (if (and (stringp id) + (spam-process-type-valid-p type) + (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + found) + (dolist (cell cell-list) + (unless found + (when (and (eq classification (nth 0 cell)) + (eq check (nth 1 cell))) + (setq found t)))) + found) + (progn + (gnus-message 5 (format "%s called with bad ID, type, classification, or check" + "spam-log-unregistration-needed-p")) + nil)))) + + +;;; undo a ham- or spam-processor registration (the group is not used) +(defun spam-log-undo-registration (id type classification check &optional group) + (when (and spam-log-to-registry + (spam-log-unregistration-needed-p id type classification check)) + (if (and (stringp id) + (spam-process-type-valid-p type) + (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + new-cell-list found) + (dolist (cell cell-list) + (unless (and (eq classification (nth 0 cell)) + (eq check (nth 1 cell))) + (push cell new-cell-list))) + (gnus-registry-store-extra-entry + id + type + new-cell-list)) + (progn + (gnus-message 5 (format "%s called with bad ID, type, check, or group" + "spam-log-undo-registration")) + nil)))) + +;;; set up IMAP widening if it's necessary (defun spam-setup-widening () (dolist (check spam-list-of-statistical-checks) (when (symbol-value check) (setq nnimap-split-download-body-default t)))) -(add-hook 'gnus-get-new-news-hook 'spam-setup-widening) + +;;;; Regex body + +(defun spam-check-regex-body () + (let ((spam-regex-headers-ham spam-regex-body-ham) + (spam-regex-headers-spam spam-regex-body-spam)) + (spam-check-regex-headers t))) ;;;; Regex headers -(defun spam-check-regex-headers () - (let (ret found) +(defun spam-check-regex-headers (&optional body) + (let ((type (if body "body" "header")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + ret found) (dolist (h-regex spam-regex-headers-ham) (unless found (goto-char (point-min)) (when (re-search-forward h-regex nil t) - (message "Ham regex header search positive.") + (message "Ham regex %s search positive." type) (setq found t)))) (dolist (s-regex spam-regex-headers-spam) (unless found (goto-char (point-min)) (when (re-search-forward s-regex nil t) - (message "Spam regex header search positive." (match-string 1)) + (message "Spam regex %s search positive." type) (setq found t) (setq ret spam-split-group)))) ret)) @@ -670,9 +1202,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;;; Blackholes. +(defun spam-reverse-ip-string (ip) + (when (stringp ip) + (mapconcat 'identity + (nreverse (split-string ip "\\.")) + "."))) + (defun spam-check-blackholes () "Check the Received headers for blackholed relays." - (let ((headers (message-fetch-field "received")) + (let ((headers (nnmail-fetch-field "received")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) ips matches) (when headers (with-temp-buffer @@ -680,29 +1221,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (goto-char (point-min)) (gnus-message 5 "Checking headers for relay addresses") (while (re-search-forward - "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t) + "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) - (push (mapconcat 'identity - (nreverse (split-string (match-string 1) "\\.")) - ".") + (push (spam-reverse-ip-string (match-string 1)) ips))) (dolist (server spam-blackhole-servers) (dolist (ip ips) (unless (and spam-blackhole-good-server-regex - (string-match spam-blackhole-good-server-regex ip)) - (let ((query-string (concat ip "." server))) - (if spam-use-dig - (let ((query-result (query-dig query-string))) - (when query-result - (gnus-message 5 "(DIG): positive blackhole check '%s'" - query-result) - (push (list ip server query-result) - matches))) - ;; else, if not using dig.el - (when (query-dns query-string) - (gnus-message 5 "positive blackhole check") - (push (list ip server (query-dns query-string 'TXT)) - matches)))))))) + ;; match the good-server-regex against the reversed (again) IP string + (string-match + spam-blackhole-good-server-regex + (spam-reverse-ip-string ip))) + (unless matches + (let ((query-string (concat ip "." server))) + (if spam-use-dig + (let ((query-result (query-dig query-string))) + (when query-result + (gnus-message 5 "(DIG): positive blackhole check '%s'" + query-result) + (push (list ip server query-result) + matches))) + ;; else, if not using dig.el + (when (query-dns query-string) + (gnus-message 5 "positive blackhole check") + (push (list ip server (query-dns query-string 'TXT)) + matches))))))))) (when matches spam-split-group))) @@ -714,7 +1257,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-check-hashcash () "Check the headers for hashcash payments." - (mail-check-payment))) ;mail-check-payment returns a boolean + (mail-check-payment))) ;mail-check-payment returns a boolean (file-error (progn (defalias 'mail-check-payment 'ignore) @@ -732,36 +1275,52 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (require 'bbdb) (require 'bbdb-com) - (defun spam-enter-ham-BBDB (from) - "Enter an address into the BBDB; implies ham (non-spam) sender" - (when (stringp from) - (let* ((parsed-address (gnus-extract-address-components from)) - (name (or (car parsed-address) "Ham Sender")) - (net-address (car (cdr parsed-address)))) - (gnus-message 5 "Adding address %s to BBDB" from) - (when (and net-address - (not (bbdb-search-simple nil net-address))) - (bbdb-create-internal name nil net-address nil nil - "ham sender added by spam.el"))))) - - (defun spam-BBDB-register-routine () - (spam-generic-register-routine - ;; spam function - nil - ;; ham function - (lambda (article) - (spam-enter-ham-BBDB (spam-fetch-field-from-fast article))))) - - (defun spam-check-BBDB () - "Mail from people in the BBDB is classified as ham or non-spam" - (let ((who (message-fetch-field "from"))) - (when who - (setq who (cadr (gnus-extract-address-components who))) - (if (bbdb-search-simple nil who) - t - (if spam-use-BBDB-exclusive - spam-split-group - nil)))))) + (defun spam-enter-ham-BBDB (addresses &optional remove) + "Enter an address into the BBDB; implies ham (non-spam) sender" + (dolist (from addresses) + (when (stringp from) + (let* ((parsed-address (gnus-extract-address-components from)) + (name (or (nth 0 parsed-address) "Ham Sender")) + (remove-function (if remove + 'bbdb-delete-record-internal + 'ignore)) + (net-address (nth 1 parsed-address)) + (record (and net-address + (bbdb-search-simple nil net-address)))) + (when net-address + (gnus-message 5 "%s address %s %s BBDB" + (if remove "Deleting" "Adding") + from + (if remove "from" "to")) + (if record + (funcall remove-function record) + (bbdb-create-internal name nil net-address nil nil + "ham sender added by spam.el"))))))) + + (defun spam-BBDB-register-routine (articles &optional unregister) + (let (addresses) + (dolist (article articles) + (when (stringp (spam-fetch-field-from-fast article)) + (push (spam-fetch-field-from-fast article) addresses))) + ;; now do the register/unregister action + (spam-enter-ham-BBDB addresses unregister))) + + (defun spam-BBDB-unregister-routine (articles) + (spam-BBDB-register-routine articles t)) + + (defun spam-check-BBDB () + "Mail from people in the BBDB is classified as ham or non-spam" + (let ((who (nnmail-fetch-field "from")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when who + (setq who (nth 1 (gnus-extract-address-components who))) + (if (bbdb-search-simple nil who) + t + (if spam-use-BBDB-exclusive + spam-split-group + nil)))))) (file-error (progn (defalias 'bbdb-search-simple 'ignore) @@ -769,6 +1328,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defalias 'spam-BBDB-register-routine 'ignore) (defalias 'spam-enter-ham-BBDB 'ignore) (defalias 'bbdb-create-internal 'ignore) + (defalias 'bbdb-delete-record-internal 'ignore) (defalias 'bbdb-records 'ignore)))) @@ -778,7 +1338,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;; as spam (defun spam-get-ifile-database-parameter () - "Get the command-line parameter for ifile's database from spam-ifile-database-path." + "Get the command-line parameter for ifile's database from + spam-ifile-database-path." (if spam-ifile-database-path (format "--db-file=%s" spam-ifile-database-path) nil)) @@ -786,17 +1347,20 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-check-ifile () "Check the ifile backend for the classification of this message" (let ((article-buffer-name (buffer-name)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) category return) (with-temp-buffer (let ((temp-buffer-name (buffer-name)) (db-param (spam-get-ifile-database-parameter))) (save-excursion (set-buffer article-buffer-name) - (if db-param - (call-process-region (point-min) (point-max) spam-ifile-path - nil temp-buffer-name nil "-q" "-c" db-param) - (call-process-region (point-min) (point-max) spam-ifile-path - nil temp-buffer-name nil "-q" "-c"))) + (apply 'call-process-region + (point-min) (point-max) spam-ifile-path + nil temp-buffer-name nil "-c" + (if db-param `(,db-param "-q") `("-q")))) + ;; check the return now (we're back in the temp buffer) (goto-char (point-min)) (if (not (eobp)) (setq category (buffer-substring (point) (spam-point-at-eol)))) @@ -805,38 +1369,38 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (setq return category) ;; else, if spam-ifile-all-categories is not set... (when (string-equal spam-ifile-spam-category category) - (setq return spam-split-group)))))) + (setq return spam-split-group)))))) ; note return is nil otherwise return)) -(defun spam-ifile-register-with-ifile (article-string category) +(defun spam-ifile-register-with-ifile (articles category &optional unregister) "Register an article, given as a string, with a category. Uses `gnus-newsgroup-name' if category is nil (for ham registration)." - (when (stringp article-string) - (let ((category (or category gnus-newsgroup-name)) - (db-param (spam-get-ifile-database-parameter))) - (with-temp-buffer - (insert article-string) - (if db-param - (call-process-region (point-min) (point-max) spam-ifile-path - nil nil nil - "-h" "-i" category db-param) - (call-process-region (point-min) (point-max) spam-ifile-path - nil nil nil - "-h" "-i" category)))))) - -(defun spam-ifile-register-spam-routine () - (spam-generic-register-routine - (lambda (article) - (spam-ifile-register-with-ifile - (spam-get-article-as-string article) spam-ifile-spam-category)) - nil)) - -(defun spam-ifile-register-ham-routine () - (spam-generic-register-routine - nil - (lambda (article) - (spam-ifile-register-with-ifile - (spam-get-article-as-string article) spam-ifile-ham-category)))) + (let ((category (or category gnus-newsgroup-name)) + (add-or-delete-option (if unregister "-d" "-i")) + (db (spam-get-ifile-database-parameter)) + parameters) + (with-temp-buffer + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (when (stringp article-string) + (insert article-string)))) + (apply 'call-process-region + (point-min) (point-max) spam-ifile-path + nil nil nil + add-or-delete-option category + (if db `(,db "-h") `("-h")))))) + +(defun spam-ifile-register-spam-routine (articles &optional unregister) + (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) + +(defun spam-ifile-unregister-spam-routine (articles) + (spam-ifile-register-spam-routine articles t)) + +(defun spam-ifile-register-ham-routine (articles &optional unregister) + (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister)) + +(defun spam-ifile-unregister-ham-routine (articles) + (spam-ifile-register-ham-routine articles t)) ;;;; spam-stat @@ -848,48 +1412,58 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (defun spam-check-stat () "Check the spam-stat backend for the classification of this message" - (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + (spam-stat-split-fancy-spam-group spam-split-group) ; override (spam-stat-buffer (buffer-name)) ; stat the current buffer category return) (spam-stat-split-fancy))) - (defun spam-stat-register-spam-routine () - (spam-generic-register-routine - (lambda (article) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (spam-stat-buffer-is-spam)))) - nil)) - - (defun spam-stat-register-ham-routine () - (spam-generic-register-routine - nil - (lambda (article) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (spam-stat-buffer-is-non-spam)))))) + (defun spam-stat-register-spam-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-non-spam) + (spam-stat-buffer-is-spam)))))) + + (defun spam-stat-unregister-spam-routine (articles) + (spam-stat-register-spam-routine articles t)) + + (defun spam-stat-register-ham-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-spam) + (spam-stat-buffer-is-non-spam)))))) + + (defun spam-stat-unregister-ham-routine (articles) + (spam-stat-register-ham-routine articles t)) (defun spam-maybe-spam-stat-load () (when spam-use-stat (spam-stat-load))) (defun spam-maybe-spam-stat-save () - (when spam-use-stat (spam-stat-save))) - - ;; 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)) + (when spam-use-stat (spam-stat-save)))) (file-error (progn + (defalias 'spam-stat-load 'ignore) + (defalias 'spam-stat-save 'ignore) + (defalias 'spam-maybe-spam-stat-load 'ignore) + (defalias 'spam-maybe-spam-stat-save 'ignore) (defalias 'spam-stat-register-ham-routine 'ignore) + (defalias 'spam-stat-unregister-ham-routine 'ignore) (defalias 'spam-stat-register-spam-routine 'ignore) + (defalias 'spam-stat-unregister-spam-routine 'ignore) (defalias 'spam-stat-buffer-is-spam 'ignore) + (defalias 'spam-stat-buffer-change-to-spam 'ignore) (defalias 'spam-stat-buffer-is-non-spam 'ignore) + (defalias 'spam-stat-buffer-change-to-non-spam 'ignore) (defalias 'spam-stat-split-fancy 'ignore) - (defalias 'spam-stat-load 'ignore) - (defalias 'spam-stat-save 'ignore) (defalias 'spam-check-stat 'ignore)))) @@ -899,47 +1473,77 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (defvar spam-whitelist-cache nil) (defvar spam-blacklist-cache nil) -(defun spam-enter-whitelist (address) - "Enter ADDRESS into the whitelist." +(defun spam-kill-whole-line () + (beginning-of-line) + (let ((kill-whole-line t)) + (kill-line))) + +;;; address can be a list, too +(defun spam-enter-whitelist (address &optional remove) + "Enter ADDRESS (list or single) into the whitelist. With a + non-nil REMOVE, remove them." (interactive "sAddress: ") - (spam-enter-list address spam-whitelist) + (spam-enter-list address spam-whitelist remove) (setq spam-whitelist-cache nil)) -(defun spam-enter-blacklist (address) - "Enter ADDRESS into the blacklist." +;;; address can be a list, too +(defun spam-enter-blacklist (address &optional remove) + "Enter ADDRESS (list or single) into the blacklist. With a + non-nil REMOVE, remove them." (interactive "sAddress: ") - (spam-enter-list address spam-blacklist) + (spam-enter-list address spam-blacklist remove) (setq spam-blacklist-cache nil)) -(defun spam-enter-list (address file) - "Enter ADDRESS into the given FILE, either the whitelist or the blacklist." - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (save-excursion - (set-buffer - (find-file-noselect file)) - (goto-char (point-max)) - (unless (bobp) - (insert "\n")) - (insert address "\n") - (save-buffer))) - -;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise +(defun spam-enter-list (addresses file &optional remove) + "Enter ADDRESSES into the given FILE. +Either the whitelist or the blacklist files can be used. With +REMOVE not nil, remove the ADDRESSES." + (if (stringp addresses) + (spam-enter-list (list addresses) file remove) + ;; else, we have a list of addresses here + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (save-excursion + (set-buffer + (find-file-noselect file)) + (dolist (a addresses) + (when (stringp a) + (goto-char (point-min)) + (if (re-search-forward (regexp-quote a) nil t) + ;; found the address + (when remove + (spam-kill-whole-line)) + ;; else, the address was not found + (unless remove + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert a "\n"))))) + (save-buffer)))) + +;;; returns t if the sender is in the whitelist, nil or +;;; spam-split-group otherwise (defun spam-check-whitelist () ;; FIXME! Should it detect when file timestamps change? - (unless spam-whitelist-cache - (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) - (if (spam-from-listed-p spam-whitelist-cache) - t - (if spam-use-whitelist-exclusive - spam-split-group - nil))) + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (unless spam-whitelist-cache + (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) + (if (spam-from-listed-p spam-whitelist-cache) + t + (if spam-use-whitelist-exclusive + spam-split-group + nil)))) (defun spam-check-blacklist () ;; FIXME! Should it detect when file timestamps change? - (unless spam-blacklist-cache - (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) - (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)) + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (unless spam-blacklist-cache + (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) + (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))) (defun spam-parse-list (file) (when (file-readable-p file) @@ -949,60 +1553,100 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (while (not (eobp)) (setq address (buffer-substring (point) (spam-point-at-eol))) (forward-line 1) + ;; insert the e-mail address if detected, otherwise the raw data (unless (zerop (length address)) - (setq address (regexp-quote address)) - (while (string-match "\\\\\\*" address) - (setq address (replace-match ".*" t t address))) - (push address contents)))) + (let ((pure-address (nth 1 (gnus-extract-address-components address)))) + (push (or pure-address address) contents))))) (nreverse contents)))) (defun spam-from-listed-p (cache) - (let ((from (message-fetch-field "from")) + (let ((from (nnmail-fetch-field "from")) found) (while cache - (when (string-match (pop cache) from) - (setq found t - cache nil))) + (let ((address (pop cache))) + (unless (zerop (length address)) ; 0 for a nil address too + (setq address (regexp-quote address)) + ;; fix regexp-quote's treatment of user-intended regexes + (while (string-match "\\\\\\*" address) + (setq address (replace-match ".*" t t address)))) + (when (and address (string-match address from)) + (setq found t + cache nil)))) found)) -(defun spam-blacklist-register-routine () - (spam-generic-register-routine - ;; the spam function - (lambda (article) - (let ((from (spam-fetch-field-from-fast article))) - (when (stringp from) - (spam-enter-blacklist from)))) - ;; the ham function - nil)) - -(defun spam-whitelist-register-routine () - (spam-generic-register-routine - ;; the spam function - nil - ;; the ham function - (lambda (article) - (let ((from (spam-fetch-field-from-fast article))) - (when (stringp from) - (spam-enter-whitelist from)))))) +(defun spam-filelist-register-routine (articles blacklist &optional unregister) + (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) + (declassification (if blacklist 'ham 'spam)) + (enter-function + (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) + (remove-function + (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) + from addresses unregister-list) + (dolist (article articles) + (let ((from (spam-fetch-field-from-fast article)) + (id (spam-fetch-field-message-id-fast article)) + sender-ignored) + (when (stringp from) + (dolist (ignore-regex spam-blacklist-ignored-regexes) + (when (and (not sender-ignored) + (stringp ignore-regex) + (string-match ignore-regex from)) + (setq sender-ignored t))) + ;; remember the messages we need to unregister, unless remove is set + (when (and + (null unregister) + (spam-log-unregistration-needed-p + id 'process declassification de-symbol)) + (push from unregister-list)) + (unless sender-ignored + (push from addresses))))) + + (if unregister + (funcall enter-function addresses t) ; unregister all these addresses + ;; else, register normally and unregister what we need to + (funcall remove-function unregister-list t) + (dolist (article unregister-list) + (spam-log-undo-registration + (spam-fetch-field-message-id-fast article) + 'process + declassification + de-symbol)) + (funcall enter-function addresses nil)))) + +(defun spam-blacklist-unregister-routine (articles) + (spam-blacklist-register-routine articles t)) + +(defun spam-blacklist-register-routine (articles &optional unregister) + (spam-filelist-register-routine articles t unregister)) + +(defun spam-whitelist-unregister-routine (articles) + (spam-whitelist-register-routine articles t)) + +(defun spam-whitelist-register-routine (articles &optional unregister) + (spam-filelist-register-routine articles nil unregister)) ;;;; Spam-report glue -(defun spam-report-gmane-register-routine () - (spam-generic-register-routine - 'spam-report-gmane - nil)) +(defun spam-report-gmane-register-routine (articles) + (when articles + (apply 'spam-report-gmane articles))) ;;;; Bogofilter (defun spam-check-bogofilter-headers (&optional score) - (let ((header (message-fetch-field spam-bogofilter-header))) - (when (and header - (string-match spam-bogofilter-bogosity-positive-spam-header - header)) - (if score - (when (string-match "spamicity=\\([0-9.]+\\)" header) - (match-string 1 header)) - spam-split-group)))) + (let ((header (nnmail-fetch-field spam-bogofilter-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (if score ; scoring mode + (if (string-match "spamicity=\\([0-9.]+\\)" header) + (match-string 1 header) + "0") + ;; spam detection mode + (when (string-match spam-bogofilter-bogosity-positive-spam-header + header) + spam-split-group))))) ;; return something sensible if the score can't be determined (defun spam-bogofilter-score () @@ -1014,54 +1658,159 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (let ((score (or (spam-check-bogofilter-headers t) (spam-check-bogofilter t)))) (message "Spamicity score %s" score) - (or score "0")))) + (or score "0")) + (gnus-summary-show-article))) (defun spam-check-bogofilter (&optional score) "Check the Bogofilter backend for the classification of this message" - (let ((article-buffer-name (buffer-name)) + (let ((article-buffer-name (buffer-name)) + (db spam-bogofilter-database-directory) return) (with-temp-buffer (let ((temp-buffer-name (buffer-name))) (save-excursion (set-buffer article-buffer-name) - (if spam-bogofilter-database-directory - (call-process-region (point-min) (point-max) - spam-bogofilter-path - nil temp-buffer-name nil "-v" - "-d" spam-bogofilter-database-directory) - (call-process-region (point-min) (point-max) spam-bogofilter-path - nil temp-buffer-name nil "-v"))) + (apply 'call-process-region + (point-min) (point-max) + spam-bogofilter-path + nil temp-buffer-name nil + (if db `("-d" ,db "-v") `("-v")))) (setq return (spam-check-bogofilter-headers score)))) return)) -(defun spam-bogofilter-register-with-bogofilter (article-string spam) +(defun spam-bogofilter-register-with-bogofilter (articles + spam + &optional unregister) "Register an article, given as a string, as spam or non-spam." - (when (stringp article-string) - (let ((switch (if spam spam-bogofilter-spam-switch - spam-bogofilter-ham-switch))) - (with-temp-buffer - (insert article-string) - (if spam-bogofilter-database-directory - (call-process-region (point-min) (point-max) - spam-bogofilter-path - nil nil nil "-v" switch - "-d" spam-bogofilter-database-directory) - (call-process-region (point-min) (point-max) spam-bogofilter-path - nil nil nil "-v" switch)))))) - -(defun spam-bogofilter-register-spam-routine () - (spam-generic-register-routine - (lambda (article) - (spam-bogofilter-register-with-bogofilter - (spam-get-article-as-string article) t)) - nil)) - -(defun spam-bogofilter-register-ham-routine () - (spam-generic-register-routine - nil - (lambda (article) - (spam-bogofilter-register-with-bogofilter - (spam-get-article-as-string article) nil)))) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (db spam-bogofilter-database-directory) + (switch (if unregister + (if spam + spam-bogofilter-spam-strong-switch + spam-bogofilter-ham-strong-switch) + (if spam + spam-bogofilter-spam-switch + spam-bogofilter-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + + (apply 'call-process-region + (point-min) (point-max) + spam-bogofilter-path + nil nil nil switch + (if db `("-d" ,db "-v") `("-v")))))))) + +(defun spam-bogofilter-register-spam-routine (articles &optional unregister) + (spam-bogofilter-register-with-bogofilter articles t unregister)) + +(defun spam-bogofilter-unregister-spam-routine (articles) + (spam-bogofilter-register-spam-routine articles t)) + +(defun spam-bogofilter-register-ham-routine (articles &optional unregister) + (spam-bogofilter-register-with-bogofilter articles nil unregister)) + +(defun spam-bogofilter-unregister-ham-routine (articles) + (spam-bogofilter-register-ham-routine articles t)) + + + +;;;; spamoracle +(defun spam-check-spamoracle () + "Run spamoracle on an article to determine whether it's spam." + (let ((article-buffer-name (buffer-name)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (let ((status + (apply 'call-process-region + (point-min) (point-max) + spam-spamoracle-binary + nil temp-buffer-name nil + (if spam-spamoracle-database + `("-f" ,spam-spamoracle-database "mark") + '("mark"))))) + (if (eq 0 status) + (progn + (set-buffer temp-buffer-name) + (goto-char (point-min)) + (when (re-search-forward "^X-Spam: yes;" nil t) + spam-split-group)) + (error "Error running spamoracle" status)))))))) + +(defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) + "Run spamoracle in training mode." + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (goto-char (point-min)) + (dolist (article articles) + (insert (spam-get-article-as-string article))) + (let* ((arg (if (spam-xor unregister article-is-spam-p) + "-spam" + "-good")) + (status + (apply 'call-process-region + (point-min) (point-max) + spam-spamoracle-binary + nil temp-buffer-name nil + (if spam-spamoracle-database + `("-f" ,spam-spamoracle-database + "add" ,arg) + `("add" ,arg))))) + (when (not (eq 0 status)) + (error "Error running spamoracle" status))))))) + +(defun spam-spamoracle-learn-ham (articles &optional unregister) + (spam-spamoracle-learn articles nil unregister)) + +(defun spam-spamoracle-unlearn-ham (articles &optional unregister) + (spam-spamoracle-learn-ham articles t)) + +(defun spam-spamoracle-learn-spam (articles &optional unregister) + (spam-spamoracle-learn articles t unregister)) + +(defun spam-spamoracle-unlearn-spam (articles &optional unregister) + (spam-spamoracle-learn-spam articles t)) + + +;;;; Hooks + +;;;###autoload +(defun spam-initialize () + "Install the spam.el hooks and do other initialization" + (interactive) + (setq spam-install-hooks t) + ;; TODO: How do we redo this every time spam-face is customized? + (push '((eq mark gnus-spam-mark) . spam-face) + gnus-summary-highlight) + ;; Add hooks for loading and saving the spam stats + (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) + (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) + (add-hook 'gnus-get-new-news-hook 'spam-setup-widening) + (add-hook 'gnus-summary-prepare-hook 'spam-find-spam)) + +(defun spam-unload-hook () + "Uninstall the spam.el hooks" + (interactive) + (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) + (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) + (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) + (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) + +(when spam-install-hooks + (spam-initialize)) (provide 'spam) diff --git a/lisp/tls.el b/lisp/tls.el index 7027077..af05ff2 100644 --- a/lisp/tls.el +++ b/lisp/tls.el @@ -66,7 +66,7 @@ after successful negotiation." :group 'tls) (defcustom tls-process-connection-type nil - "*Value for `process-connection-type' to use when starting process." + "*Value for `process-connection-type' to use when starting TLS process." :type 'boolean :group 'tls) diff --git a/texi/ChangeLog b/texi/ChangeLog index e351903..3f340b0 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,6 +1,392 @@ +2003-12-30 Lars Magne Ingebrigtsen + + * gnus.texi (Maildir): Filled. + +2003-12-29 Lars Magne Ingebrigtsen + + * gnus.texi (Group Parameters): Clarification. + +2003-12-29 Simon Josefsson + + * gnus.texi (Agent Variables): Add. + +2003-12-23 Reiner Steib + + * gnus.texi (Oort Gnus): Mention change of `e' in draft groups. + +2003-12-15 Jesper Harder + + * gnus.texi (Group Parameters): Clarify. + +2003-12-11 Kevin Greiner + + * gnus.texi (Agent Parameters): Added references in Topic and + Group Parameters. Added gnus-agent-cat-disable-undownloaded-faces + to the list of documented agent parameters. + +2003-12-11 Jesper Harder + + * message.texi (Mailing Lists): Fix typo. + +2003-12-04 Katsumi Yamaoka + + * gnus.texi (Fancy Mail Splitting): Close paren of a Lisp function. + (SpamAssassin): Ditto. + +2003-12-04 Teodor Zlatanov + + * gnus.texi (SpamAssassin, Fancy Mail Splitting): add + save-restriction before (widen) in the example. From Kevin Ryde + . + +2003-12-03 Simon Josefsson + + * emacs-mime.texi (Flowed text): Fix. + +2003-12-02 Simon Josefsson + + * gnus.texi (Agent Variables): Fix. + +2003-12-01 Jesper Harder + + * gnus.texi: Add missing mode to some @kindex'es. + +2003-11-30 Jesper Harder + + * gnus.texi (RSS): Add nnrss-use-local. + (Foreign Groups): Add `G R'. + +2003-11-29 Jesper Harder + + * gnusref.tex (subsection*{Notes}): Add `G R'. + +2003-11-25 Jesper Harder + + * gnus.texi (Hiding Headers): Update. + +2003-11-20 Teodor Zlatanov + + * gnus.texi (Debugging IMAP): minor corrections + +2003-11-20 Reiner Steib + + * gnus.texi (Finding the Parent): nnml does supports fetching by + MID. + +2003-11-20 Simon Josefsson + + * gnus.texi (Debugging IMAP): Add. + +2003-11-19 Katsumi Yamaoka + + * gnus.texi (Score Decays): Update the gnus-decay-score function. + +2003-11-17 Jesper Harder + + * gnus.texi (Troubleshooting): Update. + +2003-11-03 Teodor Zlatanov + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): added + some clarifications + +2003-10-30 Teodor Zlatanov + + * gnus.texi (Fancy Mail Splitting): added mention of + nnmail-split-fancy-match-partial-words + +2003-10-30 Jesper Harder + + * gnus.texi (Slashdot, SpamAssassin, Score File Format): Fix + overfull hbox. + (Topic Parameters): @group. + (Slashdot): Fix. + +2003-10-27 Teodor Zlatanov + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): added + example of using a string as a parameter to spam-split in order + to override the default spam-split-group value + +2003-10-27 Jesper Harder + + * gnusref.tex (subsection*{Notes}): do. + + * gnus.texi (Exiting the Summary Buffer): Add keybinding. + +2003-10-23 Reiner Steib + + * emacs-mime.texi: Markup: Use @acronym for MML and MIME. + + * message.texi: Ditto. + + * gnus.texi: Ditto. + +2003-10-23 Simon Josefsson + + * emacs-mime.texi (MML Definition): Add format. + +2003-10-22 Teodor Zlatanov + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): + changed to use the new spam-initialize function + +2003-10-19 Reiner Steib + + * message.texi (Mailing Lists): Add Mail-Followup-To to index. + + * gnus.texi (Group Parameters): Add Mail-Followup-To to index. + (Emacsen): Fixed typo. + (Oort Gnus): Mention message-forward-show-mml change (Sync with + GNUS-NEWS). + +2003-10-12 Adrian Aichner + + * gnus.texi (Mail Source Specifiers): uref fixes. + +2003-10-18 Jesper Harder + + * gnus.texi (Group Mail Splitting) + (Filtering Spam Using The Spam ELisp Package): Markup fixes. + + * message.texi (Security): @url -> @uref. + +2003-10-18 Lars Magne Ingebrigtsen + + * gnus.texi: Define gnusasis and gnusurl. + +2003-10-12 Jesper Harder + + * gnus.texi (Group Mail Splitting): Markup fix. + +2003-10-03 Jesper Harder + + * emacs-mime.texi (Files and Directories): Update. + +2003-10-02 Teodor Zlatanov + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): added + spam-process-ham-in-spam-groups and + spam-process-ham-in-nonham-groups variable descriptions + +2003-10-01 Jesper Harder + + * message.texi (Various Message Variables): Typo. + + * gnus.texi (Oort Gnus): Typo. + (Filtering Spam Using The Spam ELisp Package): Just remember, + kids: There is no 'c' in 'supersede'. + +2003-09-27 Jesper Harder + + * message.texi (Reply): Fix typo. + +2003-09-22 Teodor Zlatanov + + * gnus.texi (Fancy Mail Splitting, SpamAssassin): corrected fancy + split example to use current buffer, mentioned + nnimap-split-download-body + +2003-09-22 Jesper Harder + + * gnus.texi, gnus-faq.texi, message.texi: gnus -> Gnus. + + * message.texi: Fixes. + +2003-09-20 Jesper Harder + + * gnus.texi (Fancy Mail Splitting): Make split-on-body work for + respooling. Suggested by Harald Maier . + (Fancy Mail Splitting): Reformat. + +2003-09-15 Jesper Harder + + * gnus.texi (Posting Styles): Fix typo. @itemize attribute names. + +2003-09-14 Jesper Harder + + * pgg.texi (Selecting an implementation, Caching passphrase) + (Initializing): Markup fix. + +2003-09-12 Jesper Harder + + * gnus.texi (Summary Buffer Lines): Formatting fix. + +2003-09-03 Jesper Harder + + * gnus.texi (Creating a Virtual Server): Use nnml for the example. + nnspool doesn't work on ms-windows due to file name restrictions. + +2003-08-29 Teodor Zlatanov + + * gnus.texi (Gmane Spam Reporting): added explanation of + spam-report-gmane-use-article-number + +2003-08-25 Jesper Harder + + * gnus.texi (Customizing Articles): xface -> x-face. + +2003-08-20 Simon Josefsson + + * gnus.texi (GroupLens): Move text around. + +2003-08-16 Jesper Harder + + * gnus.texi (Searching for Articles): Fix example. + +2003-08-08 Jesper Harder + + * gnus.texi (Kibozed Groups): Fix. + +2003-08-04 Jesper Harder + + * gnus.texi (Group Parameters): Add expiry-target. + (Archived Messages): Layout fix. + +2003-07-22 Jesper Harder + + * gnus.texi (Top): Menu fixes and additions. + +2003-07-19 Jesper Harder + + * emacs-mime.texi (Encoding Customization): Fix. + (MML Definition): Typo. + +2003-07-17 Jesper Harder + + * gnus.texi (Sorting the Summary Buffer): Index. + +2003-07-15 Reiner Steib + + * gnus-faq.texi ([3.8]): Fixed example. + +2003-07-14 Teodor Zlatanov + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): + mentioned the spam-install-hooks mess + +2003-07-11 Simon Josefsson + + * gnus.texi (Splitting in IMAP): Typos, tiny patch from Matthias + Andree . + (Splitting in IMAP): Mention Sieve. + +2003-07-10 Simon Josefsson + + * message.texi (Security): Discuss the PGP 2.x compatibility + problem. + +2003-06-24 Jesper Harder + + * sieve.texi (Sieve Mode): Formatting fix. + + * gnus.texi (Agent Basics, Group Parameters, Quassia Gnus): do. + +2003-06-24 Lars Magne Ingebrigtsen + + * gnus.texi (Summary Mail Commands): Make note of + Mail-Followup-To. + +2003-06-23 Jesper Harder + + * gnus.texi: Formatting fixes. + +2003-06-22 Simon Josefsson + + * message.texi (Security): Mention S/MIME passphrases. + +2003-06-20 Jesper Harder + + * gnus.texi: Add @command. + + * texi2latex.el (latexi-translate-file): Add @command and @:. + + * gnus.texi (Face): Use @uref. + +2003-06-19 Jesper Harder + + * gnus.texi (Sieve Commands, Agent Basics, SpamOracle): @xref + fixes. + +2003-06-18 Didier Verna + + * gnus.texi (Face): New node. + * gnus.texi (Article Display): Reference it. + * gnus.texi (Customizing Articles): Ditto. + * gnus.texi (Image Enhancements): Put the Face node into the menu. + +2003-06-17 Kai Gro,A_(Bjohann + + * gnus.texi (Splitting Mail): Add "splitting" entry and concept + index entries. Small patch from Karl Pfl,Ad(Bsterer + . + +2003-06-15 Reiner Steib + + * gnus.texi (Daemons): Fixed typo. + +2003-06-15 Kai Gro,A_(Bjohann + + * message.texi (Message Headers): Extend + `message-subject-re-regexp' example. From Niklas Morberg + . + +2003-06-11 Teodor Zlatanov + + * gnus.texi (Bogofilter): revise docs to mention threshold is now + user-controllable + +2003-06-10 Jesper Harder + + * emacs-mime.texi: Use two spaces consistently to end sentences. + + * message.texi: do. + + * gnus.texi: do. + +2003-06-09 Teodor Zlatanov + + * gnus.texi (Filtering Spam Using The Spam ELisp Package): new + SpamOracle node + (SpamOracle): document new SpamOracle code + +2003-06-07 Jesper Harder + + * gnus.texi (Article Buttons, Splitting in IMAP) + (Category Syntax, Picons): Preemptive strike by + alt.possesive.its.has.no.apostrophe. + +2003-06-03 Jesper Harder + + * gnus.texi (Fancy Mail Splitting): Explain some entries in + nnmail-split-abbrev-alist. + +2003-05-17 Adrian Aichner + + * emacs-mime.texi (Charset Translation): Ruthless typo fixing. + * gnus.texi (Top): Ditto. + * gnus.texi (Selecting a Group): Ditto. + * gnus.texi (Delayed Articles): Ditto. + * gnus.texi (Hiding Headers): Ditto. + * gnus.texi (Getting Mail): Ditto. + * gnus.texi (Comparing Mail Back Ends): Ditto. + * gnus.texi (IMAP): Ditto. + * gnus.texi (Required Back End Functions): Ditto. + * gnusref.tex (MIMESummary): Ditto. + * message.texi (Message Headers): Ditto. + * message.texi (Mail Variables): Ditto. + * pgg.texi (Prerequisites): Ditto. + * pgg.texi (Architecture): Ditto. + * pgg.texi (Backend methods): Ditto. + * sieve.texi (Managing Sieve): Ditto. + +2003-05-17 Jesper Harder + + * gnusref.tex (subsection*{Notes}): Fix. + 2003-05-13 Lars Magne Ingebrigtsen - * gnus.texi (Anti-Spam Basics): Removed mention of gnus-junk. + * gnus.texi (Anti-Spam Basics): Removed mention of gnus-junk. 2003-05-13 Jesper Harder @@ -61,11 +447,11 @@ * texi2latex.el (latexi-translate-file): Add @syncodeindex. - * gnus.texi: Markup and formatting improvements. + * gnus.texi: Markup and formatting improvements. Use @syncodeindex for merging indexes to get the same font for @defvar and @vindex entries. Be more consistent about the case of index entries. - + 2003-04-30 Reiner Steib @@ -141,7 +527,7 @@ * gnus-faq.texi: Allow inclusion in `gnus.texi' again. 2003-04-21 Reiner Steib - + * gnus-faq.texi: New, the Gnus FAQ from http://my.gnus.org/FAQ. From Frank Schmitt . diff --git a/texi/Makefile.in b/texi/Makefile.in index 4258414..686a2a3 100644 --- a/texi/Makefile.in +++ b/texi/Makefile.in @@ -133,8 +133,8 @@ gnus.latexi gnus-faq.latexi message.latexi emacs-mime.latexi sieve.latexi pgg.la egrep -v "end\{document\}" $< > gnus.tmplatexi cat $(srcdir)/postamble.tex >> gnus.tmplatexi TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi - thumbpdf gnus.pdf - TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi + #thumbpdf gnus.pdf + #TEXINPUTS=$(srcdir):$$TEXINPUTS $(PDFLATEX) gnus.tmplatexi mv gnus.pdf $@ latexps: gnus.dvi-x diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 40b91b1..7b5cce0 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -93,7 +93,7 @@ read at least RFC2045 and RFC2047. @menu * Decoding and Viewing:: A framework for decoding and viewing. -* Composing:: MML; a language for describing @acronym{MIME} parts. +* Composing:: @acronym{MML}; a language for describing @acronym{MIME} parts. * Interface Functions:: An abstraction over the basic functions. * Basic Functions:: Utility and basic parsing functions. * Standards:: A summary of RFCs and working documents used. @@ -430,6 +430,16 @@ parts. Each function is applied successively to the file name. Ready-made functions include @table @code +@item mm-file-name-delete-control +@findex mm-file-name-delete-control +Delete all control characters. + +@item mm-file-name-delete-gotchas +@findex mm-file-name-delete-gotchas +Delete characters that could have unintended consequences when used +with flawed shell scripts, i.e. @samp{|}, @samp{>} and @samp{<}; and +@samp{-}, @samp{.} as the first character. + @item mm-file-name-delete-whitespace @findex mm-file-name-delete-whitespace Remove all whitespace. @@ -448,7 +458,6 @@ Collapse multiple whitespace characters. 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}, @@ -499,9 +508,10 @@ tell it to insert, but it also sets things up so that the text can be @cindex MML @cindex MIME Meta Language -Creating a @acronym{MIME} message is boring and non-trivial. Therefore, a -library called @code{mml} has been defined that parses a language called -MML (@acronym{MIME} Meta Language) and generates @acronym{MIME} messages. +Creating a @acronym{MIME} message is boring and non-trivial. Therefore, +a library called @code{mml} has been defined that parses a language +called @acronym{MML} (@acronym{MIME} Meta Language) and generates +@acronym{MIME} messages. @findex mml-generate-mime The main interface function is @code{mml-generate-mime}. It will @@ -509,12 +519,12 @@ examine the contents of the current (narrowed-to) buffer and return a string containing the @acronym{MIME} message. @menu -* Simple MML Example:: An example MML document. -* MML Definition:: All valid MML elements. -* Advanced MML Example:: Another example MML document. +* Simple MML Example:: An example @acronym{MML} document. +* MML Definition:: All valid @acronym{MML} elements. +* Advanced MML Example:: Another example @acronym{MML} document. * Encoding Customization:: Variables that affect encoding. * Charset Translation:: How charsets are mapped from @sc{mule} to @acronym{MIME}. -* Conversion:: Going from @acronym{MIME} to MML and vice versa. +* Conversion:: Going from @acronym{MIME} to @acronym{MML} and vice versa. * Flowed text:: Soft and hard newlines. @end menu @@ -556,10 +566,10 @@ Content-Type: text/enriched @node MML Definition @section MML Definition -The MML language is very simple. It looks a bit like an SGML +The @acronym{MML} language is very simple. It looks a bit like an SGML application, but it's not. -The main concept of MML is the @dfn{part}. Each part can be of a +The main concept of @acronym{MML} is the @dfn{part}. Each part can be of a different type or use a different charset. The way to delineate a part is with a @samp{<#part ...>} tag. Multipart parts can be introduced with the @samp{<#multipart ...>} tag. Parts are ended by the @@ -574,8 +584,8 @@ Each tag can contain zero or more parameters on the form but that's not necessary unless the value contains white space. So @samp{filename=/home/user/#hello$^yes} is perfectly valid. -The following parameters have meaning in MML; parameters that have no -meaning are ignored. The MML parameter names are the same as the +The following parameters have meaning in @acronym{MML}; parameters that have no +meaning are ignored. The @acronym{MML} parameter names are the same as the @acronym{MIME} parameter names; the things in the parentheses say which header it will be used in. @@ -589,7 +599,7 @@ Use the contents of the file in the body of the part @item charset The contents of the body of the part are to be encoded in the character -set speficied (@code{Content-Type}). @xref{Charset Translation}. +set specified (@code{Content-Type}). @xref{Charset Translation}. @item name Might be used to suggest a file name if the part is to be saved @@ -628,15 +638,25 @@ default key used. The size (in octets) of the part (@code{Content-Disposition}). @item sign -What technology to sign this MML part with (@code{smime}, @code{pgp} +What technology to sign this @acronym{MML} part with (@code{smime}, @code{pgp} or @code{pgpmime}) @item encrypt -What technology to encrypt this MML part with (@code{smime}, +What technology to encrypt this @acronym{MML} part with (@code{smime}, @code{pgp} or @code{pgpmime}) @end table +Parameters for @samp{text/plain}: + +@table @samp +@item format +Formatting parameter for the text, valid values include @samp{fixed} +(the default) and @samp{flowed}. Normally you do not specify this +manually, since it requires the textual body to be formatted in a +special way described in RFC 2646. @xref{Flowed text}. +@end table + Parameters for @samp{application/octet-stream}: @table @samp @@ -794,7 +814,7 @@ default is As an example, if you do not want to have ISO-8859-1 characters quoted-printable encoded, you may add @code{(iso-8859-1 . 8bit)} to this variable. You can override this setting on a per-message basis -by using the @code{encoding} MML tag (@pxref{MML Definition}). +by using the @code{encoding} @acronym{MML} tag (@pxref{MML Definition}). @item mm-coding-system-priorities @vindex mm-coding-system-priorities @@ -803,20 +823,20 @@ is @code{nil}, which means to use the defaults in Emacs. It is a list of coding system symbols (aliases of coding systems does not work, use @kbd{M-x describe-coding-system} to make sure you are not specifying an alias in this variable). For example, if you have configured Emacs -to use prefer UTF-8, but wish that outgoing messages should be sent in +to prefer UTF-8, but wish that outgoing messages should be sent in ISO-8859-1 if possible, you can set this variable to -@code{(iso-latin-1)}. You can override this setting on a per-message -basis by using the @code{charset} MML tag (@pxref{MML Definition}). +@code{(iso-latin-1)}. You can override this setting on a per-message +basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). @item mm-content-transfer-encoding-defaults @vindex mm-content-transfer-encoding-defaults Mapping from @acronym{MIME} types to encoding to use. This variable is usually used except, e.g., when other requirements force a safer encoding -(digitally signed messages require 7bit encoding). Besides the normal +(digitally signed messages require 7bit encoding). Besides the normal @acronym{MIME} encodings, @code{qp-or-base64} may be used to indicate that for each case the most efficient of quoted-printable and base64 should be used. You can override this setting on a per-message basis by using -the @code{encoding} MML tag (@pxref{MML Definition}). +the @code{encoding} @acronym{MML} tag (@pxref{MML Definition}). @item mm-use-ultra-safe-encoding @vindex mm-use-ultra-safe-encoding @@ -834,8 +854,9 @@ encoding messages that are to be digitally signed). @section Charset Translation @cindex charsets -During translation from MML to @acronym{MIME}, for each @acronym{MIME} part which -has been composed inside Emacs, an appropriate charset has to be chosen. +During translation from @acronym{MML} to @acronym{MIME}, for each +@acronym{MIME} part which has been composed inside Emacs, an appropriate +charset has to be chosen. @vindex mail-parse-charset If you are running a non-@sc{mule} Emacs, this process is simple: If the @@ -875,8 +896,8 @@ messages. You can modify this by altering the @code{mm-coding-system-priorities} variable though (@pxref{Encoding Customization}). -The charset to be used can be overriden by setting the @code{charset} -MML tag (@pxref{MML Definition}) when composing the message. +The charset to be used can be overridden by setting the @code{charset} +@acronym{MML} tag (@pxref{MML Definition}) when composing the message. The encoding of characters (quoted-printable, 8bit etc) is orthogonal to the discussion here, and is controlled by the variables @@ -888,15 +909,15 @@ Customization}). @section Conversion @findex mime-to-mml -A (multipart) @acronym{MIME} message can be converted to MML with the -@code{mime-to-mml} function. It works on the message in the current -buffer, and substitutes MML markup for @acronym{MIME} boundaries. -Non-textual parts do not have their contents in the buffer, but instead -have the contents in separate buffers that are referred to from the MML -tags. +A (multipart) @acronym{MIME} message can be converted to @acronym{MML} +with the @code{mime-to-mml} function. It works on the message in the +current buffer, and substitutes @acronym{MML} markup for @acronym{MIME} +boundaries. Non-textual parts do not have their contents in the buffer, +but instead have the contents in separate buffers that are referred to +from the @acronym{MML} tags. @findex mml-to-mime -An MML message can be converted back to @acronym{MIME} by the +An @acronym{MML} message can be converted back to @acronym{MIME} by the @code{mml-to-mime} function. These functions are in certain senses ``lossy''---you will not get back @@ -921,12 +942,14 @@ variable (@pxref{Hard and Soft Newlines, ,Hard and Soft Newlines, emacs, Emacs Manual}) when encoding a message, and the ``format=flowed'' Content-Type parameter when decoding a message. -On encoding text, lines terminated by soft newline characters are -filled together and wrapped after the column decided by -@code{fill-flowed-encode-column}. This variable controls how the text -will look in a client that does not support flowed text, the default -is to wrap after 66 characters. If hard newline characters are not -present in the buffer, no flow encoding occurs. +On encoding text, regardless of @code{use-hard-newlines}, lines +terminated by soft newline characters are filled together and wrapped +after the column decided by @code{fill-flowed-encode-column}. +Quotation marks (matching @samp{^>* ?}) are respected. The variable +controls how the text will look in a client that does not support +flowed text, the default is to wrap after 66 characters. If hard +newline characters are not present in the buffer, no flow encoding +occurs. On decoding flowed text, lines with soft newline characters are filled together and wrapped after the column decided by diff --git a/texi/gnus-faq.texi b/texi/gnus-faq.texi index f6841f0..8611ff2 100644 --- a/texi/gnus-faq.texi +++ b/texi/gnus-faq.texi @@ -214,7 +214,7 @@ Answer: @end example @noindent - Make sure that you don't have any gnus related stuff + Make sure that you don't have any Gnus related stuff before this line, on MS Windows use something like "C:/path/to/lisp" (yes, "/"). @@ -647,7 +647,7 @@ Answer: (eval-after-load "mail-source" '(add-to-list 'mail-sources '(pop :server "pop.YourProvider.net" :user "yourUserName" - :password "yourPassword")) + :password "yourPassword"))) @end example @noindent @@ -1385,7 +1385,7 @@ Answer: * [5.9]:: Sometimes I accidentally hit r instead of f in newsgroups. Can Gnus warn me, when I'm replying by mail in newsgroups? * [5.10]:: How to tell Gnus not to generate a sender header? -* [5.11]:: I want gnus to locally store copies of my send mail and news, +* [5.11]:: I want Gnus to locally store copies of my send mail and news, how to do it? * [5.12]:: People tell me my Message-IDs are not correct, why aren't they and how to fix it? @@ -1654,7 +1654,7 @@ alias al "Al " @noindent Then typing your alias (followed by a space or punctuation character) on a To: or Cc: line in the message buffer will - cause gnus to insert the full address for you. See the + cause Gnus to insert the full address for you. See the node "Mail Aliases" in Message (not Gnus) manual for details. diff --git a/texi/gnus.texi b/texi/gnus.texi index 7cb87c7..5508880 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -33,7 +33,7 @@ \makeindex \begin{document} -\newcommand{\gnusversionname}{Gnus v5.10.2} +\newcommand{\gnusversionname}{Gnus v5.10.3} \newcommand{\gnuschaptername}{} \newcommand{\gnussectionname}{} @@ -53,6 +53,9 @@ \newcommand{\gnustt}[1]{{\gnusselectttfont{}#1}} \newcommand{\gnuscode}[1]{\gnustt{#1}} +\newcommand{\gnusasis}[1]{\gnustt{#1}} +\newcommand{\gnusurl}[1]{\gnustt{#1}} +\newcommand{\gnuscommand}[1]{\gnustt{#1}} \newcommand{\gnusenv}[1]{\gnustt{#1}} \newcommand{\gnussamp}[1]{``{\fontencoding{OT1}\gnusselectttfont{}#1}''} \newcommand{\gnuslisp}[1]{\gnustt{#1}} @@ -153,6 +156,11 @@ } }{\end{list}} +\newenvironment{asislist}% +{\begin{list}{}{ +} +}{\end{list}} + \newenvironment{kbdlist}% {\begin{list}{}{ \labelwidth=0cm @@ -389,7 +397,7 @@ can be gotten by any nefarious means you can think of---@acronym{NNTP}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus v5.10.2. +This manual corresponds to Gnus v5.10.3. @end ifinfo @@ -558,22 +566,16 @@ Reply, Followup and Post * Summary Mail Commands:: Sending mail. * Summary Post Commands:: Sending news. * Summary Message Commands:: Other Message-related commands. -* Canceling and Superseding:: +* Canceling and Superseding:: Marking Articles * Unread Articles:: Marks for unread articles. * Read Articles:: Marks for read articles. * Other Marks:: Marks that do not affect readedness. -* Setting Marks:: -* Generic Marking Commands:: -* Setting Process Marks:: - -Marking Articles - -* Setting Marks:: How to set and remove marks. -* Generic Marking Commands:: How to customize the marking. -* Setting Process Marks:: How to mark articles for later processing. +* Setting Marks:: How to set and remove marks. +* Generic Marking Commands:: How to customize the marking. +* Setting Process Marks:: How to mark articles for later processing. Threading @@ -625,7 +627,7 @@ Various Summary Stuff * Summary Group Information:: Information oriented commands. * Searching for Articles:: Multiple article commands. -* Summary Generation Commands:: +* Summary Generation Commands:: * Really Various Summary Commands:: Those pesky non-conformant commands. Article Buffer @@ -690,7 +692,7 @@ Getting Mail * Group Mail Splitting:: Use group customize to drive mail splitting. * Incorporating Old Mail:: What about the old mail you have? * Expiring Mail:: Getting rid of unwanted mail. -* Washing Mail:: Removing gruft from the mail you get. +* Washing Mail:: Removing cruft from the mail you get. * Duplicates:: Dealing with duplicated mail. * Not Reading Mail:: Using mail back ends for reading other files. * Choosing a Mail Back End:: Gnus can read a variety of mail formats. @@ -713,7 +715,7 @@ Choosing a Mail Back End Browsing the Web -* Archiving Mail:: +* Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. * Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. @@ -728,6 +730,7 @@ Browsing the Web * Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. * Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. * A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. +* Debugging IMAP:: What to do when things don't work. Other Sources @@ -848,9 +851,10 @@ Formatting Variables Image Enhancements -* Picons:: How to display pictures of what you're reading. -* Smileys:: Show all those happy faces the way they were meant to be shown. * X-Face:: Display a funky, teensy black-and-white image. +* Face:: Display a funkier, teensier colored image. +* Smileys:: Show all those happy faces the way they were meant to be shown. +* Picons:: How to display pictures of what you're reading. * XVarious:: Other XEmacsy Gnusey variables. Thwarting Email Spam @@ -859,8 +863,28 @@ Thwarting Email Spam * Anti-Spam Basics:: Simple steps to reduce the amount of spam. * SpamAssassin:: How to use external anti-spam tools. * Hashcash:: Reduce spam by burning CPU time. -* Filtering Spam Using The Spam ELisp Package:: -* Filtering Spam Using Statistics with spam-stat:: +* Filtering Spam Using The Spam ELisp Package:: +* Filtering Spam Using Statistics with spam-stat:: + +Filtering Spam Using The Spam ELisp Package + +* Blacklists and Whitelists:: +* BBDB Whitelists:: +* Gmane Spam Reporting:: +* Anti-spam Hashcash Payments:: +* Blackholes:: +* Regular Expressions Header Matching:: +* Bogofilter:: +* ifile spam filtering:: +* spam-stat spam filtering:: +* SpamOracle:: +* Extending the spam elisp package:: + +Filtering Spam Using Statistics with spam-stat + +* Creating a spam-stat dictionary:: +* Splitting mail using spam-stat:: +* Low-level interface to the spam-stat dictionary:: Appendices @@ -953,7 +977,7 @@ If you want to start Gnus in a different frame, you can use the command If things do not go smoothly at startup, you have to twiddle some variables in your @file{~/.gnus.el} file. This file is similar to -@file{~/.emacs}, but is read when gnus starts. +@file{~/.emacs}, but is read when Gnus starts. If you puzzle at any terms used in this manual, please refer to the terminology section (@pxref{Terminology}). @@ -1329,11 +1353,11 @@ subscribed, and if it matches the latter, it will be ignored. @vindex gnus-auto-subscribed-groups Yet another variable that meddles here is @code{gnus-auto-subscribed-groups}. It works exactly like -@code{gnus-options-subscribe}, and is therefore really superfluous, but I -thought it would be nice to have two of these. This variable is more -meant for setting some ground rules, while the other variable is used -more for user fiddling. By default this variable makes all new groups -that come from mail back ends (@code{nnml}, @code{nnbabyl}, +@code{gnus-options-subscribe}, and is therefore really superfluous, +but I thought it would be nice to have two of these. This variable is +more meant for setting some ground rules, while the other variable is +used more for user fiddling. By default this variable makes all new +groups that come from mail back ends (@code{nnml}, @code{nnbabyl}, @code{nnfolder}, @code{nnmbox}, @code{nnmh}, and @code{nnmaildir}) subscribed. If you don't like that, just set this variable to @code{nil}. @@ -1755,7 +1779,7 @@ a @code{printf} specifications, for those of you who use (feh!) C. There should always be a colon on the line; the cursor always moves to the colon after performing an operation. @xref{Positioning -Point}. Nothing else is required---not even the group name. All +Point}. Nothing else is required---not even the group name. All displayed text is just window dressing, and is never examined by Gnus. Gnus stores all real information it needs using text properties. @@ -1824,7 +1848,7 @@ comment element in the group parameters. Newsgroup description. You need to read the group descriptions before these will appear, and to do that, you either have to set @code{gnus-read-active-file} or use the group buffer @kbd{M-d} -command. +command. @item o @samp{m} if moderated. @@ -1921,7 +1945,7 @@ background is dark: (defface my-group-face-1 '((t (:foreground "Red" :bold t))) "First group face") (defface my-group-face-2 - '((t (:foreground "DarkSeaGreen4" :bold t))) + '((t (:foreground "DarkSeaGreen4" :bold t))) "Second group face") (defface my-group-face-3 '((t (:foreground "Green4" :bold t))) "Third group face") @@ -2122,7 +2146,7 @@ manner will have no permanent effects. @vindex gnus-large-newsgroup The @code{gnus-large-newsgroup} variable says what Gnus should consider to be a big group. If it is @code{nil}, no groups are -considered big. The default vaule is 200. If the group has more +considered big. The default value is 200. If the group has more (unread and/or ticked) articles than this, Gnus will query the user before entering the group. The user can then specify how many articles should be fetched from the server. If the user specifies a @@ -2506,7 +2530,7 @@ consulted. @cindex making groups Make a new group (@code{gnus-group-make-group}). Gnus will prompt you for a name, a method and possibly an @dfn{address}. For an easier way -to subscribe to @acronym{NNTP} groups, @pxref{Browse Foreign Server}. +to subscribe to @acronym{NNTP} groups (@pxref{Browse Foreign Server}). @item G r @kindex G r (Group) @@ -2624,6 +2648,13 @@ If you use the @code{google} search engine, you can limit the search to a particular group by using a match string like @samp{shaving group:alt.sysadmin.recovery}. +@item G R +@kindex G R (Group) +@findex gnus-group-make-rss-group +Make a group based on an @acronym{RSS} feed +(@code{gnus-group-make-rss-group}). You will be prompted for an URL. +@xref{RSS}. + @item G DEL @kindex G DEL (Group) @findex gnus-group-delete-group @@ -2632,7 +2663,7 @@ This function will delete the current group actually delete all the articles in the group, and forcibly remove the group itself from the face of the Earth. Use a prefix only if you are absolutely sure of what you are doing. This command can't be used on -read-only groups (like @code{nntp} group), though. +read-only groups (like @code{nntp} groups), though. @item G V @kindex G V (Group) @@ -2723,10 +2754,6 @@ then a @code{to-list} group parameter will be added automatically upon sending the message if @code{gnus-add-to-list} is set to @code{t}. @vindex gnus-add-to-list -If you do an @kbd{a} command in a mail group and you don't have a -@code{to-list} group parameter, one will be added automatically upon -sending the message. - @findex gnus-mailing-list-mode @cindex mail list groups If this variable is set, @code{gnus-mailing-list-mode} is turned on when @@ -2737,16 +2764,22 @@ See also @code{gnus-parameter-to-list-alist}. @anchor{subscribed} @item subscribed @cindex subscribed +@cindex Mail-Followup-To +@findex gnus-find-subscribed-addresses If this parameter is set to @code{t}, Gnus will consider the to-address and to-list parameters for this group as addresses of mailing lists you are subscribed to. Giving Gnus this information is (only) a first step in getting it to generate correct Mail-Followup-To -headers for your posts to these lists. Look here @pxref{Mailing -Lists, , Mailing Lists, message, The Message Manual} for a complete -treatment of available MFT support. +headers for your posts to these lists. The second step is to put the +following in your @file{.gnus.el} -See also @code{gnus-find-subscribed-addresses}, the function that -directly uses this group parameter. +@lisp +(setq message-subscribed-address-functions + '(gnus-find-subscribed-addresses)) +@end lisp + +@xref{Mailing Lists, ,Mailing Lists, message, The Message Manual}, for +a complete treatment of available MFT support. @item visible @cindex visible @@ -2783,9 +2816,11 @@ composed messages will be @code{Gcc}'d to the current group. If generated, if @code{(gcc-self . "string")} is present, this string will be inserted literally as a @code{gcc} header. This parameter takes precedence over any default @code{Gcc} rules as described later -(@pxref{Archived Messages}). CAVEAT:: It yields an error putting -@code{(gcc-self . t)} in groups of a @code{nntp} server or so, because -a @code{nntp} server doesn't accept articles. +(@pxref{Archived Messages}). + +@strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of +@code{nntp} groups (or the like) isn't valid. An @code{nntp} server +doesn't accept articles. @item auto-expire @cindex auto-expire @@ -2815,6 +2850,11 @@ If the group parameter has an element that looks like can either be a number of days (not necessarily an integer) or the symbols @code{never} or @code{immediate}. +@item expiry-target +@cindex expiry-target +Where expired messages end up. This parameter overrides +@code{nnmail-expiry-target}. + @item score-file @cindex score file group parameter Elements that look like @code{(score-file . "file")} will make @@ -2929,7 +2969,7 @@ instead of @code{gnus-post-method}. @item banner @cindex banner An item like @code{(banner . @var{regexp})} causes any part of an article -that matches the regular expression @var{regexp} to be stripped. Instead of +that matches the regular expression @var{regexp} to be stripped. Instead of @var{regexp}, you can also use the symbol @code{signature} which strips the last signature or any of the elements of the alist @code{gnus-article-banner-alist}. @@ -2941,7 +2981,7 @@ that should be placed in this group. From this group parameter, a Sieve @samp{IF} control structure is generated, having the test as the condition and @samp{fileinto "group.name";} as the body. -For example, if the INBOX.list.sieve group has the @code{(sieve +For example, if the @samp{INBOX.list.sieve} group has the @code{(sieve address "sender" "sieve-admin@@extundo.com")} group parameter, when translating the group parameter into a Sieve script (@pxref{Sieve Commands}) the following Sieve code is generated: @@ -2952,8 +2992,15 @@ if address \"sender\" \"sieve-admin@@extundo.com\" @{ @} @end example -The Sieve language is described in RFC 3028. @xref{Top, , Top, sieve, -Emacs Sieve}. +The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve, +Top, sieve, Emacs Sieve}. + +@item (agent parameters) +If the agent has been enabled, you can set any of the its parameters +to control the behavior of the agent in individual groups. See Agent +Parameters in @ref{Category Syntax}. Most users will choose to set +agent parameters in either an agent category or group topic to +minimize the configuration effort. @item (@var{variable} @var{form}) You can use the group parameters to set variables local to the group you @@ -2971,16 +3018,19 @@ question to @code{gnus-newsgroup-variables}. @xref{Various Summary Stuff}. So if you want to set @code{message-from-style} via the group parameters, then you may need the following statement elsewhere in your @file{~/.gnus} file: + @lisp (add-to-list 'gnus-newsgroup-variables 'message-from-style) @end lisp @vindex gnus-list-identifiers A use for this feature is to remove a mailing list identifier tag in -the subject fields of articles. E.g. if the news group +the subject fields of articles. E.g. if the news group + @example nntp+news.gnus.org:gmane.text.docbook.apps @end example + has the tag @samp{DOC-BOOK-APPS:} in the subject of all articles, this tag can be removed from the article subjects in the summary buffer for the group by putting @code{(gnus-list-identifiers "DOCBOOK-APPS:")} @@ -3600,9 +3650,9 @@ Yank the previously killed group or topic before all groups. So, to move a topic to the beginning of the list of topics, just hit -@kbd{C-k} on it. This is like the `cut' part of cut and paste. Then, -move the cursor to the beginning of the buffer (just below the `Gnus' -topic) and hit @kbd{C-y}. This is like the `paste' part of cut and +@kbd{C-k} on it. This is like the ``cut'' part of cut and paste. Then, +move the cursor to the beginning of the buffer (just below the ``Gnus'' +topic) and hit @kbd{C-y}. This is like the ``paste'' part of cut and paste. Like I said -- E-Z. You can use @kbd{C-k} and @kbd{C-y} on groups as well as on topics. So @@ -3715,7 +3765,7 @@ sub-topics unless given a prefix. @findex gnus-topic-expire-articles Run all expirable articles in the current group or topic through the expiry process (if any) -(@code{gnus-topic-expire-articles}). (@pxref{Expiring Mail}). +(@code{gnus-topic-expire-articles}). (@pxref{Expiring Mail}). @item T r @kindex T r (Topic) @@ -3849,7 +3899,7 @@ Sort the current topic alphabetically by server name (@code{gnus-topic-sort-groups-by-server}). @item T S s -@kindex T S s +@kindex T S s (Topic) @findex gnus-topic-sort-groups Sort the current topic according to the function(s) given by the @code{gnus-group-sort-function} variable @@ -3912,9 +3962,11 @@ allowed---@code{visible} and @code{invisible}. @subsection Topic Parameters @cindex topic parameters -All groups in a topic will inherit group parameters from the parent (and -ancestor) topic parameters. All valid group parameters are valid topic -parameters (@pxref{Group Parameters}). +All groups in a topic will inherit group parameters from the parent +(and ancestor) topic parameters. All valid group parameters are valid +topic parameters (@pxref{Group Parameters}). When the agent is +enabled, all agent parameters (See Agent Parameters in @ref{Category +Syntax}) are also valid topic parameters. In addition, the following parameters are only valid as topic parameters: @@ -3939,6 +3991,7 @@ know. Normal inheritance rules. (@dfn{Rules} is here a noun, not a verb, although you may feel free to disagree with me here.) @example +@group Gnus Emacs 3: comp.emacs @@ -3951,6 +4004,7 @@ Gnus 8: comp.binaries.fractals 13: comp.sources.unix 452: alt.sex.emacs +@end group @end example The @samp{Emacs} topic has the topic parameter @code{(score-file @@ -4055,7 +4109,7 @@ whether they are empty or not. @item gnus-group-name-charset-method-alist @vindex gnus-group-name-charset-method-alist -An alist of method and the charset for group names. It is used to show +An alist of method and the charset for group names. It is used to show non-@acronym{ASCII} group names. For example: @@ -4175,7 +4229,7 @@ messages for the group, which in some cases includes the charter. @vindex gnus-group-fetch-control-use-browse-url @cindex control message Fetch the control messages for the group from the archive at -@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a +@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a group if given a prefix argument. If @code{gnus-group-fetch-control-use-browse-url} is non-@code{nil}, @@ -4337,7 +4391,7 @@ placed in all groups that have matching rules, otherwise the article is only placed in the group with the first matching rule. For example, the group parameter @samp{(sieve address "sender" "owner-ding@@hpc.uh.edu")} will generate the following piece of Sieve -code if @code{gnus-sieve-crosspost} is @code{nil}. (When +code if @code{gnus-sieve-crosspost} is @code{nil}. (When @code{gnus-sieve-crosspost} is non-@code{nil}, it looks the same except that the line containing the call to @code{stop} is removed.) @@ -4348,7 +4402,7 @@ if address "sender" "owner-ding@@hpc.uh.edu" @{ @} @end example -@xref{Top, ,Top, sieve, Emacs Sieve}. +@xref{Top, Emacs Sieve, Top, sieve, Emacs Sieve}. @table @kbd @@ -4512,7 +4566,7 @@ the @code{a} spec. @item L Number of lines in the article. @item c -Number of characters in the article. This specifier is not supported +Number of characters in the article. This specifier is not supported in some methods (like nnfolder). @item k Pretty-printed version of the number of characters in the article; @@ -4560,7 +4614,7 @@ Used for drawing a vertical line. The default is @samp{| }. @item gnus-sum-thread-tree-indent @vindex gnus-sum-thread-tree-indent -Used for indenting. The default is @samp{ }. +Used for indenting. The default is @samp{ }. @item gnus-sum-thread-tree-leaf-with-other @vindex gnus-sum-thread-tree-leaf-with-other @@ -4586,7 +4640,7 @@ One space for each thread level. @item < Twenty minus thread level spaces. @item U -Unread. @xref{Read Articles}. +Unread. @xref{Read Articles}. @item R This misleadingly named specifier is the @dfn{secondary mark}. This @@ -4631,7 +4685,7 @@ Age sensitive date format. Various date format is defined in @item u User defined specifier. The next character in the format string should be a letter. Gnus will call the function -@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter +@code{gnus-user-format-function-@var{x}}, where @var{x} is the letter following @samp{%u}. The function will be passed the current header as argument. The function should return a string, which will be inserted into the summary just like information from any other summary specifier. @@ -4950,7 +5004,7 @@ unread article (@code{gnus-summary-next-page}). If you have an article window open already and you press @kbd{SPACE} again, the article will be scrolled. This lets you conveniently -@kbd{SPACE} through an entire newsgroup. @pxref{Paging the Article}. +@kbd{SPACE} through an entire newsgroup. @xref{Paging the Article}. @item G n @itemx n @@ -5056,7 +5110,7 @@ the server and display it in the article buffer. @item gnus-select-article-hook @vindex gnus-select-article-hook This hook is called whenever an article is selected. By default it -exposes any threads hidden under the selected article. If you would +exposes any threads hidden under the selected article. If you would like each article to be saved in the Agent as you read it, putting @code{gnus-agent-fetch-selected-article} on this hook will do so. @@ -5178,7 +5232,7 @@ Select the article buffer (@code{gnus-summary-select-article-buffer}). * Summary Mail Commands:: Sending mail. * Summary Post Commands:: Sending news. * Summary Message Commands:: Other Message-related commands. -* Canceling and Superseding:: +* Canceling and Superseding:: @end menu @@ -5217,7 +5271,8 @@ command uses the process/prefix convention. Mail a wide reply to the author of the current article (@code{gnus-summary-wide-reply}). A @dfn{wide reply} is a reply that goes out to all people listed in the @code{To}, @code{From} (or -@code{Reply-to}) and @code{Cc} headers. +@code{Reply-to}) and @code{Cc} headers. If @code{Mail-Followup-To} is +present, that's used instead. @item S W @kindex S W (Summary) @@ -5397,7 +5452,7 @@ Post a followup to the current article (@code{gnus-summary-followup}). @c @icon{gnus-summary-followup-with-original} @findex gnus-summary-followup-with-original Post a followup to the current article and include the original message -(@code{gnus-summary-followup-with-original}). This command uses the +(@code{gnus-summary-followup-with-original}). This command uses the process/prefix convention. @item S n @@ -5548,7 +5603,7 @@ A time span. Consists of an integer and a letter. For example, (months) and @code{Y} (years). @item -A specific date. Looks like @code{YYYYY-MM-DD}. The message will be +A specific date. Looks like @code{YYYY-MM-DD}. The message will be delayed until that day, at a specific time (eight o'clock by default). See also @code{gnus-delay-default-hour}. @@ -5805,7 +5860,7 @@ religiously) are marked with an @samp{S} in the second column Articles that according to the server haven't been shown to the user before are marked with a @samp{N} in the second column (@code{gnus-recent-mark}). Note that not all servers support this -mark, in which case it simply never appears. Compare with +mark, in which case it simply never appears. Compare with @code{gnus-unseen-mark}. @item @@ -5816,7 +5871,7 @@ Compare with @code{gnus-recent-mark}. @item @vindex gnus-downloaded-mark -When using the Gnus agent @pxref{Agent Basics}, articles may be +When using the Gnus agent (@pxref{Agent Basics}), articles may be downloaded for unplugged (offline) viewing. If you are using the @samp{%O} spec, these articles get the @samp{+} mark in that spec. (The variable @code{gnus-downloaded-mark} controls which character to @@ -5824,7 +5879,7 @@ use.) @item @vindex gnus-undownloaded-mark -When using the Gnus agent @pxref{Agent Basics}, some articles might +When using the Gnus agent (@pxref{Agent Basics}), some articles might not have been downloaded. Such articles cannot be viewed while you are unplugged (offline). If you are using the @samp{%O} spec, these articles get the @samp{-} mark in that spec. (The variable @@ -5832,7 +5887,7 @@ articles get the @samp{-} mark in that spec. (The variable @item @vindex gnus-downloadable-mark -The Gnus agent @pxref{Agent Basics} downloads some articles +The Gnus agent (@pxref{Agent Basics}) downloads some articles automatically, but it is also possible to explicitly mark articles for download, even if they would not be downloaded automatically. Such explicitly-marked articles get the @samp{%} mark in the first column. @@ -6115,7 +6170,7 @@ expression (@code{gnus-uu-unmark-by-regexp}). Mark articles in region (@code{gnus-uu-mark-region}). @item M P g -@kindex M P g +@kindex M P g (Summary) @findex gnus-uu-unmark-region Unmark articles in region (@code{gnus-uu-unmark-region}). @@ -6179,7 +6234,7 @@ Push the current process mark set onto the stack @end table -Also see the @kbd{&} command in @pxref{Searching for Articles} for how to +Also see the @kbd{&} command in @ref{Searching for Articles}, for how to set process marks based on article body contents. @@ -6203,14 +6258,14 @@ additional articles. @kindex / / (Summary) @findex gnus-summary-limit-to-subject Limit the summary buffer to articles that match some subject -(@code{gnus-summary-limit-to-subject}). If given a prefix, exclude +(@code{gnus-summary-limit-to-subject}). If given a prefix, exclude matching articles. @item / a @kindex / a (Summary) @findex gnus-summary-limit-to-author Limit the summary buffer to articles that match some author -(@code{gnus-summary-limit-to-author}). If given a prefix, exclude +(@code{gnus-summary-limit-to-author}). If given a prefix, exclude matching articles. @item / x @@ -6218,7 +6273,7 @@ matching articles. @findex gnus-summary-limit-to-extra Limit the summary buffer to articles that match one of the ``extra'' headers (@pxref{To From Newsgroups}) -(@code{gnus-summary-limit-to-extra}). If given a prefix, exclude +(@code{gnus-summary-limit-to-extra}). If given a prefix, exclude matching articles. @item / u @@ -6275,8 +6330,8 @@ score (@code{gnus-summary-limit-to-score}). @findex gnus-summary-limit-to-display-predicate Limit the summary buffer to articles that satisfy the @code{display} group parameter predicate -(@code{gnus-summary-limit-to-display-predicate}). See @pxref{Group -Parameters} for more on this predicate. +(@code{gnus-summary-limit-to-display-predicate}). @xref{Group +Parameters}, for more on this predicate. @item / E @itemx M S @@ -6324,19 +6379,19 @@ Exclude all dormant articles that have no children from the limit@* @kindex / C (Summary) @findex gnus-summary-limit-mark-excluded-as-read Mark all excluded unread articles as read -(@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix, +(@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix, also mark excluded ticked and dormant articles as read. @item / N @kindex / N (Summary) @findex gnus-summary-insert-new-articles -Insert all new articles in the summary buffer. It scans for new emails +Insert all new articles in the summary buffer. It scans for new emails if @var{back-end}@code{-get-new-mail} is non-@code{nil}. @item / o @kindex / o (Summary) @findex gnus-summary-insert-old-articles -Insert all old articles in the summary buffer. If given a numbered +Insert all old articles in the summary buffer. If given a numbered prefix, fetch this number of articles. @end table @@ -6357,7 +6412,7 @@ trees, but unfortunately, the @code{References} header is often broken or simply missing. Weird news propagation exacerbates the problem, so one has to employ other heuristics to get pleasing results. A plethora of approaches exists, as detailed in horrible detail in -@pxref{Customizing Threading}. +@ref{Customizing Threading}. First, a quick overview of the concepts: @@ -6603,16 +6658,16 @@ something like: @item gnus-fetch-old-headers @vindex gnus-fetch-old-headers If non-@code{nil}, Gnus will attempt to build old threads by fetching -more old headers---headers to articles marked as read. If you -would like to display as few summary lines as possible, but still -connect as many loose threads as possible, you should set this variable -to @code{some} or a number. If you set it to a number, no more than -that number of extra old headers will be fetched. In either case, -fetching old headers only works if the back end you are using carries -overview files---this would normally be @code{nntp}, @code{nnspool}, +more old headers---headers to articles marked as read. If you would +like to display as few summary lines as possible, but still connect as +many loose threads as possible, you should set this variable to +@code{some} or a number. If you set it to a number, no more than that +number of extra old headers will be fetched. In either case, fetching +old headers only works if the back end you are using carries overview +files---this would normally be @code{nntp}, @code{nnspool}, @code{nnml}, and @code{nnmaildir}. Also remember that if the root of -the thread has been expired by the server, there's not much Gnus can do -about that. +the thread has been expired by the server, there's not much Gnus can +do about that. This variable can also be set to @code{invisible}. This won't have any visible effects, but is useful if you use the @kbd{A T} command a lot @@ -6906,7 +6961,8 @@ Matching}). @findex gnus-thread-sort-by-number @findex gnus-thread-sort-by-random @vindex gnus-thread-sort-functions -@findex gnus-thread-sort-by-most-recent-thread +@findex gnus-thread-sort-by-most-recent-number +@findex gnus-thread-sort-by-most-recent-date If you are using a threaded summary display, you can sort the threads by setting @code{gnus-thread-sort-functions}, which can be either a single function, a list of functions, or a list containing functions and @@ -7165,7 +7221,7 @@ file. @findex gnus-cache-move-cache @code{gnus-cache-move-cache} will move your whole -@code{gnus-cache-directory} to some other location. You get asked to +@code{gnus-cache-directory} to some other location. You get asked to where, isn't that cool? @node Persistent Articles @@ -7329,9 +7385,9 @@ complete headers in the piped output. @kindex O P (Summary) @findex gnus-summary-muttprint @vindex gnus-summary-muttprint-program -Save the current article into muttprint. That is, print it using the +Save the current article into muttprint. That is, print it using the external program @uref{http://muttprint.sourceforge.net/, -Muttprint}. The program name and options to use is controlled by the +Muttprint}. The program name and options to use is controlled by the variable @code{gnus-summary-muttprint-program}. (@code{gnus-summary-muttprint}). @@ -8171,7 +8227,7 @@ Signature}. Strip list identifiers specified in @code{gnus-list-identifiers}. These are strings some mailing list servers add to the beginning of all @code{Subject} headers---for example, @samp{[zebra 4711]}. Any leading -@samp{Re: } is skipped before stripping. @code{gnus-list-identifiers} +@samp{Re: } is skipped before stripping. @code{gnus-list-identifiers} may not contain @code{\\(..\\)}. @table @code @@ -8229,7 +8285,7 @@ banner something like @samp{Do You Yoo-hoo!?} in all articles he sends, you can use the following element to remove them: @lisp -("@@yoo-hoo\\.co\\.jp\\'" . +("@@yoo-hoo\\.co\\.jp\\'" . "\n_+\nDo You Yoo-hoo!\\?\n.*\n.*\n") @end lisp @@ -8266,7 +8322,7 @@ Number of lines of hidden text. @item gnus-cited-lines-visible @vindex gnus-cited-lines-visible The number of lines at the beginning of the cited text to leave -shown. This can also be a cons cell with the number of lines at the top +shown. This can also be a cons cell with the number of lines at the top and bottom of the text, respectively, to remain visible. @end table @@ -8643,7 +8699,7 @@ Fold all the message headers (@code{gnus-article-treat-fold-headers}). @item W E w -@kindex W E w +@kindex W E w (Summary) @findex gnus-article-remove-leading-whitespace Remove excessive whitespace from all headers (@code{gnus-article-remove-leading-whitespace}). @@ -8761,17 +8817,17 @@ message ID or a mail address. If it is one of the symbols @code{mid} or @code{mail}, Gnus will always assume that the string is a message ID or a mail address, respectively. If this variable is set to the symbol @code{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 will be called with the string as its only argument. The function must return @code{mid}, @code{mail}, @code{invalid} or @code{ask}. The default value is the function @code{gnus-button-mid-or-mail-heuristic}. @item gnus-button-mid-or-mail-heuristic @findex gnus-button-mid-or-mail-heuristic -Function that guesses whether it's argument is a message ID or a mail -address. Returns @code{mid} it's a message IDs, @code{mail} if it's a -mail address, @code{ask} if unsure and @code{invalid} if the string is -invalid. +Function that guesses whether its argument is a message ID or a mail +address. Returns @code{mid} if it's a message IDs, @code{mail} if +it's a mail address, @code{ask} if unsure and @code{invalid} if the +string is invalid. @item gnus-button-mid-or-mail-heuristic-alist @vindex gnus-button-mid-or-mail-heuristic-alist @@ -8974,12 +9030,15 @@ buffer in Emacs versions that support them. @code{X-Face} headers are small black-and-white images supplied by the message headers (@pxref{X-Face}). -Picons, on the other hand, reside on your own system, and Gnus will -try to match the headers to what you have (@pxref{Picons}). +@code{Face} headers are small colored images supplied by the message +headers (@pxref{Face}). Smileys are those little @samp{:-)} symbols that people like to litter their messages with (@pxref{Smileys}). +Picons, on the other hand, reside on your own system, and Gnus will +try to match the headers to what you have (@pxref{Picons}). + All these functions are toggles---if the elements already exist, they'll be removed. @@ -9580,11 +9639,11 @@ then ask Google if that fails: Most of the mail back ends support fetching by @code{Message-ID}, but do not do a particularly excellent job at it. That is, @code{nnmbox}, -@code{nnbabyl}, and @code{nnmaildir} are able to locate articles from -any groups, while @code{nnml}, @code{nnfolder}, and @code{nnimap} are -only able to locate articles that have been posted to the current group. -(Anything else would be too time consuming.) @code{nnmh} does not -support this at all. +@code{nnbabyl}, @code{nnmaildir}, @code{nnml}, are able to locate +articles from any groups, while @code{nnfolder}, and @code{nnimap} are +only able to locate articles that have been posted to the current +group. (Anything else would be too time consuming.) @code{nnmh} does +not support this at all. @node Alternative Approaches @@ -9766,10 +9825,10 @@ Variables related to the display are: @item gnus-tree-brackets @vindex gnus-tree-brackets This is used for differentiating between ``real'' articles and -``sparse'' articles. The format is +``sparse'' articles. The format is @example -((@var{real-open} . @var{real-close}) - (@var{sparse-open} . @var{sparse-close}) +((@var{real-open} . @var{real-close}) + (@var{sparse-open} . @var{sparse-close}) (@var{dummy-open} . @var{dummy-close})) @end example and the default is @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}) (?< . ?>))}. @@ -10019,7 +10078,7 @@ suggestions you find reasonable. (Note that @menu * Summary Group Information:: Information oriented commands. * Searching for Articles:: Multiple article commands. -* Summary Generation Commands:: +* Summary Generation Commands:: * Really Various Summary Commands:: Those pesky non-conformant commands. @end menu @@ -10093,7 +10152,7 @@ variables and their default values (when the default values are not @code{nil}), that should be made global while the summary buffer is active. These variables can be used to set variables in the group parameters while still allowing them to affect operations done in -other buffers. For example: +other buffers. For example: @lisp (setq gnus-newsgroup-variables @@ -10168,7 +10227,7 @@ on this field, and a command to be executed if the match is made string, the match is done on the entire article. If given a prefix, search backward instead. -For instance, @kbd{& RET some.*string #} will put the process mark on +For instance, @kbd{& RET some.*string RET #} will put the process mark on all articles that have heads or bodies that match @samp{some.*string}. @item M-& @@ -10273,8 +10332,10 @@ group and return you to the group buffer. @table @kbd @item Z Z +@itemx Z Q @itemx q @kindex Z Z (Summary) +@kindex Z Q (Summary) @kindex q (Summary) @findex gnus-summary-exit @vindex gnus-summary-exit-hook @@ -10319,7 +10380,9 @@ Mark all articles as read and go to the next group (@code{gnus-summary-catchup-and-goto-next-group}). @item Z R +@itemx C-x C-s @kindex Z R (Summary) +@kindex C-x C-s (Summary) @findex gnus-summary-reselect-current-group Exit this group, and then enter it again (@code{gnus-summary-reselect-current-group}). If given a prefix, select @@ -10545,13 +10608,13 @@ manual (@pxref{Security, ,Security, message, Message Manual}). @vindex mm-verify-option Option of verifying signed parts. @code{never}, not verify; @code{always}, always verify; @code{known}, only verify known -protocols. Otherwise, ask user. +protocols. Otherwise, ask user. @item mm-decrypt-option @vindex mm-decrypt-option Option of decrypting encrypted parts. @code{never}, no decryption; @code{always}, always decrypt; @code{known}, only decrypt known -protocols. Otherwise, ask user. +protocols. Otherwise, ask user. @item mml1991-use @vindex mml1991-use @@ -10737,7 +10800,7 @@ variable, will be displayed in random order after all the headers listed in this You can hide further boring headers by setting @code{gnus-treat-hide-boring-headers} to @code{head}. What this function does depends on the @code{gnus-boring-article-headers} variable. It's a -list, but this list doesn't actually contain header names. Instead is +list, but this list doesn't actually contain header names. Instead it lists various @dfn{boring conditions} that Gnus can check and remove from sight. @@ -10749,21 +10812,21 @@ Remove all empty headers. Remove the @code{Followup-To} header if it is identical to the @code{Newsgroups} header. @item reply-to -Remove the @code{Reply-To} header if it lists the same address as the -@code{From} header, or if the @code{broken-reply-to} group parameter is -set. +Remove the @code{Reply-To} header if it lists the same addresses as +the @code{From} header, or if the @code{broken-reply-to} group +parameter is set. @item newsgroups Remove the @code{Newsgroups} header if it only contains the current group name. @item to-address Remove the @code{To} header if it only contains the address identical to -the current groups's @code{to-address} parameter. +the current group's @code{to-address} parameter. @item to-list Remove the @code{To} header if it only contains the address identical to -the current groups's @code{to-list} parameter. +the current group's @code{to-list} parameter. @item cc-list Remove the @code{CC} header if it only contains the address identical to -the current groups's @code{to-list} parameter. +the current group's @code{to-list} parameter. @item date Remove the @code{Date} header if the article is less than three days old. @@ -10813,7 +10876,7 @@ The following commands are available when you have placed point over a @kindex RET (Article) @itemx BUTTON-2 (Article) Toggle displaying of the @acronym{MIME} object -(@code{gnus-article-press-button}). If built-in viewers can not display +(@code{gnus-article-press-button}). If built-in viewers can not display the object, Gnus resorts to external viewers in the @file{mailcap} files. If a viewer has the @samp{copiousoutput} specification, the object is displayed inline. @@ -10883,7 +10946,7 @@ Insert the contents of the @acronym{MIME} object into the buffer (@code{gnus-mime-inline-part}) as text/plain. If given a prefix, insert the raw contents without decoding. If given a numerical prefix, you can do semi-manual charset stuff (see -@code{gnus-summary-show-article-charset-alist} in @pxref{Paging the +@code{gnus-summary-show-article-charset-alist} in @ref{Paging the Article}). @findex gnus-mime-view-part-internally @@ -10928,7 +10991,7 @@ to look at you disdainfully, and you'll feel rather stupid.) Any similarity to real events and people is purely coincidental. Ahem. -Also see @pxref{MIME Commands}. +Also @pxref{MIME Commands}. @node Customizing Articles @@ -11047,10 +11110,14 @@ is controlled by @code{gnus-body-boundary-delimiter}. @xref{Smileys}. -@item gnus-treat-display-xface (head) +@item gnus-treat-display-x-face (head) @xref{X-Face}. +@item gnus-treat-display-face (head) + +@xref{Face}. + @item gnus-treat-emphasize (t, head, integer) @item gnus-treat-fill-article (t, integer) @item gnus-treat-fill-long-lines (t, integer) @@ -11311,7 +11378,7 @@ on your setup (@pxref{Posting Server}). * Signing and encrypting:: How to compose secure messages. @end menu -Also see @pxref{Canceling and Superseding} for information on how to +Also @pxref{Canceling and Superseding} for information on how to remove articles you shouldn't have posted. @@ -11347,7 +11414,7 @@ press R anyway, this variable might be for you. If non-@code{nil}, Gnus also requests confirmation according to @code{gnus-confirm-mail-reply-to-news} when replying to mail. This is useful for treating mailing lists like newsgroups. - + @end table @@ -11524,9 +11591,8 @@ determined by the @code{gnus-message-archive-group} variable. This variable can be used to do the following: -@itemize @bullet -@item -a string +@table @asis +@item a string Messages will be saved in that group. Note that you can include a select method in the group name, then the @@ -11538,16 +11604,16 @@ has the default value shown above. Then setting messages are stored in @samp{nnfolder+archive:foo}, but if you use the value @code{"nnml:foo"}, then outgoing messages will be stored in @samp{nnml:foo}. -@item -a list of strings + +@item a list of strings Messages will be saved in all those groups. -@item -an alist of regexps, functions and forms + +@item an alist of regexps, functions and forms When a key ``matches'', the result is used. -@item -@code{nil} + +@item @code{nil} No message archiving will take place. This is the default. -@end itemize +@end table Let's illustrate: @@ -11680,7 +11746,7 @@ string, then Gnus will try to regexp match it against the group name. If it is the form @code{(header @var{match} @var{regexp})}, then Gnus will look in the original article for a header whose name is @var{match} and compare that @var{regexp}. @var{match} and -@var{regexp} are strings. (There original article is the one you are +@var{regexp} are strings. (The original article is the one you are replying or following up to. If you are not composing a reply or a followup, then there is nothing to match against.) If the @code{match} is a function symbol, that function will be called with @@ -11691,15 +11757,22 @@ said to @dfn{match}. Each style may contain an arbitrary amount of @dfn{attributes}. Each attribute consists of a @code{(@var{name} @var{value})} pair. The -attribute name can be one of @code{signature}, @code{signature-file}, -@code{x-face-file}, @code{address} (overriding -@code{user-mail-address}), @code{name} (overriding -@code{(user-full-name)}) or @code{body}. The attribute name can also -be a string or a symbol. In that case, this will be used as a header -name, and the value will be inserted in the headers of the article; if -the value is @code{nil}, the header name will be removed. If the -attribute name is @code{eval}, the form is evaluated, and the result -is thrown away. +attribute name can be one of: + +@itemize @bullet +@item @code{signature} +@item @code{signature-file} +@item @code{x-face-file} +@item @code{address}, overriding @code{user-mail-address} +@item @code{name}, overriding @code{(user-full-name)} +@item @code{body} +@end itemize + +The attribute name can also be a string or a symbol. In that case, +this will be used as a header name, and the value will be inserted in +the headers of the article; if the value is @code{nil}, the header +name will be removed. If the attribute name is @code{eval}, the form +is evaluated, and the result is thrown away. The attribute value can be a string (used verbatim), a function with zero arguments (the return value will be used), a variable (its value @@ -11880,52 +11953,52 @@ are in reply to encrypted messages. Gnus offers @code{gnus-message-replysignencrypted} (on by default) will sign automatically encrypted messages. -Instructing MML to perform security operations on a @acronym{MIME} part is -done using the @kbd{C-c C-m s} key map for signing and the @kbd{C-c -C-m c} key map for encryption, as follows. +Instructing @acronym{MML} to perform security operations on a +@acronym{MIME} part is done using the @kbd{C-c C-m s} key map for +signing and the @kbd{C-c C-m c} key map for encryption, as follows. @table @kbd @item C-c C-m s s -@kindex C-c C-m s s +@kindex C-c C-m s s (Message) @findex mml-secure-message-sign-smime Digitally sign current message using @acronym{S/MIME}. @item C-c C-m s o -@kindex C-c C-m s o +@kindex C-c C-m s o (Message) @findex mml-secure-message-sign-pgp Digitally sign current message using @acronym{PGP}. @item C-c C-m s p -@kindex C-c C-m s p +@kindex C-c C-m s p (Message) @findex mml-secure-message-sign-pgp Digitally sign current message using @acronym{PGP/MIME}. @item C-c C-m c s -@kindex C-c C-m c s +@kindex C-c C-m c s (Message) @findex mml-secure-message-encrypt-smime Digitally encrypt current message using @acronym{S/MIME}. @item C-c C-m c o -@kindex C-c C-m c o +@kindex C-c C-m c o (Message) @findex mml-secure-message-encrypt-pgp Digitally encrypt current message using @acronym{PGP}. @item C-c C-m c p -@kindex C-c C-m c p +@kindex C-c C-m c p (Message) @findex mml-secure-message-encrypt-pgpmime Digitally encrypt current message using @acronym{PGP/MIME}. @item C-c C-m C-n -@kindex C-c C-m C-n +@kindex C-c C-m C-n (Message) @findex mml-unsecure-message -Remove security related MML tags from message. +Remove security related @acronym{MML} tags from message. @end table @@ -12222,27 +12295,26 @@ If you're saving lots of articles in the cache by using persistent articles, you may want to create a virtual server to read the cache. First you need to add a new server. The @kbd{a} command does that. It -would probably be best to use @code{nnspool} to read the cache. You -could also use @code{nnml} or @code{nnmh}, though. +would probably be best to use @code{nnml} to read the cache. You +could also use @code{nnspool} or @code{nnmh}, though. -Type @kbd{a nnspool RET cache RET}. +Type @kbd{a nnml RET cache RET}. -You should now have a brand new @code{nnspool} virtual server called +You should now have a brand new @code{nnml} virtual server called @samp{cache}. You now need to edit it to have the right definitions. Type @kbd{e} to edit the server. You'll be entered into a buffer that will contain the following: @lisp -(nnspool "cache") +(nnml "cache") @end lisp Change that to: @lisp -(nnspool "cache" - (nnspool-spool-directory "~/News/cache/") - (nnspool-nov-directory "~/News/cache/") - (nnspool-active-file "~/News/cache/active")) +(nnml "cache" + (nnml-directory "~/News/cache/") + (nnml-active-file "~/News/cache/active")) @end lisp Type @kbd{C-c C-c} to return to the server buffer. If you now press @@ -12760,7 +12832,7 @@ Password to use when logging in on the intermediate host. @vindex nntp-via-envuser If non-@code{nil}, the intermediate @code{telnet} session (client and server both) will support the @code{ENVIRON} option and not prompt for -login name. This works for Solaris @code{telnet}, for instance. +login name. This works for Solaris @code{telnet}, for instance. @item nntp-via-shell-prompt @vindex nntp-via-shell-prompt @@ -12792,7 +12864,7 @@ Address of the intermediate host to connect to. @subsubsection Common Variables The following variables affect the behavior of all, or several of the -pre-made connection functions. When not specified, all functions are +pre-made connection functions. When not specified, all functions are affected. @table @code @@ -12930,7 +13002,7 @@ course. * Group Mail Splitting:: Use group customize to drive mail splitting. * Incorporating Old Mail:: What about the old mail you have? * Expiring Mail:: Getting rid of unwanted mail. -* Washing Mail:: Removing gruft from the mail you get. +* Washing Mail:: Removing cruft from the mail you get. * Duplicates:: Dealing with duplicated mail. * Not Reading Mail:: Using mail back ends for reading other files. * Choosing a Mail Back End:: Gnus can read a variety of mail formats. @@ -12960,7 +13032,7 @@ deleted? How awful! But, no, it means that old messages are @dfn{expired} according to some scheme or other. For news messages, the expire process is controlled by the news administrator; for mail, the expire process is controlled by -you. The expire process for mail is covered in depth in @pxref{Expiring +you. The expire process for mail is covered in depth in @ref{Expiring Mail}. What many Gnus users find, after using it a while for both news and @@ -13045,6 +13117,7 @@ Especially @pxref{Choosing a Mail Back End} and @pxref{Expiring Mail}. @subsection Splitting Mail @cindex splitting mail @cindex mail splitting +@cindex mail filtering (splitting) @vindex nnmail-split-methods The @code{nnmail-split-methods} variable says how the incoming mail is @@ -13132,7 +13205,7 @@ useful if you want to match articles based on the raw header data. @vindex nnmail-resplit-incoming By default, splitting is performed on all incoming messages. If you specify a @code{directory} entry for the variable @code{mail-sources} -@pxref{Mail Source Specifiers}, however, then splitting does +(@pxref{Mail Source Specifiers}), however, then splitting does @emph{not} happen by default. You can set the variable @code{nnmail-resplit-incoming} to a non-@code{nil} value to make splitting happen even in this case. (This variable has no effect on @@ -13526,11 +13599,11 @@ An example @acronym{IMAP} mail source: @end lisp @item webmail -Get mail from a webmail server, such as @uref{www.hotmail.com}, -@uref{webmail.netscape.com}, @uref{www.netaddress.com}, -@uref{mail.yahoo.com}. +Get mail from a webmail server, such as @uref{http://www.hotmail.com/}, +@uref{http://webmail.netscape.com/}, @uref{http://www.netaddress.com/}, +@uref{http://mail.yahoo.com/}. -NOTE: Webmail largely depends cookies. A "one-line-cookie" patch is +NOTE: Webmail largely depends on cookies. A "one-line-cookie" patch is required for url "4.0pre.46". WARNING: Mails may be lost. NO WARRANTY. @@ -13829,46 +13902,42 @@ Let's look at an example value of this variable first: "misc.misc") @end lisp -This variable has the format of a @dfn{split}. A split is a (possibly) -recursive structure where each split may contain other splits. Here are -the five possible split syntaxes: +This variable has the format of a @dfn{split}. A split is a +(possibly) recursive structure where each split may contain other +splits. Here are the possible split syntaxes: -@enumerate - -@item -@samp{group}: If the split is a string, that will be taken as a group -name. Normal regexp match expansion will be done. See below for -examples. - -@item -@code{(@var{field} @var{value} @code{[-} @var{restrict} -@code{[@dots{}]}@code{]} @var{split})}: If the split is a list, the -first element of which is a string, then store the message as -specified by @var{split}, if header @var{field} (a regexp) contains -@var{value} (also a regexp). If @var{restrict} (yet another regexp) -matches some string after @var{field} and before the end of the -matched @var{value}, the @var{split} is ignored. If none of the -@var{restrict} clauses match, @var{split} is processed. - -@item -@code{(| @var{split}@dots{})}: If the split is a list, and the first -element is @code{|} (vertical bar), then process each @var{split} until -one of them matches. A @var{split} is said to match if it will cause -the mail message to be stored in one or more groups. - -@item -@code{(& @var{split}@dots{})}: If the split is a list, and the first -element is @code{&}, then process all @var{split}s in the list. - -@item -@code{junk}: If the split is the symbol @code{junk}, then don't save -(i.e., delete) this message. Use with extreme caution. +@table @code -@item -@code{(: @var{function} @var{arg1} @var{arg2} @dots{})}: If the split is -a list, and the first element is @code{:}, then the second element will -be called as a function with @var{args} given as arguments. The -function should return a @var{split}. +@item group +If the split is a string, that will be taken as a group name. Normal +regexp match expansion will be done. See below for examples. + +@item (@var{field} @var{value} [- @var{restrict} [@dots{}] ] @var{split}) +If the split is a list, the first element of which is a string, then +store the message as specified by @var{split}, if header @var{field} +(a regexp) contains @var{value} (also a regexp). If @var{restrict} +(yet another regexp) matches some string after @var{field} and before +the end of the matched @var{value}, the @var{split} is ignored. If +none of the @var{restrict} clauses match, @var{split} is processed. + +@item (| @var{split} @dots{}) +If the split is a list, and the first element is @code{|} (vertical +bar), then process each @var{split} until one of them matches. A +@var{split} is said to match if it will cause the mail message to be +stored in one or more groups. + +@item (& @var{split} @dots{}) +If the split is a list, and the first element is @code{&}, then +process all @var{split}s in the list. + +@item junk +If the split is the symbol @code{junk}, then don't save (i.e., delete) +this message. Use with extreme caution. + +@item (: @var{function} @var{arg1} @var{arg2} @dots{}) +If the split is a list, and the first element is @samp{:}, then the +second element will be called as a function with @var{args} given as +arguments. The function should return a @var{split}. @cindex body split For instance, the following function could be used to split based on the @@ -13877,25 +13946,31 @@ body of the messages: @lisp (defun split-on-body () (save-excursion - (set-buffer " *nnmail incoming*") - (goto-char (point-min)) - (when (re-search-forward "Some.*string" nil t) - "string.group"))) -@end lisp + (save-restriction + (widen) + (goto-char (point-min)) + (when (re-search-forward "Some.*string" nil t) + "string.group")))) +@end lisp + +The buffer is narrowed to the message in question when @var{function} +is run. That's why @code{(widen)} needs to be called after +@code{save-excursion} and @code{save-restriction} in the example +above. Also note that with the nnimap backend, message bodies will +not be downloaded by default. You need to set +@code{nnimap-split-download-body} to t to do that (@pxref{Splitting in +IMAP}). + +@item (! @var{func} @var{split}) +If the split is a list, and the first element is @code{!}, then +@var{split} will be processed, and @var{func} will be called as a +function with the result of @var{split} as argument. @var{func} +should return a split. -The @samp{" *nnmail incoming*"} is narrowed to the message in question -when the @code{:} function is run. - -@item -@code{(! @var{func} @var{split})}: If the split is a list, and the -first element is @code{!}, then @var{split} will be processed, and -@var{func} will be called as a function with the result of @var{split} -as argument. @var{func} should return a split. - -@item -@code{nil}: If the split is @code{nil}, it is ignored. +@item nil +If the split is @code{nil}, it is ignored. -@end enumerate +@end table In these splits, @var{field} must match a complete field name. @var{value} must match a complete word according to the fundamental mode @@ -13904,11 +13979,22 @@ field names or words. In other words, all @var{value}'s are wrapped in @samp{\<} and @samp{\>} pairs. @vindex nnmail-split-abbrev-alist -@var{field} and @var{value} can also be Lisp symbols, in that case they -are expanded as specified by the variable -@code{nnmail-split-abbrev-alist}. This is an alist of cons cells, where -the @code{car} of a cell contains the key, and the @code{cdr} contains the associated -value. +@var{field} and @var{value} can also be Lisp symbols, in that case +they are expanded as specified by the variable +@code{nnmail-split-abbrev-alist}. This is an alist of cons cells, +where the @sc{car} of a cell contains the key, and the @sc{cdr} +contains the associated value. Predefined entries in +@code{nnmail-split-abbrev-alist} include: + +@table @code +@item from +Matches the @samp{From}, @samp{Sender} and @samp{Resent-From} fields. +@item to +Matches the @samp{To}, @samp{Cc}, @samp{Apparently-To}, +@samp{Resent-To} and @samp{Resent-Cc} fields. +@item any +Is the union of the @code{from} and @code{to} entries. +@end table @vindex nnmail-split-fancy-syntax-table @code{nnmail-split-fancy-syntax-table} is the syntax table in effect @@ -13930,6 +14016,25 @@ matched string will be substituted. Similarly, the elements @samp{\\1} up to @samp{\\9} will be substituted with the text matched by the groupings 1 through 9. +@vindex nnmail-split-fancy-match-partial-words +@code{nnmail-split-fancy-match-partial-words} controls whether partial +words are matched during fancy splitting. + +Normally, regular expressions given in @code{nnmail-split-fancy} are +implicitly surrounded by @code{\<...\>} markers, which are word +delimiters. If this variable is true, they are not implicitly +surrounded by anything. + +@example +(any "joe" "joemail") +@end example + +In this example, messages sent from @samp{joedavis@@foo.org} will +normally not be filed in @samp{joemail}. With +@code{nnmail-split-fancy-match-partial-words} set to t, however, the +match will happen. In effect, the requirement of a word boundary is +removed and instead the match becomes more like a grep. + @findex nnmail-split-fancy-with-parent @code{nnmail-split-fancy-with-parent} is a function which allows you to split followups into the same groups their parents are in. Sometimes @@ -13975,10 +14080,10 @@ messages goes into the new group. Also see the variable @code{nnmail-cache-ignore-groups} if you don't want certain groups to be recorded in the cache. For example, if all -outgoing messages are written to an `outgoing' group, you could set +outgoing messages are written to an ``outgoing'' group, you could set @code{nnmail-cache-ignore-groups} to match that group name. Otherwise, answers to all your messages would end up in the -`outgoing' group. +``outgoing'' group. @node Group Mail Splitting @@ -13989,31 +14094,31 @@ Otherwise, answers to all your messages would end up in the @findex gnus-group-split If you subscribe to dozens of mailing lists but you don't want to maintain mail splitting rules manually, group mail splitting is for you. -You just have to set @var{to-list} and/or @var{to-address} in group +You just have to set @code{to-list} and/or @code{to-address} in group parameters or group customization and set @code{nnmail-split-methods} to @code{gnus-group-split}. This splitting function will scan all groups for those parameters and split mail accordingly, i.e., messages posted -from or to the addresses specified in the parameters @var{to-list} or -@var{to-address} of a mail group will be stored in that group. +from or to the addresses specified in the parameters @code{to-list} or +@code{to-address} of a mail group will be stored in that group. Sometimes, mailing lists have multiple addresses, and you may want mail -splitting to recognize them all: just set the @var{extra-aliases} group +splitting to recognize them all: just set the @code{extra-aliases} group parameter to the list of additional addresses and it's done. If you'd -rather use a regular expression, set @var{split-regexp}. +rather use a regular expression, set @code{split-regexp}. All these parameters in a group will be used to create an @code{nnmail-split-fancy} split, in which the @var{field} is @samp{any}, the @var{value} is a single regular expression that matches -@var{to-list}, @var{to-address}, all of @var{extra-aliases} and all -matches of @var{split-regexp}, and the @var{split} is the name of the +@code{to-list}, @code{to-address}, all of @code{extra-aliases} and all +matches of @code{split-regexp}, and the @var{split} is the name of the group. @var{restrict}s are also supported: just set the -@var{split-exclude} parameter to a list of regular expressions. +@code{split-exclude} parameter to a list of regular expressions. If you can't get the right split to be generated using all these parameters, or you just need something fancier, you can set the -parameter @var{split-spec} to an @code{nnmail-split-fancy} split. In +parameter @code{split-spec} to an @code{nnmail-split-fancy} split. In this case, all other aforementioned parameters will be ignored by -@code{gnus-group-split}. In particular, @var{split-spec} may be set to +@code{gnus-group-split}. In particular, @code{split-spec} may be set to @code{nil}, in which case the group will be ignored by @code{gnus-group-split}. @@ -14022,7 +14127,7 @@ this case, all other aforementioned parameters will be ignored by by defining a single @code{&} fancy split containing one split for each group. If a message doesn't match any split, it will be stored in the group named in @code{gnus-group-split-default-catch-all-group}, unless -some group has @var{split-spec} set to @code{catch-all}, in which case +some group has @code{split-spec} set to @code{catch-all}, in which case that group is used as the catch-all group. Even though this variable is often used just to name a group, it may also be set to an arbitrarily complex fancy split (after all, a group name is a fancy split), and this @@ -14071,10 +14176,10 @@ splits like this: parameters will be scanned to generate the output split. @var{no-crosspost} can be used to disable cross-posting; in this case, a single @code{|} split will be output. @var{catch-all} is the fall back -fancy split, used like @var{gnus-group-split-default-catch-all-group}. -If @var{catch-all} is @code{nil}, or if @var{split-regexp} matches the +fancy split, used like @code{gnus-group-split-default-catch-all-group}. +If @var{catch-all} is @code{nil}, or if @code{split-regexp} matches the empty string in any selected group, no catch-all split will be issued. -Otherwise, if some group has @var{split-spec} set to @code{catch-all}, +Otherwise, if some group has @code{split-spec} set to @code{catch-all}, this group will override the value of the @var{catch-all} argument. @findex gnus-group-split-setup @@ -14188,9 +14293,9 @@ repeating one more time, with some spurious capitalizations: IF you do NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES. You do not have to mark articles as expirable by hand. Gnus provides -two features, called `auto-expire' and `total-expire', that can help you -with this. In a nutshell, `auto-expire' means that Gnus hits @kbd{E} -for you when you select an article. And `total-expire' means that Gnus +two features, called ``auto-expire'' and ``total-expire'', that can help you +with this. In a nutshell, ``auto-expire'' means that Gnus hits @kbd{E} +for you when you select an article. And ``total-expire'' means that Gnus considers all articles as expirable that are read. So, in addition to the articles marked @samp{E}, also the articles marked @samp{r}, @samp{R}, @samp{O}, @samp{K}, @samp{Y} and so on are considered @@ -14208,8 +14313,8 @@ advantage of auto-expire is that you get more marks to work with: for the articles that are supposed to stick around, you can still choose between tick and dormant and read marks. But with total-expire, you only have dormant and ticked to choose from. The advantage of -total-expire is that it works well with adaptive scoring @pxref{Adaptive -Scoring}. Auto-expire works with normal scoring but not with adaptive +total-expire is that it works well with adaptive scoring (@pxref{Adaptive +Scoring}). Auto-expire works with normal scoring but not with adaptive scoring. @vindex gnus-auto-expirable-newsgroups @@ -14324,9 +14429,9 @@ expire mail to groups according to the variable With this setup, any mail that has @code{IMPORTANT} in its Subject header and was sent in the year @code{YYYY} and month @code{MMM}, will -get expired to the group @code{nnfolder:IMPORTANT.YYYY.MMM}. If its +get expired to the group @code{nnfolder:IMPORTANT.YYYY.MMM}. If its From or To header contains the string @code{boss}, it will get expired -to @code{nnfolder:Work}. All other mail will get expired to +to @code{nnfolder:Work}. All other mail will get expired to @code{nnfolder:Archive-YYYY}. @vindex nnmail-keep-last-article @@ -14730,8 +14835,8 @@ files. @end table @findex nnml-generate-nov-databases -If your @code{nnml} groups and @acronym{NOV} files get totally out of whack, -you can do a complete update by typing @kbd{M-x +If your @code{nnml} groups and @acronym{NOV} files get totally out of +whack, you can do a complete update by typing @kbd{M-x nnml-generate-nov-databases}. This command will trawl through the entire @code{nnml} hierarchy, looking at each and every article, so it might take a while to complete. A better interface to this @@ -14745,9 +14850,10 @@ Commands}). @cindex mh-e mail spool @code{nnmh} is just like @code{nnml}, except that is doesn't generate -@acronym{NOV} databases and it doesn't keep an active file or marks file. -This makes @code{nnmh} a @emph{much} slower back end than @code{nnml}, -but it also makes it easier to write procmail scripts for. +@acronym{NOV} databases and it doesn't keep an active file or marks +file. This makes @code{nnmh} a @emph{much} slower back end than +@code{nnml}, but it also makes it easier to write procmail scripts +for. Virtual server settings: @@ -14766,11 +14872,11 @@ If non-@code{nil}, @code{nnmh} will read incoming mail. The default is @item nnmh-be-safe @vindex nnmh-be-safe If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make -sure that the articles in the folder are actually what Gnus thinks they -are. It will check date stamps and stat everything in sight, so +sure that the articles in the folder are actually what Gnus thinks +they are. It will check date stamps and stat everything in sight, so setting this to @code{t} will mean a serious slow-down. If you never -use anything but Gnus to read the @code{nnmh} articles, you do not have -to set this variable to @code{t}. The default is @code{nil}. +use anything but Gnus to read the @code{nnmh} articles, you do not +have to set this variable to @code{t}. The default is @code{nil}. @end table @@ -14782,40 +14888,40 @@ to set this variable to @code{t}. The default is @code{nil}. @code{nnmaildir} stores mail in the maildir format, with each maildir corresponding to a group in Gnus. This format is documented here: @uref{http://cr.yp.to/proto/maildir.html} and here: -@uref{http://www.qmail.org/man/man5/maildir.html}. nnmaildir also -stores extra information in the @file{.nnmaildir/} directory within a -maildir. +@uref{http://www.qmail.org/man/man5/maildir.html}. @code{nnmaildir} +also stores extra information in the @file{.nnmaildir/} directory +within a maildir. Maildir format was designed to allow concurrent deliveries and reading, without needing locks. With other back ends, you would have your mail delivered to a spool of some kind, and then you would configure Gnus to split mail from that spool into your groups. You -can still do that with nnmaildir, but the more common configuration is -to have your mail delivered directly to the maildirs that appear as -group in Gnus. +can still do that with @code{nnmaildir}, but the more common +configuration is to have your mail delivered directly to the maildirs +that appear as group in Gnus. -nnmaildir is designed to be perfectly reliable: @kbd{C-g} will never -corrupt its data in memory, and @code{SIGKILL} will never corrupt its -data in the filesystem. +@code{nnmaildir} is designed to be perfectly reliable: @kbd{C-g} will +never corrupt its data in memory, and @code{SIGKILL} will never +corrupt its data in the filesystem. -nnmaildir stores article marks and @acronym{NOV} data in each maildir. So you -can copy a whole maildir from one Gnus setup to another, and you will -keep your marks. +@code{nnmaildir} stores article marks and @acronym{NOV} data in each +maildir. So you can copy a whole maildir from one Gnus setup to +another, and you will keep your marks. Virtual server settings: @table @code @item directory -For each of your nnmaildir servers (it's very unlikely that you'd need -more than one), you need to create a directory and populate it with -maildirs or symlinks to maildirs (and nothing else; do not choose a -directory already used for other purposes). Each maildir will be -represented in Gnus as a newsgroup on that server; the filename of the -symlink will be the name of the group. Any filenames in the directory -starting with `.' are ignored. The directory is scanned when you -first start Gnus, and each time you type @kbd{g} in the group buffer; -if any maildirs have been removed or added, nnmaildir notices at these -times. +For each of your @code{nnmaildir} servers (it's very unlikely that +you'd need more than one), you need to create a directory and populate +it with maildirs or symlinks to maildirs (and nothing else; do not +choose a directory already used for other purposes). Each maildir +will be represented in Gnus as a newsgroup on that server; the +filename of the symlink will be the name of the group. Any filenames +in the directory starting with @samp{.} are ignored. The directory is +scanned when you first start Gnus, and each time you type @kbd{g} in +the group buffer; if any maildirs have been removed or added, +@code{nnmaildir} notices at these times. The value of the @code{directory} parameter should be a Lisp form which is processed by @code{eval} and @code{expand-file-name} to get @@ -14826,7 +14932,8 @@ don't worry---a simple string will work.) This parameter is not optional; you must specify it. I don't recommend using @code{"~/Mail"} or a subdirectory of it; several other parts of Gnus use that directory by default for various things, and may get confused -if nnmaildir uses it too. @code{"~/.nnmaildir"} is a typical value. +if @code{nnmaildir} uses it too. @code{"~/.nnmaildir"} is a typical +value. @item target-prefix This should be a Lisp form which is processed by @code{eval} and @@ -14834,12 +14941,12 @@ This should be a Lisp form which is processed by @code{eval} and server is opened; the resulting string is used until the server is closed. -When you create a group on an nnmaildir server, the maildir is created -with @code{target-prefix} prepended to its name, and a symlink +When you create a group on an @code{nnmaildir} server, the maildir is +created with @code{target-prefix} prepended to its name, and a symlink pointing to that maildir is created, named with the plain group name. So if @code{directory} is @code{"~/.nnmaildir"} and @code{target-prefix} is @code{"../maildirs/"}, then when you create -the group @code{foo}, nnmaildir will create +the group @code{foo}, @code{nnmaildir} will create @file{~/.nnmaildir/../maildirs/foo} as a maildir, and will create @file{~/.nnmaildir/foo} as a symlink pointing to @file{../maildirs/foo}. @@ -14876,20 +14983,21 @@ the conventional Gnus way, from @code{mail-sources} according to value is @code{nil}. Do @emph{not} use the same maildir both in @code{mail-sources} and as -an nnmaildir group. The results might happen to be useful, but that -would be by chance, not by design, and the results might be different -in the future. If your split rules create new groups, remember to -supply a @code{create-directory} server parameter. +an @code{nnmaildir} group. The results might happen to be useful, but +that would be by chance, not by design, and the results might be +different in the future. If your split rules create new groups, +remember to supply a @code{create-directory} server parameter. @end table @subsubsection Group parameters -nnmaildir uses several group parameters. It's safe to ignore all -this; the default behavior for nnmaildir is the same as the default -behavior for other mail back ends: articles are deleted after one week, -etc. Except for the expiry parameters, all this functionality is -unique to nnmaildir, so you can ignore it if you're just trying to -duplicate the behavior you already have with another back end. +@code{nnmaildir} uses several group parameters. It's safe to ignore +all this; the default behavior for @code{nnmaildir} is the same as the +default behavior for other mail back ends: articles are deleted after +one week, etc. Except for the expiry parameters, all this +functionality is unique to @code{nnmaildir}, so you can ignore it if +you're just trying to duplicate the behavior you already have with +another back end. If the value of any of these parameters is a vector, the first element is evaluated as a Lisp form and the result is used, rather than the @@ -14903,15 +15011,15 @@ quote and wrap the value in a vector when appropriate.) @table @code @item expire-age -An integer specifying the minimum age, in seconds, of an article before -it will be expired, or the symbol @code{never} to specify that +An integer specifying the minimum age, in seconds, of an article +before it will be expired, or the symbol @code{never} to specify that articles should never be expired. If this parameter is not set, -nnmaildir falls back to the usual +@code{nnmaildir} falls back to the usual @code{nnmail-expiry-wait}(@code{-function}) variables (overrideable by the @code{expiry-wait}(@code{-function}) group parameters. If you wanted a value of 3 days, you could use something like @code{[(* 3 24 -60 60)]}; nnmaildir will evaluate the form and use the result. An -article's age is measured starting from the article file's +60 60)]}; @code{nnmaildir} will evaluate the form and use the result. +An article's age is measured starting from the article file's modification time. Normally, this is the same as the article's delivery time, but editing an article makes it younger. Moving an article (other than via expiry) may also make an article younger. @@ -14923,30 +15031,30 @@ If this is set to a string such as a full Gnus group name, like @end example and if it is not the name of the same group that the parameter belongs to, then articles will be moved to the specified group during expiry -before being deleted. @emph{If this is set to an nnmaildir group, the -article will be just as old in the destination group as it was in the -source group.} So be careful with @code{expire-age} in the +before being deleted. @emph{If this is set to an @code{nnmaildir} +group, the article will be just as old in the destination group as it +was in the source group.} So be careful with @code{expire-age} in the destination group. If this is set to the name of the same group that the parameter belongs to, then the article is not expired at all. If you use the vector form, the first element is evaluated once for each article. So that form can refer to @code{nnmaildir-article-file-name}, etc., to decide where to put the -article. @emph{If this parameter is not set, nnmaildir does not fall -back to the @code{expiry-target} group parameter or the +article. @emph{If this parameter is not set, @code{nnmaildir} does +not fall back to the @code{expiry-target} group parameter or the @code{nnmail-expiry-target} variable.} @item read-only -If this is set to @code{t}, nnmaildir will treat the articles in this -maildir as read-only. This means: articles are not renamed from -@file{new/} into @file{cur/}; articles are only found in @file{new/}, -not @file{cur/}; articles are never deleted; articles cannot be -edited. @file{new/} is expected to be a symlink to the @file{new/} -directory of another maildir---e.g., a system-wide mailbox containing -a mailing list of common interest. Everything in the maildir outside -@file{new/} is @emph{not} treated as read-only, so for a shared -mailbox, you do still need to set up your own maildir (or have write -permission to the shared mailbox); your maildir just won't contain -extra copies of the articles. +If this is set to @code{t}, @code{nnmaildir} will treat the articles +in this maildir as read-only. This means: articles are not renamed +from @file{new/} into @file{cur/}; articles are only found in +@file{new/}, not @file{cur/}; articles are never deleted; articles +cannot be edited. @file{new/} is expected to be a symlink to the +@file{new/} directory of another maildir---e.g., a system-wide mailbox +containing a mailing list of common interest. Everything in the +maildir outside @file{new/} is @emph{not} treated as read-only, so for +a shared mailbox, you do still need to set up your own maildir (or +have write permission to the shared mailbox); your maildir just won't +contain extra copies of the articles. @item directory-files A function with the same interface as @code{directory-files}. It is @@ -14955,45 +15063,45 @@ group to find articles. The default is the function specified by the server's @code{directory-files} parameter. @item distrust-Lines: -If non-@code{nil}, nnmaildir will always count the lines of an +If non-@code{nil}, @code{nnmaildir} will always count the lines of an article, rather than use the @code{Lines:} header field. If @code{nil}, the header field will be used if present. @item always-marks -A list of mark symbols, such as -@code{['(read expire)]}. Whenever Gnus asks nnmaildir for -article marks, nnmaildir will say that all articles have these -marks, regardless of whether the marks stored in the filesystem -say so. This is a proof-of-concept feature that will probably be -removed eventually; it ought to be done in Gnus proper, or -abandoned if it's not worthwhile. +A list of mark symbols, such as @code{['(read expire)]}. Whenever +Gnus asks @code{nnmaildir} for article marks, @code{nnmaildir} will +say that all articles have these marks, regardless of whether the +marks stored in the filesystem say so. This is a proof-of-concept +feature that will probably be removed eventually; it ought to be done +in Gnus proper, or abandoned if it's not worthwhile. @item never-marks A list of mark symbols, such as @code{['(tick expire)]}. Whenever -Gnus asks nnmaildir for article marks, nnmaildir will say that no -articles have these marks, regardless of whether the marks stored in -the filesystem say so. @code{never-marks} overrides +Gnus asks @code{nnmaildir} for article marks, @code{nnmaildir} will +say that no articles have these marks, regardless of whether the marks +stored in the filesystem say so. @code{never-marks} overrides @code{always-marks}. This is a proof-of-concept feature that will probably be removed eventually; it ought to be done in Gnus proper, or abandoned if it's not worthwhile. @item nov-cache-size -An integer specifying the size of the @acronym{NOV} memory cache. To speed -things up, nnmaildir keeps @acronym{NOV} data in memory for a limited number of -articles in each group. (This is probably not worthwhile, and will -probably be removed in the future.) This parameter's value is noticed -only the first time a group is seen after the server is opened---i.e., -when you first start Gnus, typically. The @acronym{NOV} cache is never resized -until the server is closed and reopened. The default is an estimate -of the number of articles that would be displayed in the summary -buffer: a count of articles that are either marked with @code{tick} or -not marked with @code{read}, plus a little extra. +An integer specifying the size of the @acronym{NOV} memory cache. To +speed things up, @code{nnmaildir} keeps @acronym{NOV} data in memory +for a limited number of articles in each group. (This is probably not +worthwhile, and will probably be removed in the future.) This +parameter's value is noticed only the first time a group is seen after +the server is opened---i.e., when you first start Gnus, typically. +The @acronym{NOV} cache is never resized until the server is closed +and reopened. The default is an estimate of the number of articles +that would be displayed in the summary buffer: a count of articles +that are either marked with @code{tick} or not marked with +@code{read}, plus a little extra. @end table @subsubsection Article identification Articles are stored in the @file{cur/} subdirectory of each maildir. Each article file is named like @code{uniq:info}, where @code{uniq} -contains no colons. nnmaildir ignores, but preserves, the +contains no colons. @code{nnmaildir} ignores, but preserves, the @code{:info} part. (Other maildir readers typically use this part of the filename to store marks.) The @code{uniq} part uniquely identifies the article, and is used in various places in the @@ -15003,36 +15111,37 @@ available in the variable @code{nnmaildir-article-file-name} after you request the article in the summary buffer. @subsubsection NOV data -An article identified by @code{uniq} has its @acronym{NOV} data (used to -generate lines in the summary buffer) stored in +An article identified by @code{uniq} has its @acronym{NOV} data (used +to generate lines in the summary buffer) stored in @code{.nnmaildir/nov/uniq}. There is no @code{nnmaildir-generate-nov-databases} function. (There isn't much -need for it---an article's @acronym{NOV} data is updated automatically when the -article or @code{nnmail-extra-headers} has changed.) You can force -nnmaildir to regenerate the @acronym{NOV} data for a single article simply by -deleting the corresponding @acronym{NOV} file, but @emph{beware}: this will also -cause nnmaildir to assign a new article number for this article, which -may cause trouble with @code{seen} marks, the Agent, and the cache. +need for it---an article's @acronym{NOV} data is updated automatically +when the article or @code{nnmail-extra-headers} has changed.) You can +force @code{nnmaildir} to regenerate the @acronym{NOV} data for a +single article simply by deleting the corresponding @acronym{NOV} +file, but @emph{beware}: this will also cause @code{nnmaildir} to +assign a new article number for this article, which may cause trouble +with @code{seen} marks, the Agent, and the cache. @subsubsection Article marks An article identified by @code{uniq} is considered to have the mark @code{flag} when the file @file{.nnmaildir/marks/flag/uniq} exists. -When Gnus asks nnmaildir for a group's marks, nnmaildir looks for such -files and reports the set of marks it finds. When Gnus asks nnmaildir -to store a new set of marks, nnmaildir creates and deletes the -corresponding files as needed. (Actually, rather than create a new -file for each mark, it just creates hard links to -@file{.nnmaildir/markfile}, to save inodes.) +When Gnus asks @code{nnmaildir} for a group's marks, @code{nnmaildir} +looks for such files and reports the set of marks it finds. When Gnus +asks @code{nnmaildir} to store a new set of marks, @code{nnmaildir} +creates and deletes the corresponding files as needed. (Actually, +rather than create a new file for each mark, it just creates hard +links to @file{.nnmaildir/markfile}, to save inodes.) You can invent new marks by creating a new directory in @file{.nnmaildir/marks/}. You can tar up a maildir and remove it from your server, untar it later, and keep your marks. You can add and remove marks yourself by creating and deleting mark files. If you do -this while Gnus is running and your nnmaildir server is open, it's -best to exit all summary buffers for nnmaildir groups and type @kbd{s} -in the group buffer first, and to type @kbd{g} or @kbd{M-g} in the -group buffer afterwards. Otherwise, Gnus might not pick up the -changes, and might undo them. +this while Gnus is running and your @code{nnmaildir} server is open, +it's best to exit all summary buffers for @code{nnmaildir} groups and +type @kbd{s} in the group buffer first, and to type @kbd{g} or +@kbd{M-g} in the group buffer afterwards. Otherwise, Gnus might not +pick up the changes, and might undo them. @node Mail Folders @@ -15041,10 +15150,10 @@ changes, and might undo them. @cindex mbox folders @cindex mail folders -@code{nnfolder} is a back end for storing each mail group in a separate -file. Each file is in the standard Un*x mbox format. @code{nnfolder} -will add extra headers to keep track of article numbers and arrival -dates. +@code{nnfolder} is a back end for storing each mail group in a +separate file. Each file is in the standard Un*x mbox format. +@code{nnfolder} will add extra headers to keep track of article +numbers and arrival dates. @cindex self contained nnfolder servers @cindex marks @@ -15054,19 +15163,19 @@ similar, and later be able to restore them into Gnus (by adding the proper @code{nnfolder} server) and have all your marks be preserved. Marks for a group is usually stored in a file named as the mbox file with @code{.mrk} concatenated to it (but see -@code{nnfolder-marks-file-suffix}) within the @code{nnfolder} directory. -Individual @code{nnfolder} groups are also possible to backup, use -@kbd{G m} to restore the group (after restoring the backup into the -@code{nnfolder} directory). +@code{nnfolder-marks-file-suffix}) within the @code{nnfolder} +directory. Individual @code{nnfolder} groups are also possible to +backup, use @kbd{G m} to restore the group (after restoring the backup +into the @code{nnfolder} directory). Virtual server settings: @table @code @item nnfolder-directory @vindex nnfolder-directory -All the @code{nnfolder} mail boxes will be stored under this directory. -The default is the value of @code{message-directory} (whose default is -@file{~/Mail}) +All the @code{nnfolder} mail boxes will be stored under this +directory. The default is the value of @code{message-directory} +(whose default is @file{~/Mail}) @item nnfolder-active-file @vindex nnfolder-active-file @@ -15079,16 +15188,16 @@ Format}. The default is @file{~/Mail/newsgroups} @item nnfolder-get-new-mail @vindex nnfolder-get-new-mail -If non-@code{nil}, @code{nnfolder} will read incoming mail. The default -is @code{t} +If non-@code{nil}, @code{nnfolder} will read incoming mail. The +default is @code{t} @item nnfolder-save-buffer-hook @vindex nnfolder-save-buffer-hook @cindex backup files Hook run before saving the folders. Note that Emacs does the normal -backup renaming of files even with the @code{nnfolder} buffers. If you -wish to switch this off, you could say something like the following in -your @file{.emacs} file: +backup renaming of files even with the @code{nnfolder} buffers. If +you wish to switch this off, you could say something like the +following in your @file{.emacs} file: @lisp (defun turn-off-backup () @@ -15272,13 +15381,13 @@ filename is unrelated to the article number in Gnus. @code{nnmaildir} also stores the equivalent of @code{nnml}'s overview files in one file per article, so it uses about twice as many inodes as @code{nnml}. (Use @code{df -i} to see how plentiful your inode supply is.) If this slows -you down or takes up very much space, consider switching to +you down or takes up very much space, consider switching to @uref{http://www.namesys.com/, ReiserFS} or another non-block-structured file system. Since maildirs don't require locking for delivery, the maildirs you use as groups can also be the maildirs your mail is directly delivered to. -This means you can skip Gnus's mail splitting if your mail is already +This means you can skip Gnus' mail splitting if your mail is already organized into different mailboxes during delivery. A @code{directory} entry in @code{mail-sources} would have a similar effect, but would require one set of mailboxes for spooling deliveries (in mbox format, @@ -15341,7 +15450,7 @@ Gnus has been getting a bit of a collection of back ends for providing interfaces to these sources. @menu -* Archiving Mail:: +* Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. * Slashdot:: Reading the Slashdot comments. * Ultimate:: The Ultimate Bulletin Board systems. @@ -15382,7 +15491,7 @@ To archive an entire @code{nnml}, @code{nnfolder}, or @code{nnmaildir} server, take a recursive copy of the server directory. There is no need to shut down Gnus, so archiving may be invoked by @code{cron} or similar. You restore the data by restoring the directory tree, and -adding a server definition pointing to that directory in Gnus. The +adding a server definition pointing to that directory in Gnus. The @ref{Article Backlog}, @ref{Asynchronous Fetching} and other things might interfere with overwriting data, so you may want to shut down Gnus before you restore the data. @@ -15392,7 +15501,7 @@ It is also possible to archive individual @code{nnml}, For @code{nnml} or @code{nnmaildir}, you copy all files in the group's directory. For @code{nnfolder} you need to copy both the base folder file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in -this example). Restoring the group is done with @kbd{G m} from the Group +this example). Restoring the group is done with @kbd{G m} from the Group buffer. The last step makes Gnus notice the new directory. @code{nnmaildir} notices the new directory automatically, so @kbd{G m} is unnecessary in that case. @@ -15446,7 +15555,7 @@ Virtual server variables: @item nnweb-type @vindex nnweb-type What search engine type is being used. The currently supported types -are @code{google}, @code{dejanews}, and @code{gmane}. Note that +are @code{google}, @code{dejanews}, and @code{gmane}. Note that @code{dejanews} is an alias to @code{google}. @item nnweb-search @@ -15516,7 +15625,7 @@ command is the most handy tool (@pxref{Foreign Groups}). When following up to @code{nnslashdot} comments (or posting new comments), some light @acronym{HTML}izations will be performed. In particular, text quoted with @samp{> } will be quoted with -@code{blockquote} instead, and signatures will have @code{br} added to +@samp{blockquote} instead, and signatures will have @samp{br} added to the end of each line. Other than that, you can just write @acronym{HTML} directly into the message buffer. Note that Slashdot filters out some @acronym{HTML} forms. @@ -15547,20 +15656,18 @@ Where @code{nnslashdot} will store its files. The default is @item nnslashdot-active-url @vindex nnslashdot-active-url -The @sc{url} format string that will be used to fetch the information on -news articles and comments. The default is@* +The @acronym{URL} format string that will be used to fetch the +information on news articles and comments. The default is@* @samp{http://slashdot.org/search.pl?section=&min=%d}. @item nnslashdot-comments-url @vindex nnslashdot-comments-url -The @sc{url} format string that will be used to fetch comments. The -default is -@samp{http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d}. +The @acronym{URL} format string that will be used to fetch comments. @item nnslashdot-article-url @vindex nnslashdot-article-url -The @sc{url} format string that will be used to fetch the news article. The -default is +The @acronym{URL} format string that will be used to fetch the news +article. The default is @samp{http://slashdot.org/article.pl?sid=%s&mode=nocomment}. @item nnslashdot-threshold @@ -15588,7 +15695,7 @@ information Gnus needs to keep groups updated. The easiest way to get started with @code{nnultimate} is to say something like the following in the group buffer: @kbd{B nnultimate RET -http://www.tcj.com/messboard/ubbcgi/ RET}. (Substitute the @sc{url} +http://www.tcj.com/messboard/ubbcgi/ RET}. (Substitute the @acronym{URL} (not including @samp{Ultimate.cgi} or the like at the end) for a forum you're interested in; there's quite a list of them on the Ultimate web site.) Then subscribe to the groups you're interested in from the @@ -15646,14 +15753,21 @@ The password for your account on the web server. @cindex nnrss @cindex RSS -Some sites have RDF site summary (RSS) -@uref{http://purl.org/rss/1.0/spec}. It has a quite regular and nice -interface, and it's possible to get the information Gnus needs to keep -groups updated. +Some web sites have an RDF Site Summary (@acronym{RSS}). +@acronym{RSS} is a format for summarizing headlines from news related +sites (such as BBC or CNN). But basically anything list-like can be +presented as an @acronym{RSS} feed: weblogs, changelogs or recent +changes to a wiki (e.g. @url{http://cliki.net/recent-changes.rdf}). + +@acronym{RSS} has a quite regular and nice interface, and it's +possible to get the information Gnus needs to keep groups updated. -The easiest way to get started with @code{nnrss} is to say something -like the following in the group buffer: @kbd{B nnrss RET RET}, then -subscribe groups. +Use @kbd{G R} from the summary buffer to subscribe to a feed---you +will be prompted for the location of the feed. + +An easy way to get started with @code{nnrss} is to say something like +the following in the group buffer: @kbd{B nnrss RET y}, then +subscribe to groups. The following @code{nnrss} variables can be altered: @@ -15663,6 +15777,13 @@ The following @code{nnrss} variables can be altered: The directory where @code{nnrss} stores its files. The default is @file{~/News/rss/}. +@item nnrss-use-local +@vindex nnrss-use-local +@findex nnrss-generate-download-script +If you set @code{nnrss-use-local} to @code{t}, @code{nnrss} will read +the feeds from local files in @code{nnrss-directory}. You can use +the command @code{nnrss-generate-download-script} to generate a +download script using @command{wget}. @end table The following code may be helpful, if you want to show the description in @@ -15760,9 +15881,10 @@ entry in @code{gnus-secondary-select-methods}. With this, Gnus will manipulate mails stored on the @acronym{IMAP} server. This is the kind of usage explained in this section. -A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP} servers -might look something like the following. (Note that for @acronym{TLS}/@acronym{SSL}, you -need external programs and libraries, see below.) +A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP} +servers might look something like the following. (Note that for +@acronym{TLS}/@acronym{SSL}, you need external programs and libraries, +see below.) @lisp (setq gnus-secondary-select-methods @@ -15840,8 +15962,9 @@ Example server specification: @vindex nnimap-stream The type of stream used to connect to your server. By default, nnimap will detect and automatically use all of the below, with the exception -of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over @acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which -can be automatically detected, but it's not widely deployed yet.) +of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over +@acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which can +be automatically detected, but it's not widely deployed yet.) Example server specification: @@ -15854,10 +15977,10 @@ Please note that the value of @code{nnimap-stream} is a symbol! @itemize @bullet @item -@dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the +@dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the @samp{gsasl} or @samp{imtest} program. @item -@dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program. +@dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program. @item @dfn{starttls:} Connect via the STARTTLS extension (similar to @acronym{TLS}/@acronym{SSL}). Requires the external library @samp{starttls.el} and program @@ -15900,11 +16023,11 @@ tried. @vindex imap-ssl-program For @acronym{SSL} connections, the OpenSSL program is available from -@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay, +@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay, and nnimap support it too---although the most recent versions of SSLeay, 0.9.x, are known to have serious bugs making it -useless. Earlier versions, especially 0.8.x, of SSLeay are known to -work. The variable @code{imap-ssl-program} contain parameters to pass +useless. Earlier versions, especially 0.8.x, of SSLeay are known to +work. The variable @code{imap-ssl-program} contain parameters to pass to OpenSSL/SSLeay. @vindex imap-shell-program @@ -15929,27 +16052,27 @@ Please note that the value of @code{nnimap-authenticator} is a symbol! @itemize @bullet @item -@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires +@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires external program @code{gsasl} or @code{imtest}. @item -@dfn{kerberos4:} Kerberos 4 authentication. Requires external program +@dfn{kerberos4:} Kerberos 4 authentication. Requires external program @code{imtest}. @item -@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires +@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires external library @code{digest-md5.el}. @item @dfn{cram-md5:} Encrypted username/password via CRAM-MD5. @item @dfn{login:} Plain-text username/password via LOGIN. @item -@dfn{anonymous:} Login as `anonymous', supplying your email address as password. +@dfn{anonymous:} Login as ``anonymous'', supplying your email address as password. @end itemize @item nnimap-expunge-on-close @cindex expunging @vindex nnimap-expunge-on-close -Unlike Parmenides the @acronym{IMAP} designers has decided that things that -doesn't exist actually does exist. More specifically, @acronym{IMAP} has +Unlike Parmenides the @acronym{IMAP} designers have decided things that +don't exist actually do exist. More specifically, @acronym{IMAP} has this concept of marking articles @code{Deleted} which doesn't actually delete them, and this (marking them @code{Deleted}, that is) is what nnimap does when you delete an article in Gnus (with @kbd{B DEL} or @@ -15985,10 +16108,10 @@ articles or not. @vindex nnimap-importantize-dormant If non-@code{nil} (the default), marks dormant articles as ticked (as -well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will +well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will naturally still (only) be marked as dormant. This is to make dormant articles stand out, just like ticked articles, in other @acronym{IMAP} -clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP} +clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP} has only one.) Probably the only reason for frobing this would be if you're trying @@ -16015,7 +16138,7 @@ UID set and the second @code{%s} is replaced by a date. Probably the only useful value to change this to is @code{"UID %s NOT SENTSINCE %s"}, which makes nnimap use the Date: in -messages instead of the internal article date. See section 6.4.4 of +messages instead of the internal article date. See section 6.4.4 of RFC 2060 for more information on valid strings. @item nnimap-authinfo-file @@ -16041,6 +16164,7 @@ Courier 1.7.1 did. * Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. * Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. * A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. +* Debugging IMAP:: What to do when things don't work. @end menu @@ -16049,14 +16173,18 @@ Courier 1.7.1 did. @subsection Splitting in IMAP @cindex splitting imap mail -Splitting is something Gnus users has loved and used for years, and now +Splitting is something Gnus users have loved and used for years, and now the rest of the world is catching up. Yeah, dream on, not many -@acronym{IMAP} server has server side splitting and those that have splitting -seem to use some non-standard protocol. This means that @acronym{IMAP} -support for Gnus has to do it's own splitting. +@acronym{IMAP} servers have server side splitting and those that have +splitting seem to use some non-standard protocol. This means that +@acronym{IMAP} support for Gnus has to do its own splitting. And it does. +(Incidentally, people seem to have been dreaming on, and Sieve has +gaining a market share and is supported by several IMAP servers. +Fortunately, Gnus support it too, @xref{Sieve Commands}.) + Here are the variables of interest: @table @code @@ -16112,7 +16240,7 @@ This will put all articles from the nnimap mailing list into mailbox INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line into INBOX.junk and everything else in INBOX.private. -The first string may contain `\\1' forms, like the ones used by +The first string may contain @samp{\\1} forms, like the ones used by replace-match to insert sub-expressions from the matched text. For instance: @@ -16176,7 +16304,7 @@ split, it is a string and the default is @samp{UNSEEN UNDELETED}. This might be useful if you use another @acronym{IMAP} client to read mail in your inbox but would like Gnus to split all articles in the inbox -regardless of readedness. Then you might change this to +regardless of readedness. Then you might change this to @samp{UNDELETED}. @item nnimap-split-fancy @@ -16186,7 +16314,7 @@ regardless of readedness. Then you might change this to It's possible to set @code{nnimap-split-rule} to @code{nnmail-split-fancy} if you want to use fancy -splitting. @xref{Fancy Mail Splitting}. +splitting. @xref{Fancy Mail Splitting}. However, to be able to have different fancy split rules for nnmail and nnimap back ends you can set @code{nnimap-split-rule} to @@ -16256,7 +16384,7 @@ article is copied instead of appended (that is, uploaded again). @cindex editing imap acls @cindex Access Control Lists @cindex Editing @acronym{IMAP} ACLs -@kindex G l +@kindex G l (Group) @findex gnus-group-nnimap-edit-acl ACL stands for Access Control List. ACLs are used in @acronym{IMAP} for @@ -16288,7 +16416,7 @@ INBOX.mailbox). @cindex expunge @cindex manual expunging -@kindex G x +@kindex G x (Group) @findex gnus-group-nnimap-expunge If you're using the @code{never} setting of @code{nnimap-expunge-on-close}, @@ -16340,6 +16468,40 @@ See the UoW IMAPD documentation for the @code{#driver.*/} prefix for more information on how to use the prefixes. They are a power tool and should be used only if you are sure what the effects are. +@node Debugging IMAP +@subsection Debugging IMAP +@cindex IMAP debugging +@cindex protocol dump (IMAP) + +@acronym{IMAP} is a complex protocol, more so than @acronym{NNTP} or +@acronym{POP3}. Implementation bugs are not unlikely, and we do our +best to fix them right away. If you encounter odd behaviour, chances +are that either the server or Gnus is buggy. + +If you are familiar with network protocols in general, you will +probably be able to extract some clues from the protocol dump of the +exchanges between Gnus and the server. Even if you are not familiar +with network protocols, when you include the protocol dump in +@acronym{IMAP}-related bug reports you are helping us with data +critical to solving the problem. Therefore, we strongly encourage you +to include the protocol dump when reporting IMAP bugs in Gnus. + + +@vindex imap-log +Because the protocol dump, when enabled, generates lots of data, it is +disabled by default. You can enable it by setting @code{imap-log} as +follows: + +@lisp +(setq imap-log t) +@end lisp + +This instructs the @code{imap.el} package to log any exchanges with +the server. The log is stored in the buffer @samp{*imap-log*}. Look +for error messages, which sometimes are tagged with the keyword +@code{BAD} - but when submitting a bug, make sure to include all the +data. + @node Other Sources @section Other Sources @@ -17090,7 +17252,7 @@ All marks in the virtual group will stick to the articles in the component groups. So if you tick an article in a virtual group, the article will also be ticked in the component group from whence it came. (And vice versa---marks from the component groups will also be -shown in the virtual group.). To create an empty virtual group, run +shown in the virtual group.). To create an empty virtual group, run @kbd{G V} (@code{gnus-group-make-empty-virtual}) in the group buffer and edit the method regexp with @kbd{M-e} (@code{gnus-group-edit-group-method}) @@ -17161,10 +17323,10 @@ inherited. @cindex nnkiboze @cindex kibozing -@dfn{Kibozing} is defined by @acronym{oed} as ``grepping through (parts of) -the news feed''. @code{nnkiboze} is a back end that will do this for -you. Oh joy! Now you can grind any @acronym{NNTP} server down to a halt -with useless requests! Oh happiness! +@dfn{Kibozing} is defined by the @acronym{OED} as ``grepping through +(parts of) the news feed''. @code{nnkiboze} is a back end that will +do this for you. Oh joy! Now you can grind any @acronym{NNTP} server +down to a halt with useless requests! Oh happiness! @kindex G k (Group) To create a kibozed group, use the @kbd{G k} command in the group @@ -17198,10 +17360,11 @@ and they can be foreign. No restrictions. @vindex nnkiboze-directory The generation of an @code{nnkiboze} group means writing two files in -@code{nnkiboze-directory}, which is @file{~/News/} by default. One -contains the @acronym{NOV} header lines for all the articles in the group, -and the other is an additional @file{.newsrc} file to store information -on what groups have been searched through to find component articles. +@code{nnkiboze-directory}, which is @file{~/News/kiboze/} by default. +One contains the @acronym{NOV} header lines for all the articles in +the group, and the other is an additional @file{.newsrc} file to store +information on what groups have been searched through to find +component articles. Articles marked as read in the @code{nnkiboze} group will have their @acronym{NOV} lines removed from the @acronym{NOV} file. @@ -17307,15 +17470,15 @@ already fetched while in this mode. You then decide to see whether any new news has arrived. You connect your machine to the net (using PPP or whatever), and then hit @kbd{J j} to make Gnus become @dfn{plugged} and use @kbd{g} to check for new mail -as usual. To check for new mail in unplugged mode, see (@pxref{Mail +as usual. To check for new mail in unplugged mode (@pxref{Mail Source Specifiers}). @item -You can then read the new news immediately, or you can download the news -onto your local machine. If you want to do the latter, you press @kbd{g} -to check if there are any new news and then @kbd{J -s} to fetch all the eligible articles in all the groups. (To let Gnus -know which articles you want to download, @pxref{Agent Categories}.) +You can then read the new news immediately, or you can download the +news onto your local machine. If you want to do the latter, you press +@kbd{g} to check if there are any new news and then @kbd{J s} to fetch +all the eligible articles in all the groups. (To let Gnus know which +articles you want to download, @pxref{Agent Categories}). @item After fetching the articles, you press @kbd{J j} to make Gnus become @@ -17345,7 +17508,7 @@ all @code{nntp} and @code{nnimap} servers in @code{gnus-select-method} and Decide on download policy. It's fairly simple once you decide whether you are going to use agent categories, topic parameters, and/or group parameters to implement your policy. If you're new to gnus, it -is probably best to start with a category @xref{Agent Categories}. +is probably best to start with a category, @xref{Agent Categories}. Both topic parameters (@pxref{Topic Parameters}) and agent categories (@pxref{Agent Categories}) provide for setting a policy that applies @@ -17388,7 +17551,7 @@ Since you can set agent parameters in several different places we have a rule to decide which source to believe. This rule specifies that the parameter sources are checked in the following order: group parameters, topic parameters, agent category, and finally customizable -variables. So you can mix all of these sources to produce a wide range +variables. So you can mix all of these sources to produce a wide range of behavior, just don't blame me if you don't remember where you put your settings. @@ -17407,6 +17570,7 @@ category, and a number of optional parameters that override the customizable variables. The complete list of agent parameters are listed below. +@cindex Agent Parameters @table @code @item gnus-agent-cat-name The name of the category. @@ -17445,6 +17609,12 @@ an integer that overrides the value of @item gnus-agent-cat-length-when-long an integer that overrides the value of @code{gnus-agent-long-article}. + +@item gnus-agent-cat-disable-undownloaded-faces +a symbol indicating whether the summary buffer should @emph{not} display +undownloaded articles using the gnus-summary-*-undownloaded-face +faces. The symbol nil will enable the use of undownloaded faces while +all other symbols disable them. @end table The name of a category can not be changed once the category has been @@ -17585,7 +17755,7 @@ just don't give a damn. The above predicates apply to @emph{all} the groups which belong to the category. However, if you wish to have a specific predicate for an individual group within a category, or you're just too lazy to set up a -new category, you can enter a group's individual predicate in it's group +new category, you can enter a group's individual predicate in its group parameters like so: @lisp @@ -17626,7 +17796,7 @@ three forms: @item Score rule -This has the same syntax as a normal gnus score file except only a +This has the same syntax as a normal Gnus score file except only a subset of scoring keywords are available as mentioned above. example: @@ -17934,7 +18104,7 @@ Remove the downloading mark from the article @findex gnus-agent-toggle-mark Toggle whether to download the article (@code{gnus-agent-toggle-mark}). The download mark is @samp{%} by -default. +default. @item J c @kindex J c (Agent Summary) @@ -17944,7 +18114,7 @@ Mark all articles as read (@code{gnus-agent-catchup}) that are neither cached, d @item J S @kindex J S (Agent Summary) @findex gnus-agent-fetch-group -Download all eligible (See @pxref{Agent Categories}) articles in this group. +Download all eligible (@pxref{Agent Categories}) articles in this group. (@code{gnus-agent-fetch-group}). @item J s @@ -18005,8 +18175,8 @@ the download status of each article so that you always know which articles will be available when unplugged. The first visual effect is the @samp{%O} spec. If you customize -gnus-summary-line-format to include this specifier, you will add a -single character field that indicates an article's download status. +@code{gnus-summary-line-format} to include this specifier, you will add +a single character field that indicates an article's download status. Articles that have been fetched into either the Agent or the Cache, will display @code{gnus-downloaded-mark} (defaults to @samp{+}). All other articles will display @code{gnus-undownloaded-mark} (defaults to @@ -18036,8 +18206,8 @@ faces will be obscured by the undownloaded faces. If this is your situation, you have two choices available. First, you can completely disable the undownload faces by customizing @code{gnus-summary-highlight} to delete the three cons-cells that -refer to the gnus-summary*-undownloaded-face faces. Second, if you -prefer to take a more fine-grained approach, you may set the +refer to the @code{gnus-summary-*-undownloaded-face} faces. Second, if +you prefer to take a more fine-grained approach, you may set the @code{agent-disable-undownloaded-faces} group parameter to t. This parameter, like all other agent parameters, may be set on an Agent Category (@pxref{Agent Categories}), a Group Topic (@pxref{Topic @@ -18074,7 +18244,7 @@ sense if you are using a nntp or nnimap back end. @cindex Gnus agent expiry @cindex expiry -The Agent back end, @code{nnagent}, doesn't handle expiry. Well, at +The Agent back end, @code{nnagent}, doesn't handle expiry. Well, at least it doesn't handle it like other back ends. Instead, there are special @code{gnus-agent-expire} and @code{gnus-agent-expire-group} commands that will expire all read articles that are older than @@ -18084,7 +18254,7 @@ efficient, and it's not a particularly good idea to interrupt them (with @kbd{C-g} or anything else) once you've started one of them. Note that other functions, e.g. @code{gnus-request-expire-articles}, -might run @code{gnus-agent-expire} for you to keep the agent +might run @code{gnus-agent-expire} for you to keep the agent synchronized with the group. The agent parameter @code{agent-enable-expiration} may be used to @@ -18257,8 +18427,13 @@ read. The default is t. @item gnus-agent-consider-all-articles @vindex gnus-agent-consider-all-articles If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the -agent will fetch all missing headers. When @code{nil}, the agent will -fetch only new headers. The default is @code{nil}. +agent will let the agent predicate decide whether articles need to be +downloaded or not, for all articles. When @code{nil}, the default, +the agent will only let the predicate decide whether unread articles +are downloaded or not. If you enable this, you may also want to look +into the agent expiry settings (@pxref{Category Variables}), so that +the agent doesn't download articles which the agent will later expire, +over and over again. @item gnus-agent-max-fetch-size @vindex gnus-agent-max-fetch-size @@ -18297,6 +18472,18 @@ have not been fetched), @code{always-undownloaded} (maneuvering always ignores articles that have not been fetched), @code{unfetched} (maneuvering ignores articles whose headers have not been fetched). +@item gnus-agent-auto-agentize-methods +@vindex gnus-agent-auto-agentize-methods +If you have never used the Agent before (or more technically, if +@file{~/News/agent/lib/servers} does not exist), Gnus will +automatically agentize a few servers for you. This variable control +which backends should be auto-agentized. It is typically only useful +to agentize remote backends. The auto-agentizing has the same effect +as running @kbd{J a} on the servers (@pxref{Server Agent Commands}). +If the file exist, you must manage the servers manually by adding or +removing them, this variable is only applicable the first time you +start Gnus. The default is @samp{(nntp nnimap)}. + @end table @@ -18377,7 +18564,7 @@ may ask: @code{gnus-agent-fetch-selected-article} to @code{gnus-select-article-hook}. -@item If I read an article while plugged, and the article already exists in +@item If I read an article while plugged, and the article already exists in the Agent, will it get downloaded once more? @strong{No}, unless @code{gnus-agent-cache} is @code{nil}. @@ -18920,8 +19107,8 @@ Anyway, if you'd like to dig into it yourself, here's an example: (eval (ding))) @end lisp -This example demonstrates most score file elements. For a different -approach, see @pxref{Advanced Scoring}. +This example demonstrates most score file elements. @xref{Advanced +Scoring}, for a different approach. Even though this looks much like Lisp code, nothing here is actually @code{eval}ed. The Lisp reader is used to read this form, though, so it @@ -18993,11 +19180,13 @@ Just as for the standard string overview headers, if you are using gnus-extra-headers, you can score on these headers' values. In this case, there is a 5th element in the score entry, being the name of the header to be scored. The following entry is useful in your -@file{all.SCORE} file in case of spam attacks from a single origin host, -if your @acronym{NNTP} server tracks NNTP-Posting-Host in overviews: +@file{all.SCORE} file in case of spam attacks from a single origin +host, if your @acronym{NNTP} server tracks @samp{NNTP-Posting-Host} in +overviews: @lisp -("111.222.333.444" -1000 nil s "NNTP-Posting-Host") +("111.222.333.444" -1000 nil s + "NNTP-Posting-Host") @end lisp @item Lines, Chars @@ -19534,10 +19723,10 @@ that Gnus has to request every single article from the back end to find matches. This takes a long time in big groups. Now, there's not much you can do about this for news groups, but for -mail groups, you have greater control. In the @pxref{To From -Newsgroups} section of the manual, it's explained in greater detail what -this mechanism does, but here's a cookbook example for @code{nnml} on -how to allow scoring on the @samp{To} and @samp{Cc} headers. +mail groups, you have greater control. In @ref{To From Newsgroups}, +it's explained in greater detail what this mechanism does, but here's +a cookbook example for @code{nnml} on how to allow scoring on the +@samp{To} and @samp{Cc} headers. Put the following in your @file{~/.gnus.el} file. @@ -19821,6 +20010,9 @@ before. @section GroupLens @cindex GroupLens +@sc{Note:} Unfortunately the GroupLens system seems to have shut down, +so this section is mostly of historical interest. + @uref{http://www.cs.umn.edu/Research/GroupLens/, GroupLens} is a collaborative filtering system that helps you work together with other people to find the quality news articles out of the huge volume of @@ -19836,9 +20028,6 @@ of a prediction, what they thought of the article. You can use this prediction to help you decide whether or not you want to read the article. -@sc{Note:} Unfortunately the GroupLens system seems to have shut down, -so this section is mostly of historical interest. - @menu * Using GroupLens:: How to make Gnus use GroupLens. * Rating Articles:: Letting GroupLens know how you rate articles. @@ -19942,7 +20131,7 @@ from GroupLens in one of three ways controlled by the variable @vindex gnus-grouplens-override-scoring There are three ways to display predictions in grouplens. You may choose to have the GroupLens scores contribute to, or override the -regular gnus scoring mechanism. override is the default; however, some +regular Gnus scoring mechanism. override is the default; however, some people prefer to see the Gnus scores plus the grouplens scores. To get the separate scoring behavior you need to set @code{gnus-grouplens-override-scoring} to @code{'separate}. To have the @@ -20211,16 +20400,21 @@ definition of that function: @lisp (defun gnus-decay-score (score) - "Decay SCORE. -This is done according to `gnus-score-decay-constant' + "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (floor - (- score - (* (if (< score 0) 1 -1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) + (let ((n (- score + (* (if (< score 0) -1 1) + (min (abs score) + (max gnus-score-decay-constant + (* (abs score) + gnus-score-decay-scale))))))) + (if (and (featurep 'xemacs) + ;; XEmacs' floor can handle only the floating point + ;; number below the half of the maximum integer. + (> (abs n) (lsh -1 -2))) + (string-to-number + (car (split-string (number-to-string n) "\\."))) + (floor n)))) @end lisp @vindex gnus-score-decay-scale @@ -21246,7 +21440,7 @@ Emacs is idle: (gnus-demon-scan-pgp 60 t) @end lisp -This @var{time} parameter and than @var{idle} parameter work together +This @var{time} parameter and that @var{idle} parameter work together in a strange, but wonderful fashion. Basically, if @var{idle} is @code{nil}, then the function will be called every @var{time} minutes. @@ -21338,7 +21532,7 @@ by default. @item gnus-nocem-groups @vindex gnus-nocem-groups Gnus will look for NoCeM messages in the groups in this list. The -default is +default is @lisp ("news.lists.filters" "news.admin.net-abuse.bulletins" "alt.nocem.misc" "news.admin.net-abuse.announce") @@ -21557,139 +21751,14 @@ support images yet.}, is able to display pictures and stuff, so Gnus has taken advantage of that. @menu -* Picons:: How to display pictures of what you're reading. -* Smileys:: Show all those happy faces the way they were meant to be shown. * X-Face:: Display a funky, teensy black-and-white image. +* Face:: Display a funkier, teensier colored image. +* Smileys:: Show all those happy faces the way they were meant to be shown. +* Picons:: How to display pictures of what you're reading. * XVarious:: Other XEmacsy Gnusey variables. @end menu -@node Picons -@subsection Picons - -@iftex -@iflatex -\include{picons} -@end iflatex -@end iftex - -So@dots{} You want to slow down your news reader even more! This is a -good way to do so. Its also a great way to impress people staring -over your shoulder as you read news. - -What are Picons? To quote directly from the Picons Web site: - -@iftex -@iflatex -\margindex{} -@end iflatex -@end iftex - -@quotation -@dfn{Picons} is short for ``personal icons''. They're small, -constrained images used to represent users and domains on the net, -organized into databases so that the appropriate image for a given -e-mail address can be found. Besides users and domains, there are picon -databases for Usenet newsgroups and weather forecasts. The picons are -in either monochrome @code{XBM} format or color @code{XPM} and -@code{GIF} formats. -@end quotation - -@vindex gnus-picon-databases -For instructions on obtaining and installing the picons databases, -point your Web browser at -@uref{http://www.cs.indiana.edu/picons/ftp/index.html}. - -If you are using Debian GNU/Linux, saying @samp{apt-get install -picons.*} will install the picons where Gnus can find them. - -To enable displaying picons, simply make sure that -@code{gnus-picon-databases} points to the directory containing the -Picons databases. - -The following variables offer control over where things are located. - -@table @code - -@item gnus-picon-databases -@vindex gnus-picon-databases -The location of the picons database. This is a list of directories -containing the @file{news}, @file{domains}, @file{users} (and so on) -subdirectories. Defaults to @code{("/usr/lib/picon" -"/usr/local/faces")}. - -@item gnus-picon-news-directories -@vindex gnus-picon-news-directories -List of subdirectories to search in @code{gnus-picon-databases} for -newsgroups faces. @code{("news")} is the default. - -@item gnus-picon-user-directories -@vindex gnus-picon-user-directories -List of subdirectories to search in @code{gnus-picon-databases} for user -faces. @code{("users" "usenix" "local" "misc")} is the default. - -@item gnus-picon-domain-directories -@vindex gnus-picon-domain-directories -List of subdirectories to search in @code{gnus-picon-databases} for -domain name faces. Defaults to @code{("domains")}. Some people may -want to add @samp{"unknown"} to this list. - -@item gnus-picon-file-types -@vindex gnus-picon-file-types -Ordered list of suffixes on picon file names to try. Defaults to -@code{("xpm" "gif" "xbm")} minus those not built-in your Emacs. - -@end table - -@node Smileys -@subsection Smileys -@cindex smileys - -@iftex -@iflatex -\gnusfig{-3cm}{0.5cm}{\epsfig{figure=ps/BigFace,height=20cm}} -\input{smiley} -@end iflatex -@end iftex - -@dfn{Smiley} is a package separate from Gnus, but since Gnus is -currently the only package that uses Smiley, it is documented here. - -In short---to use Smiley in Gnus, put the following in your -@file{~/.gnus.el} file: - -@lisp -(setq gnus-treat-display-smileys t) -@end lisp - -Smiley maps text smiley faces---@samp{:-)}, @samp{8-)}, @samp{:-(} and -the like---to pictures and displays those instead of the text smiley -faces. The conversion is controlled by a list of regexps that matches -text and maps that to file names. - -@vindex smiley-regexp-alist -The alist used is specified by the @code{smiley-regexp-alist} -variable. The first item in each element is the regexp to be matched; -the second element is the regexp match group that is to be replaced by -the picture; and the third element is the name of the file to be -displayed. - -The following variables customize where Smiley will look for these -files: - -@table @code - -@item smiley-data-directory -@vindex smiley-data-directory -Where Smiley will look for smiley faces files. - -@item gnus-smiley-file-types -@vindex gnus-smiley-file-types -List of suffixes on smiley file names to try. - -@end table - - @node X-Face @subsection X-Face @cindex x-face @@ -21701,7 +21770,6 @@ readers. @cindex x-face @findex gnus-article-display-x-face -@findex gnus-article-x-face-command @vindex gnus-article-x-face-command @vindex gnus-article-x-face-too-ugly @iftex @@ -21785,6 +21853,173 @@ Using the last function would be something like this: @end lisp +@node Face +@subsection Face +@cindex face + +@c #### FIXME: faces and x-faces'implementations should really be harmonized. + +@code{Face} headers are essentially a funkier version of @code{X-Face} +ones. They describe a 48x48 pixel colored image that's supposed to +represent the author of the message. + +@cindex face +@findex gnus-article-display-face +The contents of a @code{Face} header must be a base64 encoded PNG image. +See @uref{http://quimby.gnus.org/circus/face/} for the precise +specifications. + +Gnus provides a few convenience functions and variables to allow +easier insertion of Face headers in outgoing messages. + +@findex gnus-convert-png-to-face +@code{gnus-convert-png-to-face} takes a 48x48 PNG image, no longer than +726 bytes long, and converts it to a face. + +@findex gnus-face-from-file +@vindex gnus-convert-image-to-face-command +@code{gnus-face-from-file} takes a JPEG file as the parameter, and then +converts the file to Face format by using the +@code{gnus-convert-image-to-face-command} shell command. + +Here's how you would typically use this function. Put something like the +following in your @file{~/.gnus.el} file: + +@lisp +(setq message-required-news-headers + (nconc message-required-news-headers + (list '(Face . (lambda () + (gnus-face-from-file "~/face.jpg")))))) +@end lisp + + +@node Smileys +@subsection Smileys +@cindex smileys + +@iftex +@iflatex +\gnusfig{-3cm}{0.5cm}{\epsfig{figure=ps/BigFace,height=20cm}} +\input{smiley} +@end iflatex +@end iftex + +@dfn{Smiley} is a package separate from Gnus, but since Gnus is +currently the only package that uses Smiley, it is documented here. + +In short---to use Smiley in Gnus, put the following in your +@file{~/.gnus.el} file: + +@lisp +(setq gnus-treat-display-smileys t) +@end lisp + +Smiley maps text smiley faces---@samp{:-)}, @samp{8-)}, @samp{:-(} and +the like---to pictures and displays those instead of the text smiley +faces. The conversion is controlled by a list of regexps that matches +text and maps that to file names. + +@vindex smiley-regexp-alist +The alist used is specified by the @code{smiley-regexp-alist} +variable. The first item in each element is the regexp to be matched; +the second element is the regexp match group that is to be replaced by +the picture; and the third element is the name of the file to be +displayed. + +The following variables customize where Smiley will look for these +files: + +@table @code + +@item smiley-data-directory +@vindex smiley-data-directory +Where Smiley will look for smiley faces files. + +@item gnus-smiley-file-types +@vindex gnus-smiley-file-types +List of suffixes on smiley file names to try. + +@end table + + +@node Picons +@subsection Picons + +@iftex +@iflatex +\include{picons} +@end iflatex +@end iftex + +So@dots{} You want to slow down your news reader even more! This is a +good way to do so. It's also a great way to impress people staring +over your shoulder as you read news. + +What are Picons? To quote directly from the Picons Web site: + +@iftex +@iflatex +\margindex{} +@end iflatex +@end iftex + +@quotation +@dfn{Picons} is short for ``personal icons''. They're small, +constrained images used to represent users and domains on the net, +organized into databases so that the appropriate image for a given +e-mail address can be found. Besides users and domains, there are picon +databases for Usenet newsgroups and weather forecasts. The picons are +in either monochrome @code{XBM} format or color @code{XPM} and +@code{GIF} formats. +@end quotation + +@vindex gnus-picon-databases +For instructions on obtaining and installing the picons databases, +point your Web browser at +@uref{http://www.cs.indiana.edu/picons/ftp/index.html}. + +If you are using Debian GNU/Linux, saying @samp{apt-get install +picons.*} will install the picons where Gnus can find them. + +To enable displaying picons, simply make sure that +@code{gnus-picon-databases} points to the directory containing the +Picons databases. + +The following variables offer control over where things are located. + +@table @code + +@item gnus-picon-databases +@vindex gnus-picon-databases +The location of the picons database. This is a list of directories +containing the @file{news}, @file{domains}, @file{users} (and so on) +subdirectories. Defaults to @code{("/usr/lib/picon" +"/usr/local/faces")}. + +@item gnus-picon-news-directories +@vindex gnus-picon-news-directories +List of subdirectories to search in @code{gnus-picon-databases} for +newsgroups faces. @code{("news")} is the default. + +@item gnus-picon-user-directories +@vindex gnus-picon-user-directories +List of subdirectories to search in @code{gnus-picon-databases} for user +faces. @code{("users" "usenix" "local" "misc")} is the default. + +@item gnus-picon-domain-directories +@vindex gnus-picon-domain-directories +List of subdirectories to search in @code{gnus-picon-databases} for +domain name faces. Defaults to @code{("domains")}. Some people may +want to add @samp{"unknown"} to this list. + +@item gnus-picon-file-types +@vindex gnus-picon-file-types +Ordered list of suffixes on picon file names to try. Defaults to +@code{("xpm" "gif" "xbm")} minus those not built-in your Emacs. + +@end table + + @node XVarious @subsection Various XEmacs Variables @@ -21894,8 +22129,8 @@ This is annoying. Here's what you can do about it. * Anti-Spam Basics:: Simple steps to reduce the amount of spam. * SpamAssassin:: How to use external anti-spam tools. * Hashcash:: Reduce spam by burning CPU time. -* Filtering Spam Using The Spam ELisp Package:: -* Filtering Spam Using Statistics with spam-stat:: +* Filtering Spam Using The Spam ELisp Package:: +* Filtering Spam Using Statistics with spam-stat:: @end menu @node The problem of spam @@ -21941,13 +22176,13 @@ mail can be useful. Another approach to filtering e-mail is the distributed spam processing, for instance DCC implements such a system. In essence, -@code{N} systems around the world agree that a machine @samp{X} in +@var{N} systems around the world agree that a machine @var{X} in China, Ghana, or California is sending out spam e-mail, and these -@code{N} systems enter @samp{X} or the spam e-mail from @samp{X} into +@var{N} systems enter @var{X} or the spam e-mail from @var{X} into a database. The criteria for spam detection vary---it may be the number of messages sent, the content of the messages, and so on. When a user of the distributed processing system wants to find out if a -message is spam, he consults one of those @code{N} systems. +message is spam, he consults one of those @var{N} systems. Distributed spam processing works very well against spammers that send a large number of messages at once, but it requires the user to set up @@ -21992,14 +22227,12 @@ Then put the following split rule in @code{nnmail-split-fancy} (@pxref{Fancy Mail Splitting}): @lisp -( - ... +(... (to "larsi@@trym.ifi.uio.no" - (| ("subject" "re:.*" "misc") - ("references" ".*@@.*" "misc") - "spam")) - ... -) + (| ("subject" "re:.*" "misc") + ("references" ".*@@.*" "misc") + "spam")) + ...) @end lisp This says that all mail to this address is suspect, but if it has a @@ -22041,7 +22274,7 @@ to non-existent domains is yucky, in my opinion. @cindex DCC The days where the hints in the previous section was sufficient in -avoiding spam is coming to an end. There are many tools out there +avoiding spam are coming to an end. There are many tools out there that claim to reduce the amount of spam you get. This section could easily become outdated fast, as new products replace old, but fortunately most of these tools seem to have similar interfaces. Even @@ -22051,18 +22284,19 @@ easy to adapt it to most other tools. If the tool you are using is not installed on the mail server, you need to invoke it yourself. Ideas on how to use the @code{:postscript} mail source parameter (@pxref{Mail Source -Specifiers}) follows. +Specifiers}) follow. @lisp (setq mail-sources '((file :prescript "formail -bs spamassassin < /var/mail/%u") (pop :user "jrl" :server "pophost" - :postscript "mv %t /tmp/foo; formail -bs spamc < /tmp/foo > %t"))) + :postscript + "mv %t /tmp/foo; formail -bs spamc < /tmp/foo > %t"))) @end lisp -Once you managed to process your incoming spool somehow, thus making -the mail contain e.g. a header indicating it is spam, you are ready to +Once you manage to process your incoming spool somehow, thus making +the mail contain e.g.@: a header indicating it is spam, you are ready to filter it out. Using normal split methods (@pxref{Splitting Mail}): @lisp @@ -22088,16 +22322,18 @@ call the external tools during splitting. Example fancy split method: ...)) (defun kevin-spamassassin () (save-excursion - (let ((buf (or (get-buffer " *nnmail incoming*") - (get-buffer " *nnml move*")))) - (if (not buf) - (progn (message "Oops, cannot find message buffer") nil) - (set-buffer buf) - (if (eq 1 (call-process-region (point-min) (point-max) - "spamc" nil nil nil "-c")) - "spam"))))) + (save-restriction + (widen) + (if (eq 1 (call-process-region (point-min) (point-max) + "spamc" nil nil nil "-c")) + "spam")))) @end lisp +Note that with the nnimap backend, message bodies will not be +downloaded by default. You need to set +@code{nnimap-split-download-body} to t to do that (@pxref{Splitting in +IMAP}). + That is about it. As some spam is likely to get through anyway, you might want to have a nifty function to call when you happen to read spam. And here is the nifty function: @@ -22117,7 +22353,7 @@ spam. And here is the nifty function: A novel technique to fight spam is to require senders to do something costly for each message they send. This has the obvious drawback that -you cannot rely on that everyone in the world uses this technique, +you cannot rely on everyone in the world using this technique, since it is not part of the Internet standards, but it may be useful in smaller communities. @@ -22136,7 +22372,7 @@ one of them separately. The ``something costly'' is to burn CPU time, more specifically to compute a hash collision up to a certain number of bits. The resulting hashcash cookie is inserted in a @samp{X-Hashcash:} -header. For more details, and for the external application +header. For more details, and for the external application @code{hashcash} you need to install to use this feature, see @uref{http://www.cypherspace.org/~adam/hashcash/}. Even more information can be found at @uref{http://www.camram.org/}. @@ -22149,8 +22385,8 @@ like: (add-hook 'message-send-hook 'mail-add-payment) @end lisp -The @code{hashcash.el} library can be found in the Gnus development -contrib directory. or at +The @file{hashcash.el} library can be found in the Gnus development +contrib directory or at @uref{http://users.actrix.gen.nz/mycroft/hashcash.el}. You will need to set up some additional variables as well: @@ -22189,14 +22425,26 @@ a useful contribution, however. @cindex spam filtering @cindex spam -The idea behind @code{spam.el} is to have a control center for spam detection -and filtering in Gnus. To that end, @code{spam.el} does two things: it +The idea behind @file{spam.el} is to have a control center for spam detection +and filtering in Gnus. To that end, @file{spam.el} does two things: it filters incoming mail, and it analyzes mail known to be spam or ham. -@emph{Ham} is the name used throughout @code{spam.el} to indicate +@dfn{Ham} is the name used throughout @file{spam.el} to indicate non-spam messages. -So, what happens when you load @code{spam.el}? First of all, you get -the following keyboard commands: +First of all, you @strong{must} run the function +@code{spam-initialize} to autoload @code{spam.el} and to install the +@code{spam.el} hooks. There is one exception: if you use the +@code{spam-use-stat} (@pxref{spam-stat spam filtering}) setting, you +should turn it on before @code{spam-initialize}: + +@example +(setq spam-use-stat t) ;; if needed +(spam-initialize) +@end example + +So, what happens when you load @file{spam.el}? + +You get the following keyboard commands: @table @kbd @@ -22227,7 +22475,7 @@ You must have Bogofilter installed for that command to work properly. @end table -Also, when you load @code{spam.el}, you will be able to customize its +Also, when you load @file{spam.el}, you will be able to customize its variables. Try @code{customize-group} on the @samp{spam} variable group. @@ -22265,13 +22513,13 @@ group. If you have seen a message, had it marked as spam, then unmarked it, it won't be marked as spam when you enter the group thereafter. You can disable that behavior, so all unread messages will get the @samp{$} mark, if you set the -@code{spam-mark-only-unseen-as-spam} parameter to nil. You should -remove the @samp{$} mark when you are in the group summary buffer for -every message that is not spam after all. To remove the @samp{$} -mark, you can use @kbd{M-u} to ``unread'' the article, or @kbd{d} for -declaring it read the non-spam way. When you leave a group, all -spam-marked (@samp{$}) articles are sent to a spam processor which -will study them as spam samples. +@code{spam-mark-only-unseen-as-spam} parameter to @code{nil}. You +should remove the @samp{$} mark when you are in the group summary +buffer for every message that is not spam after all. To remove the +@samp{$} mark, you can use @kbd{M-u} to ``unread'' the article, or +@kbd{d} for declaring it read the non-spam way. When you leave a +group, all spam-marked (@samp{$}) articles are sent to a spam +processor which will study them as spam samples. Messages may also be deleted in various other ways, and unless @code{ham-marks} group parameter gets overridden below, marks @samp{R} @@ -22311,15 +22559,31 @@ determined by either the @code{ham-process-destination} group parameter or a match in the @code{gnus-ham-process-destinations} variable, which is a list of regular expressions matched with group names (it's easiest to customize this variable with -@code{customize-variable gnus-ham-process-destinations}). The ultimate -location is a group name. If the @code{ham-process-destination} -parameter is not set, ham articles are left in place. If the +@code{customize-variable gnus-ham-process-destinations}). Each +newsgroup specification has the format (REGEXP PROCESSOR) in a +standard Lisp list, if you prefer to customize the variable manually. +The ultimate location is a group name. If the +@code{ham-process-destination} parameter is not set, ham articles are +left in place. If the @code{spam-mark-ham-unread-before-move-from-spam-group} parameter is set, the ham articles are marked as unread before being moved. When you leave a @emph{ham} group, all ham-marked articles are sent to a ham processor, which will study these as non-spam samples. +@vindex spam-process-ham-in-spam-groups +By default the variable @code{spam-process-ham-in-spam-groups} is +@code{nil}. Set it to @code{t} if you want ham found in spam groups +to be processed. Normally this is not done, you are expected instead +to send your ham to a ham group and process it there. + +@vindex spam-process-ham-in-nonham-groups +By default the variable @code{spam-process-ham-in-nonham-groups} is +@code{nil}. Set it to @code{t} if you want ham found in non-ham (spam +or unclassified) groups to be processed. Normally this is not done, +you are expected instead to send your ham to a ham group and process +it there. + @vindex gnus-spam-process-destinations When you leave a @emph{ham} or @emph{unclassified} group, all @strong{spam} articles are moved to a location determined by either @@ -22327,11 +22591,14 @@ the @code{spam-process-destination} group parameter or a match in the @code{gnus-spam-process-destinations} variable, which is a list of regular expressions matched with group names (it's easiest to customize this variable with @code{customize-variable -gnus-spam-process-destinations}). The ultimate location is a group -name. If the @code{spam-process-destination} parameter is not set, -the spam articles are only expired. - -To use the @code{spam.el} facilities for incoming mail filtering, you +gnus-spam-process-destinations}). Each newsgroup specification has +the repeated format (REGEXP PROCESSOR) and they are all in a standard +Lisp list, if you prefer to customize the variable manually. The +ultimate location is a group name. If the +@code{spam-process-destination} parameter is not set, the spam +articles are only expired. + +To use the @file{spam.el} facilities for incoming mail filtering, you must add the following to your fancy split list @code{nnmail-split-fancy} or @code{nnimap-split-fancy}: @@ -22346,10 +22613,18 @@ nnimap back ends to retrieve your mail. The @code{spam-split} function will process incoming mail and send the mail considered to be spam into the group name given by the variable @code{spam-split-group}. By default that group name is @samp{spam}, -but you can customize @code{spam-split-group}. +but you can customize @code{spam-split-group}. Make sure the contents +of @code{spam-split-group} are an @emph{unqualified} group name, for +instance in an @code{nnimap} server @samp{your-server} the value +@samp{spam} will turn out to be @samp{nnimap+your-server:spam}. The +value @samp{nnimap+server:spam}, therefore, is wrong and will +actually give you the group +@samp{nnimap+your-server:nnimap+server:spam} which may or may not +work depending on your server's tolerance for strange group names. You can also give @code{spam-split} a parameter, -e.g. @samp{'spam-use-regex-headers}. Why is this useful? +e.g. @samp{'spam-use-regex-headers} or @samp{"maybe-spam"}. Why is +this useful? Take these split rules (with @code{spam-use-regex-headers} and @code{spam-use-blackholes} set): @@ -22369,21 +22644,24 @@ when it's sent to the ding list. On the other hand, some messages to the ding list are from a mail server in the blackhole list, so the invocation of @code{spam-split} can't be before the ding rule. -You can let SpamAssassin headers supercede ding rules, but all other +You can let SpamAssassin headers supersede ding rules, but all other @code{spam-split} rules (including a second invocation of the regex-headers check) will be after the ding rule: @example nnimap-split-fancy '(| - (: spam-split 'spam-use-regex-headers) +;;; all spam detected by spam-use-regex-headers goes to "regex-spam" + (: spam-split "regex-spam" 'spam-use-regex-headers) (any "ding" "ding") +;;; all other spam detected by spam-split goes to spam-split-group (: spam-split) ;; default mailbox "mail") @end example Basically, this lets you invoke specific @code{spam-split} checks -depending on your particular needs. You don't have to throw all mail +depending on your particular needs, and to target the results of those +checks to a particular spam group. You don't have to throw all mail into all the spam tests. Another reason why this is nice is that messages to mailing lists you have rules for don't have to have resource-intensive blackhole checks performed on them. You could also @@ -22391,9 +22669,9 @@ specify different spam checks for your nnmail split vs. your nnimap split. Go crazy. You still have to have specific checks such as -@code{spam-use-regex-headers} set to t, even if you specifically +@code{spam-use-regex-headers} set to @code{t}, even if you specifically invoke @code{spam-split} with the check. The reason is that when -loading @code{spam.el}, some conditional loading is done depending on +loading @file{spam.el}, some conditional loading is done depending on what @code{spam-use-xyz} variables you have set. @emph{Note for IMAP users} @@ -22421,16 +22699,17 @@ The following are the methods you can use to control the behavior of @code{spam-split} and their corresponding spam and ham processors: @menu -* Blacklists and Whitelists:: -* BBDB Whitelists:: -* Gmane Spam Reporting:: -* Anti-spam Hashcash Payments:: -* Blackholes:: -* Regular Expressions Header Matching:: -* Bogofilter:: -* ifile spam filtering:: -* spam-stat spam filtering:: -* Extending the spam elisp package:: +* Blacklists and Whitelists:: +* BBDB Whitelists:: +* Gmane Spam Reporting:: +* Anti-spam Hashcash Payments:: +* Blackholes:: +* Regular Expressions Header Matching:: +* Bogofilter:: +* ifile spam filtering:: +* spam-stat spam filtering:: +* SpamOracle:: +* Extending the spam elisp package:: @end menu @node Blacklists and Whitelists @@ -22562,7 +22841,21 @@ Add this symbol to a group's @code{spam-process} parameter by customizing the group parameters or the @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the spam-marked -articles groups will be reported to the Gmane administrators. +articles groups will be reported to the Gmane administrators via a +HTTP request. + +Gmane can be found at @uref{http://gmane.org}. + +@end defvar + +@defvar spam-report-gmane-use-article-number + +This variable is @code{t} by default. Set it to @code{nil} if you are +running your own news server, for instance, and the local article +numbers don't correspond to the Gmane article numbers. When +@code{spam-report-gmane-use-article-number} is @code{nil}, +@code{spam-report.el} will use the @code{X-Report-Spam} header that +Gmane provides. @end defvar @@ -22601,7 +22894,7 @@ list is fairly comprehensive, but make sure to let us know if it contains outdated servers. The blackhole check uses the @code{dig.el} package, but you can tell -@code{spam.el} to use @code{dns.el} instead for better performance if +@file{spam.el} to use @code{dns.el} instead for better performance if you set @code{spam-use-dig} to @code{nil}. It is not recommended at this time to set @code{spam-use-dig} to @code{nil} despite the possible performance improvements, because some users may be unable to @@ -22684,9 +22977,9 @@ category, spam or not. The command @kbd{S t} in summary mode, either for debugging or for curiosity, shows the @emph{spamicity} score of the current article (between 0.0 and 1.0). -Bogofilter determines if a message is spam based on an internal -threshold, set at compilation time. That threshold can't be -customized. +Bogofilter determines if a message is spam based on a specific +threshold. That threshold can be customized, consult the Bogofilter +documentation. If the @code{bogofilter} executable is not in your path, Bogofilter processing will be turned off. @@ -22734,7 +23027,7 @@ database directory. @end defvar -The Bogofilter mail classifier is similar to ifile in intent and +The Bogofilter mail classifier is similar to @command{ifile} in intent and purpose. A ham and a spam processor are provided, plus the @code{spam-use-bogofilter} and @code{spam-use-bogofilter-headers} variables to indicate to spam-split that Bogofilter should either be @@ -22749,7 +23042,7 @@ Bogofilter was used to test this functionality. @defvar spam-use-ifile -Enable this variable if you want @code{spam-split} to use ifile, a +Enable this variable if you want @code{spam-split} to use @command{ifile}, a statistical analyzer similar to Bogofilter. @end defvar @@ -22816,11 +23109,115 @@ of non-spam messages. Note that this ham processor has no effect in @emph{spam} or @emph{unclassified} groups. @end defvar -This enables spam.el to cooperate with spam-stat.el. spam-stat.el -provides an internal (Lisp-only) spam database, which unlike ifile or -Bogofilter does not require external programs. A spam and a ham -processor, and the @code{spam-use-stat} variable for @code{spam-split} -are provided. +This enables @file{spam.el} to cooperate with @file{spam-stat.el}. +@file{spam-stat.el} provides an internal (Lisp-only) spam database, +which unlike ifile or Bogofilter does not require external programs. +A spam and a ham processor, and the @code{spam-use-stat} variable for +@code{spam-split} are provided. + +@node SpamOracle +@subsubsection Using SpamOracle with Gnus +@cindex spam filtering +@cindex SpamOracle +@cindex spam + +An easy way to filter out spam is to use SpamOracle. SpamOracle is an +statistical mail filtering tool written by Xavier Leroy and needs to be +installed separately. + +There are several ways to use SpamOracle with Gnus. In all cases, your +mail is piped through SpamOracle in its @emph{mark} mode. SpamOracle will +then enter an @samp{X-Spam} header indicating whether it regards the +mail as a spam mail or not. + +One possibility is to run SpamOracle as a @code{:prescript} from the +@xref{Mail Source Specifiers}, (@pxref{SpamAssassin}). This method has +the advantage that the user can see the @emph{X-Spam} headers. + +The easiest method is to make @file{spam.el} (@pxref{Filtering Spam +Using The Spam ELisp Package}) call SpamOracle. + +@vindex spam-use-spamoracle +To enable SpamOracle usage by @file{spam.el}, set the variable +@code{spam-use-spamoracle} to @code{t} and configure the +@code{nnmail-split-fancy} or @code{nnimap-split-fancy} as described in +the section @xref{Filtering Spam Using The Spam ELisp Package}. In +this example the @samp{INBOX} of an nnimap server is filtered using +SpamOracle. Mails recognized as spam mails will be moved to +@code{spam-split-group}, @samp{Junk} in this case. Ham messages stay +in @samp{INBOX}: + +@example +(setq spam-use-spamoracle t + spam-split-group "Junk" + nnimap-split-inbox '("INBOX") + nnimap-split-rule 'nnimap-split-fancy + nnimap-split-fancy '(| (: spam-split) "INBOX")) +@end example + +@defvar spam-use-spamoracle +Set to @code{t} if you want Gnus to enable spam filtering using +SpamOracle. +@end defvar + +@defvar spam-spamoracle-binary +Gnus uses the SpamOracle binary called @file{spamoracle} found in the +user's PATH. Using the variable @code{spam-spamoracle-binary}, this +can be customized. +@end defvar + +@defvar spam-spamoracle-database +By default, SpamOracle uses the file @file{~/.spamoracle.db} as a database to +store its analyses. This is controlled by the variable +@code{spam-spamoracle-database} which defaults to @code{nil}. That means +the default SpamOracle database will be used. In case you want your +database to live somewhere special, set +@code{spam-spamoracle-database} to this path. +@end defvar + +SpamOracle employs a statistical algorithm to determine whether a +message is spam or ham. In order to get good results, meaning few +false hits or misses, SpamOracle needs training. SpamOracle learns the +characteristics of your spam mails. Using the @emph{add} mode +(training mode) one has to feed good (ham) and spam mails to +SpamOracle. This can be done by pressing @kbd{|} in the Summary buffer +and pipe the mail to a SpamOracle process or using @file{spam.el}'s +spam- and ham-processors, which is much more convenient. For a +detailed description of spam- and ham-processors, @xref{Filtering Spam +Using The Spam ELisp Package}. + +@defvar gnus-group-spam-exit-processor-spamoracle +Add this symbol to a group's @code{spam-process} parameter by +customizing the group parameter or the +@code{gnus-spam-process-newsgroups} variable. When this symbol is added +to a group's @code{spam-process} parameter, spam-marked articles will be +sent to SpamOracle as spam samples. +@end defvar + +@defvar gnus-group-ham-exit-processor-spamoracle +Add this symbol to a group's @code{spam-process} parameter by +customizing the group parameter or the +@code{gnus-spam-process-newsgroups} variable. When this symbol is added +to a grup's @code{spam-process} parameter, the ham-marked articles in +@emph{ham} groups will be sent to the SpamOracle as samples of ham +messages. Note that this ham processor has no effect in @emph{spam} or +@emph{unclassified} groups. +@end defvar + +@emph{Example:} These are the Group Parameters of an group that has been +classified as a ham group, meaning that it should only contain ham +messages. +@example + ((spam-contents gnus-group-spam-classification-ham) + (spam-process + (gnus-group-spam-exit-processor-spamoracle))) +@end example +For this group the @code{gnus-group-spam-exit-processor-spamoracle} is +installed. If the group contains spam message (e.g. because SpamOracle +has not had enough sample messages yet) and the user marks some +messages as spam messages, these messages will be processed by +@code{gnus-group-spam-exit-processor-spamoracle}. This processor sends +the messages to SpamOracle as new samples for spam. @node Extending the spam elisp package @subsubsection Extending the spam elisp package @@ -22865,7 +23262,7 @@ For processing spam and ham messages, provide the following: @enumerate @item -code +code Note you don't have to provide a spam or a ham processor. Only provide them if Blackbox supports spam or ham processing. @@ -22951,9 +23348,9 @@ collections, and save it. And last but not least, you need to use this dictionary in your fancy mail splitting rules. @menu -* Creating a spam-stat dictionary:: -* Splitting mail using spam-stat:: -* Low-level interface to the spam-stat dictionary:: +* Creating a spam-stat dictionary:: +* Splitting mail using spam-stat:: +* Low-level interface to the spam-stat dictionary:: @end menu @node Creating a spam-stat dictionary @@ -23618,8 +24015,8 @@ RFC 2633 describes the @acronym{S/MIME} format. @item IMAP - RFC 1730/2060, RFC 2195, RFC 2086, RFC 2359, RFC 2595, RFC 1731 RFC 1730 is @acronym{IMAP} version 4, updated somewhat by RFC 2060 (@acronym{IMAP} 4 revision 1). RFC 2195 describes CRAM-MD5 -authentication for @acronym{IMAP}. RFC 2086 describes access control -lists (ACLs) for @acronym{IMAP}. RFC 2359 describes a @acronym{IMAP} +authentication for @acronym{IMAP}. RFC 2086 describes access control +lists (ACLs) for @acronym{IMAP}. RFC 2359 describes a @acronym{IMAP} protocol enhancement. RFC 2595 describes the proper @acronym{TLS} integration (STARTTLS) with @acronym{IMAP}. RFC 1731 describes the GSSAPI/Kerberos4 mechanisms for @acronym{IMAP}. @@ -23638,7 +24035,7 @@ know. @cindex Mule @cindex Emacs -Gnus should work on : +Gnus should work on: @itemize @bullet @@ -23738,7 +24135,7 @@ Luis Fernandes---design and graphics. Joe Reiss---creator of the smiley faces. @item -Justin Sheehy--the @acronym{FAQ} maintainer. +Justin Sheehy---the @acronym{FAQ} maintainer. @item Erik Naggum---help, ideas, support, code and stuff. @@ -24565,11 +24962,11 @@ New features in Gnus 5.6: @item New functionality for using Gnus as an offline newsreader has been -added. A plethora of new commands and modes have been added. See -@pxref{Gnus Unplugged} for the full story. +added. A plethora of new commands and modes have been added. +@xref{Gnus Unplugged}, for the full story. @item - The @code{nndraft} back end has returned, but works differently than +The @code{nndraft} back end has returned, but works differently than before. All Message buffers are now also articles in the @code{nndraft} group, which is created automatically. @@ -24578,110 +24975,110 @@ group, which is created automatically. values. @item - @code{gnus-summary-goto-article} now accept Message-ID's. +@code{gnus-summary-goto-article} now accept Message-ID's. @item - A new Message command for deleting text in the body of a message +A new Message command for deleting text in the body of a message outside the region: @kbd{C-c C-v}. @item - You can now post to component group in @code{nnvirtual} groups with +You can now post to component group in @code{nnvirtual} groups with @kbd{C-u C-c C-c}. @item @code{nntp-rlogin-program}---new variable to ease customization. @item - @code{C-u C-c C-c} in @code{gnus-article-edit-mode} will now inhibit +@code{C-u C-c C-c} in @code{gnus-article-edit-mode} will now inhibit re-highlighting of the article buffer. @item - New element in @code{gnus-boring-article-headers}---@code{long-to}. +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. @xref{Symbolic Prefixes}, for +details. @item - @kbd{L} and @kbd{I} in the summary buffer now take the symbolic prefix +@kbd{L} and @kbd{I} in the summary buffer now take the symbolic prefix @kbd{a} to add the score rule to the @file{all.SCORE} file. @item - @code{gnus-simplify-subject-functions} variable to allow greater +@code{gnus-simplify-subject-functions} variable to allow greater control over simplification. @item - @kbd{A T}---new command for fetching the current thread. +@kbd{A T}---new command for fetching the current thread. @item - @kbd{/ T}---new command for including the current thread in the +@kbd{/ T}---new command for including the current thread in the limit. @item - @kbd{M-RET} is a new Message command for breaking cited text. +@kbd{M-RET} is a new Message command for breaking cited text. @item - @samp{\\1}-expressions are now valid in @code{nnmail-split-methods}. +@samp{\\1}-expressions are now valid in @code{nnmail-split-methods}. @item - The @code{custom-face-lookup} function has been removed. +The @code{custom-face-lookup} function has been removed. If you used this function in your initialization files, you must rewrite them to use @code{face-spec-set} instead. @item - Canceling now uses the current select method. Symbolic prefix +Canceling now uses the current select method. Symbolic prefix @kbd{a} forces normal posting method. @item - New command to translate M******** sm*rtq**t*s into proper +New command to translate M******** sm*rtq**t*s into proper text---@kbd{W d}. @item - For easier debugging of @code{nntp}, you can set +For easier debugging of @code{nntp}, you can set @code{nntp-record-commands} to a non-@code{nil} value. @item - @code{nntp} now uses @file{~/.authinfo}, a @file{.netrc}-like file, for +@code{nntp} now uses @file{~/.authinfo}, a @file{.netrc}-like file, for controlling where and how to send @sc{authinfo} to @acronym{NNTP} servers. @item - A command for editing group parameters from the summary buffer +A command for editing group parameters from the summary buffer has been added. @item - A history of where mails have been split is available. +A history of where mails have been split is available. @item - A new article date command has been added---@code{article-date-iso8601}. +A new article date command has been added---@code{article-date-iso8601}. @item - Subjects can be simplified when threading by setting +Subjects can be simplified when threading by setting @code{gnus-score-thread-simplify}. @item - A new function for citing in Message has been +A new function for citing in Message has been added---@code{message-cite-original-without-signature}. @item - @code{article-strip-all-blank-lines}---new article command. +@code{article-strip-all-blank-lines}---new article command. @item - A new Message command to kill to the end of the article has +A new Message command to kill to the end of the article has been added. @item - A minimum adaptive score can be specified by using the +A minimum adaptive score can be specified by using the @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 - Web listserv archives can be read with the @code{nnlistserv} back end. +Web listserv archives can be read with the @code{nnlistserv} back end. @item - Old dejanews archives can now be read by @code{nnweb}. +Old dejanews archives can now be read by @code{nnweb}. @end itemize @@ -24758,6 +25155,10 @@ New features in Gnus 5.10: @itemize @bullet @item +In draft groups, @kbd{e} is now bound to @code{gnus-draft-edit-message}. +Use @kbd{B w} for @code{gnus-summary-edit-article} instead. + +@item The revised Gnus @acronym{FAQ} is included in the manual, @xref{Frequently Asked Questions}. @@ -24787,7 +25188,7 @@ Dired integration @code{gnus-dired-minor-mode} installs key bindings in dired buffers to send a file as an attachment (@kbd{C-c C-a}), open a file using the appropriate mailcap entry (@kbd{C-c C-l}), and print a file using the mailcap entry -(@kbd{C-c P}). It is enabled with +(@kbd{C-c P}). It is enabled with @lisp (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) @end lisp @@ -24830,14 +25231,14 @@ If @code{auto-compression-mode} is enabled, attachments are automatically decompressed when activated. @item -If the new option @code{nnml-use-compressed-files} is non-@code{nil}, +If the new option @code{nnml-use-compressed-files} is non-@code{nil}, the nnml back end allows compressed message files. @item Signed article headers (X-PGP-Sig) can be verified with @kbd{W p}. @item -The Summary Buffer uses an arrow in the fringe to indicate the current +The Summary Buffer uses an arrow in the fringe to indicate the current article. Use @code{(setq gnus-summary-display-arrow nil)} to disable it. @item @@ -24857,14 +25258,14 @@ The new @code{recent} mark @samp{.} indicates newly arrived messages (as opposed to old but unread messages). @item -The new option @code{gnus-gcc-mark-as-read} automatically marks +The new option @code{gnus-gcc-mark-as-read} automatically marks Gcc articles as read. @item The nndoc back end now supports mailman digests and exim bounces. @item -Gnus supports RFC 2369 mailing list headers, and adds a number of +Gnus supports RFC 2369 mailing list headers, and adds a number of related commands in mailing list groups. @xref{Mailing List}. @item @@ -24900,7 +25301,7 @@ the second parameter. automatic recognition of XEmacs and GNU Emacs, generates @file{gnus-load.el}, checks if errors occur while compilation and generation of info files and reports them at the end of the build -process. It now uses @code{makeinfo} if it is available and falls +process. It now uses @code{makeinfo} if it is available and falls back to @file{infohack.el} otherwise. @file{make.bat} should now install all files which are necessary to run Gnus and be generally a complete replacement for the @code{configure; make; make install} @@ -24999,7 +25400,7 @@ composing messages and @code{message-generate-headers-first} is Improved anti-spam features. Gnus is now able to take out spam from your mail and news streams -using a wide variety of programs and filter rules. Among the supported +using a wide variety of programs and filter rules. Among the supported methods are RBL blocklists, bogofilter and white/blacklists. Hooks for easy use of external packages such as SpamAssassin and Hashcash are also new. @xref{Thwarting Email Spam}. @@ -25008,6 +25409,9 @@ are also new. @xref{Thwarting Email Spam}. Easy inclusion of X-Faces headers. @item +Face headers handling. + +@item In the summary buffer, the new command @kbd{/ N} inserts new messages and @kbd{/ o} inserts old messages. @@ -25053,11 +25457,11 @@ hierarchy. The Gnus Agent has seen a major updated and is now enabled by default, and all nntp and nnimap servers from @code{gnus-select-method} and -@code{gnus-secondary-select-method} are agentized by default. Earlier +@code{gnus-secondary-select-method} are agentized by default. Earlier only the server in @code{gnus-select-method} was agentized by the default, and the agent was disabled by default. When the agent is enabled, headers are now also retrieved from the Agent cache instead -of the back ends when possible. Earlier this only happened in the +of the back ends when possible. Earlier this only happened in the unplugged state. You can enroll or remove servers with @kbd{J a} and @kbd{J r} in the server buffer. Gnus will not download articles into the Agent cache, unless you instruct it to do so, though, by using @@ -25124,7 +25528,7 @@ local files as external parts. The command @code{gnus-mime-save-part-and-strip} (bound to @kbd{C-o} on @acronym{MIME} buttons) saves a part and replaces the part with an external one. @code{gnus-mime-delete-part} (bound to @kbd{d} on -@acronym{MIME} buttons) removes a part. It works only on back ends +@acronym{MIME} buttons) removes a part. It works only on back ends that support editing. @item @@ -25153,7 +25557,7 @@ The old format like the lines below is obsolete, but still accepted. @code{message-ignored-news-headers} and @code{message-ignored-mail-headers} @samp{X-Draft-From} and @samp{X-Gnus-Agent-Meta-Information} have been -added into these two variables. If you customized those, perhaps you +added into these two variables. If you customized those, perhaps you need add those two headers too. @item @@ -25196,7 +25600,7 @@ the valid values. Gnus supports Cancel Locks in News. This means a header @samp{Cancel-Lock} is inserted in news posting. It is -used to determine if you wrote an article or not (for cancelling and +used to determine if you wrote an article or not (for canceling and superseding). Gnus generates a random password string the first time you post a message, and saves it in your @file{~/.emacs} using the Custom system. While the variable is called @code{canlock-password}, it is not @@ -25227,7 +25631,7 @@ escape character, old user defined format @samp{%u&} is no longer supported. @kbd{/ *} (@code{gnus-summary-limit-include-cached}) is rewritten. It was aliased to @kbd{Y c} -(@code{gnus-summary-insert-cached-articles}). The new function filters +(@code{gnus-summary-insert-cached-articles}). The new function filters out other articles. @item Some limiting commands accept a @kbd{C-u} prefix to negate the match. @@ -25275,7 +25679,7 @@ message, Message Manual}). The regexps in these variables are compared with full group names instead of real group names in 5.8. Users who customize these -variables should change those regexps accordingly. For example: +variables should change those regexps accordingly. For example: @lisp ("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) @end lisp @@ -25298,6 +25702,14 @@ C-m}. This change was made to avoid conflict with the standard binding of @code{back-to-indentation}, which is also useful in message mode. + +@item +The default for @code{message-forward-show-mml} changed to symbol @code{best}. + +The behaviour for the @code{best} value is to show @acronym{MML} (i.e., +convert to @acronym{MIME}) when appropriate. @acronym{MML} will not be +used when forwarding signed or encrypted messages, as the conversion +invalidate the digital signature. @end itemize @iftex @@ -25421,10 +25833,10 @@ Gnus considers mail and news to be mostly the same, really. The only difference is how to access the actual articles. News articles are commonly fetched via the protocol @acronym{NNTP}, whereas mail messages could be read from a file on the local disk. The internal -architecture of Gnus thus comprises a `front end' and a number of -`back ends'. Internally, when you enter a group (by hitting +architecture of Gnus thus comprises a ``front end'' and a number of +``back ends''. Internally, when you enter a group (by hitting @key{RET}, say), you thereby invoke a function in the front end in -Gnus. The front end then `talks' to a back end and says things like +Gnus. The front end then ``talks'' to a back end and says things like ``Give me the list of articles in the foo group'' or ``Show me article number 4711''. @@ -25432,16 +25844,16 @@ So a back end mainly defines either a protocol (the @code{nntp} back end accesses news via @acronym{NNTP}, the @code{nnimap} back end accesses mail via @acronym{IMAP}) or a file format and directory layout (the @code{nnspool} back end accesses news via the common -`spool directory' format, the @code{nnml} back end access mail via a +``spool directory'' format, the @code{nnml} back end access mail via a file format and directory layout that's quite similar). Gnus does not handle the underlying media, so to speak---this is all done by the back ends. A back end is a collection of functions to access the articles. -However, sometimes the term `back end' is also used where `server' -would have been more appropriate. And then there is the term `select -method' which can mean either. The Gnus terminology can be quite +However, sometimes the term ``back end'' is also used where ``server'' +would have been more appropriate. And then there is the term ``select +method'' which can mean either. The Gnus terminology can be quite confusing. @item native @@ -25596,6 +26008,13 @@ An article that responds to a different article---its parent. A collection of messages in one file. The most common digest format is specified by RFC 1153. +@item splitting +@cindex splitting, terminolgy +@cindex mail sorting +@cindex mail filtering (splitting) +The action of sorting your emails according to certain rules. Sometimes +incorrectly called mail filtering. + @end table @@ -25751,9 +26170,8 @@ Gnus will work. @item Try doing an @kbd{M-x gnus-version}. If you get something that looks -like @samp{Gnus v5.46; nntp 4.0} you have the right files loaded. If, -on the other hand, you get something like @samp{NNTP 3.x} or @samp{nntp -flee}, you have some old @file{.el} files lying around. Delete these. +like @samp{Gnus v5.10.3} you have the right files loaded. Otherwise +you have some old @file{.el} files lying around. Delete these. @item Read the help group (@kbd{G h} in the group buffer) for a @@ -25824,7 +26242,7 @@ Sometimes, a problem do not directly generate an 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 @kbd{C-g} when things are slow, and then try to analyze the backtrace (repeating the procedure -helps isolating the real problem areas). +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 @@ -26053,7 +26471,7 @@ more. Gnus identifies each message by way of group name and article number. A few remarks about these article numbers might be useful. First of all, the numbers are positive integers. Secondly, it is normally not -possible for later articles to `re-use' older article numbers without +possible for later articles to ``re-use'' older article numbers without confusing Gnus. That is, if a group has ever contained a message numbered 42, then no other message may get that number, or Gnus will get mightily confused.@footnote{See the function @@ -26061,15 +26479,15 @@ mightily confused.@footnote{See the function Third, article numbers must be assigned in order of arrival in the group; this is not necessarily the same as the date of the message. -The previous paragraph already mentions all the `hard' restrictions that +The previous paragraph already mentions all the ``hard'' restrictions that article numbers must fulfill. But it seems that it might be useful to assign @emph{consecutive} article numbers, for Gnus gets quite confused if there are holes in the article numbering sequence. However, due to -the `no-reuse' restriction, holes cannot be avoided altogether. It's +the ``no-reuse'' restriction, holes cannot be avoided altogether. It's also useful for the article numbers to start at 1 to avoid running out of numbers as long as possible. -Note that by convention, backends are named @code{nnsomething}, but +Note that by convention, back ends are named @code{nnsomething}, but Gnus also comes with some @code{nnnotbackends}, such as @file{nnheader.el}, @file{nnmail.el} and @file{nnoo.el}. @@ -26197,7 +26615,7 @@ There should be no data returned. If @var{server} is the current virtual server, and the connection to the physical server is alive, then this function should return a -non-@code{nil} vlue. This function should under no circumstances +non-@code{nil} value. This function should under no circumstances attempt to reconnect to a server we have lost connection to. There should be no data returned. @@ -26461,7 +26879,7 @@ created after @samp{date}, which is in normal human-readable date format the function @code{message-make-date} by default). The data should be in the active buffer format. -It is okay for this function to return `too many' groups; some back ends +It is okay for this function to return ``too many'' groups; some back ends might find it cheaper to return the full list of groups, rather than just the new groups. But don't do this for back ends with many groups. Normally, if the user creates the groups herself, there won't be too @@ -26523,7 +26941,7 @@ this function in short order. The function should return a cons where the @code{car} is the group name and the @code{cdr} is the article number that the article was entered as. -The group should exist before the backend is asked to accept the +The group should exist before the back end is asked to accept the article for that group. There should be no data returned. @@ -26857,7 +27275,7 @@ this: @subsection Score File Syntax Score files are meant to be easily parseable, but yet extremely -mallable. It was decided that something that had the same read syntax +mallable. It was decided that something that had the same read syntax as an Emacs Lisp list would fit that spec. Here's a typical score file: diff --git a/texi/gnusref.tex b/texi/gnusref.tex index 17d9660..0ddecd6 100644 --- a/texi/gnusref.tex +++ b/texi/gnusref.tex @@ -1,7 +1,7 @@ %% include file for the Gnus refcard and booklet \def\progver{5.10}\def\refver{5.10-1} % program and refcard versions -\def\date{May, 2003} +\def\date{Oct, 2003} \def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$} %% @@ -299,6 +299,7 @@ G V & Make a new empty {\bf virtual} group. (nnvirtual)\\ G w & Create ephemeral group based on web-search. [Prefix: make solid group instead]\\ + G R & Make an {\bf RSS} group.\\ G DEL & {\bf Delete} group [Prefix: delete all articles as well].\\ G x & Expunge all deleted articles in an nnimap mailbox.\\ G l & Edit ACL (Access Control {\bf List}) for an nnimap mailbox.\\ @@ -426,7 +427,7 @@ Y c & Insert all cached articles into the summary-buffer.\\ % M-C-e & {\bf Edit} the group-parameters.\\ - M-C-g & Customize the group-parameters.\\ + M-C-a & Customize the group-parameters.\\ % % article handling % @@ -470,7 +471,7 @@ K $\mid$ & Pipe the MIME part to an external command.\\ K b & Make all the MIME parts have buttons in front of them.\\ K m & Try to repair {\bf multipart-headers}.\\ - K C & View the MIME part using a differenct {\bf charset}.\\ + K C & View the MIME part using a different {\bf charset}.\\ X m & Save all parts matching a MIME type to a directory. [p/p]\\ M-t & Toggle the buttonized display of the article buffer.\\ W M w & Decode RFC2047-encoded words in the article headers.\\ @@ -943,7 +944,7 @@ \end{keys} The four letters stand for:\\* \quad \B{A}ction: I)ncrease, L)ower;\\* - \quad \B{p}art: a)utor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines, + \quad \B{p}art: a)uthor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines, message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\* \quad \B{m}atch type:\\* \qquad string: s)ubstring, e)xact, r)egexp, f)uzzy,\\* @@ -1008,7 +1009,7 @@ Z P & Exit and go to the {\bf previous} group.\\ % Z G & (M-g) Check for new articles in this group ({\bf get}).\\ - Z R & Exit this group, and then enter it again ({\bf reenter}). + Z R & (C-x C-s) Exit this group, and then enter it again ({\bf reenter}). [Prefix: select all articles, read and unread.]\\ Z s & Update and save the dribble buffer. [Prefix: save .newsrc* as well]\\ \end{keys} @@ -1062,7 +1063,7 @@ C-c C-f C-d & Move to \textbf{Distribution:}.\\ C-c C-f C-m & Move to \textbf{Mail-Followup-To:}.\\ C-c C-f C-o & Move to \textbf{From:}.\\ - C-c C-f C-a & Insert a resonable \textbf{Mail-Followup-To:} for + C-c C-f C-a & Insert a reasonable \textbf{Mail-Followup-To:} for an unsubscribed list. [Prefix: include addresses in \textbf{Cc:}]\\ C-c C-f TAB & (C-c C-u) Move to \textbf{Importance:}.\\ C-c M-n & Insert \textbf{Disposition-Notification-To:} @@ -1084,7 +1085,7 @@ C-c C-m m & Insert \textbf{multi}-part.\\ C-c C-m q & \textbf{Quote} region.\\ C-c C-m c s & Encrypt message using \textbf{S/MIME}.\\ - C-c C-m c o & Encrypt message usging PGP.\\ + C-c C-m c o & Encrypt message using PGP.\\ C-c C-m c p & Encrypt message using \textbf{PGP/MIME}.\\ C-c C-m s s & Sign message using \textbf{S/MIME}.\\ C-c C-m s o & Sign message using PGP.\\ diff --git a/texi/message.texi b/texi/message.texi index e650b0e..b3c3f9c 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -48,7 +48,7 @@ license to the document, as described in section 6 of the license. @page @vskip 0pt plus 1filll -Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002 +Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -88,7 +88,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Message 5.10.1. Message is distributed +This manual corresponds to Message v5.10.3. Message is distributed with the Gnus distribution bearing the same version number as this manual. @@ -173,9 +173,9 @@ just return @code{nil}, and the normal methods for determining the To header will be used. This function can also return a list. In that case, each list element -should be a cons, where the car should be the name of an header -(eg. @code{Cc}) and the cdr should be the header value -(eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into +should be a cons, where the @sc{car} should be the name of a header +(e.g. @code{Cc}) and the @sc{cdr} should be the header value +(e.g. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into the head of the outgoing mail. @@ -312,7 +312,7 @@ constructed. The default value is @code{nil}. If this variable is @code{t} (the default), forwarded messages are included as inline @acronym{MIME} RFC822 parts. If it's @code{nil}, forwarded messages will just be copied inline to the new message, like previous, -non @acronym{MIME}-savvy versions of gnus would do. +non @acronym{MIME}-savvy versions of Gnus would do. @item message-forward-before-signature @vindex message-forward-before-signature @@ -353,6 +353,7 @@ will be removed before popping up the buffer. The default is @node Mailing Lists @section Mailing Lists +@cindex Mail-Followup-To Sometimes while posting to mailing lists, the poster needs to direct followups to the post to specific places. The Mail-Followup-To (MFT) was created to enable just this. Two example scenarios where this is @@ -399,7 +400,7 @@ way. The following variables would come in handy. @vindex message-subscribed-addresses @item message-subscribed-addresses This should be a list of addresses the user is subscribed to. Its -default value is @code{nil}. Example: +default value is @code{nil}. Example: @lisp (setq message-subscribed-addresses '("ding@@gnus.org" "bing@@noose.org")) @@ -425,8 +426,8 @@ There is a pre-defined function in Gnus that is a good candidate for this variable. @code{gnus-find-subscribed-addresses} is a function that returns a list of addresses corresponding to the groups that have the @code{subscribed} (@pxref{Group Parameters, ,Group Parameters, -gnus, The Gnus Manual}) group parameter set to a non-nil value. This -is how you would do it. +gnus, The Gnus Manual}) group parameter set to a non-@code{nil} value. +This is how you would do it. @lisp (setq message-subscribed-address-functions @@ -460,7 +461,7 @@ other headers and set to the value of all addresses in To: and Cc: @findex message-generate-unsubscribed-mail-followup-to @kindex C-c C-f C-m @findex message-goto-mail-followup-to -Hm. ``So'', you ask, ``what if I send an email to a list I am not +Hm. ``So'', you ask, ``what if I send an email to a list I am not subscribed to? I want my MFT to say that I want an extra copy.'' (This is supposed to be interpreted by others the same way as if there were no MFT, but you can use an explicit MFT to override someone else's @@ -491,7 +492,7 @@ Gnus will prompt you for an action. @end table -It is considered good nettiquette to honor MFT, as it is assumed the +It is considered good netiquette to honor MFT, as it is assumed the fellow who posted a message knows where the followups need to go better than you do. @@ -625,9 +626,9 @@ own address. This function inserts such a header automatically. It fetches the contents of the @samp{To:} header in the current mail buffer, and appends the current @code{user-mail-address}. -If the optional argument @code{include-cc} is non-nil, the addresses in -the @samp{Cc:} header are also put into the @samp{Mail-Followup-To:} -header. +If the optional argument @code{include-cc} is non-@code{nil}, the +addresses in the @samp{Cc:} header are also put into the +@samp{Mail-Followup-To:} header. @end table @@ -666,7 +667,7 @@ address from @code{To:} and @code{Cc:} headers. @kindex C-c M-n @findex message-insert-disposition-notification-to Insert a request for a disposition -notification. (@code{message-insert-disposition-notification-to}). +notification. (@code{message-insert-disposition-notification-to}). This means that if the recipient support RFC 2298 she might send you a notification that she received the message. @@ -716,7 +717,7 @@ Replace contents of @samp{To} header with contents of @samp{Cc} or @kindex C-c C-f w @findex message-insert-wide-reply Insert @samp{To} and @samp{Cc} headers as if you were doing a wide -reply. +reply. @item C-c C-f a @kindex C-c C-f a @@ -830,7 +831,7 @@ The most typical thing users want to use the multipart things in be done with the @kbd{C-c C-a} command, which will prompt for a file name and a @acronym{MIME} type. -You can also create arbitrarily complex multiparts using the MML +You can also create arbitrarily complex multiparts using the @acronym{MML} language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME Manual}). @@ -876,12 +877,13 @@ Libidn} installed in order to use this functionality. @cindex encrypt @cindex secure -Using the MML language, Message is able to create digitally signed and -digitally encrypted messages. Message (or rather MML) currently -support @acronym{PGP} (RFC 1991), @acronym{PGP/MIME} (RFC 2015/3156) and @acronym{S/MIME}. -Instructing MML to perform security operations on a @acronym{MIME} part is -done using the @kbd{C-c C-m s} key map for signing and the @kbd{C-c -C-m c} key map for encryption, as follows. +Using the @acronym{MML} language, Message is able to create digitally +signed and digitally encrypted messages. Message (or rather +@acronym{MML}) currently support @acronym{PGP} (RFC 1991), +@acronym{PGP/MIME} (RFC 2015/3156) and @acronym{S/MIME}. Instructing +@acronym{MML} to perform security operations on a @acronym{MIME} part is +done using the @kbd{C-c C-m s} key map for signing and the @kbd{C-c C-m +c} key map for encryption, as follows. @table @kbd @@ -924,43 +926,22 @@ Digitally encrypt current message using @acronym{PGP/MIME}. @item C-c C-m C-n @kindex C-c C-m C-n @findex mml-unsecure-message -Remove security related MML tags from message. +Remove security related @acronym{MML} tags from message. @end table These commands do not immediately sign or encrypt the message, they -merely insert the proper MML secure tag to instruct the MML engine to -perform that operation when the message is actually sent. They may -perform other operations too, such as locating and retrieving a -@acronym{S/MIME} certificate of the person you wish to send encrypted mail -to. When the mml parsing engine converts your MML into a properly -encoded @acronym{MIME} message, the secure tag will be replaced with either -a part or a multipart tag. If your message contains other mml parts, -a multipart tag will be used; if no other parts are present in your -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'' -mode. If you would like to disable this for a particular message, -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 -example: - - -@lisp -(setq mml-signencrypt-style-alist '(("smime" combined) - ("pgp" combined) - ("pgpmime" combined))) -@end lisp - -Will cause Gnus to sign and encrypt in one pass, thus generating a -single signed and encrypted part. Note that combined sign and encrypt -does not work with all supported OpenPGP implementations (in -particular, @acronym{PGP} version 2 do not support this). +merely insert the proper @acronym{MML} secure tag to instruct the +@acronym{MML} engine to perform that operation when the message is +actually sent. They may perform other operations too, such as locating +and retrieving a @acronym{S/MIME} certificate of the person you wish to +send encrypted mail to. When the mml parsing engine converts your +@acronym{MML} into a properly encoded @acronym{MIME} message, the secure +tag will be replaced with either a part or a multipart tag. If your +message contains other mml parts, a multipart tag will be used; if no +other parts are present in your message a single part tag will be used. +This way, message mode will do the Right Thing (TM) with +signed/encrypted multipart messages. Since signing and especially encryption often is used when sensitive information is sent, you may want to have some way to ensure that your @@ -975,6 +956,12 @@ party the other night, actually will be sent encrypted. RFC822 headers. They only operate on the @acronym{MIME} object. Keep this in mind before sending mail with a sensitive Subject line. +By default, when encrypting a message, Gnus will use the +``signencrypt'' mode, which means the message is both signed and +encrypted. If you would like to disable this for a particular +message, give the @code{mml-secure-message-encrypt-*} command a prefix +argument, e.g., @kbd{C-u C-c C-m c p}. + Actually using the security commands above is not very difficult. At least not compared with making sure all involved programs talk with each other properly. Thus, we now describe what external libraries or @@ -986,24 +973,25 @@ programs are required to make things work, and some small general hints. modern cryptography, @acronym{S/MIME}, various PKCS standards, OpenSSL and so on. -The @acronym{S/MIME} support in Message (and MML) require OpenSSL. OpenSSL -perform the actual @acronym{S/MIME} sign/encrypt operations. OpenSSL can -be found at @uref{http://www.openssl.org/}. OpenSSL 0.9.6 and later -should work. Version 0.9.5a cannot extract mail addresses from -certificates, and it insert a spurious CR character into @acronym{MIME} -separators so you may wish to avoid it if you would like to avoid -being regarded as someone who send strange mail. (Although by sending -@acronym{S/MIME} messages you've probably already lost that contest.) +The @acronym{S/MIME} support in Message (and @acronym{MML}) require +OpenSSL. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt +operations. OpenSSL can be found at @uref{http://www.openssl.org/}. +OpenSSL 0.9.6 and later should work. Version 0.9.5a cannot extract mail +addresses from certificates, and it insert a spurious CR character into +@acronym{MIME} separators so you may wish to avoid it if you would like +to avoid being regarded as someone who send strange mail. (Although by +sending @acronym{S/MIME} messages you've probably already lost that +contest.) To be able to send encrypted mail, a personal certificate is not -required. Message (MML) need a certificate for the person to whom you +required. Message (@acronym{MML}) need a certificate for the person to whom you wish to communicate with though. You're asked for this when you type @kbd{C-c C-m c s}. Currently there are two ways to retrieve this certificate, from a local file or from DNS. If you chose a local file, it need to contain a X.509 certificate in @acronym{PEM} format. If you chose DNS, you're asked for the domain name where the certificate is stored, the default is a good guess. To my belief, -Message (MML) is the first mail agent in the world to support +Message (@acronym{MML}) is the first mail agent in the world to support retrieving @acronym{S/MIME} certificates from DNS, so you're not likely to find very many certificates out there. At least there should be one, stored at the domain @code{simon.josefsson.org}. LDAP @@ -1013,8 +1001,8 @@ command line to retrieve a certificate into a file and use it.) As for signing messages, OpenSSL can't perform signing operations without some kind of configuration. Especially, you need to tell it -where your private key and your certificate is stored. MML uses an -Emacs interface to OpenSSL, aptly named @code{smime.el}, and it +where your private key and your certificate is stored. @acronym{MML} +uses an Emacs interface to OpenSSL, aptly named @code{smime.el}, and it contain a @code{custom} group used for this configuration. So, try @kbd{M-x customize-group RET smime RET} and look around. @@ -1033,15 +1021,21 @@ $ openssl pkcs12 -in ns.p12 -clcerts -nodes > key+cert.pem The @file{key+cert.pem} file should be pointed to from the @code{smime-keys} variable. You should now be able to send signed mail. -@emph{Note!} Your private key is stored unencrypted in the file, so take -care in handling it. +@emph{Note!} Your private key is now stored unencrypted in the file, +so take care in handling it. Storing encrypted keys on the disk are +supported, and Gnus will ask you for a passphrase before invoking +OpenSSL. Read the OpenSSL documentation for how to achieve this. If +you use unencrypted keys (e.g., if they are on a secure storage, or if +you are on a secure single user machine) simply press @code{RET} at +the passphrase prompt. @subsection Using PGP/MIME @acronym{PGP/MIME} requires an external OpenPGP implementation, such -as @uref{http://www.gnupg.org/, GNU Privacy Guard}. One Emacs -interface to OpenPGP implementations, PGG (@pxref{Top, ,PGG, pgg, PGG -Manual}), is included, but Mailcrypt and Florian Weimer's +as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP +implementations such as PGP 2.x and PGP 5.x are also supported. One +Emacs interface to the PGP implementations, PGG (@pxref{Top, ,PGG, +pgg, PGG Manual}), is included, but Mailcrypt and Florian Weimer's @code{gpg.el} are also supported. @vindex gpg-temp-directory @@ -1049,8 +1043,36 @@ Note, if you are using the @code{gpg.el} you must make sure that the directory specified by @code{gpg-temp-directory} have permissions 0700. -Creating your own OpenPGP key is described in detail in the -documentation of your OpenPGP implementation, so we refer to it. +Creating your own key is described in detail in the documentation of +your PGP implementation, so we refer to it. + +If you have imported your old PGP 2.x key into GnuPG, and want to send +signed and encrypted messages to your fellow PGP 2.x users, you'll +discover that the receiver cannot understand what you send. One +solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set +@code{pgg-default-scheme} to @code{pgp}). If you do want to use +GnuPG, you can use a compatibility script called @code{gpg-2comp} +available from +@uref{http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp/}. You +could also convince your fellow PGP 2.x users to convert to GnuPG. +@vindex mml-signencrypt-style-alist +As a final workaround, you can make the sign and encryption work in +two steps; separately sign, then encrypt a message. If you would like +to change this behavior you can customize the +@code{mml-signencrypt-style-alist} variable. For example: + +@lisp +(setq mml-signencrypt-style-alist '(("smime" separate) + ("pgp" separate) + ("pgpauto" separate) + ("pgpmime" separate))) +@end lisp + +This causes to sign and encrypt in two passes, thus generating a +message that can be understood by PGP version 2. + +(Refer to @uref{http://www.gnupg.org/gph/en/pgp2x.html} for more +information about the problem.) @node Various Commands @section Various Commands @@ -1071,7 +1093,7 @@ many places to rotate the text. The default is 13. @vindex message-elide-ellipsis Elide the text between point and mark (@code{message-elide-region}). The text is killed and replaced with the contents of the variable -@code{message-elide-ellipsis}. The default value is to use an ellipsis +@code{message-elide-ellipsis}. The default value is to use an ellipsis (@samp{[...]}). @item C-c C-z @@ -1329,7 +1351,7 @@ Responses to messages have subjects that start with @samp{Re: }. This is @emph{not} an abbreviation of the English word ``response'', but is Latin, and means ``in response to''. Some illiterate nincompoops have failed to grasp this fact, and have ``internationalized'' their software -to use abonimations like @samp{Aw: } (``antwort'') or @samp{Sv: } +to use abominations like @samp{Aw: } (``antwort'') or @samp{Sv: } (``svar'') instead, which is meaningless and evil. However, you may have to deal with users that use these evil tools, in which case you may set this variable to a regexp that matches these prefixes. Myself, I @@ -1340,7 +1362,23 @@ responding to a message: @lisp (setq message-subject-re-regexp - "^\\(\\(\\([Rr][Ee]\\|[Ss][Vv]\\|[Aa][Ww]\\): *\\)+\\)") + (concat + "^[ \t]*" + "\\(" + "\\(" + "[Aa][Nn][Tt][Ww]\\.?\\|" ; antw + "[Aa][Ww]\\|" ; aw + "[Ff][Ww][Dd]?\\|" ; fwd + "[Oo][Dd][Pp]\\|" ; odp + "[Rr][Ee]\\|" ; re + "[Rr][\311\351][Ff]\\.?\\|" ; ref + "[Ss][Vv]" ; sv + "\\)" + "\\(\\[[0-9]*\\]\\)" + "*:[ \t]*" + "\\)" + "*[ \t]*" + )) @end lisp @item message-subject-trailing-was-query @@ -1416,8 +1454,8 @@ buffers that are initialized as mail. @findex message-smtpmail-send-it @findex smtpmail-send-it @findex feedmail-send-it -Function used to send the current buffer as mail. The default is -@code{message-send-mail-with-sendmail}. Other valid values include +Function used to send the current buffer as mail. The default is +@code{message-send-mail-with-sendmail}. Other valid values include @code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail}, @code{message-smtpmail-send-it}, @code{smtpmail-send-it} and @code{feedmail-send-it}. @@ -1461,7 +1499,7 @@ the address to use in the @acronym{SMTP} envelope. If it is @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 -body together. (This problem exists on Sunos 4 when sendmail is run +body together. (This problem exists on SunOS 4 when sendmail is run in remote mode.) The value should be an expression to test whether the problem will actually occur. @@ -1570,9 +1608,9 @@ unlikely that you should need to fiddle with this variable at all. @findex yow @cindex Mime-Version -In addition, you can enter conses into this list. The car of this cons +In addition, you can enter conses into this list. The @sc{car} of this cons should be a symbol. This symbol's name is the name of the header, and -the cdr can either be a string to be entered verbatim as the value of +the @sc{cdr} can either be a string to be entered verbatim as the value of this header, or it can be a function to be called. This function should return a string to be inserted. For instance, if you want to insert @code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")} @@ -1580,8 +1618,8 @@ into the list. If you want to insert a funny quote, you could enter something like @code{(X-Yow . yow)} into the list. The function @code{yow} will then be called without any arguments. -If the list contains a cons where the car of the cons is -@code{optional}, the cdr of this cons will only be inserted if it is +If the list contains a cons where the @sc{car} of the cons is +@code{optional}, the @sc{cdr} of this cons will only be inserted if it is non-@code{nil}. If you want to delete an entry from this list, the following Lisp @@ -1724,7 +1762,7 @@ Note that Gnus provides a feature where clicking on `writes:' hides the cited text. If you change the citation line too much, readers of your messages will have to adjust their Gnus, too. See the variable @code{gnus-cite-attribution-suffix}. @xref{Article Highlighting, , -Article Highlighting, gnus}, for details. +Article Highlighting, gnus, The Gnus Manual}, for details. @item message-yank-prefix @vindex message-yank-prefix @@ -1734,7 +1772,7 @@ When you are replying to or following up an article, you normally want to quote the person you are answering. Inserting quoted text is done by @dfn{yanking}, and each line you yank will have @code{message-yank-prefix} prepended to it (except for quoted and -empty lines which uses @code{message-yank-cited-prefix}). The default +empty lines which uses @code{message-yank-cited-prefix}). The default is @samp{> }. @item message-yank-cited-prefix @@ -1907,7 +1945,7 @@ Hook run after sending messages. @item message-cancel-hook @vindex message-cancel-hook -Hook run when cancelling news articles. +Hook run when canceling news articles. @item message-mode-syntax-table @vindex message-mode-syntax-table @@ -1928,7 +1966,7 @@ message composition doesn't break too bad. Alist of ways to send outgoing messages. Each element has the form @lisp -(TYPE PREDICATE FUNCTION) +(@var{type} @var{predicate} @var{function}) @end lisp @table @var @@ -2066,7 +2104,7 @@ This restores the Gnus window configuration when the message buffer is killed, postponed or exited. An @dfn{action} can be either: a normal function, or a list where the -@code{car} is a function and the @code{cdr} is the list of arguments, or +@sc{car} is a function and the @sc{cdr} is the list of arguments, or a form to be @code{eval}ed. diff --git a/texi/pgg.texi b/texi/pgg.texi index a57fe11..72329a4 100644 --- a/texi/pgg.texi +++ b/texi/pgg.texi @@ -81,7 +81,7 @@ This document assumes that you have already obtained and installed them and that you are familiar with its basic functions. By default, PGG uses GnuPG, but Pretty Good Privacy version 2 or version -5 are also supported. If you are new to such a system, I recomend that +5 are also supported. If you are new to such a system, I recommend that you should look over the GNU Privacy Handbook (GPH) which is available at @uref{http://www.gnupg.org/gph/}. @@ -188,10 +188,10 @@ considerably. For example, if you are using GnuPG, you know you can select cipher algorithm from 3DES, CAST5, BLOWFISH, and so on, but on the other hand the version 2 of PGP only supports IDEA. -By default, if the variable @var{pgg-scheme} is not set, PGG searches the +By default, if the variable @code{pgg-scheme} is not set, PGG searches the registered scheme for an implementation of the requested service associated with the named algorithm. If there are no match, PGG uses -@var{pgg-default-scheme}. In other words, there are two options to +@code{pgg-default-scheme}. In other words, there are two options to control which command is used to process the incoming PGP armors. One is for encrypting and signing, the other is for decrypting and verifying. @@ -210,7 +210,7 @@ The value can be @code{gpg}, @code{pgp}, and @code{pgp5}. @section Caching passphrase PGG provides a simple passphrase caching mechanism. If you want to -arrange the interaction, set the variable @var{pgg-read-passphrase}. +arrange the interaction, set the variable @code{pgg-read-passphrase}. @defvar pgg-cache-passphrase If non-@code{nil}, store passphrases. The default value of this @@ -260,7 +260,7 @@ interchangeably with "scheme" in this document). This term refers to a singleton object wrapped with the luna object system. Since PGG was designed for accessing and developing PGP functionality, -the architecture had to be designed not just for interoperablity but +the architecture had to be designed not just for interoperability but also for extensiblity. In this chapter we explore the architecture while finding out how to write the PGG backend. @@ -278,7 +278,7 @@ It had better guarantee to keep only one instance of a scheme. The following code is snipped out of @file{pgg-gpg.el}. Once an instance of @code{pgg-gpg} scheme is initialized, it's stored to the -variable @var{pgg-scheme-gpg-instance} and will be reused from now on. +variable @code{pgg-scheme-gpg-instance} and will be reused from now on. @lisp (defvar pgg-scheme-gpg-instance nil) @@ -328,7 +328,7 @@ create a detached signature. If signing is successful, it returns Verify the current region between @var{start} and @var{end}. If the optional third argument @var{signature} is non-@code{nil}, it is treated as the detached signature of the current region. If the signature is -successflly verified, it returns @code{t}, otherwise @code{nil}. +successfully verified, it returns @code{t}, otherwise @code{nil}. @end deffn @deffn Method pgg-scheme-insert-key scheme diff --git a/texi/refcard.tex b/texi/refcard.tex index 92ed19d..8028687 100644 --- a/texi/refcard.tex +++ b/texi/refcard.tex @@ -113,17 +113,18 @@ \SortSummary \subsection*{Score (Value) Commands} \Scoring - \subsection*{Extract Series (Uudecode etc)} - \ExtractSeries \subsection*{Output Articles} \OutputArticles + \subsection*{Extract Series (Uudecode etc)} + \ExtractSeries \subsection*{MIME operations from the Summary-Buffer} \MIMESummary % \subsection*{Post, Followup, Reply, Forward, Cancel} \PostReplyetc - \subsection*{Message-Composition} - \MsgCompositionGeneral + \newpage + \subsection*{Message Composition} + \MsgCompositionGeneral \subsubsection*{Jumping in message-buffer} \MsgCompositionMovementArticle \subsubsection*{Attachments/MML} diff --git a/texi/sieve.texi b/texi/sieve.texi index e4403b9..6bfcf2f 100644 --- a/texi/sieve.texi +++ b/texi/sieve.texi @@ -135,7 +135,7 @@ indentation. Sieve mode has its own abbrev table (@code{sieve-mode-syntax-table}). In addition to the editing utility functions, Sieve mode also contains -bindings to manage Sieve scripts remotely. @pxref{Managing Sieve}. +bindings to manage Sieve scripts remotely. @xref{Managing Sieve}. @table @kbd @@ -162,7 +162,7 @@ on a remote server. It can be invoked with @kbd{M-x sieve-manage RET}, which queries the user for a server and if necessary, user credentials to use. -When a server has been succesfully contacted, the Manage Sieve buffer +When a server has been successfully contacted, the Manage Sieve buffer looks something like: @example diff --git a/texi/texi2latex.el b/texi/texi2latex.el index 06c08ec..93923c6 100644 --- a/texi/texi2latex.el +++ b/texi/texi2latex.el @@ -144,6 +144,8 @@ (insert "\\\\")) ((equal command "sp") (replace-match "" t t)) + ((equal command ":") + (replace-match "" t t)) ((member command '("deffn" "defvar" "defun")) (replace-match "" t t)) ((equal command "node") @@ -276,7 +278,8 @@ (latexi-exchange-command (concat "gnus" command) arg)) ((member command '("sc" "file" "dfn" "emph" "kbd" "key" "uref" "code" "samp" "var" "strong" "i" - "result" "email" "env" "r")) + "result" "email" "env" "r" "command" "asis" + "url")) (goto-char (match-beginning 0)) (delete-char 1) (insert "\\gnus"))