Add 'ring-resize' function

* lisp/emacs-lisp/ring.el (ring-resize): New function.  (Bug#32849)
* doc/lispref/sequences.texi (Rings): Document new function 'ring-resize'.
* etc/NEWS: Document new function 'ring-resize'.
* test/lisp/emacs-lisp/ring-tests.el (ring-test-ring-resize): New tests.

diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 554716084ee4795a0a66c82ab58fcc2e8c547305..955ad669b80aa40f1e54b047e4dd01b8ae51da79 100644 (file)
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1777,6 +1777,11 @@ If the ring is full, this function removes the newest element to make
 room for the inserted element.
 @end defun
 
+@defun ring-resize ring size
+Set the size of @var{ring} to @var{size}.  If the new size is smaller,
+then the oldest items in the ring are discarded.
+@end defun
+
 @cindex fifo data structure
   If you are careful not to exceed the ring size, you can
 use the ring as a first-in-first-out queue.  For example:

diff --git a/etc/NEWS b/etc/NEWS
index 7f3e74457da4aca4f6681826eae48feb838b197f..668b59a20a4d9aced3e00740f1403faef21a965e 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1218,6 +1218,10 @@ to mean that it is not known whether DST is in effect.
 'json-insert', 'json-parse-string', and 'json-parse-buffer'.  These
 are implemented in C using the Jansson library.
 
++++
+** New function 'ring-resize'.
+'ring-resize' can be used to grow or shrink a ring.
+
 ** Mailcap
 
 ---

diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 312df6b2de323c3441f3cf45e0d16b2e75c19e7d..1b36811f9e56bbe8441b90345409129d8aa580c5 100644 (file)
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -189,17 +189,28 @@ Raise error if ITEM is not in the 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))))
+    (ring-resize ring (+ x (ring-size ring)))))
+
+(defun ring-resize (ring size)
+  "Set the size of RING to SIZE.
+If the new size is smaller, then the oldest items in the ring are
+discarded."
+  (when (integerp size)
+    (let ((length (ring-length ring))
+         (new-vec (make-vector size nil)))
+      (if (= length 0)
+          (setcdr ring (cons 0 new-vec))
+        (let* ((hd (car ring))
+              (old-size (ring-size ring))
+              (old-vec (cddr ring))
+               (copy-length (min size length))
+               (copy-hd (mod (+ hd (- length copy-length)) length)))
+          (setcdr ring (cons copy-length new-vec))
+          ;; If the ring is wrapped, the existing elements must be written
+          ;; out in the right order.
+          (dotimes (j copy-length)
+           (aset new-vec j (aref old-vec (mod (+ copy-hd j) old-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.

diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el
index 0b4e3d9a6940cafa8231193de1679d828830a10e..9fa36aa3d336bb3138726c956173dfd0d25d2a72 100644 (file)
--- a/test/lisp/emacs-lisp/ring-tests.el
+++ b/test/lisp/emacs-lisp/ring-tests.el
@@ -162,6 +162,43 @@
     (should (= (ring-size ring) 5))
     (should (equal (ring-elements ring) '(3 2 1)))))
 
+(ert-deftest ring-resize/grow ()
+  (let ((ring (make-ring 3)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should (equal (ring-elements ring) '(3 2 1)))))
+
+(ert-deftest ring-resize/grow-empty ()
+  (let ((ring (make-ring 3)))
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should (equal (ring-elements ring) '()))))
+
+(ert-deftest ring-resize/grow-wrapped-ring ()
+  (let ((ring (make-ring 3)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-insert ring 4)
+    (ring-insert ring 5)
+    (ring-resize ring 5)
+    (should (= (ring-size ring) 5))
+    (should (equal (ring-elements ring) '(5 4 3)))))
+
+(ert-deftest ring-resize/shrink ()
+  (let ((ring (make-ring 5)))
+    (ring-insert ring 1)
+    (ring-insert ring 2)
+    (ring-insert ring 3)
+    (ring-insert ring 4)
+    (ring-insert ring 5)
+    (ring-resize ring 3)
+    (should (= (ring-size ring) 3))
+    (should (equal (ring-elements ring) '(5 4 3)))))
+
 (ert-deftest ring-tests-insert ()
   (let ((ring (make-ring 2)))
     (ring-insert+extend ring :a)