1;;; sieve.el --- Utilities to manage sieve scripts
2
3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5;; Author: Simon Josefsson <simon@josefsson.org>
6
7;; This file is part of GNU Emacs.
8
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 2, or (at your option)
12;; any later version.
13
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.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING.  If not, write to the
21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
23
24;;; Commentary:
25
26;; This file contain utilities to facilate upload, download and
27;; general management of sieve scripts.  Currently only the
28;; Managesieve protocol is supported (using sieve-manage.el), but when
29;; (useful) alternatives become available, they might be supported as
30;; well.
31;;
32;; The cursor navigation was inspired by biff-mode by Franklin Lee.
33;;
34;; Release history:
35;;
36;; 2001-10-31 Committed to Oort Gnus.
37;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode.  Fix menubar
38;;            in manage-mode.  Change some messages.  Added sieve-deactivate*,
39;;            sieve-remove.  Fixed help text in manage-mode.  Suggested by
40;;            Ned Ludd.
41;;
42;; Todo:
43;;
44;; * Namespace?  This file contains `sieve-manage' and
45;;   `sieve-manage-mode', but there is a sieve-manage.el file as well.
46;;   Can't think of a good solution though, this file need a *-mode,
47;;   and naming it `sieve-mode' would collide with sieve-mode.el.  One
48;;   solution would be to come up with some better name that this file
49;;   can use that doesn't have the managesieve specific "manage" in
50;;   it.  sieve-dired?  i dunno.  we could copy all off sieve.el into
51;;   sieve-manage.el too, but I'd like to separate the interface from
52;;   the protocol implementation since the backends are likely to
53;;   change (well).
54;;
55;; * Define servers?  We could have a customize buffer to create a server,
56;;   with authentication/stream/etc parameters, much like Gnus, and then
57;;   only use names of defined servers when interacting with M-x sieve-*.
58;;   Right now you can't use STARTTLS, which sieve-manage.el provides
59
60;;; Code:
61
62(require 'sieve-manage)
63(require 'sieve-mode)
64
65;; User customizable variables:
66
67(defgroup sieve nil
68  "Manage sieve scripts."
69  :version "22.1"
70  :group 'tools)
71
72(defcustom sieve-new-script "<new script>"
73  "Name of name script indicator."
74  :type 'string
75  :group 'sieve)
76
77(defcustom sieve-buffer "*sieve*"
78  "Name of sieve management buffer."
79  :type 'string
80  :group 'sieve)
81
82(defcustom sieve-template "\
83require \"fileinto\";
84
85# Example script (remove comment character '#' to make it effective!):
86#
87# if header :contains \"from\" \"coyote\" {
88#   discard;
89# } elsif header :contains [\"subject\"] [\"$$$\"] {
90#   discard;
91# } else {
92#  fileinto \"INBOX\";
93# }
94"
95  "Template sieve script."
96  :type 'string
97  :group 'sieve)
98
99;; Internal variables:
100
101(defvar sieve-manage-buffer nil)
102(defvar sieve-buffer-header-end nil)
103
104;; Sieve-manage mode:
105
106(defvar sieve-manage-mode-map nil
107  "Keymap for `sieve-manage-mode'.")
108
109(if sieve-manage-mode-map
110    ()
111  (setq sieve-manage-mode-map (make-sparse-keymap))
112  (suppress-keymap sieve-manage-mode-map)
113  ;; various
114  (define-key sieve-manage-mode-map "?" 'sieve-help)
115  (define-key sieve-manage-mode-map "h" 'sieve-help)
116  (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
117  ;; activating
118  (define-key sieve-manage-mode-map "m" 'sieve-activate)
119  (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
120  (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
121  ;; navigation keys
122  (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
123  (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
124  (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
125  (define-key sieve-manage-mode-map [down] 'sieve-next-line)
126  (define-key sieve-manage-mode-map " " 'sieve-next-line)
127  (define-key sieve-manage-mode-map "n" 'sieve-next-line)
128  (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
129  (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
130  (define-key sieve-manage-mode-map "f" 'sieve-edit-script)
131  (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
132  (define-key sieve-manage-mode-map "r" 'sieve-remove)
133  (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script)
134  (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu))
135
136(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
137  "Sieve Menu."
138  '("Manage Sieve"
139    ["Edit script" sieve-edit-script t]
140    ["Activate script" sieve-activate t]
141    ["Deactivate script" sieve-deactivate t]))
142
143(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
144  "Mode used for sieve script management."
145  (setq mode-name "SIEVE")
146  (buffer-disable-undo (current-buffer))
147  (setq truncate-lines t)
148  (easy-menu-add-item nil nil sieve-manage-mode-menu))
149
150(put 'sieve-manage-mode 'mode-class 'special)
151
152;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
153;; in substitute-command-keys.
154;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
155
156;; Commands used in sieve-manage mode:
157
158(defun sieve-activate (&optional pos)
159  (interactive "d")
160  (let ((name (sieve-script-at-point)) err)
161    (when (or (null name) (string-equal name sieve-new-script))
162      (error "No sieve script at point"))
163    (message "Activating script %s..." name)
164    (setq err (sieve-manage-setactive name sieve-manage-buffer))
165    (sieve-refresh-scriptlist)
166    (if (sieve-manage-ok-p err)
167	(message "Activating script %s...done" name)
168      (message "Activating script %s...failed: %s" name (nth 2 err)))))
169
170(defun sieve-deactivate-all (&optional pos)
171  (interactive "d")
172  (let ((name (sieve-script-at-point)) err)
173    (message "Deactivating scripts...")
174    (setq err (sieve-manage-setactive "" sieve-manage-buffer))
175    (sieve-refresh-scriptlist)
176    (if (sieve-manage-ok-p err)
177	(message "Deactivating scripts...done")
178      (message "Deactivating scripts...failed: %s" (nth 2 err)))))
179
180(defalias 'sieve-deactivate 'sieve-deactivate-all)
181
182(defun sieve-remove (&optional pos)
183  (interactive "d")
184  (let ((name (sieve-script-at-point)) err)
185    (when (or (null name) (string-equal name sieve-new-script))
186      (error "No sieve script at point"))
187    (message "Removing sieve script %s..." name)
188    (setq err (sieve-manage-deletescript name sieve-manage-buffer))
189    (unless (sieve-manage-ok-p err)
190      (error "Removing sieve script %s...failed: " err))
191    (sieve-refresh-scriptlist)
192    (message "Removing sieve script %s...done" name)))
193
194(defun sieve-edit-script (&optional pos)
195  (interactive "d")
196  (let ((name (sieve-script-at-point)))
197    (unless name
198      (error "No sieve script at point"))
199    (if (not (string-equal name sieve-new-script))
200	(let ((newbuf (generate-new-buffer name))
201	      err)
202	  (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer))
203	  (switch-to-buffer newbuf)
204	  (unless (sieve-manage-ok-p err)
205	    (error "Sieve download failed: %s" err)))
206      (switch-to-buffer (get-buffer-create "template.siv"))
207      (insert sieve-template))
208    (sieve-mode)
209    (message "Press C-c C-l to upload script to server.")))
210
211(defmacro sieve-change-region (&rest body)
212  "Turns off sieve-region before executing BODY, then re-enables it after.
213Used to bracket operations which move point in the sieve-buffer."
214  `(progn
215     (sieve-highlight nil)
216     ,@body
217     (sieve-highlight t)))
218(put 'sieve-change-region 'lisp-indent-function 0)
219
220(defun sieve-next-line (&optional arg)
221  (interactive)
222  (unless arg
223    (setq arg 1))
224  (if (save-excursion
225	(forward-line arg)
226	(sieve-script-at-point))
227      (sieve-change-region
228	(forward-line arg))
229    (message "End of list")))
230
231(defun sieve-prev-line (&optional arg)
232  (interactive)
233  (unless arg
234    (setq arg -1))
235  (if (save-excursion
236	(forward-line arg)
237	(sieve-script-at-point))
238      (sieve-change-region
239	(forward-line arg))
240    (message "Beginning of list")))
241
242(defun sieve-help ()
243  "Display help for various sieve commands."
244  (interactive)
245  (if (eq last-command 'sieve-help)
246      ;; would need minor-mode for log-edit-mode
247      (describe-function 'sieve-mode)
248    (message "%s" (substitute-command-keys
249	      "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
250
251(defun sieve-bury-buffer (buf &optional mainbuf)
252  "Hide the buffer BUF that was temporarily popped up.
253BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
254  (interactive (list (current-buffer)))
255  (save-current-buffer
256    (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
257		 (get-buffer-window buf t))))
258      (when win
259	(if (window-dedicated-p win)
260	    (condition-case ()
261		(delete-window win)
262	      (error (iconify-frame (window-frame win))))
263	  (if (and mainbuf (get-buffer-window mainbuf))
264	      (delete-window win)))))
265    (with-current-buffer buf
266      (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
267				(not (window-dedicated-p (selected-window))))
268		     buf)))
269    (when mainbuf
270      (let ((mainwin (or (get-buffer-window mainbuf)
271			 (get-buffer-window mainbuf 'visible))))
272	(when mainwin (select-window mainwin))))))
273
274;; Create buffer:
275
276(defun sieve-setup-buffer (server port)
277  (setq buffer-read-only nil)
278  (erase-buffer)
279  (buffer-disable-undo)
280  (insert "\
281Server  : " server ":" (or port "2000") "
282
283")
284  (set (make-local-variable 'sieve-buffer-header-end)
285       (point-max)))
286
287(defun sieve-script-at-point (&optional pos)
288  "Return name of sieve script at point POS, or nil."
289  (interactive "d")
290  (get-char-property (or pos (point)) 'script-name))
291
292(eval-and-compile
293  (defalias 'sieve-make-overlay (if (fboundp 'make-overlay)
294				    'make-overlay
295				  'make-extent))
296  (defalias 'sieve-overlay-put (if (fboundp 'overlay-put)
297				   'overlay-put
298				 'set-extent-property))
299  (defalias 'sieve-overlays-at (if (fboundp 'overlays-at)
300				   'overlays-at
301				 'extents-at)))
302
303(defun sieve-highlight (on)
304  "Turn ON or off highlighting on the current language overlay."
305  (sieve-overlay-put (car (sieve-overlays-at (point)))
306		     'face (if on 'highlight 'default)))
307
308(defun sieve-insert-scripts (scripts)
309  "Format and insert LANGUAGE-LIST strings into current buffer at point."
310  (while scripts
311    (let ((p (point))
312	  (ext nil)
313	  (script (pop scripts)))
314      (if (consp script)
315	  (insert (format " ACTIVE %s" (cdr script)))
316	(insert (format "        %s" script)))
317      (setq ext (sieve-make-overlay p (point)))
318      (sieve-overlay-put ext 'mouse-face 'highlight)
319      (sieve-overlay-put ext 'script-name (if (consp script)
320					      (cdr script)
321					    script))
322      (insert "\n"))))
323
324(defun sieve-open-server (server &optional port)
325  ;; open server
326  (set (make-local-variable 'sieve-manage-buffer)
327       (sieve-manage-open server))
328  ;; authenticate
329  (sieve-manage-authenticate nil nil sieve-manage-buffer))
330
331(defun sieve-refresh-scriptlist ()
332  (interactive)
333  (with-current-buffer sieve-buffer
334    (setq buffer-read-only nil)
335    (delete-region (or sieve-buffer-header-end (point-max)) (point-max))
336    (goto-char (point-max))
337    ;; get list of script names and print them
338    (let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
339      (if (null scripts)
340	  (insert (format (concat "No scripts on server, press RET on %s to "
341				  "create a new script.\n") sieve-new-script))
342	(insert (format (concat "%d script%s on server, press RET on a script "
343				"name edits it, or\npress RET on %s to create "
344				"a new script.\n") (length scripts)
345				(if (eq (length scripts) 1) "" "s")
346				sieve-new-script)))
347      (save-excursion
348	(sieve-insert-scripts (list sieve-new-script))
349	(sieve-insert-scripts scripts)))
350    (sieve-highlight t)
351    (setq buffer-read-only t)))
352
353;;;###autoload
354(defun sieve-manage (server &optional port)
355  (interactive "sServer: ")
356  (switch-to-buffer (get-buffer-create sieve-buffer))
357  (sieve-manage-mode)
358  (sieve-setup-buffer server port)
359  (if (sieve-open-server server port)
360      (sieve-refresh-scriptlist)
361    (message "Could not open server %s" server)))
362
363;;;###autoload
364(defun sieve-upload (&optional name)
365  (interactive)
366  (unless name
367    (setq name (buffer-name)))
368  (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
369    (let ((script (buffer-string)) err)
370      (with-current-buffer (get-buffer sieve-buffer)
371	(setq err (sieve-manage-putscript name script sieve-manage-buffer))
372	(if (sieve-manage-ok-p err)
373	    (message (concat
374		      "Sieve upload done.  Use `C-c RET' to manage scripts."))
375	  (message "Sieve upload failed: %s" (nth 2 err)))))))
376
377;;;###autoload
378(defun sieve-upload-and-bury (&optional name)
379  (interactive)
380  (sieve-upload name)
381  (bury-buffer))
382
383(provide 'sieve)
384
385;;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94
386;; sieve.el ends here
387