[elpa] externals/compat a660d13326 75/84: Add while-let from Emacs 29

[ELPA Syncer]

branch: externals/compat
commit a660d133266ed981fd165ad6e9b23fdd9dcd514f
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add while-let from Emacs 29
---
 compat-29.el    | 19 +++++++++++++++++
 compat-tests.el | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 compat.texi     |  8 ++++++++
 3 files changed, 90 insertions(+)

diff --git a/compat-29.el b/compat-29.el
index 493f75fa4e..a47037ec07 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -486,6 +486,25 @@ this defaults to the current buffer."
           (put-text-property sub-start sub-end 'display disp)))
       (setq sub-start sub-end))))
 
+(compat-defmacro while-let (spec &rest body)
+  "Bind variables according to SPEC and conditionally evaluate BODY.
+Evaluate each binding in turn, stopping if a binding value is nil.
+If all bindings are non-nil, eval BODY and repeat.
+
+The variable list SPEC is the same as in `if-let'."
+  (declare (indent 1) (debug if-let))
+  (let ((empty (make-symbol "s"))
+        (last t) list)
+    (dolist (var spec)
+      (push `(,(if (cdr var) (car var) empty)
+              (and ,last ,(if (cdr var) (cadr var) (car var))))
+            list)
+      (when (or (cdr var) (consp (car var)))
+        (setq last (caar list))))
+    `(while (let* ,(nreverse list)
+              (and ,(caar list)
+                   (progn ,(macroexp-progn (or body '(t))) t))))))
+
 ;;;; Defined in files.el
 
 (compat-defun file-parent-directory (filename)
diff --git a/compat-tests.el b/compat-tests.el
index 5c5c4f2df0..38fcc724b9 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -2135,5 +2135,68 @@ being compared against."
     (should (eq (lookup-key map "a") nil))
     (should (eq (lookup-key super "a") nil))))
 
+(ert-deftest compat-ref-while-let ()
+  "Check if the real `while-let' behaves as expected."
+  (skip-unless (fboundp 'while-let))
+  ;; Basic test
+  (let ((list (list 1 2 3 4 5)))
+    (while-let ((one (pop list))
+                (two (pop list)))
+      (should one)
+      (should two)
+      (should (< one two)))
+    (should (null list)))
+  ;; Practical test
+  (with-temp-buffer
+    (insert "1 2 3 4 1 2 3 4 1 2 3 4")
+    (goto-char (point-min))
+    (let ((count 0))
+      (while-let (((search-forward-regexp "2" nil t))
+                  (match (match-string 0))
+                  ((string= match "2")))
+        (setq count (1+ count)))
+      (should (= count 3))))
+  ;; Edge cases
+  (catch 'break
+    (while-let ()
+      (throw 'break (should t))))
+  (while-let ((()))
+    (should nil))
+  (while-let ((test nil))
+    (should nil))
+  (while-let (((ignore)))
+    (should nil)))
+
+(ert-deftest compat-impl-while-let ()
+  "Check if the compat `while-let' behaves as expected."
+  ;; Basic test
+  (let ((list (list 1 2 3 4 5)))
+    (compat--while-let ((one (pop list))
+                (two (pop list)))
+      (should one)
+      (should two)
+      (should (< one two)))
+    (should (null list)))
+  ;; Practical test
+  (with-temp-buffer
+    (insert "1 2 3 4 1 2 3 4 1 2 3 4")
+    (goto-char (point-min))
+    (let ((count 0))
+      (compat--while-let (((search-forward-regexp "2" nil t))
+                  (match (match-string 0))
+                  ((string= match "2")))
+        (setq count (1+ count)))
+      (should (= count 3))))
+  ;; Edge cases
+  (catch 'break
+    (compat--while-let ()
+      (throw 'break (should t))))
+  (compat--while-let ((()))
+    (should nil))
+  (compat--while-let ((test nil))
+    (should nil))
+  (compat--while-let (((ignore)))
+    (should nil)))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index da6cee008b..c488bb7d12 100644
--- a/compat.texi
+++ b/compat.texi
@@ -2825,6 +2825,14 @@ Here's an example:
 @end lisp
 @end defun
 
+@c copied from lispref/control.texi
+@defmac while-let spec then-forms...
+Like @code{when-let}, but repeat until a binding in @var{spec} is
+@code{nil}.  The return value is always @code{nil}.
+
+This is comparable to @code{and-let*}.
+@end defmac
+
 @subsection Prefixed Definitions
 These functions are prefixed with @code{compat} prefix, and will require
 manual loading even after the release of Compat 29.1.0.0: