--- a/lisp/help.el	Mon Aug 13 10:22:10 2007 +0200
+++ b/lisp/help.el	Mon Aug 13 10:23:02 2007 +0200
@@ -420,9 +420,48 @@
   :type 'boolean
   :group 'help-appearance)
 
+(defcustom help-max-help-buffers 10
+  "*Maximum help buffers to allow before they start getting killed.
+If this is a positive integer, before a help buffer is displayed
+by `with-displaying-help-buffer', any excess help buffers which
+are not being displayed are first killed.  Otherwise, if it is
+zero or nil, only one help buffer, \"*Help*\" is ever used."
+  :type '(choice integer (const :tag "None" nil))
+  :group 'help-appearance)
+
+(defvar help-buffer-list nil
+  "List of help buffers used by `help-register-and-maybe-prune-excess'")
+
+(defun help-register-and-maybe-prune-excess (newbuf)
+  "Register use of a help buffer and possibly kill any excess ones."
+  ;; remove new buffer from list
+  (setq help-buffer-list (remove newbuf help-buffer-list))
+  ;; maybe kill excess help buffers
+  (if (and (integerp help-max-help-buffers)
+           (> (length help-buffer-list) help-max-help-buffers))
+      (let ((keep-list nil)
+            (num-kill (- (length help-buffer-list)
+                         help-max-help-buffers)))
+        (while help-buffer-list
+          (let ((buf (car help-buffer-list)))
+            (if (and (or (equal buf newbuf) (get-buffer buf))
+                     (string-match "^*Help" buf)
+                     (save-excursion (set-buffer buf)
+                                     (eq major-mode 'help-mode)))
+                (if (and (>= num-kill (length help-buffer-list))
+                         (not (get-buffer-window buf t t)))
+                    (kill-buffer buf)
+                  (setq keep-list (cons buf keep-list)))))
+          (setq help-buffer-list (cdr help-buffer-list)))
+        (setq help-buffer-list (nreverse keep-list))))
+  ;; push new buffer
+  (setq help-buffer-list (cons newbuf help-buffer-list)))
+
 (defun help-buffer-name (name)
   "Return a name for a Help buffer using string NAME for context."
-  (if (stringp name)
+  (if (and (integerp help-max-help-buffers)
+           (> help-max-help-buffers 0)
+           (stringp name))
       (format "*Help: %s*" name)
     "*Help*"))
 
@@ -442,8 +481,7 @@
 		     (member (selected-frame)
 			     (mapcar 'window-frame
 				     (windows-of-buffer buffer-name)))))))
-     (if (get-buffer buffer-name)
-	 (kill-buffer buffer-name))
+     (help-register-and-maybe-prune-excess buffer-name)
      (prog1 (with-output-to-temp-buffer buffer-name
 	      (prog1 ,@body
 		(save-excursion
@@ -1146,21 +1184,26 @@
 
 Uses `pp-internal' if defined, otherwise `cl-prettyprint'"
   (princ
-   (if (and (or (listp object) (vectorp object))
-	    (< (length object)
-	       help-pretty-print-limit))
-       (with-output-to-string
-	 (with-syntax-table emacs-lisp-mode-syntax-table
-	   ;; print `#<...>' values better
-	   (modify-syntax-entry ?< "(>")
-	   (modify-syntax-entry ?> ")<")
-	   (let ((indent-line-function 'lisp-indent-line))
-	     (if (fboundp 'pp-internal)
-		 (progn
-		   (pp-internal object "\n")
-		   (terpri))
-	       (cl-prettyprint object)))))
-     (format "\n%S\n" object))))
+   (let ((valstr
+	  (if (and (or (listp object) (vectorp object))
+		   (< (length object)
+		      help-pretty-print-limit))
+	      (with-output-to-string
+		(with-syntax-table emacs-lisp-mode-syntax-table
+		  ;; print `#<...>' values better
+		  (modify-syntax-entry ?< "(>")
+		  (modify-syntax-entry ?> ")<")
+		  (let ((indent-line-function 'lisp-indent-line))
+		    (if (fboundp 'pp-internal)
+			(progn
+			  (pp-internal object "\n")
+			  (terpri))
+		      (cl-prettyprint object)))))
+	    (format "\n%S\n" object))))
+
+     (if (string-match "^\n[^\n]*\n$" valstr)
+         (substring valstr 1)
+       valstr))))
 
 (defun describe-variable (variable)
   "Display the full documentation of VARIABLE (a symbol)."