From 73f19816e587ad1214f91f2f8880da4ae495b2ee Mon Sep 17 00:00:00 2001 From: Allen Li Date: Wed, 24 Oct 2018 20:44:01 -0600 Subject: [PATCH 1/2] Add ring-resize function * doc/lispref/sequences.texi (Rings): Document new function * etc/NEWS: Document new function * lisp/emacs-lisp/ring.el (ring-resize): New function * 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 554716084e..955ad669b8 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -1777,6 +1777,11 @@ Rings room for the inserted element. @end defun +@defun 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. +@end 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 29bbde9395..c39303dbc0 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 312df6b2de..1b36811f9e 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -189,17 +189,28 @@ ring-previous (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 0b4e3d9a69..9fa36aa3d3 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) -- 2.19.1