branch: externals/compat
commit b27914c0b691eb9403e44137e01f6cf5a6c65653
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
compat-27: Add ring-resize
---
NEWS.org | 1 +
compat-27.el | 24 ++++++++++++++++++++++++
compat-tests.el | 43 +++++++++++++++++++++++++++++++++++++------
compat.texi | 8 ++++++--
4 files changed, 68 insertions(+), 8 deletions(-)
diff --git a/NEWS.org b/NEWS.org
index eb9171fdde..d1049a7d1b 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -30,6 +30,7 @@
- compat-27: Add ~fixnump~ and ~bignump~.
- compat-27: Add ~with-minibuffer-selected-window~.
- compat-27: Add generalized variables for ~decoded-time-*~.
+- compat-27: Add ~ring-resize~.
- compat-28: Add ~macroexp-warn-and-return~.
- compat-28: Add ~subr-native-elisp-p~.
- compat-28: Add ~bounds-of-thing-at-mouse~.
diff --git a/compat-27.el b/compat-27.el
index 9f9198e07e..16a6b124cd 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -714,5 +714,29 @@ and if a matching region is found, place point at the
start of the region."
(and (not (eq ended t))
ended))))))
+;;;; Defined in ring.el
+
+(compat-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."
+ :feature ring
+ (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))))))
+
(provide 'compat-27)
;;; compat-27.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index 1a1b2ddc84..add4f32a79 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -91,7 +91,7 @@
(should sym)
(should (symbolp sym))
(setq list (funcall sym list "first" 1 #'string=))
- (should (eq (compat-call plist-get list "first" #'string=) 1))))
+ (should-equal (compat-call plist-get list "first" #'string=) 1)))
(defconst compat-tests--version (package-get-version))
(ert-deftest package-get-version ()
@@ -939,7 +939,7 @@
(insert "first\nsecond\nthird\n")
(goto-char 7)
(delete-line)
- (should (equal (buffer-string) "first\nthird\n"))))
+ (should-equal (buffer-string) "first\nthird\n")))
(ert-deftest list-of-strings-p ()
(should-not (list-of-strings-p 1))
@@ -964,16 +964,16 @@
(setq list (compat-call plist-put list 'first 1))
(setq list (compat-call plist-put list 'second 2))
(setq list (compat-call plist-put list 'first 10))
- (should (eq (compat-call plist-get list 'first) 10))
- (should (eq (compat-call plist-get list 'second) 2))
+ (should-equal (compat-call plist-get list 'first) 10)
+ (should-equal (compat-call plist-get list 'second) 2)
(should (compat-call plist-member list 'first))
(should-not (compat-call plist-member list 'third)))
(let (list)
(setq list (compat-call plist-put list "first" 1 #'string=))
(setq list (compat-call plist-put list "second" 2 #'string=))
(setq list (compat-call plist-put list "first" 10 #'string=))
- (should (eq (compat-call plist-get list "first" #'string=) 10))
- (should (eq (compat-call plist-get list "second" #'string=) 2))
+ (should-equal (compat-call plist-get list "first" #'string=) 10)
+ (should-equal (compat-call plist-get list "second" #'string=) 2)
(should (compat-call plist-member list "first" #'string=))
(should-not (compat-call plist-member list "third" #'string=))))
@@ -2678,5 +2678,36 @@
(should-equal "*scratch*" (buffer-name (get-scratch-buffer-create)))
(should-equal initial-major-mode (buffer-local-value 'major-mode
(get-scratch-buffer-create))))
+(ert-deftest ring-resize ()
+ (let ((ring (make-ring 3)))
+ (ring-insert ring 1)
+ (ring-insert ring 2)
+ (ring-insert ring 3)
+ (ring-resize ring 5)
+ (should-equal (ring-size ring) 5)
+ (should-equal (ring-elements ring) '(3 2 1)))
+ (let ((ring (make-ring 3)))
+ (ring-resize ring 5)
+ (should (= (ring-size ring) 5))
+ (should-equal (ring-elements 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-equal (ring-size ring) 5)
+ (should-equal (ring-elements ring) '(5 4 3)))
+ (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-equal (ring-size ring) 3)
+ (should-equal (ring-elements ring) '(5 4 3))))
+
(provide 'compat-tests)
;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index ea0e020d00..9668e04ec6 100644
--- a/compat.texi
+++ b/compat.texi
@@ -893,6 +893,12 @@ The function @code{string-version-lessp}.
The following functions and macros implemented in 27.1, and are provided
by Compat:
+@c copied from lispref/sequences.texi
+@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
+
@c based on lisp/minibuffer.el
@defmac with-minibuffer-selected-window &rest body
Execute the forms in @var{body} from the minibuffer in its original
@@ -1414,8 +1420,6 @@ The function @code{file-system-info}.
@item
The more consistent treatment of NaN values.
@item
-The function @code{ring-resize}.
-@item
The function @code{group-name}.
@item
Additional @code{format-spec} modifiers.
