;;; sieve.el --- Utilities to manage sieve scripts
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Copyright (C) 2001-2015 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:
-;; This file contain utilities to facilate upload, download and
+;; This file contain utilities to facilitate upload, download and
;; general management of sieve scripts. Currently only the
;; Managesieve protocol is supported (using sieve-manage.el), but when
;; (useful) alternatives become available, they might be supported as
;; Release history:
;;
;; 2001-10-31 Committed to Oort Gnus.
-;;
-;; $Id: sieve.el,v 6.2 2001/11/01 09:45:57 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:
-(defvar sieve-manage-mode-map nil
+(defvar sieve-manage-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; various
+ (define-key map "?" 'sieve-help)
+ (define-key map "h" 'sieve-help)
+ ;; activating
+ (define-key map "m" 'sieve-activate)
+ (define-key map "u" 'sieve-deactivate)
+ (define-key map "\M-\C-?" 'sieve-deactivate-all)
+ ;; navigation keys
+ (define-key map "\C-p" 'sieve-prev-line)
+ (define-key map [up] 'sieve-prev-line)
+ (define-key map "\C-n" 'sieve-next-line)
+ (define-key map [down] 'sieve-next-line)
+ (define-key map " " 'sieve-next-line)
+ (define-key map "n" 'sieve-next-line)
+ (define-key map "p" 'sieve-prev-line)
+ (define-key map "\C-m" 'sieve-edit-script)
+ (define-key map "f" 'sieve-edit-script)
+ (define-key map "o" 'sieve-edit-script-other-window)
+ (define-key map "r" 'sieve-remove)
+ (define-key map "q" 'sieve-bury-buffer)
+ (define-key map "Q" 'sieve-manage-quit)
+ (define-key map [(down-mouse-2)] 'sieve-edit-script)
+ (define-key map [(down-mouse-3)] 'sieve-manage-mode-menu)
+ map)
"Keymap for `sieve-manage-mode'.")
-(if sieve-manage-mode-map
- ()
- (setq sieve-manage-mode-map (make-sparse-keymap))
- (suppress-keymap sieve-manage-mode-map)
- ;; various
- (define-key sieve-manage-mode-map "?" 'sieve-help)
- (define-key sieve-manage-mode-map "h" 'sieve-help)
- (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer)
- ;; activating
- (define-key sieve-manage-mode-map "m" 'sieve-activate)
- (define-key sieve-manage-mode-map "u" 'sieve-deactivate)
- (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all)
- ;; navigation keys
- (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line)
- (define-key sieve-manage-mode-map [up] 'sieve-prev-line)
- (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line)
- (define-key sieve-manage-mode-map [down] 'sieve-next-line)
- (define-key sieve-manage-mode-map " " 'sieve-next-line)
- (define-key sieve-manage-mode-map "n" 'sieve-next-line)
- (define-key sieve-manage-mode-map "p" 'sieve-prev-line)
- (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script)
- (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)
-
(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
"Sieve Menu."
'("Manage Sieve"
["Activate script" sieve-activate t]
["Deactivate script" sieve-deactivate t]))
-;; 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)
+(define-derived-mode sieve-manage-mode fundamental-mode "Sieve-manage"
+ "Mode used for sieve script management."
+ (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)
;; Commands used in sieve-manage mode:
+(defun sieve-manage-quit ()
+ "Quit Manage Sieve and close the connection."
+ (interactive)
+ (sieve-manage-close sieve-manage-buffer)
+ (kill-buffer sieve-manage-buffer)
+ (kill-buffer (current-buffer)))
+
+(defun sieve-bury-buffer ()
+ "Bury the Manage Sieve buffer without closing the connection."
+ (interactive)
+ (bury-buffer))
+
(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)
- (message "Press C-c C-l to upload script to server.")))
+ (setq sieve-buffer-script-name name)
+ (goto-char (point-min))
+ (message
+ (substitute-command-keys
+ "Press \\[sieve-upload] 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)
(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"))))
-
-(defun sieve-bury-buffer (buf &optional mainbuf)
- "Hide the buffer BUF that was temporarily popped up.
-BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
- (interactive (list (current-buffer)))
- (save-current-buffer
- (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window)
- (get-buffer-window buf t))))
- (when win
- (if (window-dedicated-p win)
- (condition-case ()
- (delete-window win)
- (error (iconify-frame (window-frame win))))
- (if (and mainbuf (get-buffer-window mainbuf))
- (delete-window win)))))
- (with-current-buffer buf
- (bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
- (not (window-dedicated-p (selected-window))))
- buf)))
- (when mainbuf
- (let ((mainwin (or (get-buffer-window mainbuf)
- (get-buffer-window mainbuf 'visible))))
- (when mainwin (select-window mainwin))))))
+ (message "%s" (substitute-command-keys
+ "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove"))))
;; Create buffer:
(setq buffer-read-only nil)
(erase-buffer)
(buffer-disable-undo)
- (insert "\
-Server : " server ":" (or port "2000") "
-
-")
+ (let* ((port (or port sieve-manage-default-port))
+ (header (format "Server : %s:%s\n\n" server port)))
+ (insert header))
(set (make-local-variable 'sieve-buffer-header-end)
(point-max)))
(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)))
-
(defun sieve-highlight (on)
"Turn ON or off highlighting on the current language overlay."
- (sieve-overlay-put (car (sieve-overlays-at (point)))
- 'face (if on 'highlight 'default)))
+ (overlay-put (car (overlays-at (point))) 'face (if on 'highlight 'default)))
(defun sieve-insert-scripts (scripts)
"Format and insert LANGUAGE-LIST strings into current buffer at point."
(if (consp script)
(insert (format " ACTIVE %s" (cdr script)))
(insert (format " %s" script)))
- (setq ext (sieve-make-overlay p (point)))
- (sieve-overlay-put ext 'mouse-face 'highlight)
- (sieve-overlay-put ext 'script-name (if (consp script)
- (cdr script)
- script))
+ (setq ext (make-overlay p (point)))
+ (overlay-put ext 'mouse-face 'highlight)
+ (overlay-put ext 'script-name (if (consp script)
+ (cdr script)
+ script))
(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 port))
+ (error "Error opening server %s" server))
+ (sieve-manage-authenticate)))
(defun sieve-refresh-scriptlist ()
(interactive)
;; get list of script names and print them
(let ((scripts (sieve-manage-listscripts sieve-manage-buffer)))
(if (null scripts)
- (insert (format (concat "No scripts on server, press RET on %s to "
- "create a new script.\n") sieve-new-script))
- (insert (format (concat "%d script%s on server, press RET on a script "
- "name edits it, or\npress RET on %s to create "
- "a new script.\n") (length scripts)
- (if (eq (length scripts) 1) "" "s")
- sieve-new-script)))
+ (insert
+ (substitute-command-keys
+ (format
+ "No scripts on server, press \\[sieve-edit-script] on %s to create a new script.\n"
+ sieve-new-script)))
+ (insert
+ (substitute-command-keys
+ (format (concat "%d script%s on server, press \\[sieve-edit-script] on a script "
+ "name edits it, or\npress \\[sieve-edit-script] on %s to create "
+ "a new script.\n") (length scripts)
+ (if (eq (length scripts) 1) "" "s")
+ sieve-new-script))))
(save-excursion
(sieve-insert-scripts (list sieve-new-script))
(sieve-insert-scripts scripts)))
;;;###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 (substitute-command-keys
+ "Sieve upload done. Use \\[sieve-manage] 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))
+
+;;;###autoload
+(defun sieve-upload-and-kill (&optional name)
+ (interactive)
+ (sieve-upload name)
+ (kill-buffer))
+
(provide 'sieve)
;; sieve.el ends here
projects / gnus / blobdiff