compat-31: New functions take-while, drop-while, all, any

Author: minad

NEWS.org

@@ -17,6 +17,7 @@
 - compat-31: New extended function =seconds-to-string=.
 - compat-31: New function =hash-table-contains-p=.
 - compat-31: New function =remove-display-text-property=.
+- compat-31: New functions =drop-while=, =take-while=, =any=, =all=.
 - Drop support for Emacs 24.x. Emacs 25.1 is required now. In case
   Emacs 24.x support is still needed, Compat 30 can be used.
 

compat-31.el

@@ -29,6 +29,30 @@
 
 ;;;; Defined in subr.el
 
+(compat-defun take-while (pred list) ;; <compat-tests:take-while>
+  "Return the longest prefix of LIST whose elements satisfy PRED."
+  (let ((r nil))
+    (while (and list (funcall pred (car list)))
+      (push (car list) r)
+      (setq list (cdr list)))
+    (nreverse r)))
+
+(compat-defun drop-while (pred list) ;; <compat-tests:drop-while>
+  "Skip initial elements of LIST satisfying PRED and return the rest."
+  (while (and list (funcall pred (car list)))
+    (setq list (cdr list)))
+  list)
+
+(compat-defun all (pred list) ;; <compat-tests:all>
+  "Non-nil if PRED is true for all elements in LIST."
+  (not (drop-while pred list)))
+
+(compat-defun any (pred list) ;; <compat-tests:any>
+  "Non-nil if PRED is true for at least one element in LIST.
+Returns the LIST suffix starting at the first element that satisfies PRED,
+or nil if none does."
+  (drop-while (lambda (x) (not (funcall pred x))) list))
+
 (compat-defun hash-table-contains-p (key table) ;; <compat-tests:hash-table-contains-p>
   "Return non-nil if TABLE has an element with KEY."
   (declare (side-effect-free t))

compat-tests.el

@@ -3033,6 +3033,59 @@
   (with-temp-buffer
     (should-equal (take 3 (widget-create 'key)) '(key :value ""))))
 
+(ert-deftest compat-drop-while ()
+  (should (equal (drop-while #'hash-table-p nil) nil))
+  (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3))))
+    (should (equal (drop-while #'plusp ls) '(0 -1 -2 -3)))
+    (should (equal (drop-while (lambda (x) (plusp x)) ls) '(0 -1 -2 -3)))
+    (let ((z 1))
+      (should (equal (drop-while (lambda (x) (> x z)) ls) '(1 0 -1 -2 -3))))
+    (should (equal (drop-while #'bufferp ls) ls))
+    (should (equal (drop-while #'numberp ls) nil))
+    (should (equal (funcall (identity #'drop-while) #'plusp ls)
+                   '(0 -1 -2 -3)))))
+
+(ert-deftest compat-take-while ()
+  (should (equal (take-while #'hash-table-p nil) nil))
+  (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3))))
+    (should (equal (take-while #'plusp ls) '(3 2 1)))
+    (should (equal (take-while (lambda (x) (plusp x)) ls) '(3 2 1)))
+    (let ((z 1))
+      (should (equal (take-while (lambda (x) (> x z)) ls) '(3 2))))
+    (should (equal (take-while #'bufferp ls) nil))
+    (should (equal (take-while #'numberp ls) ls))
+    (should (equal (funcall (identity #'take-while) #'plusp ls)
+                   '(3 2 1)))))
+
+(ert-deftest compat-all ()
+  (should (equal (all #'hash-table-p nil) t))
+  (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3))))
+    (should (equal (all #'numberp ls) t))
+    (should (equal (all (lambda (x) (numberp x)) ls) t))
+    (should (equal (all #'plusp ls) nil))
+    (should (equal (all #'bufferp ls) nil))
+    (let ((z 9))
+      (should (equal (all (lambda (x) (< x z)) ls) t))
+      (should (equal (all (lambda (x) (> x (- z 9))) ls) nil))
+      (should (equal (all (lambda (x) (> x z)) ls) nil)))
+    (should (equal (funcall (identity #'all) #'plusp ls) nil))
+    (should (equal (funcall (identity #'all) #'numberp ls) t))))
+
+(ert-deftest compat-any ()
+  (should (equal (any #'hash-table-p nil) nil))
+  (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3))))
+    (should (equal (any #'numberp ls) ls))
+    (should (equal (any (lambda (x) (numberp x)) ls) ls))
+    (should (equal (any #'plusp ls) ls))
+    (should (equal (any #'zerop ls) '(0 -1 -2 -3)))
+    (should (equal (any #'bufferp ls) nil))
+    (let ((z 9))
+      (should (equal (any (lambda (x) (< x z)) ls) ls))
+      (should (equal (any (lambda (x) (< x (- z 9))) ls) '(-1 -2 -3)))
+      (should (equal (any (lambda (x) (> x z)) ls) nil)))
+    (should (equal (funcall (identity #'any) #'minusp ls) '(-1 -2 -3)))
+    (should (equal (funcall (identity #'any) #'stringp ls) nil))))
+
 (ert-deftest compat-hash-table-contains-p ()
   (let ((h (make-hash-table :test #'equal)))
     (puthash :foo t h)

compat.texi

@@ -3452,6 +3452,65 @@ older than 31.1.  Note that due to upstream changes, it might happen
 that there will be the need for changes, so use these functions with
 care.
 
+@c copied from lispref/lists.texi
+@defun drop-while pred list
+This function skips leading list elements for which the predicate @var{pred}
+returns non-@code{nil}, and returns the rest.
+
+@example
+@group
+(drop-while #'numberp '(1 2 a b 3 4))
+     @result{} (a b 3 4)
+@end group
+@end example
+@end defun
+
+@c copied from lispref/lists.texi
+@defun take-while pred list
+This function returns the leading list elements for which the predicate
+@var{pred} returns non-@code{nil}, and ignores the rest.
+
+In general,
+@code{(append (take-while @var{p} @var{list}) (drop-while @var{p} @var{list}))}
+will return a list equal to @var{list}.
+
+@example
+@group
+(take-while #'numberp '(1 2 a b 3 4))
+     @result{} (1 2)
+@end group
+@end example
+@end defun
+
+@c copied from lispref/lists.texi
+@defun all pred list
+This function returns @code{t} if @var{pred} is true for all elements in
+@var{list}.
+
+@example
+@group
+(all #'numberp '(1 2 3 4))     @result{} t
+(all #'numberp '(1 2 a b 3 4)) @result{} nil
+(all #'numberp '())            @result{} t
+@end group
+@end example
+@end defun
+
+@c copied from lispref/lists.texi
+@defun any pred list
+This function returns non-@code{nil} if @var{pred} is true for at least
+one element in @var{list}.  The returned value is the longest @var{list}
+suffix whose first element satisfies @var{pred}.
+
+@example
+@group
+(any #'symbolp '(1 2 3 4))     @result{} nil
+(any #'symbolp '(1 2 a b 3 4)) @result{} (a b 3 4)
+(any #'symbolp '())            @result{} nil
+@end group
+@end example
+@end defun
+
 @c copied from lispref/display.texi
 @defun remove-display-text-property start end spec &optional object
 Remove the display specification @var{spec} from the text from