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

3 files changed, 57 insertions, 33 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f19d5e8ab79..427d7d87979 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2012-03-15  Chong Yidong  <cyd@gnu.org>
+
+        * emacs-lisp/ring.el (ring-extend): New function.
+        (ring-insert+extend): Extend the ring correctly (Bug#11019).
+
+        * comint.el (comint-read-input-ring)
+        (comint-add-to-input-history): Grow comint-input-ring lazily.
+
 2012-03-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * progmodes/perl-mode.el (perl-syntax-propertize-special-constructs):
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.
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 4b07de523c3..cee6a43df86 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -185,26 +185,31 @@ Raise error if ITEM is not in the RING."
     (unless curr-index (error "Item is not in the ring: `%s'" item))
     (ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
 
+(defun ring-extend (ring x)
+  "Increase the size of RING by X."
+  (when (and (integerp x) (> x 0))
+    (let* ((hd       (car ring))
+           (length   (ring-length ring))
+           (size     (ring-size ring))
+           (old-vec  (cddr ring))
+           (new-vec  (make-vector (+ size x) nil)))
+      (setcdr ring (cons length new-vec))
+      ;; If the ring is wrapped, the existing elements must be written
+      ;; out in the right order.
+      (dotimes (j length)
+        (aset new-vec j (aref old-vec (mod (+ hd j) size))))
+      (setcar ring 0))))
+
 (defun ring-insert+extend (ring item &optional grow-p)
   "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
 Insert onto ring RING the item ITEM, as the newest (last) item.
 If the ring is full, behavior depends on GROW-P:
   If GROW-P is non-nil, enlarge the ring to accommodate the new item.
   If GROW-P is nil, dump the oldest item to make room for the new."
-  (let* ((vec (cddr ring))
-         (veclen (length vec))
-         (hd (car ring))
-         (ringlen (ring-length ring)))
-    (prog1
-        (cond ((and grow-p (= ringlen veclen)) ; Full ring.  Enlarge it.
-               (setq veclen (1+ veclen))
-               (setcdr ring (cons (setq ringlen (1+ ringlen))
-                                  (setq vec (vconcat vec (vector item)))))
-               (setcar ring hd))
-              (t (aset vec (mod (+ hd ringlen) veclen) item)))
-      (if (= ringlen veclen)
-          (setcar ring (ring-plus1 hd veclen))
-        (setcar (cdr ring) (1+ ringlen))))))
+  (and grow-p
+       (= (ring-length ring) (ring-size ring))
+       (ring-extend ring 1))
+  (ring-insert ring item))
 
 (defun ring-remove+insert+extend (ring item &optional grow-p)
   "`ring-remove' ITEM from RING, then `ring-insert+extend' it.