Mercurial > emacs
view lisp/gnus/gnus-sieve.el @ 68129:6f5da26b0df1
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-690
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 174-181)
- Update from CVS
- Update from CVS: texi/gnus.texi (RSS): Addition.
2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable.
(nnrss-request-article): Render text/plain parts as HTML.
* lisp/gnus/gnus-art.el (gnus-article-wash-html-with-w3m): No need to narrow
the buffer.
2006-01-08 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-cus.el (gnus-group-parameters): Sync posting-style with
custom definition of `gnus-posting-styles'.
* lisp/gnus/gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind
print-circle. Suggested by Kalle Olavi Niemitalo <kon@iki.fi>.
2006-01-05 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-group.el (gnus-useful-groups): Use Gmane for ding. Use
nntp for bug archive.
2006-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-request-article): Fix the way to fill text/plain
parts.
(nnrss-normalize-date): New function converts ISO 8601 date into
RFC822 style. Suggested by Mark Plaksin <happy@mcplaksin.org>.
(nnrss-check-group): Use it.
2006-01-03 Rodrigo Ventura <yoda@isr.ist.utl.pt> (tiny change)
* lisp/gnus/gnus-xmas.el (gnus-xmas-group-startup-message): Typo
gnus-splash-face -> gnus-splash. Fixes starting from a TTY in
XEmacs.
2006-01-01 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-sum.el (gnus-summary-work-articles): Remove useless `min'.
* lisp/gnus/nnrss.el (nnrss-fetch): Make it fail gracefully when it can't
fetch a feed. Suggested by Mark Plaksin <happy@mcplaksin.org>.
(nnrss-insert-w3): Ditto.
2005-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-request-article): Fix last change; fill
text/plain parts.
2005-12-20 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnrss.el (nnrss-request-article): Replace <br />s with newlines
in text/plain part.
(nnrss-check-group): Don't add excessive newline to dc:subject.
2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/gnus-art.el (gnus-article-delete-text-of-type): Enable it to
remove MIME buttons associated with multipart/alternative parts.
(gnus-mime-display-alternative): Tag buttons using `article-type'
text property.
* lisp/gnus/gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons
associated with multipart/alternative parts.
2005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change)
* lisp/gnus/nnrss.el (nnrss-check-group): Put the RSS dc:subject in the
article.
2005-12-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
* lisp/gnus/dns.el (query-dns): Make sure we check the buffer size before
removing tcp headers.
2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (RSS): Document nnrss-wash-html-in-text-plain-parts.
2006-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (RSS): Addition.
2005-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Summary Post Commands): Fix function bound to `S O p'.
2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
* man/emacs-mime.texi (Display Customization): Add setting example to
mm-discouraged-alternatives.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 11 Jan 2006 02:03:24 +0000 |
parents | fafd692d1e40 |
children | 1077b8039c32 |
line wrap: on
line source
;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus ;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: NAGY Andras <nagya@inf.elte.hu>, ;; Simon Josefsson <simon@josefsson.org> ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Gnus glue to generate complete Sieve scripts from Gnus Group ;; Parameters with "if" test predicates. ;;; Code: (require 'gnus) (require 'gnus-sum) (require 'format-spec) (autoload 'sieve-mode "sieve-mode") (eval-when-compile (require 'sieve)) ;; Variables (defgroup gnus-sieve nil "Manage sieve scripts in Gnus." :group 'gnus) (defcustom gnus-sieve-file "~/.sieve" "Path to your Sieve script." :type 'file :group 'gnus-sieve) (defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n" "Line indicating the start of the autogenerated region in your Sieve script." :type 'string :group 'gnus-sieve) (defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n" "Line indicating the end of the autogenerated region in your Sieve script." :type 'string :group 'gnus-sieve) (defcustom gnus-sieve-select-method nil "Which select method we generate the Sieve script for. For example: \"nnimap:mailbox\"" :group 'gnus-sieve) (defcustom gnus-sieve-crosspost t "Whether the generated Sieve script should do crossposting." :type 'boolean :group 'gnus-sieve) (defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s" "Shell command to execute after updating your Sieve script. The following formatting characters are recognized: %f Script's file name (gnus-sieve-file) %s Server name (from gnus-sieve-select-method)" :type 'string :group 'gnus-sieve) ;;;###autoload (defun gnus-sieve-update () "Update the Sieve script in gnus-sieve-file, by replacing the region between gnus-sieve-region-start and gnus-sieve-region-end with \(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then execute gnus-sieve-update-shell-command. See the documentation for these variables and functions for details." (interactive) (gnus-sieve-generate) (save-buffer) (shell-command (format-spec gnus-sieve-update-shell-command (format-spec-make ?f gnus-sieve-file ?s (or (cadr (gnus-server-get-method nil gnus-sieve-select-method)) ""))))) ;;;###autoload (defun gnus-sieve-generate () "Generate the Sieve script in gnus-sieve-file, by replacing the region between gnus-sieve-region-start and gnus-sieve-region-end with \(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\). See the documentation for these variables and functions for details." (interactive) (require 'sieve) (find-file gnus-sieve-file) (goto-char (point-min)) (if (re-search-forward (regexp-quote gnus-sieve-region-start) nil t) (delete-region (match-end 0) (or (re-search-forward (regexp-quote gnus-sieve-region-end) nil t) (point))) (insert sieve-template)) (insert gnus-sieve-region-start (gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost) gnus-sieve-region-end)) (defun gnus-sieve-guess-rule-for-article () "Guess a sieve rule based on RFC822 article in buffer. Return nil if no rule could be guessed." (when (message-fetch-field "sender") `(sieve address "sender" ,(message-fetch-field "sender")))) ;;;###autoload (defun gnus-sieve-article-add-rule () (interactive) (gnus-summary-select-article nil 'force) (with-current-buffer gnus-original-article-buffer (let ((rule (gnus-sieve-guess-rule-for-article)) (info (gnus-get-info gnus-newsgroup-name))) (if (null rule) (error "Could not guess rule for article") (gnus-info-set-params info (cons rule (gnus-info-params info))) (message "Added rule in group %s for article: %s" gnus-newsgroup-name rule))))) ;; Internals ;; FIXME: do proper quoting of " etc (defun gnus-sieve-string-list (list) "Convert an elisp string list to a Sieve string list. For example: \(gnus-sieve-string-list '(\"to\" \"cc\")) => \"[\\\"to\\\", \\\"cc\\\"]\" " (concat "[\"" (mapconcat 'identity list "\", \"") "\"]")) (defun gnus-sieve-test-list (list) "Convert an elisp test list to a Sieve test list. For example: \(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K))) => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\"" (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")")) ;; FIXME: do proper quoting (defun gnus-sieve-test-token (token) "Convert an elisp test token to a Sieve test token. For example: \(gnus-sieve-test-token 'address) => \"address\" \(gnus-sieve-test-token \"sender\") => \"\\\"sender\\\"\" \(gnus-sieve-test-token '(\"to\" \"cc\")) => \"[\\\"to\\\", \\\"cc\\\"]\"" (cond ((symbolp token) ;; Keyword (symbol-name token)) ((stringp token) ;; String (concat "\"" token "\"")) ((and (listp token) ;; String list (stringp (car token))) (gnus-sieve-string-list token)) ((and (listp token) ;; Test list (listp (car token))) (gnus-sieve-test-list token)))) (defun gnus-sieve-test (test) "Convert an elisp test to a Sieve test. For example: \(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\")) => \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\" \(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\") (size :over 100K)))) => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\", size :over 100K)\"" (mapconcat 'gnus-sieve-test-token test " ")) (defun gnus-sieve-script (&optional method crosspost) "Generate a Sieve script based on groups with select method METHOD \(or all groups if nil\). Only groups having a `sieve' parameter are considered. This parameter should contain an elisp test \(see the documentation of gnus-sieve-test for details\). For each such group, a Sieve IF control structure is generated, having the test as the condition and { fileinto \"group.name\"; } as the body. If CROSSPOST is nil, each conditional body contains a \"stop\" command which stops execution after a match is found. For example: If the INBOX.list.sieve group has the (sieve address \"sender\" \"sieve-admin@extundo.com\") group parameter, (gnus-sieve-script) results in: if address \"sender\" \"sieve-admin@extundo.com\" { fileinto \"INBOX.list.sieve\"; } This is returned as a string." (let* ((newsrc (cdr gnus-newsrc-alist)) script) (dolist (info newsrc) (when (or (not method) (gnus-server-equal method (gnus-info-method info))) (let* ((group (gnus-info-group info)) (spec (gnus-group-find-parameter group 'sieve t))) (when spec (push (concat "if " (gnus-sieve-test spec) " {\n" "\tfileinto \"" (gnus-group-real-name group) "\";\n" (if crosspost "" "\tstop;\n") "}") script))))) (mapconcat 'identity script "\n"))) (provide 'gnus-sieve) ;;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3 ;;; gnus-sieve.el ends here