;;; sieve.el --- Utilities to manage sieve scripts
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
-;; This file is not part of GNU Emacs, but the same permissions apply.
+;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Release history:
;;
;; 2001-10-31 Committed to Oort Gnus.
-;;
-;; $Id: sieve.el,v 6.1 2001/11/01 00:50:22 jas Exp $
+;; 2002-07-27 Fix down-mouse-2 and down-mouse-3 in manage-mode. Fix menubar
+;; in manage-mode. Change some messages. Added sieve-deactivate*,
+;; sieve-remove. Fixed help text in manage-mode. Suggested by
+;; Ned Ludd.
;;
;; Todo:
;;
(defgroup sieve nil
"Manage sieve scripts."
+ :version "22.1"
:group 'tools)
(defcustom sieve-new-script "<new script>"
(defvar sieve-manage-buffer nil)
(defvar sieve-buffer-header-end nil)
+(defvar sieve-buffer-script-name nil
+ "The real script name of the buffer.")
+(make-local-variable 'sieve-buffer-script-name)
;; Sieve-manage mode:
(define-key sieve-manage-mode-map "f" 'sieve-edit-script)
(define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window)
(define-key sieve-manage-mode-map "r" 'sieve-remove)
- (define-key sieve-manage-mode-map [mouse-2] 'sieve-edit-script)
- (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-menu))
-
-(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
- "Mode used for sieve script management."
- (setq mode-name "SIEVE")
- (buffer-disable-undo (current-buffer))
- (setq truncate-lines t))
-
-(put 'sieve-manage-mode 'mode-class 'special)
+ (define-key sieve-manage-mode-map [(down-mouse-2)] 'sieve-edit-script)
+ (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-manage-mode-menu))
(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
"Sieve Menu."
["Activate script" sieve-activate t]
["Deactivate script" sieve-deactivate t]))
-;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
+(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE"
+ "Mode used for sieve script management."
+ (setq mode-name "SIEVE")
+ (buffer-disable-undo (current-buffer))
+ (setq truncate-lines t)
+ (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map))
+
+(put 'sieve-manage-mode 'mode-class 'special)
+
+;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
;; in substitute-command-keys.
;(fset 'sieve-manage-mode-map sieve-manage-mode-map)
(defun sieve-activate (&optional pos)
(interactive "d")
(let ((name (sieve-script-at-point)) err)
- (unless name
+ (when (or (null name) (string-equal name sieve-new-script))
(error "No sieve script at point"))
+ (message "Activating script %s..." name)
(setq err (sieve-manage-setactive name sieve-manage-buffer))
+ (sieve-refresh-scriptlist)
+ (if (sieve-manage-ok-p err)
+ (message "Activating script %s...done" name)
+ (message "Activating script %s...failed: %s" name (nth 2 err)))))
+
+(defun sieve-deactivate-all (&optional pos)
+ (interactive "d")
+ (let ((name (sieve-script-at-point)) err)
+ (message "Deactivating scripts...")
+ (setq err (sieve-manage-setactive "" sieve-manage-buffer))
+ (sieve-refresh-scriptlist)
(if (sieve-manage-ok-p err)
- (message "Script %s activated." name)
- (message "Failed to activate script %s: %s" name (nth 2 err)))
- (sieve-refresh-scriptlist)))
+ (message "Deactivating scripts...done")
+ (message "Deactivating scripts...failed: %s" (nth 2 err)))))
+
+(defalias 'sieve-deactivate 'sieve-deactivate-all)
+
+(defun sieve-remove (&optional pos)
+ (interactive "d")
+ (let ((name (sieve-script-at-point)) err)
+ (when (or (null name) (string-equal name sieve-new-script))
+ (error "No sieve script at point"))
+ (message "Removing sieve script %s..." name)
+ (setq err (sieve-manage-deletescript name sieve-manage-buffer))
+ (unless (sieve-manage-ok-p err)
+ (error "Removing sieve script %s...failed: " err))
+ (sieve-refresh-scriptlist)
+ (message "Removing sieve script %s...done" name)))
(defun sieve-edit-script (&optional pos)
(interactive "d")
(switch-to-buffer (get-buffer-create "template.siv"))
(insert sieve-template))
(sieve-mode)
+ (setq sieve-buffer-script-name name)
(message "Press C-c C-l to upload script to server.")))
+(defmacro sieve-change-region (&rest body)
+ "Turns off sieve-region before executing BODY, then re-enables it after.
+Used to bracket operations which move point in the sieve-buffer."
+ `(progn
+ (sieve-highlight nil)
+ ,@body
+ (sieve-highlight t)))
+(put 'sieve-change-region 'lisp-indent-function 0)
+
(defun sieve-next-line (&optional arg)
(interactive)
(unless arg
(if (eq last-command 'sieve-help)
;; would need minor-mode for log-edit-mode
(describe-function 'sieve-mode)
- (message (substitute-command-keys
- "`\\[sieve-help]':help `\\[cvs-mode-add]':add `\\[sieve-remove]':remove"))))
+ (message "%s" (substitute-command-keys
+ "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
(defun sieve-bury-buffer (buf &optional mainbuf)
"Hide the buffer BUF that was temporarily popped up.
(interactive "d")
(get-char-property (or pos (point)) 'script-name))
-(defmacro sieve-change-region (&rest body)
- "Turns off sieve-region before executing BODY, then re-enables it after.
-Used to bracket operations which move point in the sieve-buffer."
- `(progn
- (sieve-highlight nil)
- ,@body
- (sieve-highlight t)))
-(put 'sieve-change-region 'lisp-indent-function 0)
-
(eval-and-compile
- (defalias 'sieve-make-overlay (if (fboundp 'make-overlay)
- 'make-overlay
- 'make-extent))
- (defalias 'sieve-overlay-put (if (fboundp 'overlay-put)
- 'overlay-put
- 'set-extent-property))
- (defalias 'sieve-overlays-at (if (fboundp 'overlays-at)
- 'overlays-at
- 'extents-at)))
+ (defalias 'sieve-make-overlay (if (featurep 'xemacs)
+ 'make-extent
+ 'make-overlay))
+ (defalias 'sieve-overlay-put (if (featurep 'xemacs)
+ 'set-extent-property
+ 'overlay-put))
+ (defalias 'sieve-overlays-at (if (featurep 'xemacs)
+ 'extents-at
+ 'overlays-at)))
(defun sieve-highlight (on)
"Turn ON or off highlighting on the current language overlay."
(insert "\n"))))
(defun sieve-open-server (server &optional port)
- ;; open server
- (set (make-local-variable 'sieve-manage-buffer)
- (sieve-manage-open server))
- ;; authenticate
- (sieve-manage-authenticate nil nil sieve-manage-buffer))
+ "Open SERVER (on PORT) and authenticate."
+ (with-current-buffer
+ (or ;; open server
+ (set (make-local-variable 'sieve-manage-buffer)
+ (sieve-manage-open server))
+ (error "Error opening server %s" server))
+ (sieve-manage-authenticate)))
(defun sieve-refresh-scriptlist ()
(interactive)
;;;###autoload
(defun sieve-upload (&optional name)
(interactive)
- (unless name
- (setq name (buffer-name)))
(when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage))
(let ((script (buffer-string)) err)
(with-current-buffer (get-buffer sieve-buffer)
- (setq err (sieve-manage-putscript name script sieve-manage-buffer))
+ (setq err (sieve-manage-putscript
+ (or name sieve-buffer-script-name (buffer-name))
+ script sieve-manage-buffer))
(if (sieve-manage-ok-p err)
- (message (concat "Sieve upload done. Use `C-c RET' to manage scripts."))
+ (message (concat
+ "Sieve upload done. Use `C-c RET' to manage scripts."))
(message "Sieve upload failed: %s" (nth 2 err)))))))
+;;;###autoload
+(defun sieve-upload-and-bury (&optional name)
+ (interactive)
+ (sieve-upload name)
+ (bury-buffer))
+
(provide 'sieve)
;; sieve.el ends here
projects / gnus / blobdiff