diff options
| author | Allen Li | 2018-10-24 20:44:01 -0600 |
|---|---|---|
| committer | Eli Zaretskii | 2018-11-10 11:41:51 +0200 |
| commit | 5578112e182e20661783a1fef2c779b8844cf082 (patch) | |
| tree | f7ab48c6949bf6b0598ed705578a4cacae554207 /lisp | |
| parent | 705adc237629a78c10165f9a3b3260cb56242cda (diff) | |
| download | emacs-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.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." | |||
| 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))) | 196 | If the new size is smaller, then the oldest items in the ring are |
| 197 | (setcdr ring (cons length new-vec)) | 197 | discarded." |
| 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. |