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