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

   1 ;;; sieve.el --- Utilities to manage sieve scripts
   2 ;; Copyright (C) 2001 Free Software Foundation, Inc.
   3
   4 ;; Author: Simon Josefsson <simon@josefsson.org>
   5
   6 ;; This file is not part of GNU Emacs, but the same permissions apply.
   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 ;;
  37 ;; $Id: sieve.el,v 6.2 2001/11/01 09:45:57 jas Exp $
  38 ;;
  39 ;; Todo:
  40 ;;
  41 ;; * Namespace?  This file contains `sieve-manage' and
  42 ;;   `sieve-manage-mode', but there is a sieve-manage.el file as well.
  43 ;;   Can't think of a good solution though, this file need a *-mode,
  44 ;;   and naming it `sieve-mode' would collide with sieve-mode.el.  One
  45 ;;   solution would be to come up with some better name that this file
  46 ;;   can use that doesn't have the managesieve specific "manage" in
  47 ;;   it.  sieve-dired?  i dunno.  we could copy all off sieve.el into
  48 ;;   sieve-manage.el too, but I'd like to separate the interface from
  49 ;;   the protocol implementation since the backends are likely to
  50 ;;   change (well).
  51 ;;
  52 ;; * Define servers?  We could have a customize buffer to create a server,
  53 ;;   with authentication/stream/etc parameters, much like Gnus, and then
  54 ;;   only use names of defined servers when interacting with M-x sieve-*.
  55 ;;   Right now you can't use STARTTLS, which sieve-manage.el provides
  56
  57 ;;; Code:
  58
  59 (require 'sieve-manage)
  60 (require 'sieve-mode)
  61
  62 ;; User customizable variables:
  63
  64 (defgroup sieve nil
  65   "Manage sieve scripts."
  66   :group 'tools)
  67
  68 (defcustom sieve-new-script "<new script>"
  69   "Name of name script indicator."
  70   :type 'string
  71   :group 'sieve)
  72
  73 (defcustom sieve-buffer "*sieve*"
  74   "Name of sieve management buffer."
  75   :type 'string
  76   :group 'sieve)
  77
  78 (defcustom sieve-template "\
  79 require \"fileinto\";
  80
  81 # Example script (remove comment character '#' to make it effective!):
  82 #
  83 # if header :contains \"from\" \"coyote\" {
  84 #   discard;
  85 # } elsif header :contains [\"subject\"] [\"$$$\"] {
  86 #   discard;
  87 # } else {
  88 #  fileinto \"INBOX\";
  89 # }
  90 "
  91   "Template sieve script."
  92   :type 'string
  93   :group 'sieve)
  94
  95 ;; Internal variables:
  96
  97 (defvar sieve-manage-buffer nil)
  98 (defvar sieve-buffer-header-end nil)
  99
 100 ;; Sieve-manage mode:
 101
 102 (defvar sieve-manage-mode-map nil
 103   "Keymap for `sieve-manage-mode'.")
 104
 105 (if sieve-manage-mode-map
 106     ()
 107   (setq sieve-manage-mode-map (make-sparse-keymap))
 108   (suppress-keymap sieve-manage-mode-map)
 109   ;; various
 110   (define-key sieve-manage-mode-map "?" 'sieve-help)
 111   (define-key sieve-manage-mode-map "h" 'sieve-help)
 112   (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
 113   ;; activating
 114   (define-key sieve-manage-mode-map "m" 'sieve-activate)
 115   (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
 116   (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
 117   ;; navigation keys
 118   (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
 119   (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
 120   (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
 121   (define-key sieve-manage-mode-map [down] 'sieve-next-line)
 122   (define-key sieve-manage-mode-map " " 'sieve-next-line)
 123   (define-key sieve-manage-mode-map "n" 'sieve-next-line)
 124   (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
 125   (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
 126   (define-key sieve-manage-mode-map "f" 'sieve-edit-script)
 127   (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
 128   (define-key sieve-manage-mode-map "r" 'sieve-remove)
 129   (define-key sieve-manage-mode-map [mouse-2] 'sieve-edit-script)
 130   (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-menu))
 131
 132 (define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
 133   "Mode used for sieve script management."
 134   (setq mode-name "SIEVE")
 135   (buffer-disable-undo (current-buffer))
 136   (setq truncate-lines t))
 137
 138 (put 'sieve-manage-mode 'mode-class 'special)
 139
 140 (easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
 141   "Sieve Menu."
 142   '("Manage Sieve"
 143     ["Edit script" sieve-edit-script t]
 144     ["Activate script" sieve-activate t]
 145     ["Deactivate script" sieve-deactivate t]))
 146
 147 ;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
 148 ;; in substitute-command-keys.
 149 ;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
 150
 151 ;; Commands used in sieve-manage mode:
 152
 153 (defun sieve-activate (&optional pos)
 154   (interactive "d")
 155   (let ((name (sieve-script-at-point)) err)
 156     (unless name
 157       (error "No sieve script at point"))
 158     (setq err (sieve-manage-setactive name sieve-manage-buffer))
 159     (if (sieve-manage-ok-p err)
 160         (message "Script %s activated." name)
 161       (message "Failed to activate script %s: %s" name (nth 2 err)))
 162     (sieve-refresh-scriptlist)))
 163
 164 (defun sieve-edit-script (&optional pos)
 165   (interactive "d")
 166   (let ((name (sieve-script-at-point)))
 167     (unless name
 168       (error "No sieve script at point"))
 169     (if (not (string-equal name sieve-new-script))
 170         (let ((newbuf (generate-new-buffer name))
 171               err)
 172           (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
 173           (switch-to-buffer newbuf)
 174           (unless (sieve-manage-ok-p err)
 175             (error "Sieve download failed: %s" err)))
 176       (switch-to-buffer (get-buffer-create "template.siv"))
 177       (insert sieve-template))
 178     (sieve-mode)
 179     (message "Press C-c C-l to upload script to server.")))
 180
 181 (defun sieve-next-line (&optional arg)
 182   (interactive)
 183   (unless arg
 184     (setq arg 1))
 185   (if (save-excursion
 186         (forward-line arg)
 187         (sieve-script-at-point))
 188       (sieve-change-region
 189         (forward-line arg))