emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-sieve.el [emacs-unicode-2]


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-sieve.el [emacs-unicode-2]
Date: Thu, 09 Sep 2004 08:13:47 -0400

Index: emacs/lisp/gnus/gnus-sieve.el
diff -c /dev/null emacs/lisp/gnus/gnus-sieve.el:1.2.2.1
*** /dev/null   Thu Sep  9 09:37:47 2004
--- emacs/lisp/gnus/gnus-sieve.el       Thu Sep  9 09:36:25 2004
***************
*** 0 ****
--- 1,240 ----
+ ;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
+ ;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+ 
+ ;; Author: NAGY Andras <address@hidden>,
+ ;;    Simon Josefsson <address@hidden>
+ 
+ ;; 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:
+ 
+ ;; 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\" \"address@hidden") (size :over 
4K)))
+   => \"(address \\\"sender\\\" \\\"address@hidden", 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\" \"address@hidden"))
+   => \"address \\\"sender\\\" \\\"address@hidden"\"
+ 
+ \(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") 
\"address@hidden")
+                         (size :over 100K))))
+   => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"address@hidden",
+            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\" \"address@hidden")
+ 
+ group parameter, (gnus-sieve-script) results in:
+ 
+   if address \"sender\" \"address@hidden" {
+           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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]