--- a/lisp/ChangeLog	Sun Nov 08 17:27:26 2009 +0000
+++ b/lisp/ChangeLog	Mon Nov 09 17:05:19 2009 +0100
@@ -1,3 +1,10 @@
+2009-11-09  Didier Verna  <didier@xemacs.org>
+
+	* minibuf.el (read-buffer): New optional argument 'exclude' for
+	excluding buffers from the completion list.
+	* buffer.el (switch-to-buffer): Don't offer the current buffer in
+	the completion list.
+
 2009-11-01  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-extra.el (equalp): 

--- a/lisp/buffer.el	Sun Nov 08 17:27:26 2009 +0000
+++ b/lisp/buffer.el	Mon Nov 09 17:05:19 2009 +0100
@@ -41,7 +41,11 @@
 WARNING: This is NOT the way to work on another buffer temporarily
 within a Lisp program!  Use `set-buffer' instead.  That avoids messing with
 the window-buffer correspondences."
-  (interactive "BSwitch to buffer: ")
+  (interactive
+   (list (read-buffer "Switch to buffer: "
+		      (other-buffer (current-buffer))
+		      nil
+		      (current-buffer))))
   ;; #ifdef I18N3
   ;; #### Doc string should indicate that the buffer name will get
   ;; translated.

--- a/lisp/minibuf.el	Sun Nov 08 17:27:26 2009 +0000
+++ b/lisp/minibuf.el	Mon Nov 09 17:05:19 2009 +0100
@@ -40,6 +40,8 @@
 
 ;;; Code:
 
+(require 'cl)
+
 (defgroup minibuffer nil
   "Controling the behavior of the minibuffer."
   :group 'environment)
@@ -1467,20 +1469,24 @@
 			       (symbol-name default-value)
 			     default-value))))
 
-(defun read-buffer (prompt &optional default require-match)
+(defun read-buffer (prompt &optional default require-match exclude)
   "Read the name of a buffer and return as a string.
 Prompts with PROMPT.  Optional second arg DEFAULT is value to return if user
 enters an empty line.  If optional third arg REQUIRE-MATCH is non-nil,
-only existing buffer names are allowed."
+only existing buffer names are allowed.  Optional fourth argument EXCLUDE is
+a buffer or a list of buffers to exclude from the completion list."
+  (when (bufferp exclude)
+    (setq exclude (list exclude)))
   (let ((prompt (if default
                     (format "%s(default %s) "
                             (gettext prompt) (if (bufferp default)
 						 (buffer-name default)
 					       default))
-                    prompt))
-        (alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
-                       (buffer-list)))
-        result)
+		    prompt))
+	(alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
+		       (remove-if (lambda (elt) (member elt exclude))
+				  (buffer-list))))
+	result)
     (while (progn
              (setq result (completing-read prompt alist nil require-match
 					   nil 'buffer-history