summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/ring.el
diff options
context:
space:
mode:
authorAllen Li <darkfeline@felesatra.moe>2018-10-24 20:44:01 -0600
committerEli Zaretskii <eliz@gnu.org>2018-11-10 11:41:51 +0200
commit5578112e182e20661783a1fef2c779b8844cf082 (patch)
treef7ab48c6949bf6b0598ed705578a4cacae554207 /lisp/emacs-lisp/ring.el
parent705adc237629a78c10165f9a3b3260cb56242cda (diff)
downloademacs-5578112e182e20661783a1fef2c779b8844cf082.tar.gz
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.
Diffstat (limited to 'lisp/emacs-lisp/ring.el')
-rw-r--r--lisp/emacs-lisp/ring.el33
1 files changed, 22 insertions, 11 deletions
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 312df6b2de3..1b36811f9e5 100644
--- 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.