From: yamaoka Date: Tue, 18 Mar 2003 00:02:12 +0000 (+0000) Subject: Import Oort Gnus v0.16. X-Git-Tag: ognus-0_16~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ca101d0305c3ff2ecc44dade2025c974ffc7168a;p=elisp%2Fgnus.git- Import Oort Gnus v0.16. --- diff --git a/ChangeLog b/ChangeLog index 59c4126..aa17979 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2003-02-19 Reiner Steib + + * GNUS-NEWS: Renamed `gnus-unsightly-citation-regexp' to + `gnus-cite-unsightly-citation-regexp'. + +2003-02-18 Simon Josefsson + + * GNUS-NEWS: Talk about canlock more. + +2003-02-13 Kai Gro,A_(Bjohann + + * GNUS-NEWS: Add user visible changes from Michael Shields from + the past couple of days. Actual text from Michael. + 2003-01-24 Jesper Harder * etc/gnus-tut.txt: Update. diff --git a/GNUS-NEWS b/GNUS-NEWS index dcccac0..b388b8d 100644 --- a/GNUS-NEWS +++ b/GNUS-NEWS @@ -8,6 +8,25 @@ For older news, see Gnus info node "New Features". * Changes in Oort Gnus +** Better handling of Microsoft citation styles + +Gnus now tries to recognize the mangled header block that some Microsoft +mailers use to indicate that the rest of the message is a citation, even +though it is not quoted in any way. The variable +`gnus-cite-unsightly-citation-regexp' matches the start of these +citations. + +** gnus-article-skip-boring + +If you set `gnus-article-skip-boring' to t, then Gnus will not scroll +down to show you a page that contains only boring text, which by +default means cited text and signature. You can customize what is +skippable using `gnus-article-boring-faces'. + +This feature is especially useful if you read many articles that +consist of a little new content at the top with a long, untrimmed +message cited below. + ** The format spec %C for positioning point has changed to %*. ** The new variable `gnus-parameters' can be used to set group parameters. @@ -216,10 +235,14 @@ In the message buffer, C-c C-f C-i or C-u cycles through the valid values. ** Gnus supports Cancel Locks in News. -This means a header "Cancel-Lock" is inserted in news posting. It is -used to determine if you wrote a article or not (for -cancelling/superseding). The behaviour can be changed by customizing -`message-insert-canlock'. +This means a header "Cancel-Lock" is inserted in news posting. It is +used to determine if you wrote a article or not (for cancelling and +superseding). Gnus generates a random password string the first time +you post a message, and saves it in your ~/.emacs using the Custom +system. While the variable is called `canlock-password', it is not +security sensitive data. Publishing your canlock string on the web +will not allow anyone to be able to anything she could not already do. +The behaviour can be changed by customizing `message-insert-canlock'. ** Gnus supports server-side mail filtering using Sieve. diff --git a/contrib/ChangeLog b/contrib/ChangeLog index f8271d6..4f6586b 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,27 @@ +2003-03-11 Teodor Zlatanov + + * hashcash.el (hashcash-version, hashcash-insert-payment): patch + from Paul Foley + +2003-03-07 Simon Josefsson + + * gnus-idna.el (gnus-idna-to-ascii-rhs-1): Narrow to + head (otherwise forwarded mail break havoc). + +2003-03-07 Teodor Zlatanov + + * hashcash.el: New version from Paul Foley with better variable + names, executable-find support, and no errors in GNU Emacs + (hashcash-version): return nil when invoked with a + nil token + +2003-02-21 Simon Josefsson + + * hashcash.el (hashcash-point-at-bol): + (hashcash-point-at-eol): Defalias. + (hashcash-generate-payment): + (mail-check-payment): Use it. + 2002-12-30 Lars Magne Ingebrigtsen * hashcash.el: New version from Paul Foley with new diff --git a/contrib/gnus-idna.el b/contrib/gnus-idna.el new file mode 100644 index 0000000..32eb2f8 --- /dev/null +++ b/contrib/gnus-idna.el @@ -0,0 +1,116 @@ +;;; gnus-idna.el --- Internationalized domain names support for Gnus. + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Keywords: news, mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package implement crude support for internationalized +;; (non-ASCII) domain names in Gnus. It is meant as a proof of +;; concept. + +;; Theory of Operation: + +;; RFC 2822 RHS's inside the From:, To:, and CC: headers are encoded +;; using IDNA ToASCII() when you send mail using Message. The hook +;; used is message-send-hook. +;; +;; For incoming articles, when QP in headers are decoded, it searches +;; for "xn--" prefixes and decode them using IDNA ToUnicode(). The +;; hook used is gnus-article-decode-hook. + +;; Usage: + +;; Simply put (require 'gnus-idna) in your ~/.gnus or ~/.emacs and it +;; should work. You need to install GNU Libidn (0.1.11 or later) and +;; make sure the idna.el installed by it is found by emacs. + +;;; Code: + +(require 'gnus) +(require 'rfc822) +(require 'idna) + +(eval-and-compile + (cond + ((fboundp 'replace-in-string) + (defalias 'gnus-replace-in-string 'replace-in-string)) + ((fboundp 'replace-regexp-in-string) + (defun gnus-replace-in-string (string regexp newtext &optional literal) + (replace-regexp-in-string regexp newtext string nil literal))) + (t + (defun gnus-replace-in-string (string regexp newtext &optional literal) + (let ((start 0) tail) + (while (string-match regexp string start) + (setq tail (- (length string) (match-end 0))) + (setq string (replace-match newtext nil literal string)) + (setq start (- (length string) tail)))) + string)))) + +(defun gnus-idna-to-ascii-rhs-1 (header) + (save-excursion + (save-restriction + (let (address header-data new-header-data rhs ace) + (message-narrow-to-head) + (setq header-data (message-fetch-field header)) + (when header-data + (dolist (element (message-tokenize-header header-data)) + (setq address (car (rfc822-addresses element))) + (when (string-match "\\(.*\\)@\\([^@]+\\)" address) + (setq ace (if (setq rhs (match-string 2 address)) + (idna-to-ascii rhs))) + (push (if (string= rhs ace) + element + (gnus-replace-in-string + element (regexp-quote rhs) ace t)) + new-header-data))) + (message-remove-header header) + (message-position-on-field header) + (dolist (addr (reverse new-header-data)) + (insert addr ", ")) + (when new-header-data + (delete-backward-char 2))))))) + +(defun gnus-idna-to-ascii-rhs () + (gnus-idna-to-ascii-rhs-1 "From") + (gnus-idna-to-ascii-rhs-1 "To") + (gnus-idna-to-ascii-rhs-1 "Cc")) + +(add-hook 'message-send-hook 'gnus-idna-to-ascii-rhs) + +(defun gnus-idna-to-unicode-rhs () + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (goto-char (point-min)) + (while (re-search-forward "xn--.*[ \t\n\r.,<>()@!]" nil t) + ;(or (eobp) (forward-char)) + (let (ace unicode) + (when (setq ace (match-string 0)) + (setq unicode (idna-to-unicode ace)) + (unless (string= ace unicode) + (replace-match unicode))))))) + +(add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append) + +(provide 'gnus-idna) + +;; gnus-idna.el ends here diff --git a/contrib/hashcash.el b/contrib/hashcash.el index 86b5d84..ef6fc9f 100644 --- a/contrib/hashcash.el +++ b/contrib/hashcash.el @@ -1,12 +1,14 @@ ;;; hashcash.el --- Add hashcash payments to email -;; $Revision: 1.1.1.2 $ -;; Copyright (C) 1997,2001 Paul E. Foley +;; $Revision: 1.1.1.3 $ +;; Copyright (C) 1997--2002 Paul E. Foley +;; Copyright (C) 2003 Free Software Foundation ;; Maintainer: Paul Foley ;; Keywords: mail, hashcash ;; Released under the GNU General Public License +;; (http://www.gnu.org/licenses/gpl.html) ;;; Commentary: @@ -20,6 +22,9 @@ ;;; Code: +(eval-and-compile + (autoload 'executable-find "executable")) + (defcustom hashcash-default-payment 0 "*The default number of bits to pay to unknown users. If this is zero, no payment header will be generated. @@ -37,13 +42,13 @@ present, is the string to be hashed; if not present ADDR will be used.") "*The default minimum number of bits to accept on incoming payments." :type 'integer) -(defcustom hashcash-accept-resources `((,(user-mail-address) nil)) +(defcustom hashcash-accept-resources `((,user-mail-address nil)) "*An association list mapping hashcash resources to payment amounts. Resources named here are to be accepted in incoming payments. If the corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment' is used instead.") -(defcustom hashcash "/usr/local/bin/hashcash" +(defcustom hashcash-path (executable-find "hashcash") "*The path to the hashcash binary.") (defcustom hashcash-double-spend-database "hashcash.db" @@ -55,6 +60,16 @@ is used instead.") (require 'mail-utils) +(defalias 'hashcash-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) + +(defalias 'hashcash-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position)) + (defun hashcash-strip-quoted-names (addr) (setq addr (mail-strip-quoted-names addr)) (if (and addr (string-match "^[^+@]+\\(\\+[^@]*\\)@" addr)) @@ -85,20 +100,36 @@ is used instead.") (save-excursion (set-buffer (get-buffer-create " *hashcash*")) (erase-buffer) - (call-process hashcash nil t nil (concat "-b " (number-to-string val)) - str) + (call-process hashcash-path nil t nil + (concat "-b " (number-to-string val)) str) (goto-char (point-min)) - (buffer-substring (point-at-bol) (point-at-eol))) + (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol))) nil)) (defun hashcash-check-payment (token str val) "Check the validity of a hashcash payment." - (zerop (call-process hashcash nil nil nil "-c" + (zerop (call-process hashcash-path nil nil nil "-c" "-d" "-f" hashcash-double-spend-database "-b" (number-to-string val) "-r" str token))) +(defun hashcash-version (token) + "Find the format version of a hashcash token." + ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; This carries its own version number embedded in the token, + ;; so no further format number changes should be necessary + ;; in the X-Payment header. + ;; + ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; You need to upgrade your hashcash binary. + ;; + ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx + ;; This is no longer supported. + (cond ((equal (aref token 1) ?:) 1.2) + ((equal (aref token 6) ?:) 1.1) + (t (error "Unknown hashcash format version")))) + ;;;###autoload (defun hashcash-insert-payment (arg) "Insert X-Payment and X-Hashcash headers with a payment for ARG" @@ -106,13 +137,17 @@ is used instead.") (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) (hashcash-payment-required arg)))) (when pay - (insert-before-markers "X-Payment: hashcash 1.1 " pay "\n") + (insert-before-markers "X-Payment: hashcash " + (number-to-string (hashcash-version pay)) " " + pay "\n") (insert-before-markers "X-Hashcash: " pay "\n")))) ;;;###autoload (defun hashcash-verify-payment (token &optional resource amount) "Verify a hashcash payment" - (let ((key (cadr (split-string-by-char token ?:)))) + (let ((key (if (< (hashcash-version token) 1.2) + (cadr (split-string token ":")) + (caddr (split-string token ":"))))) (cond ((null resource) (let ((elt (assoc key hashcash-accept-resources))) (and elt (hashcash-check-payment token (car elt) @@ -156,25 +191,27 @@ for each recipient address. Prefix arg sets default payment temporarily." Prefix arg sets default accept amount temporarily." (interactive "P") (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg) - hashcash-default-accept-payment))) + hashcash-default-accept-payment)) + (version (hashcash-version (hashcash-generate-payment "x" 1)))) (save-excursion (goto-char (point-min)) - (search-forward mail-header-separator) + (search-forward "\n\n") (beginning-of-line) (let ((end (point)) (ok nil)) (goto-char (point-min)) - (while (and (not ok) (search-forward "X-Payment: hashcash 1.1 " end t)) - (setq ok (hashcash-verify-payment - (buffer-substring (point) (point-at-eol))))) + (while (and (not ok) (search-forward "X-Payment: hashcash " end t)) + (let ((value (split-string + (buffer-substring (point) (hashcash-point-at-eol)) + " "))) + (when (equal (car value) (number-to-string version)) + (setq ok (hashcash-verify-payment (cadr value)))))) (goto-char (point-min)) (while (and (not ok) (search-forward "X-Hashcash: " end t)) (setq ok (hashcash-verify-payment - (buffer-substring (point) (point-at-eol))))) + (buffer-substring (point) (hashcash-point-at-eol))))) (when ok (message "Payment valid")) ok)))) (provide 'hashcash) - -;;; hashcash.el ends here diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d04dbef..e6dd576 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,970 @@ +2003-03-18 00:38:22 Lars Magne Ingebrigtsen + + * gnus.el: Oort Gnus v0.16 is released. + +2003-03-18 Lars Magne Ingebrigtsen + + * lpath.el (featurep): Bind mm-w3m-mode-map. + +2003-03-12 Paul Jarc + + * nnmail.el (nnmail-cache-primary-mail-backend): Not all + 'respool-able backends define a global nnchoke-get-new-mail + variable. + +2003-03-17 Reiner Steib + + * gnus-art.el (gnus-mime-delete-part): New function. + (gnus-mime-action-alist, gnus-mime-button-commands): Use it. + +2003-03-17 Lars Magne Ingebrigtsen + + * message.el (message-check-news-header-syntax): Don't push + groups twice onto list of unknown groups. + + * nndoc.el (nndoc-type-alist): Move exim-bounce a bit further + back. + + * nnheader.el (nnheader-find-etc-directory): Doc fix. + + * gnus-msg.el (gnus-inews-add-send-actions): Don't restore window + config unless the summary buffer exists. + + * gnus-sum.el (gnus-summary-next-group): Semi-exit group first to + that target group is computed correctly when articles are marked + as read by Xref handling. + + * mail-source.el (mail-source-fetch-imap): Pass buffer-name to + imap-open. + + * message.el (message-send-mail): Add courtesy string to Bcc's, + too. + + * gnus-cite.el (gnus-cited-line-p): New function. + +2003-03-15 Jesper Harder + + * mm-bodies.el (mm-decode-body): Add new optional parameter, + force, to use the supplied charset unconditionally. + + * gnus-art.el (article-decode-charset): Use it. + +2003-03-14 Jesper Harder + + * mm-bodies.el (mm-decode-coding-region-safely): New function. + (mm-decode-body): Use it. + + * rfc2047.el (rfc2047-decode-region): do. + (rfc2047-decode-string): Guess coding system if the default is + invalid. + +2003-03-12 Paul Jarc + + * nnmaildir.el (nnmaildir-request-update-info): Pretend missing + articles are marked 'read, so we get correct article counts. + +2003-03-13 Katsumi Yamaoka + + * gnus-art.el (gnus-insert-mime-button): Exclude a newline from + the button. + (gnus-insert-prev-page-button): Ditto. + (gnus-insert-next-page-button): Ditto. + (gnus-insert-mime-security-button): Ditto. + + * mm-view.el (mm-inline-image-emacs): Open the bottom of an image + one line. Suggested by Greg Klanderman . + (mm-inline-image-xemacs): Ditto. + +2003-03-12 Paul Jarc + + * nnmaildir.el (nnmaildir--parse-filename, nnmaildir--sort-files, + nnmaildir--scan, nnmaildir-request-accept-article): Changes for + the recent filename uniqueness discussion. + +2003-03-12 Katsumi Yamaoka + + * mm-view.el (mm-inline-image-emacs): Make it delete an excessive + newline next time. + (mm-inline-image-xemacs): Ditto. + +2003-03-10 Jesper Harder + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use + kill-line. + +2003-03-09 Jesper Harder + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use + kill-line. + +2003-03-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just + fixing the code to match the documentation. + (gnus-agent-fetch-selected-article): Replaced + gnus-summary-update-article-line with gnus-summary-update-line as + the former did not correctly recalculate the thread indentation. + (gnus-agent-find-parameter): The agent-predicate, if not found + anywhere else, defaults to the value of gnus-agent-predicate. + (gnus-agent-fetch-session): Fixed typo; now executes + gnus-agent-fetched-hook rather than the undocumented + gnus-agent-fetch-hook. + (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The + default agent predicate is now provided by + gnus-agent-find-parameter. + (gnus-agent-message): New macro. This macro avoids potentially + costly parameter evaluation when the message's level is too high + to display. + (gnus-agent-expire-group-1): Disabled undo tracking in temp + overview buffer. Uses new gnus-agent-message macro to reduce + overhead of optional messages. Reversed message levels to + emphasize percent completion messages. Detailed messages of + little use except when debugging code. + +2003-03-08 Teodor Zlatanov + + * spam.el (spam-ham-move-routine): use + spam-mark-ham-unread-before-move-from-spam-group + (spam-mark-ham-unread-before-move-from-spam-group): new variable + +2003-03-07 Teodor Zlatanov + + * spam.el: load nnimap.el when compiling + (spam-setup-widening): use + nnimap-split-download-body-default instead of + nnimap-split-download-body which is a user-customizable variable + +2003-03-07 Simon Josefsson + + * nnimap.el (nnimap-split-download-body-default): New, holds + default for n-s-d-b. + (nnimap-split-download-body): Add new setting (symbol default), + which uses contents of n-s-d-b-d, and made it the default. + +2003-03-07 Teodor Zlatanov + + * spam.el (spam-use-hashcash): new variable + (spam-list-of-checks): added spam-use-hashcash with associated + spam-check-hashcash + (spam-check-hashcash): new function, installed iff hashcash.el is + loaded + (spam-setup-widening): don't use (return) + +2003-03-06 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group-1): Added default + predicate of `false' to avoid an error when a group defines no + predicate. Fixed typo that disabled agent scoring (i.e. the + low/high predicates should now work). + +2003-03-06 Teodor Zlatanov + + * spam.el: add spam-maybe-spam-stat-load to + gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook + (spam-bogofilter-register-with-bogofilter): use + spam-bogofilter-spam-switch and spam-bogofilter-ham-switch + (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): new + custom variables to replace "-s" and "-n" + + * gnus-group.el (gnus-group-get-new-news): call the new + gnus-get-top-new-news-hook hook + + * gnus-start.el (gnus-get-top-new-news-hook): new hook, run ONLY + by gnus-get-new-news, NOT by gnus-group-get-new-news-this-group + +2003-03-06 Lars Magne Ingebrigtsen + + * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message. + +2003-03-06 Katsumi Yamaoka + + * gnus-cus.el (gnus-group-customize): Don't use delete-if which is + a cl run-time function. + +2003-03-06 Kevin Greiner + + * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding + on gnus-agent-short-article. + (gnus-category-read): Replaced CL function mapcar* with new macro: + gnus-mapcar. + * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to + support functions that accept multiple parameters. A separate + sequence must be provided for each parameter in the function. + Iteration stops when the end of the shortest list is reached. + +2003-03-06 Jesper Harder + + * nnimap.el (nnimap-request-accept-article): Use delete-region. + + * html2text.el (html2text-clean-dtdd, html2text-delete-tags) + (html2text-delete-single-tag, html2text-clean-anchor) + (html2text-remove-tags): Use delete-region. + (html2text-fix-paragraphs): Simplify. + + * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt) + (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign) + (mml1991-pgg-encrypt, mml1991-pgg-encrypt): Use delete-region, not + kill-region. + +2003-03-04 John Paul Wallington + + * gnus-agent.el (gnus-agent-enable-expiration) + (gnus-agent-article-alist, gnus-agent-article-alist) + (gnus-agent-cat-defaccessor): Doc fixes. + +2003-03-04 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-function-implies-unread-1): Grok + byte-compiled functions. + +2003-03-04 Kevin Greiner + + * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides + customization between new maneuvering (which permits selecting + undownloaded articles) and old maneuvering (which skipped over + undownloaded articles) behaviors. + (gnus-summary-find-next): Pass through the unread and subject + parameters when calling gnus-summary-find-prev. + (gnus-summary-find-next,gnus-summary-find-prev): Apply + gnus-auto-goto-ignores to filter out unacceptable articles. + +2003-03-04 Jesper Harder + + * mail-source.el (mail-source-read-passwd): Remove. `read-passwd' + exists in all supported Emacs versions, so we don't need this + compatibility function. + (mail-source-fetch-pop, mail-source-check-pop) + (mail-source-fetch-webmail): Use read-passwd. + + * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo) + (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use + read-passwd. + + * nnwarchive.el (nnwarchive-open-server): Use read-passwd. + + * imap.el (imap-read-passwd): Remove. + (imap-interactive-login): Use read-passwd. + + * canlock.el (canlock-read-passwd): Remove. + (canlock-insert-header, canlock-verify): Use read-passwd. + + * sieve-manage.el (sieve-manage-read-passwd): Remove. + (sieve-manage-interactive-login): Use read-passwd. + + * pop3.el (pop3-read-passwd): Remove. + (pop3-movemail, pop3-get-message-count, pop3-apop): Use + read-passwd. + + * pgg.el (pgg-read-passphrase): Simplify. + +2003-03-04 Kevin Greiner + + * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports + 'plugged' when actually 'unplugged' bug. + (gnus-category-read): Ignore nil values when converting an + old-format category so that the new-format category will default + those attributes to the global variables. + +2003-03-03 Reiner Steib + + * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed + doc-string. + +2003-03-03 Jesper Harder + + * nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'. + * nndoc.el (nndoc-dissect-mime-parts-sub): do. + * nndb.el (nndb-request-accept-article, nndb-status-message): do. + * mm-url.el (mm-url-decode-entities-string): do. + * mml1991.el (mml1991-mailcrypt-sign, mml1991-gpg-sign): do. + * mm-decode.el (mm-find-raw-part-by-type): do. + * message.el (message-send-mail-partially) + (message-send-mail-with-sendmail): do. + * gnus-uu.el (gnus-uu-save-article, gnus-uu-reginize-string): do. + * gnus-kill.el (gnus-pp-gnus-kill): do. + * gnus-art.el (gnus-article-treat-unfold-headers) + (gnus-article-encrypt-body): do. + +2003-02-24 Reiner Steib + + * mail-source.el (mail-source-delete-incoming): Allow integer value. + (mail-source-delete-old-incoming-confirm): New variable. + (mail-source-delete-old-incoming): Use it. New function. + (mail-source-callback): Call `mail-source-delete-old-incoming' if + `mail-source-delete-incoming' is a nonnegative integer. + +2003-03-03 Reiner Steib + + * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config. + (gnus-user-agent): Fixed typo. + +2003-03-03 Kevin Greiner + + * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation. + (gnus-agent-expire-group-1): Removed invalid (interactive) specifier. + +2003-03-03 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message. + (gnus-agent-fetch-session): Allow debugging to take place. + +2003-03-03 Jesper Harder + + * gnus-sum.el (gnus-highlight-selected-summary) + (gnus-article-get-xrefs, gnus-summary-show-thread): Use + `gnus-point-at-bol' and `gnus-point-at-eol' instead of + `(progn (beginning-of-line) (point))'. It's shorter, faster, + and makes it clear that we don't need the side effect. + * gnus-util.el (gnus-delete-line): do. + * gnus-xmas.el (gnus-group-add-icon): do. + * nnmail.el (nnmail-article-group, nnmail-cache-fetch-group): do. + * nntp.el (nntp-send-authinfo-from-file): do. + * nnml.el (nnml-header-value): do. + * nnheader.el (nnheader-insert-references): do. + * gnus-cite.el (gnus-article-highlight-citation) + (gnus-cite-parse): do. + * gnus-score.el (gnus-score-followup): do. + * gnus-draft.el (gnus-draft-send): do. + * gnus-group.el (gnus-group-highlight-line): do. + * gnus-cache.el (gnus-cache-braid-nov): do. + * nnfolder.el (nnfolder-retrieve-headers) + (nnfolder-request-article): do. + * gnus-art.el (article-hide-boring-headers) + (gnus-article-hide-header): do. + + * nnheader.el (nnheader-find-nov-line): Use gnus-delete-line. + * nnml.el (nnml-request-replace-article): do. + * nnmbox.el (nnmbox-request-move-article, nnmbox-delete-mail): do. + * nnfolder.el (nnfolder-request-move-article): do. + * gnus-cache.el (gnus-cache-possibly-remove-article): do. + * gnus-art.el (gnus-mm-display-part): do. + + * gnus-art.el (gnus-article-goto-part): Use gnus-goto-char. + +2003-03-02 Kevin Greiner + + * nntp.el (nntp-possibly-change-group): Avoid calling + process-buffer on nil (Which happened when you lost your + connection while fetching); instead signal a "Server Closed + Connection" error. + +2003-03-02 Kevin Greiner + + * gnus-agent.el (gnus-agent-enable-expiration): New + variable. Either ENABLE or DISABLE. Sets default behavior for + selecting which groups are expired. + (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor, + gnus-agent-set-cat-groups): Provides abstract interface for + accessing agent category. Category now implemented by an alist. + (gnus-agent-add-group, gnus-agent-remove-group, + gnus-category-insert-line, gnus-category-edit-predicate, + gnus-category-edit-score, gnus-category-edit-groups, + gnus-category-copy, gnus-category-add, gnus-group-category): Use + new agent category abstraction. + (gnus-agent-find-parameter): New function. Search for agent + configuration parameter first in the group's parameters, then its + topics (if any), and then the group's category. If not found + anywhere, use the original defined constants. + (gnus-agent-fetch-headers, gnus-agent-fetch-group-1): Use new + gnus-agent-find-parameter. + (gnus-agent-fetch-headers, gnus-agent-uncached-articles): Clearing + gnus-agent-cache now blocks retrieving headers and articles from + the local cache. Fetched content is still added to the cache + before being returned. + (gnus-agent-fetch-session): Use error-message-string to generate + displayed error message. + (gnus-agent-customize-category): New Command. 'e' in category + buffer opens category customization buffer. + (gnus-category-read): Reads either positional or alist format; + returns alist format. + (gnus-category-write): Writes category file compatible with + current, and previous, versions of gnus-agent. + (gnus-category-make-function, gnus-category-make-function-1): + Corrected documentation; parameter is predicate NOT category. + (gnus-predicate-implies-unread): Now works in more cases per the + todo comment. + (gnus-function-implies-unread-1): New function. Supports + gnus-predicate-implies-unread. + (gnus-agent-expire-group): Command now provides default of group + under point. + (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and + agent-days-until-old parameters. No longer supports + gnus-agent-expire-days being set to an alist. + (gnus-agent-request-article): Now performs its own checks of + gnus-agent, gnus-agent-cache, and gnus-plugged rather than + assuming that the caller will do them correctly. + (): Added one-time hook to gnus-group-prepare-hook. Detects when + gnus-agent-expire-days is set to an alist. Converts said alist + into group parameter so that gnus-agent-expire-days will not be + needed. + * gnus-art.el (gnus-request-article-this-buffer): Conditional + checks surrounding gnus-agent-request-article removed; now + performed by gnus-agent-request-article. + * gnus-cus.el (gnus-agent-parameters): New variable. List of + customizable group/topic parameters that regulate the agent. + (gnus-group-customize): Uses gnus-agent-parameters. Replaced + kill-buffer with gnus-kill-buffer to remove the killed buffer from + the list of gnus buffers. + (gnus-trim-whitespace): Removes leading and trailing whitespace + from multiline strings. + (gnus-agent-cat-prepare-category-field, + gnus-agent-customize-category): Constructs a category + customization buffer. + * gnus-int.el (gnus-retrieve-headers, + gnus-request-expire-articles): No longer checks gnus-agent-cache + as it is handled internally by the agent. + (gnus-request-head, gnus-request-body): Conditional checks + surrounding gnus-agent-request-article removed; now performed by + gnus-agent-request-article. + + * gnus-start.el (): Added defvar statements to resolve compilation + warnings. + (gnus-long-file-names): New function. Isolates platform dependent + msdos-long-file-names. + (gnus-save-startup-file-via-temp-buffer): New variable. Provides + option of writing directly to file. Avoids memory exhausted + errors when .newsrc.eld is huge. + (gnus-save-newsrc-file): Uses new + gnus-save-startup-file-via-temp-buffer. + (gnus-gnus-to-quick-newsrc-format): Rewritten to write to + standard-output. + (gnus-display-time-event-handler): Changed to alias from a defun + to avoid a compile-time warning when display-time-event-handler is + not defined. + * gnus-util.el (gnus-with-output-to-file): New macro. Binds + standard-output such that prin1 and princ will write directly to a + file. + + * gnus.el (gnus-agent-cache): Expanded documentation. + (gnus-summary-high-undownloaded-face): Removed second bold keyword + so that this face is actually bold. + + * nnkiboze.el (nnkiboze-request-article): Only use the cache when + gnus-use-cache has been set. + +2003-03-02 Jesper Harder + + * nnvirtual.el (nnvirtual-update-xref-header): Simplify. + +2003-03-01 Jesper Harder + + * gnus-art.el (gnus-article-refer-article): Be more permissive. + +2003-03-01 ShengHuo ZHU + + * spam.el: Fix typo. + +2003-03-01 Satyaki Das + (Trivial patch.) + + * pgg-gpg.el (pgg-gpg-process-region): Insert process status into + errors-buffer. This produces a nicer error message in case of + problems. + +2003-03-01 Teodor Zlatanov + + * spam.el (spam-maybe-spam-stat-load, spam-maybe-spam-stat-load): + load stats iff spam-use-stat is on + + * spam.el: add spam-maybe-spam-stat-load to gnus-startup hook, + also use spam-maybe-spam-stat-load and spam-maybe-spam-stat-save + instead of spam-stat-load and spam-stat-save in the + gnus-get-new-news-hook and gnus-save-newsrc-hook, respectively + +2003-03-01 ShengHuo ZHU + + * mm-view.el (mm-inline-text): Ignore errors from enriched-decode. + +2003-03-01 Lars Magne Ingebrigtsen + + * message.el (message-make-fqdn): Protect against nil user-mail. + +2003-02-28 Vasily Korytov + + * gnus-art.el (gnus-boring-article-headers): New values: + 'to-list and 'cc-list. + +2003-02-28 Teodor Zlatanov + + * spam.el (spam-setup-widening): new function to set + nnimap-split-download-body, we add it to gnus-get-new-news-hook + (spam-list-of-statistical-checks): list of statistical splitter + checks + (spam-split): added a widen call when a statistical check is + enabled + +2003-02-28 Reiner Steib + + * gnus-msg.el (gnus-user-agent): Changed default to + 'emacs-gnus-type, renamed 'full. + +2003-02-28 ShengHuo ZHU + + * nnfolder.el (nnfolder-request-accept-article): Don't use + mail-header-unfold-field. + +2003-02-27 ShengHuo ZHU + + * imap.el (imap-ssl-open): Don't depend on ssl.el. + * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el. + +2003-02-26 Teodor Zlatanov + + * spam.el: add spam-stat-load to gnus-get-new-news-hook + (spam-split): remove spam-stat-load call + +2003-02-26 Simon Josefsson + + * gnus-sum.el (gnus-summary-toggle-header): Run + gnus-article-decode-hook instead of calling a-decode-encoded-words + directly (the latter is run as part of the former). + +2003-02-26 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-expire-group): Remove debug. + +2003-02-25 Jesper Harder + + * message.el (message-sendmail-envelope-from): New option. + (message-sendmail-envelope-from): New function. + (message-send-mail-with-sendmail): Use it. + +2003-02-25 Reiner Steib + + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added + compensation for TDMA addresses. + +2003-02-24 Reiner Steib + + * gnus-msg.el (gnus-user-agent): New variable. + (gnus-version-expose-system): Removed. Obsoleted by + `gnus-user-agent'. + (gnus-extended-version): Use `gnus-user-agent'. + +2003-02-24 Teodor Zlatanov + + * spam.el (spam-stat-register-spam-routine, + spam-stat-register-ham-routine): remove spam-stat-save + (spam-stat hook): add spam-stat-save to the gnus-save-newsrc-hook + +2003-02-24 Kevin Greiner + + * gnus-group.el (gnus-topic-mode-p): Fixed free variable + reference. + +2003-02-24 Kevin Greiner + + * nnheader.el (nnheader-find-nov-line): Changed midpoint + calculation to avoid integer overflow. + +2003-02-24 Reiner Steib + + * gnus-start.el (gnus-backup-startup-file): Fixed custom type. + +2003-02-24 Ted Zlatanov + * spam.el: disabled spam-get-article-as-filename + + From Michael Shields + + * gnus-group.el (gnus-group-is-exiting-without-update-p): New. + * gnus-sum.el (gnus-summary-exit-no-update): Use it. + * gnus-sum.el (gnus-summary-expire-articles): Use it. + * spam.el (spam-summary-prepare-exit): Use it. + * gnus.el (gnus-install-group-spam-parameters): New. + * spam.el (spam-group-ham-processor-copy-p): New. + * spam.el (spam-summary-prepare-exit): Support for ham copying. + * spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug + that would cause the current message to be moved if the group had + no spam. + * spam.el (spam-ham-move-routine): New `copy' argument. + +2003-02-24 Kai Gro,A_(Bjohann + From Martin Thornquist + + * gnus-topic.el (gnus-topic-select-group): Select last group if + after last group. + * gnus-group.el (gnus-group-select-group): Ditto. + +2003-02-24 Katsumi Yamaoka + + * gnus-art.el (popup-menu): Compiler macro for Emacs 20. + (gnus-article-refer-article): Use gnus-point-at-(b|e)ol instead of + point-at-(b|e)ol which aren't available in Emacs 20. + + * gnus-registry.el (puthash): Alias to cl-puthash for Emacs 20. + +2003-02-23 Kevin Greiner + + * gnus-start.el (gnus-activate-group): Re-enabled the catch error + clause of the condition-case statement. Errors connecting to a + server no longer terminate gnus. + + * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to + make its use obvious. Added no-nothing case to avoid + opening(closing) servers when already open(closed). + (gnus-agent-while-plugged): Added macro to facilitate internal use + of gnus-agent-toggle-plugged. + (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to + temporarily open servers. + (gnus-agent-get-undownloaded-list): Sort list of article numbers + as sorting gnus-newsgroup-headers is wrong. + (gnus-agent-summary-fetch-group): Use new gnus-agent-while-plugged + to temporarily open servers. Corrected logic to handle setting + gnus-agent-mark-unread-after-downloaded. + (gnus-agent-fetch-articles): Now handles headers with missing + article sizes and/or missing article lengths. Now clears the + message buffer when finished. + (gnus-agent-fetch-group-1): Position point before calling + gnus-summary-set-agent-mark. + (gnus-get-predicate): Corrected description, parameter is + predicate not category. + (gnus-agent-expire-group): Adapted the gnus-agent-expire-* code to + provide a separate single group expiration function. + (gnus-agent-regenerate-group): Now clears the message buffer when + finished. + +2003-02-23 Kai Gro,A_(Bjohann + + * gnus.el (gnus-agent-target-move-group-header): New variable. + * gnus-draft.el (gnus-draft-send): If special header + "X-Gnus-Agent-Target-Move-Group" is present, do like Gcc into + that group, instead of performing the regular sending functions. + +2003-02-23 Katsumi Yamaoka + + * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg. + +2003-02-20 Reiner Steib + + * message.el (message-user-fqdn, message-valid-fqdn-regexp): New + variables. + (message-make-fqdn): Use it. Improved validity check. + +2003-02-23 Lars Magne Ingebrigtsen + + * message.el (message-user-mail-address): Check whether + user-mail-address looks valid. + + * gnus-msg.el (gnus-mailing-list-followup-to): New function. + + * gnus-util.el (gnus-fetch-original-field): New function. + +2003-02-23 Kai Gro,A_(Bjohann + + * message.el (message-mode): \\(...\\) around additional + paragraph-separate alternative. + +2003-02-23 Jesper Harder + + * gnus-art.el (gnus-mime-button-commands): Add ellipsis. + (gnus-mime-button-menu): Define MIME popup menu with easy-menu to + display key bindings. + (gnus-mime-button-menu): Rewrite. + +2003-02-23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-url-regexp): Removed `. + +2003-02-23 Max Froumentin + + * gnus-art.el (gnus-button-url-regexp): Remove `, enter '. + +2003-02-23 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-action-on-part): Require a match + interactively. + + * gnus-start.el (gnus-save-newsrc-file): Use + gnus-backup-startup-file. + (gnus-backup-startup-file): New variable. + +2003-02-22 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-buffer-name): Moved function here. + + * gnus-draft.el (defun): Remove debug. + +2003-02-22 Jesper Harder + + * gnus-sum.el (gnus-summary-refer-article): Skip method if we + can't open server. + +2003-02-22 Lars Magne Ingebrigtsen + + * gnus-draft.el (defun): Configure posting styles. + + * gnus-start.el (gnus-get-unread-articles-in-group): Make sure + the entry for the group exists before we alter it. + +2003-02-22 Kai Gro,A_(Bjohann + + * message.el (message-mode): MML tags separate paragraphs. Small + change from David S Goldberg . + + * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort + `gnus-newsgroup-headers'. + + * gnus-art.el (gnus-article-refer-article): Grok more message id + formats. From Karl Pfl,Ad(Bsterer . + +2003-02-22 Jesper Harder + + * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't + use "path name". + +2003-02-21 Teodor Zlatanov + + * gnus-sum.el (gnus-summary-move-article) + (gnus-summary-expire-articles): send data header for article, not + just article ID + + * gnus-registry.el (gnus-registry-hashtb, gnus-register-action) + (gnus-register-spool-action): added hashtable of message ID keys + with message motion data + +2003-02-21 Florian Weimer + From Reiner Steib . + + * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New + variable, used in `gnus-button-mid-or-mail-heuristic'. + (gnus-button-mid-or-mail-heuristic): New function derived from + Florian Weimer's Perl script. + (gnus-button-handle-mid-or-mail): Allow a function instead of + 'guess. + (gnus-button-guessed-mid-regexp): Removed. + +2003-02-20 Katsumi Yamaoka + + * message.el (message-resend): Bind message-setup-hook to nil; + remove X-Draft-From header. + +2003-02-20 Jesper Harder + + * gnus-sum.el (gnus-simplify-subject-fully, gnus-subject-equal) + (gnus-newsgroup-undownloaded) + (gnus-summary-save-parts-default-mime, gnus-auto-select-next): + Doc fixes. + +2003-02-17 John Paul Wallington + + * gnus.el (gnus-shell-command-separator, gnus-email-address) + (gnus-default-charset, gnus-other-frame-parameters): Doc fixes. + +2003-02-20 Jesper Harder + + * gnus-spec.el (gnus-xmas-format): Use insert instead of + insert-string which is obsolete in Emacs 21.4. + + * message.el (message-cross-post-followup-to-header): do. + + * spam.el (spam-ifile-register-with-ifile) + (spam-stat-register-spam-routine) + (spam-stat-register-ham-routine) + (spam-bogofilter-register-with-bogofilter): do. + + * mailcap.el (mailcap-mime-data): Fix typo. + + * gnus-topic.el (gnus-topic-make-menu-bar): Add ellipsis. + +2003-02-19 Reiner Steib + + * gnus-cite.el (gnus-cite-unsightly-citation-regexp) + (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to + `gnus-cite-unsightly-citation-regexp'. + +2003-02-19 Katsumi Yamaoka + + * gnus-msg.el (gnus-copy-article-buffer): Copy an article header + even if there's just a header. + +2003-02-19 Jesper Harder + + * message.el (message-fix-before-sending): Fix highlighting of + illegible and invisible text. + + * gnus-util.el (gnus-multiple-choice): Separate choices with + ",,A (B". Suggested by Dan Jacobson . + +2003-02-18 Jesper Harder + + * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer. + +2003-02-18 Teodor Zlatanov + + * spam.el (spam-ham-move-routine) + (spam-mark-spam-as-expired-and-move-routine): use + gnus-summary-kill-process-mark and gnus-summary-yank-process-mark + around process-mark manipulation on the group + +2003-02-17 Kai Gro,A_(Bjohann + + * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart + submenu. + +2003-02-17 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-fetch): Reverse the return value of + the continuation question. + +2003-02-16 Lars Magne Ingebrigtsen + + * nndraft.el (nndraft-request-move-article): Bind + nnmh-allow-delete-final to t. + +2003-02-14 ShengHuo ZHU + + * mm-uu.el (mm-uu-uu-filename): Fix use of character constant. + +2003-02-11 Stefan Monnier + + * nntp.el (nntp-accept-process-output): Don't use point-max to get + the buffer's size. + +2003-01-31 Joe Buehler + + * nnheader.el: Added cygwin to system-type comparisons. + +2003-01-27 Juanma Barranquero + + * imap.el (imap-mailbox-status): Fix typo. + +2003-02-14 ShengHuo ZHU + + * gnus-art.el (gnus-article-prepare): Don't set agent mark if + online. + +2003-02-14 Kai Gro,A_(Bjohann + + * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all + commands. + * gnus-sum.el: Small change from Frank Weinberg + : + (gnus-auto-center-group): New variable. + (gnus-summary-read-group-1): Use it. + (gnus-summary-next-group): Fix docstring. + +2003-02-13 Katsumi Yamaoka + + * gnus-util.el (gnus-faces-at): Simplify. + +2003-02-13 Teodor Zlatanov + + * spam.el (spam-ham-move-routine) + (spam-mark-spam-as-expired-and-move-routine): made the article + move conditional, so it's not called even if there's nothing to move + +2003-02-13 Kai Gro,A_(Bjohann + + * message.el (message-unix-mail-delimiter): Accept any whitespace + after the email address and before the date; do not require the + space character. From Kurt B. Kaiser . + +2003-02-13 Katsumi Yamaoka + + * gnus-art.el (gnus-article-only-boring-p): Make sure that the + gnus-article-boring-faces variable is bound; use gnus-faces-at. + + * gnus-util.el (gnus-faces-at): New macro. + +2003-02-13 Michael Shields + + * gnus-cite.el + (gnus-cite-attribution-suffix, gnus-cite-parse): + Better handling for Microsoft citation styles. + (gnus-unsightly-citation-regexp): New. + +2003-02-12 Michael Shields + + * gnus-art.el (article-strip-banner): Strip both per-group and + per-user-address banners. + (article-really-strip-banner): New. + +2003-02-12 Michael Shields + + * gnus-sum.el (gnus-article-goto-next-page, + gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of + relying on the summary bindings of `n' and `p'. + +2003-02-12 Michael Shields + + * gnus-art.el (gnus-article-only-boring-p): New. + (gnus-article-skip-boring): New. + * gnus-cite.el (gnus-article-boring-faces): New. + * gnus-sum.el (gnus-summary-next-page): Use + gnus-article-only-boring-p. + +2003-02-12 Teodor Zlatanov + + * spam.el (spam-mark-spam-as-expired-and-move-routine) + (spam-ham-move-routine): unmark all articles before marking those + of interest and calling gnus-summary-move-article + +2003-02-12 Jesper Harder + + * gnus.el (gnus-kill-buffer): Move to gnus.el because it's + logically the complement of gnus-get-buffer-create and + gnus-add-buffer. + + * gnus-util.el (gnus-kill-buffer): do. + + * nnmail.el: Autoload gnus-kill-buffer. + +2003-02-11 Kevin Greiner + + * gnus-agent.el (gnus-summary-set-agent-mark): Added call to + gnus-summary-goto-subject as gnus-summary-update-mark operates on + the current LINE. + (gnus-agent-summary-fetch-group): Minimized the number of times + that the article is updated in the buffer. + +2003-02-11 Teodor Zlatanov + + * spam.el (spam-ham-move-routine): use the process-mark instead of + gnus-current-article when moving articles + (spam-mark-spam-as-expired-and-move-routine): ditto, use the process-mark + +2003-02-11 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-expire-articles): Recursive. + (gnus-topic-catchup-articles): Ditto. + (gnus-topic-mark-topic): Reverse recursive logic. + +2003-02-11 Jesper Harder + + * gnus-sum.el (gnus-summary-refer-thread): Handle case where + gnus-refer-thread-limit is t. + +2003-02-10 Jesper Harder + + * mm-util.el (mm-mule-charset-to-mime-charset): Use + sort-coding-systems to prefer utf-8 over utf-16. + +2003-02-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-expire-days): + gnus-request-move-article depends on gnus-agent-expire to clean up + the cache after moving the article. Therefore, g-a-e-d can NOT + default to nil or can gnus-agent-expire be disabled by doing so. + If you don't want to run gnus-agent-expire, don't call it. + (gnus-agent-expire): The broken test to disable gnus-agent-expire + when g-a-e-d was NOT nil was removed. + (gnus-agent-article-name): Removed unnecessary input test as + article IDs are always strings. + (gnus-agent-regenerate-group): Added check to protect against + servers that generate absurdly long article IDs. Valid IDs are + less than 10 digits to avoid overflow errors. Fixed logic error + when ensuring that the final article ID is present in the new + alist. + +2003-02-09 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the + next line after finding the parent. + +2003-02-08 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bumped. + 2003-02-08 23:23:27 Lars Magne Ingebrigtsen * gnus.el: Oort Gnus v0.15 is released. @@ -34,8 +1001,6 @@ * gnus-registry.el (regtest-nnmail): use gnus-internal-registry-spool-current-method - - 2003-02-07 Lars Magne Ingebrigtsen * mail-source.el (mail-source-fetch): Typo fix. @@ -55,16 +1020,16 @@ (gnus-group-full-name): always get a group's full name (gnus-group-guess-full-name): shortcut, using just the group name - * gnus-sum.el (gnus-summary-article-move-hook) - (gnus-summary-article-delete-hook) + * gnus-sum.el (gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) (gnus-summary-article-expire-hook): new hooks - (gnus-summary-move-article, gnus-summary-expire-articles) + (gnus-summary-move-article, gnus-summary-expire-articles) (gnus-summary-delete-article): invoke the new hooks 2003-02-07 Frank Weinberg - * gnus-art.el (gnus-article-refer-article): Strip leading "news:" - from message-ID + * gnus-art.el (gnus-article-refer-article): Strip leading "news:" + from message-ID 2003-02-07 Jesper Harder @@ -81,7 +1046,7 @@ (mail-source-ignore-errors): New variable. * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current - articles. + articles. * gnus-msg.el (gnus-version-expose-system): Change default. @@ -133,11 +1098,11 @@ "delete-if" is misleading because it isn't actually destructive. * gnus-topic.el (gnus-group-prepare-topics): Use new name. - + * nnmail.el (nnmail-purge-split-history): do. * gnus-win.el (gnus-get-buffer-window): do. - + * gnus-sum.el (gnus-simplify-whitespace): Remove unnecessary let-binding. (gnus-simplify-all-whitespace): do. @@ -219,7 +1184,7 @@ * gnus.el: Use gnus-prin1-to-string throughout. * gnus-util.el (gnus-prin1-to-string): Bind print-length and - print-level. + print-level. * gnus-art.el (article-display-x-face): Removed grey x-face stuff. (gnus-treat-display-grey-xface): Removed. @@ -251,10 +1216,10 @@ 2003-01-27 Teodor Zlatanov - * spam.el (spam-check-blackholes) + * spam.el (spam-check-blackholes) (spam-blackhole-good-server-regex): new variable to skip some IPs when checking blackholes; use it - (spam-check-bogofilter-headers) + (spam-check-bogofilter-headers) (spam-bogofilter-bogosity-positive-spam-header): new variable, in case more X-Bogosity is used than just "Yes/No" (spam-ham-move-routine): semi-fixed, only first article is @@ -264,15 +1229,15 @@ * gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers as well. - + * gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer. - + * gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do. - + * gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do. - + * gnus-bcklg.el (gnus-backlog-shutdown): do. - + * gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do. 2003-01-26 Lars Magne Ingebrigtsen @@ -280,7 +1245,7 @@ * gnus-fun.el (gnus-face-encode): New function. (gnus-convert-png-to-face): Use it. - * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. + * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. 2003-01-26 Jesper Harder @@ -321,7 +1286,7 @@ 2003-01-24 Lars Magne Ingebrigtsen * nnheader.el (nnheader-directory-separator-character): New - variable. + variable. 2003-01-24 Kai Gro,A_(Bjohann @@ -338,7 +1303,7 @@ (gnus-agent-regenerate-group): Reformat to keep under eighty columns. Reword docstrings so that first line is under eighty chars and a complete sentence. Still need to work on the rear - end of the file, in particular gnus-agent-expire. + end of the file, in particular gnus-agent-expire. 2003-01-24 Lars Magne Ingebrigtsen @@ -358,7 +1323,7 @@ 2003-01-24 Teodor Zlatanov - * spam.el (spam-check-blackholes, spam-split) + * spam.el (spam-check-blackholes, spam-split) (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): added gnus-message calls to show to users what spam.el is doing @@ -370,7 +1335,7 @@ 2003-01-24 Lars Magne Ingebrigtsen * gnus-art.el (gnus-mime-security-show-details): Toggle showing - details. + details. 2003-01-23 Lars Magne Ingebrigtsen @@ -382,15 +1347,15 @@ * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Doc fix. * gnus-async.el (gnus-async-wait-for-article): Don't use a - timeout. + timeout. - * nntp.el (nntp-accept-process-output): Removed timeout. + * nntp.el (nntp-accept-process-output): Removed timeout. (nntp-read-timeout): New variable. (nntp-accept-process-output): Use it. * gnus-sum.el (gnus-data-find-list): Remove *. -2002-01-23 Kevin Greiner +2003-01-23 Kevin Greiner * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I introduced on 2002-01-22. @@ -398,7 +1363,7 @@ 2003-01-23 Teodor Zlatanov - * spam.el (spam-check-regex-headers, spam-list-of-checks) + * spam.el (spam-check-regex-headers, spam-list-of-checks) (spam-regex-headers-spam, spam-regex-headers-ham): added spam/ham checks of incoming mail based on simple header regexp matching @@ -406,7 +1371,7 @@ * gnus-sum.el (gnus-spam-mark): set to `$' -2002-01-22 Kevin Greiner +2003-01-22 Kevin Greiner * gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes gnus-newsgroup-unfetched, the list of articles whose headers have @@ -425,7 +1390,7 @@ gnus-summary-first-subject call to match new API. (gnus-summary-first-unseen-or-unread-subject): Ditto. (gnus-summary-catchup): Do not mark unfetched articles as read. - + 2003-01-22 Jesper Harder * gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook): @@ -494,14 +1459,14 @@ * mailcap.el (mailcap-print-command): lpr-command might be unbound in XEmacs. -2002-01-18 Kevin Greiner +2003-01-18 Kevin Greiner * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form. * gnus-sum.el (gnus-summary-update-article-line): Fixed calculation of net characters added for use in the gnus-data structure. - + 2003-01-18 Kai Gro,A_(Bjohann * nnmail.el (nnmail-process-unix-mail-format): Improve error @@ -509,7 +1474,7 @@ 2003-01-17 Lars Magne Ingebrigtsen - * gnus-art.el (gnus-article-followup-with-original): Clean up. + * gnus-art.el (gnus-article-followup-with-original): Clean up. (gnus-article-reply-with-original): Ditto. * gnus-sum.el (gnus-summary-catchup): Make sure downloadable, @@ -517,7 +1482,7 @@ 2003-01-17 Simon Josefsson - * gnus-fun.el (gnus-x-face-from-file): + * gnus-fun.el (gnus-x-face-from-file): (gnus-face-from-file): Suggest image format in minibuffer prompt. * gnus-fun.el (gnus-convert-image-to-x-face-command) @@ -542,8 +1507,8 @@ 2003-01-16 Simon Josefsson - * gnus-fun.el (gnus-convert-image-to-x-face-command) - (gnus-convert-image-to-face-command, gnus-x-face-from-file) + * gnus-fun.el (gnus-convert-image-to-x-face-command) + (gnus-convert-image-to-face-command, gnus-x-face-from-file) (gnus-face-from-file): Doc fix; don't mention image format. 2003-01-16 Teodor Zlatanov @@ -554,31 +1519,31 @@ (spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis 2003-01-15 ShengHuo ZHU - + * gnus-agent.el: Don't use `path'. From the GNU coding standards: - + Please do not use the term ``pathname'' that is used in Unix documentation; use ``file name'' (two words) instead. We use the term ``path'' only for search paths, which are lists of directory names. * nnsoup.el (nnsoup-file-name): Ditto. - + * nnmail.el (nnmail-pathname-coding-system): Ditto. - (nnmail-group-pathname): Ditto. - + (nnmail-group-pathname): Ditto. + * nnimap.el (nnimap-group-overview-filename): Ditto. - + * nnheader.el (nnheader-pathname-coding-system): Ditto. (nnheader-group-pathname): Ditto. - + * nnfolder.el (nnfolder-group-pathname): Ditto. - + * gnus.el (gnus-home-directory): Ditto. - + * gnus-group.el (gnus-group-icon-list): Ditto. - + 2003-01-16 Jesper Harder * gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type. @@ -593,12 +1558,12 @@ 2003-01-15 Teodor Zlatanov - * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header) + * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header) (spam-bogofilter-database-directory): new variables - (spam-check-bogofilter-headers, spam-check-bogofilter) - (spam-bogofilter-register-with-bogofilter) - (spam-bogofilter-register-spam-routine) - (spam-bogofilter-register-ham-routine) + (spam-check-bogofilter-headers, spam-check-bogofilter) + (spam-bogofilter-register-with-bogofilter) + (spam-bogofilter-register-spam-routine) + (spam-bogofilter-register-ham-routine) (spam-group-ham-processor-bogofilter-p): new functions for the new Bogofilter interface (spam-summary-prepare-exit): use the new Bogofilter functions @@ -628,14 +1593,14 @@ 2003-01-15 Lars Magne Ingebrigtsen * message.el (message-send): Don't warn about duplicates when - superseding. + superseding. 2003-01-15 Simon Josefsson * nnimap.el (nnimap-split-download-body): New variable. (nnimap-split-articles): Use it. -2002-01-14 Kevin Greiner +2003-01-14 Kevin Greiner * gnus-agent.el (gnus-agent-check-overview-buffer): This data integrity checker was incorrectly flagging, and removing, articles @@ -649,12 +1614,12 @@ 2003-01-14 Lars Magne Ingebrigtsen - * gnus-audio.el (gnus-audio-au-player): Use executable-find. + * gnus-audio.el (gnus-audio-au-player): Use executable-find. 2003-01-13 Jhair Tocancipa Triana * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use - /usr/bin/play as default player. + /usr/bin/play as default player. (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play. 2003-01-14 Katsumi Yamaoka @@ -662,11 +1627,11 @@ * gnus-msg.el (gnus-inews-add-send-actions): Allow a list of articles to be marked as well. -2002-01-14 Kevin Greiner +2003-01-14 Kevin Greiner * gnus-agent.el (gnus-agent-get-undownloaded-list): Include the fictious headers generated by nnagent (ie. Undownloaded Article ####) in the list of articles that have not been downloaded. - + * gnus-int.el (): Added require declarations to resolve compile-time warnings. (gnus-open-server): If the server status is set to offline, @@ -690,13 +1655,13 @@ 2003-01-13 Romain FRANCOISE - * gnus-fun.el (gnus-x-face-from-file): Quote file name. + * gnus-fun.el (gnus-x-face-from-file): Quote file name. (gnus-face-from-file): Ditto. 2003-01-13 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-articles-to-read): Don't just apply - gnus-alter-articles-to-read-function to the unread articles. + gnus-alter-articles-to-read-function to the unread articles. 2003-01-13 Reiner Steib @@ -757,7 +1722,7 @@ 2003-01-12 Fran,Ag(Bois-David Collin * mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer. - + 2003-01-12 Lars Magne Ingebrigtsen * gnus-fun.el (gnus-face-from-file): Autoload. @@ -791,13 +1756,13 @@ * gnus-msg.el (gnus-inews-do-gcc): Don't try to mark GCC's as read if Gnus isn't alive. -2002-01-11 Kevin Greiner +2003-01-11 Kevin Greiner * gnus-agent.el (gnus-agent-fetch-group-1): Remove downloadable marks from articles that are already stored in the agent. (gnus-agent-backup-overview-buffer): New debug tool. Creates a backup copy of an invalid .overview file for later analysis. - + 2003-01-12 Gregorio Gervasio, Jr. * gnus-sum.el (gnus-summary-exit): Reverse change to make group @@ -829,7 +1794,7 @@ 2003-01-11 Lars Magne Ingebrigtsen * gnus-art.el (gnus-display-mime): Use the mime emulation - variable. + variable. * gnus-sum.el (gnus-article-emulate-mime): New variable. @@ -847,7 +1812,7 @@ * message.el (message-check-news-header-syntax): Compute the header length correctly. -2002-01-10 Kevin Greiner +2003-01-10 Kevin Greiner * gnus-agent.el (gnus-agent-expire): Do not remove article from alist when keeping fetched article file. @@ -884,7 +1849,7 @@ 2003-01-10 Teodor Zlatanov * spam.el (spam-use-stat): new variable - (spam-group-spam-processor-stat-p) + (spam-group-spam-processor-stat-p) (spam-group-ham-processor-stat-p): new convenience functions (spam-summary-prepare-exit): add spam/ham processors to sequence (spam-list-of-checks): add spam-use-stat to list of checks @@ -929,7 +1894,7 @@ (spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0. Changed copyright statement to FSF. -2002-01-09 Kevin Greiner +2003-01-09 Kevin Greiner * gnus-agent.el (gnus-agent-catchup): Do not mark cached nor processable articles as read. @@ -1085,7 +2050,7 @@ * gnus-sum.el (gnus-summary-make-menu-bar): Added gnus-summary-refer-thread to thread menu. -2002-01-07 Kevin Greiner +2003-01-07 Kevin Greiner * gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a summary buffer, articles that cannot be fetched are marked as @@ -1136,7 +2101,7 @@ gnus-sieve-crosspost. One-line patch from Steinar Bang . -2002-01-06 Kevin Greiner +2003-01-06 Kevin Greiner * gnus.el: Renamed gnus-summary-*-uncached-face as gnus-summary-*-undownloaded-face to avoid confusing the agent with @@ -1144,7 +2109,7 @@ * gnus-sum.el: Ditto. -2002-01-06 Kevin Greiner +2003-01-06 Kevin Greiner * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution in either the group or summary buffer. @@ -2847,7 +3812,6 @@ * gnus-sum.el (t): Add gnus-group-fetch-charter and gnus-group-fetch-control to summary key map and menu. - 2002-10-03 Paul Jarc * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article @@ -12709,7 +13673,7 @@ * mail-source.el (mail-sources): Revert to nil. - * nnmail (nnmail-spool-file): Revert to `((file))'. + * nnmail.el (nnmail-spool-file): Revert to `((file))'. * qp.el: Don't require mm-util. (quoted-printable-decode-region): Rewritten. diff --git a/lisp/canlock.el b/lisp/canlock.el index 13e7fbc..b52afed 100644 --- a/lisp/canlock.el +++ b/lisp/canlock.el @@ -125,22 +125,6 @@ buffer does not look like a news message." "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes." (canlock-string-as-unibyte (funcall canlock-sha1-function message))) -(defvar canlock-read-passwd nil) -(defun canlock-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt - (if args - (apply 'format prompt args) - prompt))) - (unless canlock-read-passwd - (if (or (fboundp 'read-passwd) (load "passwd" t)) - (setq canlock-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq canlock-read-passwd 'ange-ftp-read-passwd))) - (funcall canlock-read-passwd prompt))) - (defun canlock-make-cancel-key (message-id password) "Make a Cancel-Key header." (when (> (length password) 20) @@ -231,7 +215,7 @@ message." (message "There are no Message-ID(s)") (unless password (setq password (or canlock-password - (canlock-read-passwd + (read-passwd "Password for Canlock: ")))) (if (or (not (stringp password)) (zerop (length password))) (message "Password for Canlock is bad") @@ -284,7 +268,7 @@ nil instead of to signal an error by setting the option (error "%s" errmsg)) (setq password (or canlock-password-for-verify - (canlock-read-passwd "Password for Canlock: "))) + (read-passwd "Password for Canlock: "))) (if (or (not (stringp password)) (zerop (length password))) (progn (setq errmsg "Password for Canlock is bad") diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 3ef12c8..acbe088 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -30,6 +30,7 @@ (require 'gnus-sum) (require 'gnus-score) (require 'gnus-srvr) +(require 'gnus-util) (eval-when-compile (if (featurep 'xemacs) (require 'itimer) @@ -37,7 +38,9 @@ (require 'cl)) (eval-and-compile - (autoload 'gnus-server-update-server "gnus-srvr")) + (autoload 'gnus-server-update-server "gnus-srvr") + (autoload 'gnus-agent-customize-category "gnus-cus") +) (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." @@ -54,19 +57,23 @@ :group 'gnus-agent :type 'hook) +(defcustom gnus-agent-fetched-hook nil + "Hook run when finished fetching articles." + :group 'gnus-agent + :type 'hook) + (defcustom gnus-agent-handle-level gnus-level-subscribed "Groups on levels higher than this variable will be ignored by the Agent." :group 'gnus-agent :type 'integer) -(defcustom gnus-agent-expire-days nil +(defcustom gnus-agent-expire-days 7 "Read articles older than this will be expired. This can also be a list of regexp/day pairs. The regexps will be -matched against group names. If nil, articles in the agent cache are -never expired." +matched against group names." :group 'gnus-agent :type '(choice (number :tag "days") - (const :tag "never" nil))) + (sexp :tag "List" nil))) (defcustom gnus-agent-expire-all nil "If non-nil, also expire unread, ticked and dormant articles. @@ -150,12 +157,23 @@ this limit." :group 'gnus-agent :type 'integer) +(defcustom gnus-agent-enable-expiration 'ENABLE + "The default expiration state for each group. +When set to ENABLE, the default, `gnus-agent-expire' will expire old +contents from a group's local storage. This value may be overridden +to disable expiration in specific categories, topics, and groups. Of +course, you could change gnus-agent-enable-expiration to DISABLE then +enable expiration per categories, topics, and groups." + :group 'gnus-agent + :type '(radio (const :format "Enable " ENABLE) + (const :format "Disable " DISABLE))) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) (defvar gnus-agent-buffer-alist nil) (defvar gnus-agent-article-alist nil -"An assoc list identifying the articles whose headers have been fetched. + "An assoc list identifying the articles whose headers have been fetched. If successfully fetched, these headers will be stored in the group's overview file. The key of each assoc pair is the article ID, the value of each assoc pair is a flag indicating whether the identified article has been downloaded @@ -164,8 +182,7 @@ NOTES: 1) The last element of this list can not be expired as some routines (for example, get-agent-fetch-headers) use the last value to track which articles have had their headers retrieved. -2) The gnus-agent-regenerate may destructively modify the value. -") +2) The function `gnus-agent-regenerate' may destructively modify the value.") (defvar gnus-agent-group-alist nil) (defvar gnus-category-alist nil) (defvar gnus-agent-current-history nil) @@ -247,6 +264,107 @@ node `(gnus)Server Buffer'.") (file-name-as-directory (expand-file-name "agent.lib" (gnus-agent-directory))))) +(defun gnus-agent-cat-set-property (category property value) + (if value + (setcdr (or (assq property category) + (let ((cell (cons property nil))) + (setcdr category (cons cell (cdr category))) + cell)) value) + (let ((category category)) + (while (cond ((eq property (caadr category)) + (setcdr category (cddr category)) + nil) + (t + (setq category (cdr category))))))) + category) + +(defmacro gnus-agent-cat-defaccessor (name prop-name) + "Define accessor and setter methods for manipulating a list of the form +\(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)). +Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be +manipulated as follows: + (func LIST): Returns VALUE1 + (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1." + `(progn (defmacro ,name (category) + (list (quote cdr) (list (quote assq) + (quote (quote ,prop-name)) category))) + + (define-setf-method ,name (category) + (let* ((--category--temp-- (gensym "--category--")) + (--value--temp-- (gensym "--value--"))) + (list (list --category--temp--) ; temporary-variables + (list category) ; value-forms + (list --value--temp--) ; store-variables + (let* ((category --category--temp--) ; store-form + (value --value--temp--)) + (list (quote gnus-agent-cat-set-property) + category + (quote (quote ,prop-name)) + value)) + (list (quote ,name) --category--temp--) ; access-form + ))))) + +(defmacro gnus-agent-cat-name (category) + `(car ,category)) + +(gnus-agent-cat-defaccessor + gnus-agent-cat-days-until-old agent-days-until-old) +(gnus-agent-cat-defaccessor + gnus-agent-cat-enable-expiration agent-enable-expiration) +(gnus-agent-cat-defaccessor + gnus-agent-cat-groups agent-groups) +(gnus-agent-cat-defaccessor + gnus-agent-cat-high-score agent-high-score) +(gnus-agent-cat-defaccessor + gnus-agent-cat-length-when-long agent-length-when-long) +(gnus-agent-cat-defaccessor + gnus-agent-cat-length-when-short agent-length-when-short) +(gnus-agent-cat-defaccessor + gnus-agent-cat-low-score agent-low-score) +(gnus-agent-cat-defaccessor + gnus-agent-cat-predicate agent-predicate) +(gnus-agent-cat-defaccessor + gnus-agent-cat-score-file agent-score-file) + +(defsetf gnus-agent-cat-groups (category) (groups) + (list 'gnus-agent-set-cat-groups category groups)) + +(defun gnus-agent-set-cat-groups (category groups) + (unless (eq groups 'ignore) + (let ((new-g groups) + (old-g (gnus-agent-cat-groups category))) + (cond ((eq new-g old-g) + ;; gnus-agent-add-group is fiddling with the group + ;; list. Still, Im done. + nil + ) + ((eq new-g (cdr old-g)) + ;; gnus-agent-add-group is fiddling with the group list + (setcdr (or (assq 'agent-groups category) + (let ((cell (cons 'agent-groups nil))) + (setcdr category (cons cell (cdr category))) + cell)) new-g)) + (t + (let ((groups groups)) + (while groups + (let* ((group (pop groups)) + (old-category (gnus-group-category group))) + (if (eq category old-category) + nil + (setf (gnus-agent-cat-groups old-category) + (delete group (gnus-agent-cat-groups + old-category)))))) + ;; Purge cache as preceeding loop invalidated it. + (setq gnus-category-group-cache nil)) + + (setcdr (or (assq 'agent-groups category) + (let ((cell (cons 'agent-groups nil))) + (setcdr category (cons cell (cdr category))) + cell)) groups)))))) + +(defsubst gnus-agent-cat-make (name) + (list name '(agent-predicate . false))) + ;;; Fetching setup functions. (defun gnus-agent-start-fetch () @@ -303,7 +421,12 @@ node `(gnus)Server Buffer'.") buffer)))) minor-mode-map-alist)) (when (eq major-mode 'gnus-group-mode) - (gnus-agent-toggle-plugged gnus-plugged)) + (let ((init-plugged gnus-plugged)) + ;; g-a-t-p does nothing when gnus-plugged isn't changed. + ;; Therefore, make certain that the current value does not + ;; match the desired initial value. + (setq gnus-plugged :unknown) + (gnus-agent-toggle-plugged init-plugged))) (gnus-run-hooks 'gnus-agent-mode-hook (intern (format "gnus-agent-%s-mode-hook" buffer))))) @@ -327,10 +450,14 @@ node `(gnus)Server Buffer'.") ["Toggle plugged" gnus-agent-toggle-plugged t] ["Toggle group plugged" gnus-agent-toggle-group-plugged t] ["List categories" gnus-enter-category-buffer t] + ["Add (current) group to category" gnus-agent-add-group t] + ["Remove (current) group from category" gnus-agent-remove-group t] ["Send queue" gnus-group-send-queue gnus-plugged] ("Fetch" ["All" gnus-agent-fetch-session gnus-plugged] - ["Group" gnus-agent-fetch-group gnus-plugged]))))) + ["Group" gnus-agent-fetch-group gnus-plugged]) + ["Synchronize flags" gnus-agent-synchronize-flags t] + )))) (defvar gnus-agent-summary-mode-map (make-sparse-keymap)) (gnus-define-keys gnus-agent-summary-mode-map @@ -377,28 +504,40 @@ node `(gnus)Server Buffer'.") (make-mode-line-mouse-map mouse-button mouse-func)) string)) -(defun gnus-agent-toggle-plugged (plugged) +(defun gnus-agent-toggle-plugged (set-to) "Toggle whether Gnus is unplugged or not." (interactive (list (not gnus-plugged))) - (if plugged - (progn - (setq gnus-plugged plugged) - (gnus-run-hooks 'gnus-agent-plugged-hook) - (setcar (cdr gnus-agent-mode-status) - (gnus-agent-make-mode-line-string " Plugged" - 'mouse-2 - 'gnus-agent-toggle-plugged)) - (gnus-agent-go-online gnus-agent-go-online) - (gnus-agent-possibly-synchronize-flags)) - (gnus-agent-close-connections) - (setq gnus-plugged plugged) - (gnus-run-hooks 'gnus-agent-unplugged-hook) - (setcar (cdr gnus-agent-mode-status) - (gnus-agent-make-mode-line-string " Unplugged" - 'mouse-2 - 'gnus-agent-toggle-plugged))) + (cond ((eq set-to gnus-plugged) + nil) + (set-to + (setq gnus-plugged set-to) + (gnus-run-hooks 'gnus-agent-plugged-hook) + (setcar (cdr gnus-agent-mode-status) + (gnus-agent-make-mode-line-string " Plugged" + 'mouse-2 + 'gnus-agent-toggle-plugged)) + (gnus-agent-go-online gnus-agent-go-online) + (gnus-agent-possibly-synchronize-flags)) + (t + (gnus-agent-close-connections) + (setq gnus-plugged set-to) + (gnus-run-hooks 'gnus-agent-unplugged-hook) + (setcar (cdr gnus-agent-mode-status) + (gnus-agent-make-mode-line-string " Unplugged" + 'mouse-2 + 'gnus-agent-toggle-plugged)))) (set-buffer-modified-p t)) +(defmacro gnus-agent-while-plugged (&rest body) + `(let ((original-gnus-plugged gnus-plugged)) + (unwind-protect + (progn (gnus-agent-toggle-plugged t) + ,@body) + (gnus-agent-toggle-plugged original-gnus-plugged)))) + +(put 'gnus-agent-while-plugged 'lisp-indent-function 0) +(put 'gnus-agent-while-plugged 'edebug-form-spec '(body)) + (defun gnus-agent-close-connections () "Close all methods covered by the Gnus agent." (let ((methods gnus-agent-covered-methods)) @@ -443,7 +582,7 @@ minor mode in all Gnus buffers." (unless gnus-agent-send-mail-function (setq gnus-agent-send-mail-function (or message-send-mail-real-function - message-send-mail-function) + message-send-mail-function) message-send-mail-real-function 'gnus-agent-send-mail)) (unless gnus-agent-covered-methods @@ -540,21 +679,15 @@ be a select method." (defun gnus-agent-fetch-group (&optional group) "Put all new articles in GROUP into the Agent." (interactive (list (gnus-group-group-name))) - (let ((state gnus-plugged)) - (unwind-protect - (progn - (setq group (or group gnus-newsgroup-name)) - (unless group - (error "No group on the current line")) - (unless state - (gnus-agent-toggle-plugged gnus-plugged)) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (gnus-agent-with-fetch - (gnus-agent-fetch-group-1 group gnus-command-method) - (gnus-message 5 "Fetching %s...done" group)))) - (when (and (not state) - gnus-plugged) - (gnus-agent-toggle-plugged gnus-plugged))))) + (setq group (or group gnus-newsgroup-name)) + (unless group + (error "No group on the current line")) + + (gnus-agent-while-plugged + (let ((gnus-command-method (gnus-find-method-for-group group))) + (gnus-agent-with-fetch + (gnus-agent-fetch-group-1 group gnus-command-method) + (gnus-message 5 "Fetching %s...done" group))))) (defun gnus-agent-add-group (category arg) "Add the current group to an agent category." @@ -571,10 +704,12 @@ be a select method." c groups) (gnus-group-iterate arg (lambda (group) - (when (cadddr (setq c (gnus-group-category group))) - (setf (cadddr c) (delete group (cadddr c)))) + (when (gnus-agent-cat-groups (setq c (gnus-group-category group))) + (setf (gnus-agent-cat-groups c) + (delete group (gnus-agent-cat-groups c)))) (push group groups))) - (setf (cadddr cat) (nconc (cadddr cat) groups)) + (setf (gnus-agent-cat-groups cat) + (nconc (gnus-agent-cat-groups cat) groups)) (gnus-category-write))) (defun gnus-agent-remove-group (arg) @@ -583,8 +718,9 @@ be a select method." (let (c) (gnus-group-iterate arg (lambda (group) - (when (cadddr (setq c (gnus-group-category group))) - (setf (cadddr c) (delete group (cadddr c)))))) + (when (gnus-agent-cat-groups (setq c (gnus-group-category group))) + (setf (gnus-agent-cat-groups c) + (delete group (gnus-agent-cat-groups c)))))) (gnus-category-write))) (defun gnus-agent-synchronize-flags () @@ -614,8 +750,7 @@ be a select method." (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method)) (while (not (eobp)) (if (null (eval (read (current-buffer)))) - (progn (forward-line) - (kill-line -1)) + (gnus-delete-line) (write-file (gnus-agent-lib-file "flags")) (error "Couldn't set flags from file %s" (gnus-agent-lib-file "flags")))) @@ -734,32 +869,36 @@ article's mark is toggled." t) (t (memq article gnus-newsgroup-downloadable))))) - (gnus-summary-update-mark - (if unmark - (progn - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (gnus-article-mark article)) - (progn - (setq gnus-newsgroup-downloadable - (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)) - gnus-downloadable-mark) - ) - 'unread))) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-mark + (if unmark + (progn + (setq gnus-newsgroup-downloadable + (delq article gnus-newsgroup-downloadable)) + (gnus-article-mark article)) + (progn + (setq gnus-newsgroup-downloadable + (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)) + gnus-downloadable-mark) + ) + 'unread)))) (defun gnus-agent-get-undownloaded-list () "Construct list of articles that have not been downloaded." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (set (make-local-variable 'gnus-newsgroup-agentized) (gnus-agent-method-p gnus-command-method)) + (when (set (make-local-variable 'gnus-newsgroup-agentized) + (gnus-agent-method-p gnus-command-method)) (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name)) - (headers gnus-newsgroup-headers) + (headers (sort (mapcar (lambda (h) + (mail-header-number h)) + gnus-newsgroup-headers) '<)) (undownloaded (list nil)) (tail-undownloaded undownloaded) (unfetched (list nil)) (tail-unfetched unfetched)) (while (and alist headers) (let ((a (caar alist)) - (h (mail-header-number (car headers)))) + (h (car headers))) (cond ((< a h) ;; Ignore IDs in the alist that are not being ;; displayed in the summary. @@ -782,7 +921,7 @@ article's mark is toggled." (gnus-agent-append-to-list tail-undownloaded a))))) (while headers - (let ((num (mail-header-number (pop headers)))) + (let ((num (pop headers))) (gnus-agent-append-to-list tail-undownloaded num) (gnus-agent-append-to-list tail-unfetched num))) @@ -800,7 +939,7 @@ downloadable." gnus-newsgroup-cached) (setq articles (gnus-sorted-ndifference (gnus-sorted-ndifference - (copy-sequence articles) + (gnus-copy-sequence articles) gnus-newsgroup-downloadable) gnus-newsgroup-cached))) @@ -815,7 +954,7 @@ downloadable." (setq gnus-newsgroup-downloadable (let* ((dl gnus-newsgroup-downloadable) (gnus-newsgroup-downloadable - (sort (copy-sequence gnus-newsgroup-processable) '<)) + (sort (gnus-copy-sequence gnus-newsgroup-processable) '<)) (fetched-articles (gnus-agent-summary-fetch-group))) ;; The preceeding call to (gnus-agent-summary-fetch-group) ;; updated gnus-newsgroup-downloadable to remove each @@ -837,33 +976,34 @@ Optional arg ALL, if non-nil, means to fetch all articles." (if all gnus-newsgroup-articles gnus-newsgroup-downloadable)) (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)) - (state gnus-plugged) fetched-articles) - (unwind-protect - (progn - (unless state - (gnus-agent-toggle-plugged t)) - (unless articles - (error "No articles to download")) - (gnus-agent-with-fetch - (setq gnus-newsgroup-undownloaded - (gnus-sorted-ndifference - gnus-newsgroup-undownloaded - (setq fetched-articles - (gnus-agent-fetch-articles - gnus-newsgroup-name articles))))) - (save-excursion - - (dolist (article articles) - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (if gnus-agent-mark-unread-after-downloaded - (gnus-summary-mark-article article gnus-unread-mark)) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-download-mark article))))) - (when (and (not state) - gnus-plugged) - (gnus-agent-toggle-plugged nil))) + (gnus-agent-while-plugged + (unless articles + (error "No articles to download")) + (gnus-agent-with-fetch + (setq gnus-newsgroup-undownloaded + (gnus-sorted-ndifference + gnus-newsgroup-undownloaded + (setq fetched-articles + (gnus-agent-fetch-articles + gnus-newsgroup-name articles))))) + (save-excursion + (dolist (article articles) + (let ((was-marked-downloadable + (memq article gnus-newsgroup-downloadable))) + (cond (gnus-agent-mark-unread-after-downloaded + (setq gnus-newsgroup-downloadable + (delq article gnus-newsgroup-downloadable)) + + ;; The downloadable mark is implemented as a + ;; type of read mark. Therefore, marking the + ;; article as unread is sufficient to clear + ;; its downloadable flag. + (gnus-summary-mark-article article gnus-unread-mark)) + (was-marked-downloadable + (gnus-summary-set-agent-mark article t))) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-download-mark article)))))) fetched-articles)) (defun gnus-agent-fetch-selected-article () @@ -877,9 +1017,7 @@ This can be added to `gnus-select-article-hook' or (list gnus-current-article)) (setq gnus-newsgroup-undownloaded (delq gnus-current-article gnus-newsgroup-undownloaded)) - (gnus-summary-update-article-line - gnus-current-article - (gnus-summary-article-header gnus-current-article)))))) + (gnus-summary-update-line gnus-current-article))))) ;;; ;;; Internal functions @@ -1043,7 +1181,18 @@ This can be added to `gnus-select-article-hook' or (setq current-set-size (+ current-set-size (if (= header-number article) - (mail-header-chars (car headers)) + (let ((char-size (mail-header-chars + (car headers)))) + (if (<= char-size 0) + ;; The char size was missing/invalid, + ;; assume a worst-case situation of + ;; 65 char/line. If the line count + ;; is missing, arbitrarily assume a + ;; size of 1000 characters. + (max (* 65 (mail-header-lines + (car headers))) + 1000) + char-size)) 0)))) (setcar selected-sets (nreverse (car selected-sets))) (setq selected-sets (cons nil selected-sets) @@ -1064,7 +1213,7 @@ This can be added to `gnus-select-article-hook' or (gnus-make-directory dir) (gnus-message 7 "Fetching articles for %s..." group) - + (unwind-protect (while (setq articles (pop selected-sets)) ;; Fetch the articles from the backend. @@ -1125,7 +1274,8 @@ This can be added to `gnus-select-article-hook' or (widen) (pop pos)))) - (gnus-agent-save-alist group (cdr fetched-articles) date)) + (gnus-agent-save-alist group (cdr fetched-articles) date) + (gnus-message 7 "")) (cdr fetched-articles)))))) (defun gnus-agent-crosspost (crosses article &optional date) @@ -1234,6 +1384,24 @@ and that there are no duplicates." (insert "\n")) (pop gnus-agent-group-alist)))) +(defun gnus-agent-find-parameter (group symbol) + "Search for GROUPs SYMBOL in the group's parameters, the group's +topic parameters, the group's category, or the customizable +variables. Returns the first non-nil value found." + (or (gnus-group-find-parameter group symbol t) + (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t) + (symbol-value + (cdr + (assq symbol + '((agent-short-article . gnus-agent-short-article) + (agent-long-article . gnus-agent-long-article) + (agent-low-score . gnus-agent-low-score) + (agent-high-score . gnus-agent-high-score) + (agent-days-until-old . gnus-agent-expire-days) + (agent-enable-expiration + . gnus-agent-enable-expiration) + (agent-predicate . gnus-agent-predicate))))))) + (defun gnus-agent-fetch-headers (group &optional force) "Fetch interesting headers into the agent. The group's overview file will be updated to include the headers while a list of available @@ -1242,15 +1410,13 @@ article numbers will be returned." ;; Do not fetch all headers if the predicate ;; implies that we only consider unread articles. (not (gnus-predicate-implies-unread - (or (gnus-group-find-parameter - group 'agent-predicate t) - (cadr (gnus-group-category group))))))) + (gnus-agent-find-parameter group + 'agent-predicate))))) (articles (if fetch-all (gnus-uncompress-range (gnus-active group)) (gnus-list-of-unread-articles group))) (gnus-decode-encoded-word-function 'identity) - (file (gnus-agent-article-name ".overview" group)) - gnus-agent-cache) + (file (gnus-agent-article-name ".overview" group))) (unless fetch-all ;; Add articles with marks to the list of article headers we want to @@ -1271,7 +1437,9 @@ article numbers will be returned." ;; be fetched. (let ((articles articles)) ;; Remove known articles. - (when (gnus-agent-load-alist group) + (when (and (or gnus-agent-cache + (not gnus-plugged)) + (gnus-agent-load-alist group)) ;; Remove articles marked as downloaded. (if fetch-all ;; I want to fetch all headers in the active range. @@ -1330,8 +1498,7 @@ article numbers will be returned." articles) (ignore-errors (erase-buffer) - (nnheader-insert-file-contents file)))) - ) + (nnheader-insert-file-contents file))))) articles)) (defsubst gnus-agent-copy-nov-line (article) @@ -1393,7 +1560,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (t (beginning-of-line) nil)))) - + (gnus-agent-copy-nov-line (pop articles))))) ;; Copy the rest lines @@ -1530,7 +1697,7 @@ FILE and places the combined headers into `nntp-server-buffer'." (insert "\n")))) (defun gnus-agent-article-name (article group) - (expand-file-name (if (stringp article) article (string-to-number article)) + (expand-file-name article (file-name-as-directory (expand-file-name (gnus-agent-group-path group) (gnus-agent-directory))))) @@ -1560,28 +1727,35 @@ FILE and places the combined headers into `nntp-server-buffer'." groups group gnus-command-method) (save-excursion (while methods - (condition-case err - (progn - (setq gnus-command-method (car methods)) - (when (and (or (gnus-server-opened gnus-command-method) - (gnus-open-server gnus-command-method)) - (gnus-online gnus-command-method)) - (setq groups (gnus-groups-from-server (car methods))) - (gnus-agent-with-fetch - (while (setq group (pop groups)) - (when (<= (gnus-group-level group) gnus-agent-handle-level) - (gnus-agent-fetch-group-1 group gnus-command-method)))))) - (error - (unless (funcall gnus-agent-confirmation-function - (format "Error %s. Continue? " (cdr err))) - (error "Cannot fetch articles into the Gnus agent"))) - (quit - (unless (funcall gnus-agent-confirmation-function - (format "Quit fetching session %s. Continue? " - (cdr err))) - (signal 'quit "Cannot fetch articles into the Gnus agent")))) + (setq gnus-command-method (car methods)) + (when (and (or (gnus-server-opened gnus-command-method) + (gnus-open-server gnus-command-method)) + (gnus-online gnus-command-method)) + (setq groups (gnus-groups-from-server (car methods))) + (gnus-agent-with-fetch + (while (setq group (pop groups)) + (when (<= (gnus-group-level group) + gnus-agent-handle-level) + (if (or debug-on-error debug-on-quit) + (gnus-agent-fetch-group-1 + group gnus-command-method) + (condition-case err + (gnus-agent-fetch-group-1 + group gnus-command-method) + (error + (unless (funcall gnus-agent-confirmation-function + (format "Error %s. Continue? " + (error-message-string err))) + (error "Cannot fetch articles into the Gnus agent"))) + (quit + (unless (funcall gnus-agent-confirmation-function + (format + "Quit fetching session %s. Continue? " + (error-message-string err))) + (signal 'quit + "Cannot fetch articles into the Gnus agent"))))))))) (pop methods)) - (run-hooks 'gnus-agent-fetch-hook) + (gnus-run-hooks 'gnus-agent-fetched-hook) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) (defun gnus-agent-fetch-group-1 (group method) @@ -1613,9 +1787,9 @@ FILE and places the combined headers into `nntp-server-buffer'." (let ((marked-articles gnus-newsgroup-downloadable)) ;; Identify the articles marked for download (unless gnus-newsgroup-active - ;; This needs to be a gnus-summary local variable that is - ;; NOT bound to any value above (its global value should - ;; default to nil). + ;; The variable gnus-newsgroup-active was selected as I need + ;; a gnus-summary local variable that is NOT bound to any + ;; value (its global value should default to nil). (dolist (mark gnus-agent-download-marks) (let ((arts (cdr (assq mark (gnus-info-marks (setq info (gnus-get-info group))))))) @@ -1649,14 +1823,12 @@ FILE and places the combined headers into `nntp-server-buffer'." (setq predicate (gnus-get-predicate - (or (gnus-group-find-parameter group 'agent-predicate t) - (cadr category)))) + (gnus-agent-find-parameter group 'agent-predicate))) ;; If the selection predicate requires scoring, score each header (unless (memq predicate '(gnus-agent-true gnus-agent-false)) (let ((score-param - (or (gnus-group-get-parameter group 'agent-score t) - (caddr category)))) + (gnus-agent-find-parameter group 'agent-score-file))) ;; Translate score-param into real one (cond ((not score-param)) @@ -1697,7 +1869,22 @@ FILE and places the combined headers into `nntp-server-buffer'." (let ((gnus-score (or (cdr (assq num gnus-newsgroup-scored)) - gnus-summary-default-score))) + gnus-summary-default-score)) + (gnus-agent-long-article + (gnus-agent-find-parameter + group 'agent-long-article)) + (gnus-agent-short-article + (gnus-agent-find-parameter + group 'agent-short-article)) + (gnus-agent-low-score + (gnus-agent-find-parameter + group 'agent-low-score)) + (gnus-agent-high-score + (gnus-agent-find-parameter + group 'agent-high-score)) + (gnus-agent-expire-days + (gnus-agent-find-parameter + group 'agent-days-until-old))) (funcall predicate))) (gnus-agent-append-to-list arts-tail num)))))) @@ -1717,8 +1904,7 @@ FILE and places the combined headers into `nntp-server-buffer'." ;; Update the summary buffer (progn (dolist (article marked-articles) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-set-agent-mark article t))) + (gnus-summary-set-agent-mark article t)) (dolist (article fetched-articles) (if gnus-agent-mark-unread-after-downloaded (gnus-summary-mark-article @@ -1778,6 +1964,9 @@ General format specifiers can also be used. See Info node (defvar gnus-category-mode-line-format "Gnus: %%b" "The format specification for the category mode line.") +(defvar gnus-agent-predicate 'false + "The selection predicate used when no other source is available.") + (defvar gnus-agent-short-article 100 "Articles that have fewer lines than this are short.") @@ -1817,6 +2006,7 @@ General format specifiers can also be used. See Info node "k" gnus-category-kill "c" gnus-category-copy "a" gnus-category-add + "e" gnus-agent-customize-category "p" gnus-category-edit-predicate "g" gnus-category-edit-groups "s" gnus-category-edit-score @@ -1837,6 +2027,7 @@ General format specifiers can also be used. See Info node ["Add" gnus-category-add t] ["Kill" gnus-category-kill t] ["Copy" gnus-category-copy t] + ["Edit category" gnus-agent-customize-category t] ["Edit predicate" gnus-category-edit-predicate t] ["Edit score" gnus-category-edit-score t] ["Edit groups" gnus-category-edit-groups t] @@ -1874,7 +2065,7 @@ The following commands are available: (defun gnus-category-insert-line (category) (let* ((gnus-tmp-name (format "%s" (car category))) - (gnus-tmp-groups (length (cadddr category)))) + (gnus-tmp-groups (length (gnus-agent-cat-groups category)))) (beginning-of-line) (gnus-add-text-properties (point) @@ -1914,9 +2105,35 @@ The following commands are available: (defun gnus-category-read () "Read the category alist." (setq gnus-category-alist - (or (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/categories")) - (list (list 'default 'short nil nil))))) + (or + (with-temp-buffer + (ignore-errors + (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories")) + (goto-char (point-min)) + ;; This code isn't temp, it will be needed so long as + ;; anyone may be migrating from an older version. + + ;; Once we're certain that people will not revert to an + ;; earlier version, we can take out the old-list code in + ;; gnus-category-write. + (let* ((old-list (read (current-buffer))) + (new-list (ignore-errors (read (current-buffer))))) + (if new-list + new-list + ;; Convert from a positional list to an alist. + (mapcar + (lambda (c) + (setcdr c + (delq nil + (gnus-mapcar + (lambda (valu symb) + (if valu + (cons symb valu))) + (cdr c) + '(agent-predicate agent-score-file agent-groups)))) + c) + old-list))))) + (list (gnus-agent-cat-make 'default))))) (defun gnus-category-write () "Write the category alist." @@ -1924,6 +2141,16 @@ The following commands are available: gnus-category-group-cache nil) (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories") + ;; This prin1 is temporary. It exists so that people can revert + ;; to an earlier version of gnus-agent. + (prin1 (mapcar (lambda (c) + (list (car c) + (cdr (assoc 'agent-predicate c)) + (cdr (assoc 'agent-score-file c)) + (cdr (assoc 'agent-groups c)))) + gnus-category-alist) + (current-buffer)) + (newline) (prin1 gnus-category-alist (current-buffer)))) (defun gnus-category-edit-predicate (category) @@ -1931,9 +2158,16 @@ The following commands are available: (interactive (list (gnus-category-name))) (let ((info (assq category gnus-category-alist))) (gnus-edit-form - (cadr info) (format "Editing the predicate for category %s" category) + (gnus-agent-cat-predicate info) + (format "Editing the select predicate for category %s" category) `(lambda (predicate) - (setcar (cdr (assq ',category gnus-category-alist)) predicate) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) + ;; predicate) + ;; use its expansion instead: + (gnus-agent-cat-set-property (assq ',category gnus-category-alist) + 'agent-predicate predicate) + (gnus-category-write) (gnus-category-list))))) @@ -1942,10 +2176,16 @@ The following commands are available: (interactive (list (gnus-category-name))) (let ((info (assq category gnus-category-alist))) (gnus-edit-form - (caddr info) + (gnus-agent-cat-score-file info) (format "Editing the score expression for category %s" category) - `(lambda (groups) - (setcar (cddr (assq ',category gnus-category-alist)) groups) + `(lambda (score-file) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) + ;; score-file) + ;; use its expansion instead: + (gnus-agent-cat-set-property (assq ',category gnus-category-alist) + 'agent-score-file score-file) + (gnus-category-write) (gnus-category-list))))) @@ -1954,9 +2194,16 @@ The following commands are available: (interactive (list (gnus-category-name))) (let ((info (assq category gnus-category-alist))) (gnus-edit-form - (cadddr info) (format "Editing the group list for category %s" category) + (gnus-agent-cat-groups info) + (format "Editing the group list for category %s" category) `(lambda (groups) - (setcar (nthcdr 3 (assq ',category gnus-category-alist)) groups) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist)) + ;; groups) + ;; use its expansion instead: + (gnus-agent-set-cat-groups (assq ',category gnus-category-alist) + groups) + (gnus-category-write) (gnus-category-list))))) @@ -1973,8 +2220,10 @@ The following commands are available: "Copy the current category." (interactive (list (gnus-category-name) (intern (read-string "New name: ")))) (let ((info (assq category gnus-category-alist))) - (push (list to (gnus-copy-sequence (cadr info)) - (gnus-copy-sequence (caddr info)) nil) + (push (let ((newcat (gnus-copy-sequence info))) + (setf (gnus-agent-cat-name newcat) to) + (setf (gnus-agent-cat-groups newcat) nil) + newcat) gnus-category-alist) (gnus-category-write) (gnus-category-list))) @@ -1984,7 +2233,7 @@ The following commands are available: (interactive "SCategory name: ") (when (assq category gnus-category-alist) (error "Category %s already exists" category)) - (push (list category 'false nil nil) + (push (gnus-agent-cat-make category) gnus-category-alist) (gnus-category-write) (gnus-category-list)) @@ -2046,9 +2295,9 @@ The following commands are available: (gnus-member-of-range (mail-header-number gnus-headers) (gnus-info-read (gnus-get-info gnus-newsgroup-name)))) -(defun gnus-category-make-function (cat) - "Make a function from category CAT." - (let ((func (gnus-category-make-function-1 cat))) +(defun gnus-category-make-function (predicate) + "Make a function from PREDICATE." + (let ((func (gnus-category-make-function-1 predicate))) (if (and (= (length func) 1) (symbolp (car func))) (car func) @@ -2062,29 +2311,29 @@ The following commands are available: "Return nil." nil) -(defun gnus-category-make-function-1 (cat) - "Make a function from category CAT." +(defun gnus-category-make-function-1 (predicate) + "Make a function from PREDICATE." (cond ;; Functions are just returned as is. - ((or (symbolp cat) - (gnus-functionp cat)) - `(,(or (cdr (assq cat gnus-category-predicate-alist)) - cat))) - ;; More complex category. - ((consp cat) + ((or (symbolp predicate) + (gnus-functionp predicate)) + `(,(or (cdr (assq predicate gnus-category-predicate-alist)) + predicate))) + ;; More complex predicate. + ((consp predicate) `(,(cond - ((memq (car cat) '(& and)) + ((memq (car predicate) '(& and)) 'and) - ((memq (car cat) '(| or)) + ((memq (car predicate) '(| or)) 'or) - ((memq (car cat) gnus-category-not) + ((memq (car predicate) gnus-category-not) 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr cat)))) + ,@(mapcar 'gnus-category-make-function-1 (cdr predicate)))) (t - (error "Unknown category type: %s" cat)))) + (error "Unknown predicate type: %s" predicate)))) (defun gnus-get-predicate (predicate) - "Return the predicate for CATEGORY." + "Return the function implementing PREDICATE." (or (cdr (assoc predicate gnus-category-predicate-cache)) (let ((func (gnus-category-make-function predicate))) (setq gnus-category-predicate-cache @@ -2097,8 +2346,20 @@ The following commands are available: It is okay to miss some cases, but there must be no false positives. That is, if this function returns true, then indeed the predicate must return only unread articles." - ;; Todo: make this work in more cases. - (equal predicate '(not read))) + (gnus-function-implies-unread-1 (gnus-category-make-function predicate))) + +(defun gnus-function-implies-unread-1 (function) + (cond ((eq function (symbol-function 'gnus-agent-read-p)) + nil) + ((not function) + nil) + ((gnus-functionp function) + 'ignore) + ((memq (car function) '(or and not)) + (apply (car function) + (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (t + (error "Unknown function: %s" function)))) (defun gnus-group-category (group) "Return the category GROUP belongs to." @@ -2107,336 +2368,374 @@ return only unread articles." (let ((cs gnus-category-alist) groups cat) (while (setq cat (pop cs)) - (setq groups (cadddr cat)) + (setq groups (gnus-agent-cat-groups cat)) (while groups (gnus-sethash (pop groups) cat gnus-category-group-cache))))) (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) -(defun gnus-agent-expire-2 (expiring-group active articles overview day force - dir) - (gnus-agent-load-alist expiring-group) - (gnus-message 5 "Expiring articles in %s" expiring-group) - (let* ((info (gnus-get-info expiring-group)) - (alist gnus-agent-article-alist) - (specials (if alist - (list (caar (last alist))))) - (unreads ;; Articles that are excluded from the expiration process - (cond (gnus-agent-expire-all - ;; All articles are marked read by global decree - nil) - ((eq articles t) - ;; All articles are marked read by function parameter - nil) - ((not articles) - ;; Unread articles are marked protected from - ;; expiration Don't call gnus-list-of-unread-articles - ;; as it returns articles that have not been fetched - ;; into the agent. - (ignore-errors (gnus-agent-unread-articles expiring-group))) - (t - ;; All articles EXCEPT those named by the caller are - ;; protected from expiration - (gnus-sorted-difference - (gnus-uncompress-range - (cons (caar alist) (caar (last alist)))) - (sort articles '<))))) - (marked ;; More articles that are exluded from the expiration process - (cond (gnus-agent-expire-all - ;; All articles are unmarked by global decree - nil) - ((eq articles t) - ;; All articles are unmarked by function parameter - nil) - (articles - ;; All articles may as well be unmarked as the - ;; unreads list already names the articles we are - ;; going to keep - nil) - (t - ;; Ticked and/or dormant articles are excluded from expiration - (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info)))))))) - (nov-file (concat dir ".overview")) - (cnt 0) - (completed -1) - dlist - type) - - ;; The normal article alist contains - ;; elements that look like (article# . - ;; fetch_date) I need to combine other - ;; information with this list. For - ;; example, a flag indicating that a - ;; particular article MUST BE KEPT. To - ;; do this, I'm going to transform the - ;; elements to look like (article# - ;; fetch_date keep_flag - ;; NOV_entry_marker) Later, I'll reverse - ;; the process to generate the expired - ;; article alist. - - ;; Convert the alist elements to - ;; (article# fetch_date nil nil). - (setq dlist (mapcar (lambda (e) (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements - ;; that look like (article# nil - ;; keep_flag nil) then append it to the - ;; expanded dlist These statements are - ;; sorted by ascending precidence of the - ;; keep_flag. - (setq dlist (nconc dlist (mapcar (lambda (e) - (list e nil 'unread nil)) unreads))) - (setq dlist (nconc dlist (mapcar (lambda (e) - (list e nil 'marked nil)) marked))) - (setq dlist (nconc dlist (mapcar (lambda (e) - (list e nil 'special nil)) specials))) - - (set-buffer overview) - (erase-buffer) - (when (file-exists-p nov-file) - (gnus-message 7 "gnus-agent-expire: Loading overview...") - (nnheader-insert-file-contents nov-file) - (goto-char (point-min)) +(defun gnus-agent-expire-group (group &optional articles force) + "Expire all old articles in GROUP. +If you want to force expiring of certain articles, this function can +take ARTICLES, and FORCE parameters as well. - (let (p) - (while (< (setq p (point)) (point-max)) - (condition-case nil - ;; If I successfully read an - ;; integer (the plus zero - ;; ensures a numeric type), - ;; prepend a marker entry to - ;; the list - (push (list (+ 0 (read (current-buffer))) nil nil - (set-marker (make-marker) p)) dlist) - (error - (gnus-message 1 (concat "gnus-agent-expire: read error occurred " - "when reading expression at %s in %s. " - "Skipping to next line.") - (point) nov-file))) - ;; Whether I succeeded, or failed, - ;; it doesn't matter. Move to the - ;; next line then try again. - (forward-line 1))) - (gnus-message 7 "gnus-agent-expire: Loading overview... Done")) - (set-buffer-modified-p nil) - - ;; At this point, all of the information - ;; is in dlist. The only problem is - ;; that much of it is spread across - ;; multiple entries. Sort then MERGE!! - (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - ;; If two entries have the same - ;; article-number then sort by ascending - ;; keep_flag. - (let ((special 0) - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) 3)) - (b (or (symbol-value (nth 2 b)) 3))) - (<= a b)))))))) - (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") - (gnus-message 7 "gnus-agent-expire: Merging entries... ") - (let ((dlist dlist)) - (while (cdr dlist) ; I'm not at the end-of-list - (if (eq (caar dlist) (caadr dlist)) - (let ((first (cdr (car dlist))) - (secnd (cdr (cadr dlist)))) - (setcar first (or (car first) (car secnd))) ; fetch_date - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) (car secnd))) ; Keep_flag - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) (car secnd))) ; NOV_entry_marker - - (setcdr dlist (cddr dlist))) - (setq dlist (cdr dlist))))) - (gnus-message 7 "gnus-agent-expire: Merging entries... Done") - - (let* ((len (float (length dlist))) - (alist (list nil)) - (tail-alist alist)) - (while dlist - (let ((new-completed (truncate (* 100.0 (/ (setq cnt (1+ cnt)) len))))) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 9 "%3d%% completed..." completed))) - (let* ((entry (car dlist)) - (article-number (nth 0 entry)) - (fetch-date (nth 1 entry)) - (keep (nth 2 entry)) - (marker (nth 3 entry))) - - (cond - ;; Kept articles are unread, marked, or special. - (keep - (when fetch-date - (unless (file-exists-p (concat dir (number-to-string - article-number))) - (setf (nth 1 entry) nil) - (gnus-message 3 (concat "gnus-agent-expire cleared download " - "flag on article %d as the cached " - "article file is missing.") - (caar dlist))) - (unless marker - (gnus-message 1 (concat "gnus-agent-expire detected a " - "missing NOV entry. Run " - "gnus-agent-regenerate-group to " - "restore it.")))) - (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) - - ;; The following articles are READ, UNMARKED, and ORDINARY. - ;; See if they can be EXPIRED!!! - ((setq type - (cond - ((not (integerp fetch-date)) - 'read) ;; never fetched article (may expire right now) - ((not (file-exists-p (concat dir (number-to-string - article-number)))) - (setf (nth 1 entry) nil) - 'externally-expired) ;; Can't find the cached - ;; article. Handle case as - ;; though this article was - ;; never fetched. - - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - ((< fetch-date day) - 'expired) - (force - 'forced))) - - ;; I found some reason to expire this entry. - - (let ((actions nil)) - (when (memq type '(forced expired)) - (ignore-errors ; Just being paranoid. - (delete-file (concat dir (number-to-string article-number))) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil)) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - (gnus-delete-line)) - - ;; If considering all articles is set, I can only expire - ;; article IDs that are no longer in the active range. - (if (and gnus-agent-consider-all-articles - (>= article-number (car active))) - ;; I have to keep this ID in the alist - (gnus-agent-append-to-list tail-alist - (cons article-number fetch-date)) - (push (format "Removed %s article number from article alist" - type) actions)) - - (gnus-message 7 "gnus-agent-expire: Article %d: %s" - article-number (mapconcat 'identity - actions ", ")))) - (t - (gnus-agent-append-to-list tail-alist (cons article-number fetch-date))) - ) - - ;; Clean up markers as I want to recycle this buffer over - ;; several groups. - (when marker - (set-marker marker nil)) - - (setq dlist (cdr dlist)))) - - (setq alist (cdr alist)) - - (let ((inhibit-quit t)) - (unless (equal alist gnus-agent-article-alist) - (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist expiring-group)) - - (when (buffer-modified-p) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-make-directory dir) - (write-region (point-min) (point-max) nov-file nil 'silent) - ;; clear the modified flag as that I'm not confused by its - ;; status on the next pass through this routine. - (set-buffer-modified-p nil))) - - (when (eq articles t) - (gnus-summary-update-info)))))) - -(defun gnus-agent-expire-1 (&optional articles group force) - "Expire all old agent cached articles unconditionally. -See `gnus-agent-expire'." - (let ((methods (if group - (list (gnus-find-method-for-group group)) - gnus-agent-covered-methods)) - (day (if (numberp gnus-agent-expire-days) - (- (time-to-days (current-time)) gnus-agent-expire-days) - nil)) - gnus-command-method sym arts pos - history overview file histories elem art nov-file low info - unreads marked article orig lowest highest found days) - (save-excursion - (setq overview (gnus-get-buffer-create " *expire overview*")) - (unwind-protect - (while (setq gnus-command-method (pop methods)) - (when (file-exists-p (gnus-agent-lib-file "active")) - (with-temp-buffer - (nnheader-insert-file-contents - (gnus-agent-lib-file "active")) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (dolist (expiring-group (gnus-groups-from-server - gnus-command-method)) - (if (or (not group) - (equal group expiring-group)) - (let* ((dir (concat - (gnus-agent-directory) - (gnus-agent-group-path expiring-group) - "/")) - (active - (gnus-gethash-safe expiring-group orig)) - (day (if (numberp day) - day - (let (found - (days gnus-agent-expire-days)) - (catch 'found - (while (and (not found) days) - (when (eq 0 (string-match - (caar days) - expiring-group)) - (throw 'found (- (time-to-days - (current-time)) - (cadar days)))) - (pop days)) - ;; No regexp matched so set - ;; a limit that will block - ;; expiration in this group. - 0))))) - - (when active - (gnus-agent-expire-2 expiring-group active - articles overview day force - dir))))))) - (kill-buffer overview))))) +The articles on which the expiration process runs are selected as follows: + if ARTICLES is null, all read and unmarked articles. + if ARTICLES is t, all articles. + if ARTICLES is a list, just those articles. +FORCE is equivalent to setting the expiration predicates to true." + (interactive + (list (let ((def (or (gnus-group-group-name) + gnus-newsgroup-name))) + (let ((select (read-string (if def + (concat "Group Name (" + def "): ") + "Group Name: ")))) + (if (and (equal "" select) + def) + def + select))))) + + (if (not group) + (gnus-agent-expire articles group force) + (if (or (not (eq articles t)) + (yes-or-no-p + (concat "Are you sure that you want to " + "expire all articles in " group "."))) + (let ((gnus-command-method (gnus-find-method-for-group group)) + (overview (gnus-get-buffer-create " *expire overview*")) + orig) + (unwind-protect + (when (file-exists-p (gnus-agent-lib-file "active")) + (with-temp-buffer + (nnheader-insert-file-contents + (gnus-agent-lib-file "active")) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (save-excursion + (gnus-agent-expire-group-1 + group overview (gnus-gethash-safe group orig) + articles force))) + (kill-buffer overview)))) + (gnus-message 4 "Expiry...done"))) + +(defmacro gnus-agent-message (level &rest args) + `(if (<= ,level gnus-verbose) + (message ,@args))) + +(defun gnus-agent-expire-group-1 (group overview active articles force) + ;; Internal function - requires caller to have set + ;; gnus-command-method, initialized overview buffer, and to have + ;; provided a non-nil active + + (if (eq 'DISABLE (gnus-agent-find-parameter group 'agent-enable-expiration)) + (gnus-message 5 "Expiry skipping over %s" group) + (gnus-message 5 "Expiring articles in %s" group) + (gnus-agent-load-alist group) + (let* ((info (gnus-get-info group)) + (alist gnus-agent-article-alist) + (dir (concat + (gnus-agent-directory) + (gnus-agent-group-path group) + "/")) + (day (- (time-to-days (current-time)) + (gnus-agent-find-parameter group 'agent-days-until-old))) + (specials (if (and alist + (not force)) + ;; This could be a bit of a problem. I need to + ;; keep the last article to avoid refetching + ;; headers when using nntp in the backend. At + ;; the same time, if someone uses a backend + ;; that supports article moving then I may have + ;; to remove the last article to complete the + ;; move. Right now, I'm going to assume that + ;; FORCE overrides specials. + (list (caar (last alist))))) + (unreads ;; Articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are marked read by global decree + nil) + ((eq articles t) + ;; All articles are marked read by function + ;; parameter + nil) + ((not articles) + ;; Unread articles are marked protected from + ;; expiration Don't call + ;; gnus-list-of-unread-articles as it returns + ;; articles that have not been fetched into the + ;; agent. + (ignore-errors + (gnus-agent-unread-articles group))) + (t + ;; All articles EXCEPT those named by the caller + ;; are protected from expiration + (gnus-sorted-difference + (gnus-uncompress-range + (cons (caar alist) + (caar (last alist)))) + (sort articles '<))))) + (marked ;; More articles that are exluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are unmarked by global decree + nil) + ((eq articles t) + ;; All articles are unmarked by function + ;; parameter + nil) + (articles + ;; All articles may as well be unmarked as the + ;; unreads list already names the articles we are + ;; going to keep + nil) + (t + ;; Ticked and/or dormant articles are excluded + ;; from expiration + (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info)))))))) + (nov-file (concat dir ".overview")) + (cnt 0) + (completed -1) + dlist + type) + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse + ;; the process to generate the expired article alist. + + ;; Convert the alist elements to (article# fetch_date nil + ;; nil). + (setq dlist (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) alist)) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precidence of the + ;; keep_flag. + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'special nil)) + specials))) + + (set-buffer overview) + (erase-buffer) + (buffer-disable-undo) + (when (file-exists-p nov-file) + (gnus-message 7 "gnus-agent-expire: Loading overview...") + (nnheader-insert-file-contents nov-file) + (goto-char (point-min)) + + (let (p) + (while (< (setq p (point)) (point-max)) + (condition-case nil + ;; If I successfully read an integer (the plus zero + ;; ensures a numeric type), prepend a marker entry + ;; to the list + (push (list (+ 0 (read (current-buffer))) nil nil + (set-marker (make-marker) p)) + dlist) + (error + (gnus-message 1 "gnus-agent-expire: read error \ +occurred when reading expression at %s in %s. Skipping to next \ +line." (point) nov-file))) + ;; Whether I succeeded, or failed, it doesn't matter. + ;; Move to the next line then try again. + (forward-line 1))) + (gnus-message + 7 "gnus-agent-expire: Loading overview... Done")) + (set-buffer-modified-p nil) + + ;; At this point, all of the information is in dlist. The + ;; only problem is that much of it is spread across multiple + ;; entries. Sort then MERGE!! + (gnus-message 7 "gnus-agent-expire: Sorting entries... ") + ;; If two entries have the same article-number then sort by + ;; ascending keep_flag. + (let ((special 0) + (marked 1) + (unread 2)) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + (let ((a (or (symbol-value (nth 2 a)) + 3)) + (b (or (symbol-value (nth 2 b)) + 3))) + (<= a b)))))))) + (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") + (gnus-message 7 "gnus-agent-expire: Merging entries... ") + (let ((dlist dlist)) + (while (cdr dlist) ; I'm not at the end-of-list + (if (eq (caar dlist) (caadr dlist)) + (let ((first (cdr (car dlist))) + (secnd (cdr (cadr dlist)))) + (setcar first (or (car first) + (car secnd))) ; fetch_date + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; Keep_flag + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; NOV_entry_marker + + (setcdr dlist (cddr dlist))) + (setq dlist (cdr dlist))))) + (gnus-message 7 "gnus-agent-expire: Merging entries... Done") + + (let* ((len (float (length dlist))) + (alist (list nil)) + (tail-alist alist)) + (while dlist + (let ((new-completed (truncate (* 100.0 + (/ (setq cnt (1+ cnt)) + len))))) + (when (> new-completed completed) + (setq completed new-completed) + (gnus-message 7 "%3d%% completed..." completed))) + (let* ((entry (car dlist)) + (article-number (nth 0 entry)) + (fetch-date (nth 1 entry)) + (keep (nth 2 entry)) + (marker (nth 3 entry))) + + (cond + ;; Kept articles are unread, marked, or special. + (keep + (gnus-agent-message 10 + "gnus-agent-expire: Article %d: Kept %s article." + article-number keep) + (when fetch-date + (unless (file-exists-p + (concat dir (number-to-string + article-number))) + (setf (nth 1 entry) nil) + (gnus-agent-message 3 "gnus-agent-expire cleared \ +download flag on article %d as the cached article file is missing." + (caar dlist))) + (unless marker + (gnus-message 1 "gnus-agent-expire detected a \ +missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) + (gnus-agent-append-to-list + tail-alist + (cons article-number fetch-date))) + + ;; The following articles are READ, UNMARKED, and + ;; ORDINARY. See if they can be EXPIRED!!! + ((setq type + (cond + ((not (integerp fetch-date)) + 'read) ;; never fetched article (may expire + ;; right now) + ((not (file-exists-p + (concat dir (number-to-string + article-number)))) + (setf (nth 1 entry) nil) + 'externally-expired) ;; Can't find the cached + ;; article. Handle case + ;; as though this article + ;; was never fetched. + + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + ((< fetch-date day) + 'expired) + (force + 'forced))) + + ;; I found some reason to expire this entry. + + (let ((actions nil)) + (when (memq type '(forced expired)) + (ignore-errors ; Just being paranoid. + (delete-file (concat dir (number-to-string + article-number))) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil) + ) + + (when marker + (push "NOV entry removed" actions) + (goto-char marker) + (gnus-delete-line)) + + ;; If considering all articles is set, I can only + ;; expire article IDs that are no longer in the + ;; active range. + (if (and gnus-agent-consider-all-articles + (>= article-number (car active))) + ;; I have to keep this ID in the alist + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date)) + (push (format "Removed %s article number from \ +article alist" type) actions)) + + (gnus-agent-message 8 "gnus-agent-expire: Article %d: %s" + article-number + (mapconcat 'identity actions ", ")))) + (t + (gnus-agent-message + 10 "gnus-agent-expire: Article %d: Article kept as \ +expiration tests failed." article-number) + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date))) + ) + + ;; Clean up markers as I want to recycle this buffer + ;; over several groups. + (when marker + (set-marker marker nil)) + + (setq dlist (cdr dlist)))) + + (setq alist (cdr alist)) + + (let ((inhibit-quit t)) + (unless (equal alist gnus-agent-article-alist) + (setq gnus-agent-article-alist alist) + (gnus-agent-save-alist group)) + + (when (buffer-modified-p) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (gnus-make-directory dir) + (write-region (point-min) (point-max) nov-file nil + 'silent) + ;; clear the modified flag as that I'm not confused by + ;; its status on the next pass through this routine. + (set-buffer-modified-p nil))) + + (when (eq articles t) + (gnus-summary-update-info))))))) (defun gnus-agent-expire (&optional articles group force) - "Expire all old agent cached articles. + "Expire all old articles. If you want to force expiring of certain articles, this function can take ARTICLES, GROUP and FORCE parameters as well. @@ -2445,16 +2744,38 @@ The articles on which the expiration process runs are selected as follows: if ARTICLES is t, all articles. if ARTICLES is a list, just those articles. Setting GROUP will limit expiration to that group. -FORCE is equivalent to setting gnus-agent-expire-days to zero(0)." +FORCE is equivalent to setting the expiration predicates to true." (interactive) - (if (and (not gnus-agent-expire-days) - (or (not (eq articles t)) - (yes-or-no-p (concat "Are you sure that you want to expire all " - "articles in " (if group group - "every agentized group") - ".")))) - (gnus-agent-expire-1 articles group force) - (gnus-message 4 "Expiry...done"))) + + (if group + (gnus-agent-expire-group group articles force) + (if (or (not (eq articles t)) + (yes-or-no-p "Are you sure that you want to expire all \ +articles in every agentized group.")) + (let ((methods gnus-agent-covered-methods) + gnus-command-method overview orig) + (setq overview (gnus-get-buffer-create " *expire overview*")) + (unwind-protect + (while (setq gnus-command-method (pop methods)) + (when (file-exists-p (gnus-agent-lib-file "active")) + (with-temp-buffer + (nnheader-insert-file-contents + (gnus-agent-lib-file "active")) + (gnus-active-to-gnus-format + gnus-command-method + (setq orig (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (dolist (expiring-group (gnus-groups-from-server + gnus-command-method)) + (let* ((active + (gnus-gethash-safe expiring-group orig))) + + (when active + (save-excursion + (gnus-agent-expire-group-1 + expiring-group overview active articles force))))))) + (kill-buffer overview)) + (gnus-message 4 "Expiry...done"))))) ;;;###autoload (defun gnus-agent-batch () @@ -2499,7 +2820,8 @@ has been fetched." ;; Functionally, I don't need to construct a temp list using mapcar. - (if (gnus-agent-load-alist group) + (if (and (or gnus-agent-cache (not gnus-plugged)) + (gnus-agent-load-alist group)) (let* ((ref gnus-agent-article-alist) (arts articles) (uncached (list nil)) @@ -2507,15 +2829,15 @@ has been fetched." (while (and ref arts) (let ((v1 (car arts)) (v2 (caar ref))) - (cond ((< v1 v2) ; the article (v1) does not appear in the reference list + (cond ((< v1 v2) ; v1 does not appear in the reference list (gnus-agent-append-to-list tail-uncached v1) (pop arts)) ((= v1 v2) - (unless (or cached-header (cdar ref)) ; the article (v1) is already cached + (unless (or cached-header (cdar ref)) ; v1 is already cached (gnus-agent-append-to-list tail-uncached v1)) (pop arts) (pop ref)) - (t ; the reference article (v2) preceeds the list being filtered + (t ; reference article (v2) preceeds the list being filtered (pop ref))))) (while arts (gnus-agent-append-to-list tail-uncached (pop arts))) @@ -2540,70 +2862,77 @@ has been fetched." gnus-agent-file-coding-system)) (nnheader-insert-nov-file file (car articles))))) - (if (setq uncached-articles (gnus-agent-uncached-articles articles group t)) + (if (setq uncached-articles (gnus-agent-uncached-articles articles group + t)) (progn ;; Populate nntp-server-buffer with uncached headers (set-buffer nntp-server-buffer) (erase-buffer) - (let (gnus-agent-cache) ; Turn off agent cache - (cond ((not (eq 'nov (gnus-retrieve-headers - uncached-articles group fetch-old))) - (nnvirtual-convert-headers)) - ((eq 'nntp (car gnus-current-select-method)) - ;; The author of gnus-get-newsgroup-headers-xover - ;; reports that the XOVER command is commonly - ;; unreliable. The problem is that recently - ;; posted articles may not be entered into the - ;; NOV database in time to respond to my XOVER - ;; query. - ;; - ;; I'm going to use his assumption that the NOV - ;; database is updated in order of ascending - ;; article ID. Therefore, a response containing - ;; article ID N implies that all articles from 1 - ;; to N-1 are up-to-date. Therefore, missing - ;; articles in that range have expired. - - (set-buffer nntp-server-buffer) - (let* ((fetched-articles (list nil)) - (tail-fetched-articles fetched-articles) - (min (cond ((numberp fetch-old) - (max 1 (- (car articles) fetch-old))) - (fetch-old - 1) - (t - (car articles)))) - (max (car (last articles)))) - - ;; Get the list of articles that were fetched - (goto-char (point-min)) - (let ((pm (point-max))) - (while (< (point) pm) - (when (looking-at "[0-9]+\t") - (gnus-agent-append-to-list tail-fetched-articles (read (current-buffer)))) - (forward-line 1))) - - ;; Clip this list to the headers that will - ;; actually be returned - (setq fetched-articles (gnus-list-range-intersection - (cdr fetched-articles) - (cons min max))) - - ;; Clip the uncached articles list to exclude - ;; IDs after the last FETCHED header. The - ;; excluded IDs may be fetchable using HEAD. - (if (car tail-fetched-articles) - (setq uncached-articles (gnus-list-range-intersection - uncached-articles - (cons (car uncached-articles) (car tail-fetched-articles))))) - - ;; Create the list of articles that were - ;; "successfully" fetched. Success, in this - ;; case, means that the ID should not be - ;; fetched again. In the case of an expired - ;; article, the header will not be fetched. - (setq uncached-articles (gnus-sorted-nunion fetched-articles uncached-articles)) - )))) + (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent + (gnus-retrieve-headers + uncached-articles group fetch-old)))) + (nnvirtual-convert-headers)) + ((eq 'nntp (car gnus-current-select-method)) + ;; The author of gnus-get-newsgroup-headers-xover + ;; reports that the XOVER command is commonly + ;; unreliable. The problem is that recently + ;; posted articles may not be entered into the + ;; NOV database in time to respond to my XOVER + ;; query. + ;; + ;; I'm going to use his assumption that the NOV + ;; database is updated in order of ascending + ;; article ID. Therefore, a response containing + ;; article ID N implies that all articles from 1 + ;; to N-1 are up-to-date. Therefore, missing + ;; articles in that range have expired. + + (set-buffer nntp-server-buffer) + (let* ((fetched-articles (list nil)) + (tail-fetched-articles fetched-articles) + (min (cond ((numberp fetch-old) + (max 1 (- (car articles) fetch-old))) + (fetch-old + 1) + (t + (car articles)))) + (max (car (last articles)))) + + ;; Get the list of articles that were fetched + (goto-char (point-min)) + (let ((pm (point-max))) + (while (< (point) pm) + (when (looking-at "[0-9]+\t") + (gnus-agent-append-to-list + tail-fetched-articles + (read (current-buffer)))) + (forward-line 1))) + + ;; Clip this list to the headers that will + ;; actually be returned + (setq fetched-articles (gnus-list-range-intersection + (cdr fetched-articles) + (cons min max))) + + ;; Clip the uncached articles list to exclude + ;; IDs after the last FETCHED header. The + ;; excluded IDs may be fetchable using HEAD. + (if (car tail-fetched-articles) + (setq uncached-articles + (gnus-list-range-intersection + uncached-articles + (cons (car uncached-articles) + (car tail-fetched-articles))))) + + ;; Create the list of articles that were + ;; "successfully" fetched. Success, in this + ;; case, means that the ID should not be + ;; fetched again. In the case of an expired + ;; article, the header will not be fetched. + (setq uncached-articles + (gnus-sorted-nunion fetched-articles + uncached-articles)) + ))) ;; Erase the temp buffer (set-buffer gnus-agent-overview-buffer) @@ -2624,13 +2953,13 @@ has been fetched." gnus-agent-file-coding-system)) (gnus-agent-check-overview-buffer) (write-region (point-min) (point-max) file nil 'silent)) - + ;; Update the group's article alist to include the newly ;; fetched articles. (gnus-agent-load-alist group) (gnus-agent-save-alist group uncached-articles nil) ) - + ;; Copy the temp buffer to the nntp-server-buffer (set-buffer nntp-server-buffer) (erase-buffer) @@ -2649,33 +2978,42 @@ has been fetched." (defun gnus-agent-request-article (article group) "Retrieve ARTICLE in GROUP from the agent cache." - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (file (concat + (when (and gnus-agent + (or gnus-agent-cache + (not gnus-plugged)) + (numberp article)) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (file (concat (gnus-agent-directory) (gnus-agent-group-path group) "/" (number-to-string article))) - (buffer-read-only nil)) - (when (and (file-exists-p file) - (> (nth 7 (file-attributes file)) 0)) - (erase-buffer) - (gnus-kill-all-overlays) - (let ((coding-system-for-read gnus-cache-coding-system)) - (insert-file-contents file)) - t))) + (buffer-read-only nil)) + (when (and (file-exists-p file) + (> (nth 7 (file-attributes file)) 0)) + (erase-buffer) + (gnus-kill-all-overlays) + (let ((coding-system-for-read gnus-cache-coding-system)) + (insert-file-contents file)) + t)))) (defun gnus-agent-regenerate-group (group &optional reread) "Regenerate GROUP. If REREAD is t, all articles in the .overview are marked as unread. If REREAD is not nil, downloaded articles are marked as unread." - (interactive (list (let ((def (or (gnus-group-group-name) - gnus-newsgroup-name))) - (let ((select (read-string (if def (concat "Group Name (" def "): ") - "Group Name: ")))) - (if (and (equal "" select) - def) - def - select))) - (intern-soft (read-string "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): ")))) + (interactive + (list (let ((def (or (gnus-group-group-name) + gnus-newsgroup-name))) + (let ((select (read-string (if def + (concat "Group Name (" + def "): ") + "Group Name: ")))) + (if (and (equal "" select) + def) + def + select))) + (intern-soft + (read-string + "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): ")))) (gnus-message 5 "Regenerating in %s" group) (let* ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) @@ -2705,7 +3043,8 @@ If REREAD is not nil, downloaded articles are marked as unread." (setq load nil) (goto-char (point-min)) (while (< (point) (point-max)) - (cond ((looking-at "[0-9]+\t") + (cond ((and (looking-at "[0-9]+\t") + (<= (- (match-end 0) (match-beginning 0)) 9)) (push (read (current-buffer)) nov-arts) (forward-line 1) (let ((l1 (car nov-arts)) @@ -2713,21 +3052,26 @@ If REREAD is not nil, downloaded articles are marked as unread." (cond ((not l2) nil) ((< l1 l2) - (gnus-message 3 "gnus-agent-regenerate-group: NOV entries are NOT in ascending order.") + (gnus-message 3 "gnus-agent-regenerate-group: NOV\ + entries are NOT in ascending order.") ;; Don't sort now as I haven't verified ;; that every line begins with a number (setq load t)) ((= l1 l2) (forward-line -1) - (gnus-message 4 "gnus-agent-regenerate-group: NOV entries contained duplicate of article %s. Duplicate deleted." l1) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + entries contained duplicate of article %s. Duplicate deleted." l1) (gnus-delete-line) (pop nov-arts))))) (t - (gnus-message 1 "gnus-agent-regenerate-group: NOV entries contained line that did not begin with an article number. Deleted line.") + (gnus-message 1 "gnus-agent-regenerate-group: NOV\ + entries contained line that did not begin with an article number. Deleted\ + line.") (gnus-delete-line)))) (if load (progn - (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV entries into ascending order.") + (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ + entries into ascending order.") (sort-numeric-fields 1 (point-min) (point-max)) (setq nov-arts nil))))) (gnus-agent-check-overview-buffer) @@ -2736,11 +3080,12 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; in the .overview file. As a side-effect, missing headers are ;; reconstructed from the downloaded article file. (while (or downloaded nov-arts) - (cond ((and downloaded + (cond ((and downloaded (or (not nov-arts) (> (car downloaded) (car nov-arts)))) ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group (car downloaded)) + (gnus-message 3 "Regenerating NOV %s %d..." group + (car downloaded)) (let ((file (concat dir (number-to-string (car downloaded))))) (mm-with-unibyte-buffer (nnheader-insert-file-contents file) @@ -2748,7 +3093,8 @@ If REREAD is not nil, downloaded articles are marked as unread." (setq header (nnheader-parse-naked-head))) (mail-header-set-number header (car downloaded)) (if nov-arts - (let ((key (concat "^" (int-to-string (car nov-arts)) "\t"))) + (let ((key (concat "^" (int-to-string (car nov-arts)) + "\t"))) (or (re-search-backward key nil t) (re-search-forward key)) (forward-line 1)) @@ -2757,7 +3103,11 @@ If REREAD is not nil, downloaded articles are marked as unread." (setq nov-arts (cons (car downloaded) nov-arts))) ((eq (car downloaded) (car nov-arts)) ;; This entry in the overview has been downloaded - (push (cons (car downloaded) (time-to-days (nth 5 (file-attributes (concat dir (number-to-string (car downloaded))))))) alist) + (push (cons (car downloaded) + (time-to-days + (nth 5 (file-attributes + (concat dir (number-to-string + (car downloaded))))))) alist) (pop downloaded) (pop nov-arts)) (t @@ -2800,12 +3150,13 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; Restore the last article ID if it is not already in the new alist (let ((n (last alist)) (o (last (gnus-agent-load-alist group)))) - (cond ((not n) - (when o - (push (cons (caar o) nil) alist))) + (cond ((not o) + nil) + ((not n) + (push (cons (caar o) nil) alist)) ((< (caar n) (caar o)) (setcdr n (list (car o))))))) - + (let ((inhibit-quit t)) (if (setq regenerated (buffer-modified-p)) (let ((coding-system-for-write gnus-agent-file-coding-system)) @@ -2817,7 +3168,7 @@ If REREAD is not nil, downloaded articles are marked as unread." ) (setq gnus-agent-article-alist alist) - + (when regenerated (gnus-agent-save-alist group))) ) @@ -2837,6 +3188,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (sit-for 0)) ) + (gnus-message 5 nil) regenerated)) ;;;###autoload @@ -2885,7 +3237,8 @@ If CLEAN, don't read existing active files." (when active-changed (setq regenerated t) (gnus-message 4 "Regenerate %s" active-file) - (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) + (let ((nnmail-active-file-coding-system + gnus-agent-file-coding-system)) (gnus-write-active-file active-file active-hashtb))))) (gnus-message 4 "Regenerating Gnus agent files...done") regenerated)) @@ -2919,6 +3272,49 @@ If CLEAN, don't read existing active files." (member (gnus-group-method group) gnus-agent-covered-methods)) +(add-hook 'gnus-group-prepare-hook + (lambda () + 'gnus-agent-do-once + + (when (listp gnus-agent-expire-days) + (beep) + (beep) + (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\ + supports being set to a list.")(sleep-for 3) + (gnus-message 1 "Change your configuration to set it to an\ + integer.")(sleep-for 3) + (gnus-message 1 "I am now setting group parameters on each\ + group to match the configuration that the list offered.") + + (save-excursion + (let ((groups (gnus-group-listed-groups))) + (while groups + (let* ((group (pop groups)) + (days gnus-agent-expire-days) + (day (catch 'found + (while days + (when (eq 0 (string-match + (caar days) + group)) + (throw 'found (cadar days))) + (pop days)) + nil))) + (when day + (gnus-group-set-parameter group 'agent-days-until-old + day)))))) + + (let ((h gnus-group-prepare-hook)) + (while h + (let ((func (pop h))) + (when (and (listp func) + (eq (cadr (caddr func)) 'gnus-agent-do-once)) + (remove-hook 'gnus-group-prepare-hook func) + (setq h nil))))) + + (gnus-message 1 "I have finished setting group parameters on\ + each group. You may now customize your groups and/or topics to control the\ + agent.")))) + (provide 'gnus-agent) ;;; gnus-agent.el ends here diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index a06d41e..2c6a98f 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -185,6 +185,8 @@ Possible values in this list are: 'empty Headers with no content. 'newsgroups Newsgroup identical to Gnus group. 'to-address To identical to To-address. + 'to-list To identical to To-list. + 'cc-list CC identical to To-list. 'followup-to Followup-to identical to Newsgroups. 'reply-to Reply-to identical to From. 'date Date less than four days old. @@ -193,6 +195,8 @@ Possible values in this list are: :type '(set (const :tag "Headers with no content." empty) (const :tag "Newsgroups identical to Gnus group." newsgroups) (const :tag "To identical to To-address." to-address) + (const :tag "To identical to To-list." to-list) + (const :tag "CC identical to To-list." cc-list) (const :tag "Followup-to identical to Newsgroups." followup-to) (const :tag "Reply-to identical to From." reply-to) (const :tag "Date less than four days old." date) @@ -200,6 +204,15 @@ Possible values in this list are: (const :tag "Multiple To and/or Cc headers." many-to)) :group 'gnus-article-hiding) +(defcustom gnus-article-skip-boring nil + "Skip over text that is not worth reading. +By default, if you set this t, then Gnus will display citations and +signatures, but will never scroll down to show you a page consisting +only of boring text. Boring text is controlled by +`gnus-article-boring-faces'." + :type 'boolean + :group 'gnus-article-hiding) + (defcustom gnus-signature-separator '("^-- $" "^-- *$") "Regexp matching signature separator. This can also be a list of regexps. In that case, it will be checked @@ -805,6 +818,7 @@ used." (defcustom gnus-mime-action-alist '(("save to file" . gnus-mime-save-part) ("save and strip" . gnus-mime-save-part-and-strip) + ("delete part" . gnus-mime-delete-part) ("display as text" . gnus-mime-inline-part) ("view the part" . gnus-mime-view-part) ("pipe to command" . gnus-mime-pipe-part) @@ -1575,7 +1589,7 @@ always hide." (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) (forward-line -1) (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) + (gnus-point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1604,6 +1618,32 @@ always hide." (nth 1 (mail-extract-address-components to)) to-address))) (gnus-article-hide-header "to")))) + ((eq elem 'to-list) + (let ((to (message-fetch-field "to")) + (to-list + (gnus-parameter-to-list + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name "")))) + (when (and to to-list + (ignore-errors + (gnus-string-equal + ;; only one address in To + (nth 1 (mail-extract-address-components to)) + to-list))) + (gnus-article-hide-header "to")))) + ((eq elem 'cc-list) + (let ((cc (message-fetch-field "cc")) + (to-list + (gnus-parameter-to-list + (if (boundp 'gnus-newsgroup-name) + gnus-newsgroup-name "")))) + (when (and cc to-list + (ignore-errors + (gnus-string-equal + ;; only one address in CC + (nth 1 (mail-extract-address-components cc)) + to-list))) + (gnus-article-hide-header "cc")))) ((eq elem 'followup-to) (when (gnus-string-equal (message-fetch-field "followup-to") @@ -1665,7 +1705,7 @@ always hide." (goto-char (point-min)) (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) + (gnus-point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1781,7 +1821,7 @@ unfolded." (while (not (eobp)) (save-restriction (mail-header-narrow-to-field) - (let ((header (buffer-substring (point-min) (point-max)))) + (let ((header (buffer-string))) (with-temp-buffer (insert header) (goto-char (point-min)) @@ -2049,7 +2089,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) - (car ctl))))))) + (car ctl) prompt)))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2290,43 +2330,50 @@ always hide." (match-beginning 0) (match-end 0) 'pem))))))) (defun article-strip-banner () - "Strip the banner specified by the `banner' group parameter." + "Strip the banners specified by the `banner' group parameter and by +`gnus-article-address-banner-alist'." (interactive) (save-excursion (save-restriction + (let ((inhibit-point-motion-hooks t)) + (when (gnus-parameter-banner gnus-newsgroup-name) + (article-really-strip-banner + (gnus-parameter-banner gnus-newsgroup-name))) + (when gnus-article-address-banner-alist + (article-really-strip-banner + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (caar (mail-header-parse-addresses from)))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found (cdr pair))))))))))))) + +(defun article-really-strip-banner (banner) + "Strip the banner specified by the argument." + (save-excursion + (save-restriction (let ((inhibit-point-motion-hooks t) - (banner (gnus-parameter-banner gnus-newsgroup-name)) (gnus-signature-limit nil) - buffer-read-only beg end) - (when (and gnus-article-address-banner-alist - (not banner)) - (setq banner - (let ((from (save-restriction - (widen) - (article-narrow-to-head) - (mail-fetch-field "from")))) - (when (and from - (setq from - (caar (mail-header-parse-addresses from)))) - (catch 'found - (dolist (pair gnus-article-address-banner-alist) - (when (string-match (car pair) from) - (throw 'found (cdr pair))))))))) - (when banner - (article-goto-body) - (cond - ((eq banner 'signature) - (when (gnus-article-narrow-to-signature) - (widen) - (forward-line -1) - (delete-region (point) (point-max)))) - ((symbolp banner) - (if (setq banner (cdr (assq banner gnus-article-banner-alist))) - (while (re-search-forward banner nil t) - (delete-region (match-beginning 0) (match-end 0))))) - ((stringp banner) - (while (re-search-forward banner nil t) - (delete-region (match-beginning 0) (match-end 0)))))))))) + buffer-read-only) + (article-goto-body) + (cond + ((eq banner 'signature) + (when (gnus-article-narrow-to-signature) + (widen) + (forward-line -1) + (delete-region (point) (point-max)))) + ((symbolp banner) + (if (setq banner (cdr (assq banner gnus-article-banner-alist))) + (while (re-search-forward banner nil t) + (delete-region (match-beginning 0) (match-end 0))))) + ((stringp banner) + (while (re-search-forward banner nil t) + (delete-region (match-beginning 0) (match-end 0))))))))) (defun article-babel () "Translate article using an online translation service." @@ -3556,7 +3603,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) - (if (memq article gnus-newsgroup-undownloaded) + (if (and (memq article gnus-newsgroup-undownloaded) + (not (gnus-online (gnus-find-method-for-group + gnus-newsgroup-name)))) (progn (gnus-summary-set-agent-mark article) (message "Message marked for downloading")) @@ -3686,13 +3735,14 @@ General format specifiers can also be used. See Info node (gnus-mime-view-part-as-charset "C" "View As charset...") (gnus-mime-save-part "o" "Save...") (gnus-mime-save-part-and-strip "\C-o" "Save and Strip") + (gnus-mime-delete-part "d" "Delete part") (gnus-mime-copy-part "c" "View As Text, In Other Buffer") (gnus-mime-inline-part "i" "View As Text, In This Buffer") (gnus-mime-view-part-internally "E" "View Internally") (gnus-mime-view-part-externally "e" "View Externally") (gnus-mime-print-part "p" "Print") (gnus-mime-pipe-part "|" "Pipe To Command...") - (gnus-mime-action-on-part "." "Take action on the part"))) + (gnus-mime-action-on-part "." "Take action on the part..."))) (defun gnus-article-mime-part-status () (if gnus-article-mime-handle-alist-1 @@ -3712,21 +3762,36 @@ General format specifiers can also be used. See Info node (define-key map (cadr c) (car c))) map)) -(defun gnus-mime-button-menu (event) - "Construct a context-sensitive menu of MIME commands." - (interactive "e") - (save-window-excursion - (let ((pos (event-start event))) - (select-window (posn-window pos)) - (goto-char (posn-point pos)) - (gnus-article-check-buffer) - (let ((response (x-popup-menu - t `("MIME Part" - ("" ,@(mapcar (lambda (c) - (cons (caddr c) (car c))) - gnus-mime-button-commands)))))) - (if response - (call-interactively response)))))) +(easy-menu-define gnus-mime-button-menu gnus-mime-button-map "MIME button menu." + `("MIME Part" + ,@(mapcar (lambda (c) + (vector (caddr c) (car c) :enable t)) gnus-mime-button-commands))) + +(eval-when-compile + (define-compiler-macro popup-menu (&whole form + menu &optional position prefix) + (if (and (fboundp 'popup-menu) + (not (memq 'popup-menu (assoc "lmenu" load-history)))) + form + ;; Gnus is probably running under Emacs 20. + `(let* ((menu (cdr ,menu)) + (response (x-popup-menu + t (list (car menu) + (cons "" (mapcar (lambda (c) + (cons (caddr c) (car c))) + (cdr menu))))))) + (if response + (call-interactively (nth 3 (assq response menu)))))))) + +(defun gnus-mime-button-menu (event prefix) + "Construct a context-sensitive menu of MIME commands." + (interactive "e\nP") + (save-window-excursion + (let ((pos (event-start event))) + (select-window (posn-window pos)) + (goto-char (posn-point pos)) + (gnus-article-check-buffer) + (popup-menu gnus-mime-button-menu nil prefix)))) (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." @@ -3810,6 +3875,87 @@ General format specifiers can also be used. See Info node ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))) +(defun gnus-mime-delete-part () + "Delete the MIME part under point. +Replace it with some information about the removed part." + (interactive) + (gnus-article-check-buffer) + (let* ((data (get-text-property (point) 'gnus-data)) + (handles gnus-article-mime-handles) + (none "(none)") + (description + (or + (mail-decode-encoded-word-string (or (mm-handle-description data) + none)))) + (filename + (or (mail-content-type-get (mm-handle-disposition data) 'filename) + none)) + (type (mm-handle-media-type data))) + (if (mm-multiple-handles gnus-article-mime-handles) + (error "This function is not implemented")) + (with-current-buffer (mm-handle-buffer data) + (let ((bsize (format "%s" (buffer-size)))) + (erase-buffer) + (insert + (concat + "<#part type=text/plain nofile=yes disposition=attachment" + " description=\"Deleted attachment (" bsize " Byte)\">" + ",----\n" + "| The following attachment has been deleted:\n" + "|\n" + "| Type: " type "\n" + "| Filename: " filename "\n" + "| Size (encoded): " bsize " Byte\n" + "| Description: " description "\n" + "`----\n" + "<#/part>")) + (setcdr data + (cdr (mm-make-handle nil `("text/plain")))))) + (set-buffer gnus-summary-buffer) + ;; FIXME: maybe some of the following code (borrowed from + ;; `gnus-mime-save-part-and-strip') isn't necessary? + (gnus-article-edit-article + `(lambda () + (erase-buffer) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (insert-buffer gnus-original-article-buffer) + (mime-to-mml ',handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + ;; LOCAL argument of add-hook differs between GNU Emacs + ;; and XEmacs. make-local-hook makes sure they are local. + (make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) + `(lambda (no-highlight) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets))) + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) + ,gnus-summary-buffer no-highlight)))) + ;; Not in `gnus-mime-save-part-and-strip': + (gnus-article-edit-done) + (gnus-summary-expand-window) + (gnus-summary-show-article)) + (defun gnus-mime-save-part () "Save the MIME part under point." (interactive) @@ -4043,7 +4189,7 @@ If no internal viewer is available, use an external viewer." (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." (interactive - (list (completing-read "Action: " gnus-mime-action-alist))) + (list (completing-read "Action: " gnus-mime-action-alist nil t))) (gnus-article-check-buffer) (let ((action-pair (assoc action gnus-mime-action-alist))) (if action-pair @@ -4176,16 +4322,14 @@ If no internal viewer is available, use an external viewer." (if (window-live-p window) (select-window window))))) (goto-char point) - (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) + (gnus-delete-line) (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle))) (goto-char point)))) (defun gnus-article-goto-part (n) "Go to MIME part N." - (let ((point (text-property-any (point-min) (point-max) 'gnus-part n))) - (when point - (goto-char point)))) + (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name @@ -4221,7 +4365,10 @@ If no internal viewer is available, use an external viewer." gnus-part ,gnus-tmp-id article-type annotation gnus-data ,handle)) - (setq e (point)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) (widget-convert-button 'link b e :mime-handle handle @@ -4677,15 +4824,14 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-next-page () "Show the next page of the article." (interactive) - (when (gnus-article-next-page) - (goto-char (point-min)) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + (gnus-eval-in-buffer-window gnus-summary-buffer + (gnus-summary-next-page))) (defun gnus-article-goto-prev-page () "Show the next page of the article." (interactive) - (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) - (gnus-article-prev-page nil))) + (gnus-eval-in-buffer-window gnus-summary-buffer + (gnus-summary-prev-page))) (defun gnus-article-next-page (&optional lines) "Show the next page of the current article. @@ -4735,17 +4881,33 @@ Argument LINES specifies lines to be scrolled down." (goto-char (point-min)))) (move-to-window-line 0))))) +(defun gnus-article-only-boring-p () + "Decide whether there is only boring text remaining in the article. +Something \"interesting\" is a word of at least two letters that does +not have a face in `gnus-article-boring-faces'." + (when (and gnus-article-skip-boring + (boundp 'gnus-article-boring-faces) + (symbol-value 'gnus-article-boring-faces)) + (save-excursion + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces))) + (throw 'only-boring nil))) + (throw 'only-boring t))))) + (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) - (let ((point (point))) - (search-forward ">" nil t) ;Move point to end of "<....>". - (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) - (let ((message-id (gnus-replace-in-string (match-string 1) "]+" (gnus-point-at-eol) t) + (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id)) - (goto-char (point)) + (gnus-summary-refer-article msg-id)) (error "No references around point")))) (defun gnus-article-show-summary () @@ -5064,9 +5226,7 @@ If given a prefix, show the hidden text instead." (gnus-cache-request-article article group)) 'article) ;; Check the agent cache. - ((and gnus-agent gnus-agent-cache gnus-plugged - (numberp article) - (gnus-agent-request-article article group)) + ((gnus-agent-request-article article group) 'article) ;; Get the article and put into the article buffer. ((or (stringp article) @@ -5347,8 +5507,8 @@ groups." (defcustom gnus-button-url-regexp (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~`%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~`%&*+\\/[:word:]]\\)" - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~`%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~`%&*+\\/]\\|\\w\\)\\)") + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) @@ -5407,57 +5567,173 @@ The function must take one argument, the string naming the URL." :group 'gnus-article-buttons :type 'regexp) -(defcustom gnus-button-prefer-mid-or-mail 'guess - "What to do when the button on a string as \"foo123@bar.com\" is pushed. -Strings like this can be either a message ID or a mail address. If the -variable is set to the symbol `ask', query the user what do do. If it is the -symbol `guess', Gnus will do a guess and query the user what do do if it is -ambiguous. See the variable `gnus-button-guessed-mid-regexp' for details -concerning the guessing. If it is one of the sybols `mid' or `mail', Gnus -will always assume that the string is a message ID or a mail address, -respectivly." - ;; FIXME: doc-string could/should be improved. +(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic + "What to do when the button on a string as \"foo123@bar.invalid\" is pushed. +Strings like this can be either a message ID or a mail address. If it is one +of the symbols `mid' or `mail', Gnus will always assume that the string is a +message ID or a mail address, respectivly. If this variable is set to the +symbol `ask', always query the user what do do. If it is a function, this +function will be called with the string as it's only argument. The function +must return `mid', `mail', `invalid' or `ask'." :group 'gnus-article-buttons - :type '(choice (const ask) - (const guess) + :type '(choice (function-item :tag "Heuristic function" + gnus-button-mid-or-mail-heuristic) + (const ask) (const mid) (const mail))) -(defcustom gnus-button-guessed-mid-regexp - (concat - "^. I.e. translate the - ;; Perl-REs to Elisp-REs. +(defcustom gnus-button-mid-or-mail-heuristic-alist + '((-10.0 . ".+\\$.+@") + (-10.0 . "#") + (-10.0 . "\\*") + (-5.0 . "\\+[^+]*\\+.*@") ;; # two plus signs + (-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i + (-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i; + (-1.0 . "^[^a-z]+@") + + (-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@" + (-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@" + (-3.0 . "[A-Z][A-Z][a-z][a-z].*@") + (-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@") + + (-2.0 . "^[0-9]") + (-1.0 . "^[0-9][0-9]") + ;; + ;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/; + (-3.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") + ;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/; + (-5.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") + ;; + (-3.0 . "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@" + (-3.0 . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@") + ;; "[0-9]{8,}.*\@" + (-3.0 + . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@") + ;; "[0-9]{12,}.*\@" + ;; compensation for TDMA dated mail addresses: + (25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@") + ;; + (-20.0 . "\\.fsf@") ;; Gnus + (-20.0 . "^slrn") + (-20.0 . "^Pine") + (-20.0 . "_-_") ;; Subject change in thread + ;; + (-20.0 . "\\.ln@") ;; leafnode + (-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de") + (-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent + ;; + ;; (5.0 . "") ;; $local_part_len <= 7 + (10.0 . "^[^0-9]+@") + (3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@") + ;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part + (3.0 . "\@stud") + ;; + (2.0 . "[a-z][a-z][._-][A-Z][a-z].*@") + ;; + (0.5 . "^[A-Z][a-z]") + (0.5 . "^[A-Z][a-z][a-z]") + (1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3} + (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4} + "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. + +A negative RATE indicates a message IDs, whereas a positive indicates a mail +address. The REGEXP is processed with `case-fold-search' set to `nil'." :group 'gnus-article-buttons - :type 'regexp) + :type '(repeat (cons (number :tag "Rate") + (regexp :tag "Regexp")))) + +(defun gnus-button-mid-or-mail-heuristic (mid-or-mail) + "Guess whether MID-OR-MAIL is a message ID or a mail address. +Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail +address, `ask' if unsure and `invalid' if the string is invalid." + (let ((case-fold-search nil) + (list gnus-button-mid-or-mail-heuristic-alist) + (result 0) rate regexp lpartlen elem) + (setq lpartlen + (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) + (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) + ;; Certain special cases... + (when (string-match + (concat + "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$" "\\|" + "^[0-9]+\.[0-9]+\@compuserve") + mid-or-mail) + (gnus-message 8 "`%s' is a known mail address.") + (setq result 'mail)) + (when (string-match "@.*@\\| " mid-or-mail) + (gnus-message 8 "`%s' is invalid.") + (setq result 'invalid)) + ;; Nothing more to do, if result is not a number here... + (when (numberp result) + (while list + (setq elem (car list) + rate (car elem) + regexp (cdr elem) + list (cdr list)) + (when (string-match regexp mid-or-mail) + (setq result (+ result rate)) + (gnus-message + 9 "`%s' matched `%s', rate `%s', result `%s'." + mid-or-mail regexp rate result))) + (when (<= lpartlen 7) + (setq result (+ result 5.0)) + (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'." + mid-or-mail result)) + (when (>= lpartlen 12) + (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail) + (cond + ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail) + ;; Long local part should contain realname if e-mail address, + ;; too many digits: message-id. + ;; $score -= 5.0 + 0.1 * $local_part_len; + (setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen)))) + (setq result (+ result rate)) + (gnus-message + 9 "Many digits in `%s', rate `%s', result `%s'." + mid-or-mail rate result)) + ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@" + mid-or-mail) + ;; Too few vowels [^aeiouy]{4,}.*\@ + (setq result (+ result -5.0)) + (gnus-message + 9 "Few vowels in `%s', rate `%s', result `%s'." + mid-or-mail -5.0 result)) + (t + (setq result (+ result 5.0)) + (gnus-message + 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result))))) + (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result) + (cond + ;; Maybe we should make this a customizable alist: (condition . 'result) + ((< result -10.0) 'mid) + ((> result 10.0) 'mail) + (t 'ask)))) (defun gnus-button-handle-mid-or-mail (mid-or-mail) - (let* ((pref gnus-button-prefer-mid-or-mail) + (let* ((pref gnus-button-prefer-mid-or-mail) guessed (url-mid (concat "news" ":" mid-or-mail)) (url-mailto (concat "mailto" ":" mid-or-mail))) (gnus-message 9 "mid-or-mail=%s" mid-or-mail) - ;; If it looks like a MID (well known readers or servers) use 'mid, - ;; otherwise 'ask the user. - (if (eq pref 'guess) - (if (string-match gnus-button-guessed-mid-regexp mid-or-mail) - (setq pref 'mid) - (setq pref 'ask))) + (when (fboundp pref) + (setq guessed + ;; get rid of surrounding angles... + (funcall pref + (gnus-replace-in-string mid-or-mail "^<\\|>$" ""))) + (if (or (eq 'mid guessed) (eq 'mail guessed)) + (setq pref guessed) + (setq pref 'ask))) (if (eq pref 'ask) (save-window-excursion (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? ")) (setq pref 'mail) (setq pref 'mid)))) (cond ((eq pref 'mid) - (gnus-message 9 "calling `gnus-button-handle-news' %s" url-mid) + (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid) (gnus-button-handle-news url-mid)) ((eq pref 'mail) - (gnus-message 9 "calling `gnus-url-mailto' %s" url-mailto) - (gnus-url-mailto url-mailto))))) + (gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto) + (gnus-url-mailto url-mailto)) + (t (gnus-message 3 "Invalid string."))))) (defun gnus-button-handle-custom (url) "Follow a Custom URL." @@ -6106,7 +6382,10 @@ specified by `gnus-button-alist'." gnus-callback gnus-article-button-prev-page article-type annotation)) (widget-convert-button - 'link b (point) + 'link b (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point)) :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) @@ -6153,7 +6432,10 @@ specified by `gnus-button-alist'." gnus-callback gnus-article-button-next-page article-type annotation)) (widget-convert-button - 'link b (point) + 'link b (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point)) :action 'gnus-button-next-page :button-keymap gnus-next-page-map))) @@ -6326,7 +6608,7 @@ For example: (search-forward field nil t)) (prog2 (message-narrow-to-field) - (buffer-substring (point-min) (point-max)) + (buffer-string) (delete-region (point-min) (point-max)) (widen)))) '("Content-Type:" "Content-Transfer-Encoding:" @@ -6495,7 +6777,10 @@ For example: gnus-mime-details ,gnus-mime-security-button-pressed article-type annotation gnus-data ,handle)) - (setq e (point)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) (widget-convert-button 'link b e :mime-handle handle diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index e293a80..6431c81 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -462,8 +462,7 @@ Returns the list of articles removed." (when (or (looking-at (concat (int-to-string number) "\t")) (search-forward (concat "\n" (int-to-string number) "\t") (point-max) t)) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) + (gnus-delete-line))) (unless (setq gnus-newsgroup-cached (delq article gnus-newsgroup-cached)) (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) @@ -514,7 +513,7 @@ Returns the list of articles removed." (set-buffer cache-buf) (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") nil t) - (setq beg (progn (beginning-of-line) (point)) + (setq beg (gnus-point-at-bol) end (progn (end-of-line) (point))) (setq beg nil)) (set-buffer nntp-server-buffer) diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index f3e53a2..a119ac7 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -29,7 +29,6 @@ (eval-when-compile (require 'cl)) (require 'gnus) -(require 'gnus-art) (require 'gnus-range) (require 'message) ; for message-cite-prefix-regexp @@ -91,19 +90,42 @@ The first regexp group should match the Supercite attribution." :group 'gnus-cite :type 'integer) +;; Some Microsoft products put in a citation that extends to the +;; remainder of the message: +;; +;; -----Original Message----- +;; From: ... +;; To: ... +;; Sent: ... [date, in non-RFC-2822 format] +;; Subject: ... +;; +;; Cited message, with no prefixes +;; +;; The four headers are always the same. But note they are prone to +;; folding without additional indentation. +;; +;; Others use "----- Original Message -----" instead, and properly quote +;; the body using "> ". This style is handled without special cases. + (defcustom gnus-cite-attribution-prefix - "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----" + "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----" "*Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$" + "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" "*Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite :type 'regexp) +(defcustom gnus-cite-unsightly-citation-regexp + "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" + "Regexp matching Microsoft-type rest-of-message citations." + :group 'gnus-cite + :type 'regexp) + (defface gnus-cite-attribution-face '((t (:italic t))) "Face used for attribution lines.") @@ -251,6 +273,17 @@ This should make it easier to see who wrote what." :group 'gnus-cite :type 'boolean) +;; This has to go here because its default value depends on +;; gnus-cite-face-list. +(defcustom gnus-article-boring-faces (cons 'gnus-signature-face + gnus-cite-face-list) + "List of faces that are not worth reading. +If an article has more pages below the one you are looking at, but +nothing on those pages is a word of at least three letters that is not +in a boring face, then the pages will be skipped." + :type '(repeat face) + :group 'gnus-article-hiding) + ;;; Internal Variables: (defvar gnus-cite-article nil) @@ -339,7 +372,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (goto-char (point-min)) (forward-line (1- number)) (when (re-search-forward gnus-cite-attribution-suffix - (save-excursion (end-of-line 1) (point)) + (gnus-point-at-eol) t) (gnus-article-add-button (match-beginning 1) (match-end 1) 'gnus-cite-toggle prefix)) @@ -690,7 +723,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;; Each line. (setq begin (point) guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) - end (progn (beginning-of-line 2) (point)) + end (gnus-point-at-bol 2) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. @@ -714,9 +747,19 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char begin)) (goto-char start) (setq line (1+ line))) + ;; Horrible special case for some Microsoft mailers. + (goto-char (point-min)) + (when (re-search-forward gnus-cite-unsightly-citation-regexp max t) + (setq begin (count-lines (point-min) (point))) + (setq end (count-lines (point-min) max)) + (setq entry nil) + (while (< begin end) + (push begin entry) + (setq begin (1+ begin))) + (push (cons "" entry) alist)) ;; We got all the potential prefixes. Now create ;; `gnus-cite-prefix-alist' containing the oldest prefix for each - ;; line that appears at least gnus-cite-minimum-match-count + ;; line that appears at least `gnus-cite-minimum-match-count' ;; times. First sort them by length. Longer is older. (setq alist (sort alist (lambda (a b) (> (length (car a)) (length (car b)))))) @@ -992,6 +1035,17 @@ See also the documentation for `gnus-article-highlight-citation'." (while vars (make-local-variable (pop vars))))) +(defun gnus-cited-line-p () + "Say whether the current line is a cited line." + (save-excursion + (beginning-of-line) + (let ((found nil)) + (dolist (prefix (mapcar 'car gnus-cite-prefix-alist)) + (when (string= (buffer-substring (point) (+ (length prefix) (point))) + prefix) + (setq found t))) + found))) + (gnus-ems-redefine) (provide 'gnus-cite) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 2f80b47..ba32cbe 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -29,6 +29,7 @@ (require 'wid-edit) (require 'gnus) +(require 'gnus-agent) (require 'gnus-score) (require 'gnus-topic) (require 'gnus-art) @@ -263,6 +264,62 @@ Server-assigned value attached to IMAP groups, used to maintain consistency.")) Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a documentation string for the parameter.") + +(eval-and-compile + (defconst gnus-agent-parameters + '((agent-predicate + (sexp :tag "Selection Predicate" :value false) + "Predicate used to automatically select articles for downloading." + gnus-agent-cat-predicate) + (agent-score + (choice :tag "Score File" :value nil + (const file :tag "Use group's score files") + (repeat (list (string :format "%v" :tag "File name")))) + "Which score files to use when using score to select articles to fetch. + + `nil' + All articles will be scored to zero (0). + + `file' + The group's score files will be used to score the articles. + + `List' + A list of score file names." + gnus-agent-cat-score-file) + (agent-short-article + (integer :tag "Max Length of Short Article" :value "") + "The SHORT predicate will evaluate to true when the article is +shorter than this length." gnus-agent-cat-length-when-short) + (agent-long-article + (integer :tag "Min Length of Long Article" :value "") + "The LONG predicate will evaluate to true when the article is +longer than this length." gnus-agent-cat-length-when-long) + (agent-low-score + (integer :tag "Low Score Limit" :value "") + "The LOW predicate will evaluate to true when the article scores +lower than this limit." gnus-agent-cat-low-score) + (agent-high-score + (integer :tag "High Score Limit" :value "") + "The HIGH predicate will evaluate to true when the article scores +higher than this limit." gnus-agent-cat-high-score) + (agent-days-until-old + (integer :tag "Days Until Old" :value "") + "The OLD predicate will evaluate to true when the fetched article +has been stored locally for at least this many days." + gnus-agent-cat-days-until-old) + (agent-enable-expiration + (radio :tag "Expire in this Group or Topic" :value nil +; (const :format "Inherit " nil) + (const :format "Enable " ENABLE) + (const :format "Disable " DISABLE)) + "\nEnable, or disable, agent expiration in this group or topic." + gnus-agent-cat-enable-expiration) ) + "Alist of group parameters that are not also topic parameters. + +Each entry has the form (NAME TYPE DOC), where NAME is the parameter +itself (a symbol), TYPE is the parameters type (a sexp widget), and +DOC is a documentation string for the parameter.")) + (defvar gnus-custom-params) (defvar gnus-custom-method) (defvar gnus-custom-group) @@ -281,7 +338,25 @@ DOC is a documentation string for the parameter.") gnus-group-parameters (if group gnus-extra-group-parameters - gnus-extra-topic-parameters))))) + gnus-extra-topic-parameters)))) + (agent (mapcar (lambda (entry) + (let ((type (nth 1 entry)) + vcons) + (if (listp type) + (setq type (copy-sequence type))) + + (setq vcons (cdr (memq :value type))) + + (if (symbolp (car vcons)) + (condition-case nil + (setcar vcons (symbol-value (car vcons))) + (error))) + `(cons :format "%v%h\n" + :doc ,(nth 2 entry) + (const :format "" ,(nth 0 entry)) + ,type))) + (if gnus-agent + gnus-agent-parameters)))) (unless (or group topic) (error "No group on current line")) (when (and group topic) @@ -289,7 +364,7 @@ DOC is a documentation string for the parameter.") (unless (or topic (setq info (gnus-get-info group))) (error "Killed group; can't be edited")) ;; Ready. - (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) + (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) (gnus-custom-mode) (make-local-variable 'gnus-custom-group) @@ -316,24 +391,54 @@ DOC is a documentation string for the parameter.") :action 'gnus-group-customize-done) (widget-insert ".\n\n") (make-local-variable 'gnus-custom-params) - (setq gnus-custom-params - (widget-create 'group - :value (if group - (gnus-info-params info) - (gnus-topic-parameters topic)) - `(set :inline t - :greedy t - :tag "Parameters" - :format "%t:\n%h%v" - :doc "\ + + (let ((values (if group + (gnus-info-params info) + (gnus-topic-parameters topic)))) + + ;; The parameters in values may contain duplicates. This is + ;; normally OK as assq returns the first. However, right here + ;; every duplicate ends up being displayed. So, rather than + ;; display them, remove them from the list. + + (let ((tmp (setq values (gnus-copy-sequence values))) + elem) + (while (cdr tmp) + (while (setq elem (assq (caar tmp) (cdr tmp))) + (delq elem tmp)) + (setq tmp (cdr tmp)))) + + (setq gnus-custom-params + (apply 'widget-create 'group + :value values + (delq nil + (list `(set :inline t + :greedy t + :tag "Parameters" + :format "%t:\n%h%v" + :doc "\ These special parameters are recognized by Gnus. Check the [ ] for the parameters you want to apply to this group or to the groups in this topic, then edit the value to suit your taste." - ,@types) - '(repeat :inline t - :tag "Variables" - :format "%t:\n%h%v%i\n\n" - :doc "\ + ,@types) + (when gnus-agent + `(set :inline t + :greedy t + :tag "Agent Parameters" + :format "%t:\n%h%v" + :doc "\ These agent parameters are +recognized by Gnus. They control article selection and expiration for +use in the unplugged cache. Check the [ ] for the parameters you want +to apply to this group or to the groups in this topic, then edit the +value to suit your taste. + +For those interested, group parameters override topic parameters while +topic parameters override agent category parameters. Underlying +category parameters are the customizable variables." ,@agent)) + '(repeat :inline t + :tag "Variables" + :format "%t:\n%h%v%i\n\n" + :doc "\ Set variables local to the group you are entering. If you want to turn threading off in `news.answers', you could put @@ -346,14 +451,14 @@ like. If you want to hear a beep when you enter a group, you could put something like `(dummy-variable (ding))' in the parameters of that group. `dummy-variable' will be set to the result of the `(ding)' form, but who cares?" - (list :format "%v" :value (nil nil) - (symbol :tag "Variable") - (sexp :tag - "Value"))) - - '(repeat :inline t - :tag "Unknown entries" - sexp))) + (list :format "%v" :value (nil nil) + (symbol :tag "Variable") + (sexp :tag + "Value"))) + + '(repeat :inline t + :tag "Unknown entries" + sexp)))))) (when group (widget-insert "\n\nYou can also edit the ") (widget-create 'info-link @@ -771,6 +876,163 @@ articles in the thread. (gnus-score-set 'touched '(t) alist)) (bury-buffer)) +(eval-when-compile + (defvar category-fields nil) + (defvar gnus-agent-cat-predicate nil) + (defvar gnus-agent-cat-score-file nil) + (defvar gnus-agent-cat-length-when-short nil) + (defvar gnus-agent-cat-length-when-long nil) + (defvar gnus-agent-cat-low-score nil) + (defvar gnus-agent-cat-high-score nil) + (defvar gnus-agent-cat-groups nil) + (defvar gnus-agent-cat-enable-expiration nil) + (defvar gnus-agent-cat-days-until-old nil) + (defvar gnus-agent-cat-name nil) +) + +(defun gnus-trim-whitespace (s) + (when (string-match "\\`[ \n\t]+" s) + (setq s (substring s (match-end 0)))) + (when (string-match "[ \n\t]+\\'" s) + (setq s (substring s 0 (match-beginning 0)))) + s) + +(defmacro gnus-agent-cat-prepare-category-field (parameter) + (let* ((entry (assq parameter gnus-agent-parameters)) + (field (nth 3 entry))) + `(let* ((type (copy-sequence + (nth 1 (assq ',parameter gnus-agent-parameters)))) + (val (,field info)) + (deflt (if (,field defaults) + (concat " [" (gnus-trim-whitespace + (pp-to-string (,field defaults))) "]")))) + + (if (eq (car type) 'radio) + (let* ((rtype (nreverse type)) + (rt rtype)) + (while (listp (or (cadr rt) 'not-list)) + (setq rt (cdr rt))) + + (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt))) + (setq type (nreverse rtype)))) + + (if deflt + (let ((tag (cdr (memq :tag type)))) + (if (string-match "\n" deflt) + (progn (while (progn (setq deflt (replace-match "\n " t t + deflt)) + (string-match "\n" deflt (match-end 0)))) + (setq deflt (concat "\n" deflt)))) + + (setcar tag (concat (car tag) deflt)))) + + (widget-insert "\n") + + (set (make-local-variable ',field) + (if val + (widget-create type :value val) + (widget-create type))) + (widget-put ,field :default val) + (widget-put ,field :accessor ',field) + (push ,field category-fields)))) + +(defun gnus-agent-customize-category (category) + "Edit the CATEGORY." + (interactive (list (gnus-category-name))) + (let ((info (assq category gnus-category-alist)) + (defaults (list nil '(agent-predicate . false) + (cons 'agent-enable-expiration + gnus-agent-enable-expiration) + '(agent-days-until-old . 7) + (cons 'agent-length-when-short + gnus-agent-short-article) + (cons 'agent-length-when-long gnus-agent-long-article) + (cons 'agent-low-score gnus-agent-low-score) + (cons 'agent-high-score gnus-agent-high-score)))) + + (let ((old (get-buffer "*Gnus Agent Category Customize*"))) + (when old + (gnus-kill-buffer old))) + (switch-to-buffer (gnus-get-buffer-create + "*Gnus Agent Category Customize*")) + + (let ((inhibit-read-only t)) + (gnus-custom-mode) + (buffer-disable-undo) + + (let* ((name (gnus-agent-cat-name info))) + (widget-insert "Customize the Agent Category '") + (widget-insert (symbol-name name)) + (widget-insert "' and press ") + (widget-create + 'push-button + :notify + '(lambda (&rest ignore) + (let* ((info (assq gnus-agent-cat-name gnus-category-alist)) + (widgets category-fields)) + (while widgets + (let* ((widget (pop widgets)) + (value (ignore-errors (widget-value widget)))) + (eval `(setf (,(widget-get widget :accessor) ',info) + ',value))))) + (gnus-category-write) + (gnus-kill-buffer (current-buffer)) + (when (get-buffer gnus-category-buffer) + (switch-to-buffer (get-buffer gnus-category-buffer)) + (gnus-category-list))) + "Done") + (widget-insert + "\n Note: Empty fields default to the customizable global\ + variables.\n\n") + + (set (make-local-variable 'gnus-agent-cat-name) + name)) + + (set (make-local-variable 'category-fields) nil) + (gnus-agent-cat-prepare-category-field agent-predicate) + + (gnus-agent-cat-prepare-category-field agent-score) + (gnus-agent-cat-prepare-category-field agent-short-article) + (gnus-agent-cat-prepare-category-field agent-long-article) + (gnus-agent-cat-prepare-category-field agent-low-score) + (gnus-agent-cat-prepare-category-field agent-high-score) + + ;; The group list is NOT handled with + ;; gnus-agent-cat-prepare-category-field as I don't want the + ;; group list to appear when customizing a topic. + (widget-insert "\n") + (set (make-local-variable 'gnus-agent-cat-groups) + (widget-create + `(choice + :format "%[Select Member Groups%]\n%v" :value ignore + (const :menu-tag "do not change" :tag "" :value ignore) + (checklist :entry-format "%b %v" + :menu-tag "display group selectors" + :greedy t + :value ,(delq nil + (mapcar + (lambda (newsrc) + (car (member + (gnus-info-group newsrc) + (gnus-agent-cat-groups info)))) + (cdr gnus-newsrc-alist))) + ,@(mapcar (lambda (newsrc) + `(const ,(gnus-info-group newsrc))) + (cdr gnus-newsrc-alist)))))) + + (widget-put gnus-agent-cat-groups :default (gnus-agent-cat-groups info)) + (widget-put gnus-agent-cat-groups :accessor 'gnus-agent-cat-groups) + (push gnus-agent-cat-groups category-fields) + + (widget-insert "\nExpiration Settings ") + + (gnus-agent-cat-prepare-category-field agent-enable-expiration) + (gnus-agent-cat-prepare-category-field agent-days-until-old) + + (use-local-map widget-keymap) + (widget-setup) + (buffer-enable-undo)))) + ;;; The End: (provide 'gnus-cus) diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 6c9c13c..cbde8b0 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -140,13 +140,20 @@ message-send-hook)) (message-setup-hook (and group (not (equal group "nndraft:queue")) message-setup-hook)) - type method) + type method move-to) (gnus-draft-setup article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction (message-narrow-to-head) (when (re-search-forward + (concat "^" (regexp-quote gnus-agent-target-move-group-header) + ":") nil t) + (skip-syntax-forward "-") + (setq move-to (buffer-substring (point) (gnus-point-at-eol))) + (message-remove-header gnus-agent-target-move-group-header)) + (goto-char (point-min)) + (when (re-search-forward (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") nil t) (setq type (ignore-errors (read (current-buffer))) @@ -164,8 +171,12 @@ (message-this-is-mail (eq type 'mail)) (gnus-post-method method) (message-post-method method)) - (message-send-and-exit)) - (message-send-and-exit))) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit))) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit)))) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) (or group "nndraft:queue") t))))) @@ -242,6 +253,7 @@ (ignore-errors (setq ga (car (read-from-string ga))))) (setq gnus-newsgroup-name (if (equal (car ga) "") nil (car ga))) + (gnus-configure-posting-styles) (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) (setq message-post-method `(lambda (arg) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 3c0b6cd..1a291f6 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -445,6 +445,7 @@ simple manner.") ;;; Internal variables (defvar gnus-group-is-exiting-p nil) +(defvar gnus-group-is-exiting-without-update-p nil) (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat "Function for sorting the group buffer.") @@ -729,7 +730,7 @@ simple manner.") (defun gnus-topic-mode-p () "Return non-nil in `gnus-topic-mode'." (and (boundp 'gnus-topic-mode) - gnus-topic-mode)) + (symbol-value 'gnus-topic-mode))) (defun gnus-group-make-menu-bar () (gnus-turn-off-edit-menu 'group) @@ -960,7 +961,7 @@ simple manner.") ;; Emacs 21 tool bar. Should be no-op otherwise. (defun gnus-group-make-tool-bar () - (if (and + (if (and (condition-case nil (require 'tool-bar) (error nil)) (fboundp 'tool-bar-add-item-from-menu) (default-value 'tool-bar-mode) @@ -1449,7 +1450,7 @@ if it is a string, only list groups matching REGEXP." "Highlight the current line according to `gnus-group-highlight'." (let* ((list gnus-group-highlight) (p (point)) - (end (progn (end-of-line) (point))) + (end (gnus-point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) (group (gnus-group-group-name)) @@ -1876,6 +1877,8 @@ If the group is opened, just switch the summary buffer. If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." (interactive "P") + (when (and (eobp) (not (gnus-group-group-name))) + (forward-line -1)) (gnus-group-read-group all t)) (defun gnus-group-quick-select-group (&optional all) @@ -3488,6 +3491,7 @@ re-scanning. If ARG is non-nil and not a number, this will force ;; Binding this variable will inhibit multiple fetchings ;; of the same mail source. (nnmail-fetched-sources (list t))) + (gnus-run-hooks 'gnus-get-top-new-news-hook) (gnus-run-hooks 'gnus-get-new-news-hook) ;; Read any slave files. diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index ca5539b..e89e9da 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -347,7 +347,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (cond ((and gnus-use-cache (numberp (car articles))) (gnus-cache-retrieve-headers articles group fetch-old)) - ((and gnus-agent gnus-agent-cache (gnus-online gnus-command-method) + ((and gnus-agent (gnus-online gnus-command-method) (gnus-agent-method-p gnus-command-method)) (gnus-agent-retrieve-headers articles group fetch-old)) (t @@ -419,9 +419,7 @@ If BUFFER, insert the article in that group." (setq res (cons group article) clean-up t)) ;; Check the agent cache. - ((and gnus-agent gnus-agent-cache gnus-plugged - (numberp article) - (gnus-agent-request-article article group)) + ((gnus-agent-request-article article group) (setq res (cons group article) clean-up t)) ;; Use `head' function. @@ -454,9 +452,7 @@ If BUFFER, insert the article in that group." (setq res (cons group article) clean-up t)) ;; Check the agent cache. - ((and gnus-agent gnus-agent-cache gnus-plugged - (numberp article) - (gnus-agent-request-article article group)) + ((gnus-agent-request-article article group) (setq res (cons group article) clean-up t)) ;; Use `head' function. @@ -526,18 +522,22 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (gnus-get-function gnus-command-method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 gnus-command-method) force))) - (when (and gnus-agent gnus-agent-cache (gnus-agent-method-p gnus-command-method)) + (when (and gnus-agent + (gnus-agent-method-p gnus-command-method)) (let ((expired-articles (gnus-sorted-difference articles not-deleted))) (when expired-articles (gnus-agent-expire expired-articles group 'force)))) not-deleted)) -(defun gnus-request-move-article (article group server accept-function &optional last) +(defun gnus-request-move-article (article group server accept-function + &optional last) (let* ((gnus-command-method (gnus-find-method-for-group group)) - (result (funcall (gnus-get-function gnus-command-method 'request-move-article) + (result (funcall (gnus-get-function gnus-command-method + 'request-move-article) article (gnus-group-real-name group) (nth 1 gnus-command-method) accept-function last))) - (when (and result gnus-agent gnus-agent-cache (gnus-agent-method-p gnus-command-method)) + (when (and result gnus-agent + (gnus-agent-method-p gnus-command-method)) (gnus-agent-expire (list article) group 'force)) result)) diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index dd6a774..41965a9 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -578,7 +578,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (insert "\n t")) (insert ")") (prog1 - (buffer-substring (point-min) (point-max)) + (buffer-string) (kill-buffer (current-buffer)))))) (defun gnus-execute-1 (function regexp form header) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index b22d3ef..0b57ee0 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -33,6 +33,7 @@ (require 'gnus-ems) (require 'message) (require 'gnus-art) +(require 'gnus-util) (defcustom gnus-post-method 'current "*Preferred method for posting USENET news. @@ -283,10 +284,23 @@ If nil, the address field will always be empty after invoking :group 'gnus-message :type 'boolean) -(defcustom gnus-version-expose-system nil - "If non-nil, `system-configuration' is exposed in `gnus-extended-version'." +(defcustom gnus-user-agent 'emacs-gnus-type + "Which information should be exposed in the User-Agent header. + +It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus' +\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as +`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as +`emacs-gnus' plus system type\) or a custom string. If you set it to a +string, be sure to use a valid format, see RFC 2616." :group 'gnus-message - :type 'boolean) + :type '(choice + (item :tag "Show Gnus and Emacs versions and system type" + emacs-gnus-type) + (item :tag "Show Gnus and Emacs versions and system configuration" + emacs-gnus-config) + (item :tag "Show Gnus and Emacs versions" emacs-gnus) + (item :tag "Show only Gnus version" gnus) + (string :tag "Other"))) ;;; Internal variables. @@ -520,7 +534,9 @@ Gcc: header for archiving purposes." (gnus-post-method arg ,gnus-newsgroup-name))) (setq message-newsreader (setq message-mailer (gnus-extended-version))) (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill) + `(when (gnus-buffer-exists-p ,buffer) + (set-window-configuration ,winconf)) + 'exit 'postpone 'kill) (let ((to-be-marked (cond (yanked yanked) (article (if (listp article) article (list article))) @@ -852,7 +868,9 @@ header line with the old Message-ID." (forward-line 1)) (let ((mail-header-separator "")) (setq beg (point) - end (or (message-goto-body) beg))) + end (or (message-goto-body) + ;; There may be just a header. + (point-max)))) ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) (let ((mail-header-separator "")) @@ -1024,31 +1042,51 @@ If SILENT, don't prompt the user." (defvar xemacs-codename)) (defun gnus-extended-version () - "Stringified Gnus version and Emacs version." + "Stringified Gnus version and Emacs version. +See the variable `gnus-user-agent'." (interactive) - (concat - "Gnus/" (gnus-prin1-to-string (gnus-continuum-version gnus-version)) - " (" gnus-version ")" - " " - (cond - ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) - (concat "Emacs/" (match-string 1 emacs-version) - (if gnus-version-expose-system - " (" system-configuration ")" - ""))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" - emacs-version) - (concat (match-string 1 emacs-version) + (let* ((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) - (if gnus-version-expose-system - (concat " (" xemacs-codename ", " system-configuration ")") - (concat " (" xemacs-codename ")")) - ""))) - (t emacs-version)))) + (concat + " (" xemacs-codename + (if system-v + (concat ", " system-v ")") + ")")) + ""))) + (t emacs-version)))) + (if (stringp gnus-user-agent) + gnus-user-agent + (concat gnus-v + (when emacs-v + (concat " " emacs-v)))))) ;;; @@ -1746,9 +1784,7 @@ this is a reply." group))) (if (not (eq gcc-self-val 'none)) (insert "\n") - (progn - (beginning-of-line) - (kill-line)))) + (gnus-delete-line))) ;; Use the list of groups. (while (setq name (pop groups)) (let ((str (if (string-match ":" name) @@ -1762,6 +1798,16 @@ this is a reply." (insert " "))) (insert "\n"))))))) +(defun gnus-mailing-list-followup-to () + "Look at the headers in the current buffer and return a Mail-Followup-To address." + (let ((x-been-there (gnus-fetch-original-field "x-beenthere")) + (list-post (gnus-fetch-original-field "list-post"))) + (when (and list-post + (string-match "mailto:\\([^>]+\\)" list-post)) + (setq list-post (match-string 1 list-post))) + (or list-post + x-been-there))) + ;;; Posting styles. (defun gnus-configure-posting-styles (&optional group-name) diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el index 79b4ad5..6c11631 100644 --- a/lisp/gnus-registry.el +++ b/lisp/gnus-registry.el @@ -33,29 +33,53 @@ (require 'gnus-sum) (require 'nnmail) -;; (defcustom gnus-summary-article-spool-hook nil -;; "*A hook called after an article is spooled." -;; :group 'gnus-summary -;; :type 'hook) - -(defun regtest (action id from &optional to method) - (message "Registry: article %s %s from %s to %s" - id - (if method "respooling" "going") - (gnus-group-guess-full-name from) - (if to (gnus-group-guess-full-name to) "the Bit Bucket in the sky"))) - -(defun regtest-nnmail (id group) - (message "Registry: article %s spooled to %s" +(defvar gnus-registry-hashtb nil + "*The article registry by Message ID.") +(setq gnus-registry-hashtb (make-hash-table + :size 4096 + :test 'equal)) ; we test message ID strings equality + +;; sample data-header +;; (defvar tzz-header '(49 "Re[2]: good news" "\"Jonathan Pryor\" " "Mon, 17 Feb 2003 10:41:46 +-0800" "<88288020@dytqq>" "" 896 18 "lockgroove.bwh.harvard.edu spam.asian:49" nil)) + +;; (maphash (lambda (key value) (message "key: %s value: %s" key value)) gnus-registry-hashtb) +;; (clrhash gnus-registry-hashtb) + +;; Function(s) missing in Emacs 20 +(when (memq nil (mapcar 'fboundp '(puthash))) + (require 'cl) + (unless (fboundp 'puthash) + ;; alias puthash is missing from Emacs 20 cl-extra.el + (defalias 'puthash 'cl-puthash))) + +(defun gnus-register-action (action data-header from &optional to method) + (let* ((id (mail-header-id data-header)) + (hash-entry (gethash id gnus-registry-hashtb))) + (gnus-message 5 "Registry: article %s %s from %s to %s" + id + (if method "respooling" "going") + (gnus-group-guess-full-name from) + (if to (gnus-group-guess-full-name to) "the Bit Bucket")) + (unless hash-entry + (setq hash-entry (puthash id (list data-header) gnus-registry-hashtb))) + (puthash id (cons (list action from to method) + (gethash id gnus-registry-hashtb)) gnus-registry-hashtb))) + +(defun gnus-register-spool-action (id group) + (gnus-message 5 "Registry: article %s spooled to %s" id - (gnus-group-prefixed-name group gnus-internal-registry-spool-current-method t))) - -;;(add-hook 'gnus-summary-article-move-hook 'regtest) ; also does copy, respool, and crosspost -;;(add-hook 'gnus-summary-article-delete-hook 'regtest) -;;(add-hook 'gnus-summary-article-expire-hook 'regtest) -(add-hook 'nnmail-spool-hook 'regtest-nnmail) - -;; TODO: + (gnus-group-prefixed-name + group + gnus-internal-registry-spool-current-method + t))) + +(add-hook 'gnus-summary-article-move-hook 'gnus-register-action) ; also does copy, respool, and crosspost +(add-hook 'gnus-summary-article-delete-hook 'gnus-register-action) +(add-hook 'gnus-summary-article-expire-hook 'gnus-register-action) +(add-hook 'nnmail-spool-hook 'gnus-register-spool-action) + +;; TODO: a lot of things +;; TODO: we have to load and save the registry through gnus-save-newsrc-file (provide 'gnus-registry) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 7733f9d..41adecb 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1818,7 +1818,7 @@ score in `gnus-newsgroup-scored' by SCORE." (goto-char (point-min)) (if (= dmt ?e) (while (funcall search-func match nil t) - (and (= (progn (beginning-of-line) (point)) + (and (= (gnus-point-at-bol) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index ce3fcb5..393c8a1 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -494,7 +494,7 @@ are supported for %s." (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") (n (length args))) (with-temp-buffer - (insert-string fstring) + (insert fstring) (goto-char (point-min)) (while (re-search-forward re nil t) (goto-char (match-end 0)) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 0d3e7b0..b212ec4 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -41,6 +41,24 @@ :group 'gnus-start :type 'file) +(defcustom gnus-backup-startup-file 'never + "Whether to create backup files. +This variable takes the same values as the `version-control' +variable." + :group 'gnus-start + :type '(choice (const :tag "Never" never) + (const :tag "If existing" nil) + (other :tag "Always" t))) + +(defcustom gnus-save-startup-file-via-temp-buffer t + "Whether to write the startup file contents to a buffer then save +the buffer or write directly to the file. The buffer is faster +because all of the contents are written at once. The direct write +uses considerably less memory." + :group 'gnus-start + :type '(choice (const :tag "Write via buffer" t) + (const :tag "Write directly to file" nil))) + (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") "Your Gnus Emacs-Lisp startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead." @@ -369,6 +387,11 @@ This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) +(defcustom gnus-get-top-new-news-hook nil + "A hook run just before Gnus checks for new news globally." + :group 'gnus-group-new + :type 'hook) + (defcustom gnus-get-new-news-hook nil "A hook run just before Gnus checks for new news." :group 'gnus-group-new @@ -593,16 +616,21 @@ the first newsgroup." ;;; General various misc type functions. ;; Silence byte-compiler. -(defvar gnus-current-headers) -(defvar gnus-thread-indent-array) -(defvar gnus-newsgroup-name) -(defvar gnus-newsgroup-headers) -(defvar gnus-group-list-mode) -(defvar gnus-group-mark-positions) -(defvar gnus-newsgroup-data) -(defvar gnus-newsgroup-unreads) -(defvar nnoo-state-alist) -(defvar gnus-current-select-method) +(eval-when-compile + (defvar gnus-current-headers) + (defvar gnus-thread-indent-array) + (defvar gnus-newsgroup-name) + (defvar gnus-newsgroup-headers) + (defvar gnus-group-list-mode) + (defvar gnus-group-mark-positions) + (defvar gnus-newsgroup-data) + (defvar gnus-newsgroup-unreads) + (defvar nnoo-state-alist) + (defvar gnus-current-select-method) + (defvar mail-sources) + (defvar nnmail-scan-directory-mail-source-once) + (defvar nnmail-split-history) + (defvar nnmail-spool-file)) (defun gnus-close-all-servers () "Close all servers." @@ -1452,7 +1480,7 @@ newsgroup." t) (if (or debug-on-error debug-on-quit) (inline (gnus-request-group group dont-check method)) - (condition-case () + (condition-case nil (inline (gnus-request-group group dont-check method)) ;;(error nil) (quit @@ -1553,7 +1581,8 @@ newsgroup." (setq range (cdr range))) (setq num (max 0 (- (cdr active) num))))) ;; Set the number of unread articles. - (when info + (when (and info + (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb)) (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) num))) @@ -2514,6 +2543,12 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-newsrc-options-n out)))) +(eval-and-compile + (defalias 'gnus-long-file-names + (if (fboundp 'msdos-long-file-names) + 'msdos-long-file-names + (lambda () t)))) + (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed @@ -2540,17 +2575,62 @@ If FORCE is non-nil, the .newsrc file is read." ;; Save .newsrc.eld. (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) (make-local-variable 'version-control) - (setq version-control 'never) + (setq version-control gnus-backup-startup-file) (setq buffer-file-name (concat gnus-current-startup-file ".eld")) (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo) (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (let ((coding-system-for-write gnus-ding-file-coding-system)) - (save-buffer)) + (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) + + (if gnus-save-startup-file-via-temp-buffer + (let ((coding-system-for-write gnus-ding-file-coding-system) + (standard-output (current-buffer))) + (gnus-gnus-to-quick-newsrc-format) + (gnus-run-hooks 'gnus-save-quick-newsrc-hook) + (save-buffer)) + (let ((coding-system-for-write gnus-ding-file-coding-system) + (version-control gnus-backup-startup-file) + (startup-file (concat gnus-current-startup-file ".eld")) + (working-dir (file-name-directory gnus-current-startup-file)) + working-file + (i -1)) + ;; Generate the name of a non-existent file. + (while (progn (setq working-file + (format + (if (and (eq system-type 'ms-dos) + (not (gnus-long-file-names))) + "%s#%d.tm#" ; MSDOS limits files to 8+3 + (if (memq system-type '(vax-vms axp-vms)) + "%s$tmp$%d" + "%s#tmp#%d")) + working-dir (setq i (1+ i)))) + (file-exists-p working-file))) + + (unwind-protect + (progn + (gnus-with-output-to-file + working-file + (gnus-gnus-to-quick-newsrc-format) + (gnus-run-hooks 'gnus-save-quick-newsrc-hook)) + + ;; These bindings will mislead the current buffer + ;; into thinking that it is visiting the startup + ;; file. + (let ((buffer-backed-up nil) + (buffer-file-name startup-file) + (file-precious-flag t) + (setmodes (file-modes startup-file))) + ;; Backup the current version of the startup file. + (backup-buffer) + + ;; Replace the existing startup file with the temp file. + (rename-file working-file startup-file t) + (set-file-modes startup-file setmodes))) + (condition-case nil + (delete-file working-file) + (file-error nil))))) + (gnus-kill-buffer (current-buffer)) (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)) @@ -2558,17 +2638,15 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-group-set-mode-line))))) (defun gnus-gnus-to-quick-newsrc-format () - "Insert Gnus variables such as gnus-newsrc-alist in lisp format." - (let ((print-quoted t) - (print-escape-newlines t)) - - (insert ";; -*- emacs-lisp -*-\n") - (insert ";; Gnus startup file.\n") - (insert "\ + "Print Gnus variables such as gnus-newsrc-alist in lisp format." + (princ ";; -*- emacs-lisp -*-\n") + (princ ";; Gnus startup file.\n") + (princ "\ ;; Never delete this file -- if you want to force Gnus to read the ;; .newsrc file (if you have one), touch .newsrc instead.\n") - (insert "(setq gnus-newsrc-file-version " - (gnus-prin1-to-string gnus-version) ")\n") + (princ "(setq gnus-newsrc-file-version ") + (princ (gnus-prin1-to-string gnus-version)) + (princ ")\n") (let* ((gnus-killed-list (if (and gnus-save-killed-list (stringp gnus-save-killed-list)) @@ -2586,9 +2664,11 @@ If FORCE is non-nil, the .newsrc file is read." (while variables (when (and (boundp (setq variable (pop variables))) (symbol-value variable)) - (insert "(setq " (symbol-name variable) " '") - (gnus-prin1 (symbol-value variable)) - (insert ")\n")))))) + (princ "(setq ") + (princ (symbol-name variable)) + (princ " '") + (prin1 (symbol-value variable)) + (princ ")\n"))))) (defun gnus-strip-killed-list () "Return the killed list minus the groups that match `gnus-save-killed-list'." @@ -2836,10 +2916,12 @@ If this variable is nil, don't do anything." (file-name-as-directory (expand-file-name gnus-default-directory)) default-directory))) -(defun gnus-display-time-event-handler () - "Like `display-time-event-handler', but test `display-time-timer'." - (when (gnus-boundp 'display-time-timer) - (display-time-event-handler))) +(eval-and-compile +(defalias 'gnus-display-time-event-handler + (if (gnus-boundp 'display-time-timer) + 'display-time-event-handler + (lambda () "Does nothing as `display-time-timer' is not bound. +Would otherwise be an alias for `display-time-event-handler'." nil)))) ;;;###autoload (defun gnus-fixup-nnimap-unread-after-getting-new-news () diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index a1caf01..596da96 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -321,13 +321,13 @@ place point on some subject line." (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit -summary mode and go back to group mode. If the value is neither nil -nor t, Gnus will select the following unread newsgroup. In +summary mode and go back to group mode. If the value is neither nil +nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmation, and if it is `almost-quietly', the next group will be selected without any confirmation if you are located on the last article in the group. -Finally, if this variable is `slightly-quietly', the `Z n' command +Finally, if this variable is `slightly-quietly', the `\\\\[gnus-summary-catchup-and-goto-next-group]' command will go to the next group without confirmation." :group 'gnus-summary-maneuvering :type '(choice (const :tag "off" nil) @@ -343,6 +343,23 @@ the first unread article." :group 'gnus-summary-maneuvering :type 'boolean) +(defcustom gnus-auto-goto-ignores 'unfetched + "*Says how to handle unfetched articles when maneuvering. + +This variable can either be the symbols `nil' (maneuver to any +article), `undownloaded' (maneuvering while unplugged ignores articles +that have not been fetched), `always-undownloaded' (maneuvering always +ignores articles that have not been fetched), `unfetched' (maneuvering +ignores articles whose headers have not been fetched). + +NOTE: The list of unfetched articles will always be nil when plugged +and, when unplugged, a subset of the undownloaded article list." + :group 'gnus-summary-maneuvering + :type '(choice (const :tag "None" nil) + (const :tag "Undownloaded when unplugged" undownloaded) + (const :tag "Undownloaded" always-undownloaded) + (const :tag "Unfetched" unfetched))) + (defcustom gnus-summary-check-current nil "*If non-nil, consider the current article when moving. The \"unread\" movement commands will stay on the same line if the @@ -360,6 +377,9 @@ and non-`vertical', do both horizontal and vertical recentering." (integer :tag "height") (sexp :menu-tag "both" t))) +(defvar gnus-auto-center-group t + "*If non-nil, always center the group buffer.") + (defcustom gnus-show-all-headers nil "*If non-nil, don't hide any headers." :group 'gnus-article-hiding @@ -1031,9 +1051,10 @@ For example: ((1 . cn-gb-2312) (2 . big5))." integer)) (defcustom gnus-summary-save-parts-default-mime "image/.*" - "*A regexp to match MIME parts when saving multiple parts of a message -with gnus-summary-save-parts (X m). This regexp will be used by default -when prompting the user for which type of files to save." + "*A regexp to match MIME parts when saving multiple parts of a +message with `gnus-summary-save-parts' (\\\\[gnus-summary-save-parts]). +This regexp will be used by default when prompting the user for which +type of files to save." :group 'gnus-summary :type 'regexp) @@ -1250,10 +1271,13 @@ the type of the variable (string, integer, character, etc).") "Sorted list of articles in the current newsgroup that can be processed.") (defvar gnus-newsgroup-unfetched nil - "Sorted list of articles in the current newsgroup whose headers have not been fetched into the agent.") + "Sorted list of articles in the current newsgroup whose headers have +not been fetched into the agent. + +This list will always be a subset of gnus-newsgroup-undownloaded.") (defvar gnus-newsgroup-undownloaded nil - "List of articles in the current newsgroup that haven't been downloaded..") + "List of articles in the current newsgroup that haven't been downloaded.") (defvar gnus-newsgroup-unsendable nil "List of articles in the current newsgroup that won't be sent.") @@ -1502,7 +1526,7 @@ See `gnus-simplify-buffer-fuzzy' for details." (buffer-string)))) (defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to gnus-summary-gather-subject-limit." + "Simplify a subject string according to `gnus-summary-gather-subject-limit'." (cond (gnus-simplify-subject-functions (gnus-map-function gnus-simplify-subject-functions subject)) @@ -1518,7 +1542,7 @@ See `gnus-simplify-buffer-fuzzy' for details." (defsubst gnus-subject-equal (s1 s2 &optional simple-first) "Check whether two subjects are equal. -If optional argument simple-first is t, first argument is already +If optional argument SIMPLE-FIRST is t, first argument is already simplified." (cond ((null simple-first) @@ -2063,7 +2087,18 @@ increase the score of each group you read." ["View all" gnus-mime-view-all-parts t] ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] ["Encrypt body" gnus-article-encrypt-body t] - ["Extract all parts" gnus-summary-save-parts t]) + ["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 t] + ["View part externally" gnus-article-view-part-externally t] + ["View part with charset" gnus-article-view-part-as-charset t] + ["Copy part" gnus-article-copy-part t] + ["Save part" gnus-article-save-part t] + ["View part" gnus-article-view-part t])) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] @@ -3021,10 +3056,6 @@ display only a single character." (point) (current-buffer)))))) -(defun gnus-summary-buffer-name (group) - "Return the summary buffer name of GROUP." - (concat "*Summary " (gnus-group-decoded-name group) "*")) - (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." (let ((buffer (gnus-summary-buffer-name group)) @@ -3533,7 +3564,8 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary)) - (when (get-buffer-window gnus-group-buffer t) + (when (and gnus-auto-center-group + (get-buffer-window gnus-group-buffer t)) ;; Gotta use windows, because recenter does weird stuff if ;; the current buffer ain't the displayed window. (let ((owin (selected-window))) @@ -5850,8 +5882,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) - (progn (end-of-line) (point)))) + (setq xref (buffer-substring (point) (gnus-point-at-eol))) (mail-header-set-xref headers xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) @@ -6014,7 +6045,7 @@ If EXCLUDE-GROUP, do not go to this group." (gnus-group-best-unread-group exclude-group)))) (defun gnus-summary-find-next (&optional unread article backward) - (if backward (gnus-summary-find-prev) + (if backward (gnus-summary-find-prev unread article) (let* ((dummy (gnus-summary-article-intangible-p)) (article (or article (gnus-summary-article-number))) (data (gnus-data-find-list article)) @@ -6029,7 +6060,14 @@ If EXCLUDE-GROUP, do not go to this group." (progn (while data (unless (memq (gnus-data-number (car data)) - gnus-newsgroup-unfetched) + (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) + gnus-newsgroup-undownloaded) + (gnus-plugged + nil) + ((eq gnus-auto-goto-ignores 'unfetched) + gnus-newsgroup-unfetched) + ((eq gnus-auto-goto-ignores 'undownloaded) + gnus-newsgroup-undownloaded))) (when (gnus-data-unread-p (car data)) (setq result (car data) data nil))) @@ -6053,7 +6091,15 @@ If EXCLUDE-GROUP, do not go to this group." (if unread (progn (while data - (unless (memq (gnus-data-number (car data)) gnus-newsgroup-unfetched) + (unless (memq (gnus-data-number (car data)) + (cond ((eq gnus-auto-goto-ignores 'always-undownloaded) + gnus-newsgroup-undownloaded) + (gnus-plugged + nil) + ((eq gnus-auto-goto-ignores 'unfetched) + gnus-newsgroup-unfetched) + ((eq gnus-auto-goto-ignores 'undownloaded) + gnus-newsgroup-undownloaded))) (when (gnus-data-unread-p (car data)) (setq result (car data) data nil))) @@ -6455,14 +6501,13 @@ If FORCE (the prefix), also save the .newsrc file(s)." (interactive) (let* ((group gnus-newsgroup-name) (gnus-group-is-exiting-p t) + (gnus-group-is-exiting-without-update-p t) (quit-config (gnus-group-quit-config group))) (when (or no-questions gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) - (mapcar 'funcall - (delq 'gnus-summary-expire-articles - (copy-sequence gnus-summary-prepare-exit-hook))) + (run-hooks 'gnus-summary-prepare-exit-hook) (when (gnus-buffer-live-p gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) @@ -6485,8 +6530,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-summary-clear-local-variables) (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-clear-local-variables)) - (when (get-buffer gnus-summary-buffer) - (kill-buffer gnus-summary-buffer))) + (gnus-kill-buffer gnus-summary-buffer)) (unless gnus-single-article-buffer (setq gnus-article-current nil)) (when gnus-use-trees @@ -6656,7 +6700,7 @@ in." (defun gnus-summary-next-group (&optional no-article target-group backward) "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected -initially. If NEXT-GROUP, go to this group. If BACKWARD, go to +initially. If TARGET-GROUP, go to this group. If BACKWARD, go to previous group instead." (interactive "P") ;; Stop pre-fetching. @@ -6664,6 +6708,11 @@ previous group instead." (let ((current-group gnus-newsgroup-name) (current-buffer (current-buffer)) entered) + ;; First we semi-exit this group to update Xrefs and all variables. + ;; We can't do a real exit, because the window conf must remain + ;; the same in case the user is prompted for info, and we don't + ;; want the window conf to change before that... + (gnus-summary-exit t) (while (not entered) ;; Then we find what group we are supposed to enter. (set-buffer gnus-group-buffer) @@ -6688,20 +6737,10 @@ previous group instead." (let ((unreads (gnus-group-group-unread))) (if (and (or (eq t unreads) (and unreads (not (zerop unreads)))) - (progn - ;; Now we semi-exit this group to update Xrefs - ;; and all variables. We can't do a real exit, - ;; because the window conf must remain the same - ;; in case the user is prompted for info, and we - ;; don't want the window conf to change before - ;; that... - (when (gnus-buffer-live-p current-buffer) - (set-buffer current-buffer) - (gnus-summary-exit t)) - (gnus-summary-read-group - target-group nil no-article - (and (buffer-name current-buffer) current-buffer) - nil backward))) + (gnus-summary-read-group + target-group nil no-article + (and (buffer-name current-buffer) current-buffer) + nil backward)) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -7098,7 +7137,8 @@ If STOP is non-nil, just stop when reaching the end of the message." (gnus-summary-display-article article) (when article-window (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-next-page lines))) + (setq endp (or (gnus-article-next-page lines) + (gnus-article-only-boring-p)))) (when endp (cond (stop (gnus-message 3 "End of message")) @@ -7957,13 +7997,18 @@ of what's specified by the `gnus-refer-thread-limit' variable." (unless (eq gnus-fetch-old-headers 'invisible) (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) ;; Retrieve the headers and read them in. - (if (eq (gnus-retrieve-headers - (list (min - (+ (mail-header-number - (gnus-summary-article-header)) - limit) - gnus-newsgroup-end)) - gnus-newsgroup-name (* limit 2)) + (if (eq (if (numberp limit) + (gnus-retrieve-headers + (list (min + (+ (mail-header-number + (gnus-summary-article-header)) + limit) + gnus-newsgroup-end)) + gnus-newsgroup-name (* limit 2)) + ;; gnus-refer-thread-limit is t, i.e. fetch _all_ + ;; headers. + (gnus-retrieve-headers (list gnus-newsgroup-end) + gnus-newsgroup-name limit)) 'nov) (gnus-build-all-threads) (error "Can't fetch thread from backends that don't support NOV")) @@ -8003,9 +8048,10 @@ of what's specified by the `gnus-refer-thread-limit' variable." ;; We fetch the article. (catch 'found (dolist (gnus-override-method (gnus-refer-article-methods)) - (gnus-check-server gnus-override-method) - ;; Fetch the header, and display the article. - (when (setq number (gnus-summary-insert-subject message-id)) + (when (and (gnus-check-server gnus-override-method) + ;; Fetch the header, + (setq number (gnus-summary-insert-subject message-id))) + ;; and display the article. (gnus-summary-select-article nil nil nil number) (throw 'found t))) (gnus-message 3 "Couldn't fetch article %s" message-id))))))) @@ -8559,7 +8605,7 @@ If ARG is a negative number, hide the unwanted header lines." (1- (point)) (point-max)))) (insert-buffer-substring gnus-original-article-buffer s e) - (article-decode-encoded-words) + (run-hooks 'gnus-article-decode-hook) (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) @@ -8773,14 +8819,15 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (nnheader-get-report (car to-method)))) ((eq art-group 'junk) (when (eq action 'move) - (let ((id (mail-header-id (gnus-data-header - (assoc article (gnus-data-list nil)))))) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article) - ;; run the move/copy/crosspost/respool hook - (run-hook-with-args 'gnus-summary-article-delete-hook - action id gnus-newsgroup-name nil - select-method)))) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article) + ;; run the delete hook + (run-hook-with-args 'gnus-summary-article-delete-hook + action + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name nil + select-method))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -8861,15 +8908,17 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." article gnus-newsgroup-name (current-buffer)))) ;; run the move/copy/crosspost/respool hook - (let ((id (mail-header-id (gnus-data-header - (assoc article (gnus-data-list nil)))))) (run-hook-with-args 'gnus-summary-article-move-hook - action id gnus-newsgroup-name to-newsgroup - select-method))) + action + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + to-newsgroup + select-method)) ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) @@ -9041,8 +9090,9 @@ This will be the case if the article has both been mailed and posted." (defun gnus-summary-expire-articles (&optional now) "Expire all articles that are marked as expirable in the current group." (interactive) - (when (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name) + (when (and (not gnus-group-is-exiting-without-update-p) + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)) ;; This backend supports expiry. (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) (expirable (if total @@ -9087,12 +9137,13 @@ This will be the case if the article has both been mailed and posted." (when (and (not (memq article es)) (gnus-data-find article)) (gnus-summary-mark-article article gnus-canceled-mark) - (let ((id (mail-header-id (gnus-data-header - (assoc article - (gnus-data-list nil)))))) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete id gnus-newsgroup-name nil - nil))))))) + (run-hook-with-args 'gnus-summary-article-expire-hook + 'delete + (gnus-data-header + (assoc article (gnus-data-list nil))) + gnus-newsgroup-name + nil + nil)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -9756,7 +9807,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." t) (defun gnus-summary-update-download-mark (article) - "Update the secondary (read, process, cache) mark." + "Update the download mark." (gnus-summary-update-mark (cond ((memq article gnus-newsgroup-undownloaded) gnus-undownloaded-mark) @@ -10281,8 +10332,8 @@ Returns nil if no thread was there to be shown." (interactive) (let ((buffer-read-only nil) (orig (point)) - ;; first goto end then to beg, to have point at beg after let - (end (progn (end-of-line) (point))) + (end (gnus-point-at-eol)) + ;; Leave point at bol (beg (progn (beginning-of-line) (point)))) (prog1 ;; Any hidden lines here? @@ -11033,8 +11084,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen . (when gnus-summary-selected-face (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) + (let* ((beg (gnus-point-at-bol)) + (end (gnus-point-at-eol)) ;; Fix by Mike Dugan . (from (if (get-text-property beg gnus-mouse-face-prop) beg diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 9d656b8..22ef257 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -752,7 +752,7 @@ articles in the topic and its subtopics." (not (gnus-topic-goto-topic (caaar tp)))) (pop tp)) (if tp - (gnus-topic-forward-topic 1) + (forward-line 1) (gnus-topic-goto-missing-topic (caadr top))))) nil)) @@ -1103,7 +1103,7 @@ articles in the topic and its subtopics." ["Move..." gnus-topic-move-group t] ["Remove" gnus-topic-remove-group t] ["Copy matching..." gnus-topic-copy-matching t] - ["Move matching" gnus-topic-move-matching t]) + ["Move matching..." gnus-topic-move-matching t]) ("Topics" ["Goto..." gnus-topic-jump-to-topic t] ["Show" gnus-topic-show-topic t] @@ -1180,6 +1180,8 @@ If ALL is a number, fetch this number of articles. If performed over a topic line, toggle folding the topic." (interactive "P") + (when (and (eobp) (not (gnus-group-group-name))) + (forward-line -1)) (if (gnus-group-topic-p) (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) @@ -1202,7 +1204,8 @@ If performed over a topic line, toggle folding the topic." (gnus-message 5 "Expiring groups in %s..." topic) (let ((gnus-group-marked (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t)))) + (gnus-topic-find-groups topic gnus-level-killed t + nil t)))) (gnus-group-expire-articles nil)) (gnus-message 5 "Expiring groups in %s...done" topic)))) @@ -1215,7 +1218,8 @@ Also see `gnus-group-catchup'." (save-excursion (let* ((groups (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t))) + (gnus-topic-find-groups topic gnus-level-killed t + nil t))) (buffer-read-only nil) (gnus-group-marked groups)) (gnus-group-catchup-current) @@ -1424,9 +1428,9 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) -(defun gnus-topic-mark-topic (topic &optional unmark recursive) +(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) "Mark all groups in the TOPIC with the process mark. -If RECURSIVE is t, mark its subtopics too." +If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (interactive (list (gnus-group-topic-name) nil (and current-prefix-arg t))) @@ -1434,20 +1438,20 @@ If RECURSIVE is t, mark its subtopics too." (call-interactively 'gnus-group-mark-group) (save-excursion (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil - recursive))) + (not non-recursive)))) (while groups (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) (gnus-info-group (nth 2 (pop groups))))))))) -(defun gnus-topic-unmark-topic (topic &optional dummy recursive) +(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive) "Remove the process mark from all groups in the TOPIC. -If RECURSIVE is t, unmark its subtopics too." +If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (interactive (list (gnus-group-topic-name) nil (and current-prefix-arg t))) (if (not topic) (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t recursive))) + (gnus-topic-mark-topic topic t non-recursive))) (defun gnus-topic-get-new-news-this-topic (&optional n) "Check for new news in the current topic." diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index e844fa7..6186fdb 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -124,13 +124,6 @@ (funcall (if (stringp buffer) 'get-buffer 'buffer-name) buffer)))) -(defmacro gnus-kill-buffer (buffer) - `(let ((buf ,buffer)) - (when (gnus-buffer-exists-p buf) - (when (boundp 'gnus-buffers) - (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))) - (kill-buffer buf)))) - (defalias 'gnus-point-at-bol (if (fboundp 'point-at-bol) 'point-at-bol @@ -155,7 +148,7 @@ ;; Delete the current line (and the next N lines). (defmacro gnus-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) + `(delete-region (gnus-point-at-bol) (progn (forward-line ,(or n 1)) (point)))) (defun gnus-byte-code (func) @@ -205,6 +198,12 @@ (nnheader-narrow-to-headers) (message-fetch-field field))))) +(defun gnus-fetch-original-field (field) + "Fetch FIELD from the original version of the current article." + (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field field))) + + (defun gnus-goto-colon () (beginning-of-line) (let ((eol (gnus-point-at-eol))) @@ -703,6 +702,19 @@ and `print-level' to nil." b (setq b (next-single-property-change b 'gnus-face nil end)) prop val)))))) +(defmacro gnus-faces-at (position) + "Return a list of faces at POSITION." + (if (featurep 'xemacs) + `(let ((pos ,position)) + (mapcar-extents 'extent-face + nil (current-buffer) pos pos nil 'face)) + `(let ((pos ,position)) + (delq nil (cons (get-text-property pos 'face) + (mapcar + (lambda (overlay) + (overlay-get overlay 'face)) + (overlays-at pos))))))) + ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 ;;; The primary idea here is to try to protect internal datastructures ;;; from becoming corrupted when the user hits C-g, or if a hook or @@ -1013,6 +1025,32 @@ Return the modified alist." (while (search-backward "\\." nil t) (delete-char 1))))) +(defmacro gnus-with-output-to-file (file &rest body) + (let ((buffer (make-symbol "output-buffer")) + (size (make-symbol "output-buffer-size")) + (leng (make-symbol "output-buffer-length"))) + `(let* ((print-quoted t) + (print-readably t) + (print-escape-multibyte nil) + print-level + print-length + (,size 131072) + (,buffer (make-string ,size 0)) + (,leng 0) + (append nil) + (standard-output (lambda (c) + (aset ,buffer ,leng c) + (if (= ,size (setq ,leng (1+ ,leng))) + (progn (write-region ,buffer nil ,file append 'no-msg) + (setq ,leng 0 + append t)))))) + ,@body + (if (> ,leng 0) + (write-region (substring ,buffer 0 ,leng) nil ,file append 'no-msg))))) + +(put 'gnus-with-output-to-file 'lisp-indent-function 1) +(put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) + (if (fboundp 'union) (defalias 'gnus-union 'union) (defun gnus-union (l1 l2) @@ -1230,10 +1268,10 @@ CHOICE is a list of the choice char and help message at IDX." (save-window-excursion (save-excursion (while (not tchar) - (message "%s (%s?): " + (message "%s (%s): " prompt (mapconcat (lambda (s) (char-to-string (car s))) - choice "")) + choice ", ")) (setq tchar (read-char)) (when (not (assq tchar choice)) (setq tchar nil) @@ -1314,4 +1352,38 @@ Return nil otherwise." (provide 'gnus-util) +(defmacro gnus-mapcar (function seq1 &rest seqs2_n) + "Apply FUNCTION to each element of the sequences, and make a list of the results. +If there are several sequences, FUNCTION is called with that many arguments, +and mapping stops as soon as the shortest sequence runs out. With just one +sequence, this is like `mapcar'. With several, it is like the Common Lisp +`mapcar' function extended to arbitrary sequence types." + + (if seqs2_n + (let* ((seqs (cons seq1 seqs2_n)) + (cnt 0) + (heads (mapcar (lambda (seq) + (make-symbol (concat "head" + (int-to-string + (setq cnt (1+ cnt)))))) + seqs)) + (result (make-symbol "result")) + (result-tail (make-symbol "result-tail"))) + `(let* ,(let* ((bindings (cons nil nil)) + (heads heads)) + (nconc bindings (list (list result '(cons nil nil)))) + (nconc bindings (list (list result-tail result))) + (while heads + (nconc bindings (list (list (pop heads) (pop seqs))))) + (cdr bindings)) + (while (and ,@heads) + (setcdr ,result-tail (cons (funcall ,function + ,@(mapcar (lambda (h) (list 'car h)) + heads)) + nil)) + (setq ,result-tail (cdr ,result-tail) + ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads)))) + (cdr ,result))) + `(mapcar ,function ,seq1))) + ;;; gnus-util.el ends here diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index e46f00f..a74bc66 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -869,7 +869,7 @@ When called interactively, prompt for REGEXP." (setq body (buffer-substring (1- (point)) (point-max))) (narrow-to-region (point-min) (point)) (if (not (setq headers gnus-uu-digest-headers)) - (setq sorthead (buffer-substring (point-min) (point-max))) + (setq sorthead (buffer-string)) (while headers (setq headline (car headers)) (setq headers (cdr headers)) @@ -1089,7 +1089,7 @@ When called interactively, prompt for REGEXP." (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]+" t t)) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) (defun gnus-uu-get-list-of-articles (n) ;; If N is non-nil, the article numbers of the N next articles diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 65d003d..1806ceb 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -714,9 +714,9 @@ XEmacs compatibility workaround." (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) (text-property-any b e 'gnus-undeletable t)))) -(defun gnus-xmas-mime-button-menu (event) +(defun gnus-xmas-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." - (interactive "e") + (interactive "e\nP") (let ((response (get-popup-menu-response `("MIME Part" ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) @@ -728,7 +728,7 @@ XEmacs compatibility workaround." (defun gnus-group-add-icon () "Add an icon to the current line according to `gnus-group-icon-list'." (let* ((p (point)) - (end (progn (end-of-line) (point))) + (end (gnus-point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point)))) (save-restriction diff --git a/lisp/gnus.el b/lisp/gnus.el index d8743c8..eb3fc76 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -286,7 +286,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.15" +(defconst gnus-version-number "0.16" "Version number for this version of Gnus.") (defconst gnus-version (format "Oort Gnus v%s" gnus-version-number) @@ -679,9 +679,9 @@ be set in `.emacs' instead." (defface gnus-summary-high-undownloaded-face '((((class color) (background light)) - (:bold t :foreground "cyan4" :bold nil)) + (:bold t :foreground "cyan4")) (((class color) (background dark)) - (:bold t :foreground "LightGray" :bold nil)) + (:bold t :foreground "LightGray")) (t (:inverse-video t :bold t))) "Face used for high interest uncached articles.") @@ -771,6 +771,13 @@ be set in `.emacs' instead." "Add the current buffer to the list of Gnus buffers." (push (current-buffer) gnus-buffers)) +(defmacro gnus-kill-buffer (buffer) + "Kill BUFFER and remove from the list of Gnus buffers." + `(let ((buf ,buffer)) + (when (gnus-buffer-exists-p buf) + (setq gnus-buffers (delete (get-buffer buf) gnus-buffers)) + (kill-buffer buf)))) + (defun gnus-buffers () "Return a list of live Gnus buffers." (while (and gnus-buffers @@ -1482,7 +1489,7 @@ slower." :type 'boolean) (defcustom gnus-shell-command-separator ";" - "String used to separate to shell commands." + "String used to separate shell commands." :group 'gnus-files :type 'string) @@ -1580,7 +1587,7 @@ to be desirable; see the manual for further details." ;; There should be special validation for this. (define-widget 'gnus-email-address 'string - "An email address") + "An email address.") (gnus-define-group-parameter to-address @@ -1838,6 +1845,10 @@ Only applicable to non-spam (unclassified and ham) groups.") "The BBDB summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") + (defvar gnus-group-ham-exit-processor-copy "copy" + "The ham copy exit ham processor. +Only applicable to non-spam (unclassified and ham) groups.") + (gnus-define-group-parameter spam-process :type list @@ -1853,7 +1864,8 @@ Only applicable to non-spam (unclassified and ham) groups.") (variable-item gnus-group-ham-exit-processor-ifile) (variable-item gnus-group-ham-exit-processor-stat) (variable-item gnus-group-ham-exit-processor-whitelist) - (variable-item gnus-group-ham-exit-processor-BBDB)))) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-copy)))) :function-document "Which spam or ham processors will be applied to the GROUP articles at summary exit." :variable gnus-spam-process-newsgroups @@ -1877,7 +1889,8 @@ for mail groups." (variable-item gnus-group-ham-exit-processor-ifile) (variable-item gnus-group-ham-exit-processor-stat) (variable-item gnus-group-ham-exit-processor-whitelist) - (variable-item gnus-group-ham-exit-processor-BBDB)))) + (variable-item gnus-group-ham-exit-processor-BBDB) + (variable-item gnus-group-ham-exit-processor-copy)))) :parameter-document "Which spam processors will be applied to the spam or ham GROUP articles at summary exit.") @@ -2062,8 +2075,9 @@ face." "Whether Gnus is plugged or not.") (defcustom gnus-agent-cache t - "Whether Gnus use agent cache. -You also need to enable `gnus-agent'." + "Controls use of the agent cache while plugged. When set, Gnus will prefer +using the locally stored content rather than re-fetching it from the server. +You also need to enable `gnus-agent' for this to have any affect." :version "21.3" :group 'gnus-agent :type 'boolean) @@ -2071,7 +2085,7 @@ You also need to enable `gnus-agent'." (defcustom gnus-default-charset (mm-guess-mime-charset) "Default charset assumed to be used when viewing non-ASCII characters. This variable is overridden on a group-to-group basis by the -gnus-group-charset-alist variable and is only used on groups not +`gnus-group-charset-alist' variable and is only used on groups not covered by that variable." :type 'symbol :group 'gnus-charset) @@ -2093,7 +2107,7 @@ Putting (gnus-agentize) in ~/.gnus is obsolete by (setq gnus-agent t)." (defcustom gnus-other-frame-parameters nil "Frame parameters used by `gnus-other-frame' to create a Gnus frame. -This should be an alist for FSF Emacs, or a plist for XEmacs." +This should be an alist for Emacs, or a plist for XEmacs." :group 'gnus-start :type (if (featurep 'xemacs) '(repeat (list :inline t :format "%v" @@ -2108,6 +2122,7 @@ This should be an alist for FSF Emacs, or a plist for XEmacs." (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") +(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") (defvar gnus-draft-meta-information-header "X-Draft-From") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-original-article-buffer " *Original Article*") @@ -3145,6 +3160,10 @@ native." (substring group 0 (match-end 0)) "")) +(defun gnus-summary-buffer-name (group) + "Return the summary buffer name of GROUP." + (concat "*Summary " (gnus-group-decoded-name group) "*")) + (defun gnus-group-method (group) "Return the server or method used for selecting GROUP. You should probably use `gnus-find-method-for-group' instead." diff --git a/lisp/html2text.el b/lisp/html2text.el index 22ae79b..4b89f8f 100644 --- a/lisp/html2text.el +++ b/lisp/html2text.el @@ -1,6 +1,5 @@ ;;; html2text.el --- a simple html to plain text converter - -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. ;; Author: Joakim Hove @@ -287,9 +286,8 @@ formatting, and then moved afterward.") (while (< item-nr items) (setq item-nr (1+ item-nr)) (re-search-forward "
\\([ ]*\\)" (point-max) t) - (if (match-string 1) - (kill-region (point) (- (point) (string-width (match-string 1)))) - ) + (when (match-string 1) + (delete-region (point) (- (point) (string-width (match-string 1))))) (let ((def-p1 (point)) (def-p2 0)) (re-search-forward "\\([ ]*\\)\\(
\\|
\\)" (point-max) t) @@ -299,25 +297,17 @@ formatting, and then moved afterward.") (mw2 (string-width (match-string 2))) (mw (+ mw1 mw2))) (goto-char (- (point) mw)) - (kill-region (point) (+ (point) mw1)) - (setq def-p2 (point)) - ) - ) + (delete-region (point) (+ (point) mw1)) + (setq def-p2 (point)))) (setq def-p2 (- (point) (string-width (match-string 2))))) - (put-text-property def-p1 def-p2 'face 'bold) - ) - ) - ) - ) + (put-text-property def-p1 def-p2 'face 'bold))))) (defun html2text-delete-tags (p1 p2 p3 p4) - (kill-region p1 p2) - (kill-region (- p3 (- p2 p1)) (- p4 (- p2 p1))) - ) + (delete-region p1 p2) + (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1)))) (defun html2text-delete-single-tag (p1 p2) - (kill-region p1 p2) - ) + (delete-region p1 p2)) (defun html2text-clean-hr (p1 p2) (html2text-delete-single-tag p1 p2) @@ -379,7 +369,7 @@ formatting, and then moved afterward.") ;; surely improve upon this. (let* ((attr-list (html2text-get-attr p1 p2 "a")) (href (html2text-attr-value attr-list "href"))) - (kill-region p1 p4) + (delete-region p1 p4) (when href (goto-char p1) (insert (substring href 1 -1 )) @@ -446,17 +436,14 @@ fashion, quite close to pure guess-work. It does work in some cases though." ;; Removing lonely
on a single line, if they are left intact we ;; dont have any paragraphs at all. (html2text-buffer-head) - (while (< (point) (point-max)) + (while (not (eobp)) (let ((p1 (point))) (forward-paragraph 1) ;;(message "Kaller fix med p1=%s p2=%s " p1 (1- (point))) (sleep-for 5) (html2text-fix-paragraph p1 (1- (point))) (goto-char p1) - (if (< (point) (point-max)) - (forward-paragraph 1)) - ) - ) - ) + (when (not (eobp)) + (forward-paragraph 1))))) ;; ;; @@ -478,11 +465,7 @@ See the documentation for that variable." (while (re-search-forward (format "\\(]*>\\)" tag) (point-max) t) (let ((p1 (point))) (search-backward "<") - (kill-region (point) p1) - ) - ) - ) - ) + (delete-region (point) p1))))) (defun html2text-format-tags () "See the variable \"html2text-format-tag-list\" for documentation" diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index ae97c7e..4725651 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -52,7 +52,7 @@ "Textual token including full stop.") (defvar ietf-drums-qtext-token (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177") - "Non-white-space control characters, plus the rest of ASCII excluding + "Non-white-space control characters, plus the rest of ASCII excluding backslash and doublequote.") (defvar ietf-drums-tspecials "][()<>@,;:\\\"/?=" "Tspecials.") diff --git a/lisp/imap.el b/lisp/imap.el index 4413fb5..ae2a5fd 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -1,5 +1,5 @@ ;;; imap.el --- imap library -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Simon Josefsson @@ -138,7 +138,6 @@ (eval-when-compile (require 'cl)) (eval-and-compile - (autoload 'open-ssl-stream "ssl") (autoload 'base64-decode-string "base64") (autoload 'base64-encode-string "base64") (autoload 'starttls-open-stream "starttls") @@ -417,22 +416,6 @@ sure of changing the value of `foo'." (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun imap-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt (if args - (apply 'format prompt args) - prompt))) - (funcall (if (or (fboundp 'read-passwd) - (and (load "subr" t) - (fboundp 'read-passwd)) - (and (load "passwd" t) - (fboundp 'read-passwd))) - 'read-passwd - (autoload 'ange-ftp-read-passwd "ange-ftp") - 'ange-ftp-read-passwd) - prompt))) - (defsubst imap-utf7-encode (string) (if imap-use-utf7 (and string @@ -601,24 +584,23 @@ If ARGS, PROMPT is used as an argument to `format'." (let ((cmds (if (listp imap-ssl-program) imap-ssl-program (list imap-ssl-program))) cmd done) - (condition-case () - (require 'ssl) - (error)) (while (and (not done) (setq cmd (pop cmds))) (message "imap: Opening SSL connection with `%s'..." cmd) (let* ((port (or port imap-default-ssl-port)) (coding-system-for-read imap-coding-system-for-read) (coding-system-for-write imap-coding-system-for-write) - (ssl-program-name shell-file-name) - (ssl-program-arguments - (list shell-command-switch - (format-spec cmd (format-spec-make - ?s server - ?p (number-to-string port))))) + (process-connection-type nil) process) - (when (setq process (condition-case () - (open-ssl-stream name buffer server port) - (error))) + (when (progn + (setq process (start-process + name buffer shell-file-name + shell-command-switch + (format-spec cmd + (format-spec-make + ?s server + ?p (number-to-string port))))) + (process-kill-without-query process) + process) (with-current-buffer buffer (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) @@ -773,7 +755,7 @@ Returns t if login was successful, nil otherwise." "'): ") (or user imap-default-user)))) (setq passwd (or imap-password - (imap-read-passwd + (read-passwd (concat "IMAP password for " user "@" imap-server " (using authenticator `" (symbol-name imap-auth) "'): ")))) @@ -1304,7 +1286,7 @@ Returns non-nil if successful." ITEMS can be a symbol or a list of symbols, valid symbols are one of the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity or 'unseen. If ITEMS is a list of symbols, a list of values is -returned, if ITEMS is a symbol only it's value is returned." +returned, if ITEMS is a symbol only its value is returned." (with-current-buffer (or buffer (current-buffer)) (when (imap-ok-p (imap-send-command-wait (list "STATUS \"" @@ -2646,7 +2628,6 @@ Return nil if no complete line has arrived." (buffer-disable-undo (get-buffer-create imap-debug-buffer)) (mapcar (lambda (f) (trace-function-background f imap-debug-buffer)) '( - imap-read-passwd imap-utf7-encode imap-utf7-decode imap-error-text diff --git a/lisp/lpath.el b/lisp/lpath.el index dadf0b6..cee53a7 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -50,7 +50,8 @@ enable-multibyte-characters language-info-alist mark-active mouse-selection-click-count mouse-selection-click-count-buffer pgg-parse-crc24 - temporary-file-directory transient-mark-mode))) + temporary-file-directory transient-mark-mode + mm-w3m-mode-map))) (maybe-fbind '(bbdb-complete-name delete-annotation device-connection dfw-device events-to-keys font-lock-set-defaults frame-device @@ -65,7 +66,7 @@ (maybe-bind '(help-echo-owns-message mail-mode-hook url-package-name url-package-version w3-meta-charset-content-type-regexp - w3-meta-content-type-charset-regexp))) + w3-meta-content-type-charset-regexp mm-w3m-mode-map))) (defun nnkiboze-score-file (a) ) diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 824bb5a..b8458b8 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -263,7 +263,23 @@ If non-nil, this maildrop will be checked periodically for new mail." :type 'integer) (defcustom mail-source-delete-incoming nil - "*If non-nil, delete incoming files after handling." + "*If non-nil, delete incoming files after handling. +If t, delete immediately, if nil, never delete. If a positive number, delete +files older than number of days." + ;; Note: The removing happens in `mail-source-callback', i.e. no old + ;; incoming files will be deleted, unless you receive new mail. + ;; + ;; You may also set this to `nil' and call `mail-source-delete-old-incoming' + ;; from a hook or interactively. + :group 'mail-source + :type '(choice (const :tag "immediately" t) + (const :tag "never" nil) + (integer :tag "days"))) + +(defcustom mail-source-delete-old-incoming-confirm t + "*If non-nil, ask for for confirmation before deleting old incoming files. +This variable only applies when `mail-source-delete-incoming' is a positive +number." :group 'mail-source :type 'boolean) @@ -482,15 +498,16 @@ Return the number of files that were found." (funcall function source callback) (error (if (and (not mail-source-ignore-errors) - (yes-or-no-p - (format "Mail source %s error (%s). Continue? " - (if (memq ':password source) - (let ((s (copy-sequence source))) - (setcar (cdr (memq ':password s)) - "********") - s) - source) - (cadr err)))) + (not + (yes-or-no-p + (format "Mail source %s error (%s). Continue? " + (if (memq ':password source) + (let ((s (copy-sequence source))) + (setcar (cdr (memq ':password s)) + "********") + s) + source) + (cadr err))))) (error "Cannot get new mail")) 0))))))))) @@ -505,6 +522,34 @@ Return the number of files that were found." (setq newname (make-temp-name newprefix))) newname)))) +(defun mail-source-delete-old-incoming (&optional age confirm) + "Remove incoming files older than AGE days. +If CONFIRM is non-nil, ask for confirmation before removing a file." + (interactive "P") + (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days + (low2days (/ 1.0 65536.0)) ;; convert low bits to days + (diff (if (natnump age) age 30));; fallback, if no valid AGE given + currday files) + (setq files (directory-files + mail-source-directory t + (concat mail-source-incoming-file-prefix "*")) + currday (* (car (current-time)) high2days) + currday (+ currday (* low2days (nth 1 (current-time))))) + (while files + (let* ((ffile (car files)) + (bfile (gnus-replace-in-string + ffile "\\`.*/\\([^/]+\\)\\'" "\\1")) + (filetime (nth 5 (file-attributes ffile))) + (fileday (* (car filetime) high2days)) + (fileday (+ fileday (* low2days (nth 1 filetime))))) + (setq files (cdr files)) + (when (and (> (- currday fileday) diff) + (gnus-message 8 "File `%s' is older than %s day(s)" + bfile diff) + (or (not confirm) + (y-or-n-p (concat "Remove file `" bfile "'? ")))) + (delete-file ffile)))))) + (defun mail-source-callback (callback info) "Call CALLBACK on the mail file, and then remove the mail file. Pass INFO on to CALLBACK." @@ -518,7 +563,7 @@ Pass INFO on to CALLBACK." (funcall callback mail-source-crash-box info) (when (file-exists-p mail-source-crash-box) ;; Delete or move the incoming mail out of the way. - (if mail-source-delete-incoming + (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming (mail-source-make-complex-temp-name @@ -527,7 +572,12 @@ Pass INFO on to CALLBACK." mail-source-directory)))) (unless (file-exists-p (file-name-directory incoming)) (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t))))))) + (rename-file mail-source-crash-box incoming t) + ;; remove old incoming files? + (when (natnump mail-source-delete-incoming) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm)))))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -604,22 +654,6 @@ Pass INFO on to CALLBACK." (not (zerop (nth 7 (file-attributes from)))) (delete-file from))) -(defvar mail-source-read-passwd nil) -(defun mail-source-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt - (if args - (apply 'format prompt args) - prompt))) - (unless mail-source-read-passwd - (if (or (fboundp 'read-passwd) (load "passwd" t)) - (setq mail-source-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq mail-source-read-passwd 'ange-ftp-read-passwd))) - (funcall mail-source-read-passwd prompt))) - (defun mail-source-fetch-with-program (program) (zerop (call-process shell-file-name nil nil nil shell-command-switch program))) @@ -663,8 +697,7 @@ If ARGS, PROMPT is used as an argument to `format'." "Fetcher for directory sources." (mail-source-bind (directory source) (mail-source-run-script - prescript (format-spec-make ?t path) - prescript-delay) + prescript (format-spec-make ?t path) prescript-delay) (let ((found 0) (mail-source-string (format "directory:%s" path))) (dolist (file (directory-files @@ -673,8 +706,7 @@ If ARGS, PROMPT is used as an argument to `format'." (funcall predicate file) (mail-source-movemail file mail-source-crash-box)) (incf found (mail-source-callback callback file)))) - (mail-source-run-script - postscript (format-spec-make ?t path)) + (mail-source-run-script postscript (format-spec-make ?t path)) found))) (defun mail-source-fetch-pop (source callback) @@ -692,7 +724,7 @@ If ARGS, PROMPT is used as an argument to `format'." (setq password (or password (cdr (assoc from mail-source-password-cache)) - (mail-source-read-passwd + (read-passwd (format "Password for %s at %s: " user server))))) (when server (setenv "MAILHOST" server)) @@ -756,7 +788,7 @@ If ARGS, PROMPT is used as an argument to `format'." (setq password (or password (cdr (assoc from mail-source-password-cache)) - (mail-source-read-passwd + (read-passwd (format "Password for %s at %s: " user server)))) (unless (assoc from mail-source-password-cache) (push (cons from password) mail-source-password-cache))) @@ -944,13 +976,14 @@ This only works when `display-time' is enabled." (defun mail-source-fetch-imap (source callback) "Fetcher for imap sources." (mail-source-bind (imap source) - (let ((from (format "%s:%s:%s" server user port)) - (found 0) - (buf (get-buffer-create (generate-new-buffer-name " *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) + (let* ((from (format "%s:%s:%s" server user port)) + (found 0) + (buffer-name " *imap source*") + (buf (get-buffer-create (generate-new-buffer-name buffer-name))) + (mail-source-string (format "imap:%s:%s" server mailbox)) + (imap-shell-program (or (list program) imap-shell-program)) + remove) + (if (and (imap-open server port stream authentication buffer-name) (imap-authenticate user (or (cdr (assoc from mail-source-password-cache)) password) buf) @@ -1014,7 +1047,7 @@ This only works when `display-time' is enabled." (or password (cdr (assoc (format "webmail:%s:%s" subtype user) mail-source-password-cache)) - (mail-source-read-passwd + (read-passwd (format "Password for %s at %s: " user subtype)))) (when (and password (not (assoc (format "webmail:%s:%s" subtype user) diff --git a/lisp/mailcap.el b/lisp/mailcap.el index ab16136..605f1b3 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -147,7 +147,7 @@ mailcap-print-command)) (test . window-system)) ("pdf" - (viewer . ,(concat "pdftotext %s - | ")) + (viewer . ,(concat "pdftotext %s -")) (type . "application/pdf") ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) ("copiousoutput")) diff --git a/lisp/message.el b/lisp/message.el index 16b127e..1313300 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -636,6 +636,15 @@ Doing so would be even more evil than leaving it out." :group 'message-sending :type 'boolean) +(defcustom message-sendmail-envelope-from nil + "*Envelope-from when sending mail with sendmail. +If this is nil, use `user-mail-address'. If it is the symbol +`header', use the From: header of the message." + :type '(choice (string :tag "From name") + (const :tag "Use From: header from message" header) + (const :tag "Use `user-mail-address'" nil)) + :group 'message-sending) + ;; qmail-related stuff (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" "Location of the qmail-inject program." @@ -1273,6 +1282,12 @@ no, only reply back to the author." :group 'message-headers :type 'boolean) +(defcustom message-user-fqdn nil + "*Domain part of Messsage-Ids." + :group 'message-headers + :link '(custom-manual "(message)News Headers") + :type 'string) + ;;; Internal variables. (defvar message-sending-message "Sending...") @@ -1319,7 +1334,7 @@ no, only reply back to the author." ;; We want to match the results of any of these manglings. ;; The following regexp rejects names whose first characters are ;; obviously bogus, but after that anything goes. - "\\([^\0-\b\n-\r\^?].*\\)? " + "\\([^\0-\b\n-\r\^?].*\\)?" ;; The time the message was sent. "\\([^\0-\r \^?]+\\) +" ; day of the week @@ -1381,6 +1396,19 @@ no, only reply back to the author." (defvar message-bogus-system-names "^localhost\\." "The regexp of bogus system names.") +(defcustom message-valid-fqdn-regexp + (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. + ;; valid TLDs: + "\\([a-z][a-z]" ;; two letter country TDLs + "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org" + "\\|aero\\|coop\\|info\\|name\\|museum" + "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style? + "\\)") + "Regular expression that matches a valid FQDN." + ;; see also: gnus-button-valid-fqdn-regexp + :group 'message-headers + :type 'regexp) + (eval-and-compile (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") @@ -1711,7 +1739,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (not (string-match (regexp-quote target-group) (message-fetch-field "Newsgroups")))) (end-of-line) - (insert-string (concat "," target-group)))) + (insert (concat "," target-group)))) (end-of-line) ; ensure Followup: comes after Newsgroups: ;; unless new followup would be identical to Newsgroups line ;; make a new Followup-To line @@ -2270,6 +2298,11 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'message-checksum) nil) (set (make-local-variable 'message-mime-part) 0) (message-setup-fill-variables) + (set + (make-local-variable 'paragraph-separate) + (format "\\(%s\\)\\|\\(%s\\)" + paragraph-separate + "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) ;; Allow using comment commands to add/remove quoting. (set (make-local-variable 'comment-start) message-yank-prefix) (if (featurep 'xemacs) @@ -3233,7 +3266,8 @@ It should typically alter the sending method in some way or other." (goto-char (car points)) (dolist (point points) (add-text-properties point (1+ point) - '(invisible nil highlight t))) + '(invisible nil face highlight + font-lock-face highlight))) (unless (yes-or-no-p "Invisible text found and made visible; continue posting? ") (error "Invisible text found and made visible"))))) @@ -3248,14 +3282,15 @@ It should typically alter the sending method in some way or other." (memq (char-charset char) '(eight-bit-control eight-bit-graphic control-1))))) - (add-text-properties (point) (1+ (point)) '(highlight t)) + (add-text-properties (point) (1+ (point)) + '(font-lock-face highlight face highlight)) (setq found t)) (forward-char) (skip-chars-forward mm-7bit-chars)) (when found (setq choice (gnus-multiple-choice - "Illegible text found. Continue posting? " + "Illegible text found. Continue posting?" '((?d "Remove and continue posting") (?r "Replace with dots and continue posting") (?i "Ignore and continue posting") @@ -3272,10 +3307,11 @@ It should typically alter the sending method in some way or other." '(eight-bit-control eight-bit-graphic control-1))))) (if (eq choice ?i) - (remove-text-properties (point) (1+ (point)) '(highlight t)) + (remove-text-properties (point) (1+ (point)) + '(font-lock-face highlight face highlight)) (delete-char 1) - (if (eq choice ?r) - (insert ".")))) + (when (eq choice ?r) + (insert ".")))) (forward-char) (skip-chars-forward mm-7bit-chars)))))) @@ -3355,7 +3391,7 @@ It should typically alter the sending method in some way or other." (message-remove-header "Lines") (goto-char (point-max)) (insert "Mime-Version: 1.0\n") - (setq header (buffer-substring (point-min) (point-max)))) + (setq header (buffer-string))) (goto-char (point-max)) (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n" id n total)) @@ -3436,6 +3472,7 @@ It should typically alter the sending method in some way or other." (message-narrow-to-headers) (and news (or (message-fetch-field "cc") + (message-fetch-field "bcc") (message-fetch-field "to")) (let ((content-type (message-fetch-field "content-type"))) (or @@ -3523,7 +3560,7 @@ If you always want Gnus to send messages in one piece, set ;; But some systems are more broken with -f, so ;; we'll let users override this. (if (null message-sendmail-f-is-evil) - (list "-f" (message-make-address))) + (list "-f" (message-sendmail-envelope-from))) ;; These mean "report errors by mail" ;; and "deliver in background". (if (null message-interactive) '("-oem" "-odb")) @@ -3545,7 +3582,7 @@ If you always want Gnus to send messages in one piece, set (replace-match "; ")) (if (not (zerop (buffer-size))) (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))))) + (buffer-string)))))) (when (bufferp errbuf) (kill-buffer errbuf))))) @@ -3915,8 +3952,9 @@ Otherwise, generate and save a value for `canlock-password' first." (gnus-groups-from-server method))) errors) (while groups - (unless (or (equal (car groups) "poster") - (member (car groups) known-groups)) + (when (and (not (equal (car groups) "poster")) + (not (member (car groups) known-groups)) + (not (member (car groups) errors))) (push (car groups) errors)) (pop groups)) (cond @@ -4473,30 +4511,53 @@ give as trustworthy answer as possible." (defun message-user-mail-address () "Return the pertinent part of `user-mail-address'." - (when user-mail-address + (when (and user-mail-address + (string-match "@.*\\." user-mail-address)) (if (string-match " " user-mail-address) (nth 1 (mail-extract-address-components user-mail-address)) user-mail-address))) +(defun message-sendmail-envelope-from () + "Return the envelope from." + (cond ((eq message-sendmail-envelope-from 'header) + (nth 1 (mail-extract-address-components + (message-fetch-field "from")))) + ((stringp message-sendmail-envelope-from) + message-sendmail-envelope-from) + (t + (message-make-address)))) + (defun message-make-fqdn () "Return user's fully qualified domain name." - (let ((system-name (system-name)) - (user-mail (message-user-mail-address))) + (let* ((system-name (system-name)) + (user-mail (message-user-mail-address)) + (user-domain + (if (and user-mail + (string-match "@\\(.*\\)\\'" user-mail)) + (match-string 1 user-mail)))) (cond - ((and (string-match "[^.]\\.[^.]" system-name) + ((and message-user-fqdn + (stringp message-user-fqdn) + (string-match message-valid-fqdn-regexp message-user-fqdn) + (not (string-match message-bogus-system-names message-user-fqdn))) + message-user-fqdn) + ;; `message-user-fqdn' seems to be valid + ((and (string-match message-valid-fqdn-regexp system-name) (not (string-match message-bogus-system-names system-name))) ;; `system-name' returned the right result. system-name) ;; Try `mail-host-address'. ((and (boundp 'mail-host-address) (stringp mail-host-address) - (string-match "\\." mail-host-address)) + (string-match message-valid-fqdn-regexp mail-host-address) + (not (string-match message-bogus-system-names mail-host-address))) mail-host-address) ;; We try `user-mail-address' as a backup. - ((and user-mail - (string-match "\\." user-mail) - (string-match "@\\(.*\\)\\'" user-mail)) - (match-string 1 user-mail)) + ((and user-domain + (stringp user-domain) + (string-match message-valid-fqdn-regexp user-domain) + (not (string-match message-bogus-system-names user-domain))) + user-domain) ;; Default to this bogus thing. (t (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me"))))) @@ -5827,12 +5888,16 @@ Optional DIGEST will use digest to forward." (unless (message-mail-user-agent) (set-buffer (get-buffer-create " *message resend*")) (erase-buffer)) - (let ((message-this-is-mail t)) + (let ((message-this-is-mail t) + message-setup-hook) (message-setup `((To . ,address)))) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (message-narrow-to-headers) + ;; Remove X-Draft-From header etc. + (message-remove-header message-ignored-mail-headers t) ;; Rename them all to "Resent-*". + (goto-char (point-min)) (while (re-search-forward "^[A-Za-z]" nil t) (forward-char -1) (insert "Resent-")) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index e672e33..b28c50c 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -243,9 +243,10 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) -(defun mm-decode-body (charset &optional encoding type) +(defun mm-decode-body (charset &optional encoding type force) "Decode the current article that has been encoded with ENCODING. -The characters in CHARSET should then be decoded." +The characters in CHARSET should then be decoded. If FORCE is non-nil +use the supplied charset unconditionally." (if (stringp charset) (setq charset (intern (downcase charset)))) (if (or (not charset) @@ -271,7 +272,24 @@ The characters in CHARSET should then be decoded." (or (not (eq coding-system 'ascii)) (setq coding-system mail-parse-charset)) (not (eq coding-system 'gnus-decoded))) - (mm-decode-coding-region (point-min) (point-max) coding-system)))))) + (if force + (mm-decode-coding-region (point-min) (point-max) + coding-system) + (mm-decode-coding-region-safely (point-min) (point-max) + coding-system))))))) + +(defun mm-decode-coding-region-safely (start end coding-system) + "Decode region between START and END with CODING-SYSTEM. +If CODING-SYSTEM is not a valid coding system for the text, let Emacs +decide which coding system to use." + (let* ((decoded (mm-decode-coding-string (buffer-substring start end) + coding-system)) + (charsets (find-charset-string decoded))) + (if (or (memq 'eight-bit-control charsets) + (memq 'eight-bit-graphic charsets)) + (mm-decode-coding-region start end 'undecided) + (delete-region start end) + (insert decoded)))) (defun mm-decode-string (string charset) "Decode STRING with CHARSET." diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index f347a5c..249f3e9 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -333,10 +333,10 @@ Ready-made functions include `upcase-initials'.") (defvar mm-path-name-rewrite-functions nil - "*List of functions used for rewriting path names of MIME parts. -This is used when viewing parts externally , and is meant for -transforming the path name so that non-compliant programs can -find the file where it's saved. + "*List of functions for rewriting the full file names of MIME parts. +This is used when viewing parts externally, and is meant for +transforming the absolute name so that non-compliant programs can find +the file where it's saved. Each function takes a file name as input and returns a file name.") @@ -1262,7 +1262,7 @@ If RECURSIVE, search recursively." (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) - (setq result (buffer-substring (point-min) (point-max))))))) + (setq result (buffer-string)))))) (forward-line 1) (setq start (point))) (when (and (not result) start) @@ -1275,7 +1275,7 @@ If RECURSIVE, search recursively." (if notp (not (equal (car ctl) type)) (equal (car ctl) type))) - (setq result (buffer-substring (point-min) (point-max))))))) + (setq result (buffer-string)))))) result)) (defvar mm-security-handle nil) diff --git a/lisp/mm-url.el b/lisp/mm-url.el index 0f5af82..b653c7e 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -359,7 +359,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (with-temp-buffer (insert string) (mm-url-decode-entities) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) (defun mm-url-form-encode-xwfu (chunk) "Escape characters in a string for application/x-www-form-urlencoded. diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 8a204c7..bfc3906 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -300,7 +300,9 @@ mail with multiple parts is preferred to sending a Unicode one.") "Return the MIME charset corresponding to the given Mule CHARSET." (if (fboundp 'find-coding-systems-for-charsets) (let (mime) - (dolist (cs (find-coding-systems-for-charsets (list charset))) + (dolist (cs (sort-coding-systems + (copy-sequence + (find-coding-systems-for-charsets (list charset))))) (unless mime (when cs (setq mime (coding-system-get cs 'mime-charset))))) diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index e7770ba..cd20115 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -207,7 +207,7 @@ Return that buffer." (if (looking-at ".+") (setq file-name (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 0)))))) (defun mm-uu-binhex-filename () @@ -361,7 +361,7 @@ Return that buffer." ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) t) - (t (y-or-n-p "Decrypt pgp encrypted part?"))))) + (t (y-or-n-p "Decrypt pgp encrypted part? "))))) (defun mm-uu-pgp-encrypted-extract-1 (handles ctl) (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 90a7358..5659e63 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -73,25 +73,28 @@ (defun mm-inline-image-emacs (handle) (let ((b (point-marker)) buffer-read-only) - (insert "\n") (put-image (mm-get-image handle) b) + (insert "\n\n") (mm-handle-set-undisplayer handle - `(lambda () (remove-images ,b (1+ ,b)))))) + `(lambda () + (let ((b ,b) + buffer-read-only) + (remove-images b b) + (delete-region b (+ b 2))))))) (defun mm-inline-image-xemacs (handle) - (insert "\n") - (forward-char -1) - (let ((b (point)) - (annot (make-annotation (mm-get-image handle) nil 'text)) + (insert "\n\n") + (forward-char -2) + (let ((annot (make-annotation (mm-get-image handle) nil 'text)) buffer-read-only) (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) + (let ((b ,(point-marker)) + buffer-read-only) (delete-annotation ,annot) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))) + (delete-region (- b 2) b)))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t))) @@ -369,7 +372,8 @@ map."))) (set-text-properties (point-min) (point-max) nil) (when (or (equal type "enriched") (equal type "richtext")) - (enriched-decode (point-min) (point-max))) + (ignore-errors + (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/mml1991.el b/lisp/mml1991.el index 1ca73d2..63903d7 100644 --- a/lisp/mml1991.el +++ b/lisp/mml1991.el @@ -1,5 +1,5 @@ -;;; mml-gpg-old.el --- Old PGP message format (RFC 1991) support for MML -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML +;; Copyright (C) 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc. ;; Author: Sascha Lüdecke , ;; Simon Josefsson (Mailcrypt interface, Gnus glue) @@ -24,8 +24,6 @@ ;;; Commentary: -;; RCS: $Id: mml1991.el,v 1.1.1.4 2003-01-14 05:36:30 yamaoka Exp $ - ;;; Code: (defvar mml1991-use mml2015-use @@ -55,10 +53,9 @@ ;; Save MIME Content[^ ]+: headers from signing (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (setq headers (buffer-substring (point-min) (point))) - (kill-region (point-min) (point)))) + (unless (bobp) + (setq headers (buffer-string)) + (delete-region (point-min) (point))) (goto-char (point-max)) (unless (bolp) (insert "\n")) @@ -76,7 +73,7 @@ (replace-match "" t t)) (quoted-printable-encode-region (point-min) (point-max)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) (if headers (insert headers)) (insert "\n") (insert-buffer signature) @@ -98,9 +95,8 @@ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (kill-region (point-min) (point)))) + (unless (bobp) + (delete-region (point-min) (point))) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer (setq cipher (current-buffer)) @@ -121,7 +117,7 @@ (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") @@ -140,10 +136,9 @@ ;; Save MIME Content[^ ]+: headers from signing (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (setq headers (buffer-substring (point-min) (point))) - (kill-region (point-min) (point)))) + (unless (bobp) + (setq headers (buffer-string)) + (delete-region (point-min) (point))) (goto-char (point-max)) (unless (bolp) (insert "\n")) @@ -161,7 +156,7 @@ (replace-match "" t t)) (quoted-printable-encode-region (point-min) (point-max)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) (if headers (insert headers)) (insert "\n") (insert-buffer signature) @@ -174,9 +169,8 @@ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (kill-region (point-min) (point)))) + (unless (bobp) + (delete-region (point-min) (point))) (mm-with-unibyte-current-buffer-mule4 (with-temp-buffer (flet ((gpg-encrypt-func @@ -209,7 +203,7 @@ (while (re-search-forward "\r+$" nil t) (replace-match "" t t)) (set-buffer text) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") @@ -230,7 +224,7 @@ (unless (eobp) ;; no headers? (setq headers (buffer-substring (point-min) (point))) (forward-line) ;; skip header/body separator - (kill-region (point-min) (point))) + (delete-region (point-min) (point))) (quoted-printable-decode-region (point-min) (point-max)) (unless (let ((pgg-default-user-id (or (message-options-get 'message-sender) @@ -238,7 +232,7 @@ (pgg-sign-region (point-min) (point-max) t)) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) (insert-buffer pgg-output-buffer) (goto-char (point-min)) (while (re-search-forward "\r+$" nil t) @@ -254,9 +248,8 @@ ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") (forward-line)) - (if (> (point) (point-min)) - (progn - (kill-region (point-min) (point)))) + (unless (bobp) + (delete-region (point-min) (point))) (unless (pgg-encrypt-region (point-min) (point-max) (split-string @@ -268,7 +261,7 @@ sign) (pop-to-buffer pgg-errors-buffer) (error "Encrypt error")) - (kill-region (point-min) (point-max)) + (delete-region (point-min) (point-max)) ;;(insert "Content-Type: application/pgp-encrypted\n\n") ;;(insert "Version: 1\n\n") (insert "\n") diff --git a/lisp/nndb.el b/lisp/nndb.el index 6cc95c3..da53530 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -292,7 +292,7 @@ Optional LAST is ignored." (nntp-send-buffer "^[23].*\n")) (set-buffer nntp-server-buffer) - (setq msg (buffer-substring (point-min) (point-max))) + (setq msg (buffer-string)) (or (string-match "^\\([0-9]+\\)" msg) (error "nndb: %s" msg)) (setq art (substring msg (match-beginning 1) (match-end 1))) @@ -318,7 +318,7 @@ Optional LAST is ignored." (deffoo nndb-status-message (&optional server) "Return server status as a string." (set-buffer nntp-server-buffer) - (buffer-substring (point-min) (point-max))) + (buffer-string)) ;; Import stuff from nntp diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 101bb40..4d940c2 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -58,9 +58,6 @@ from the document.") `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) - (exim-bounce - (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n") - (body-end-function . nndoc-exim-bounce-body-end-function)) (nsmail (article-begin . "^From - ")) (news @@ -76,6 +73,9 @@ from the document.") (body-end . "\^_") (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) + (exim-bounce + (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n") + (body-end-function . nndoc-exim-bounce-body-end-function)) (rfc934 (article-begin . "^--.*\n+") (body-end . "^--.*$") @@ -630,7 +630,7 @@ from the document.") (setq subject (concat " (" (match-string 1) ")")) (when (re-search-forward "^From: \\(.*\\)" nil t) (setq from (concat "<" - (cadr (funcall gnus-extract-address-components + (cadr (funcall gnus-extract-address-components (match-string 1))) ">"))) (if (re-search-forward "^Date: +\\([^(]*\\)" nil t) (setq date (match-string 1)) @@ -890,7 +890,7 @@ PARENT is the message-ID of the parent summary line, or nil for none." subtype "plain")) ;; Prepare the article and summary inserts. (unless article-insert - (setq article-insert (buffer-substring (point-min) (point-max)) + (setq article-insert (buffer-string) head-end head-begin)) ;; Fix MIME-Version (unless (string-match "MIME-Version:" article-insert) diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 85d23f8..2b384b0 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -196,6 +196,13 @@ 'nnmh-request-group (list group server dont-check))) +(deffoo nndraft-request-move-article (article group server + accept-form &optional last) + (nndraft-possibly-change-group group) + (let ((nnmh-allow-delete-final t)) + (nnoo-parent-function 'nndraft 'nndraft-request-move-article + (list article group server accept-form last)))) + (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) @@ -286,8 +293,7 @@ nnmh-request-group nnmh-close-group nnmh-request-list - nnmh-request-newsgroups - nnmh-request-move-article)) + nnmh-request-newsgroups)) (provide 'nndraft) diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el index 9db8739..ce3da7e 100644 --- a/lisp/nnfolder.el +++ b/lisp/nnfolder.el @@ -202,7 +202,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (goto-char (match-end 0)) (setq num (string-to-int (buffer-substring - (point) (progn (end-of-line) (point))))) + (point) (gnus-point-at-eol)))) (goto-char start) (< num article))) ;; Check that we are before an article with a @@ -212,7 +212,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (progn (setq num (string-to-int (buffer-substring - (point) (progn (end-of-line) (point))))) + (point) (gnus-point-at-eol)))) (> num article)) ;; Discard any article numbers before the one we're ;; now looking at. @@ -285,9 +285,8 @@ the group. Then the marks file will be regenerated properly by Gnus.") (cons nnfolder-current-group (if (search-forward (concat "\n" nnfolder-article-marker) nil t) - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point)))) + (string-to-int (buffer-substring + (point) (gnus-point-at-eol))) -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check) @@ -483,8 +482,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (concat "^" nnfolder-article-marker) (save-excursion (and (search-forward "\n\n" nil t) (point))) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (gnus-delete-line)) (setq result (eval accept-form)) (kill-buffer buf) result) @@ -510,9 +508,9 @@ the group. Then the marks file will be regenerated properly by Gnus.") result art-group) (goto-char (point-min)) (when (looking-at "X-From-Line: ") - (save-match-data - (mail-header-unfold-field)) - (replace-match "From ")) + (replace-match "From ") + (while (progn (forward-line) (looking-at "[ \t]")) + (delete-char -1))) (with-temp-buffer (let ((nnmail-file-coding-system nnfolder-active-file-coding-system) (nntp-server-buffer (current-buffer))) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 61f4ce9..6d52131 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -489,7 +489,7 @@ the line could be found." (prev (point-min)) num found) (while (not found) - (goto-char (/ (+ max min) 2)) + (goto-char (+ min (/ (- max min) 2))) (beginning-of-line) (if (or (= (point) prev) (eobp)) @@ -497,8 +497,7 @@ the line could be found." (setq prev (point)) (while (and (not (numberp (setq num (read cur)))) (not (eobp))) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (gnus-delete-line)) (cond ((> num article) (setq max (point))) ((< num article) @@ -600,7 +599,7 @@ the line could be found." ;; This is invalid, but not all articles have Message-IDs. () (mail-position-on-field "References") - (let ((begin (save-excursion (beginning-of-line) (point))) + (let ((begin (gnus-point-at-bol)) (fill-column 78) (fill-prefix "\t")) (when references @@ -727,7 +726,8 @@ If FULL, translate everything." ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt))) + (memq system-type '(cygwin32 win32 w32 mswindows windows-nt + cygwin))) ;; This is needed on NT and stuff, because ;; file-name-nondirectory is not enough to split ;; file names, containing ':', e.g. @@ -866,7 +866,9 @@ without formatting." (or (nth 7 (file-attributes file)) 0)) (defun nnheader-find-etc-directory (package &optional file) - "Go through the path and find the \".../etc/PACKAGE\" directory. + "Go through `load-path' and find the \"../etc/PACKAGE\" directory. +This function will look in the parent directory of each `load-path' +entry, and look for the \"etc\" directory there. If FILE, find the \".../etc/PACKAGE\" file instead." (let ((path load-path) dir result) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 5488c36..30756d7 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -196,13 +196,22 @@ RFC2060 section 6.4.4." :group 'nnimap :type 'sexp) -(defcustom nnimap-split-download-body nil +(defvar nnimap-split-download-body-default nil + "Internal variable with default value for `nnimap-split-download-body'.") + +(defcustom nnimap-split-download-body 'default "Whether to download entire articles during splitting. This is generally not required, and will slow things down considerably. You may need it if you want to use an advanced splitting function that -analyses the body before splitting the article." +analyses the body before splitting the article. +If this variable is nil, bodies will not be downloaded; if this +variable is the symbol `default' the default behaviour is +used (which currently is nil, unless you use a statistical +spam.el test); if this variable is another non-nil value bodies +will be downloaded." :group 'nnimap - :type 'boolean) + :type '(choice (const :tag "Let system decide" deault) + boolean)) ;; Performance / bug workaround variables @@ -1445,7 +1454,7 @@ function is generally only called when Gnus is shutting down." ;; remove any 'From blabla' lines, some IMAP servers ;; reject the entire message otherwise. (when (looking-at "^From[^:]") - (kill-region (point) (progn (forward-line) (point)))) + (delete-region (point) (progn (forward-line) (point)))) ;; turn into rfc822 format (\r\n eol's) (while (search-forward "\n" nil t) (replace-match "\r\n")) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 110cc7c..c6e3ed3 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -109,7 +109,7 @@ (setq num (string-to-int (match-string 2 xref)) group (match-string 1 xref)) (or (with-current-buffer buffer - (or (gnus-cache-request-article num group) + (or (and gnus-use-cache (gnus-cache-request-article num group)) (gnus-agent-request-article num group))) (gnus-request-article num group buffer))))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index fd2fccf..6abe9e6 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -36,7 +36,8 @@ (require 'mm-util) (eval-and-compile - (autoload 'gnus-add-buffer "gnus")) + (autoload 'gnus-add-buffer "gnus") + (autoload 'gnus-kill-buffer "gnus")) (defgroup nnmail nil "Reading mail with Gnus." @@ -1037,7 +1038,7 @@ FUNC will be called with the group name to determine the article number." (while (not (eobp)) (unless (< (move-to-column nnmail-split-header-length-limit) nnmail-split-header-length-limit) - (delete-region (point) (progn (end-of-line) (point)))) + (delete-region (point) (gnus-point-at-eol))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -1510,12 +1511,16 @@ See the documentation for the variable `nnmail-split-fancy' for details." (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) (be nil) - (res nil)) + (res nil) + (get-new-mail nil)) (while (and (null res) be-list) (setq be (car be-list)) (setq be-list (cdr be-list)) (when (and (gnus-method-option-p be 'respool) - (eval (intern (format "%s-get-new-mail" (car be))))) + (setq get-new-mail + (intern (format "%s-get-new-mail" (car be)))) + (boundp get-new-mail) + (symbol-value get-new-mail)) (setq res be))) res)) @@ -1531,8 +1536,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) - (progn (end-of-line) (point)))))))) + (buffer-substring (point) (gnus-point-at-eol))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. diff --git a/lisp/nnmaildir.el b/lisp/nnmaildir.el index dff0443..18c6eb1 100644 --- a/lisp/nnmaildir.el +++ b/lisp/nnmaildir.el @@ -41,16 +41,14 @@ ;; copying, restoring, etc. ;; ;; Todo: -;; * Merge the information from -;; into the Gnus manual. -;; * Allow create-directory = ".", and configurable prefix of maildir names, -;; stripped off to produce group names. +;; * Replace create-directory with target-prefix, so the maildirs can be in +;; the same directory as the symlinks, starting with, e.g., ".". ;; * Add a hook for when moving messages from new/ to cur/, to support ;; nnmail's duplicate detection. ;; * Allow each mark directory in a group to have its own inode for mark ;; files, to accommodate AFS. ;; * Improve generated Xrefs, so crossposts are detectable. -;; * Improve readability. +;; * Improve code readability. ;;; Code: @@ -86,8 +84,8 @@ by nnmaildir-request-article.") ;; Variables to generate filenames of messages being delivered: (defvar nnmaildir--delivery-time "") -(defconst nnmaildir--delivery-pid (number-to-string (emacs-pid))) -(defvar nnmaildir--delivery-ct nil) +(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid)))) +(defvar nnmaildir--delivery-count nil) ;; An obarry containing symbols whose names are server names and whose values ;; are servers: @@ -620,17 +618,13 @@ by nnmaildir-request-article.") (defun nnmaildir--parse-filename (file) (let ((prefix (car file)) timestamp len) - (if (string-match - "\\`\\([0-9]+\\)\\.\\([0-9]+\\)\\(_\\([0-9]+\\)\\)?\\(\\..*\\)\\'" - prefix) + (if (string-match "\\`\\([0-9]+\\)\\(\\..*\\)\\'" prefix) (progn (setq timestamp (concat "0000" (match-string 1 prefix)) len (- (length timestamp) 4)) (vector (string-to-number (substring timestamp 0 len)) (string-to-number (substring timestamp len)) - (string-to-number (match-string 2 prefix)) - (string-to-number (or (match-string 4 prefix) "-1")) - (match-string 5 prefix) + (match-string 2 prefix) file)) file))) @@ -643,11 +637,7 @@ by nnmaildir-request-article.") (if (> (aref a 0) (aref b 0)) (throw 'return nil)) (if (< (aref a 1) (aref b 1)) (throw 'return t)) (if (> (aref a 1) (aref b 1)) (throw 'return nil)) - (if (< (aref a 2) (aref b 2)) (throw 'return t)) - (if (> (aref a 2) (aref b 2)) (throw 'return nil)) - (if (< (aref a 3) (aref b 3)) (throw 'return t)) - (if (> (aref a 3) (aref b 3)) (throw 'return nil)) - (string-lessp (aref a 4) (aref b 4)))) + (string-lessp (aref a 2) (aref b 2)))) (defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls) (catch 'return @@ -703,7 +693,9 @@ by nnmaildir-request-article.") (when (or isnew nattr) (mapcar (lambda (file) - (rename-file (concat ndir file) (concat cdir file ":2,"))) + (let ((path (concat ndir file))) + (and (time-less-p (nth 5 (file-attributes path)) (current-time)) + (rename-file path (concat cdir file ":2,"))))) (funcall ls ndir nil "\\`[^.]" 'nosort)) (setf (nnmaildir--grp-new group) nattr)) (setq cattr (nth 5 (file-attributes cdir))) @@ -751,7 +743,7 @@ by nnmaildir-request-article.") files (sort files 'nnmaildir--sort-files)) (mapcar (lambda (file) - (setq file (if (consp file) file (aref file 5)) + (setq file (if (consp file) file (aref file 3)) x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) (nnmaildir--grp-add-art nnmaildir--cur-server group x)) files) @@ -855,9 +847,9 @@ by nnmaildir-request-article.") (defun nnmaildir-request-update-info (gname info &optional server) (let ((group (nnmaildir--prepare server gname)) - pgname flist all always-marks never-marks old-marks dotfile num dir + pgname flist always-marks never-marks old-marks dotfile num dir markdirs marks mark ranges markdir article read end new-marks ls - old-mmth new-mmth mtime mark-sym deactivate-mark) + old-mmth new-mmth mtime mark-sym existing missing deactivate-mark) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -874,6 +866,13 @@ by nnmaildir-request-article.") old-marks (cons old-marks (gnus-info-marks info)) always-marks (nnmaildir--param pgname 'always-marks) never-marks (nnmaildir--param pgname 'never-marks) + existing (nnmaildir--grp-nlist group) + existing (mapcar 'car existing) + existing (nreverse existing) + existing (gnus-compress-sequence existing 'always-list) + missing (list (cons 1 (nnmaildir--group-maxnum + nnmaildir--cur-server group))) + missing (gnus-range-difference missing existing) dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--nndir dir) @@ -891,13 +890,7 @@ by nnmaildir-request-article.") (catch 'got-ranges (if (memq mark-sym never-marks) (throw 'got-ranges nil)) (when (memq mark-sym always-marks) - (unless all - (setq all (nnmaildir--grp-nlist group) - all (mapcar 'car all) - all (nreverse all) - all (gnus-compress-sequence all 'always-list) - all (cons 'dummy-mark-symbol all))) - (setq ranges (cdr all)) + (setq ranges existing) (throw 'got-ranges nil)) (setq mtime (nth 5 (file-attributes markdir))) (set (intern mark new-mmth) mtime) @@ -916,7 +909,7 @@ by nnmaildir-request-article.") (if (eq mark-sym 'read) (setq read ranges) (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) markdirs) - (gnus-info-set-read info read) + (gnus-info-set-read info (gnus-range-add read missing)) (gnus-info-set-marks info marks 'extend) (setf (nnmaildir--grp-mmth group) new-mmth) info))) @@ -1265,7 +1258,7 @@ by nnmaildir-request-article.") (coding-system-for-write nnheader-file-coding-system) (buffer-file-coding-system nil) (file-coding-system-alist nil) - srv-dir dir file tmpfile curfile 24h article) + srv-dir dir file time tmpfile curfile 24h article) (catch 'return (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) @@ -1279,15 +1272,17 @@ by nnmaildir-request-article.") (throw 'return nil)) (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir srv-dir gname) - file (format-time-string "%s" nil)) + time (current-time) + file (format-time-string "%s." time)) (unless (string-equal nnmaildir--delivery-time file) (setq nnmaildir--delivery-time file - nnmaildir--delivery-ct 0)) - (setq file (concat file "." nnmaildir--delivery-pid)) - (unless (zerop nnmaildir--delivery-ct) - (setq file (concat file "_" - (number-to-string nnmaildir--delivery-ct)))) - (setq file (concat file "." (system-name)) + nnmaildir--delivery-count 0)) + (when (and (consp (cdr time)) + (consp (cddr time))) + (setq file (concat file "M" (number-to-string (caddr time))))) + (setq file (concat file nnmaildir--delivery-pid) + file (concat file "Q" (number-to-string nnmaildir--delivery-count)) + file (concat file "." (system-name)) ;;;; FIXME: encode / and : tmpfile (concat (nnmaildir--tmp dir) file) curfile (concat (nnmaildir--cur dir) file ":2,")) (when (file-exists-p tmpfile) @@ -1298,7 +1293,7 @@ by nnmaildir-request-article.") (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "File exists: " curfile)) (throw 'return nil)) - (setq nnmaildir--delivery-ct (1+ nnmaildir--delivery-ct) + (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count) 24h (run-with-timer 86400 nil (lambda () (nnmaildir--unlink tmpfile) diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el index b3003cb..4569dbd 100644 --- a/lisp/nnmbox.el +++ b/lisp/nnmbox.el @@ -297,8 +297,7 @@ (while (re-search-forward "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (gnus-delete-line)) (setq result (eval accept-form)) (kill-buffer buf) result) @@ -423,9 +422,7 @@ (if (not force) (nnmbox-record-deleted-article (nnmbox-article-group-number t))) (or force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) + (gnus-delete-line)) ;; Beginning of the article. (save-excursion (save-restriction diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 4540dba..0832ae2 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -290,8 +290,8 @@ as unread by Gnus.") (deffoo nnmh-close-group (group &optional server) t) -(deffoo nnmh-request-move-article - (article group server accept-form &optional last) +(deffoo nnmh-request-move-article (article group server + accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) (and diff --git a/lisp/nnml.el b/lisp/nnml.el index 25b3913..e5dbd10 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -418,8 +418,7 @@ marks file will be regenerated properly by Gnus.") (if (or (looking-at art) (search-forward (concat "\n" art) nil t)) ;; Delete the old NOV line. - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) + (gnus-delete-line) ;; The line isn't here, so we have to find out where ;; we should insert it. (This situation should never ;; occur, but one likes to make sure...) @@ -692,7 +691,7 @@ marks file will be regenerated properly by Gnus.") (nnheader-insert-nov headers))) (defsubst nnml-header-value () - (buffer-substring (match-end 0) (progn (end-of-line) (point)))) + (buffer-substring (match-end 0) (gnus-point-at-eol))) (defun nnml-parse-head (chars &optional number) "Parse the head of the current buffer." diff --git a/lisp/nnrss.el b/lisp/nnrss.el index 2b3dd27..00f1332 100644 --- a/lisp/nnrss.el +++ b/lisp/nnrss.el @@ -458,7 +458,7 @@ ARTICLE is the article number of the current headline.") (mm-with-unibyte-buffer (insert string) (mm-url-decode-entities-nbsp) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) (defalias 'nnrss-insert 'nnrss-insert-w3) diff --git a/lisp/nntp.el b/lisp/nntp.el index 7f50446..2927dc6 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -254,9 +254,12 @@ noticing asynchronous data.") (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) -(eval-and-compile - (autoload 'mail-source-read-passwd "mail-source") - (autoload 'open-ssl-stream "ssl")) +(defvar nntp-ssl-program + "openssl s_client -quiet -ssl3 -connect %s:%p" +"A string containing commands for SSL connections. +Within a string, %s is replaced with the server address and %p with +port number on server. The program should accept IMAP commands on +stdin and return responses to stdout.") @@ -1042,9 +1045,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the (or passwd nntp-authinfo-password (setq nntp-authinfo-password - (mail-source-read-passwd - (format "NNTP (%s@%s) password: " - user nntp-address)))))))))) + (read-passwd (format "NNTP (%s@%s) password: " + user nntp-address)))))))))) (defun nntp-send-nosy-authinfo () "Send the AUTHINFO to the nntp server." @@ -1053,8 +1055,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) (when t ;???Should check if AUTHINFO succeeded (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (mail-source-read-passwd "NNTP (%s@%s) password: " - user nntp-address)))))) + (read-passwd (format "NNTP (%s@%s) password: " + user nntp-address))))))) (defun nntp-send-authinfo-from-file () "Send the AUTHINFO to the nntp server. @@ -1068,7 +1070,7 @@ password contained in '~/.nntp-authinfo'." (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (progn (end-of-line) (point))))))) + (buffer-substring (point) (gnus-point-at-eol)))))) ;;; Internal functions. @@ -1148,7 +1150,15 @@ password contained in '~/.nntp-authinfo'." (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) (defun nntp-open-ssl-stream (buffer) - (let ((proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number))) + (let* ((process-connection-type nil) + (proc (start-process "nntpd" buffer + shell-file-name + shell-command-switch + (format-spec nntp-ssl-program + (format-spec-make + ?s nntp-address + ?p nntp-port-number))))) + (process-kill-without-query proc) (save-excursion (set-buffer buffer) (nntp-wait-for-string "^\r*20[01]") @@ -1280,7 +1290,7 @@ password contained in '~/.nntp-authinfo'." (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) nntp-server-buffer)) - (let ((len (/ (point-max) 1024)) + (let ((len (/ (buffer-size) 1024)) message-log-max) (unless (< len 10) (setq nntp-have-messaged t) @@ -1315,16 +1325,18 @@ password contained in '~/.nntp-authinfo'." (when group (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (when (not (equal group (caddr entry))) - (save-excursion - (set-buffer (process-buffer (car entry))) - (erase-buffer) - (nntp-send-command "^[245].*\n" "GROUP" group) - (setcar (cddr entry) group) - (erase-buffer) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))))))) + (cond ((not entry) + (nntp-report "Server closed connection")) + ((not (equal group (caddr entry))) + (save-excursion + (set-buffer (process-buffer (car entry))) + (erase-buffer) + (nntp-send-command "^[245].*\n" "GROUP" group) + (setcar (cddr entry) group) + (erase-buffer) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer)))))))) (defun nntp-decode-text (&optional cr-only) "Decode the text in the current buffer." @@ -1669,7 +1681,7 @@ via telnet.") proc (concat (or nntp-telnet-passwd (setq nntp-telnet-passwd - (mail-source-read-passwd "Password: "))) + (read-passwd "Password: "))) "\n")) (nntp-wait-for-string nntp-telnet-shell-prompt) (process-send-string @@ -1821,8 +1833,7 @@ Please refer to the following variables to customize the connection: (concat (or nntp-via-user-password (setq nntp-via-user-password - (mail-source-read-passwd - "Password: "))) + (read-passwd "Password: "))) "\n")) (nntp-wait-for-string nntp-via-shell-prompt) (let ((real-telnet-command `("exec" diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 1157eeb..185dd6b 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -426,7 +426,7 @@ component group will show up when you enter the virtual group.") (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") nil t) (replace-match "" t t)) - (unless (= (point) (point-max)) + (unless (eobp) (insert " ") (when (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" nil t) diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el index e05ae78..8802594 100644 --- a/lisp/nnwarchive.el +++ b/lisp/nnwarchive.el @@ -41,7 +41,6 @@ (require 'gnus-bcklg) (require 'nnmail) (require 'mm-util) -(require 'mail-source) (require 'mm-url) (nnoo-declare nnwarchive) @@ -286,7 +285,7 @@ user-mail-address))) (setq nnwarchive-passwd (or nnwarchive-passwd - (mail-source-read-passwd + (read-passwd (format "Password for %s at %s: " nnwarchive-login server))))) (unless nnwarchive-groups diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el index 79e6aab..8718f44 100644 --- a/lisp/pgg-gpg.el +++ b/lisp/pgg-gpg.el @@ -83,7 +83,8 @@ (insert-file-contents output-file-name))) (set-buffer errors-buffer) (if (not (equal exit-status 0)) - (error "%s exited abnormally: '%s'" program exit-status)))) + (insert (format "\n%s exited abnormally: '%s'\n" + program exit-status))))) (if (file-exists-p output-file-name) (delete-file output-file-name)) (set-default-file-modes orig-mode)))) diff --git a/lisp/pgg.el b/lisp/pgg.el index 0f686d6..407e5c1 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -89,19 +89,11 @@ (defvar pgg-passphrase-cache (make-vector 7 0)) -(defvar pgg-read-passphrase nil) (defun pgg-read-passphrase (prompt &optional key) - (if (not pgg-read-passphrase) - (if (functionp 'read-passwd) - (setq pgg-read-passphrase 'read-passwd) - (if (load "passwd" t) - (setq pgg-read-passphrase 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pgg-read-passphrase 'ange-ftp-read-passwd)))) (or (and pgg-cache-passphrase key (setq key (pgg-truncate-key-identifier key)) (symbol-value (intern-soft key pgg-passphrase-cache))) - (funcall pgg-read-passphrase prompt))) + (read-passwd prompt))) (defun pgg-add-passphrase-cache (key passphrase) (setq key (pgg-truncate-key-identifier key)) diff --git a/lisp/pop3.el b/lisp/pop3.el index 43cf916..0c2f73c 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -75,7 +75,7 @@ Used for APOP authentication.") ;; query for password (if (and pop3-password-required (not pop3-password)) (setq pop3-password - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (read-passwd (format "Password for %s: " pop3-maildrop)))) (cond ((equal 'apop pop3-authentication-scheme) (pop3-apop process pop3-maildrop)) ((equal 'pass pop3-authentication-scheme) @@ -117,7 +117,7 @@ Used for APOP authentication.") ;; query for password (if (and pop3-password-required (not pop3-password)) (setq pop3-password - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (read-passwd (format "Password for %s: " pop3-maildrop)))) (cond ((equal 'apop pop3-authentication-scheme) (pop3-apop process pop3-maildrop)) ((equal 'pass pop3-authentication-scheme) @@ -188,17 +188,6 @@ Return the response string if optional second argument is non-nil." t) ))))) -(defvar pop3-read-passwd nil) -(defun pop3-read-passwd (prompt) - (if (not pop3-read-passwd) - (if (fboundp 'read-passwd) - (setq pop3-read-passwd 'read-passwd) - (if (load "passwd" t) - (setq pop3-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pop3-read-passwd 'ange-ftp-read-passwd)))) - (funcall pop3-read-passwd prompt)) - (defun pop3-clean-region (start end) (setq end (set-marker (make-marker) end)) (save-excursion @@ -312,7 +301,7 @@ If NOW, use that time instead." (let ((pass pop3-password)) (if (and pop3-password-required (not pass)) (setq pass - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) + (read-passwd (format "Password for %s: " pop3-maildrop)))) (if pass (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) (pop3-send-command process (format "APOP %s %s" user hash)) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index fdce08d..0b65fcb 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -538,7 +538,7 @@ The buffer may be narrowed." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region b (point-max) mail-parse-charset)))))) + (mm-decode-coding-region-safely b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." @@ -555,7 +555,12 @@ The buffer may be narrowed." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-string string mail-parse-charset) + (let* ((decoded (mm-decode-coding-string string mail-parse-charset)) + (charsets (find-charset-string decoded))) + (if (or (memq 'eight-bit-control charsets) + (memq 'eight-bit-graphic charsets)) + (mm-decode-coding-string string 'undecided) + decoded)) string)))) (defun rfc2047-parse-and-decode (word) diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el index 9193577..b3015ab 100644 --- a/lisp/sieve-manage.el +++ b/lisp/sieve-manage.el @@ -166,23 +166,6 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") (when (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil))) -(defun sieve-manage-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt (if args - (apply 'format prompt args) - prompt))) - (funcall (if (or (fboundp 'read-passwd) - (and (load "subr" t) - (fboundp 'read-passwd)) - (and (load "passwd" t) - (fboundp 'read-passwd))) - 'read-passwd - (autoload 'ange-ftp-read-passwd "ange-ftp") - 'ange-ftp-read-passwd) - prompt))) - - ;; Uses the dynamically bound `reason' variable. (defvar reason) (defun sieve-manage-interactive-login (buffer loginfunc) @@ -202,7 +185,7 @@ Returns t if login was successful, nil otherwise." sieve-manage-server ": ") (or user sieve-manage-default-user)))) (setq passwd (or sieve-manage-password - (sieve-manage-read-passwd + (read-passwd (concat "Managesieve password for " user "@" sieve-manage-server ": ")))) (when (and user passwd) diff --git a/lisp/spam.el b/lisp/spam.el index ffecadf..e95baf5 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -40,6 +40,9 @@ (require 'gnus) ; for the definitions of group content classification and spam processors (require 'message) ;for the message-fetch-field functions +;; for nnimap-split-download-body-default +(eval-when-compile (require 'nnimap)) + ;; autoload executable-find (eval-and-compile ;; executable-find is not autoloaded in Emacs 20 @@ -69,7 +72,15 @@ When nil, only ham and unclassified groups will have their spam moved to the spam-process-destination. When t, spam will also be moved from spam groups." :type 'boolean - :group 'spam-ifile) + :group 'spam) + +(defcustom spam-mark-ham-unread-before-move-from-spam-group nil + "Whether ham should be marked unread before it's moved out of a spam +group according to ham-process-destination. This variable is an +official entry in the international Longest Variable Name +Competition." + :type 'boolean + :group 'spam) (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory) "The location of the whitelist. @@ -112,6 +123,11 @@ are considered spam." :type 'boolean :group 'spam) +(defcustom spam-use-hashcash nil + "Whether hashcash payments should be detected by spam-split." + :type 'boolean + :group 'spam) + (defcustom spam-use-regex-headers nil "Whether a header regular expression match should be used by spam-split. Also see the variable `spam-spam-regex-headers' and `spam-ham-regex-headers'." @@ -262,6 +278,16 @@ your main source of newsgroup names." :type 'string :group 'spam-bogofilter) +(defcustom spam-bogofilter-spam-switch "-s" + "The switch that Bogofilter uses to register spam messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-ham-switch "-n" + "The switch that Bogofilter uses to register ham messages." + :type 'string + :group 'spam-bogofilter) + (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" "The regex on `spam-bogofilter-header' for positive spam identification." :type 'regexp @@ -336,6 +362,9 @@ your main source of newsgroup names." (defun spam-group-ham-processor-BBDB-p (group) (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB)) +(defun spam-group-ham-processor-copy-p (group) + (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy)) + ;;; Summary entry and exit processing. (defun spam-summary-prepare () @@ -343,61 +372,68 @@ your main source of newsgroup names." (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) +;; The spam processors are invoked for any group, spam or ham or neither (defun spam-summary-prepare-exit () - ;; The spam processors are invoked for any group, spam or ham or neither - (gnus-message 6 "Exiting summary buffer and applying spam rules") - (when (and spam-bogofilter-path - (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name)) - (gnus-message 5 "Registering spam with bogofilter") - (spam-bogofilter-register-spam-routine)) + (unless gnus-group-is-exiting-without-update-p + (gnus-message 6 "Exiting summary buffer and applying spam rules") + (when (and spam-bogofilter-path + (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name)) + (gnus-message 5 "Registering spam with bogofilter") + (spam-bogofilter-register-spam-routine)) - (when (and spam-ifile-path - (spam-group-spam-processor-ifile-p gnus-newsgroup-name)) - (gnus-message 5 "Registering spam with ifile") - (spam-ifile-register-spam-routine)) + (when (and spam-ifile-path + (spam-group-spam-processor-ifile-p gnus-newsgroup-name)) + (gnus-message 5 "Registering spam with ifile") + (spam-ifile-register-spam-routine)) - (when (spam-group-spam-processor-stat-p gnus-newsgroup-name) - (gnus-message 5 "Registering spam with spam-stat") - (spam-stat-register-spam-routine)) - - (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name) - (gnus-message 5 "Registering spam with the blacklist") - (spam-blacklist-register-routine)) - - (if spam-move-spam-nonspam-groups-only - (when (not (spam-group-spam-contents-p gnus-newsgroup-name)) - (spam-mark-spam-as-expired-and-move-routine - (gnus-parameter-spam-process-destination gnus-newsgroup-name))) - (gnus-message 5 "Marking spam as expired and moving it") - (spam-mark-spam-as-expired-and-move-routine - (gnus-parameter-spam-process-destination gnus-newsgroup-name))) - - ;; now we redo spam-mark-spam-as-expired-and-move-routine to only - ;; expire spam, in case the above did not expire them - (spam-mark-spam-as-expired-and-move-routine nil) - - (when (spam-group-ham-contents-p gnus-newsgroup-name) - (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with the whitelist") - (spam-whitelist-register-routine)) - (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with ifile") - (spam-ifile-register-ham-routine)) - (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with Bogofilter") - (spam-bogofilter-register-ham-routine)) - (when (spam-group-ham-processor-stat-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with spam-stat") - (spam-stat-register-ham-routine)) - (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name) - (gnus-message 5 "Registering ham with the BBDB") - (spam-BBDB-register-routine))) - - ;; now move all ham articles out of spam groups - (when (spam-group-spam-contents-p gnus-newsgroup-name) - (gnus-message 5 "Moving ham messages from spam group") - (spam-ham-move-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) + (when (spam-group-spam-processor-stat-p gnus-newsgroup-name) + (gnus-message 5 "Registering spam with spam-stat") + (spam-stat-register-spam-routine)) + + (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name) + (gnus-message 5 "Registering spam with the blacklist") + (spam-blacklist-register-routine)) + + (if spam-move-spam-nonspam-groups-only + (when (not (spam-group-spam-contents-p gnus-newsgroup-name)) + (spam-mark-spam-as-expired-and-move-routine + (gnus-parameter-spam-process-destination gnus-newsgroup-name))) + (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name) + (spam-mark-spam-as-expired-and-move-routine + (gnus-parameter-spam-process-destination gnus-newsgroup-name))) + + ;; now we redo spam-mark-spam-as-expired-and-move-routine to only + ;; expire spam, in case the above did not expire them + (gnus-message 5 "Marking spam as expired without moving it") + (spam-mark-spam-as-expired-and-move-routine nil) + + (when (spam-group-ham-contents-p gnus-newsgroup-name) + (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with the whitelist") + (spam-whitelist-register-routine)) + (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with ifile") + (spam-ifile-register-ham-routine)) + (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with Bogofilter") + (spam-bogofilter-register-ham-routine)) + (when (spam-group-ham-processor-stat-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with spam-stat") + (spam-stat-register-ham-routine)) + (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name) + (gnus-message 5 "Registering ham with the BBDB") + (spam-BBDB-register-routine))) + + (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) + (gnus-message 5 "Copying ham") + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name) t)) + + ;; now move all ham articles out of spam groups + (when (spam-group-spam-contents-p gnus-newsgroup-name) + (gnus-message 5 "Moving ham messages from spam group") + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name))))) (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) @@ -414,28 +450,44 @@ your main source of newsgroup names." (gnus-summary-mark-article article gnus-spam-mark)))))) (defun spam-mark-spam-as-expired-and-move-routine (&optional group) + (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article) - (while articles - (setq article (pop articles)) + article tomove) + (dolist (article articles) (when (eq (gnus-summary-article-mark article) gnus-spam-mark) (gnus-summary-mark-article article gnus-expirable-mark) - (when (stringp group) - (let ((gnus-current-article article)) - (gnus-summary-move-article nil group))))))) + (push article tomove))) + + ;; now do the actual move + (when (and tomove + (stringp group)) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove (gnus-summary-move-article nil group)))) + (gnus-summary-yank-process-mark)) -(defun spam-ham-move-routine (&optional group) +(defun spam-ham-move-routine (&optional group copy) + (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article ham-mark-values mark) - - (dolist (mark spam-ham-marks) - (push (symbol-value mark) ham-mark-values)) - - (dolist (article articles) - (when (and (memq (gnus-summary-article-mark article) ham-mark-values) - (stringp group)) - (let ((gnus-current-article article)) - (gnus-summary-move-article nil group)))))) + article ham-mark-values mark tomove) + (when (stringp group) ; this routine will do nothing + ; without a valid group + (dolist (mark spam-ham-marks) + (push (symbol-value mark) ham-mark-values)) + (dolist (article articles) + (when (memq (gnus-summary-article-mark article) ham-mark-values) + (push article tomove))) + + ;; now do the actual move + (when tomove + (dolist (article tomove) + (when spam-mark-ham-unread-before-move-from-spam-group + (gnus-summary-mark-article article gnus-unread-mark)) + (gnus-summary-set-process-mark article)) + (if copy + (gnus-summary-copy-article nil group) + (gnus-summary-move-article nil group))))) + (gnus-summary-yank-process-mark)) (defun spam-generic-register-routine (spam-func ham-func) (let ((articles gnus-newsgroup-articles) @@ -489,14 +541,15 @@ your main source of newsgroup names." (setq article-buffer (get-buffer gnus-article-buffer)))) article-buffer)) -(defun spam-get-article-as-filename (article) - (let ((article-filename)) - (when (numberp article) - (nnml-possibly-change-directory (gnus-group-real-name gnus-newsgroup-name)) - (setq article-filename (expand-file-name (int-to-string article) nnml-current-directory))) - (if (file-exists-p article-filename) - article-filename - nil))) +;; disabled for now +;; (defun spam-get-article-as-filename (article) +;; (let ((article-filename)) +;; (when (numberp article) +;; (nnml-possibly-change-directory (gnus-group-real-name gnus-newsgroup-name)) +;; (setq article-filename (expand-file-name (int-to-string article) nnml-current-directory))) +;; (if (file-exists-p article-filename) +;; article-filename +;; nil))) (defun spam-fetch-field-from-fast (article) "Fetch the `from' field quickly, using the internal gnus-data-list function" @@ -523,6 +576,7 @@ your main source of newsgroup names." (spam-use-ifile . spam-check-ifile) (spam-use-stat . spam-check-stat) (spam-use-blackholes . spam-check-blackholes) + (spam-use-hashcash . spam-check-hashcash) (spam-use-bogofilter-headers . spam-check-bogofilter-headers) (spam-use-bogofilter . spam-check-bogofilter)) "The spam-list-of-checks list contains pairs associating a parameter @@ -537,6 +591,11 @@ should go, and further checks are also inhibited. The usual mailgroup name is the value of `spam-split-group', meaning that the message is definitely a spam.") +(defvar spam-list-of-statistical-checks + '(spam-use-ifile spam-use-stat spam-use-bogofilter) +"The spam-list-of-statistical-checks list contains all the mail +splitters that need to have the full message body available.") + (defun spam-split () "Split this message into the `spam' group if it is spam. This function can be used as an entry in `nnmail-split-fancy', for @@ -544,10 +603,14 @@ example like this: (: spam-split) See the Info node `(gnus)Fancy Mail Splitting' for more details." (interactive) - - ;; load the spam-stat tables if needed - (when spam-use-stat (spam-stat-load)) + (dolist (check spam-list-of-statistical-checks) + (when (symbol-value check) + (widen) + (gnus-message 8 "spam-split: widening the buffer (%s requires it)" + (symbol-name check)) + (return))) +;; (progn (widen) (debug (buffer-string))) (let ((list-of-checks spam-list-of-checks) decision) (while (and list-of-checks (not decision)) @@ -558,6 +621,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if (eq decision t) nil decision))) + +(defun spam-setup-widening () + (dolist (check spam-list-of-statistical-checks) + (when (symbol-value check) + (setq nnimap-split-download-body-default t)))) + +(add-hook 'gnus-get-new-news-hook 'spam-setup-widening) + ;;;; Regex headers @@ -605,7 +676,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if spam-use-dig (let ((query-result (query-dig query-string))) (when query-result - (gnus-message 5 "(DIG): positive blackhole check '%s'" query-result) + (gnus-message 5 "(DIG): positive blackhole check '%s'" + query-result) (push (list ip server query-result) matches))) ;; else, if not using dig.el @@ -616,6 +688,20 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when matches spam-split-group))) +;;;; Hashcash. + +(condition-case nil + (progn + (require 'hashcash) + + (defun spam-check-hashcash () + "Check the headers for hashcash payments." + (mail-check-payment))) ;mail-check-payment returns a boolean + + (file-error (progn + (defalias 'mail-check-payment 'ignore) + (defalias 'spam-check-hashcash 'ignore)))) + ;;;; BBDB ;;; original idea for spam-check-BBDB from Alexander Kotelnikov @@ -711,7 +797,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (let ((category (or category gnus-newsgroup-name)) (db-param (spam-get-ifile-database-parameter))) (with-temp-buffer - (insert-string article-string) + (insert article-string) (if db-param (call-process-region (point-min) (point-max) spam-ifile-path nil nil nil @@ -754,10 +840,9 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (lambda (article) (let ((article-string (spam-get-article-as-string article))) (with-temp-buffer - (insert-string article-string) + (insert article-string) (spam-stat-buffer-is-spam)))) - nil) - (spam-stat-save)) + nil)) (defun spam-stat-register-ham-routine () (spam-generic-register-routine @@ -765,9 +850,19 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (lambda (article) (let ((article-string (spam-get-article-as-string article))) (with-temp-buffer - (insert-string article-string) - (spam-stat-buffer-is-non-spam))))) - (spam-stat-save))) + (insert article-string) + (spam-stat-buffer-is-non-spam)))))) + + (defun spam-maybe-spam-stat-load () + (when spam-use-stat (spam-stat-load))) + + (defun spam-maybe-spam-stat-save () + (when spam-use-stat (spam-stat-save))) + + ;; Add hooks for loading and saving the spam stats + (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)) (file-error (progn (defalias 'spam-stat-register-ham-routine 'ignore) @@ -917,9 +1012,10 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (defun spam-bogofilter-register-with-bogofilter (article-string spam) "Register an article, given as a string, as spam or non-spam." (when (stringp article-string) - (let ((switch (if spam "-s" "-n"))) + (let ((switch (if spam spam-bogofilter-spam-switch + spam-bogofilter-ham-switch))) (with-temp-buffer - (insert-string article-string) + (insert article-string) (if spam-bogofilter-database-directory (call-process-region (point-min) (point-max) spam-bogofilter-path diff --git a/texi/ChangeLog b/texi/ChangeLog index 477cd97..836dfed 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,124 @@ +2003-03-17 Reiner Steib + + * gnus.texi (Using MIME): Added gnus-mime-delete-part. + +2003-03-17 Lars Magne Ingebrigtsen + + * gnus.texi (Required Back End Functions): Add. + +2003-03-17 Simon Josefsson + + * pgg.texi: Fix setfilename. Tiny patch by Frank Haun + . + +2003-03-09 Paul Jarc + + * gnus.texi (Top): Added menu item for Maildir node. + +2003-03-11 Jesper Harder + + * gnus.texi (Paging the Article): Addition. + +2003-03-10 Jesper Harder + + * gnus.texi (Customizing Articles): Additions. + +2003-03-09 Paul Jarc + + * gnus.texi (Maildir): New node. + +2003-03-08 Jesper Harder + + * gnusref.tex: Update. + +2003-03-03 Reiner Steib + + * gnus.texi (Mail and Post): Updated `gnus-user-agent'. + (Mail Source Customization): Added `mail-source-delete-incoming' + and `mail-source-delete-old-incoming-confirm'. + +2003-03-01 Jesper Harder + + * gnus.texi (Troubleshooting): Fix typo. + (Group Parameters): Markup fix. + (Article Hiding, Splitting Mail, Fancy Mail Splitting) + (Document Server Internals, Score Variables, Adaptive Scoring) + (X-Face, Hashcash): do. + +2003-02-28 Vasily Korytov + + * gnus.texi: New values, 'to-list and 'cc-list, for + gnus-boring-article-headers. + +2003-02-28 Teodor Zlatanov + + * gnus.texi (Extending the spam elisp package): added mention of + spam-list-of-statistical-checks + +2003-02-27 ShengHuo ZHU + + * gnus.texi: Remove the dependence on ssl.el. + +2003-02-26 Jesper Harder + + * message.texi (Mail Variables): Add + message-sendmail-envelope-from. + +2003-02-24 Reiner Steib + + * gnus.texi (Mail and Post): Added `gnus-user-agent', removed + `gnus-version-expose-system'. + +2003-02-24 Jesper Harder + + * gnus.texi: Markup fixes. + + * message.texi: do. + + * emacs-mime.texi: do. + +2003-02-20 Reiner Steib + + * message.texi (News Headers): Update description of Message-ID. + +2003-02-23 Lars Magne Ingebrigtsen + + * gnus.texi (Startup Files): Addition. + +2003-02-22 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Source Specifiers): Addition. + +2003-02-22 Jesper Harder + + * emacs-mime.texi (Files and Directories): New node. + +2003-02-21 Jesper Harder + + * gnus.texi (Mailing List): Fix. + + * gnus.texi: Markup fixes. + +2003-02-18 Reiner Steib + + * gnus.texi (Article Washing): Mention `g'. + (Customizing Articles): Added cross reference. + +2003-02-12 Michael Shields + + * gnus.texi (Paging the Article): Document + gnus-article-boring-faces. + (Choosing Commands): Explain that SPACE in the summary buffer + is used for both selecting and scrolling. + + * gnus.texi (Article Keymap): Say that SPACE and DEL in the + summary buffer are the same as switching to the article buffer + and using SPACE and DEL; since now that is the case. + +2003-02-11 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + 2003-02-07 Teodor Zlatanov * gnus.texi (BBDB Whitelists, Blacklists and Whitelists): diff --git a/texi/emacs-mime.texi b/texi/emacs-mime.texi index 2261722..f249157 100644 --- a/texi/emacs-mime.texi +++ b/texi/emacs-mime.texi @@ -117,6 +117,7 @@ returned as a result of this analysis. * Handles:: Handle manipulations. * Display:: Displaying handles. * Display Customization:: Variables that affect display. +* Files and Directories:: Saving and naming attachments. * New Viewers:: How to write your own viewers. @end menu @@ -400,6 +401,59 @@ The program used to start an external terminal. @end table +@node Files and Directories +@section Files and Directories + +@table @code + +@item mm-default-directory +@vindex mm-default-directory +The default directory for saving attachments. If @code{nil} use +@code{default-directory}. + +@item mm-tmp-directory +@vindex mm-tmp-directory +Directory for storing temporary files. + +@item mm-file-name-rewrite-functions +@vindex mm-file-name-rewrite-functions +A list of functions used for rewriting file names of @sc{mime} +parts. Each function is applied successively to the file name. +Ready-made functions include + +@table @code +@item mm-file-name-delete-whitespace +@findex mm-file-name-delete-whitespace +Remove all whitespace. + +@item mm-file-name-trim-whitespace +@findex mm-file-name-trim-whitespace +Remove leading and trailing whitespace. + +@item mm-file-name-collapse-whitespace +@findex mm-file-name-collapse-whitespace +Collapse multiple whitespace characters. + +@item mm-file-name-replace-whitespace +@findex mm-file-name-replace-whitespace +@vindex mm-file-name-replace-whitespace +Replace whitespace with underscores. Set the variable +@code{mm-file-name-replace-whitespace} to any other string if you do +not like underscores. + +@end table + +The standard Emacs functions @code{capitalize}, @code{downcase}, +@code{upcase} and @code{upcase-initials} might also prove useful. + +@item mm-path-name-rewrite-functions +@vindex mm-path-name-rewrite-functions +List of functions used for rewriting the full file names of @sc{mime} +parts. This is used when viewing parts externally, and is meant for +transforming the absolute name so that non-compliant programs can find +the file where it's saved. + +@end table @node New Viewers @section New Viewers @@ -427,7 +481,7 @@ The two important helper functions here are @code{mm-insert-part} and handle in the current buffer. It handles charset and/or content transfer decoding. The second function just inserts whatever text you tell it to insert, but it also sets things up so that the text can be -``undisplayed' in a convenient manner. +``undisplayed'' in a convenient manner. @node Composing @@ -1390,7 +1444,7 @@ Take a time and return the number of days that represents. @item safe-date-to-time Take a date and return a time. If the date is not syntactically valid, -return a "zero" date. +return a ``zero'' date. @item time-less-p Take two times and say whether the first time is less (i. e., earlier) diff --git a/texi/gnus.texi b/texi/gnus.texi index cb6e5c1..53a1d31 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -33,7 +33,7 @@ \makeindex \begin{document} -\newcommand{\gnusversionname}{Oort Gnus v0.15} +\newcommand{\gnusversionname}{Oort Gnus v0.16} \newcommand{\gnuschaptername}{} \newcommand{\gnussectionname}{} @@ -387,7 +387,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Oort Gnus v0.15. +This manual corresponds to Oort Gnus v0.16. @end ifinfo @@ -583,7 +583,7 @@ Customizing Threading * Loose Threads:: How Gnus gathers loose threads into bigger threads. * Filling In Threads:: Making the threads displayed look fuller. * More Threading:: Even more variables for fiddling with threads. -* Low-Level Threading:: You thought it was over... but you were wrong! +* Low-Level Threading:: You thought it was over@dots{} but you were wrong! Decoding Articles @@ -704,6 +704,7 @@ Choosing a Mail Back End * Rmail Babyl:: Emacs programs use the rmail babyl format. * Mail Spool:: Store your mail in a private spool? * MH Spool:: An mhspool-like back end. +* Maildir:: Another one-file-per-message format. * Mail Folders:: Having one file for each group. * Comparing Mail Back Ends:: An in-depth looks at pros and cons. @@ -722,7 +723,7 @@ Browsing the Web * Splitting in IMAP:: Splitting mail with nnimap. * Expiring in IMAP:: Expiring mail with nnimap. * Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. -* Expunging mailboxes:: Equivalent of a "compress mailbox" button. +* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. * A note on namespaces:: How to (not) use IMAP namespace in Gnus. Other Sources @@ -1136,8 +1137,8 @@ information in the normal (i.e., master) @file{.newsrc} file. If the @file{.newsrc*} files have not been saved in the master when the slave starts, you may be prompted as to whether to read an auto-save -file. If you answer "yes", the unsaved changes to the master will be -incorporated into the slave. If you answer "no", the slave may see some +file. If you answer ``yes'', the unsaved changes to the master will be +incorporated into the slave. If you answer ``no'', the slave may see some messages as unread that have been read in the master. @node Fetching a Group @@ -1444,9 +1445,14 @@ saving. This can be useful in certain obscure situations that involve several servers where not all servers support @code{ask-server}. @vindex gnus-startup-file +@vindex gnus-backup-startup-file +@vindex version-control The @code{gnus-startup-file} variable says where the startup files are. The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup file being whatever that one is, with a @samp{.eld} appended. +If you want version control for this file, set +@code{gnus-backup-startup-file}. It respects the same values as the +@code{version-control} variable. @vindex gnus-save-newsrc-hook @vindex gnus-save-quick-newsrc-hook @@ -1943,8 +1949,8 @@ The score of the group. @item ticked The number of ticked articles in the group. @item total -The total number of articles in the group. Or rather, MAX-NUMBER minus -MIN-NUMBER plus one. +The total number of articles in the group. Or rather, +@var{max-number} minus @var{min-number} plus one. @item topic When using the topic minor mode, this variable is bound to the current topic being inserted. @@ -2051,10 +2057,10 @@ Select the current group, switch to the summary buffer and display the first unread article (@code{gnus-group-read-group}). If there are no unread articles in the group, or if you give a non-numerical prefix to this command, Gnus will offer to fetch all the old articles in this -group from the server. If you give a numerical prefix @var{N}, @var{N} -determines the number of articles Gnus will fetch. If @var{N} is -positive, Gnus fetches the @var{N} newest articles, if @var{N} is -negative, Gnus fetches the @code{abs(@var{N})} oldest articles. +group from the server. If you give a numerical prefix @var{n}, @var{n} +determines the number of articles Gnus will fetch. If @var{n} is +positive, Gnus fetches the @var{n} newest articles, if @var{n} is +negative, Gnus fetches the @code{abs(@var{n})} oldest articles. Thus, @kbd{SPC} enters the group normally, @kbd{C-u SPC} offers old articles, @kbd{C-u 4 2 SPC} fetches the 42 newest articles, and @kbd{C-u @@ -2649,7 +2655,7 @@ Here's an example group parameter list: (auto-expire . t)) @end example -We see that each element consists of a "dotted pair"---the thing before +We see that each element consists of a ``dotted pair''---the thing before the dot is the key, while the thing after the dot is the value. All the parameters have this form @emph{except} local variable specs, which are not dotted pairs, but proper lists. @@ -2820,8 +2826,8 @@ display on entering the group. Valid values are: Display all articles, both read and unread. @item an integer -Display the last INTEGER articles in the group. This is the same as -entering the group with C-u INTEGER. +Display the last @var{integer} articles in the group. This is the same as +entering the group with C-u @var{integer}. @item default Display the default visible articles, which normally includes unread and @@ -2968,7 +2974,7 @@ Group parameters can be set via the @code{gnus-parameters} variable too. But some variables, such as @code{visible}, have no effect. For example: -@example +@lisp (setq gnus-parameters '(("mail\\..*" (gnus-show-threads nil) @@ -2987,7 +2993,7 @@ example: ("list\\..*" (total-expire . t) (broken-reply-to . t)))) -@end example +@end lisp String value of parameters will be subjected to regexp substitution, as the @code{to-group} example shows. @@ -3483,10 +3489,10 @@ To get this @emph{fab} functionality you simply turn on (ooh!) the is a toggling command.) Go ahead, just try it. I'll still be here when you get back. La de -dum... Nice tune, that... la la la... What, you're back? Yes, and -now press @kbd{l}. There. All your groups are now listed under -@samp{misc}. Doesn't that make you feel all warm and fuzzy? Hot and -bothered? +dum@dots{} Nice tune, that@dots{} la la la@dots{} What, you're back? +Yes, and now press @kbd{l}. There. All your groups are now listed +under @samp{misc}. Doesn't that make you feel all warm and fuzzy? +Hot and bothered? If you want this permanently enabled, you should add that minor mode to the hook for the group mode. Put the following line in your @@ -3669,13 +3675,15 @@ Toggle hiding empty topics @kindex T # (Topic) @findex gnus-topic-mark-topic Mark all groups in the current topic with the process mark -(@code{gnus-topic-mark-topic}). +(@code{gnus-topic-mark-topic}). This command works recursively on +sub-topics unless given a prefix. @item T M-# @kindex T M-# (Topic) @findex gnus-topic-unmark-topic Remove the process mark from all groups in the current topic -(@code{gnus-topic-unmark-topic}). +(@code{gnus-topic-unmark-topic}). This command works recursively on +sub-topics unless given a prefix. @item C-c C-x @kindex C-c C-x (Topic) @@ -3986,7 +3994,7 @@ post to the group under the point. If the prefix is 1, prompt for group to post to. @xref{Composing Messages}. This function actually prepares a news even when using mail groups. -This is useful for "posting" messages to mail groups without actually +This is useful for ``posting'' messages to mail groups without actually sending them over the network: they're just saved directly to the group in question. The corresponding back end must have a request-post method for this to work though. @@ -4662,10 +4670,11 @@ headers are used instead. @vindex nnmail-extra-headers A related variable is @code{nnmail-extra-headers}, which controls when -to include extra headers when generating overview (@sc{nov}) files. If -you have old overview files, you should regenerate them after changing -this variable, by entering the server buffer using `^', and then `g' on -the appropriate mail server (e.g. nnml) to cause regeneration. +to include extra headers when generating overview (@sc{nov}) files. +If you have old overview files, you should regenerate them after +changing this variable, by entering the server buffer using @kbd{^}, +and then @kbd{g} on the appropriate mail server (e.g. nnml) to cause +regeneration. @vindex gnus-summary-line-format You also have to instruct Gnus to display the data by changing the @@ -4907,6 +4916,10 @@ If you want to fetch new articles or redisplay the group, see Select the current article, or, if that one's read already, the next 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}. + @item G n @itemx n @kindex n (Summary) @@ -5046,6 +5059,15 @@ Pressing @kbd{SPACE} will scroll the current article forward one page, or, if you have come to the end of the current article, will choose the next article (@code{gnus-summary-next-page}). +@vindex gnus-article-boring-faces +@vindex gnus-article-skip-boring +If @code{gnus-article-skip-boring} is non-@code{nil} and the rest of +the article consists only of citations and signature, then it will be +skipped; the next article will be shown instead. You can customize +what is considered uninteresting with +@code{gnus-article-boring-faces}. You can manually view the article's +pages, no matter how boring, using @kbd{C-M-v}. + @item DEL @kindex DEL (Summary) @findex gnus-summary-prev-page @@ -5239,7 +5261,7 @@ post to the current group. If given a prefix, disable that. If the prefix is 1, prompt for a group to post to. This function actually prepares a news even when using mail groups. -This is useful for "posting" messages to mail groups without actually +This is useful for ``posting'' messages to mail groups without actually sending them over the network: they're just saved directly to the group in question. The corresponding back end must have a request-post method for this to work though. @@ -6341,7 +6363,7 @@ displayed as empty lines in the summary buffer. * Loose Threads:: How Gnus gathers loose threads into bigger threads. * Filling In Threads:: Making the threads displayed look fuller. * More Threading:: Even more variables for fiddling with threads. -* Low-Level Threading:: You thought it was over... but you were wrong! +* Low-Level Threading:: You thought it was over@dots{} but you were wrong! @end menu @@ -6817,7 +6839,7 @@ Go to the top of the thread (@code{gnus-summary-top-thread}). @vindex gnus-thread-operation-ignore-subject If you ignore subject while threading, you'll naturally end up with threads that have several different subjects in them. If you then issue -a command like `T k' (@code{gnus-summary-kill-thread}) you might not +a command like @kbd{T k} (@code{gnus-summary-kill-thread}) you might not wish to kill the entire thread, but just those parts of the thread that have the same subject as the current article. If you like this idea, you can fiddle with @code{gnus-thread-operation-ignore-subject}. If it @@ -6959,7 +6981,7 @@ loaded than if you didn't use article pre-fetch. The server itself will also become more loaded---both with the extra article requests, and the extra connection. -Ok, so now you know that you shouldn't really use this thing... unless +Ok, so now you know that you shouldn't really use this thing@dots{} unless you really want to. @vindex gnus-asynchronous @@ -6977,13 +6999,15 @@ pre-fetch all the articles it can without bound. If it is @vindex gnus-async-prefetch-article-p @findex gnus-async-read-p There are probably some articles that you don't want to pre-fetch---read -articles, for instance. The @code{gnus-async-prefetch-article-p} variable controls whether an article is to be pre-fetched. This function should -return non-@code{nil} when the article in question is to be -pre-fetched. The default is @code{gnus-async-read-p}, which returns -@code{nil} on read articles. The function is called with an article -data structure as the only parameter. +articles, for instance. The @code{gnus-async-prefetch-article-p} +variable controls whether an article is to be pre-fetched. This +function should return non-@code{nil} when the article in question is +to be pre-fetched. The default is @code{gnus-async-read-p}, which +returns @code{nil} on read articles. The function is called with an +article data structure as the only parameter. -If, for instance, you wish to pre-fetch only unread articles shorter than 100 lines, you could say something like: +If, for instance, you wish to pre-fetch only unread articles shorter +than 100 lines, you could say something like: @lisp (defun my-async-short-unread-p (data) @@ -7383,7 +7407,7 @@ File names like @file{~/News/larsi}. You can have Gnus suggest where to save articles by plonking a regexp into the @code{gnus-split-methods} alist. For instance, if you would like to save articles related to Gnus in the file @file{gnus-stuff}, and articles -related to VM in @code{vm-stuff}, you could set this variable to something +related to VM in @file{vm-stuff}, you could set this variable to something like: @lisp @@ -7668,7 +7692,7 @@ variables are of the form @vindex gnus-uu-user-view-rules @cindex sox This variable is consulted first when viewing files. If you wish to use, -for instance, @code{sox} to convert an @samp{.au} sound file, you could +for instance, @code{sox} to convert an @file{.au} sound file, you could say something like: @lisp (setq gnus-uu-user-view-rules @@ -7814,7 +7838,7 @@ Non-@code{nil} means that @code{gnus-uu} will post the encoded file in a thread. This may not be smart, as no other decoder I have seen is able to follow threads when collecting uuencoded articles. (Well, I have seen one package that does that---@code{gnus-uu}, but somehow, I don't -think that counts...) Default is @code{nil}. +think that counts@dots{}) Default is @code{nil}. @item gnus-uu-post-separate-description @vindex gnus-uu-post-separate-description @@ -8150,14 +8174,14 @@ the sender of an article has a certain mail address specified in @item gnus-article-address-banner-alist @vindex gnus-article-address-banner-alist Alist of mail addresses and banners. Each element has the form -@code{(ADDRESS . BANNER)}, where ADDRESS is a regexp matching a mail -address in the From header, BANNER is one of a symbol @code{signature}, -an item in @code{gnus-article-banner-alist}, a regexp and @code{nil}. -If ADDRESS matches author's mail address, it will remove things like -advertisements. For example, if a sender has the mail address -@samp{hail@@yoo-hoo.co.jp} and there is a banner something like -@samp{Do You Yoo-hoo!?} in all articles he sends, you can use the -following element to remove them: +@code{(@var{address} . @var{banner})}, where @var{address} is a regexp +matching a mail address in the From header, @var{banner} is one of a +symbol @code{signature}, an item in @code{gnus-article-banner-alist}, +a regexp and @code{nil}. If @var{address} matches author's mail +address, it will remove things like advertisements. For example, if a +sender has the mail address @samp{hail@@yoo-hoo.co.jp} and there is a +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\\'" . "\n_+\nDo You Yoo-hoo!\\?\n.*\n.*\n") @@ -8263,6 +8287,13 @@ This is not really washing, it's sort of the opposite of washing. If you type this, you see the article exactly as it exists on disk or on the server. +@item g +Force redisplaying of the current article +(@code{gnus-summary-show-article}). This is also not really washing. +If you type this, you see the article without any previously applied +interactive Washing functions but with all default treatments +(@pxref{Customizing Articles}). + @item W l @kindex W l (Summary) @findex gnus-summary-stop-page-breaking @@ -9757,7 +9788,7 @@ when respooling, if any (@code{gnus-summary-respool-trace}). @item B p @kindex B p (Summary) @findex gnus-summary-article-posted-p -Some people have a tendency to send you "courtesy" copies when they +Some people have a tendency to send you ``courtesy'' copies when they follow up to articles you have posted. These usually have a @code{Newsgroups} header in them, but not always. This command (@code{gnus-summary-article-posted-p}) will try to fetch the current @@ -10350,13 +10381,9 @@ and @code{gpg} are also supported although deprecated. @kindex A M (summary) @findex gnus-mailing-list-insinuate Gnus understands some mailing list fields of RFC 2369. To enable it, -either add a `to-list' group parameter (@pxref{Group Parameters}), +add a @code{to-list} group parameter (@pxref{Group Parameters}), possibly using @kbd{A M} (@code{gnus-mailing-list-insinuate}) in the -summary buffer, or say: - -@lisp -(add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode) -@end lisp +summary buffer. That enables the following commands to the summary buffer: @@ -10513,6 +10540,12 @@ 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. +@item to-list +Remove the @code{To} header if it only contains the address identical to +the current groups'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. @item date Remove the @code{Date} header if the article is less than three days old. @@ -10598,10 +10631,17 @@ Prompt for a file name, and then save the @sc{mime} object Prompt for a file name, then save the @sc{mime} object and strip it from the article. Then proceed to article editing, where a reasonable suggestion is being made on how the altered article should look -like. The stripped @sc{mime} object will be referred via the +like. The stripped @sc{mime} object will be referred via the message/external-body @sc{mime} type. (@code{gnus-mime-save-part-and-strip}). +@findex gnus-mime-delete-part +@item d (Article) +@kindex d (Article) +Delete the @sc{mime} object from the article and replace it with some +information about the removed @sc{mime} object +(@code{gnus-mime-delete-part}). + @findex gnus-mime-copy-part @item c (Article) @kindex c (Article) @@ -10678,7 +10718,8 @@ Also see @pxref{MIME Commands}. @cindex article customization A slew of functions for customizing how the articles are to look like -exist. You can call these functions interactively, or you can have them +exist. You can call these functions interactively +(@pxref{Article Washing}), or you can have them called automatically when you select the articles. To have them called automatically, you should set the corresponding @@ -10800,6 +10841,8 @@ is controlled by @code{gnus-body-boundary-delimiter}. @item gnus-treat-hide-citation-maybe (t, integer) @item gnus-treat-hide-headers (head) @item gnus-treat-hide-signature (t, last) +@item gnus-treat-strip-banner (t, last) +@item gnus-treat-strip-list-identifiers (head) @xref{Article Hiding}. @@ -10848,11 +10891,13 @@ A few additional keystrokes are available: @kindex SPACE (Article) @findex gnus-article-next-page Scroll forwards one page (@code{gnus-article-next-page}). +This is exactly the same as @kbd{h SPACE h}. @item DEL @kindex DEL (Article) @findex gnus-article-prev-page Scroll backwards one page (@code{gnus-article-prev-page}). +This is exactly the same as @kbd{h DEL h}. @item C-c ^ @kindex C-c ^ (Article) @@ -11155,13 +11200,17 @@ really are mailing lists. Then, at least, followups to the mailing lists will work most of the time. Posting to these groups (@kbd{a}) is still a pain, though. -@item gnus-version-expose-system -@vindex gnus-version-expose-system +@item gnus-user-agent +@vindex gnus-user-agent +@cindex User-Agent -Your system type (@code{system-configuration} variable, such as -@samp{i686-pc-linux}) is exposed in the auto-generated by default -User-Agent header. Sometimes, it may be desireable (mostly because of -aesthetic reasons) to turn it off. In this case, set it to @code{nil}. +This variable controls which information should be exposed in the +User-Agent header. It can be one of the symbols @code{gnus} (show only +Gnus version), @code{emacs-gnus} (show only Emacs and Gnus versions), +@code{emacs-gnus-config} (same as @code{emacs-gnus} plus system +configuration), @code{emacs-gnus-type} (same as @code{emacs-gnus} plus +system type) or a custom string. If you set it to a string, be sure to +use a valid format, see RFC 2616." @end table @@ -11393,16 +11442,17 @@ signature and the @samp{What me?} @code{Organization} header. The first element in each style is called the @code{match}. If it's a string, then Gnus will try to regexp match it against the group name. -If it is the form @code{(header MATCH REGEXP)}, then Gnus will look in -the original article for a header whose name is MATCH and compare that -REGEXP. MATCH and REGEXP are strings. (There 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 no -arguments. If it's a variable symbol, then the variable will be +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 +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 +no arguments. If it's a variable symbol, then the variable will be referenced. If it's a list, then that list will be @code{eval}ed. In -any case, if this returns a non-@code{nil} value, then the style is said -to @dfn{match}. +any case, if this returns a non-@code{nil} value, then the style is +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 @@ -11965,8 +12015,8 @@ buffer, and you should be able to enter any of the groups displayed. One sticky point when defining variables (both on back ends and in Emacs in general) is that some variables are typically initialized from other variables when the definition of the variables is being loaded. If you -change the "base" variable after the variables have been loaded, you -won't change the "derived" variables. +change the ``base'' variable after the variables have been loaded, you +won't change the ``derived'' variables. This typically affects directory and file variables. For instance, @code{nnml-directory} is @file{~/Mail/} by default, and all @code{nnml} @@ -12351,10 +12401,9 @@ remote system. @findex nntp-open-ssl-stream @item nntp-open-ssl-stream -Opens a connection to a server over a @dfn{secure} channel. To use -this you must have OpenSSL (@uref{http://www.openssl.org}) or SSLeay -installed (@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL}, and you also -need @file{ssl.el} (from the W3 distribution, for instance). You then +Opens a connection to a server over a @dfn{secure} channel. To use this +you must have OpenSSL (@uref{http://www.openssl.org}) or SSLeay +installed (@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL}. You then define a server as follows: @lisp @@ -12397,7 +12446,7 @@ session, which is not a good idea. These functions are called indirect because they connect to an intermediate host before actually connecting to the @sc{nntp} server. All of these functions and related variables are also said to belong to -the "via" family of connection: they're all prefixed with "via" to make +the ``via'' family of connection: they're all prefixed with ``via'' to make things cleaner. The behavior of these functions is also affected by commonly understood variables (@pxref{Common Variables}). @@ -12420,7 +12469,7 @@ Command used to log in on the intermediate host. The default is @vindex nntp-via-rlogin-command-switches List of strings to be used as the switches to @code{nntp-via-rlogin-command}. The default is @code{nil}. If you use -@samp{ssh} for `nntp-via-rlogin-command', you may set this to +@samp{ssh} for @code{nntp-via-rlogin-command}, you may set this to @samp{("-C")} in order to compress all data connections, otherwise set this to @samp{("-t")} or @samp{("-C" "-t")} if the telnet command requires a pseudo-tty allocation on an intermediate host. @@ -12697,8 +12746,8 @@ It's quite easy to use Gnus to read your new mail. You just plonk the mail back end of your choice into @code{gnus-secondary-select-methods}, and things will happen automatically. -For instance, if you want to use @code{nnml} (which is a "one file per -mail" back end), you could put the following in your @file{.gnus.el} file: +For instance, if you want to use @code{nnml} (which is a ``one file per +mail'' back end), you could put the following in your @file{.gnus.el} file: @lisp (setq gnus-secondary-select-methods '((nnml ""))) @@ -12706,7 +12755,7 @@ mail" back end), you could put the following in your @file{.gnus.el} file: Now, the next time you start Gnus, this back end will be queried for new articles, and it will move all the messages in your spool file to its -directory, which is @code{~/Mail/} by default. The new group that will +directory, which is @file{~/Mail/} by default. The new group that will be created (@samp{mail.misc}) will be subscribed, and you can read it like any other group. @@ -12763,11 +12812,11 @@ argument. It should return a non-@code{nil} value if it thinks that the mail belongs in that group. The last of these groups should always be a general one, and the regular -expression should @emph{always} be @samp{} so that it matches any mails +expression should @emph{always} be @samp{*} so that it matches any mails that haven't been matched by any of the other regexps. (These rules are processed from the beginning of the alist toward the end. The first -rule to make a match will "win", unless you have crossposting enabled. -In that case, all matching rules will "win".) +rule to make a match will ``win'', unless you have crossposting enabled. +In that case, all matching rules will ``win''.) If you like to tinker with this yourself, you can set this variable to a function of your choice. This function will be called without any @@ -12784,7 +12833,7 @@ some add @code{X-Gnus-Group} headers; most rename the Unix mbox The mail back ends all support cross-posting. If several regexps match, the mail will be ``cross-posted'' to all those groups. @code{nnmail-crosspost} says whether to use this mechanism or not. Note -that no articles are crossposted to the general (@samp{}) group. +that no articles are crossposted to the general (@samp{*}) group. @vindex nnmail-crosspost-link-function @cindex crosspost @@ -12810,7 +12859,7 @@ function. @vindex nnmail-mail-splitting-charset @vindex nnmail-mail-splitting-decodes -By default the splitting codes MIME decodes headers so you can match +By default the splitting codes @sc{mime} decodes headers so you can match on non-ASCII strings. The @code{nnmail-mail-splitting-charset} variable specifies the default charset for decoding. The behaviour can be turned off completely by binding @@ -12886,6 +12935,10 @@ Keywords: The file name. Defaults to the value of the @code{MAIL} environment variable or the value of @code{rmail-spool-directory} (usually something like @file{/usr/mail/spool/user-name}). + +@item :prescript +@itemx :postscript +Script run before/after fetching mail. @end table An example file mail source: @@ -13084,7 +13137,7 @@ Keywords: @item :path The name of the directory where the mails are stored. The default is taken from the @code{MAILDIR} environment variable or -@samp{~/Maildir/}. +@file{~/Maildir/}. @item :subdirs The subdirectories of the Maildir. The default is @samp{("new" "cur")}. @@ -13154,7 +13207,7 @@ this means @samp{gssapi}, @samp{kerberos4}, @samp{digest-md5}, @item :program When using the `shell' :stream, the contents of this variable is -mapped into the `imap-shell-program' variable. This should be a +mapped into the @code{imap-shell-program} variable. This should be a @code{format}-like string (or list of strings). Here's an example: @example @@ -13168,7 +13221,7 @@ The valid format specifier characters are: The name of the server. @item l -User name from `imap-default-user'. +User name from @code{imap-default-user}. @item p The port number of the server. @@ -13309,7 +13362,18 @@ File where mail will be stored while processing it. The default is @item mail-source-delete-incoming @vindex mail-source-delete-incoming -If non-@code{nil}, delete incoming files after handling them. +If non-@code{nil}, delete incoming files after handling them. If +@code{t}, delete the files immediately, if @code{nil}, never delete any +files. If a positive number, delete files older than number of days +(This will only happen, when reveiving new mail). You may also set +@code{mail-source-delete-incoming} to @code{nil} and call +@code{mail-source-delete-old-incoming} from a hook or interactively. + +@item mail-source-delete-old-incoming-confirm +@vindex mail-source-delete-old-incoming-confirm +If @code{non-nil}, ask for for confirmation before deleting old incoming +files. This variable only applies when +@code{mail-source-delete-incoming} is a positive number. @item mail-source-ignore-errors @vindex mail-source-ignore-errors @@ -13559,10 +13623,10 @@ 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 SPLIT will be processed, and FUNC will be -called as a function with the result of SPLIT as argument. FUNC should -return a split. +@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. @@ -14226,16 +14290,14 @@ depends on what format you want to store your mail in. There are six different mail back ends in the standard Gnus, and more back ends are available separately. The mail back end most people use (because it is possibly the fastest) is @code{nnml} (@pxref{Mail -Spool}). You might notice that only five back ends are listed below; -@code{nnmaildir}'s documentation has not yet been completely -incorporated into this manual. Until it is, you can find it at -@uref{http://multivac.cwru.edu./nnmaildir/}. +Spool}). @menu * Unix Mail Box:: Using the (quite) standard Un*x mbox. * Rmail Babyl:: Emacs programs use the rmail babyl format. * Mail Spool:: Store your mail in a private spool? * MH Spool:: An mhspool-like back end. +* Maildir:: Another one-file-per-message format. * Mail Folders:: Having one file for each group. * Comparing Mail Back Ends:: An in-depth looks at pros and cons. @end menu @@ -14354,19 +14416,19 @@ Virtual server settings: @table @code @item nnml-directory @vindex nnml-directory -All @code{nnml} directories will be placed under this directory. -The default is the value of `message-directory' (whose default value is -@file{~/Mail}). +All @code{nnml} directories will be placed under this directory. The +default is the value of @code{message-directory} (whose default value +is @file{~/Mail}). @item nnml-active-file @vindex nnml-active-file The active file for the @code{nnml} server. The default is -@file{~/Mail/active"}. +@file{~/Mail/active}. @item nnml-newsgroups-file @vindex nnml-newsgroups-file The @code{nnml} group descriptions file. @xref{Newsgroups File -Format}. The default is @file{~/Mail/newsgroups"}. +Format}. The default is @file{~/Mail/newsgroups}. @item nnml-get-new-mail @vindex nnml-get-new-mail @@ -14447,6 +14509,242 @@ to set this variable to @code{t}. The default is @code{nil}. @end table +@node Maildir +@subsubsection Maildir +@cindex nnmaildir +@cindex maildir + +@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. + +Maildir format was designed to allow concurrent deliveries and +reading, without needing locks. With other backends, 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. + +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 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 +symlinks to maildirs (and nothing else; do not choose a directory +already used for other purposes). You could also put maildirs +themselves (instead of symlinks to them) directly in the server +directory, but that would break @code{nnmaildir-request-delete-group}, +so you wouldn't be able to delete those groups from within Gnus. (You +could still delete them from your shell with @code{rm -r foo}.) 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. + +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 +the path of the directory for this server. The form is @code{eval}ed +only when the server is opened; the resulting string is used until the +server is closed. (If you don't know about forms and @code{eval}, +don't worry - a simple string will work.) This parameter is not +optional; you must specify it. I don't recommend using @file{~/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. @file{~/.nnmaildir} is a typical value. + +@item create-directory +This should be a Lisp form which is processed by @code{eval} and +@code{expand-file-name} to get the name of the directory where new +maildirs are created. The form is @code{eval}ed only when the server +is opened; the resulting string is used until the server is closed. +This parameter is optional, but if you do not supply it, you cannot +create new groups from within Gnus. (You could still create them from +your shell with @code{mkdir -m 0700 foo foo/tmp foo/new foo/cur}.) A +relative path is interpreted as relative to the @code{directory} path. +@code{create-directory} and @code{directory} must be different; +otherwise, group creation and deletion will break. (If you don't need +those features, you can omit @code{create-directory} entirely.) + +@item directory-files +This should be a function with the same interface as +@code{directory-files} (such as @code{directory-files} itself). It is +used to scan the server's @code{directory} for maildirs. This +parameter is optional; the default is +@code{nnheader-directory-files-safe} if +@code{nnheader-directory-files-is-safe} is @code{nil}, and +@code{directory-files} otherwise. +(@code{nnheader-directory-files-is-safe} is checked only once when the +server is opened; if you want to check it each time the directory is +scanned, you'll have to provide your own function that does that.) + +@item get-new-mail +If non-@code{nil}, then after scanning for new mail in the group +maildirs themselves as usual, this server will also incorporate mail +the conventional Gnus way, from @code{mail-sources} according to +@code{nnmail-split-methods} or @code{nnmail-split-fancy}. The default +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. +@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 backends: 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 backend. + +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 +original value. If the value is not a vector, the value itself is +evaluated as a Lisp form. (This is why these parameters use names +different from those of other, similar parameters supported by other +backends: they have different, though similar, meanings.) (For +numbers, strings, @code{nil}, and @code{t}, you can ignore the +@code{eval} business again; for other values, remember to use an extra +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 +articles should never be expired. If this parameter is not set, +nnmaildir falls back to the usual +@code{nnmail-expiry-wait}(@code{-function}) variables (overridable 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 +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. + +@item expire-group +If this is set to a string (a full Gnus group name, like +@code{"backend+server.address.string:group.name"}), 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 destination +group. + +@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. + +@item directory-files +A function with the same interface as @code{directory-files}. It is +used to scan the directories in the maildir corresponding to this +group to find articles. The default is the function specified by the +server's @code{directory-files} parameter. + +@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. + +@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 +@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 NOV memory cache. To speed +things up, nnmaildir keeps 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 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 +@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 +@file{.nnmaildir/} subdirectory of the maildir to store information +about the corresponding article. The full pathname of an article is +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 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 NOV data is updated automatically when the +article or @code{nnmail-extra-headers} has changed.) You can force +nnmaildir to regenerate the NOV data for a single article simply by +deleting the corresponding 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. + +@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.) + +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. + + @node Mail Folders @subsubsection Mail Folders @cindex nnfolder @@ -14487,7 +14785,7 @@ The name of the active file. The default is @file{~/Mail/active}. @item nnfolder-newsgroups-file @vindex nnfolder-newsgroups-file The name of the group descriptions file. @xref{Newsgroups File -Format}. The default is @file{~/Mail/newsgroups"} +Format}. The default is @file{~/Mail/newsgroups} @item nnfolder-get-new-mail @vindex nnfolder-get-new-mail @@ -14659,7 +14957,7 @@ slowness of access parsing when learning what's new in one's groups. Basically the effect of @code{nnfolder} is @code{nnmbox} (the first method described above) on a per-group basis. That is, @code{nnmbox} -itself puts *all* one's mail in one file; @code{nnfolder} provides a +itself puts @emph{all} one's mail in one file; @code{nnfolder} provides a little bit of optimization to this so that each of one's mail groups has a Unix mail box file. It's faster than @code{nnmbox} because each group can be parsed separately, and still provides the simple Unix mail box @@ -14961,7 +15259,7 @@ The password to use when posting. @item nnslashdot-directory @vindex nnslashdot-directory Where @code{nnslashdot} will store its files. The default is -@samp{~/News/slashdot/}. +@file{~/News/slashdot/}. @item nnslashdot-active-url @vindex nnslashdot-active-url @@ -15018,7 +15316,7 @@ The following @code{nnultimate} variables can be altered: @item nnultimate-directory @vindex nnultimate-directory The directory where @code{nnultimate} stores its files. The default is -@samp{~/News/ultimate/}. +@file{~/News/ultimate/}. @end table @@ -15048,7 +15346,7 @@ The following @code{nnwarchive} variables can be altered: @item nnwarchive-directory @vindex nnwarchive-directory The directory where @code{nnwarchive} stores its files. The default is -@samp{~/News/warchive/}. +@file{~/News/warchive/}. @item nnwarchive-login @vindex nnwarchive-login @@ -15079,7 +15377,7 @@ The following @code{nnrss} variables can be altered: @item nnrss-directory @vindex nnrss-directory The directory where @code{nnrss} stores its files. The default is -@samp{~/News/rss/}. +@file{~/News/rss/}. @end table @@ -15156,7 +15454,7 @@ follow the link. @cindex nnimap @cindex @sc{imap} -@sc{imap} is a network protocol for reading mail (or news, or ...), +@sc{imap} is a network protocol for reading mail (or news, or @dots{}), think of it as a modernized @sc{nntp}. Connecting to a @sc{imap} server is much similar to connecting to a news server, you just specify the network address of the server. @@ -15177,7 +15475,7 @@ entry in @code{gnus-secondary-select-methods}. With this, Gnus will manipulate mails stored on the @sc{imap} server. This is the kind of usage explained in this section. -A server configuration in @code{~/.gnus} with a few @sc{imap} servers +A server configuration in @file{~/.gnus} with a few @sc{imap} servers might look something like the following. (Note that for SSL/TLS, you need external programs and libraries, see below.) @@ -15281,8 +15579,7 @@ SSL). Requires the external library @samp{starttls.el} and program @samp{starttls}. @item @dfn{ssl:} Connect through SSL. Requires OpenSSL (the program -@samp{openssl}) or SSLeay (@samp{s_client}) as well as the external -library @samp{ssl.el}. +@samp{openssl}) or SSLeay (@samp{s_client}). @item @dfn{shell:} Use a shell command to start @sc{imap} connection. @item @@ -15307,8 +15604,7 @@ 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 -to OpenSSL/SSLeay. You also need @samp{ssl.el} (from the W3 -distribution, for instance). +to OpenSSL/SSLeay. @vindex imap-shell-program @vindex imap-shell-host @@ -15371,7 +15667,7 @@ The possible options are: @table @code @item always -The default behavior, delete all articles marked as "Deleted" when +The default behavior, delete all articles marked as ``Deleted'' when closing a mailbox. @item never Never actually delete articles. Currently there is no way of showing @@ -15435,7 +15731,7 @@ variable @code{nntp-authinfo-file} for exact syntax; also see * Splitting in IMAP:: Splitting mail with nnimap. * Expiring in IMAP:: Expiring mail with nnimap. * Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. -* Expunging mailboxes:: Equivalent of a "compress mailbox" button. +* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. * A note on namespaces:: How to (not) use IMAP namespace in Gnus. @end menu @@ -15531,8 +15827,8 @@ unread articles in your inbox, since the splitting code would go over them every time you fetch new mail.) These rules are processed from the beginning of the alist toward the -end. The first rule to make a match will "win", unless you have -crossposting enabled. In that case, all matching rules will "win". +end. The first rule to make a match will ``win'', unless you have +crossposting enabled. In that case, all matching rules will ``win''. This variable can also have a function as its value, the function will be called with the headers narrowed and should return a group where it @@ -15635,7 +15931,7 @@ messages. Most do, fortunately. @item nnmail-expiry-wait-function These variables are fully supported. The expire value can be a -number, the symbol @var{immediate} or @var{never}. +number, the symbol @code{immediate} or @code{never}. @item nnmail-expiry-target @@ -15667,12 +15963,12 @@ Some possible uses: @itemize @bullet @item -Giving "anyone" the "lrs" rights (lookup, read, keep seen/unseen flags) +Giving ``anyone'' the ``lrs'' rights (lookup, read, keep seen/unseen flags) on your mailing list mailboxes enables other users on the same server to follow the list without subscribing to it. @item At least with the Cyrus server, you are required to give the user -"anyone" posting ("p") capabilities to have "plussing" work (that is, +``anyone'' posting ("p") capabilities to have ``plussing'' work (that is, mail sent to user+mailbox@@domain ending up in the @sc{imap} mailbox INBOX.mailbox). @end itemize @@ -15725,7 +16021,7 @@ Specifically, University of Washington's IMAP server uses mailbox names like @code{#driver.mbx/read-mail} which are valid only in the @sc{create} and @sc{append} commands. After the mailbox is created (or a messages is appended to a mailbox), it must be accessed without -the namespace prefix, i.e @code{read-mail}. Since Gnus do not make it +the namespace prefix, i.e. @code{read-mail}. Since Gnus do not make it possible for the user to guarantee that user entered mailbox names will only be used with the CREATE and APPEND commands, you should simply not use the namespace prefixed mailbox names in Gnus. @@ -16078,15 +16374,17 @@ the head from the body may contain a single space; and that the body is run through @code{nndoc-unquote-dashes} before being delivered. To hook your own document definition into @code{nndoc}, use the -@code{nndoc-add-type} function. It takes two parameters---the first is -the definition itself and the second (optional) parameter says where in -the document type definition alist to put this definition. The alist is -traversed sequentially, and @code{nndoc-TYPE-type-p} is called for a given type @code{TYPE}. So @code{nndoc-mmdf-type-p} is called to see whether a document -is of @code{mmdf} type, and so on. These type predicates should return -@code{nil} if the document is not of the correct type; @code{t} if it is -of the correct type; and a number if the document might be of the -correct type. A high number means high probability; a low number means -low probability with @samp{0} being the lowest valid number. +@code{nndoc-add-type} function. It takes two parameters---the first +is the definition itself and the second (optional) parameter says +where in the document type definition alist to put this definition. +The alist is traversed sequentially, and @code{nndoc-TYPE-type-p} is +called for a given type @code{TYPE}. So @code{nndoc-mmdf-type-p} is +called to see whether a document is of @code{mmdf} type, and so on. +These type predicates should return @code{nil} if the document is not +of the correct type; @code{t} if it is of the correct type; and a +number if the document might be of the correct type. A high number +means high probability; a low number means low probability with +@samp{0} being the lowest valid number. @node SOUP @@ -16301,7 +16599,7 @@ The default is @file{~/SOUP/}. @item nnsoup-replies-directory @vindex nnsoup-replies-directory All replies will be stored in this directory before being packed into a -reply packet. The default is @file{~/SOUP/replies/"}. +reply packet. The default is @file{~/SOUP/replies/}. @item nnsoup-replies-format-type @vindex nnsoup-replies-format-type @@ -16715,7 +17013,7 @@ all @code{nntp} and @code{nnimap} groups in @code{gnus-select-method} and Decide on download policy. @xref{Agent Categories}. @item -Uhm... that's it. +Uhm@dots{} that's it. @end itemize @@ -16878,7 +17176,7 @@ misconfigured systems/mailers out there and so an article's date is not always a reliable indication of when it was posted. Hell, some people just don't give a damn. -The above predicates apply to *all* the groups which belong to the +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 @@ -16954,8 +17252,8 @@ Again, note the omission of the outermost parenthesis here. @item Agent score file -These score files must *only* contain the permitted scoring keywords -stated above. +These score files must @emph{only} contain the permitted scoring +keywords stated above. example: @@ -16994,7 +17292,7 @@ your desired @code{downloading} criteria for a group are the same as your These directives in either the category definition or a group's parameters will cause the agent to read in all the applicable score -files for a group, *filtering out* those sections that do not +files for a group, @emph{filtering out} those sections that do not relate to one of the permitted subset of scoring keywords. @itemize @bullet @@ -17392,12 +17690,12 @@ Creating/deleting nnimap groups when unplugged. @end itemize -Technical note: the synchronization algorithm does not work by "pushing" +Technical note: the synchronization algorithm does not work by ``pushing'' all local flags to the server, but rather incrementally update the server view of flags by changing only those flags that were changed by the user. Thus, if you set one flag on a article, quit the group and re-select the group and remove the flag; the flag will be set and -removed from the server when you "synchronize". The queued flag +removed from the server when you ``synchronize''. The queued flag operations can be found in the per-server @code{flags} file in the Agent directory. It's emptied when you synchronize flags. @@ -17575,7 +17873,7 @@ may ask: @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 `nil'. +@strong{No}, unless @code{gnus-agent-cache} is @code{nil}. @end table @@ -17770,7 +18068,7 @@ Score on the number of lines. Score on the @code{Message-ID} header. @item e -Score on an "extra" header, that is, one of those in gnus-extra-headers, +Score on an ``extra'' header, that is, one of those in gnus-extra-headers, if your @sc{nntp} server tracks additional header data in overviews. @item f @@ -17941,14 +18239,15 @@ This is @file{~/News/} by default. @item gnus-score-file-suffix @vindex gnus-score-file-suffix Suffix to add to the group name to arrive at the score file name -(@samp{SCORE} by default.) +(@file{SCORE} by default.) @item gnus-score-uncacheable-files @vindex gnus-score-uncacheable-files @cindex score cache All score files are normally cached to avoid excessive re-loading of score files. However, if this might make your Emacs grow big and -bloated, so this regexp can be used to weed out score files unlikely to be needed again. It would be a bad idea to deny caching of +bloated, so this regexp can be used to weed out score files unlikely +to be needed again. It would be a bad idea to deny caching of @file{all.SCORE}, while it might be a good idea to not cache @file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this variable is @samp{ADAPT$} by default, so no adaptive score files will @@ -18354,11 +18653,12 @@ file for a number of groups. @item local @cindex local variables -The value of this entry should be a list of @code{(VAR VALUE)} pairs. -Each @var{var} will be made buffer-local to the current summary buffer, -and set to the value specified. This is a convenient, if somewhat -strange, way of setting variables in some groups if you don't like hooks -much. Note that the @var{value} won't be evaluated. +The value of this entry should be a list of @code{(@var{var} +@var{value})} pairs. Each @var{var} will be made buffer-local to the +current summary buffer, and set to the value specified. This is a +convenient, if somewhat strange, way of setting variables in some +groups if you don't like hooks much. Note that the @var{value} won't +be evaluated. @end table @@ -18492,7 +18792,7 @@ let you use different rules in different groups. @vindex gnus-adaptive-file-suffix The adaptive score entries will be put into a file where the name is the group name with @code{gnus-adaptive-file-suffix} appended. The default -is @samp{ADAPT}. +is @file{ADAPT}. @vindex gnus-score-exact-adapt-limit When doing adaptive scoring, substring or fuzzy matching would probably @@ -18885,7 +19185,7 @@ should probably have a long expiry period, though, as some sites keep old articles for a long time. @end itemize -... I wonder whether other newsreaders will support global score files +@dots{} I wonder whether other newsreaders will support global score files in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue Wave, xrn and 1stReader are bound to implement scoring. Should we start holding our breath yet? @@ -19079,8 +19379,8 @@ you, based on how the people you usually agree with have already rated. In GroupLens, an article is rated on a scale from 1 to 5, inclusive. Where 1 means something like this article is a waste of bandwidth and 5 means that the article was really good. The basic question to ask -yourself is, "on a scale from 1 to 5 would I like to see more articles -like this one?" +yourself is, ``on a scale from 1 to 5 would I like to see more articles +like this one?'' There are four ways to enter a rating for an article in GroupLens. @@ -19524,7 +19824,7 @@ Many commands do not use the process/prefix convention. All commands that do explicitly say so in this manual. To apply the process/prefix convention to commands that do not use it, you can use the @kbd{M-&} command. For instance, to mark all the articles in the group as -expirable, you could say `M P b M-& E'. +expirable, you could say @kbd{M P b M-& E}. @node Interactive @@ -20916,7 +21216,7 @@ external programs from the @code{pbmplus} package and friends.@footnote{On a GNU/Linux system look for packages with names like @code{netpbm}, @code{libgr-progs} and @code{compface}.}) -(NOTE: @code{x-face} is used in the variable/function names, not +(Note: @code{x-face} is used in the variable/function names, not @code{xface}). Gnus provides a few convenience functions and variables to allow @@ -21350,11 +21650,12 @@ done. Suggested useful values include 17 to 29. @item hashcash-payment-alist @vindex hashcash-payment-alist Some receivers may require you to spend burn more CPU time than the -default. This variable contains a list of @samp{(ADDR AMOUNT)} cells, -where ADDR is the receiver (email address or newsgroup) and AMOUNT is -the number of bits in the collision that is needed. It can also -contain @samp{(ADDR STRING AMOUNT)} cells, where the STRING is the -string to use (normally the email address or newsgroup name is used). +default. This variable contains a list of @samp{(@var{addr} +@var{amount})} cells, where @var{addr} is the receiver (email address +or newsgroup) and @var{amount} is the number of bits in the collision +that is needed. It can also contain @samp{(@var{addr} @var{string} +@var{amount})} cells, where the @var{string} is the string to use +(normally the email address or newsgroup name is used). @item hashcash @vindex hashcash @@ -21442,7 +21743,7 @@ In spam groups, all messages are considered to be spam by default: they get the @samp{$} mark when you enter the group. You must review these messages from time to time and remove the @samp{$} mark 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 +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. @@ -21918,10 +22219,10 @@ incoming mail, provide the following: @item code -@example +@lisp (defvar spam-use-blackbox nil "True if blackbox should be used.") -@end example +@end lisp Add @example @@ -21935,6 +22236,11 @@ functionality Write the @code{spam-check-blackbox} function. It should return @samp{nil} or @code{spam-split-group}. See the existing @code{spam-check-*} functions for examples of what you can do. + +Make sure to add @code{spam-use-blackbox} to +@code{spam-list-of-statistical-checks} if Blackbox is a statistical +mail analyzer that needs the full message body to operate. + @end enumerate For processing spam and ham messages, provide the following: @@ -21947,7 +22253,7 @@ code Note you don't have to provide a spam or a ham processor. Only provide them if Blackbox supports spam or ham processing. -@example +@lisp (defvar gnus-group-spam-exit-processor-blackbox "blackbox" "The Blackbox summary exit spam processor. Only applicable to spam groups.") @@ -21956,12 +22262,12 @@ Only applicable to spam groups.") "The whitelist summary exit ham processor. Only applicable to non-spam (unclassified and ham) groups.") -@end example +@end lisp @item functionality -@example +@lisp (defun spam-blackbox-register-spam-routine () (spam-generic-register-routine ;; the spam function @@ -21981,7 +22287,7 @@ functionality (let ((from (spam-fetch-field-from-fast article))) (when (stringp from) (blackbox-do-something-with-this-ham-sender from)))))) -@end example +@end lisp Write the @code{blackbox-do-something-with-this-ham-sender} and @code{blackbox-do-something-with-this-spammer} functions. You can add @@ -22110,10 +22416,10 @@ The filename used to store the dictionary. This defaults to In order to use @code{spam-stat} to split your mail, you need to add the following to your @file{~/.gnus} file: -@example +@lisp (require 'spam-stat) (spam-stat-load) -@end example +@end lisp This will load the necessary Gnus code, and the dictionary you created. @@ -22128,11 +22434,11 @@ In the simplest case, you only have two groups, @samp{mail.misc} and spam or it should go into @samp{mail.misc}. If it is spam, then @code{spam-stat-split-fancy} will return @samp{mail.spam}. -@example +@lisp (setq nnmail-split-fancy `(| (: spam-stat-split-fancy) "mail.misc")) -@end example +@end lisp @defvar spam-stat-split-fancy-spam-group The group to use for spam. Default is @samp{mail.spam}. @@ -22142,12 +22448,12 @@ If you also filter mail with specific subjects into other groups, use the following expression. Only mails not matching the regular expression are considered potential spam. -@example +@lisp (setq nnmail-split-fancy `(| ("Subject" "\\bspam-stat\\b" "mail.emacs") (: spam-stat-split-fancy) "mail.misc")) -@end example +@end lisp If you want to filter for spam first, then you must be careful when creating the dictionary. Note that @code{spam-stat-split-fancy} must @@ -22155,12 +22461,12 @@ consider both mails in @samp{mail.emacs} and in @samp{mail.misc} as non-spam, therefore both should be in your collection of non-spam mails, when creating the dictionary! -@example +@lisp (setq nnmail-split-fancy `(| (: spam-stat-split-fancy) ("Subject" "\\bspam-stat\\b" "mail.emacs") "mail.misc")) -@end example +@end lisp You can combine this with traditional filtering. Here, we move all HTML-only mails into the @samp{mail.spam.filtered} group. Note that since @@ -22169,13 +22475,13 @@ HTML-only mails into the @samp{mail.spam.filtered} group. Note that since nor in your collection of non-spam mails, when creating the dictionary! -@example +@lisp (setq nnmail-split-fancy `(| ("Content-Type" "text/html" "mail.spam.filtered") (: spam-stat-split-fancy) ("Subject" "\\bspam-stat\\b" "mail.emacs") "mail.misc")) -@end example +@end lisp @node Low-level interface to the spam-stat dictionary @@ -22231,10 +22537,10 @@ spam-stat-split-fancy)} to @code{nnmail-split-fancy} Make sure you load the dictionary before using it. This requires the following in your @file{~/.gnus} file: -@example +@lisp (require 'spam-stat) (spam-stat-load) -@end example +@end lisp Typical test will involve calls to the following functions: @@ -22785,7 +23091,7 @@ off> no, wait, that absolutely does not work'' policy for releases. Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that ``worser''? ``much worser''? ``worsest''?) -I would like to take this opportunity to thank the Academy for... oops, +I would like to take this opportunity to thank the Academy for@dots{} oops, wrong show. @itemize @bullet @@ -23664,12 +23970,12 @@ re-highlighting of the article buffer. New element in @code{gnus-boring-article-headers}---@code{long-to}. @item - @kbd{M-i} symbolic prefix command. See the section "Symbolic -Prefixes" in the Gnus manual for details. + @kbd{M-i} symbolic prefix command. See the section ``Symbolic +Prefixes'' in the Gnus manual for details. @item @kbd{L} and @kbd{I} in the summary buffer now take the symbolic prefix -@kbd{a} to add the score rule to the "all.SCORE" file. +@kbd{a} to add the score rule to the @file{all.SCORE} file. @item @code{gnus-simplify-subject-functions} variable to allow greater @@ -23739,7 +24045,7 @@ been added. @code{gnus-adaptive-word-minimum} variable. @item - The "lapsed date" article header can be kept continually + The ``lapsed date'' article header can be kept continually updated by the @code{gnus-start-date-timer} command. @item @@ -24335,14 +24641,14 @@ evaluate expressions using @kbd{M-:} or inspect variables using @cindex slow Sometimes, a problem do not directly generate a elisp error but manifests itself by causing Gnus to be very slow. In these cases, you -can use @kbd{M-x toggle-debug-on-quit} and press C-j when things are +can use @kbd{M-x toggle-debug-on-quit} and press @kbd{C-j} when things are slow, and then try to analyze the backtrace (repeating the procedure helps isolating the real problem areas). A fancier approach is to use the elisp profiler, ELP. The profiler is (or should be) fully documented elsewhere, but to get you started there are a few steps that need to be followed. First, instrument the part of Gnus you are interested in for profiling, e.g. @kbd{M-x elp-instrument-package RET -gnus} or @kbd{M-x elp-instrument-packagre RET message}. Then perform +gnus} or @kbd{M-x elp-instrument-package RET message}. Then perform the operation that is slow and press @kbd{M-x elp-results}. You will then see which operations that takes time, and can debug them further. If the entire operation takes much longer than the time spent in the @@ -24357,8 +24663,8 @@ If you just need help, you are better off asking on @cindex gnu.emacs.gnus @cindex ding mailing list -You can also ask on the ding mailing list---@samp{ding@@gnus.org}. -Write to @samp{ding-request@@gnus.org} to subscribe. +You can also ask on the ding mailing list---@email{ding@@gnus.org}. +Write to @email{ding-request@@gnus.org} to subscribe. @page @@ -24617,8 +24923,8 @@ value should either be @code{headers} or @code{nov} to reflect this. This might later be expanded to @code{various}, which will be a mixture of HEADs and @sc{nov} lines, but this is currently not supported by Gnus. -If @var{fetch-old} is non-@code{nil} it says to try fetching "extra -headers", in some meaning of the word. This is generally done by +If @var{fetch-old} is non-@code{nil} it says to try fetching ``extra +headers'', in some meaning of the word. This is generally done by fetching (at most) @var{fetch-old} extra headers less than the smallest article number in @code{articles}, and filling the gaps as well. The presence of this parameter can be ignored if the back end finds it @@ -24656,13 +24962,16 @@ valid-message = "221 " " Article retrieved." eol header = eol @end example +@cindex BNF +(The version of BNF used here is the one used in RFC822.) + If the return value is @code{nov}, the data buffer should contain @dfn{network overview database} lines. These are basically fields separated by tabs. @example nov-buffer = *nov-line -nov-line = 8*9 [ field ] eol +nov-line = field 7*8[ field ] eol field = @end example @@ -25000,8 +25309,7 @@ able to delete. There should be no result data returned. -@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM -&optional LAST) +@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST) This function should move @var{article} (which is a number) from @var{group} by calling @var{accept-form}. @@ -25151,9 +25459,9 @@ of @code{nndir}. (The same with @code{nnmh}.) This macro defines some common functions that almost all back ends should have. -@example +@lisp (nnoo-define-basics nndir) -@end example +@end lisp @item deffoo This macro is just like @code{defun} and takes the same parameters. In @@ -25164,11 +25472,11 @@ function as being public so that other back ends can inherit it. This macro allows mapping of functions from the current back end to functions from the parent back ends. -@example +@lisp (nnoo-map-functions nndir (nnml-retrieve-headers 0 nndir-current-group 0 0) (nnmh-request-article 0 nndir-current-group 0 0)) -@end example +@end lisp This means that when @code{nndir-retrieve-headers} is called, the first, third, and fourth parameters will be passed on to @@ -25180,13 +25488,13 @@ This macro allows importing functions from back ends. It should be the last thing in the source file, since it will only define functions that haven't already been defined. -@example +@lisp (nnoo-import nndir (nnmh nnmh-request-list nnmh-request-newgroups) (nnml)) -@end example +@end lisp This means that calls to @code{nndir-request-list} should just be passed on to @code{nnmh-request-list}, while all public functions from diff --git a/texi/gnusref.tex b/texi/gnusref.tex index abb47eb..208c8e4 100644 --- a/texi/gnusref.tex +++ b/texi/gnusref.tex @@ -586,9 +586,8 @@ W d & Treat {\bf dumbquotes}.\\ W e & Treat {\bf emphasized} text.\\ W h & Treat {\bf HTML}.\\ - W k & Deuglify broken Outlook (Express) articles and redisplay.\\ W l & (w) Remove page breaks ({\bf\^{}L}) from the article.\\ - W m & Toggle {\bf MIME} processing.\\ + W m & {\bf Morse} decode article.\\ W o & Treat {\bf overstrike} or underline (\^{}H\_) in the article.\\ W p & Verify X-{\bf PGP}-Sig header.\\ W q & Treat {\bf quoted}-printable in the article.\\ @@ -606,6 +605,11 @@ W G u & {\bf Unfold} folded header lines.\\ W G f & {\bf Fold} all header lines.\\ W G n & Unfold {\bf Newsgroups:} and Follow-Up-To:.\\ + % + W Y c & Repair broken {\bf citations}.\\ + W Y a & Repair broken {\bf attribution} lines.\\ + W Y u & {\bf Unwrap} broken citation lines.\\ + W Y f & Do a {\bf full} deuglification (W Y c, W Y a, W Y u).\\ \end{keys} } } @@ -632,6 +636,7 @@ \begin{keys}{W D D} W D s & (W g) Display {\bf smilies}.\\ W D x & (W f) Look for and display any X-{\bf Face} headers.\\ + W D d & Display any Face headers.\\ W D n & Toggle picons in {\bf Newsgroups} and Followup-To.\\ W D m & Toggle picons in {\bf mail} headers (To and Cc).\\ W D f & Toggle picons in {\bf From}.\\ @@ -668,9 +673,6 @@ W W c & Hide {\bf citation}.\\ W W C-c & Hide {\bf citation} using a more intelligent algorithm.\\ W W C & Hide cited text in articles that aren't roots.\\ - % - W e & {\bf Emphasize} article.\\ - % W H a & Highlight {\bf all} parts. Calls W b, W H c, W H h, W H s.\\ W H c & Highlight article {\bf citations}.\\ W H h & Highlight article {\bf headers}.\\ @@ -682,9 +684,9 @@ \newcommand{\MIMEArticleMode}{% {\esamepage - \begin{keys}{M-RET} + \begin{keys}{RET} RET & (BUTTON-2) Toggle display of the MIME object.\\ - v & (M-RET) Prompt for a method and then view object using this method.\\ + v & Prompt for a method and then view object using this method.\\ o & Prompt for a filename and save the MIME object.\\ C-o & Prompt for a filename to save the MIME object to and remove it.\\ c & {\bf Copy} the MIME object to a new buffer and display this buffer.\\ diff --git a/texi/message.texi b/texi/message.texi index c8ca154..cf06576 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -686,7 +686,7 @@ headers if necessary. @findex message-change-subject @cindex Subject Change the current @samp{Subject} header. Ask for new @samp{Subject} -header and append @code{(was: )}. The old subject can be +header and append @samp{(was: )}. The old subject can be stripped on replying, see @code{message-subject-trailing-was-query} (@pxref{Message Headers}). @@ -906,10 +906,10 @@ message a single part tag will be used. This way, message mode will do the Right Thing (TM) with signed/encrypted multipart messages. @vindex mml-signencrypt-style-alist -By default, when encrypting a message, Gnus will use the "signencrypt" +By default, when encrypting a message, Gnus will use the ``signencrypt'' mode. If you would like to disable this for a particular message, -give the mml-secure-message-encrypt-* command a prefix argument. (for -example, C-u C-c C-m c p). Additionally, by default Gnus will +give the @code{mml-secure-message-encrypt-*} command a prefix argument. (for +example, @kbd{C-u C-c C-m c p}). Additionally, by default Gnus will separately sign, then encrypt a message which has the mode signencrypt. If you would like to change this behavior you can customize the @code{mml-signencrypt-style-alist} variable. For @@ -1404,6 +1404,13 @@ might set this variable to @code{'("-f" "you@@some.where")}. Non-@code{nil} means don't add @samp{-f username} to the sendmail command line. Doing so would be even more evil than leaving it out. +@item message-sendmail-envelope-from +@vindex message-sendmail-envelope-from +When @code{message-sendmail-f-is-evil} is @code{nil}, this specifies +the address to use in the SMTP envelope. If it is @code{nil}, use +@code{user-mail-address}. If it is the symbol @code{header}, use the +@samp{From} header of the message. + @item message-mailer-swallows-blank-line @vindex message-mailer-swallows-blank-line Set this to non-@code{nil} if the system's mailer runs the header and @@ -1466,14 +1473,18 @@ This optional header will be computed by Message. @item Message-ID @cindex Message-ID +@vindex message-user-fqdn @vindex mail-host-address +@vindex user-mail-address @findex system-name @cindex Sun +@cindex i-did-not-set--mail-host-address--so-tickle-me This required header will be generated by Message. A unique ID will be -created based on the date, time, user name and system name. Message -will use @code{system-name} to determine the name of the system. If -this isn't a fully qualified domain name (FQDN), Message will use -@code{mail-host-address} as the FQDN of the machine. +created based on the date, time, user name and system name. For the +domain part, message will look (in this order) at +@code{message-user-fqdn}, @code{system-name}, @code{mail-host-address} +and @code{message-user-mail-address} (i.e. @code{user-mail-address}) +until a probably valid fully qualified domain name (FQDN) was found. @item User-Agent @cindex User-Agent diff --git a/texi/pgg.texi b/texi/pgg.texi index 69b18b9..fc15392 100644 --- a/texi/pgg.texi +++ b/texi/pgg.texi @@ -1,6 +1,6 @@ \input texinfo @c -*-texinfo-*- -@setfilename pgg.info +@setfilename pgg @set VERSION 0.1