1 ;;; sieve.el --- Utilities to manage sieve scripts
2 ;; Copyright (C) 2001 Free Software Foundation, Inc.
4 ;; Author: Simon Josefsson <simon@josefsson.org>
6 ;; This file is not part of GNU Emacs, but the same permissions apply.
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)
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.
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.
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
31 ;; The cursor navigation was inspired by biff-mode by Franklin Lee.
35 ;; 2001-10-31 Committed to Oort Gnus.
39 ;; * Namespace? This file contains `sieve-manage' and
40 ;; `sieve-manage-mode', but there is a sieve-manage.el file as well.
41 ;; Can't think of a good solution though, this file need a *-mode,
42 ;; and naming it `sieve-mode' would collide with sieve-mode.el. One
43 ;; solution would be to come up with some better name that this file
44 ;; can use that doesn't have the managesieve specific "manage" in
45 ;; it. sieve-dired? i dunno. we could copy all off sieve.el into
46 ;; sieve-manage.el too, but I'd like to separate the interface from
47 ;; the protocol implementation since the backends are likely to
50 ;; * Define servers? We could have a customize buffer to create a server,
51 ;; with authentication/stream/etc parameters, much like Gnus, and then
52 ;; only use names of defined servers when interacting with M-x sieve-*.
53 ;; Right now you can't use STARTTLS, which sieve-manage.el provides
57 (require 'sieve-manage)
60 ;; User customizable variables:
63 "Manage sieve scripts."
66 (defcustom sieve-new-script "<new script>"
67 "Name of name script indicator."
71 (defcustom sieve-buffer "*sieve*"
72 "Name of sieve management buffer."
76 (defcustom sieve-template "\
79 # Example script (remove comment character '#' to make it effective!):
81 # if header :contains \"from\" \"coyote\" {
83 # } elsif header :contains [\"subject\"] [\"$$$\"] {
89 "Template sieve script."
93 ;; Internal variables:
95 (defvar sieve-manage-buffer nil)
96 (defvar sieve-buffer-header-end nil)
100 (defvar sieve-manage-mode-map nil
101 "Keymap for `sieve-manage-mode'.")
103 (if sieve-manage-mode-map
105 (setq sieve-manage-mode-map (make-sparse-keymap))
106 (suppress-keymap sieve-manage-mode-map)
108 (define-key sieve-manage-mode-map "?" 'sieve-help)
109 (define-key sieve-manage-mode-map "h" 'sieve-help)
110 (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
112 (define-key sieve-manage-mode-map "m" 'sieve-activate)
113 (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
114 (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
116 (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
117 (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
118 (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
119 (define-key sieve-manage-mode-map [down] 'sieve-next-line)
120 (define-key sieve-manage-mode-map " " 'sieve-next-line)
121 (define-key sieve-manage-mode-map "n" 'sieve-next-line)
122 (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
123 (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
124 (define-key sieve-manage-mode-map "f" 'sieve-edit-script)
125 (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
126 (define-key sieve-manage-mode-map "r" 'sieve-remove)
127 (define-key sieve-manage-mode-map [mouse-2] 'sieve-edit-script)
128 (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-menu))
130 (define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
131 "Mode used for sieve script management."
132 (setq mode-name "SIEVE")
133 (buffer-disable-undo (current-buffer))
134 (setq truncate-lines t))
136 (put 'sieve-manage-mode 'mode-class 'special)
138 (easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
141 ["Edit script" sieve-edit-script t]
142 ["Activate script" sieve-activate t]
143 ["Deactivate script" sieve-deactivate t]))
145 ;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
146 ;; in substitute-command-keys.
147 ;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
149 ;; Commands used in sieve-manage mode:
151 (defun sieve-activate (&optional pos)
153 (let ((name (sieve-script-at-point)) err)
155 (error "No sieve script at point"))
156 (setq err (sieve-manage-setactive name sieve-manage-buffer))
157 (if (sieve-manage-ok-p err)
158 (message "Script %s activated." name)
159 (message "Failed to activate script %s: %s" name (nth 2 err)))
160 (sieve-refresh-scriptlist)))
162 (defun sieve-edit-script (&optional pos)
164 (let ((name (sieve-script-at-point)))
166 (error "No sieve script at point"))
167 (if (not (string-equal name sieve-new-script))
168 (let ((newbuf (generate-new-buffer name))
170 (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
171 (switch-to-buffer newbuf)
172 (unless (sieve-manage-ok-p err)
173 (error "Sieve download failed: %s" err)))
174 (switch-to-buffer (get-buffer-create "template.siv"))
175 (insert sieve-template))
177 (message "Press C-c C-l to upload script to server.")))
179 (defun sieve-next-line (&optional arg)
185 (sieve-script-at-point))
188 (message "End of list")))
190 (defun sieve-prev-line (&optional arg)
196 (sieve-script-at-point))
199 (message "Beginning of list")))
202 "Display help for various sieve commands."
204 (if (eq last-command 'sieve-help)
205 ;; would need minor-mode for log-edit-mode
206 (describe-function 'sieve-mode)
207 (message (substitute-command-keys
208 "`\\[sieve-help]':help `\\[cvs-mode-add]':add `\\[sieve-remove]':remove"))))
210 (defun sieve-bury-buffer (buf &optional mainbuf)
211 "Hide the buffer BUF that was temporarily popped up.
212 BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
213 (interactive (list (current-buffer)))
215 (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
216 (get-buffer-window buf t))))
218 (if (window-dedicated-p win)
221 (error (iconify-frame (window-frame win))))
222 (if (and mainbuf (get-buffer-window mainbuf))
223 (delete-window win)))))
224 (with-current-buffer buf
225 (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
226 (not (window-dedicated-p (selected-window))))
229 (let ((mainwin (or (get-buffer-window mainbuf)
230 (get-buffer-window mainbuf 'visible))))
231 (when mainwin (select-window mainwin))))))
235 (defun sieve-setup-buffer (server port)
236 (setq buffer-read-only nil)
238 (buffer-disable-undo)
240 Server : " server ":" (or port "2000") "
243 (set (make-local-variable 'sieve-buffer-header-end)
246 (defun sieve-script-at-point (&optional pos)
247 "Return name of sieve script at point POS, or nil."
249 (get-char-property (or pos (point)) 'script-name))
251 (defmacro sieve-change-region (&rest body)
252 "Turns off sieve-region before executing BODY, then re-enables it after.
253 Used to bracket operations which move point in the sieve-buffer."
255 (sieve-highlight nil)
257 (sieve-highlight t)))
258 (put 'sieve-change-region 'lisp-indent-function 0)
261 (defalias 'sieve-make-overlay (if (fboundp 'make-overlay)
264 (defalias 'sieve-overlay-put (if (fboundp 'overlay-put)
266 'set-extent-property))
267 (defalias 'sieve-overlays-at (if (fboundp 'overlays-at)
271 (defun sieve-highlight (on)
272 "Turn ON or off highlighting on the current language overlay."
273 (sieve-overlay-put (car (sieve-overlays-at (point)))
274 'face (if on 'highlight 'default)))
276 (defun sieve-insert-scripts (scripts)
277 "Format and insert LANGUAGE-LIST strings into current buffer at point."
281 (script (pop scripts)))
283 (insert (format " ACTIVE %s" (cdr script)))
284 (insert (format " %s" script)))
285 (setq ext (sieve-make-overlay p (point)))
286 (sieve-overlay-put ext 'mouse-face 'highlight)
287 (sieve-overlay-put ext 'script-name (if (consp script)
292 (defun sieve-open-server (server &optional port)
294 (set (make-local-variable 'sieve-manage-buffer)
295 (sieve-manage-open server))
297 (sieve-manage-authenticate nil nil sieve-manage-buffer))
299 (defun sieve-refresh-scriptlist ()
301 (with-current-buffer sieve-buffer
302 (setq buffer-read-only nil)
303 (delete-region (or sieve-buffer-header-end (point-max)) (point-max))
304 (goto-char (point-max))
305 ;; get list of script names and print them
306 (let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
308 (insert (format (concat "No scripts on server, press RET on %s to "
309 "create a new script.\n") sieve-new-script))
310 (insert (format (concat "%d script%s on server, press RET on a script "
311 "name edits it, or\npress RET on %s to create "
312 "a new script.\n") (length scripts)
313 (if (eq (length scripts) 1) "" "s")
316 (sieve-insert-scripts (list sieve-new-script))
317 (sieve-insert-scripts scripts)))
319 (setq buffer-read-only t)))
322 (defun sieve-manage (server &optional port)
323 (interactive "sServer: ")
324 (switch-to-buffer (get-buffer-create sieve-buffer))
326 (sieve-setup-buffer server port)
327 (if (sieve-open-server server port)
328 (sieve-refresh-scriptlist)
329 (message "Could not open server %s" server)))
332 (defun sieve-upload (&optional name)
335 (setq name (buffer-name)))
336 (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
337 (let ((script (buffer-string)) err)
338 (with-current-buffer (get-buffer sieve-buffer)
339 (setq err (sieve-manage-putscript name script sieve-manage-buffer))
340 (if (sieve-manage-ok-p err)
341 (message (concat "Sieve upload done. Use `C-c RET' to manage scripts."))
342 (message "Sieve upload failed: %s" (nth 2 err)))))))
346 ;; sieve.el ends here