1 ;;; sieve.el --- Utilities to manage sieve scripts
3 ;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
5 ;; Author: Simon Josefsson <simon@josefsson.org>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; This file contain utilities to facilate upload, download and
25 ;; general management of sieve scripts. Currently only the
26 ;; Managesieve protocol is supported (using sieve-manage.el), but when
27 ;; (useful) alternatives become available, they might be supported as
30 ;; The cursor navigation was inspired by biff-mode by Franklin Lee.
34 ;; 2001-10-31 Committed to Oort Gnus.
35 ;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode. Fix menubar
36 ;; in manage-mode. Change some messages. Added sieve-deactivate*,
37 ;; sieve-remove. Fixed help text in manage-mode. Suggested by
42 ;; * Namespace? This file contains `sieve-manage' and
43 ;; `sieve-manage-mode', but there is a sieve-manage.el file as well.
44 ;; Can't think of a good solution though, this file need a *-mode,
45 ;; and naming it `sieve-mode' would collide with sieve-mode.el. One
46 ;; solution would be to come up with some better name that this file
47 ;; can use that doesn't have the managesieve specific "manage" in
48 ;; it. sieve-dired? i dunno. we could copy all off sieve.el into
49 ;; sieve-manage.el too, but I'd like to separate the interface from
50 ;; the protocol implementation since the backends are likely to
53 ;; * Define servers? We could have a customize buffer to create a server,
54 ;; with authentication/stream/etc parameters, much like Gnus, and then
55 ;; only use names of defined servers when interacting with M-x sieve-*.
56 ;; Right now you can't use STARTTLS, which sieve-manage.el provides
60 (require 'sieve-manage)
63 ;; User customizable variables:
66 "Manage sieve scripts."
70 (defcustom sieve-new-script "<new script>"
71 "Name of name script indicator."
75 (defcustom sieve-buffer "*sieve*"
76 "Name of sieve management buffer."
80 (defcustom sieve-template "\
83 # Example script (remove comment character '#' to make it effective!):
85 # if header :contains \"from\" \"coyote\" {
87 # } elsif header :contains [\"subject\"] [\"$$$\"] {
93 "Template sieve script."
97 ;; Internal variables:
99 (defvar sieve-manage-buffer nil)
100 (defvar sieve-buffer-header-end nil)
101 (defvar sieve-buffer-script-name nil
102 "The real script name of the buffer.")
103 (make-local-variable 'sieve-buffer-script-name)
105 ;; Sieve-manage mode:
107 (defvar sieve-manage-mode-map
108 (let ((map (make-sparse-keymap)))
110 (define-key map "?" 'sieve-help)
111 (define-key map "h" 'sieve-help)
112 (define-key map "q" 'sieve-bury-buffer)
114 (define-key map "m" 'sieve-activate)
115 (define-key map "u" 'sieve-deactivate)
116 (define-key map "\M-\C-?" 'sieve-deactivate-all)
118 (define-key map "\C-p" 'sieve-prev-line)
119 (define-key map [up] 'sieve-prev-line)
120 (define-key map "\C-n" 'sieve-next-line)
121 (define-key map [down] 'sieve-next-line)
122 (define-key map " " 'sieve-next-line)
123 (define-key map "n" 'sieve-next-line)
124 (define-key map "p" 'sieve-prev-line)
125 (define-key map "\C-m" 'sieve-edit-script)
126 (define-key map "f" 'sieve-edit-script)
127 (define-key map "o" 'sieve-edit-script-other-window)
128 (define-key map "r" 'sieve-remove)
129 (define-key map [(down-mouse-2)] 'sieve-edit-script)
130 (define-key map [(down-mouse-3)] 'sieve-manage-mode-menu)
132 "Keymap for `sieve-manage-mode'.")
134 (easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
137 ["Edit script" sieve-edit-script t]
138 ["Activate script" sieve-activate t]
139 ["Deactivate script" sieve-deactivate t]))
141 (define-derived-mode sieve-manage-mode fundamental-mode "Sieve-manage"
142 "Mode used for sieve script management."
143 (buffer-disable-undo (current-buffer))
144 (setq truncate-lines t)
145 (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map))
147 (put 'sieve-manage-mode 'mode-class 'special)
149 ;; Commands used in sieve-manage mode:
151 (defun sieve-activate (&optional pos)
153 (let ((name (sieve-script-at-point)) err)
154 (when (or (null name) (string-equal name sieve-new-script))
155 (error "No sieve script at point"))
156 (message "Activating script %s..." name)
157 (setq err (sieve-manage-setactive name sieve-manage-buffer))
158 (sieve-refresh-scriptlist)
159 (if (sieve-manage-ok-p err)
160 (message "Activating script %s...done" name)
161 (message "Activating script %s...failed: %s" name (nth 2 err)))))
163 (defun sieve-deactivate-all (&optional pos)
165 (let ((name (sieve-script-at-point)) err)
166 (message "Deactivating scripts...")
167 (setq err (sieve-manage-setactive "" sieve-manage-buffer))
168 (sieve-refresh-scriptlist)
169 (if (sieve-manage-ok-p err)
170 (message "Deactivating scripts...done")
171 (message "Deactivating scripts...failed: %s" (nth 2 err)))))
173 (defalias 'sieve-deactivate 'sieve-deactivate-all)
175 (defun sieve-remove (&optional pos)
177 (let ((name (sieve-script-at-point)) err)
178 (when (or (null name) (string-equal name sieve-new-script))
179 (error "No sieve script at point"))
180 (message "Removing sieve script %s..." name)
181 (setq err (sieve-manage-deletescript name sieve-manage-buffer))
182 (unless (sieve-manage-ok-p err)
183 (error "Removing sieve script %s...failed: " err))
184 (sieve-refresh-scriptlist)
185 (message "Removing sieve script %s...done" name)))
187 (defun sieve-edit-script (&optional pos)
189 (let ((name (sieve-script-at-point)))
191 (error "No sieve script at point"))
192 (if (not (string-equal name sieve-new-script))
193 (let ((newbuf (generate-new-buffer name))
195 (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
196 (switch-to-buffer newbuf)
197 (unless (sieve-manage-ok-p err)
198 (error "Sieve download failed: %s" err)))
199 (switch-to-buffer (get-buffer-create "template.siv"))
200 (insert sieve-template))
202 (setq sieve-buffer-script-name name)
204 (substitute-command-keys
205 "Press \\[sieve-upload] to upload script to server."))))
207 (defmacro sieve-change-region (&rest body)
208 "Turns off sieve-region before executing BODY, then re-enables it after.
209 Used to bracket operations which move point in the sieve-buffer."
211 (sieve-highlight nil)
213 (sieve-highlight t)))
214 (put 'sieve-change-region 'lisp-indent-function 0)
216 (defun sieve-next-line (&optional arg)
222 (sieve-script-at-point))
225 (message "End of list")))
227 (defun sieve-prev-line (&optional arg)
233 (sieve-script-at-point))
236 (message "Beginning of list")))
239 "Display help for various sieve commands."
241 (if (eq last-command 'sieve-help)
242 ;; would need minor-mode for log-edit-mode
243 (describe-function 'sieve-mode)
244 (message "%s" (substitute-command-keys
245 "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
247 (defun sieve-bury-buffer (buf &optional mainbuf)
248 "Hide the buffer BUF that was temporarily popped up.
249 BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
250 (interactive (list (current-buffer)))
252 (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
253 (get-buffer-window buf t))))
255 (if (window-dedicated-p win)
258 (error (iconify-frame (window-frame win))))
259 (if (and mainbuf (get-buffer-window mainbuf))
260 (delete-window win)))))
261 (with-current-buffer buf
262 (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
263 (not (window-dedicated-p (selected-window))))
266 (let ((mainwin (or (get-buffer-window mainbuf)
267 (get-buffer-window mainbuf 'visible))))
268 (when mainwin (select-window mainwin))))))
272 (defun sieve-setup-buffer (server port)
273 (setq buffer-read-only nil)
275 (buffer-disable-undo)
277 Server : " server ":" (or port "2000") "
280 (set (make-local-variable 'sieve-buffer-header-end)
283 (defun sieve-script-at-point (&optional pos)
284 "Return name of sieve script at point POS, or nil."
286 (get-char-property (or pos (point)) 'script-name))
289 (defalias 'sieve-make-overlay (if (featurep 'xemacs)
292 (defalias 'sieve-overlay-put (if (featurep 'xemacs)
295 (defalias 'sieve-overlays-at (if (featurep 'xemacs)
299 (defun sieve-highlight (on)
300 "Turn ON or off highlighting on the current language overlay."
301 (sieve-overlay-put (car (sieve-overlays-at (point)))
302 'face (if on 'highlight 'default)))
304 (defun sieve-insert-scripts (scripts)
305 "Format and insert LANGUAGE-LIST strings into current buffer at point."
309 (script (pop scripts)))
311 (insert (format " ACTIVE %s" (cdr script)))
312 (insert (format " %s" script)))
313 (setq ext (sieve-make-overlay p (point)))
314 (sieve-overlay-put ext 'mouse-face 'highlight)
315 (sieve-overlay-put ext 'script-name (if (consp script)
320 (defun sieve-open-server (server &optional port)
321 "Open SERVER (on PORT) and authenticate."
324 (set (make-local-variable 'sieve-manage-buffer)
325 (sieve-manage-open server))
326 (error "Error opening server %s" server))
327 (sieve-manage-authenticate)))
329 (defun sieve-refresh-scriptlist ()
331 (with-current-buffer sieve-buffer
332 (setq buffer-read-only nil)
333 (delete-region (or sieve-buffer-header-end (point-max)) (point-max))
334 (goto-char (point-max))
335 ;; get list of script names and print them
336 (let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
339 (substitute-command-keys
341 "No scripts on server, press \\[sieve-edit-script] on %s to create a new script.\n"
344 (substitute-command-keys
345 (format (concat "%d script%s on server, press \\[sieve-edit-script] on a script "
346 "name edits it, or\npress \\[sieve-edit-script] on %s to create "
347 "a new script.\n") (length scripts)
348 (if (eq (length scripts) 1) "" "s")
351 (sieve-insert-scripts (list sieve-new-script))
352 (sieve-insert-scripts scripts)))
354 (setq buffer-read-only t)))
357 (defun sieve-manage (server &optional port)
358 (interactive "sServer: ")
359 (switch-to-buffer (get-buffer-create sieve-buffer))
361 (sieve-setup-buffer server port)
362 (if (sieve-open-server server port)
363 (sieve-refresh-scriptlist)
364 (message "Could not open server %s" server)))
367 (defun sieve-upload (&optional name)
369 (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
370 (let ((script (buffer-string)) err)
371 (with-current-buffer (get-buffer sieve-buffer)
372 (setq err (sieve-manage-putscript
373 (or name sieve-buffer-script-name (buffer-name))
374 script sieve-manage-buffer))
375 (if (sieve-manage-ok-p err)
376 (message (substitute-command-keys
377 "Sieve upload done. Use \\[sieve-manage] to manage scripts."))
378 (message "Sieve upload failed: %s" (nth 2 err)))))))
381 (defun sieve-upload-and-bury (&optional name)
388 ;; sieve.el ends here