diff options
| -rw-r--r-- | NEWS.org | 1 | ||||
| -rw-r--r-- | compat-31.el | 24 | ||||
| -rw-r--r-- | compat-tests.el | 53 | ||||
| -rw-r--r-- | compat.texi | 59 |
4 files changed, 137 insertions, 0 deletions
@@ -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. diff --git a/compat-31.el b/compat-31.el index 420a899..83421d9 100644 --- a/compat-31.el +++ b/compat-31.el @@ -29,6 +29,30 @@ ;;;; Defined in subr.el +(compat-defun take-while (pred list) + "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) + "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) + "Non-nil if PRED is true for all elements in LIST." + (not (drop-while pred list))) + +(compat-defun any (pred list) + "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)) diff --git a/compat-tests.el b/compat-tests.el index f07bed9..5272576 100644 --- a/compat-tests.el +++ b/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) diff --git a/compat.texi b/compat.texi index 99c4d92..a01b250 100644 --- a/compat.texi +++ b/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 |