sieve: fix script name when uploading
[gnus] / lisp / sieve.el
index 8297f57..8cdd717 100644 (file)
@@ -1,24 +1,23 @@
 ;;; sieve.el --- Utilities to manage sieve scripts
-;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 
 ;; 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:
 
@@ -65,6 +64,7 @@
 
 (defgroup sieve nil
   "Manage sieve scripts."
+  :version "22.1"
   :group 'tools)
 
 (defcustom sieve-new-script "<new script>"
@@ -98,6 +98,9 @@ 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:
 
@@ -131,22 +134,22 @@ require \"fileinto\";
   (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"
+    ["Edit script" sieve-edit-script t]
+    ["Activate script" sieve-activate t]
+    ["Deactivate script" sieve-deactivate t]))
+
 (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-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)
 
-(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map
-  "Sieve Menu."
-  '("Manage Sieve"
-    ["Edit script" sieve-edit-script t]
-    ["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)
@@ -173,7 +176,7 @@ require \"fileinto\";
     (sieve-refresh-scriptlist)
     (if (sieve-manage-ok-p err)
        (message "Deactivating scripts...done")
-      (message "Deactivating scripts...failed" (nth 2 err)))))
+      (message "Deactivating scripts...failed: %s" (nth 2 err)))))
 
 (defalias 'sieve-deactivate 'sieve-deactivate-all)
 
@@ -204,6 +207,7 @@ require \"fileinto\";
       (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)
@@ -243,7 +247,7 @@ 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)
@@ -288,15 +292,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 +324,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)
@@ -361,12 +367,12 @@ 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."))