X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fsieve.el;h=39b74e5eae0664bb02f7c4f7f67328e49760e5a9;hp=f4645168dec808ccd64864b8402f0665ef803aed;hb=d6d90fbbda04a990e100832c709d6c746d872aa3;hpb=125d88b46ad2efa065f06d5dac37a245b488985a diff --git a/lisp/sieve.el b/lisp/sieve.el index f4645168d..39b74e5ea 100644 --- a/lisp/sieve.el +++ b/lisp/sieve.el @@ -1,28 +1,27 @@ ;;; sieve.el --- Utilities to manage sieve scripts -;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. + +;; Copyright (C) 2001-2012 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; 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 . ;;; 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 @@ -65,6 +64,7 @@ (defgroup sieve nil "Manage sieve scripts." + :version "22.1" :group 'tools) (defcustom sieve-new-script "" @@ -98,39 +98,40 @@ require \"fileinto\"; (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) + (define-key map "q" 'kill-buffer) + ;; 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-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 [(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." '("Manage Sieve" @@ -138,21 +139,21 @@ require \"fileinto\"; ["Activate script" sieve-activate t] ["Deactivate script" sieve-deactivate t])) -(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE" +(define-derived-mode sieve-manage-mode fundamental-mode "Sieve-manage" "Mode used for sieve script management." - (setq mode-name "SIEVE") (buffer-disable-undo (current-buffer)) (setq truncate-lines t) - (easy-menu-add-item nil nil sieve-manage-mode-menu)) + (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) - ;; Commands used in sieve-manage mode: +(defun sieve-manage-quit () + "Quit." + (interactive) + (kill-buffer (current-buffer))) + (defun sieve-activate (&optional pos) (interactive "d") (let ((name (sieve-script-at-point)) err) @@ -204,7 +205,10 @@ require \"fileinto\"; (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) + (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. @@ -243,32 +247,9 @@ Used to bracket operations which move point in the sieve-buffer." (if (eq last-command 'sieve-help) ;; would need minor-mode for log-edit-mode (describe-function 'sieve-mode) - (message (substitute-command-keys + (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. -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)))))) - ;; Create buffer: (defun sieve-setup-buffer (server port) @@ -288,15 +269,15 @@ Server : " server ":" (or port "2000") " (get-char-property (or pos (point)) 'script-name)) (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." @@ -320,11 +301,13 @@ Server : " server ":" (or port "2000") " (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) @@ -335,13 +318,18 @@ Server : " server ":" (or port "2000") " ;; 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))) @@ -361,15 +349,15 @@ Server : " server ":" (or port "2000") " ;;;###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 @@ -378,7 +366,12 @@ Server : " server ":" (or port "2000") " (sieve-upload name) (bury-buffer)) +;;;###autoload +(defun sieve-upload-and-kill (&optional name) + (interactive) + (sieve-upload name) + (kill-buffer)) + (provide 'sieve) -;;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94 ;; sieve.el ends here