cgit.sxemacs.org Git - gnus/blob - lisp/sieve.el

   1 ;;; sieve.el --- Utilities to manage sieve scripts
   2 ;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
   3
   4 ;; Author: Simon Josefsson <simon@josefsson.org>
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; This file contain utilities to facilate upload, download and
  26 ;; general management of sieve scripts.  Currently only the
  27 ;; Managesieve protocol is supported (using sieve-manage.el), but when
  28 ;; (useful) alternatives become available, they might be supported as
  29 ;; well.
  30 ;;
  31 ;; The cursor navigation was inspired by biff-mode by Franklin Lee.
  32 ;;
  33 ;; Release history:
  34 ;;
  35 ;; 2001-10-31 Committed to Oort Gnus.
  36 ;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode.  Fix menubar
  37 ;;            in manage-mode.  Change some messages.  Added sieve-deactivate*,
  38 ;;            sieve-remove.  Fixed help text in manage-mode.  Suggested by
  39 ;;            Ned Ludd.
  40 ;;
  41 ;; Todo:
  42 ;;
  43 ;; * Namespace?  This file contains `sieve-manage' and
  44 ;;   `sieve-manage-mode', but there is a sieve-manage.el file as well.
  45 ;;   Can't think of a good solution though, this file need a *-mode,
  46 ;;   and naming it `sieve-mode' would collide with sieve-mode.el.  One
  47 ;;   solution would be to come up with some better name that this file
  48 ;;   can use that doesn't have the managesieve specific "manage" in
  49 ;;   it.  sieve-dired?  i dunno.  we could copy all off sieve.el into
  50 ;;   sieve-manage.el too, but I'd like to separate the interface from
  51 ;;   the protocol implementation since the backends are likely to
  52 ;;   change (well).
  53 ;;
  54 ;; * Define servers?  We could have a customize buffer to create a server,
  55 ;;   with authentication/stream/etc parameters, much like Gnus, and then
  56 ;;   only use names of defined servers when interacting with M-x sieve-*.
  57 ;;   Right now you can't use STARTTLS, which sieve-manage.el provides
  58
  59 ;;; Code:
  60
  61 (require 'sieve-manage)
  62 (require 'sieve-mode)
  63
  64 ;; User customizable variables:
  65
  66 (defgroup sieve nil
  67   "Manage sieve scripts."
  68   :group 'tools)
  69
  70 (defcustom sieve-new-script "<new script>"
  71   "Name of name script indicator."
  72   :type 'string
  73   :group 'sieve)
  74
  75 (defcustom sieve-buffer "*sieve*"
  76   "Name of sieve management buffer."
  77   :type 'string
  78   :group 'sieve)
  79
  80 (defcustom sieve-template "\
  81 require \"fileinto\";
  82
  83 # Example script (remove comment character '#' to make it effective!):
  84 #
  85 # if header :contains \"from\" \"coyote\" {
  86 #   discard;
  87 # } elsif header :contains [\"subject\"] [\"$$$\"] {
  88 #   discard;
  89 # } else {
  90 #  fileinto \"INBOX\";
  91 # }
  92 "
  93   "Template sieve script."
  94   :type 'string
  95   :group 'sieve)
  96
  97 ;; Internal variables:
  98
  99 (defvar sieve-manage-buffer nil)
 100 (defvar sieve-buffer-header-end nil)
 101
 102 ;; Sieve-manage mode:
 103
 104 (defvar sieve-manage-mode-map nil
 105   "Keymap for `sieve-manage-mode'.")
 106
 107 (if sieve-manage-mode-map
 108     ()
 109   (setq sieve-manage-mode-map (make-sparse-keymap))
 110   (suppress-keymap sieve-manage-mode-map)
 111   ;; various
 112   (define-key sieve-manage-mode-map "?" 'sieve-help)
 113   (define-key sieve-manage-mode-map "h" 'sieve-help)
 114   (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
 115   ;; activating
 116   (define-key sieve-manage-mode-map "m" 'sieve-activate)
 117   (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
 118   (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
 119   ;; navigation keys
 120   (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
 121   (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
 122   (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
 123   (define-key sieve-manage-mode-map [down] 'sieve-next-line)
 124   (define-key sieve-manage-mode-map " " 'sieve-next-line)
 125   (define-key sieve-manage-mode-map "n" 'sieve-next-line)
 126   (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
 127   (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
 128   (define-key sieve-manage-mode-map "f" 'sieve-edit-script)
 129   (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
 130   (define-key sieve-manage-mode-map "r" 'sieve-remove)
 131   (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script)
 132   (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu))
 133
 134 (easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
 135   "Sieve Menu."
 136   '("Manage Sieve"
 137     ["Edit script" sieve-edit-script t]
 138     ["Activate script" sieve-activate t]
 139     ["Deactivate script" sieve-deactivate t]))
 140
 141 (define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
 142   "Mode used for sieve script management."
 143   (setq mode-name "SIEVE")
 144   (buffer-disable-undo (current-buffer))
 145   (setq truncate-lines t)
 146   (easy-menu-add-item nil nil sieve-manage-mode-menu))
 147
 148 (put 'sieve-manage-mode 'mode-class 'special)
 149
 150 ;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
 151 ;; in substitute-command-keys.
 152 ;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
 153
 154 ;; Commands used in sieve-manage mode:
 155
 156 (defun sieve-activate (&optional pos)
 157   (interactive "d")
 158   (let ((name (sieve-script-at-point)) err)
 159     (when (or (null name) (string-equal name sieve-new-script))
 160       (error "No sieve script at point"))
 161     (message "Activating script %s..." name)
 162     (setq err (sieve-manage-setactive name sieve-manage-buffer))
 163     (sieve-refresh-scriptlist)
 164     (if (sieve-manage-ok-p err)
 165         (message "Activating script %s...done" name)
 166       (message "Activating script %s...failed: %s" name (nth 2 err)))))
 167
 168 (defun sieve-deactivate-all (&optional pos)
 169   (interactive "d")
 170   (let ((name (sieve-script-at-point)) err)
 171     (message "Deactivating scripts...")
 172     (setq err (sieve-manage-setactive "" sieve-manage-buffer))
 173     (sieve-refresh-scriptlist)
 174     (if (sieve-manage-ok-p err)
 175         (message "Deactivating scripts...done")
 176       (message "Deactivating scripts...failed" (nth 2 err)))))
 177
 178 (defalias 'sieve-deactivate 'sieve-deactivate-all)
 179
 180 (defun sieve-remove (&optional pos)
 181   (interactive "d")
 182   (let ((name (sieve-script-at-point)) err)
 183     (when (or (null name) (string-equal name sieve-new-script))
 184       (error "No sieve script at point"))
 185     (message "Removing sieve script %s..." name)
 186     (setq err (sieve-manage-deletescript name sieve-manage-buffer))
 187     (unless (sieve-manage-ok-p err)