[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 5578112 1/2: Add 'ring-resize' function
From: |
Eli Zaretskii |
Subject: |
[Emacs-diffs] master 5578112 1/2: Add 'ring-resize' function |
Date: |
Sat, 10 Nov 2018 04:46:02 -0500 (EST) |
branch: master
commit 5578112e182e20661783a1fef2c779b8844cf082
Author: Allen Li <address@hidden>
Commit: Eli Zaretskii <address@hidden>
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 | 5 +++++
etc/NEWS | 4 ++++
lisp/emacs-lisp/ring.el | 33 ++++++++++++++++++++++-----------
test/lisp/emacs-lisp/ring-tests.el | 37 +++++++++++++++++++++++++++++++++++++
4 files changed, 68 insertions(+), 11 deletions(-)
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 5547160..955ad66 100644
--- a/doc/lispref/sequences.texi
+++ b/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
address@hidden 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.
address@hidden 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:
diff --git a/etc/NEWS b/etc/NEWS
index 7f3e744..668b59a 100644
--- a/etc/NEWS
+++ b/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
---
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 312df6b..1b36811 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.
diff --git a/test/lisp/emacs-lisp/ring-tests.el
b/test/lisp/emacs-lisp/ring-tests.el
index 0b4e3d9..9fa36aa 100644
--- a/test/lisp/emacs-lisp/ring-tests.el
+++ b/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)