+2003-02-08 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-art.el (gnus-article-refer-article): Use
+ gnus-replace-in-string.
+
+ * gnus-util.el (gnus-map-function): Remove unneeded let-binding.
+ (gnus-remove-duplicates): do.
+
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-int.el (gnus-internal-registry-spool-current-method): new variable
+ (gnus-request-scan): set
+ gnus-internal-registry-spool-current-method to gnus-command-method
+ before a request-scan operation
+
+ * gnus-registry.el (regtest-nnmail): use
+ gnus-internal-registry-spool-current-method
+
+
+
+2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch): Typo fix.
+
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * nnmail.el (nnmail-spool-hook): new hook
+ (nnmail-cache-insert): call nnmail-spool-hook
+
+ * gnus-registry.el: new file with examples of using the hooks
+
+ * gnus.el (gnus-registry): added registry customization group
+ (gnus-group-prefixed-name): improve function to return full group
+ name optionally
+ (gnus-group-guess-prefixed-name): shortcut to
+ gnus-group-prefixed-name, using just the group name
+ (gnus-group-full-name): always get a group's full name
+ (gnus-group-guess-full-name): shortcut, using just the group name
+
+ * gnus-sum.el (gnus-summary-article-move-hook)
+ (gnus-summary-article-delete-hook)
+ (gnus-summary-article-expire-hook): new hooks
+ (gnus-summary-move-article, gnus-summary-expire-articles)
+ (gnus-summary-delete-article): invoke the new hooks
+
+2003-02-07 Frank Weinberg <frank@usenet-rundfahrt.de>
+
+ * gnus-art.el (gnus-article-refer-article): Strip leading "news:"
+ from message-ID
+
+2003-02-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus-util.el (gnus-run-hooks): Use save-current-buffer.
+
+2003-02-07 John Paul Wallington <jpw@gnu.org>
+
+ * mm-util.el (mm-delete-duplicates, mm-append-to-file)
+ (mm-write-region, mm-detect-coding-region): Doc fixes.
+
2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mail-source.el (mail-source-fetch): Ignore errors.
(let ((point (point)))
(search-forward ">" nil t) ;Move point to end of "<....>".
(if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
- (let ((message-id (match-string 1)))
+ (let ((message-id (gnus-replace-in-string (match-string 1) "<news:" "<" )))
(goto-char point)
(set-buffer gnus-summary-buffer)
(gnus-summary-refer-article message-id))
(const :tag "Deny server" denied)
(const :tag "Unplugg Agent" offline)))
+(defvar gnus-internal-registry-spool-current-method nil
+ "The current method, for the registry.")
+
;;;
;;; Server Communication
;;;
(gnus-inhibit-demon t)
(mail-source-plugged gnus-plugged))
(if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-scan)
- (and group (gnus-group-real-name group))
- (nth 1 gnus-command-method)))))
+ (progn
+ (setq gnus-internal-registry-spool-current-method gnus-command-method)
+ (funcall (gnus-get-function gnus-command-method 'request-scan)
+ (and group (gnus-group-real-name group))
+ (nth 1 gnus-command-method))))))
(defsubst gnus-request-update-info (info gnus-command-method)
"Request that GNUS-COMMAND-METHOD update INFO."
--- /dev/null
+;;; gnus-registry.el --- article registry for Gnus
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
+(require 'gnus-int)
+(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"
+ 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:
+
+(provide 'gnus-registry)
+
+;;; gnus-registry.el ends here
:group 'gnus-summary
:type 'hook)
+(defcustom gnus-summary-article-move-hook nil
+ "*A hook called after an article is moved, copied, respooled, or crossposted."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-delete-hook nil
+ "*A hook called after an article is deleted."
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-expire-hook nil
+ "*A hook called after an article is expired."
+ :group 'gnus-summary
+ :type 'hook)
+
(defcustom gnus-summary-display-arrow
(and (fboundp 'display-graphic-p)
(display-graphic-p))
(nnheader-get-report (car to-method))))
((eq art-group 'junk)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)))
+ (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))))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer)))))
+ article gnus-newsgroup-name (current-buffer))))
+
+ ;; run the move/copy/crosspost/respool hook
+ (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)))
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
(dolist (article expirable)
(when (and (not (memq article es))
(gnus-data-find article))
- (gnus-summary-mark-article article gnus-canceled-mark))))))
+ (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)))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
;; after all.
(unless (memq (car articles) not-deleted)
(gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (id (mail-header-id (gnus-data-header
+ (assoc article (gnus-data-list nil))))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete id gnus-newsgroup-name nil
+ nil))
(setq articles (cdr articles)))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(defun gnus-map-function (funs arg)
"Applies the result of the first function in FUNS to the second, and so on.
ARG is passed to the first function."
- (let ((myfuns funs))
- (while myfuns
- (setq arg (funcall (pop myfuns) arg)))
- arg))
+ (while funs
+ (setq arg (funcall (pop funs) arg)))
+ arg)
(defun gnus-run-hooks (&rest funcs)
- "Does the same as `run-hooks', but saves excursion."
- (let ((buf (current-buffer)))
- (unwind-protect
- (apply 'run-hooks funcs)
- (set-buffer buf))))
+ "Does the same as `run-hooks', but saves the current buffer."
+ (save-current-buffer
+ (apply 'run-hooks funcs)))
;;; Various
(eq major-mode 'gnus-group-mode))))
(defun gnus-remove-duplicates (list)
- (let (new (tail list))
- (while tail
- (or (member (car tail) new)
- (setq new (cons (car tail) new)))
- (setq tail (cdr tail)))
+ (let (new)
+ (while list
+ (or (member (car list) new)
+ (setq new (cons (car list) new)))
+ (setq list (cdr list)))
(nreverse new)))
(defun gnus-remove-if (predicate list)
:link '(custom-manual "(gnus)Article Caching")
:group 'gnus)
+(defgroup gnus-registry nil
+ "Article Registry."
+ :group 'gnus)
+
(defgroup gnus-start nil
"Starting your favorite newsreader."
:group 'gnus)
(defsubst gnus-method-to-full-server-name (method)
(format "%s+%s" (car method) (nth 1 method)))
-(defun gnus-group-prefixed-name (group method)
- "Return the whole name from GROUP and METHOD."
+(defun gnus-group-prefixed-name (group method &optional full)
+ "Return the whole name from GROUP and METHOD. Call with full set to
+get the fully qualified group name (even if the server is native)."
(and (stringp method) (setq method (gnus-server-to-method method)))
(if (or (not method)
- (gnus-server-equal method "native")
+ (and (not full) (gnus-server-equal method "native"))
(string-match ":" group))
group
(concat (gnus-method-to-server-name method) ":" group)))
+(defun gnus-group-guess-prefixed-name (group)
+ "Guess the whole name from GROUP and METHOD."
+ (gnus-group-prefixed-name group (gnus-find-method-for-group
+ group)))
+
+(defun gnus-group-full-name (group method)
+ "Return the full name from GROUP and METHOD, even if the method is
+native."
+ (gnus-group-prefixed-name group method t))
+
+(defun gnus-group-guess-full-name (group)
+ "Guess the full name from GROUP, even if the method is native."
+ (gnus-group-full-name group (gnus-find-method-for-group group)))
+
(defun gnus-group-real-prefix (group)
"Return the prefix of the current group name."
(if (string-match "^[^:]+:" group)
(condition-case err
(funcall function source callback)
(error
- (if (and (not mail-source-ignore-error)
+ (if (and (not mail-source-ignore-errors)
(yes-or-no-p
(format "Mail source %s error (%s). Continue? "
(if (memq ':password source)
(mm-mule-charset-to-mime-charset charset)))
(defun mm-delete-duplicates (list)
- "Simple substitute for CL `delete-duplicates', testing with `equal'."
+ "Simple substitute for CL `delete-duplicates', testing with `equal'."
(let (result head)
(while list
(setq head (car list))
saying what text to write.
Optional fourth argument specifies the coding system to use when
encoding the file.
-If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
(let ((coding-system-for-write
(or codesys mm-text-coding-system-for-write
mm-text-coding-system))
coding-system inhibit)
"Like `write-region'.
-If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
+If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
(let ((coding-system-for-write
(or coding-system mm-text-coding-system-for-write
mm-text-coding-system))
(if (fboundp 'detect-coding-region)
(defun mm-detect-coding-region (start end)
- "Like 'detect-coding-region' except returning the best one."
+ "Like `detect-coding-region' except returning the best one."
(let ((coding-systems
(detect-coding-region (point) (point-max))))
(or (car-safe coding-systems)
:group 'nnmail-split
:type 'hook)
+(defcustom nnmail-spool-hook nil
+ "*A hook called when a new article is spooled."
+ :group 'nnmail
+ :type 'hook)
+
(defcustom nnmail-large-newsgroup 50
"*The number of the articles which indicates a large newsgroup or nil.
If the number of the articles is greater than the value, verbose
(defvar group-art-list)
(defvar group-art)
(defun nnmail-cache-insert (id grp)
+ (run-hook-with-args 'nnmail-spool-hook
+ id grp)
(when nnmail-treat-duplicates
;; Store some information about the group this message is written
;; to. This is passed in as the grp argument -- all locations this
+2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus.texi (BBDB Whitelists, Blacklists and Whitelists):
+ corrected existing docs, added spam-use-whitelist-exclusive and
+ spam-use-BBDB-exclusive to list of variables
+
+2003-02-07 Jesper Harder <harder@ifa.au.dk>
+
+ * gnus.texi (The problem of spam): Don't use @email for examples
+ -- it creates a mailto-link in HTML and PDF.
+
2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Mail Source Customization): Addition.
and processing.
The simplest approach to filtering spam is filtering. If you get 200
-spam messages per day from @email{random-address@@vmadmin.com}, you
+spam messages per day from @samp{random-address@@vmadmin.com}, you
block @samp{vmadmin.com}. If you get 200 messages about
@samp{VIAGRA}, you discard all messages with @samp{VIAGRA} in the
message. This, unfortunately, is a great way to discard legitimate
@cindex spam
@defvar spam-use-blacklist
+
Set this variable to @code{t} if you want to use blacklists when
splitting incoming mail. Messages whose senders are in the blacklist
will be sent to the @code{spam-split-group}. This is an explicit
filter, meaning that it acts only on mail senders @emph{declared} to
be spammers.
+
@end defvar
@defvar spam-use-whitelist
+
Set this variable to @code{t} if you want to use whitelists when
splitting incoming mail. Messages whose senders are not in the
-whitelist will be sent to the @code{spam-split-group}. This is an
-implicit filter, meaning it believes everyone to be a spammer unless
-told otherwise. Use with care.
+whitelist will be sent to the next spam-split rule. This is an
+explicit filter, meaning that unless someone is in the whitelist, their
+messages are not assumed to be spam or ham.
+
+@end defvar
+
+@defvar spam-use-whitelist-exclusive
+
+Set this variable to @code{t} if you want to use whitelists as an
+implicit filter, meaning that every message will be considered spam
+unless the sender is in the whitelist. Use with care.
+
@end defvar
@defvar gnus-group-spam-exit-processor-blacklist
+
Add this symbol to a group's @code{spam-process} parameter by
customizing the group parameters or the
@code{gnus-spam-process-newsgroups} variable. When this symbol is
added to a group's @code{spam-process} parameter, the senders of
spam-marked articles will be added to the blacklist.
+
@end defvar
@defvar gnus-group-ham-exit-processor-whitelist
+
Add this symbol to a group's @code{spam-process} parameter by
customizing the group parameters or the
@code{gnus-spam-process-newsgroups} variable. When this symbol is
ham-marked articles in @emph{ham} groups will be added to the
whitelist. Note that this ham processor has no effect in @emph{spam}
or @emph{unclassified} groups.
+
@end defvar
Blacklists are lists of regular expressions matching addresses you
use the Emacs regular expression syntax.
Conversely, whitelists tell Gnus what addresses are considered
-legitimate. All non-whitelisted addresses are considered spammers.
-This option is probably not useful for most Gnus users unless the
-whitelists is very comprehensive or permissive. Also see @ref{BBDB
-Whitelists}. Whitelist entries use the Emacs regular expression
-syntax.
+legitimate. All messages from whitelisted addresses are considered
+non-spam. Also see @ref{BBDB Whitelists}. Whitelist entries use the
+Emacs regular expression syntax.
The blacklist and whitelist file locations can be customized with the
@code{spam-directory} variable (@file{~/News/spam} by default), or
@defvar spam-use-BBDB
Analogous to @code{spam-use-whitelist} (@pxref{Blacklists and
-Whitelists}), but uses the BBDB as the source of whitelisted addresses,
-without regular expressions. You must have the BBDB loaded for
-@code{spam-use-BBDB} to work properly. Only addresses in the BBDB
-will be allowed through; all others will be classified as spam.
+Whitelists}), but uses the BBDB as the source of whitelisted
+addresses, without regular expressions. You must have the BBDB loaded
+for @code{spam-use-BBDB} to work properly. Messages whose senders are
+not in the BBDB will be sent to the next spam-split rule. This is an
+explicit filter, meaning that unless someone is in the BBDB, their
+messages are not assumed to be spam or ham.
+
+@end defvar
+
+@defvar spam-use-BBDB-exclusive
+
+Set this variable to @code{t} if you want to use the BBDB as an
+implicit filter, meaning that every message will be considered spam
+unless the sender is in the BBDB. Use with care. Only sender
+addresses in the BBDB will be allowed through; all others will be
+classified as spammers.
@end defvar
@defvar gnus-group-ham-exit-processor-BBDB
+
Add this symbol to a group's @code{spam-process} parameter by
customizing the group parameters or the
@code{gnus-spam-process-newsgroups} variable. When this symbol is
ham-marked articles in @emph{ham} groups will be added to the
BBDB. Note that this ham processor has no effect in @emph{spam}
or @emph{unclassified} groups.
+
@end defvar
@node Blackholes
projects / elisp / gnus.git- / commitdiff