diff lisp/simple.el @ 83414:14a4eb789b45

Merged from [e-mail]--gnu-2005 (patch 169-173, 671-676) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-671 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-672 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-673 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-674 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-675 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-676 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-169 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-170 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-171 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-172 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-173 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-454

--- a/lisp/simple.el	Mon Dec 19 16:13:20 2005 +0000
+++ b/lisp/simple.el	Mon Dec 19 19:57:22 2005 +0000
@@ -52,25 +52,68 @@
   "Highlight (un)matching of parens and expressions."
   :group 'matching)
 
+(defun get-next-valid-buffer (list &optional buffer visible-ok frame) "\
+Search LIST for a valid buffer to display in FRAME.
+Return nil when all buffers in LIST are undesirable for display,
+otherwise return the first suitable buffer in LIST.
+
+Buffers not visible in windows are preferred to visible buffers,
+unless VISIBLE-OK is non-nil.
+If the optional argument FRAME is nil, it defaults to the selected frame.
+If BUFFER is non-nil, ignore occurances of that buffer in LIST."
+  ;; This logic is more or less copied from other-buffer.
+  (setq frame (or frame (selected-frame)))
+  (let ((pred (frame-parameter frame 'buffer-predicate))
+	found buf)
+    (while (and (not found) list)
+      (setq buf (car list))
+      (if (and (not (eq buffer buf))
+	       (buffer-live-p buf)
+	       (or (null pred) (funcall pred buf))
+	       (not (eq (aref (buffer-name buf) 0) ?\s))
+	       (or visible-ok (null (get-buffer-window buf 'visible))))
+	  (setq found buf)
+	(setq list (cdr list))))
+    (car list)))
+
+(defun last-buffer (&optional buffer visible-ok frame) "\
+Return the last non-hidden displayable buffer in the buffer list.
+If BUFFER is non-nil, last-buffer will ignore that buffer.
+Buffers not visible in windows are preferred to visible buffers,
+unless optional argument VISIBLE-OK is non-nil.
+If the optional third argument FRAME is non-nil, use that frame's
+buffer list instead of the selected frame's buffer list.
+If no other buffer exists, the buffer `*scratch*' is returned."
+  (setq frame (or frame (selected-frame)))
+  (or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list)
+			     buffer visible-ok frame)
+      (get-next-valid-buffer (nreverse (buffer-list frame))
+			     buffer visible-ok frame)
+      (progn
+	(set-buffer-major-mode (get-buffer-create "*scratch*"))
+	(get-buffer "*scratch*"))))
+
 (defun next-buffer ()
   "Switch to the next buffer in cyclic order."
   (interactive)
-  (let ((buffer (current-buffer)))
-    (switch-to-buffer (other-buffer buffer))
-    (bury-buffer buffer)))
-
-(defun prev-buffer ()
+  (let ((buffer (current-buffer))
+	(bbl (frame-parameter nil 'buried-buffer-list)))
+    (switch-to-buffer (other-buffer buffer t))
+    (bury-buffer buffer)
+    (set-frame-parameter nil 'buried-buffer-list
+			 (cons buffer (delq buffer bbl)))))
+
+(defun previous-buffer ()
   "Switch to the previous buffer in cyclic order."
   (interactive)
-  (let ((list (nreverse (buffer-list)))
-	found)
-    (while (and (not found) list)
-      (let ((buffer (car list)))
-	(if (and (not (get-buffer-window buffer))
-		 (not (string-match "\\` " (buffer-name buffer))))
-	    (setq found buffer)))
-      (setq list (cdr list)))
-    (switch-to-buffer found)))
+  (let ((buffer (last-buffer (current-buffer) t))
+	(bbl (frame-parameter nil 'buried-buffer-list)))
+    (switch-to-buffer buffer)
+    ;; Clean up buried-buffer-list up to and including the chosen buffer.
+    (while (and bbl (not (eq (car bbl) buffer)))
+      (setq bbl (cdr bbl)))
+    (set-frame-parameter nil 'buried-buffer-list bbl)))
+
 
 ;;; next-error support framework
 
@@ -4748,7 +4791,7 @@
 	(error "No completion here"))
     (setq beg (previous-single-property-change beg 'mouse-face))
     (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
-    (setq completion (buffer-substring beg end))
+    (setq completion (buffer-substring-no-properties beg end))
     (let ((owindow (selected-window)))
       (if (and (one-window-p t 'selected-frame)
 	       (window-dedicated-p (selected-window)))
@@ -4905,68 +4948,52 @@
   "Common prefix substring to use in `completion-setup-function' to put faces.
 The value is set by `display-completion-list' during running `completion-setup-hook'.
 
-To put faces, `completions-first-difference' and `completions-common-part'
-into \"*Completions*\* buffer, the common prefix substring in completions is
-needed as a hint. (Minibuffer is a special case. The content of minibuffer itself
-is the substring.)")
+To put faces `completions-first-difference' and `completions-common-part'
+in the `*Completions*' buffer, the common prefix substring in completions
+is needed as a hint.  (The minibuffer is a special case.  The content
+of the minibuffer before point is always the common substring.)")
 
 ;; This function goes in completion-setup-hook, so that it is called
 ;; after the text of the completion list buffer is written.
 (defun completion-setup-function ()
   (let* ((mainbuf (current-buffer))
-         (mbuf-contents (minibuffer-contents))
-         (common-string-length (length mbuf-contents)))
+         (mbuf-contents (minibuffer-completion-contents))
+         common-string-length)
     ;; When reading a file name in the minibuffer,
     ;; set default-directory in the minibuffer
     ;; so it will get copied into the completion list buffer.
     (if minibuffer-completing-file-name
 	(with-current-buffer mainbuf
 	  (setq default-directory (file-name-directory mbuf-contents))))
-    ;; If partial-completion-mode is on, point might not be after the
-    ;; last character in the minibuffer.
-    ;; FIXME: This hack should be moved to complete.el where we call
-    ;; display-completion-list.
-    (when partial-completion-mode
-      (setq common-string-length
-            (if (eq (char-after (field-beginning)) ?-)
-                ;; If the text to be completed starts with a `-', there is no
-                ;; common prefix.
-                ;; FIXME: this probably still doesn't do the right thing
-                ;; when completing file names.  It's not even clear what
-                ;; is TRT.
-                0
-              (- common-string-length (- (point-max) (point))))))
     (with-current-buffer standard-output
       (completion-list-mode)
       (set (make-local-variable 'completion-reference-buffer) mainbuf)
       (setq completion-base-size
-            (if minibuffer-completing-file-name
-                ;; For file name completion, use the number of chars before
-                ;; the start of the last file name component.
-		(with-current-buffer mainbuf
-		  (save-excursion
-		    (goto-char (point-max))
-		    (skip-chars-backward completion-root-regexp)
-		    (- (point) (minibuffer-prompt-end))))
-              ;; Otherwise, in minibuffer, the whole input is being completed.
-              (if (minibufferp mainbuf) 0)))
-      (if (and (symbolp minibuffer-completion-table)
-               (get minibuffer-completion-table 'completion-base-size-function))
-          (setq completion-base-size
-                ;; FIXME: without any extra arg, how is this function
-                ;; expected to return anything else than a constant unless
-                ;; it redoes part of the work of all-completions?
-                ;; In most cases this value would better be computed and
-                ;; returned at the same time as the list of all-completions
-                ;; is computed.  --Stef
-                (funcall (get minibuffer-completion-table
-                              'completion-base-size-function))))
+	    (cond
+	     ((and (symbolp minibuffer-completion-table)
+		   (get minibuffer-completion-table 'completion-base-size-function))
+	      ;; To compute base size, a function can use the global value of
+	      ;; completion-common-substring or minibuffer-completion-contents.
+	      (with-current-buffer mainbuf
+		(funcall (get minibuffer-completion-table
+			      'completion-base-size-function))))
+	     (minibuffer-completing-file-name
+	      ;; For file name completion, use the number of chars before
+	      ;; the start of the file name component at point.
+	      (with-current-buffer mainbuf
+		(save-excursion
+		  (skip-chars-backward completion-root-regexp)
+		  (- (point) (minibuffer-prompt-end)))))
+	     ;; Otherwise, in minibuffer, the base size is 0.
+	     ((minibufferp mainbuf) 0)))
+      (setq common-string-length
+	    (cond
+	     (completion-common-substring
+	      (length completion-common-substring))
+	     (completion-base-size
+	      (- (length mbuf-contents) completion-base-size))))
       ;; Put faces on first uncommon characters and common parts.
-      (when (or completion-common-substring completion-base-size)
-        (setq common-string-length
-              (if completion-common-substring
-                  (length completion-common-substring)
-                (- common-string-length completion-base-size)))
+      (when (and (integerp common-string-length) (>= common-string-length 0))
 	(let ((element-start (point-min))
               (maxp (point-max))
               element-common-end)
@@ -4977,7 +5004,8 @@
                                (+ element-start common-string-length))
                          maxp))
 	    (when (get-char-property element-start 'mouse-face)
-	      (if (get-char-property (1- element-common-end) 'mouse-face)
+	      (if (and (> common-string-length 0)
+		       (get-char-property (1- element-common-end) 'mouse-face))
 		  (put-text-property element-start element-common-end
 				     'font-lock-face 'completions-common-part))
 	      (if (get-char-property element-common-end 'mouse-face)