X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fsieve.el;h=2046e53697daa8f4d3f04953223e2905e79a56b8;hp=2111d34eac5a3c28f6e822947679fdcb55d0f462;hb=b8d320e51cd2b549ab453682da8b00119e051c3d;hpb=b5fa82f9d758d5e39bf7c8908189c44759cb90b4

diff --git a/lisp/sieve.el b/lisp/sieve.el
index 2111d34ea..2046e5369 100644
--- a/lisp/sieve.el
+++ b/lisp/sieve.el
@@ -1,6 +1,6 @@
 ;;; sieve.el --- Utilities to manage sieve scripts
 
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2016 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 
@@ -21,7 +21,7 @@
 
 ;;; 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
@@ -109,7 +109,6 @@ require \"fileinto\";
     ;; various
     (define-key map "?" 'sieve-help)
     (define-key map "h" 'sieve-help)
-    (define-key map "q" 'sieve-bury-buffer)
     ;; activating
     (define-key map "m" 'sieve-activate)
     (define-key map "u" 'sieve-deactivate)
@@ -126,7 +125,8 @@ require \"fileinto\";
     (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 "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)
@@ -150,10 +150,17 @@ require \"fileinto\";
 ;; Commands used in sieve-manage mode:
 
 (defun sieve-manage-quit ()
-  "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)
@@ -206,6 +213,7 @@ require \"fileinto\";
       (insert sieve-template))
     (sieve-mode)
     (setq sieve-buffer-script-name name)
+    (goto-char (point-min))
     (message
      (substitute-command-keys
       "Press \\[sieve-upload] to upload script to server."))))
@@ -250,39 +258,15 @@ Used to bracket operations which move point in the sieve-buffer."
     (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)
   (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)))
 
@@ -291,21 +275,9 @@ Server  : " server ":" (or port "2000") "
   (interactive "d")
   (get-char-property (or pos (point)) 'script-name))
 
-(eval-and-compile
-  (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."
-  (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."
@@ -316,11 +288,11 @@ Server  : " server ":" (or port "2000") "
       (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)
@@ -328,7 +300,7 @@ Server  : " server ":" (or port "2000") "
   (with-current-buffer
       (or ;; open server
        (set (make-local-variable 'sieve-manage-buffer)
-	    (sieve-manage-open server))
+	    (sieve-manage-open server port))
        (error "Error opening server %s" server))
     (sieve-manage-authenticate)))
 
@@ -389,6 +361,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)
 
 ;; sieve.el ends here