+2003-02-19 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * GNUS-NEWS: Renamed `gnus-unsightly-citation-regexp' to
+ `gnus-cite-unsightly-citation-regexp'.
+
+2003-02-18 Simon Josefsson <jas@extundo.com>
+
+ * GNUS-NEWS: Talk about canlock more.
+
+2003-02-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * GNUS-NEWS: Add user visible changes from Michael Shields from
+ the past couple of days. Actual text from Michael.
+
2003-01-24 Jesper Harder <harder@ifa.au.dk>
* etc/gnus-tut.txt: Update.
\f
* 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.
** 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.
+2003-03-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * hashcash.el (hashcash-version, hashcash-insert-payment): patch
+ from Paul Foley
+
+2003-03-07 Simon Josefsson <jas@extundo.com>
+
+ * gnus-idna.el (gnus-idna-to-ascii-rhs-1): Narrow to
+ head (otherwise forwarded mail break havoc).
+
+2003-03-07 Teodor Zlatanov <tzz@bwh.harvard.edu>
+
+ * 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 <jas@extundo.com>
+
+ * 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 <larsi@gnus.org>
* hashcash.el: New version from Paul Foley with new
--- /dev/null
+;;; 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
;;; 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 <mycroft@actrix.gen.nz>
;; Keywords: mail, hashcash
;; Released under the GNU General Public License
+;; (http://www.gnu.org/licenses/gpl.html)
;;; Commentary:
;;; 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.
"*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"
(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))
(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"
(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)
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
+2003-03-18 00:38:22 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
+
+ * gnus.el: Oort Gnus v0.16 is released.
+
+2003-03-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * lpath.el (featurep): Bind mm-w3m-mode-map.
+
+2003-03-12 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmail.el (nnmail-cache-primary-mail-backend): Not all
+ 'respool-able backends define a global nnchoke-get-new-mail
+ variable.
+
+2003-03-17 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-mime-delete-part): New function.
+ (gnus-mime-action-alist, gnus-mime-button-commands): Use it.
+
+2003-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-check-news-header-syntax): Don't push
+ groups twice onto list of unknown groups.
+
+ * nndoc.el (nndoc-type-alist): Move exim-bounce a bit further
+ back.
+
+ * nnheader.el (nnheader-find-etc-directory): Doc fix.
+
+ * gnus-msg.el (gnus-inews-add-send-actions): Don't restore window
+ config unless the summary buffer exists.
+
+ * gnus-sum.el (gnus-summary-next-group): Semi-exit group first to
+ that target group is computed correctly when articles are marked
+ as read by Xref handling.
+
+ * mail-source.el (mail-source-fetch-imap): Pass buffer-name to
+ imap-open.
+
+ * message.el (message-send-mail): Add courtesy string to Bcc's,
+ too.
+
+ * gnus-cite.el (gnus-cited-line-p): New function.
+
+2003-03-15 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-decode-body): Add new optional parameter,
+ force, to use the supplied charset unconditionally.
+
+ * gnus-art.el (article-decode-charset): Use it.
+
+2003-03-14 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-bodies.el (mm-decode-coding-region-safely): New function.
+ (mm-decode-body): Use it.
+
+ * rfc2047.el (rfc2047-decode-region): do.
+ (rfc2047-decode-string): Guess coding system if the default is
+ invalid.
+
+2003-03-12 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir-request-update-info): Pretend missing
+ articles are marked 'read, so we get correct article counts.
+
+2003-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-insert-mime-button): Exclude a newline from
+ the button.
+ (gnus-insert-prev-page-button): Ditto.
+ (gnus-insert-next-page-button): Ditto.
+ (gnus-insert-mime-security-button): Ditto.
+
+ * mm-view.el (mm-inline-image-emacs): Open the bottom of an image
+ one line. Suggested by Greg Klanderman <gak@klanderman.net>.
+ (mm-inline-image-xemacs): Ditto.
+
+2003-03-12 Paul Jarc <prj@po.cwru.edu>
+
+ * nnmaildir.el (nnmaildir--parse-filename, nnmaildir--sort-files,
+ nnmaildir--scan, nnmaildir-request-accept-article): Changes for
+ the recent filename uniqueness discussion.
+
+2003-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-inline-image-emacs): Make it delete an excessive
+ newline next time.
+ (mm-inline-image-xemacs): Ditto.
+
+2003-03-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use
+ kill-line.
+
+2003-03-09 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use
+ kill-line.
+
+2003-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just
+ fixing the code to match the documentation.
+ (gnus-agent-fetch-selected-article): Replaced
+ gnus-summary-update-article-line with gnus-summary-update-line as
+ the former did not correctly recalculate the thread indentation.
+ (gnus-agent-find-parameter): The agent-predicate, if not found
+ anywhere else, defaults to the value of gnus-agent-predicate.
+ (gnus-agent-fetch-session): Fixed typo; now executes
+ gnus-agent-fetched-hook rather than the undocumented
+ gnus-agent-fetch-hook.
+ (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The
+ default agent predicate is now provided by
+ gnus-agent-find-parameter.
+ (gnus-agent-message): New macro. This macro avoids potentially
+ costly parameter evaluation when the message's level is too high
+ to display.
+ (gnus-agent-expire-group-1): Disabled undo tracking in temp
+ overview buffer. Uses new gnus-agent-message macro to reduce
+ overhead of optional messages. Reversed message levels to
+ emphasize percent completion messages. Detailed messages of
+ little use except when debugging code.
+
+2003-03-08 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine): use
+ spam-mark-ham-unread-before-move-from-spam-group
+ (spam-mark-ham-unread-before-move-from-spam-group): new variable
+
+2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: load nnimap.el when compiling
+ (spam-setup-widening): use
+ nnimap-split-download-body-default instead of
+ nnimap-split-download-body which is a user-customizable variable
+
+2003-03-07 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-split-download-body-default): New, holds
+ default for n-s-d-b.
+ (nnimap-split-download-body): Add new setting (symbol default),
+ which uses contents of n-s-d-b-d, and made it the default.
+
+2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-use-hashcash): new variable
+ (spam-list-of-checks): added spam-use-hashcash with associated
+ spam-check-hashcash
+ (spam-check-hashcash): new function, installed iff hashcash.el is
+ loaded
+ (spam-setup-widening): don't use (return)
+
+2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Added default
+ predicate of `false' to avoid an error when a group defines no
+ predicate. Fixed typo that disabled agent scoring (i.e. the
+ low/high predicates should now work).
+
+2003-03-06 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: add spam-maybe-spam-stat-load to
+ gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook
+ (spam-bogofilter-register-with-bogofilter): use
+ spam-bogofilter-spam-switch and spam-bogofilter-ham-switch
+ (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): new
+ custom variables to replace "-s" and "-n"
+
+ * gnus-group.el (gnus-group-get-new-news): call the new
+ gnus-get-top-new-news-hook hook
+
+ * gnus-start.el (gnus-get-top-new-news-hook): new hook, run ONLY
+ by gnus-get-new-news, NOT by gnus-group-get-new-news-this-group
+
+2003-03-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message.
+
+2003-03-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cus.el (gnus-group-customize): Don't use delete-if which is
+ a cl run-time function.
+
+2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding
+ on gnus-agent-short-article.
+ (gnus-category-read): Replaced CL function mapcar* with new macro:
+ gnus-mapcar.
+ * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to
+ support functions that accept multiple parameters. A separate
+ sequence must be provided for each parameter in the function.
+ Iteration stops when the end of the shortest list is reached.
+
+2003-03-06 Jesper Harder <harder@ifa.au.dk>
+
+ * nnimap.el (nnimap-request-accept-article): Use delete-region.
+
+ * html2text.el (html2text-clean-dtdd, html2text-delete-tags)
+ (html2text-delete-single-tag, html2text-clean-anchor)
+ (html2text-remove-tags): Use delete-region.
+ (html2text-fix-paragraphs): Simplify.
+
+ * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt)
+ (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign)
+ (mml1991-pgg-encrypt, mml1991-pgg-encrypt): Use delete-region, not
+ kill-region.
+
+2003-03-04 John Paul Wallington <jpw@gnu.org>
+
+ * gnus-agent.el (gnus-agent-enable-expiration)
+ (gnus-agent-article-alist, gnus-agent-article-alist)
+ (gnus-agent-cat-defaccessor): Doc fixes.
+
+2003-03-04 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-function-implies-unread-1): Grok
+ byte-compiled functions.
+
+2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides
+ customization between new maneuvering (which permits selecting
+ undownloaded articles) and old maneuvering (which skipped over
+ undownloaded articles) behaviors.
+ (gnus-summary-find-next): Pass through the unread and subject
+ parameters when calling gnus-summary-find-prev.
+ (gnus-summary-find-next,gnus-summary-find-prev): Apply
+ gnus-auto-goto-ignores to filter out unacceptable articles.
+
+2003-03-04 Jesper Harder <harder@ifa.au.dk>
+
+ * mail-source.el (mail-source-read-passwd): Remove. `read-passwd'
+ exists in all supported Emacs versions, so we don't need this
+ compatibility function.
+ (mail-source-fetch-pop, mail-source-check-pop)
+ (mail-source-fetch-webmail): Use read-passwd.
+
+ * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo)
+ (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use
+ read-passwd.
+
+ * nnwarchive.el (nnwarchive-open-server): Use read-passwd.
+
+ * imap.el (imap-read-passwd): Remove.
+ (imap-interactive-login): Use read-passwd.
+
+ * canlock.el (canlock-read-passwd): Remove.
+ (canlock-insert-header, canlock-verify): Use read-passwd.
+
+ * sieve-manage.el (sieve-manage-read-passwd): Remove.
+ (sieve-manage-interactive-login): Use read-passwd.
+
+ * pop3.el (pop3-read-passwd): Remove.
+ (pop3-movemail, pop3-get-message-count, pop3-apop): Use
+ read-passwd.
+
+ * pgg.el (pgg-read-passphrase): Simplify.
+
+2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports
+ 'plugged' when actually 'unplugged' bug.
+ (gnus-category-read): Ignore nil values when converting an
+ old-format category so that the new-format category will default
+ those attributes to the global variables.
+
+2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed
+ doc-string.
+
+2003-03-03 Jesper Harder <harder@ifa.au.dk>
+
+ * nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'.
+ * nndoc.el (nndoc-dissect-mime-parts-sub): do.
+ * nndb.el (nndb-request-accept-article, nndb-status-message): do.
+ * mm-url.el (mm-url-decode-entities-string): do.
+ * mml1991.el (mml1991-mailcrypt-sign, mml1991-gpg-sign): do.
+ * mm-decode.el (mm-find-raw-part-by-type): do.
+ * message.el (message-send-mail-partially)
+ (message-send-mail-with-sendmail): do.
+ * gnus-uu.el (gnus-uu-save-article, gnus-uu-reginize-string): do.
+ * gnus-kill.el (gnus-pp-gnus-kill): do.
+ * gnus-art.el (gnus-article-treat-unfold-headers)
+ (gnus-article-encrypt-body): do.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * mail-source.el (mail-source-delete-incoming): Allow integer value.
+ (mail-source-delete-old-incoming-confirm): New variable.
+ (mail-source-delete-old-incoming): Use it. New function.
+ (mail-source-callback): Call `mail-source-delete-old-incoming' if
+ `mail-source-delete-incoming' is a nonnegative integer.
+
+2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config.
+ (gnus-user-agent): Fixed typo.
+
+2003-03-03 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation.
+ (gnus-agent-expire-group-1): Removed invalid (interactive) specifier.
+
+2003-03-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message.
+ (gnus-agent-fetch-session): Allow debugging to take place.
+
+2003-03-03 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-highlight-selected-summary)
+ (gnus-article-get-xrefs, gnus-summary-show-thread): Use
+ `gnus-point-at-bol' and `gnus-point-at-eol' instead of
+ `(progn (beginning-of-line) (point))'. It's shorter, faster,
+ and makes it clear that we don't need the side effect.
+ * gnus-util.el (gnus-delete-line): do.
+ * gnus-xmas.el (gnus-group-add-icon): do.
+ * nnmail.el (nnmail-article-group, nnmail-cache-fetch-group): do.
+ * nntp.el (nntp-send-authinfo-from-file): do.
+ * nnml.el (nnml-header-value): do.
+ * nnheader.el (nnheader-insert-references): do.
+ * gnus-cite.el (gnus-article-highlight-citation)
+ (gnus-cite-parse): do.
+ * gnus-score.el (gnus-score-followup): do.
+ * gnus-draft.el (gnus-draft-send): do.
+ * gnus-group.el (gnus-group-highlight-line): do.
+ * gnus-cache.el (gnus-cache-braid-nov): do.
+ * nnfolder.el (nnfolder-retrieve-headers)
+ (nnfolder-request-article): do.
+ * gnus-art.el (article-hide-boring-headers)
+ (gnus-article-hide-header): do.
+
+ * nnheader.el (nnheader-find-nov-line): Use gnus-delete-line.
+ * nnml.el (nnml-request-replace-article): do.
+ * nnmbox.el (nnmbox-request-move-article, nnmbox-delete-mail): do.
+ * nnfolder.el (nnfolder-request-move-article): do.
+ * gnus-cache.el (gnus-cache-possibly-remove-article): do.
+ * gnus-art.el (gnus-mm-display-part): do.
+
+ * gnus-art.el (gnus-article-goto-part): Use gnus-goto-char.
+
+2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * nntp.el (nntp-possibly-change-group): Avoid calling
+ process-buffer on nil (Which happened when you lost your
+ connection while fetching); instead signal a "Server Closed
+ Connection" error.
+
+2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-enable-expiration): New
+ variable. Either ENABLE or DISABLE. Sets default behavior for
+ selecting which groups are expired.
+ (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor,
+ gnus-agent-set-cat-groups): Provides abstract interface for
+ accessing agent category. Category now implemented by an alist.
+ (gnus-agent-add-group, gnus-agent-remove-group,
+ gnus-category-insert-line, gnus-category-edit-predicate,
+ gnus-category-edit-score, gnus-category-edit-groups,
+ gnus-category-copy, gnus-category-add, gnus-group-category): Use
+ new agent category abstraction.
+ (gnus-agent-find-parameter): New function. Search for agent
+ configuration parameter first in the group's parameters, then its
+ topics (if any), and then the group's category. If not found
+ anywhere, use the original defined constants.
+ (gnus-agent-fetch-headers, gnus-agent-fetch-group-1): Use new
+ gnus-agent-find-parameter.
+ (gnus-agent-fetch-headers, gnus-agent-uncached-articles): Clearing
+ gnus-agent-cache now blocks retrieving headers and articles from
+ the local cache. Fetched content is still added to the cache
+ before being returned.
+ (gnus-agent-fetch-session): Use error-message-string to generate
+ displayed error message.
+ (gnus-agent-customize-category): New Command. 'e' in category
+ buffer opens category customization buffer.
+ (gnus-category-read): Reads either positional or alist format;
+ returns alist format.
+ (gnus-category-write): Writes category file compatible with
+ current, and previous, versions of gnus-agent.
+ (gnus-category-make-function, gnus-category-make-function-1):
+ Corrected documentation; parameter is predicate NOT category.
+ (gnus-predicate-implies-unread): Now works in more cases per the
+ todo comment.
+ (gnus-function-implies-unread-1): New function. Supports
+ gnus-predicate-implies-unread.
+ (gnus-agent-expire-group): Command now provides default of group
+ under point.
+ (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and
+ agent-days-until-old parameters. No longer supports
+ gnus-agent-expire-days being set to an alist.
+ (gnus-agent-request-article): Now performs its own checks of
+ gnus-agent, gnus-agent-cache, and gnus-plugged rather than
+ assuming that the caller will do them correctly.
+ (): Added one-time hook to gnus-group-prepare-hook. Detects when
+ gnus-agent-expire-days is set to an alist. Converts said alist
+ into group parameter so that gnus-agent-expire-days will not be
+ needed.
+ * gnus-art.el (gnus-request-article-this-buffer): Conditional
+ checks surrounding gnus-agent-request-article removed; now
+ performed by gnus-agent-request-article.
+ * gnus-cus.el (gnus-agent-parameters): New variable. List of
+ customizable group/topic parameters that regulate the agent.
+ (gnus-group-customize): Uses gnus-agent-parameters. Replaced
+ kill-buffer with gnus-kill-buffer to remove the killed buffer from
+ the list of gnus buffers.
+ (gnus-trim-whitespace): Removes leading and trailing whitespace
+ from multiline strings.
+ (gnus-agent-cat-prepare-category-field,
+ gnus-agent-customize-category): Constructs a category
+ customization buffer.
+ * gnus-int.el (gnus-retrieve-headers,
+ gnus-request-expire-articles): No longer checks gnus-agent-cache
+ as it is handled internally by the agent.
+ (gnus-request-head, gnus-request-body): Conditional checks
+ surrounding gnus-agent-request-article removed; now performed by
+ gnus-agent-request-article.
+
+ * gnus-start.el (): Added defvar statements to resolve compilation
+ warnings.
+ (gnus-long-file-names): New function. Isolates platform dependent
+ msdos-long-file-names.
+ (gnus-save-startup-file-via-temp-buffer): New variable. Provides
+ option of writing directly to file. Avoids memory exhausted
+ errors when .newsrc.eld is huge.
+ (gnus-save-newsrc-file): Uses new
+ gnus-save-startup-file-via-temp-buffer.
+ (gnus-gnus-to-quick-newsrc-format): Rewritten to write to
+ standard-output.
+ (gnus-display-time-event-handler): Changed to alias from a defun
+ to avoid a compile-time warning when display-time-event-handler is
+ not defined.
+ * gnus-util.el (gnus-with-output-to-file): New macro. Binds
+ standard-output such that prin1 and princ will write directly to a
+ file.
+
+ * gnus.el (gnus-agent-cache): Expanded documentation.
+ (gnus-summary-high-undownloaded-face): Removed second bold keyword
+ so that this face is actually bold.
+
+ * nnkiboze.el (nnkiboze-request-article): Only use the cache when
+ gnus-use-cache has been set.
+
+2003-03-02 Jesper Harder <harder@ifa.au.dk>
+
+ * nnvirtual.el (nnvirtual-update-xref-header): Simplify.
+
+2003-03-01 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-refer-article): Be more permissive.
+
+2003-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * spam.el: Fix typo.
+
+2003-03-01 Satyaki Das <satyaki@theforce.stanford.edu>
+ (Trivial patch.)
+
+ * pgg-gpg.el (pgg-gpg-process-region): Insert process status into
+ errors-buffer. This produces a nicer error message in case of
+ problems.
+
+2003-03-01 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-maybe-spam-stat-load, spam-maybe-spam-stat-load):
+ load stats iff spam-use-stat is on
+
+ * spam.el: add spam-maybe-spam-stat-load to gnus-startup hook,
+ also use spam-maybe-spam-stat-load and spam-maybe-spam-stat-save
+ instead of spam-stat-load and spam-stat-save in the
+ gnus-get-new-news-hook and gnus-save-newsrc-hook, respectively
+
+2003-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-view.el (mm-inline-text): Ignore errors from enriched-decode.
+
+2003-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-make-fqdn): Protect against nil user-mail.
+
+2003-02-28 Vasily Korytov <deskpot@myrealbox.com>
+
+ * gnus-art.el (gnus-boring-article-headers): New values:
+ 'to-list and 'cc-list.
+
+2003-02-28 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-setup-widening): new function to set
+ nnimap-split-download-body, we add it to gnus-get-new-news-hook
+ (spam-list-of-statistical-checks): list of statistical splitter
+ checks
+ (spam-split): added a widen call when a statistical check is
+ enabled
+
+2003-02-28 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-msg.el (gnus-user-agent): Changed default to
+ 'emacs-gnus-type, renamed 'full.
+
+2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nnfolder.el (nnfolder-request-accept-article): Don't use
+ mail-header-unfold-field.
+
+2003-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * imap.el (imap-ssl-open): Don't depend on ssl.el.
+ * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el.
+
+2003-02-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: add spam-stat-load to gnus-get-new-news-hook
+ (spam-split): remove spam-stat-load call
+
+2003-02-26 Simon Josefsson <jas@extundo.com>
+
+ * gnus-sum.el (gnus-summary-toggle-header): Run
+ gnus-article-decode-hook instead of calling a-decode-encoded-words
+ directly (the latter is run as part of the former).
+
+2003-02-26 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-expire-group): Remove debug.
+
+2003-02-25 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-sendmail-envelope-from): New option.
+ (message-sendmail-envelope-from): New function.
+ (message-send-mail-with-sendmail): Use it.
+
+2003-02-25 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added
+ compensation for TDMA addresses.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-msg.el (gnus-user-agent): New variable.
+ (gnus-version-expose-system): Removed. Obsoleted by
+ `gnus-user-agent'.
+ (gnus-extended-version): Use `gnus-user-agent'.
+
+2003-02-24 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-stat-register-spam-routine,
+ spam-stat-register-ham-routine): remove spam-stat-save
+ (spam-stat hook): add spam-stat-save to the gnus-save-newsrc-hook
+
+2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-group.el (gnus-topic-mode-p): Fixed free variable
+ reference.
+
+2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * nnheader.el (nnheader-find-nov-line): Changed midpoint
+ calculation to avoid integer overflow.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-start.el (gnus-backup-startup-file): Fixed custom type.
+
+2003-02-24 Ted Zlatanov <tzz@lifelogs.com>
+ * spam.el: disabled spam-get-article-as-filename
+
+ From Michael Shields <shields@msrl.com>
+
+ * gnus-group.el (gnus-group-is-exiting-without-update-p): New.
+ * gnus-sum.el (gnus-summary-exit-no-update): Use it.
+ * gnus-sum.el (gnus-summary-expire-articles): Use it.
+ * spam.el (spam-summary-prepare-exit): Use it.
+ * gnus.el (gnus-install-group-spam-parameters): New.
+ * spam.el (spam-group-ham-processor-copy-p): New.
+ * spam.el (spam-summary-prepare-exit): Support for ham copying.
+ * spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug
+ that would cause the current message to be moved if the group had
+ no spam.
+ * spam.el (spam-ham-move-routine): New `copy' argument.
+
+2003-02-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+ From Martin Thornquist <martint@ifi.uio.no>
+
+ * gnus-topic.el (gnus-topic-select-group): Select last group if
+ after last group.
+ * gnus-group.el (gnus-group-select-group): Ditto.
+
+2003-02-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (popup-menu): Compiler macro for Emacs 20.
+ (gnus-article-refer-article): Use gnus-point-at-(b|e)ol instead of
+ point-at-(b|e)ol which aren't available in Emacs 20.
+
+ * gnus-registry.el (puthash): Alias to cl-puthash for Emacs 20.
+
+2003-02-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-start.el (gnus-activate-group): Re-enabled the catch error
+ clause of the condition-case statement. Errors connecting to a
+ server no longer terminate gnus.
+
+ * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to
+ make its use obvious. Added no-nothing case to avoid
+ opening(closing) servers when already open(closed).
+ (gnus-agent-while-plugged): Added macro to facilitate internal use
+ of gnus-agent-toggle-plugged.
+ (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to
+ temporarily open servers.
+ (gnus-agent-get-undownloaded-list): Sort list of article numbers
+ as sorting gnus-newsgroup-headers is wrong.
+ (gnus-agent-summary-fetch-group): Use new gnus-agent-while-plugged
+ to temporarily open servers. Corrected logic to handle setting
+ gnus-agent-mark-unread-after-downloaded.
+ (gnus-agent-fetch-articles): Now handles headers with missing
+ article sizes and/or missing article lengths. Now clears the
+ message buffer when finished.
+ (gnus-agent-fetch-group-1): Position point before calling
+ gnus-summary-set-agent-mark.
+ (gnus-get-predicate): Corrected description, parameter is
+ predicate not category.
+ (gnus-agent-expire-group): Adapted the gnus-agent-expire-* code to
+ provide a separate single group expiration function.
+ (gnus-agent-regenerate-group): Now clears the message buffer when
+ finished.
+
+2003-02-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus.el (gnus-agent-target-move-group-header): New variable.
+ * gnus-draft.el (gnus-draft-send): If special header
+ "X-Gnus-Agent-Target-Move-Group" is present, do like Gcc into
+ that group, instead of performing the regular sending functions.
+
+2003-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg.
+
+2003-02-20 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.el (message-user-fqdn, message-valid-fqdn-regexp): New
+ variables.
+ (message-make-fqdn): Use it. Improved validity check.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-user-mail-address): Check whether
+ user-mail-address looks valid.
+
+ * gnus-msg.el (gnus-mailing-list-followup-to): New function.
+
+ * gnus-util.el (gnus-fetch-original-field): New function.
+
+2003-02-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * message.el (message-mode): \\(...\\) around additional
+ paragraph-separate alternative.
+
+2003-02-23 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-mime-button-commands): Add ellipsis.
+ (gnus-mime-button-menu): Define MIME popup menu with easy-menu to
+ display key bindings.
+ (gnus-mime-button-menu): Rewrite.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-button-url-regexp): Removed `.
+
+2003-02-23 Max Froumentin <mf@w3.org>
+
+ * gnus-art.el (gnus-button-url-regexp): Remove `, enter '.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-action-on-part): Require a match
+ interactively.
+
+ * gnus-start.el (gnus-save-newsrc-file): Use
+ gnus-backup-startup-file.
+ (gnus-backup-startup-file): New variable.
+
+2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-summary-buffer-name): Moved function here.
+
+ * gnus-draft.el (defun): Remove debug.
+
+2003-02-22 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-refer-article): Skip method if we
+ can't open server.
+
+2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-draft.el (defun): Configure posting styles.
+
+ * gnus-start.el (gnus-get-unread-articles-in-group): Make sure
+ the entry for the group exists before we alter it.
+
+2003-02-22 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * message.el (message-mode): MML tags separate paragraphs. Small
+ change from David S Goldberg <david.goldberg6@verizon.net>.
+
+ * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort
+ `gnus-newsgroup-headers'.
+
+ * gnus-art.el (gnus-article-refer-article): Grok more message id
+ formats. From Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>.
+
+2003-02-22 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't
+ use "path name".
+
+2003-02-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sum.el (gnus-summary-move-article)
+ (gnus-summary-expire-articles): send data header for article, not
+ just article ID
+
+ * gnus-registry.el (gnus-registry-hashtb, gnus-register-action)
+ (gnus-register-spool-action): added hashtable of message ID keys
+ with message motion data
+
+2003-02-21 Florian Weimer <fw@deneb.enyo.de>
+ From Reiner Steib <Reiner.Steib@gmx.de>.
+
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New
+ variable, used in `gnus-button-mid-or-mail-heuristic'.
+ (gnus-button-mid-or-mail-heuristic): New function derived from
+ Florian Weimer's Perl script.
+ (gnus-button-handle-mid-or-mail): Allow a function instead of
+ 'guess.
+ (gnus-button-guessed-mid-regexp): Removed.
+
+2003-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-resend): Bind message-setup-hook to nil;
+ remove X-Draft-From header.
+
+2003-02-20 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-simplify-subject-fully, gnus-subject-equal)
+ (gnus-newsgroup-undownloaded)
+ (gnus-summary-save-parts-default-mime, gnus-auto-select-next):
+ Doc fixes.
+
+2003-02-17 John Paul Wallington <jpw@gnu.org>
+
+ * gnus.el (gnus-shell-command-separator, gnus-email-address)
+ (gnus-default-charset, gnus-other-frame-parameters): Doc fixes.
+
+2003-02-20 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-spec.el (gnus-xmas-format): Use insert instead of
+ insert-string which is obsolete in Emacs 21.4.
+
+ * message.el (message-cross-post-followup-to-header): do.
+
+ * spam.el (spam-ifile-register-with-ifile)
+ (spam-stat-register-spam-routine)
+ (spam-stat-register-ham-routine)
+ (spam-bogofilter-register-with-bogofilter): do.
+
+ * mailcap.el (mailcap-mime-data): Fix typo.
+
+ * gnus-topic.el (gnus-topic-make-menu-bar): Add ellipsis.
+
+2003-02-19 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus-cite.el (gnus-cite-unsightly-citation-regexp)
+ (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to
+ `gnus-cite-unsightly-citation-regexp'.
+
+2003-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-copy-article-buffer): Copy an article header
+ even if there's just a header.
+
+2003-02-19 Jesper Harder <harder@ifa.au.dk>
+
+ * message.el (message-fix-before-sending): Fix highlighting of
+ illegible and invisible text.
+
+ * gnus-util.el (gnus-multiple-choice): Separate choices with
+ ",\e,A \e(B". Suggested by Dan Jacobson <jidanni@dman.ddts.net>.
+
+2003-02-18 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer.
+
+2003-02-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine)
+ (spam-mark-spam-as-expired-and-move-routine): use
+ gnus-summary-kill-process-mark and gnus-summary-yank-process-mark
+ around process-mark manipulation on the group
+
+2003-02-17 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart
+ submenu.
+
+2003-02-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch): Reverse the return value of
+ the continuation question.
+
+2003-02-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nndraft.el (nndraft-request-move-article): Bind
+ nnmh-allow-delete-final to t.
+
+2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-uu-filename): Fix use of character constant.
+
+2003-02-11 Stefan Monnier <monnier@cs.yale.edu>
+
+ * nntp.el (nntp-accept-process-output): Don't use point-max to get
+ the buffer's size.
+
+2003-01-31 Joe Buehler <jhpb@draco.hekimian.com>
+
+ * nnheader.el: Added cygwin to system-type comparisons.
+
+2003-01-27 Juanma Barranquero <lektu@terra.es>
+
+ * imap.el (imap-mailbox-status): Fix typo.
+
+2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-prepare): Don't set agent mark if
+ online.
+
+2003-02-14 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all
+ commands.
+ * gnus-sum.el: Small change from Frank Weinberg
+ <frank@usenet-rundfahrt.de>:
+ (gnus-auto-center-group): New variable.
+ (gnus-summary-read-group-1): Use it.
+ (gnus-summary-next-group): Fix docstring.
+
+2003-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-util.el (gnus-faces-at): Simplify.
+
+2003-02-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine)
+ (spam-mark-spam-as-expired-and-move-routine): made the article
+ move conditional, so it's not called even if there's nothing to move
+
+2003-02-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
+
+ * message.el (message-unix-mail-delimiter): Accept any whitespace
+ after the email address and before the date; do not require the
+ space character. From Kurt B. Kaiser <kbk@shore.net>.
+
+2003-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-only-boring-p): Make sure that the
+ gnus-article-boring-faces variable is bound; use gnus-faces-at.
+
+ * gnus-util.el (gnus-faces-at): New macro.
+
+2003-02-13 Michael Shields <shields@msrl.com>
+
+ * gnus-cite.el
+ (gnus-cite-attribution-suffix, gnus-cite-parse):
+ Better handling for Microsoft citation styles.
+ (gnus-unsightly-citation-regexp): New.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * gnus-art.el (article-strip-banner): Strip both per-group and
+ per-user-address banners.
+ (article-really-strip-banner): New.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * gnus-sum.el (gnus-article-goto-next-page,
+ gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of
+ relying on the summary bindings of `n' and `p'.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * gnus-art.el (gnus-article-only-boring-p): New.
+ (gnus-article-skip-boring): New.
+ * gnus-cite.el (gnus-article-boring-faces): New.
+ * gnus-sum.el (gnus-summary-next-page): Use
+ gnus-article-only-boring-p.
+
+2003-02-12 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-mark-spam-as-expired-and-move-routine)
+ (spam-ham-move-routine): unmark all articles before marking those
+ of interest and calling gnus-summary-move-article
+
+2003-02-12 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.el (gnus-kill-buffer): Move to gnus.el because it's
+ logically the complement of gnus-get-buffer-create and
+ gnus-add-buffer.
+
+ * gnus-util.el (gnus-kill-buffer): do.
+
+ * nnmail.el: Autoload gnus-kill-buffer.
+
+2003-02-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-summary-set-agent-mark): Added call to
+ gnus-summary-goto-subject as gnus-summary-update-mark operates on
+ the current LINE.
+ (gnus-agent-summary-fetch-group): Minimized the number of times
+ that the article is updated in the buffer.
+
+2003-02-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el (spam-ham-move-routine): use the process-mark instead of
+ gnus-current-article when moving articles
+ (spam-mark-spam-as-expired-and-move-routine): ditto, use the process-mark
+
+2003-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-expire-articles): Recursive.
+ (gnus-topic-catchup-articles): Ditto.
+ (gnus-topic-mark-topic): Reverse recursive logic.
+
+2003-02-11 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-sum.el (gnus-summary-refer-thread): Handle case where
+ gnus-refer-thread-limit is t.
+
+2003-02-10 Jesper Harder <harder@ifa.au.dk>
+
+ * mm-util.el (mm-mule-charset-to-mime-charset): Use
+ sort-coding-systems to prefer utf-8 over utf-16.
+
+2003-02-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+
+ * gnus-agent.el (gnus-agent-expire-days):
+ gnus-request-move-article depends on gnus-agent-expire to clean up
+ the cache after moving the article. Therefore, g-a-e-d can NOT
+ default to nil or can gnus-agent-expire be disabled by doing so.
+ If you don't want to run gnus-agent-expire, don't call it.
+ (gnus-agent-expire): The broken test to disable gnus-agent-expire
+ when g-a-e-d was NOT nil was removed.
+ (gnus-agent-article-name): Removed unnecessary input test as
+ article IDs are always strings.
+ (gnus-agent-regenerate-group): Added check to protect against
+ servers that generate absurdly long article IDs. Valid IDs are
+ less than 10 digits to avoid overflow errors. Fixed logic error
+ when ensuring that the final article ID is present in the new
+ alist.
+
+2003-02-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the
+ next line after finding the parent.
+
+2003-02-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-version-number): Bumped.
+
2003-02-08 23:23:27 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
* gnus.el: Oort Gnus v0.15 is released.
* gnus-registry.el (regtest-nnmail): use
gnus-internal-registry-spool-current-method
-
-
2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail-source.el (mail-source-fetch): Typo fix.
(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 <frank@usenet-rundfahrt.de>
- * 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 <harder@ifa.au.dk>
(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.
"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.
* 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.
2003-01-27 Teodor Zlatanov <tzz@lifelogs.com>
- * 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
* gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers
as well.
-
+
* gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer.
-
+
* gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do.
-
+
* gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do.
-
+
* gnus-bcklg.el (gnus-backlog-shutdown): do.
-
+
* gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do.
2003-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-fun.el (gnus-face-encode): New function.
(gnus-convert-png-to-face): Use it.
- * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks.
+ * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks.
2003-01-26 Jesper Harder <harder@ifa.au.dk>
2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnheader.el (nnheader-directory-separator-character): New
- variable.
+ variable.
2003-01-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
(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 <larsi@gnus.org>
2003-01-24 Teodor Zlatanov <tzz@lifelogs.com>
- * 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
2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-mime-security-show-details): Toggle showing
- details.
+ details.
2003-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
* 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 <kgreiner@xpediantsolutions.com>
+2003-01-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-sum.el (gnus-summary-first-subject): Fixed bug that I
introduced on 2002-01-22.
2003-01-23 Teodor Zlatanov <tzz@lifelogs.com>
- * 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
* gnus-sum.el (gnus-spam-mark): set to `$'
-2002-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes
gnus-newsgroup-unfetched, the list of articles whose headers have
gnus-summary-first-subject call to match new API.
(gnus-summary-first-unseen-or-unread-subject): Ditto.
(gnus-summary-catchup): Do not mark unfetched articles as read.
-
+
2003-01-22 Jesper Harder <harder@ifa.au.dk>
* gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook):
* mailcap.el (mailcap-print-command): lpr-command might be
unbound in XEmacs.
-2002-01-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-regenerate-group): Added interactive form.
* gnus-sum.el (gnus-summary-update-article-line): Fixed
calculation of net characters added for use in the gnus-data
structure.
-
+
2003-01-18 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
* nnmail.el (nnmail-process-unix-mail-format): Improve error
2003-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * 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,
2003-01-17 Simon Josefsson <jas@extundo.com>
- * 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)
2003-01-16 Simon Josefsson <jas@extundo.com>
- * gnus-fun.el (gnus-convert-image-to-x-face-command)
- (gnus-convert-image-to-face-command, gnus-x-face-from-file)
+ * gnus-fun.el (gnus-convert-image-to-x-face-command)
+ (gnus-convert-image-to-face-command, gnus-x-face-from-file)
(gnus-face-from-file): Doc fix; don't mention image format.
2003-01-16 Teodor Zlatanov <tzz@lifelogs.com>
(spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis
2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
+
* gnus-agent.el: Don't use `path'.
From the GNU coding standards:
-
+
Please do not use the term ``pathname'' that is used in Unix
documentation; use ``file name'' (two words) instead. We use
the term ``path'' only for search paths, which are lists of
directory names.
* nnsoup.el (nnsoup-file-name): Ditto.
-
+
* nnmail.el (nnmail-pathname-coding-system): Ditto.
- (nnmail-group-pathname): Ditto.
-
+ (nnmail-group-pathname): Ditto.
+
* nnimap.el (nnimap-group-overview-filename): Ditto.
-
+
* nnheader.el (nnheader-pathname-coding-system): Ditto.
(nnheader-group-pathname): Ditto.
-
+
* nnfolder.el (nnfolder-group-pathname): Ditto.
-
+
* gnus.el (gnus-home-directory): Ditto.
-
+
* gnus-group.el (gnus-group-icon-list): Ditto.
-
+
2003-01-16 Jesper Harder <harder@ifa.au.dk>
* gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type.
2003-01-15 Teodor Zlatanov <tzz@lifelogs.com>
- * 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
2003-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
* message.el (message-send): Don't warn about duplicates when
- superseding.
+ superseding.
2003-01-15 Simon Josefsson <jas@extundo.com>
* nnimap.el (nnimap-split-download-body): New variable.
(nnimap-split-articles): Use it.
-2002-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-check-overview-buffer): This data
integrity checker was incorrectly flagging, and removing, articles
2003-01-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * 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 <jhair_tocancipa@@gmx.net>
* 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 <yamaoka@jpl.org>
* gnus-msg.el (gnus-inews-add-send-actions): Allow a list of
articles to be marked as well.
-2002-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-get-undownloaded-list): Include the
fictious headers generated by nnagent (ie. Undownloaded Article
####) in the list of articles that have not been downloaded.
-
+
* gnus-int.el (): Added require declarations to resolve
compile-time warnings.
(gnus-open-server): If the server status is set to offline,
2003-01-13 Romain FRANCOISE <romain@orebokech.com>
- * 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 <larsi@gnus.org>
* 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 <Reiner.Steib@gmx.de>
2003-01-12 Fran\e,Ag\e(Bois-David Collin <Francois-David.Collin@curie.fr>
* mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer.
-
+
2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-fun.el (gnus-face-from-file): Autoload.
* gnus-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 <kgreiner@xpediantsolutions.com>
+2003-01-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-fetch-group-1): Remove downloadable
marks from articles that are already stored in the agent.
(gnus-agent-backup-overview-buffer): New debug tool. Creates a
backup copy of an invalid .overview file for later analysis.
-
+
2003-01-12 Gregorio Gervasio, Jr. <gtgj@pacbell.net>
* gnus-sum.el (gnus-summary-exit): Reverse change to make group
2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-display-mime): Use the mime emulation
- variable.
+ variable.
* gnus-sum.el (gnus-article-emulate-mime): New variable.
* message.el (message-check-news-header-syntax): Compute the
header length correctly.
-2002-01-10 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-10 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-expire): Do not remove article from
alist when keeping fetched article file.
2003-01-10 Teodor Zlatanov <tzz@lifelogs.com>
* 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
(spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0.
Changed copyright statement to FSF.
-2002-01-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-catchup): Do not mark cached nor
processable articles as read.
* gnus-sum.el (gnus-summary-make-menu-bar): Added
gnus-summary-refer-thread to thread menu.
-2002-01-07 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-07 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a
summary buffer, articles that cannot be fetched are marked as
gnus-sieve-crosspost. One-line patch from Steinar Bang
<sb@dod.no>.
-2002-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus.el: Renamed gnus-summary-*-uncached-face as
gnus-summary-*-undownloaded-face to avoid confusing the agent with
* gnus-sum.el: Ditto.
-2002-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
+2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution
in either the group or summary buffer.
* gnus-sum.el (t): Add gnus-group-fetch-charter and
gnus-group-fetch-control to summary key map and menu.
-
2002-10-03 Paul Jarc <prj@po.cwru.edu>
* nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article
* 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.
"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)
(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")
(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")
(require 'gnus-sum)
(require 'gnus-score)
(require 'gnus-srvr)
+(require 'gnus-util)
(eval-when-compile
(if (featurep 'xemacs)
(require 'itimer)
(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."
: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.
: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
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)
(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 ()
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)))))
["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
(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))
(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
(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."
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)
(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 ()
(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"))))
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.
(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)))
gnus-newsgroup-cached)
(setq articles (gnus-sorted-ndifference
(gnus-sorted-ndifference
- (copy-sequence articles)
+ (gnus-copy-sequence articles)
gnus-newsgroup-downloadable)
gnus-newsgroup-cached)))
(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
(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 ()
(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
(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)
(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.
(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)
(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
;; 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
;; 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.
articles)
(ignore-errors
(erase-buffer)
- (nnheader-insert-file-contents file))))
- )
+ (nnheader-insert-file-contents file)))))
articles))
(defsubst gnus-agent-copy-nov-line (article)
(t
(beginning-of-line)
nil))))
-
+
(gnus-agent-copy-nov-line (pop articles)))))
;; Copy the rest lines
(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)))))
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)
(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)))))))
(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))
(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))))))
;; 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
(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.")
"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
["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]
(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)
(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."
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)
(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)))))
(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)))))
(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)))))
"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)))
(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))
(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)
"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
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."
(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.
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 ()
;; 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))
(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)))
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)
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)
(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)))
(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))
(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)
;; 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)
(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))
(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
;; 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))
)
(setq gnus-agent-article-alist alist)
-
+
(when regenerated
(gnus-agent-save-alist group)))
)
(sit-for 0))
)
+ (gnus-message 5 nil)
regenerated))
;;;###autoload
(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))
(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
'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.
: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)
(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
(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)
(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)
(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")
(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)
(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))
(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."
(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."
(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"))
(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
(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."
,(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)
(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
(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
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
(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.
(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) "<news:" "<" )))
- (goto-char point)
+ (save-excursion
+ (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
+ (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
+ (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+ (let ((msg-id (concat "<" (match-string 0) ">")))
(set-buffer gnus-summary-buffer)
- (gnus-summary-refer-article message-id))
- (goto-char (point))
+ (gnus-summary-refer-article msg-id))
(error "No references around point"))))
(defun gnus-article-show-summary ()
(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)
(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)
: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
- "^<?\\(slrn\\|Pine\\.\\)"
- "\\|\\.fsf@\\|\\.fsf_-_@\\|\\.ln@"
- "\\|@4ax\\.com\\|@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de"
- "\\|^<?.*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*@")
- "Regular expression that matches message IDs and not mail addresses."
- ;; TODO: Incorporate more matches from
- ;; <URL:http://piology.org/perl/id-or-mail.pl.html>. 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."
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)))
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)))
(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:"
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
(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)
(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)
(eval-when-compile (require 'cl))
(require 'gnus)
-(require 'gnus-art)
(require 'gnus-range)
(require 'message) ; for message-cite-prefix-regexp
: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.")
: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)
(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))
;; 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.
(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))))))
(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)
(require 'wid-edit)
(require 'gnus)
+(require 'gnus-agent)
(require 'gnus-score)
(require 'gnus-topic)
(require 'gnus-art)
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)
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)
(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)
: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
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
(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)
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)))
(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)))))
(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)
;;; 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.")
(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)
;; 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)
"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))
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)
;; 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.
(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
(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.
(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.
(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))
(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)
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
+(require 'gnus-util)
(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
: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.
(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)))
(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 ""))
(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))))))
\f
;;;
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)
(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)
(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\" <offerlm@aol.com>" "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)
(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))
(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))
: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."
: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
;;; 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."
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
(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)))
(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
;; 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))
(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))
(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'."
(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 ()
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
+summary mode and go back to group mode. If the value is neither nil
+nor t, Gnus will select the following unread newsgroup. In
particular, if the value is the symbol `quietly', the next unread
newsgroup will be selected without any confirmation, and if it is
`almost-quietly', the next group will be selected without any
confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
+Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
will go to the next group without confirmation."
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "off" nil)
: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
(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
integer))
(defcustom gnus-summary-save-parts-default-mime "image/.*"
- "*A regexp to match MIME parts when saving multiple parts of a message
-with gnus-summary-save-parts (X m). This regexp will be used by default
-when prompting the user for which type of files to save."
+ "*A regexp to match MIME parts when saving multiple parts of a
+message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
+This regexp will be used by default when prompting the user for which
+type of files to save."
:group 'gnus-summary
:type 'regexp)
"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.")
(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))
(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)
["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]
(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))
(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)))
(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)
(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))
(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)))
(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)))
(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)
(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
(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.
(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)
(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)))))))
(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"))
(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"))
;; 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)))))))
(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))
(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))
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))))
(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
(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 ()
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)
(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?
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (progn (beginning-of-line) (point)))
- (end (progn (end-of-line) (point)))
+ (let* ((beg (gnus-point-at-bol))
+ (end (gnus-point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
(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))
["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]
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)))
(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))))
(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)
(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)))
(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."
(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
;; 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)
(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)))
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
(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)
(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)
(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
(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))
(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
(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])
(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
: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)
(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.")
"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
: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)
;; 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
"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
(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
(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.")
"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)
(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)
(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"
(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*")
(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."
;;; 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 <hove@phys.ntnu.no>
(while (< item-nr items)
(setq item-nr (1+ item-nr))
(re-search-forward "<dt>\\([ ]*\\)" (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 "\\([ ]*\\)\\(</dt>\\|<dd>\\)" (point-max) t)
(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)
;; 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 ))
;; Removing lonely <br> 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)))))
;;
;; </Functions to be called to fix up paragraphs>
(while (re-search-forward (format "\\(</?%s[^>]*>\\)" 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"
"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.")
;;; 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 <jas@pdc.kth.se>
(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")
(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
(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))
"'): ")
(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) "'): "))))
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 \""
(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
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
(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)
)
: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)
(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)))))))))
(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."
(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
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."
(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)))
"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
(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)
(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))
(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)))
(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)
(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)
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"))
: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."
: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...")
;; 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
(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")
(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
(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)
(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")))))
(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")
'(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))))))
(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))
(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
;; 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"))
(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)))))
(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
(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")))))
(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-"))
(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)
(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."
`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.")
(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)
(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)
(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.
"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)))))
(if (looking-at ".+")
(setq file-name
(let ((nnheader-file-name-translation-alist
- '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
+ '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_))))
(nnheader-translate-file-chars (match-string 0))))))
(defun mm-uu-binhex-filename ()
((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))))
(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)))
(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 ()
-;;; 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 <sascha@meta-x.de>,
;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
;;; Commentary:
-;; RCS: $Id: mml1991.el,v 1.1.1.4 2003-01-14 05:36:30 yamaoka Exp $
-
;;; Code:
(defvar mml1991-use mml2015-use
;; 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"))
(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)
;; 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))
(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")
;; 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"))
(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)
;; 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
(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")
(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)
(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)
;; 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
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")
(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)))
(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
`((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
(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 . "^--.*$")
(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))
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)
'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)
nnmh-request-group
nnmh-close-group
nnmh-request-list
- nnmh-request-newsgroups
- nnmh-request-move-article))
+ nnmh-request-newsgroups))
(provide 'nndraft)
(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
(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.
(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)
(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)
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)))
(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))
(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)
;; 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
;; 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.
(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)
: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
;; 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"))
(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)))))
(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."
(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))
(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))
(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.
;; copying, restoring, etc.
;;
;; Todo:
-;; * Merge the information from <URL:http://multivac.cwru.edu./nnmaildir/>
-;; 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:
;; 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:
(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)))
(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
(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)))
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)
(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)
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)
(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)
(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)))
(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)
(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)
(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)
(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)
(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
(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
(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...)
(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."
(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)
(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.")
\f
(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."
(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.
(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.
(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]")
(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)
(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."
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
(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"
(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)
(require 'gnus-bcklg)
(require 'nnmail)
(require 'mm-util)
-(require 'mail-source)
(require 'mm-url)
(nnoo-declare nnwarchive)
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
(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))))
(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))
;; 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)
;; 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)
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
(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))
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."
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)
(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)
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)
(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
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.
: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'."
: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
(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 ()
(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)
(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)
(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"
(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
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
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))
(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)
+
\f
;;;; Regex headers
(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
(when matches
spam-split-group)))
\f
+;;;; 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))))
+\f
;;;; BBDB
;;; original idea for spam-check-BBDB from Alexander Kotelnikov
(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
(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
(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)
(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
+2003-03-17 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Using MIME): Added gnus-mime-delete-part.
+
+2003-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Required Back End Functions): Add.
+
+2003-03-17 Simon Josefsson <jas@extundo.com>
+
+ * pgg.texi: Fix setfilename. Tiny patch by Frank Haun
+ <pille3003@fhaun.de>.
+
+2003-03-09 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus.texi (Top): Added menu item for Maildir node.
+
+2003-03-11 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi (Paging the Article): Addition.
+
+2003-03-10 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi (Customizing Articles): Additions.
+
+2003-03-09 Paul Jarc <prj@po.cwru.edu>
+
+ * gnus.texi (Maildir): New node.
+
+2003-03-08 Jesper Harder <harder@ifa.au.dk>
+
+ * gnusref.tex: Update.
+
+2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * 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 <harder@ifa.au.dk>
+
+ * 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 <deskpot@myrealbox.com>
+
+ * gnus.texi: New values, 'to-list and 'cc-list, for
+ gnus-boring-article-headers.
+
+2003-02-28 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi (Extending the spam elisp package): added mention of
+ spam-list-of-statistical-checks
+
+2003-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus.texi: Remove the dependence on ssl.el.
+
+2003-02-26 Jesper Harder <harder@ifa.au.dk>
+
+ * message.texi (Mail Variables): Add
+ message-sendmail-envelope-from.
+
+2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Mail and Post): Added `gnus-user-agent', removed
+ `gnus-version-expose-system'.
+
+2003-02-24 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi: Markup fixes.
+
+ * message.texi: do.
+
+ * emacs-mime.texi: do.
+
+2003-02-20 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * message.texi (News Headers): Update description of Message-ID.
+
+2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Startup Files): Addition.
+
+2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Mail Source Specifiers): Addition.
+
+2003-02-22 Jesper Harder <harder@ifa.au.dk>
+
+ * emacs-mime.texi (Files and Directories): New node.
+
+2003-02-21 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi (Mailing List): Fix.
+
+ * gnus.texi: Markup fixes.
+
+2003-02-18 Reiner Steib <Reiner.Steib@gmx.de>
+
+ * gnus.texi (Article Washing): Mention `g'.
+ (Customizing Articles): Added cross reference.
+
+2003-02-12 Michael Shields <shields@msrl.com>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus.texi (Topic Commands): Addition.
+
2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
* gnus.texi (BBDB Whitelists, Blacklists and Whitelists):
* 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
@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
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
@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)
\makeindex
\begin{document}
-\newcommand{\gnusversionname}{Oort Gnus v0.15}
+\newcommand{\gnusversionname}{Oort Gnus v0.16}
\newcommand{\gnuschaptername}{}
\newcommand{\gnussectionname}{}
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
* 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
* 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.
* 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
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
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
@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.
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
(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.
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
But some variables, such as @code{visible}, have no effect. For
example:
-@example
+@lisp
(setq gnus-parameters
'(("mail\\..*"
(gnus-show-threads nil)
("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.
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
@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)
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.
@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
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)
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
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.
* 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
@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
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
@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)
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
@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
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
@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")
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
@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
@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:
@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.
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)
@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
@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}.
@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)
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
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
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}
@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
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}).
@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.
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 "")))
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.
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
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
@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
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:
@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")}.
@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
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.
@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
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.
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
@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
@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
@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
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
@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
@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
@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
@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
@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.
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.)
@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
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
@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
* 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
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
@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
@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
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.
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
@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
Decide on download policy. @xref{Agent Categories}.
@item
-Uhm... that's it.
+Uhm@dots{} that's it.
@end itemize
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
@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:
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
@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.
@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
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
@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
@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
@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
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?
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.
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
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
@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
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.
@item
code
-@example
+@lisp
(defvar spam-use-blackbox nil
"True if blackbox should be used.")
-@end example
+@end lisp
Add
@example
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:
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.")
"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
(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
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.
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}.
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
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
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
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:
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
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
@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
@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
@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
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
header = <text> 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 <TAB> ] eol
+nov-line = field 7*8[ <TAB> field ] eol
field = <text except TAB>
@end example
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}.
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
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
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
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.\\
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}
}
}
\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}.\\
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}.\\
\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.\\
@findex message-change-subject
@cindex Subject
Change the current @samp{Subject} header. Ask for new @samp{Subject}
-header and append @code{(was: <Old Subject>)}. The old subject can be
+header and append @samp{(was: <Old Subject>)}. The old subject can be
stripped on replying, see @code{message-subject-trailing-was-query}
(@pxref{Message Headers}).
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
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
@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
\input texinfo @c -*-texinfo-*-
-@setfilename pgg.info
+@setfilename pgg
@set VERSION 0.1
projects / elisp / gnus.git- / commitdiff