aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorAllen Li2018-10-24 20:44:01 -0600
committerEli Zaretskii2018-11-10 11:41:51 +0200
commit5578112e182e20661783a1fef2c779b8844cf082 (patch)
treef7ab48c6949bf6b0598ed705578a4cacae554207 /lisp
parent705adc237629a78c10165f9a3b3260cb56242cda (diff)
downloademacs-5578112e182e20661783a1fef2c779b8844cf082.tar.gz
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')
-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."
189(defun ring-extend (ring x) 189(defun ring-extend (ring x)
190 "Increase the size of RING by X." 190 "Increase the size of RING by X."
191 (when (and (integerp x) (> x 0)) 191 (when (and (integerp x) (> x 0))
192 (let* ((hd (car ring)) 192 (ring-resize ring (+ x (ring-size ring)))))
193 (length (ring-length ring)) 193
194 (size (ring-size ring)) 194(defun ring-resize (ring size)
195 (old-vec (cddr ring)) 195 "Set the size of RING to SIZE.
196 (new-vec (make-vector (+ size x) nil))) 196If the new size is smaller, then the oldest items in the ring are
197 (setcdr ring (cons length new-vec)) 197discarded."
198 ;; If the ring is wrapped, the existing elements must be written 198 (when (integerp size)
199 ;; out in the right order. 199 (let ((length (ring-length ring))
200 (dotimes (j length) 200 (new-vec (make-vector size nil)))
201 (aset new-vec j (aref old-vec (mod (+ hd j) size)))) 201 (if (= length 0)
202 (setcar ring 0)))) 202 (setcdr ring (cons 0 new-vec))
203 (let* ((hd (car ring))
204 (old-size (ring-size ring))
205 (old-vec (cddr ring))
206 (copy-length (min size length))
207 (copy-hd (mod (+ hd (- length copy-length)) length)))
208 (setcdr ring (cons copy-length new-vec))
209 ;; If the ring is wrapped, the existing elements must be written
210 ;; out in the right order.
211 (dotimes (j copy-length)
212 (aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size))))
213 (setcar ring 0))))))
203 214
204(defun ring-insert+extend (ring item &optional grow-p) 215(defun ring-insert+extend (ring item &optional grow-p)
205 "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring. 216 "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.