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: %s" (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) |
188 |
|
(error "Removing sieve script %s...failed: " err)) |
189 |
|
(sieve-refresh-scriptlist) |
190 |
|
(message "Removing sieve script %s...done" name))) |
191 |
|
|
192 |
|
(defun sieve-edit-script (&optional pos) |
193 |
|
(interactive "d") |
194 |
|
(let ((name (sieve-script-at-point))) |
195 |
|
(unless name |
196 |
|
(error "No sieve script at point")) |
197 |
|
(if (not (string-equal name sieve-new-script)) |
198 |
|
(let ((newbuf (generate-new-buffer name)) |
199 |
|
err) |
200 |
|
(setq err (sieve-manage-getscript name newbuf sieve-manage-buffer)) |
201 |
|
(switch-to-buffer newbuf) |
202 |
|
(unless (sieve-manage-ok-p err) |
203 |
|
(error "Sieve download failed: %s" err))) |
204 |
|
(switch-to-buffer (get-buffer-create "template.siv")) |
205 |
|
(insert sieve-template)) |
206 |
|
(sieve-mode) |
207 |
|
(message "Press C-c C-l to upload script to server."))) |
208 |
|
|
209 |
|
(defmacro sieve-change-region (&rest body) |
210 |
|
"Turns off sieve-region before executing BODY, then re-enables it after. |
211 |
|
Used to bracket operations which move point in the sieve-buffer." |
212 |
|
`(progn |
213 |
|
(sieve-highlight nil) |
214 |
|
,@body |
215 |
|
(sieve-highlight t))) |
216 |
|
(put 'sieve-change-region 'lisp-indent-function 0) |
217 |
|
|
218 |
|
(defun sieve-next-line (&optional arg) |
219 |
|
(interactive) |
220 |
|
(unless arg |
221 |
|
(setq arg 1)) |
222 |
|
(if (save-excursion |
223 |
|
(forward-line arg) |
224 |
|
(sieve-script-at-point)) |
225 |
|
(sieve-change-region |
226 |
|
(forward-line arg)) |
227 |
|
(message "End of list"))) |
228 |
|
|
229 |
|
(defun sieve-prev-line (&optional arg) |
230 |
|
(interactive) |
231 |
|
(unless arg |
232 |
|
(setq arg -1)) |
233 |
|
(if (save-excursion |
234 |
|
(forward-line arg) |
235 |
|
(sieve-script-at-point)) |
236 |
|
(sieve-change-region |
237 |
|
(forward-line arg)) |
238 |
|
(message "Beginning of list"))) |
239 |
|
|
240 |
|
(defun sieve-help () |
241 |
|
"Display help for various sieve commands." |
242 |
|
(interactive) |
243 |
|
(if (eq last-command 'sieve-help) |
244 |
|
;; would need minor-mode for log-edit-mode |
245 |
|
(describe-function 'sieve-mode) |
246 |
|
(message (substitute-command-keys |
247 |
|
"`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove")))) |
248 |
|
|
249 |
|
(defun sieve-bury-buffer (buf &optional mainbuf) |
250 |
|
"Hide the buffer BUF that was temporarily popped up. |
251 |
|
BUF is assumed to be a temporary buffer used from the buffer MAINBUF." |
252 |
|
(interactive (list (current-buffer))) |
253 |
|
(save-current-buffer |
254 |
|
(let ((win (if (eq buf (window-buffer (selected-window))) (selected-window) |
255 |
|
(get-buffer-window buf t)))) |
256 |
|
(when win |
257 |
|
(if (window-dedicated-p win) |
258 |
|
(condition-case () |
259 |
|
(delete-window win) |
260 |
|
(error (iconify-frame (window-frame win)))) |
261 |
|
(if (and mainbuf (get-buffer-window mainbuf)) |
262 |
|
(delete-window win))))) |
263 |
|
(with-current-buffer buf |
264 |
|
(bury-buffer (unless (and (eq buf (window-buffer (selected-window))) |
265 |
|
(not (window-dedicated-p (selected-window)))) |
266 |
|
buf))) |
267 |
|
(when mainbuf |
268 |
|
(let ((mainwin (or (get-buffer-window mainbuf) |
269 |
|
(get-buffer-window mainbuf 'visible)))) |
270 |
|
(when mainwin (select-window mainwin)))))) |
271 |
|
|
272 |
|
;; Create buffer: |
273 |
|
|
274 |
|
(defun sieve-setup-buffer (server port) |
275 |
|
(setq buffer-read-only nil) |
276 |
|
(erase-buffer) |
277 |
|
(buffer-disable-undo) |
278 |
|
(insert "\ |
279 |
|
Server : " server ":" (or port "2000") " |
280 |
|
|
281 |
|
") |
282 |
|
(set (make-local-variable 'sieve-buffer-header-end) |
283 |
|
(point-max))) |
284 |
|
|
285 |
|
(defun sieve-script-at-point (&optional pos) |
286 |
|
"Return name of sieve script at point POS, or nil." |
287 |
|
(interactive "d") |
288 |
|
(get-char-property (or pos (point)) 'script-name)) |
289 |
|
|
290 |
|
(eval-and-compile |
291 |
|
(defalias 'sieve-make-overlay (if (fboundp 'make-overlay) |
292 |
|
'make-overlay |
293 |
|
'make-extent)) |
294 |
|
(defalias 'sieve-overlay-put (if (fboundp 'overlay-put) |
295 |
|
'overlay-put |
296 |
|
'set-extent-property)) |
297 |
|
(defalias 'sieve-overlays-at (if (fboundp 'overlays-at) |
298 |
|
'overlays-at |
299 |
|
'extents-at))) |
300 |
|
|
301 |
|
(defun sieve-highlight (on) |
302 |
|
"Turn ON or off highlighting on the current language overlay." |
303 |
|
(sieve-overlay-put (car (sieve-overlays-at (point))) |
304 |
|
'face (if on 'highlight 'default))) |
305 |
|
|
306 |
|
(defun sieve-insert-scripts (scripts) |
307 |
|
"Format and insert LANGUAGE-LIST strings into current buffer at point." |
308 |
|
(while scripts |
309 |
|
(let ((p (point)) |
310 |
|
(ext nil) |
311 |
|
(script (pop scripts))) |
312 |
|
(if (consp script) |
313 |
|
(insert (format " ACTIVE %s" (cdr script))) |
314 |
|
(insert (format " %s" script))) |
315 |
|
(setq ext (sieve-make-overlay p (point))) |
316 |
|
(sieve-overlay-put ext 'mouse-face 'highlight) |
317 |
|
(sieve-overlay-put ext 'script-name (if (consp script) |
318 |
|
(cdr script) |
319 |
|
script)) |
320 |
|
(insert "\n")))) |
321 |
|
|
322 |
|
(defun sieve-open-server (server &optional port) |
323 |
|
;; open server |
324 |
|
(set (make-local-variable 'sieve-manage-buffer) |
325 |
|
(sieve-manage-open server)) |
326 |
|
;; authenticate |
327 |
|
(sieve-manage-authenticate nil nil sieve-manage-buffer)) |
328 |
|
|
329 |
|
(defun sieve-refresh-scriptlist () |
330 |
|
(interactive) |
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))) |
337 |
|
(if (null scripts) |
338 |
|
(insert (format (concat "No scripts on server, press RET on %s to " |
339 |
|
"create a new script.\n") sieve-new-script)) |
340 |
|
(insert (format (concat "%d script%s on server, press RET on a script " |
341 |
|
"name edits it, or\npress RET on %s to create " |
342 |
|
"a new script.\n") (length scripts) |
343 |
|
(if (eq (length scripts) 1) "" "s") |
344 |
|
sieve-new-script))) |
345 |
|
(save-excursion |
346 |
|
(sieve-insert-scripts (list sieve-new-script)) |
347 |
|
(sieve-insert-scripts scripts))) |
348 |
|
(sieve-highlight t) |
349 |
|
(setq buffer-read-only t))) |
350 |
|
|
351 |
|
;;;###autoload |
352 |
|
(defun sieve-manage (server &optional port) |
353 |
|
(interactive "sServer: ") |
354 |
|
(switch-to-buffer (get-buffer-create sieve-buffer)) |
355 |
|
(sieve-manage-mode) |
356 |
|
(sieve-setup-buffer server port) |
357 |
|
(if (sieve-open-server server port) |
358 |
|
(sieve-refresh-scriptlist) |
359 |
|
(message "Could not open server %s" server))) |
360 |
|
|
361 |
|
;;;###autoload |
362 |
|
(defun sieve-upload (&optional name) |
363 |
|
(interactive) |
364 |
|
(unless name |
365 |
|
(setq name (buffer-name))) |
366 |
|
(when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage)) |
367 |
|
(let ((script (buffer-string)) err) |
368 |
|
(with-current-buffer (get-buffer sieve-buffer) |
369 |
|
(setq err (sieve-manage-putscript name script sieve-manage-buffer)) |
370 |
|
(if (sieve-manage-ok-p err) |
371 |
|
(message (concat |
372 |
|
"Sieve upload done. Use `C-c RET' to manage scripts.")) |
373 |
|
(message "Sieve upload failed: %s" (nth 2 err))))))) |
374 |
|
|
375 |
|
;;;###autoload |
376 |
|
(defun sieve-upload-and-bury (&optional name) |
377 |
|
(interactive) |
378 |
|
(sieve-upload name) |
379 |
|
(bury-buffer)) |
380 |
|
|
381 |
|
(provide 'sieve) |
382 |
|
|
383 |
|
;;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94 |
384 |
|
;; sieve.el ends here |