Fix ring extension code in ring.el, and tweak comint-input-ring handling.

* lisp/emacs-lisp/ring.el (ring-extend): New function.
(ring-insert+extend): Extend the ring correctly.

* lisp/comint.el (comint-read-input-ring)
(comint-add-to-input-history): Grow comint-input-ring lazily.

Fixes: debbugs:11019

1 files changed, 30 insertions, 19 deletions

diff --git a/lisp/comint.el b/lisp/comint.el
index 4c2229f2f83..9306bf8dbb2 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -922,15 +922,18 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
         (t
          (let* ((file comint-input-ring-file-name)
                 (count 0)
-                (size comint-input-ring-size)
-                (ring (make-ring size)))
+                ;; Some users set HISTSIZE or `comint-input-ring-size'
+                ;; to huge numbers.  Don't allocate a huge ring right
+                ;; away; there might not be that much history.
+                (ring-size (min 1500 comint-input-ring-size))
+                (ring (make-ring ring-size)))
            (with-temp-buffer
              (insert-file-contents file)
              ;; Save restriction in case file is already visited...
              ;; Watch for those date stamps in history files!
              (goto-char (point-max))
              (let (start end history)
-               (while (and (< count size)
+               (while (and (< count comint-input-ring-size)
                            (re-search-backward comint-input-ring-separator
                                                nil t)
                            (setq end (match-beginning 0)))
@@ -941,15 +944,18 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
                          (point-min)))
                  (setq history (buffer-substring start end))
                  (goto-char start)
-                 (if (and (not (string-match comint-input-history-ignore
-                                             history))
-                          (or (null comint-input-ignoredups)
-                              (ring-empty-p ring)
-                              (not (string-equal (ring-ref ring 0)
-                                                 history))))
-                     (progn
-                       (ring-insert-at-beginning ring history)
-                       (setq count (1+ count)))))))
+                 (when (and (not (string-match comint-input-history-ignore
+                                               history))
+                            (or (null comint-input-ignoredups)
+                                (ring-empty-p ring)
+                                (not (string-equal (ring-ref ring 0)
+                                                   history))))
+                   (when (= count ring-size)
+                     (ring-extend ring (min (- comint-input-ring-size ring-size)
+                                            ring-size))
+                     (setq ring-size (ring-size ring)))
+                   (ring-insert-at-beginning ring history)
+                   (setq count (1+ count))))))
            (setq comint-input-ring ring
                  comint-input-ring-index nil)))))
 
@@ -1691,13 +1697,18 @@ Argument 0 is the command name."
 (defun comint-add-to-input-history (cmd)
   "Add CMD to the input history.
 Ignore duplicates if `comint-input-ignoredups' is non-nil."
-  (if (and (funcall comint-input-filter cmd)
-           (or (null comint-input-ignoredups)
-               (not (ring-p comint-input-ring))
-               (ring-empty-p comint-input-ring)
-               (not (string-equal (ring-ref comint-input-ring 0)
-                                  cmd))))
-      (ring-insert comint-input-ring cmd)))
+  (when (and (funcall comint-input-filter cmd)
+             (or (null comint-input-ignoredups)
+                 (not (ring-p comint-input-ring))
+                 (ring-empty-p comint-input-ring)
+                 (not (string-equal (ring-ref comint-input-ring 0) cmd))))
+    ;; If `comint-input-ring' is full, maybe grow it.
+    (let ((size (ring-size comint-input-ring)))
+      (and (= size (ring-length comint-input-ring))
+           (< size comint-input-ring-size)
+           (ring-extend comint-input-ring
+                        (min size (- comint-input-ring-size size)))))
+    (ring-insert comint-input-ring cmd)))
 
 (defun comint-send-input (&optional no-newline artificial)
   "Send input to process.