branch: externals/compat
commit 8190769d9eb9258dd8361bd322d90228dc586770
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
compat-30: Add value< and sort with keyword arguments
---
NEWS.org | 2 +
compat-25.el | 17 ------
compat-30.el | 91 +++++++++++++++++++++++++++++
compat-tests.el | 61 +++++++++++++++++++-
compat.texi | 175 +++++++++++++++++++++++++++++++++++++++++++++++++-------
5 files changed, 308 insertions(+), 38 deletions(-)
diff --git a/NEWS.org b/NEWS.org
index 15e5e7b576..c51195b74a 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -4,6 +4,8 @@
* Development
+- compat-30: Add extended function =sort= with keyword arguments.
+- compat-30: New function =value<=.
- compat-30: Add extended =copy-tree= with support for copying records with
non-nil optional second argument.
- compat-30: New macro =static-if=.
diff --git a/compat-25.el b/compat-25.el
index 4a662fd493..9a0b13d622 100644
--- a/compat-25.el
+++ b/compat-25.el
@@ -40,23 +40,6 @@ usage: (bool-vector &rest OBJECTS)"
i (1+ i)))
vec))
-;;;; Defined in fns.c
-
-(compat-defun sort (seq predicate) ;; <compat-tests:sort>
- "Handle vector SEQ."
- :extended t
- (cond
- ((listp seq)
- (sort seq predicate))
- ((vectorp seq)
- (let* ((list (sort (append seq nil) predicate))
- (p list) (i 0))
- (while p
- (aset seq i (car p))
- (setq i (1+ i) p (cdr p)))
- (apply #'vector list)))
- (t (signal 'wrong-type-argument (list 'list-or-vector-p seq)))))
-
;;;; Defined in editfns.c
(compat-defalias format-message format) ;; <compat-tests:format-message>
diff --git a/compat-30.el b/compat-30.el
index 4d9c5b1e74..28f9faaa1a 100644
--- a/compat-30.el
+++ b/compat-30.el
@@ -219,5 +219,96 @@ enclosed in a `progn' form. ELSE-FORMS may be empty."
then-form
(cons 'progn else-forms)))
+;;;; Defined in fns.c
+
+(compat-defun value< (a b) ;; <compat-tests:value<>
+ "Return non-nil if A precedes B in standard value order.
+A and B must have the same basic type.
+Numbers are compared with <.
+Strings and symbols are compared with string-lessp.
+Lists, vectors, bool-vectors and records are compared lexicographically.
+Markers are compared lexicographically by buffer and position.
+Buffers and processes are compared by name.
+Other types are considered unordered and the return value will be ‘nil’."
+ (cond
+ ((and (number-or-marker-p a) (number-or-marker-p b))
+ (< a b))
+ ((or (and (stringp a) (stringp b))
+ (and (symbolp a) (symbolp b)))
+ (string< a b))
+ ((and (listp a) (listp b))
+ (while (and (consp a) (consp b) (equal (car a) (car b)))
+ (setq a (cdr a) b (cdr b)))
+ (cond
+ ((not b) nil)
+ ((not a) t)
+ ((and (consp a) (consp b)) (value< (car a) (car b)))
+ (t (value< a b))))
+ ((and (vectorp a) (vectorp b))
+ (let* ((na (length a))
+ (nb (length b))
+ (n (min na nb))
+ (i 0))
+ (while (and (< i n) (equal (aref a i) (aref b i)))
+ (cl-incf i))
+ (if (< i n) (value< (aref a i) (aref b i)) (< n nb))))
+ ;; TODO Add support for more types.
+ (t (error "value< unsupported type: %S %S" a b))))
+
+(compat-defun sort (seq &optional lessp &rest rest) ;; <compat-tests:sort>
+ "Sort function with support for keyword arguments.
+The following arguments are defined:
+
+:key FUNC -- FUNC is a function that takes a single element from SEQ and
+ returns the key value to be used in comparison. If absent or nil,
+ `identity' is used.
+
+:lessp FUNC -- FUNC is a function that takes two arguments and returns
+ non-nil if the first element should come before the second.
+ If absent or nil, `value<' is used.
+
+:reverse BOOL -- if BOOL is non-nil, the sorting order implied by FUNC is
+ reversed. This does not affect stability: equal elements still retain
+ their order in the input sequence.
+
+:in-place BOOL -- if BOOL is non-nil, SEQ is sorted in-place and returned.
+ Otherwise, a sorted copy of SEQ is returned and SEQ remains unmodified;
+ this is the default.
+
+For compatibility, the calling convention (sort SEQ LESSP) can also be used;
+in this case, sorting is always done in-place."
+ :extended t
+ (let ((in-place t) (orig-seq seq))
+ (when (or (not lessp) rest)
+ (setq
+ rest (if lessp (cons lessp rest) rest)
+ in-place (plist-get rest :in-place)
+ lessp (let ((key (plist-get rest :key))
+ (reverse (plist-get rest :reverse))
+ (< (or (plist-get rest :lessp) #'value<)))
+ (cond
+ ((and key reverse)
+ (lambda (a b) (not (funcall < (funcall key a) (funcall key
b)))))
+ (key
+ (lambda (a b) (funcall < (funcall key a) (funcall key b))))
+ (reverse
+ (lambda (a b) (not (funcall < a b))))
+ (t <)))
+ seq (if (or (eval-when-compile (< emacs-major-version 25)) in-place)
+ seq
+ (copy-sequence seq))))
+ ;; Emacs 24 does not support vectors. Convert to list.
+ (when (and (eval-when-compile (< emacs-major-version 25)) (vectorp seq))
+ (setq seq (append seq nil)))
+ (setq seq (sort seq lessp))
+ ;; Emacs 24: Convert back to vector.
+ (if (and (eval-when-compile (< emacs-major-version 25)) (vectorp orig-seq))
+ (if in-place
+ (cl-loop for i from 0 for x in seq
+ do (aset orig-seq i x)
+ finally return orig-seq)
+ (apply #'vector seq))
+ seq)))
+
(provide 'compat-30)
;;; compat-30.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index bac29aeb4b..64e1072a10 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1757,6 +1757,45 @@
(should-equal '(1 2 3 4) (flatten-tree '((1) nil 2 ((3 4)))))
(should-equal '(1 2 3 4) (flatten-tree '(((1 nil)) 2 (((3 nil nil) 4))))))
+(defmacro compat--should-value< (x y)
+ "Helper for (value< X Y) test."
+ `(progn
+ (should (value< ,x ,y))
+ (should-not (value< ,y ,x))))
+
+(ert-deftest compat-value< ()
+ ;; Type mismatch
+ (should-error (value< 'aa "aa"))
+ (should-error (value< 1 "aa"))
+ (should-error (value< 1 (cons 1 2)))
+ ;; Nil symbol
+ (compat--should-value< nil t)
+ (compat--should-value< nil 'nim)
+ (compat--should-value< nil 'nll)
+ (compat--should-value< 'mil nil)
+ ;; Atoms
+ (compat--should-value< 1 2)
+ (compat--should-value< "aa" "b")
+ (compat--should-value< 'aa 'b)
+ ;; Lists
+ (compat--should-value< nil '(1))
+ (compat--should-value< '(1 2) '(2 3))
+ (compat--should-value< '(1 2 3) '(2))
+ (compat--should-value< '(0 1 2) '(0 2 3))
+ (compat--should-value< '(0 1 2 3) '(0 2))
+ ;; Pairs and improper lists
+ (compat--should-value< nil '(1 . 2))
+ (compat--should-value< nil '(1 2 . 3))
+ (compat--should-value< '(1 . 2) '(2 . 2))
+ (compat--should-value< '(1 . 2) '(1 . 3))
+ (compat--should-value< '(1 2 . 3) '(1 2 . 4))
+ ;; Vectors
+ (compat--should-value< [] [1])
+ (compat--should-value< [1 2] [2 3])
+ (compat--should-value< [1 2 3] [2])
+ (compat--should-value< [0 1 2] [0 2 3])
+ (compat--should-value< [0 1 2 3] [0 2]))
+
(ert-deftest compat-sort ()
(should-equal (list 1 2 3) (sort (list 1 2 3) #'<))
(should-equal (list 1 2 3) (sort (list 1 3 2) #'<))
@@ -1764,14 +1803,34 @@
(should-equal (list 1 2 3) (compat-call sort (list 1 2 3) #'<))
(should-equal (list 1 2 3) (compat-call sort (list 1 3 2) #'<))
(should-equal (list 1 2 3) (compat-call sort (list 3 2 1) #'<))
+ ;; Test Emacs 25 support for vectors.
(should-equal [1 2 3] (compat-call sort (vector 1 2 3) #'<))
(should-equal [1 2 3] (compat-call sort (vector 1 3 2) #'<))
(should-equal [1 2 3] (compat-call sort (vector 3 2 1) #'<))
;; Test side effect
(let* ((vec (vector 4 5 8 3 1 2 3 2 3 4))
(sorted (compat-call sort vec #'>)))
+ (should (eq vec sorted))
(should-equal sorted [8 5 4 4 3 3 3 2 2 1])
- (should-equal vec [8 5 4 4 3 3 3 2 2 1])))
+ (should-equal vec [8 5 4 4 3 3 3 2 2 1]))
+ ;; Test Emacs 30 keyword arguments.
+ (should-equal '(1 2 3) (compat-call sort '(2 3 1)))
+ (should-equal '(3 2 1) (compat-call sort '(2 3 1) :reverse t))
+ (should-equal '((x 3) (y 2) (z 1)) (compat-call sort '((z 1) (x 3) (y 2))
:key #'car))
+ (should-equal '((z 1) (y 2) (x 3)) (compat-call sort '((z 1) (x 3) (y 2))
:key #'car :reverse t))
+ (should-equal '((z 1) (y 2) (x 3)) (compat-call sort '((z 1) (x 3) (y 2))
:key #'cadr))
+ (should-equal '((x 3) (y 2) (z 1)) (compat-call sort '((z 1) (x 3) (y 2))
:key #'cadr :reverse t))
+ (should-equal '(3 2 1) (compat-call sort '(2 3 1) :lessp #'>))
+ (should-equal '(1 2 3) (compat-call sort '(2 3 1) :reverse t :lessp #'>))
+ (should-equal '((30 1) (20 2) (10 3)) (compat-call sort '((30 1) (10 3) (20
2)) :key #'car :lessp #'>))
+ (should-equal '((10 3) (20 2) (30 1)) (compat-call sort '((30 1) (10 3) (20
2)) :key #'car :reverse t :lessp #'>))
+ (should-equal '((x 3) (y 2) (z 1)) (compat-call sort '((z 1) (x 3) (y 2))
:key #'cadr :lessp #'>))
+ (should-equal '((z 1) (y 2) (x 3)) (compat-call sort '((z 1) (x 3) (y 2))
:key #'cadr :reverse t :lessp #'>))
+ (let* ((vec (vector 4 5 8 3 1 2 3 2 3 4))
+ (sorted (compat-call sort vec :in-place t)))
+ (should (eq vec sorted))
+ (should-equal sorted [1 2 2 3 3 3 4 4 5 8])
+ (should-equal vec [1 2 2 3 3 3 4 4 5 8])))
(ert-deftest compat-replace-string-in-region ()
(with-temp-buffer
diff --git a/compat.texi b/compat.texi
index 825f348e8e..4177b56ad0 100644
--- a/compat.texi
+++ b/compat.texi
@@ -532,26 +532,6 @@ arguments, @var{objects}.
@xref{Bool-Vectors,,,elisp}.
@end defun
-@subsection Extended Definitions
-These functions must be called explicitly via @code{compat-call},
-since their calling convention or behavior was extended in Emacs 25.1:
-
-@defun compat-call@ sort sequence predicate
-This function sorts @var{sequence} stably. Note that this function
-doesn't work for all sequences; it may be used only for lists and
-vectors. If @var{sequence} is a list, it is modified destructively.
-This functions returns the sorted @var{sequence} and compares elements
-using @var{predicate}. A stable sort is one in which elements with
-equal sort keys maintain their relative order before and after the
-sort. Stability is important when successive sorts are used to order
-elements according to different criteria.
-
-@xref{Sequence Functions,,,elisp}.
-
-The compatibility version adds support for vectors to be sorted, not
-just lists.
-@end defun
-
@subsection Missing Definitions
Compat does not provide support for the following Lisp features
implemented in 25.1:
@@ -3350,6 +3330,63 @@ older than 30.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/sequences.texi
+@defun value< a b
+This function returns non-@code{nil} if @var{a} comes before @var{b}
+in the standard sorting order; this means that it returns @code{nil}
+when @var{b} comes before @var{a}, or if they are equal or unordered.
+
+The arguments @var{a} and @var{b} must have the same type.
+Specifically:
+
+@itemize @bullet
+@item
+Numbers are compared using @code{<}.
+@item
+Strings are compared using @code{string<} and symbols are compared by
+comparing their names as strings.
+@item
+Conses, lists, vectors and records are compared lexicographically.
+This means that the two sequences are compared element-wise from left
+to right until they differ, and the result is then that of
+@code{value<} on the first pair of differing elements. If one
+sequence runs out of elements before the other, the shorter sequence
+comes before the longer.
+@item
+Markers are compared first by buffer, then by position.
+@item
+Buffers and processes are compared by comparing their names as
+strings. Dead buffers (whose name is @code{nil}) will compare before
+any live buffer.
+@item
+Other types are considered unordered and the return value will be
+@code{nil}.
+@end itemize
+
+Examples:
+@example
+(value< -4 3.5) @result{} t
+(value< "dog" "cat") @result{} nil
+(value< 'yip 'yip) @result{} nil
+(value< '(3 2) '(3 2 0)) @result{} t
+(value< [3 2 "a"] [3 2 "b"]) @result{} t
+@end example
+
+@noindent
+Note that @code{nil} is treated as either a symbol or an empty list,
+depending on what it is compared against:
+
+@example
+(value< nil '(0)) @result{} t
+(value< 'nib nil) @result{} t
+@end example
+
+@noindent
+There is no limit to the length of sequences (lists, vectors and so
+on) that can be compared, but @code{value<} may fail with an error if
+used to compare circular or deeply nested data structures.
+@end defun
+
@c based on lispref/lists.texi
@defun drop n list
This function is an alias for @code{nthcdr}. It returns the @var{n}th
@@ -3466,6 +3503,104 @@ Here is an example of its use from CC Mode, which
prevents a
These functions must be called explicitly via @code{compat-call},
since their calling convention or behavior was extended in Emacs 30.1:
+@c copied from lisp/sequences.texi
+@defun compat-call@ sort sequence &rest keyword-args
+This function sorts @var{sequence}, which must be a list or vector,
+and returns a sorted sequence of the same type. The sort is stable,
+which means that elements with equal sort keys maintain their relative
+order. It takes the following optional keyword arguments:
+
+@table @code
+@item :key @var{keyfunc}
+Use @var{keyfunc}, a function that takes a single element from
+@var{sequence} and returns its key value, to generate the keys used in
+comparison. If this argument is absent or if @var{keyfunc} is
+@code{nil} then @code{identity} is assumed; that is, the elements
+themselves are used as sorting keys.
+
+@item :lessp @var{predicate}
+Use @var{predicate} to order the keys. @var{predicate} is a function
+that takes two sort keys as arguments and returns non-@code{nil} if
+the first should come before the second. If this argument is absent
+or @var{predicate} is @code{nil}, then @code{value<} is used, which is
+applicable to many different Lisp types and generally sorts in
+ascending order.
+
+For consistency, any predicate must obey the following rules:
+@itemize @bullet
+@item
+It must be @dfn{antisymmetric}: it cannot both order @var{a} before
+@var{b} and @var{b} before @var{a}.
+@item
+It must be @dfn{transitive}: if it orders @var{a} before @var{b} and
+@var{b} before @var{c}, then it must also order @var{a} before @var{c}.
+@end itemize
+
+@item :reverse @var{flag}
+If @var{flag} is non-@code{nil}, the sorting order is reversed. With
+the default @code{:lessp} predicate this means sorting in descending order.
+
+@item :in-place @var{flag}
+If @var{flag} is non-@code{nil}, then @var{sequence} is sorted
+in-place (destructively) and returned. If @code{nil}, or if this
+argument is not given, a sorted copy of the input is returned and
+@var{sequence} itself remains unmodified. In-place sorting is
+slightly faster, but the original sequence is lost.
+@end table
+
+If the default behaviour is not suitable for your needs, it is usually
+easier and faster to supply a new @code{:key} function than a
+different @code{:lessp} predicate. For example, consider sorting
+these strings:
+
+@example
+@group
+(setq numbers '("one" "two" "three" "four" "five" "six"))
+(sort numbers)
+ @result{} ("five" "four" "one" "six" "three" "two")
+@end group
+@end example
+
+You can sort the strings by length instead by supplying a different key
+function:
+
+@example
+@group
+(sort numbers :key #'length)
+ @result{} ("one" "two" "six" "four" "five" "three")
+@end group
+@end example
+
+@noindent
+Note how strings of the same length keep their original order, thanks to
+the sorting stability. Now suppose you want to sort by length, but use
+the string contents to break ties. The easiest way is to specify a key
+function that transforms an element to a value that is sorted this way.
+Since @code{value<} orders compound objects (conses, lists,
+vectors and records) lexicographically, you could do:
+
+@example
+@group
+(sort numbers :key (lambda (x) (cons (length x) x)))
+ @result{} ("one" "six" "two" "five" "four" "three")
+@end group
+@end example
+
+@noindent
+because @code{(3 . "six")} is ordered before @code{(3 . "two")} and so on.
+
+For compatibility with previous versions of Emacs, the @code{sort}
+function can also be called using the fixed two-argument form:
+
+@example
+(@code{sort} @var{sequence} @var{predicate})
+@end example
+
+@noindent
+where @var{predicate} is the @code{:lessp} argument. When using this
+form, sorting is always done in-place.
+@end defun
+
@c based on lisp/minibuffer.el
@defun compat-call@ completion-metadata-get metadata prop
Get property @var{prop} from completion @var{metadata}. If the
