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.

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:

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
 
 ---

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.

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)