diff options
author | Allen Li <darkfeline@felesatra.moe> | 2018-10-24 20:44:01 -0600 |
---|---|---|
committer | Eli Zaretskii <eliz@gnu.org> | 2018-11-10 11:41:51 +0200 |
commit | 5578112e182e20661783a1fef2c779b8844cf082 (patch) | |
tree | f7ab48c6949bf6b0598ed705578a4cacae554207 /lisp/emacs-lisp/ring.el | |
parent | 705adc237629a78c10165f9a3b3260cb56242cda (diff) | |
download | emacs-5578112e182e20661783a1fef2c779b8844cf082.tar.gz emacs-5578112e182e20661783a1fef2c779b8844cf082.tar.bz2 emacs-5578112e182e20661783a1fef2c779b8844cf082.zip |
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.el | 33 |
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. |