diff options
| -rw-r--r-- | .github/workflows/makefile.yml | 5 | ||||
| -rw-r--r-- | .github/workflows/seq-24.el | 496 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | NEWS.org | 19 | ||||
| -rw-r--r-- | README.md | 2 | ||||
| -rw-r--r-- | compat-25.el | 260 | ||||
| -rw-r--r-- | compat-26.el | 8 | ||||
| -rw-r--r-- | compat-28.el | 8 | ||||
| -rw-r--r-- | compat-29.el | 50 | ||||
| -rw-r--r-- | compat-30.el | 24 | ||||
| -rw-r--r-- | compat-31.el | 393 | ||||
| -rw-r--r-- | compat-macs.el | 2 | ||||
| -rw-r--r-- | compat-tests.el | 524 | ||||
| -rw-r--r-- | compat.el | 8 | ||||
| -rw-r--r-- | compat.texi | 534 |
15 files changed, 1025 insertions, 1312 deletions
diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml index c2bc49f..6326d29 100644 --- a/.github/workflows/makefile.yml +++ b/.github/workflows/makefile.yml @@ -19,15 +19,12 @@ jobs: strategy: matrix: # See https://github.com/purcell/setup-emacs/blob/master/.github/workflows/test.yml - emacs-version: [24.4, 24.5, 25.1, 25.2, 25.3, 26.1, 26.2, 26.3, 27.1, 27.2, 28.1, 28.2, 29.1, 29.2, 29.3, 29.4, 30.1, snapshot] # release-snapshot + emacs-version: [25.1, 25.2, 25.3, 26.1, 26.2, 26.3, 27.1, 27.2, 28.1, 28.2, 29.1, 29.2, 29.3, 29.4, 30.1, snapshot] # release-snapshot steps: - uses: actions/checkout@v4 - uses: purcell/setup-emacs@master with: version: ${{ matrix.emacs-version }} - - name: Provide seq.el on Emacs 24 - if: ${{ startsWith(matrix.emacs-version, '24.') }} - run: mv .github/workflows/seq-24.el seq.el - name: Basic checks run: make check - name: Run interpreted tests diff --git a/.github/workflows/seq-24.el b/.github/workflows/seq-24.el deleted file mode 100644 index 78dfe4b..0000000 --- a/.github/workflows/seq-24.el +++ /dev/null @@ -1,496 +0,0 @@ -;;; seq.el --- seq.el implementation for Emacs 24.x -*- lexical-binding: t -*- - -;; Copyright (C) 2014-2020 Free Software Foundation, Inc. - -;; Author: Nicolas Petton <nicolas@petton.fr> -;; Keywords: sequences - -;; Maintainer: emacs-devel@gnu.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Sequence-manipulation functions that complement basic functions -;; provided by subr.el. -;; -;; All functions are prefixed with "seq-". -;; -;; All provided functions work on lists, strings and vectors. -;; -;; Functions taking a predicate or iterating over a sequence using a -;; function as argument take the function as their first argument and -;; the sequence as their second argument. All other functions take -;; the sequence as their first argument. - -;;; Code: - -(defmacro seq-doseq (spec &rest body) - "Loop over a sequence. -Similar to `dolist' but can be applied to lists, strings, and vectors. - -Evaluate BODY with VAR bound to each element of SEQ, in turn. - -\(fn (VAR SEQ) BODY...)" - (declare (indent 1) (debug ((symbolp form &optional form) body))) - (let ((length (make-symbol "length")) - (seq (make-symbol "seq")) - (index (make-symbol "index"))) - `(let* ((,seq ,(cadr spec)) - (,length (if (listp ,seq) nil (seq-length ,seq))) - (,index (if ,length 0 ,seq))) - (while (if ,length - (< ,index ,length) - (consp ,index)) - (let ((,(car spec) (if ,length - (prog1 (seq-elt ,seq ,index) - (setq ,index (+ ,index 1))) - (pop ,index)))) - ,@body))))) - -;; Implementation of `seq-let' compatible with Emacs<25.1. -(defmacro seq-let (args sequence &rest body) - "Bind the variables in ARGS to the elements of SEQUENCE then evaluate BODY. - -ARGS can also include the `&rest' marker followed by a variable -name to be bound to the rest of SEQUENCE." - (declare (indent 2) (debug t)) - (let ((seq-var (make-symbol "seq"))) - `(let* ((,seq-var ,sequence) - ,@(seq--make-bindings args seq-var)) - ,@body))) - -(defun seq-drop (sequence n) - "Return a subsequence of SEQUENCE without its first N elements. -The result is a sequence of the same type as SEQUENCE. - -If N is a negative integer or zero, SEQUENCE is returned." - (if (<= n 0) - sequence - (if (listp sequence) - (seq--drop-list sequence n) - (let ((length (seq-length sequence))) - (seq-subseq sequence (min n length) length))))) - -(defun seq-take (sequence n) - "Return a subsequence of SEQUENCE with its first N elements. -The result is a sequence of the same type as SEQUENCE. - -If N is a negative integer or zero, an empty sequence is -returned." - (if (listp sequence) - (seq--take-list sequence n) - (seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))) - -(defun seq-drop-while (predicate sequence) - "Return a sequence from the first element for which (PREDICATE element) is nil in SEQUENCE. -The result is a sequence of the same type as SEQUENCE." - (if (listp sequence) - (seq--drop-while-list predicate sequence) - (seq-drop sequence (seq--count-successive predicate sequence)))) - -(defun seq-take-while (predicate sequence) - "Return the successive elements for which (PREDICATE element) is non-nil in SEQUENCE. -The result is a sequence of the same type as SEQUENCE." - (if (listp sequence) - (seq--take-while-list predicate sequence) - (seq-take sequence (seq--count-successive predicate sequence)))) - -(defun seq-filter (predicate sequence) - "Return a list of all the elements for which (PREDICATE element) is non-nil in SEQUENCE." - (let ((exclude (make-symbol "exclude"))) - (delq exclude (seq-map (lambda (elt) - (if (funcall predicate elt) - elt - exclude)) - sequence)))) - -(defun seq-map-indexed (function sequence) - "Return the result of applying FUNCTION to each element of SEQUENCE. -Unlike `seq-map', FUNCTION takes two arguments: the element of -the sequence, and its index within the sequence." - (let ((index 0)) - (seq-map (lambda (elt) - (prog1 - (funcall function elt index) - (setq index (1+ index)))) - sequence))) - -(defun seq-remove (predicate sequence) - "Return a list of all the elements for which (PREDICATE element) is nil in SEQUENCE." - (seq-filter (lambda (elt) (not (funcall predicate elt))) - sequence)) - -(defun seq-reduce (function sequence initial-value) - "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. - -Return the result of calling FUNCTION with INITIAL-VALUE and the -first element of SEQUENCE, then calling FUNCTION with that result and -the second element of SEQUENCE, then with that result and the third -element of SEQUENCE, etc. - -If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." - (if (seq-empty-p sequence) - initial-value - (let ((acc initial-value)) - (seq-doseq (elt sequence) - (setq acc (funcall function acc elt))) - acc))) - -(defun seq-some (predicate sequence) - "Return the first value for which if (PREDICATE element) is non-nil for in SEQUENCE." - (catch 'seq--break - (seq-doseq (elt sequence) - (let ((result (funcall predicate elt))) - (when result - (throw 'seq--break result)))) - nil)) - -(defun seq-find (predicate sequence &optional default) - "Return the first element for which (PREDICATE element) is non-nil in SEQUENCE. -If no element is found, return DEFAULT. - -Note that `seq-find' has an ambiguity if the found element is -identical to DEFAULT, as it cannot be known if an element was -found or not." - (catch 'seq--break - (seq-doseq (elt sequence) - (when (funcall predicate elt) - (throw 'seq--break elt))) - default)) - -(defun seq-every-p (predicate sequence) - "Return non-nil if (PREDICATE element) is non-nil for all elements of the sequence SEQUENCE." - (catch 'seq--break - (seq-doseq (elt sequence) - (or (funcall predicate elt) - (throw 'seq--break nil))) - t)) - -(defun seq-count (predicate sequence) - "Return the number of elements for which (PREDICATE element) is non-nil in SEQUENCE." - (let ((count 0)) - (seq-doseq (elt sequence) - (when (funcall predicate elt) - (setq count (+ 1 count)))) - count)) - -(defun seq-empty-p (sequence) - "Return non-nil if the sequence SEQUENCE is empty, nil otherwise." - (if (listp sequence) - (null sequence) - (= 0 (seq-length sequence)))) - -(defun seq-sort (predicate sequence) - "Return a sorted sequence comparing using PREDICATE the elements of SEQUENCE. -The result is a sequence of the same type as SEQUENCE." - (if (listp sequence) - (sort (seq-copy sequence) predicate) - (let ((result (seq-sort predicate (append sequence nil)))) - (seq-into result (type-of sequence))))) - -(defun seq-sort-by (function pred sequence) - "Sort SEQUENCE using PRED as a comparison function. -Elements of SEQUENCE are transformed by FUNCTION before being -sorted. FUNCTION must be a function of one argument." - (seq-sort (lambda (a b) - (funcall pred - (funcall function a) - (funcall function b))) - sequence)) - -(defun seq-contains (sequence elt &optional testfn) - "Return the first element in SEQUENCE that equals to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." - (seq-some (lambda (e) - (funcall (or testfn #'equal) elt e)) - sequence)) - -(defun seq-set-equal-p (sequence1 sequence2 &optional testfn) - "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. -Equality is defined by TESTFN if non-nil or by `equal' if nil." - (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1) - (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2))) - -(defun seq-position (sequence elt &optional testfn) - "Return the index of the first element in SEQUENCE that is equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." - (let ((index 0)) - (catch 'seq--break - (seq-doseq (e sequence) - (when (funcall (or testfn #'equal) e elt) - (throw 'seq--break index)) - (setq index (1+ index))) - nil))) - -(defun seq-uniq (sequence &optional testfn) - "Return a list of the elements of SEQUENCE with duplicates removed. -TESTFN is used to compare elements, or `equal' if TESTFN is nil." - (let ((result '())) - (seq-doseq (elt sequence) - (unless (seq-contains result elt testfn) - (setq result (cons elt result)))) - (nreverse result))) - -(defun seq-subseq (sequence start &optional end) - "Return the subsequence of SEQUENCE from START to END. -If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end." - (cond ((or (stringp sequence) (vectorp sequence)) (substring sequence start end)) - ((listp sequence) - (let (len (errtext (format "Bad bounding indices: %s, %s" start end))) - (and end (< end 0) (setq end (+ end (setq len (seq-length sequence))))) - (if (< start 0) (setq start (+ start (or len (setq len (seq-length sequence)))))) - (when (> start 0) - (setq sequence (nthcdr (1- start) sequence)) - (or sequence (error "%s" errtext)) - (setq sequence (cdr sequence))) - (if end - (let ((res nil)) - (while (and (>= (setq end (1- end)) start) sequence) - (push (pop sequence) res)) - (or (= (1+ end) start) (error "%s" errtext)) - (nreverse res)) - (seq-copy sequence)))) - (t (error "Unsupported sequence: %s" sequence)))) - -(defun seq-concatenate (type &rest seqs) - "Concatenate, into a sequence of type TYPE, the sequences SEQS. -TYPE must be one of following symbols: vector, string or list. - -\n(fn TYPE SEQUENCE...)" - (pcase type - (`vector (apply #'vconcat seqs)) - (`string (apply #'concat seqs)) - (`list (apply #'append (append seqs '(nil)))) - (_ (error "Not a sequence type name: %S" type)))) - -(defun seq-mapcat (function sequence &optional type) - "Concatenate the result of applying FUNCTION to each element of SEQUENCE. -The result is a sequence of type TYPE, or a list if TYPE is nil." - (apply #'seq-concatenate (or type 'list) - (seq-map function sequence))) - -(defun seq-mapn (function sequence &rest seqs) - "Like `seq-map' but FUNCTION is mapped over all SEQS. -The arity of FUNCTION must match the number of SEQS, and the -mapping stops on the shortest sequence. -Return a list of the results. - -\(fn FUNCTION SEQS...)" - (let ((result nil) - (seqs (seq-map (lambda (s) - (seq-into s 'list)) - (cons sequence seqs)))) - (while (not (memq nil seqs)) - (push (apply function (seq-map #'car seqs)) result) - (setq seqs (seq-map #'cdr seqs))) - (nreverse result))) - -(defun seq-partition (sequence n) - "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N. -The last sequence may contain less than N elements. If N is a -negative integer or 0, nil is returned." - (unless (< n 1) - (let ((result '())) - (while (not (seq-empty-p sequence)) - (push (seq-take sequence n) result) - (setq sequence (seq-drop sequence n))) - (nreverse result)))) - -(defun seq-intersection (seq1 seq2 &optional testfn) - "Return a list of the elements that appear in both SEQ1 and SEQ2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." - (seq-reduce (lambda (acc elt) - (if (seq-contains seq2 elt testfn) - (cons elt acc) - acc)) - (seq-reverse seq1) - '())) - -(defun seq-difference (seq1 seq2 &optional testfn) - "Return a list of the elements that appear in SEQ1 but not in SEQ2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." - (seq-reduce (lambda (acc elt) - (if (not (seq-contains seq2 elt testfn)) - (cons elt acc) - acc)) - (seq-reverse seq1) - '())) - -(defun seq-group-by (function sequence) - "Apply FUNCTION to each element of SEQUENCE. -Separate the elements of SEQUENCE into an alist using the results as -keys. Keys are compared using `equal'." - (seq-reduce - (lambda (acc elt) - (let* ((key (funcall function elt)) - (cell (assoc key acc))) - (if cell - (setcdr cell (push elt (cdr cell))) - (push (list key elt) acc)) - acc)) - (seq-reverse sequence) - nil)) - -(defalias 'seq-reverse - (if (ignore-errors (reverse [1 2])) - #'reverse - (lambda (sequence) - "Return the reversed copy of list, vector, or string SEQUENCE. -See also the function `nreverse', which is used more often." - (let ((result '())) - (seq-map (lambda (elt) (push elt result)) - sequence) - (if (listp sequence) - result - (seq-into result (type-of sequence))))))) - -(defun seq-into (sequence type) - "Convert the sequence SEQUENCE into a sequence of type TYPE. -TYPE can be one of the following symbols: vector, string or list." - (pcase type - (`vector (seq--into-vector sequence)) - (`string (seq--into-string sequence)) - (`list (seq--into-list sequence)) - (_ (error "Not a sequence type name: %S" type)))) - -(defun seq-min (sequence) - "Return the smallest element of SEQUENCE. -SEQUENCE must be a sequence of numbers or markers." - (apply #'min (seq-into sequence 'list))) - -(defun seq-max (sequence) - "Return the largest element of SEQUENCE. -SEQUENCE must be a sequence of numbers or markers." - (apply #'max (seq-into sequence 'list))) - -(defun seq-random-elt (sequence) - "Return a random element from SEQUENCE. -Signal an error if SEQUENCE is empty." - (if (seq-empty-p sequence) - (error "Sequence cannot be empty") - (seq-elt sequence (random (seq-length sequence))))) - -(defun seq--drop-list (list n) - "Return a list from LIST without its first N elements. -This is an optimization for lists in `seq-drop'." - (nthcdr n list)) - -(defun seq--take-list (list n) - "Return a list from LIST made of its first N elements. -This is an optimization for lists in `seq-take'." - (let ((result '())) - (while (and list (> n 0)) - (setq n (1- n)) - (push (pop list) result)) - (nreverse result))) - -(defun seq--drop-while-list (predicate list) - "Return a list from the first element for which (PREDICATE element) is nil in LIST. -This is an optimization for lists in `seq-drop-while'." - (while (and list (funcall predicate (car list))) - (setq list (cdr list))) - list) - -(defun seq--take-while-list (predicate list) - "Return the successive elements for which (PREDICATE element) is non-nil in LIST. -This is an optimization for lists in `seq-take-while'." - (let ((result '())) - (while (and list (funcall predicate (car list))) - (push (pop list) result)) - (nreverse result))) - -(defun seq--count-successive (predicate sequence) - "Return the number of successive elements for which (PREDICATE element) is non-nil in SEQUENCE." - (let ((n 0) - (len (seq-length sequence))) - (while (and (< n len) - (funcall predicate (seq-elt sequence n))) - (setq n (+ 1 n))) - n)) - -;; Helper function for the Backward-compatible version of `seq-let' -;; for Emacs<25.1. -(defun seq--make-bindings (args sequence &optional bindings) - "Return a list of bindings of the variables in ARGS to the elements of a sequence. -if BINDINGS is non-nil, append new bindings to it, and return -BINDINGS." - (let ((index 0) - (rest-marker nil)) - (seq-doseq (name args) - (unless rest-marker - (pcase name - ((pred seqp) - (setq bindings (seq--make-bindings (seq--elt-safe args index) - `(seq--elt-safe ,sequence ,index) - bindings))) - (`&rest - (progn (push `(,(seq--elt-safe args (1+ index)) - (seq-drop ,sequence ,index)) - bindings) - (setq rest-marker t))) - (_ - (push `(,name (seq--elt-safe ,sequence ,index)) bindings)))) - (setq index (1+ index))) - bindings)) - -(defun seq--elt-safe (sequence n) - "Return element of SEQUENCE at the index N. -If no element is found, return nil." - (when (or (listp sequence) - (and (sequencep sequence) - (> (seq-length sequence) n))) - (seq-elt sequence n))) - -(defun seq--activate-font-lock-keywords () - "Activate font-lock keywords for some symbols defined in seq." - (font-lock-add-keywords 'emacs-lisp-mode - '("\\<seq-doseq\\>" "\\<seq-let\\>"))) - -(defalias 'seq-copy #'copy-sequence) -(defalias 'seq-elt #'elt) -(defalias 'seq-length #'length) -(defalias 'seq-do #'mapc) -(defalias 'seq-each #'seq-do) -(defalias 'seq-map #'mapcar) -(defalias 'seqp #'sequencep) - -(defun seq--into-list (sequence) - "Concatenate the elements of SEQUENCE into a list." - (if (listp sequence) - sequence - (append sequence nil))) - -(defun seq--into-vector (sequence) - "Concatenate the elements of SEQUENCE into a vector." - (if (vectorp sequence) - sequence - (vconcat sequence))) - -(defun seq--into-string (sequence) - "Concatenate the elements of SEQUENCE into a string." - (if (stringp sequence) - sequence - (concat sequence))) - -(unless (fboundp 'elisp--font-lock-flush-elisp-buffers) - ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others) - ;; we automatically highlight macros. - (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords)) - -(provide 'seq) -;;; seq.el ends here @@ -40,12 +40,12 @@ endif EMACS = emacs MAKEINFO = makeinfo -BYTEC = compat-25.elc \ - compat-26.elc \ +BYTEC = compat-26.elc \ compat-27.elc \ compat-28.elc \ compat-29.elc \ compat-30.elc \ + compat-31.elc \ compat.elc \ compat-macs.elc \ compat-tests.elc @@ -1,6 +1,25 @@ #+link: compat-gh https://github.com/emacs-compat/compat/issues/ #+options: toc:nil num:nil author:nil +* Development (emacs-31 branch) + +- compat-28: New pcase pattern =cl-type=. +- compat-31: New macros =static-when= and =static-unless=. +- compat-31: New functions =oddp= and =evenp=. +- compat-31: New functions =minusp= and =plusp=. +- compat-31: New macros =incf= and =decf=. +- compat-31: New function =color-blend=. +- compat-31: New function =completion-table-with-metadata=. +- compat-31: New function =completion-list-candidate-at-point=. +- compat-31: New macro =with-work-buffer=. +- compat-31: New function =unbuttonize-region=. +- 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. + * Development - compat-29: Add =string-glyph-compose= and =string-glyph-decompose=. @@ -1,7 +1,7 @@ COMPATibility Library for Emacs =============================== This is the source of compat.el, the forwards-compatibility library for (GNU) -Emacs Lisp, versions 24.4 and newer. The intended audience are package +Emacs Lisp, versions 25.1 and newer. The intended audience are package developers that are interested in using newer developments, without having to break compatibility. diff --git a/compat-25.el b/compat-25.el deleted file mode 100644 index ae7681f..0000000 --- a/compat-25.el +++ /dev/null @@ -1,260 +0,0 @@ -;;; compat-25.el --- Functionality added in Emacs 25.1 -*- lexical-binding: t; -*- - -;; Copyright (C) 2021-2026 Free Software Foundation, Inc. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Functionality added in Emacs 25.1, needed by older Emacs versions. - -;;; Code: - -(eval-when-compile (load "compat-macs.el" nil t t)) - -(compat-version "25.1") - -;;;; Defined in alloc.c - -(compat-defun bool-vector (&rest objects) ;; <compat-tests:bool-vector> - "Return a new bool-vector with specified arguments as elements. -Allows any number of arguments, including zero. -usage: (bool-vector &rest OBJECTS)" - (let ((vec (make-bool-vector (length objects) nil)) - (i 0)) - (while objects - (when (car objects) - (aset vec i t)) - (setq objects (cdr objects) - i (1+ i))) - vec)) - -;;;; Defined in editfns.c - -(compat-defalias format-message format) ;; <compat-tests:format-message> - -;;;; Defined in fileio.c - -(compat-defun directory-name-p (name) ;; <compat-tests:directory-name-p> - "Return non-nil if NAME ends with a directory separator character." - (eq (eval-when-compile - (if (memq system-type '(cygwin windows-nt ms-dos)) - ?\\ ?/)) - (aref name (1- (length name))))) - -;;;; Defined in doc.c - -(compat-defvar text-quoting-style nil ;; <compat-tests:text-quoting-style> - "Style to use for single quotes in help and messages. - -The value of this variable determines substitution of grave accents -and apostrophes in help output (but not for display of Info -manuals) and in functions like `message' and `format-message', but not -in `format'. - -The value should be one of these symbols: - `curve': quote with curved single quotes ‘like this’. - `straight': quote with straight apostrophes \\='like this\\='. - `grave': quote with grave accent and apostrophe \\=`like this\\='; - i.e., do not alter the original quote marks. - nil: like `curve' if curved single quotes are displayable, - and like `grave' otherwise. This is the default. - -You should never read the value of this variable directly from a Lisp -program. Use the function `text-quoting-style' instead, as that will -compute the correct value for the current terminal in the nil case.") - -;;;; Defined in simple.el - -;; `save-excursion' behaved like `save-mark-and-excursion' before 25.1. -(compat-defalias save-mark-and-excursion save-excursion) ;; <compat-tests:save-mark-and-excursion> - -(declare-function region-bounds nil) ;; Defined in compat-26.el -(compat-defun region-noncontiguous-p () ;; <compat-tests:region-noncontiguous-p> - "Return non-nil if the region contains several pieces. -An example is a rectangular region handled as a list of -separate contiguous regions for each line." - (let ((bounds (region-bounds))) (and (cdr bounds) bounds))) - -;;;; Defined in subr.el - -(compat-defun string-greaterp (string1 string2) ;; <compat-tests:string-greaterp> - "Return non-nil if STRING1 is greater than STRING2 in lexicographic order. -Case is significant. -Symbols are also allowed; their print names are used instead." - (string-lessp string2 string1)) - -(compat-defmacro with-file-modes (modes &rest body) ;; <compat-tests:with-file-modes> - "Execute BODY with default file permissions temporarily set to MODES. -MODES is as for `set-default-file-modes'." - (declare (indent 1) (debug t)) - (let ((umask (make-symbol "umask"))) - `(let ((,umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ,modes) - ,@body) - (set-default-file-modes ,umask))))) - -(compat-defmacro if-let (spec then &rest else) ;; <compat-tests:if-let> - "Bind variables according to SPEC and evaluate THEN or ELSE. -Evaluate each binding in turn, as in `let*', stopping if a -binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. - -Each element of SPEC is a list (SYMBOL VALUEFORM) that binds -SYMBOL to the value of VALUEFORM. An element can additionally be -of the form (VALUEFORM), which is evaluated and checked for nil; -i.e. SYMBOL can be omitted if only the test result is of -interest. It can also be of the form SYMBOL, then the binding of -SYMBOL is checked for nil. - -As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) -like \((SYMBOL SOMETHING)). This exists for backward compatibility -with an old syntax that accepted only one binding." - (declare (indent 2) - (debug ([&or (symbolp form) - (&rest [&or symbolp (symbolp form) (form)])] - body))) - (when (and (<= (length spec) 2) (not (listp (car spec)))) - ;; Adjust the single binding case - (setq spec (list spec))) - (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)))) - `(let* ,(nreverse list) - (if ,(caar list) ,then ,@else)))) - -(compat-defmacro when-let (spec &rest body) ;; <compat-tests:when-let> - "Bind variables according to SPEC and conditionally evaluate BODY. -Evaluate each binding in turn, stopping if a binding value is nil. -If all are non-nil, return the value of the last form in BODY. - -The variable list SPEC is the same as in `if-let'." - (declare (indent 1) (debug if-let)) - (list 'if-let spec (macroexp-progn body))) - -;;;; Defined in subr-x.el - -(compat-defun hash-table-empty-p (hash-table) ;; <compat-tests:hash-table-empty-p> - "Check whether HASH-TABLE is empty (has 0 elements)." - (zerop (hash-table-count hash-table))) - -(compat-defmacro thread-first (&rest forms) ;; <compat-tests:thread-first> - "Thread FORMS elements as the first argument of their successor. -Example: - (thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) -Is equivalent to: - (+ (- (/ (+ 5 20) 25)) 40) -Note how the single `-' got converted into a list before -threading." - (declare (indent 1) - (debug (form &rest [&or symbolp (sexp &rest form)]))) - (let ((body (car forms))) - (dolist (form (cdr forms)) - (when (symbolp form) - (setq form (list form))) - (setq body (append (list (car form)) - (list body) - (cdr form)))) - body)) - -(compat-defmacro thread-last (&rest forms) ;; <compat-tests:thread-last> - "Thread FORMS elements as the last argument of their successor. -Example: - (thread-last - 5 - (+ 20) - (/ 25) - - - (+ 40)) -Is equivalent to: - (+ 40 (- (/ 25 (+ 20 5)))) -Note how the single `-' got converted into a list before -threading." - (declare (indent 1) (debug thread-first)) - (let ((body (car forms))) - (dolist (form (cdr forms)) - (when (symbolp form) - (setq form (list form))) - (setq body (append form (list body)))) - body)) - -;;;; Defined in macroexp.el - -(compat-defun macroexp-parse-body (body) ;; <compat-tests:macroexp-parse-body> - "Parse a function BODY into (DECLARATIONS . EXPS)." - (let ((decls ())) - (while (and (cdr body) - (let ((e (car body))) - (or (stringp e) - (memq (car-safe e) - '(:documentation declare interactive cl-declare))))) - (push (pop body) decls)) - (cons (nreverse decls) body))) - -(compat-defun macroexp-quote (v) ;; <compat-tests:macroexp-quote> - "Return an expression E such that `(eval E)' is V. - -E is either V or (quote V) depending on whether V evaluates to -itself or not." - (if (and (not (consp v)) - (or (keywordp v) - (not (symbolp v)) - (memq v '(nil t)))) - v - (list 'quote v))) - -(compat-defun macroexpand-1 (form &optional environment) ;; <compat-tests:macroexpand-1> - "Perform (at most) one step of macro expansion." - (cond - ((consp form) - (let* ((head (car form)) - (env-expander (assq head environment))) - (if env-expander - (if (cdr env-expander) - (apply (cdr env-expander) (cdr form)) - form) - (if (not (and (symbolp head) (fboundp head))) - form - (let ((def (autoload-do-load (symbol-function head) head 'macro))) - (cond - ;; Follow alias, but only for macros, otherwise we may end up - ;; skipping an important compiler-macro (e.g. cl--block-wrapper). - ((and (symbolp def) (macrop def)) (cons def (cdr form))) - ((not (consp def)) form) - (t - (if (eq 'macro (car def)) - (apply (cdr def) (cdr form)) - form)))))))) - (t form))) - -;;;; Defined in minibuffer.el - -(compat-defun completion--category-override (category tag) ;; <compat-tests:completion-metadata-get> - "Return completion category override for CATEGORY and TAG." - (assq tag (cdr (assq category completion-category-overrides)))) - -(provide 'compat-25) -;;; compat-25.el ends here diff --git a/compat-26.el b/compat-26.el index 063c207..f1ab3a2 100644 --- a/compat-26.el +++ b/compat-26.el @@ -67,11 +67,7 @@ SEQUENCE may be a list, a vector, a boolean vector, or a string." Value is a list of one or more cons cells of the form (START . END). It will have more than one cons cell when the region is non-contiguous, see `region-noncontiguous-p' and `extract-rectangle-bounds'." - (if (eval-when-compile (< emacs-major-version 25)) - ;; FIXME: The `region-extract-function' of Emacs 24 has no support for the - ;; bounds argument. - (list (cons (region-beginning) (region-end))) - (funcall region-extract-function 'bounds))) + (funcall region-extract-function 'bounds)) ;;;; Defined in subr.el @@ -108,7 +104,7 @@ If you just want to check `major-mode', use `derived-mode-p'." (compat-defun alist-get (key alist &optional default remove testfn) ;; <compat-tests:alist-get> "Handle optional argument TESTFN." - :extended "25.1" + :extended t (ignore remove) (let ((x (if (not testfn) (assq key alist) diff --git a/compat-28.el b/compat-28.el index bf02bc2..54367a7 100644 --- a/compat-28.el +++ b/compat-28.el @@ -853,5 +853,13 @@ function will never return nil." :type-error "This field should contain a nonnegative integer" :match-alternatives '(natnump))) +;;;; Defined in pcase.el + +(compat-guard t ;; <compat-tests:pcase-cl-type> + (pcase-defmacro cl-type (type) + "Pcase pattern that matches objects of TYPE. +TYPE is a type descriptor as accepted by `cl-typep', which see." + `(pred (lambda (x) (cl-typep x ',type))))) + (provide 'compat-28) ;;; compat-28.el ends here diff --git a/compat-29.el b/compat-29.el index 9949aa0..554d1cd 100644 --- a/compat-29.el +++ b/compat-29.el @@ -584,47 +584,15 @@ be marked unmodified, effectively ignoring those changes." (equal ,hash (buffer-hash))) (restore-buffer-modified-p nil)))))))) -(compat-defun add-display-text-property (start end prop value ;; <compat-tests:add-display-text-property> - &optional object) - "Add display property PROP with VALUE to the text from START to END. -If any text in the region has a non-nil `display' property, those -properties are retained. - -If OBJECT is non-nil, it should be a string or a buffer. If nil, -this defaults to the current buffer." - (let ((sub-start start) - (sub-end 0) - disp) - (while (< sub-end end) - (setq sub-end (next-single-property-change sub-start 'display object - (if (stringp object) - (min (length object) end) - (min end (point-max))))) - (if (not (setq disp (get-text-property sub-start 'display object))) - ;; No old properties in this range. - (put-text-property sub-start sub-end 'display (list prop value) - object) - ;; We have old properties. - (let ((vector nil)) - ;; Make disp into a list. - (setq disp - (cond - ((vectorp disp) - (setq vector t) - (append disp nil)) - ((not (consp (car disp))) - (list disp)) - (t - disp))) - ;; Remove any old instances. - (when-let ((old (assoc prop disp))) - (setq disp (delete old disp))) - (setq disp (cons (list prop value) disp)) - (when vector - (setq disp (vconcat disp))) - ;; Finally update the range. - (put-text-property sub-start sub-end 'display disp object))) - (setq sub-start sub-end)))) +(compat-defun add-display-text-property (start end spec value &optional object) ;; <compat-tests:add-display-text-property> + "Add the display specification (SPEC VALUE) to the text from START to END. +If any text in the region has a non-nil `display' property, the existing +display specifications are retained. + +OBJECT is either a string or a buffer to add the specification to. +If omitted, OBJECT defaults to the current buffer." + (declare-function add-remove--display-text-property "compat-31") + (add-remove--display-text-property start end spec value object)) (compat-defmacro while-let (spec &rest body) ;; <compat-tests:while-let> "Bind variables according to SPEC and conditionally evaluate BODY. diff --git a/compat-30.el b/compat-30.el index e7e0d82..a3c9dcd 100644 --- a/compat-30.el +++ b/compat-30.el @@ -431,7 +431,7 @@ The following arguments are defined: 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) (reverse nil) (orig-seq seq)) + (let ((in-place t) (reverse nil)) (when (or (not lessp) rest) (setq rest (if lessp (cons lessp rest) rest) @@ -442,24 +442,10 @@ in this case, sorting is always done in-place." (if key (lambda (a b) (funcall < (funcall key a) (funcall key b))) <)) - seq (if (or (and (eval-when-compile (< emacs-major-version 25)) (vectorp orig-seq)) - 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 orig-seq)) - (setq seq (append seq nil))) - (setq seq (if reverse - (nreverse (sort (nreverse seq) lessp)) - (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))) + seq (if in-place seq (copy-sequence seq)))) + (if reverse + (nreverse (sort (nreverse seq) lessp)) + (sort seq lessp)))) ;;;; Defined in mule-cmds.el diff --git a/compat-31.el b/compat-31.el new file mode 100644 index 0000000..adf9672 --- /dev/null +++ b/compat-31.el @@ -0,0 +1,393 @@ +;;; compat-31.el --- Functionality added in Emacs 31 -*- lexical-binding: t; -*- + +;; Copyright (C) 2025-2026 Free Software Foundation, Inc. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Functionality added in Emacs 31, needed by older Emacs versions. + +;;; Code: + +(eval-when-compile (load "compat-macs.el" nil t t)) +(compat-require compat-30 "30.1") + +;; TODO Update to 31.1 as soon as the Emacs emacs-31 branch version bumped +(compat-version "31.0.50") + +;;;; 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)) + (let ((missing '#:missing)) + (not (eq (gethash key table missing) missing)))) + +(compat-defmacro static-when (condition &rest body) ;; <compat-tests:static-when> + "A conditional compilation macro. +Evaluate CONDITION at macro-expansion time. If it is non-nil, +expand the macro to evaluate all BODY forms sequentially and return +the value of the last one, or nil if there are none." + (declare (indent 1) (debug t)) + (if body + (if (eval condition lexical-binding) + (cons 'progn body) + nil) + (macroexp-warn-and-return (format-message "`static-when' with empty body") + (list 'progn nil nil) '(empty-body static-when) t))) + +(compat-defmacro static-unless (condition &rest body) ;; <compat-tests:static-unless> + "A conditional compilation macro. +Evaluate CONDITION at macro-expansion time. If it is nil, +expand the macro to evaluate all BODY forms sequentially and return +the value of the last one, or nil if there are none." + (declare (indent 1) (debug t)) + (if body + (if (eval condition lexical-binding) + nil + (cons 'progn body)) + (macroexp-warn-and-return (format-message "`static-unless' with empty body") + (list 'progn nil nil) '(empty-body static-unless) t))) + +(compat-defun oddp (integer) ;; <compat-tests:oddp> + "Return t if INTEGER is odd." + (not (eq (% integer 2) 0))) + +(compat-defun evenp (integer) ;; <compat-tests:evenp> + "Return t if INTEGER is even." + (eq (% integer 2) 0)) + +(compat-defun plusp (number) ;; <compat-tests:plusp> + "Return t if NUMBER is positive." + (> number 0)) + +(compat-defun minusp (number) ;; <compat-tests:minusp> + "Return t if NUMBER is negative." + (< number 0)) + +(compat-defmacro incf (place &optional delta) ;; <compat-tests:incf> + "Increment PLACE by DELTA (default to 1). + +The DELTA is first added to PLACE, and then stored in PLACE. +Return the incremented value of PLACE. + +See also `decf'." + (gv-letplace (getter setter) place + (funcall setter `(+ ,getter ,(or delta 1))))) + +(compat-defmacro decf (place &optional delta) ;; <compat-tests:decf> + "Decrement PLACE by DELTA (default to 1). + +The DELTA is first subtracted from PLACE, and then stored in PLACE. +Return the decremented value of PLACE. + +See also `incf'." + (gv-letplace (getter setter) place + (funcall setter `(- ,getter ,(or delta 1))))) + +;;;; Defined in color.el + +(compat-defun color-blend (a b &optional alpha) ;; <compat-tests:color-blend> + "Blend the two colors A and B in linear space with ALPHA. +A and B should be lists (RED GREEN BLUE), where each element is +between 0.0 and 1.0, inclusive. ALPHA controls the influence A +has on the result and should be between 0.0 and 1.0, inclusive. + +For instance: + + (color-blend \\='(1 0.5 1) \\='(0 0 0) 0.75) + => (0.75 0.375 0.75)" + (setq alpha (or alpha 0.5)) + (let (blend) + (dotimes (i 3) + (push (+ (* (nth i a) alpha) (* (nth i b) (- 1 alpha))) blend)) + (nreverse blend))) + +;;;; Defined in time-date.el + +(compat-defvar seconds-to-string ;; <compat-tests:seconds-to-string> + (list (list 1 "ms" 0.001) + (list 100 "s" 1) + (list (* 60 100) "m" 60.0) + (list (* 3600 30) "h" 3600.0) + (list (* 3600 24 400) "d" (* 3600.0 24.0)) + (list nil "y" (* 365.25 24 3600))) + "Formatting used by the function `seconds-to-string'.") + +(compat-defvar seconds-to-string-readable ;; <compat-tests:seconds-to-string> + `(("Y" "year" "years" ,(round (* 60 60 24 365.2425))) + ("M" "month" "months" ,(round (* 60 60 24 30.436875))) + ("w" "week" "weeks" ,(* 60 60 24 7)) + ("d" "day" "days" ,(* 60 60 24)) + ("h" "hour" "hours" ,(* 60 60)) + ("m" "minute" "minutes" 60) + ("s" "second" "seconds" 1)) + "Formatting used by the function `seconds-to-string' with READABLE set. +The format is an alist, with string keys ABBREV-UNIT, and elements like: + + (ABBREV-UNIT UNIT UNIT-PLURAL SECS) + +where UNIT is a unit of time, ABBREV-UNIT is the abbreviated form of +UNIT, UNIT-PLURAL is the plural form of UNIT, and SECS is the number of +seconds per UNIT.") + +(compat-defun seconds-to-string (delay &optional readable abbrev precision) ;; <compat-tests:seconds-to-string> + "Handle optional arguments READABLE, ABBREV and PRECISION." + :extended t + (cond + ((< delay 0) + (concat "-" (seconds-to-string (- delay) readable precision))) + (readable + (let* ((stsa seconds-to-string-readable) + (expanded (eq readable 'expanded)) + digits + (round-to (cond + ((wholenump precision) + (setq digits precision) + (expt 10 (- precision))) + ((and (floatp precision) (< precision 1.)) + (setq digits (- (floor (log precision 10)))) + precision) + (t (setq digits 0) 1))) + (dformat (if (> digits 0) (format "%%0.%df" digits))) + (padding (if abbrev "" " ")) + here cnt cnt-pre here-pre cnt-val isfloatp) + (if (= (round delay round-to) 0) + (format "0%s" (if abbrev "s" " seconds")) + (while (and (setq here (pop stsa)) stsa + (< (/ delay (nth 3 here)) 1))) + (or (and + expanded stsa ; smaller unit remains + (progn + (setq + here-pre here here (car stsa) + cnt-pre (floor (/ (float delay) (nth 3 here-pre))) + cnt (round + (/ (- (float delay) (* cnt-pre (nth 3 here-pre))) + (nth 3 here)) + round-to)) + (if (> cnt 0) t (setq cnt cnt-pre here here-pre here-pre nil)))) + (setq cnt (round (/ (float delay) (nth 3 here)) round-to))) + (setq cnt-val (* cnt round-to) + isfloatp (and (> digits 0) + (> (- cnt-val (floor cnt-val)) 0.))) + (cl-labels + ((unit (val here &optional plural) + (cond (abbrev (car here)) + ((and (not plural) (<= (floor val) 1)) (nth 1 here)) + (t (nth 2 here))))) + (concat + (when here-pre + (concat (number-to-string cnt-pre) padding + (unit cnt-pre here-pre) " ")) + (if isfloatp (format dformat cnt-val) + (number-to-string (floor cnt-val))) + padding + (unit cnt-val here isfloatp)))))) ; float formats are always plural + ((= 0 delay) "0s") + (t (let ((sts seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here)))))) + +;;;; Defined in minibuffer.el + +(compat-defun completion-list-candidate-at-point (&optional pt) ;; <compat-tests:completion-list-candidate-at-point> + "Candidate string and bounds at PT in completions buffer. +The return value has the format (STR BEG END). +The optional argument PT defaults to (point)." + (let ((pt (or pt (point))) beg end) + (cond + ((and (/= pt (point-max)) (get-text-property pt 'mouse-face)) + (setq end pt beg (1+ pt))) + ((and (/= pt (point-min)) (get-text-property (1- pt) 'mouse-face)) + (setq end (1- pt) beg pt))) + (when (and beg end) + (setq beg (previous-single-property-change beg 'mouse-face)) + (setq end (or (next-single-property-change end 'mouse-face) (point-max))) + (list (or (get-text-property beg 'completion--string) + (buffer-substring beg end)) + beg end)))) + +(compat-defun completion-table-with-metadata (table metadata) ;; <compat-tests:completion-table-with-metadata> + "Return new completion TABLE with METADATA. +METADATA should be an alist of completion metadata. See +`completion-metadata' for a list of supported metadata." + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata . ,metadata) + (complete-with-action action table string pred)))) + +;;;; Defined in subr-x.el + +(compat-defun add-remove--display-text-property (start end spec value &optional object remove) ;; <compat-tests:add-display-text-property> + "Helper function for `add-display-text-property' and `remove-display-text-property'." + (let ((sub-start start) + (sub-end 0) + (limit (if (stringp object) + (min (length object) end) + (min end (point-max)))) + disp) + (while (< sub-end end) + (setq sub-end (next-single-property-change sub-start 'display object + limit)) + (if (not (setq disp (get-text-property sub-start 'display object))) + ;; No old properties in this range. + (unless remove + (put-text-property sub-start sub-end 'display (list spec value) + object)) + ;; We have old properties. + (let ((changed nil) + type) + ;; Make disp into a list. + (setq disp + (cond + ((vectorp disp) + (setq type 'vector) + (seq-into disp 'list)) + ((or (not (consp (car-safe disp))) + ;; If disp looks like ((margin ...) ...), that's + ;; still a single display specification. + (eq (caar disp) 'margin)) + (setq type 'scalar) + (list disp)) + (t + (setq type 'list) + disp))) + ;; Remove any old instances. + (when-let* ((old (assoc spec disp))) + ;; If the property value was a list, don't modify the + ;; original value in place; it could be used by other + ;; regions of text. + (setq disp (if (eq type 'list) + (remove old disp) + (delete old disp)) + changed t)) + (unless remove + (setq disp (cons (list spec value) disp) + changed t)) + (when changed + (if (not disp) + (remove-text-properties sub-start sub-end '(display nil) object) + (when (eq type 'vector) + (setq disp (seq-into disp 'vector))) + ;; Finally update the range. + (put-text-property sub-start sub-end 'display disp object))))) + (setq sub-start sub-end)))) + +(compat-defun remove-display-text-property (start end spec &optional object) ;; <compat-tests:remove-display-text-property> + "Remove the display specification SPEC from the text from START to END. +SPEC is the car of the display specification to remove, e.g. `height'. +If any text in the region has other display specifications, those specs +are retained. + +OBJECT is either a string or a buffer to remove the specification from. +If omitted, OBJECT defaults to the current buffer." + (add-remove--display-text-property start end spec nil object 'remove)) + +(compat-defvar work-buffer--list nil ;; <compat-tests:with-work-buffer> + "List of work buffers.") + +(compat-defvar work-buffer-limit 10 ;; <compat-tests:with-work-buffer> + "Maximum number of reusable work buffers. +When this limit is exceeded, newly allocated work buffers are +automatically killed, which means that in a such case +`with-work-buffer' becomes equivalent to `with-temp-buffer'.") + +(compat-defun work-buffer--get () ;; <compat-tests:with-work-buffer> + "Get a work buffer." + (let ((buffer (pop work-buffer--list))) + (if (buffer-live-p buffer) + buffer + ;; `generate-new-buffer' and `get-buffer-create' accept an + ;; INHIBIT-BUFFER-HOOKS argument on Emacs 28 and newer. + ;; Unfortunately it is hard or not possible to port this back. See + ;; issue <compat-gh:42>. + (static-if (>= emacs-major-version 28) + (generate-new-buffer " *work*" t) + (generate-new-buffer " *work*"))))) + +(compat-defun work-buffer--release (buffer) ;; <compat-tests:with-work-buffer> + "Release work BUFFER. +Note that the Compat backport does not kill permanentely local +variables on Emacs 28 and older." + (if (buffer-live-p buffer) + (with-current-buffer buffer + (let ((inhibit-read-only t) deactivate-mark) + (erase-buffer)) + (delete-all-overlays) + (let (change-major-mode-hook) + ;; The KILL-PERMANENT argument is only supported by Emacs 29 + ;; and newer. + (static-if (>= emacs-major-version 29) + (kill-all-local-variables t) + (kill-all-local-variables))) + (push buffer work-buffer--list))) + (when (> (length work-buffer--list) work-buffer-limit) + (mapc #'kill-buffer (nthcdr work-buffer-limit work-buffer--list)) + (setq work-buffer--list (ntake work-buffer-limit work-buffer--list)))) + +(compat-defmacro with-work-buffer (&rest body) ;; <compat-tests:with-work-buffer> + "Create a work buffer, and evaluate BODY there like `progn'. +Like `with-temp-buffer', but reuse an already created temporary buffer +when possible, instead of creating a new one on each call. Note that +the Compat backport does not kill permanentely local variables on Emacs +28 and older, see `work-buffer--release'." + (declare (indent 0) (debug t)) + (let ((work-buffer (make-symbol "work-buffer"))) + `(let ((,work-buffer (work-buffer--get))) + (with-current-buffer ,work-buffer + (unwind-protect + (progn ,@body) + (work-buffer--release ,work-buffer)))))) + +;;;; Defined in button.el + +(compat-defun unbuttonize-region (start end) ;; <compat-tests:buttonize-region> + "Remove all the buttons between START and END. +This removes both text-property and overlay based buttons." + (dolist (o (overlays-in start end)) + (when (overlay-get o 'button) + (delete-overlay o))) + (with-silent-modifications + (remove-text-properties start end (button--properties nil nil nil)) + (add-face-text-property start end 'button nil))) + +(provide 'compat-31) +;;; compat-31.el ends here diff --git a/compat-macs.el b/compat-macs.el index 852ed21..b3206f7 100644 --- a/compat-macs.el +++ b/compat-macs.el @@ -103,7 +103,7 @@ REST are attributes and the function BODY." (lambda (extended obsolete body) (when (stringp extended) (compat-macs--assert - (and (version< extended compat-macs--version) (version< "24.4" extended)) + (and (version< extended compat-macs--version) (version< "25.1" extended)) "Invalid :extended version %s for %s %s" extended type name) (setq extended (version<= extended emacs-version))) (compat-macs--strict (eq extended (fboundp name)) diff --git a/compat-tests.el b/compat-tests.el index 66127fd..2df3f96 100644 --- a/compat-tests.el +++ b/compat-tests.el @@ -44,15 +44,15 @@ ;; calling convention or behavior changed between Emacs versions. ;; The functions tested here are guaranteed to work on the Emacs versions -;; tested by continuous integration. This includes 24.4, 24.5, 25.1, 25.2, -;; 25.3, 26.1, 26.2, 26.3, 27.1, 27.2, 28.1, 28.2, 29.1 and the current -;; Emacs master branch. +;; tested by continuous integration. This includes the versions 25.x, +;; 26.x, 27.x, 28.x, 29.x, 30.x and the current Emacs master branch. ;;; Code: (require 'compat) (require 'ert-x) (require 'subr-x) +(require 'cl-lib) (require 'time-date) (require 'image) (require 'text-property-search nil t) @@ -232,7 +232,10 @@ (should-equal 'd (get-text-property 2 'button-data)) (should-equal 'd (get-text-property 6 'button-data)) (should-equal 'h (get-text-property 2 'help-echo)) - (should-equal 'h (get-text-property 6 'help-echo)))) + (should-equal 'h (get-text-property 6 'help-echo)) + (unbuttonize-region 2 7) + (should-not (get-text-property 2 'action)) + (should-not (get-text-property 6 'action)))) (ert-deftest compat-with-restriction () (with-temp-buffer @@ -484,6 +487,18 @@ 4 8 (display ((raise 0.5) (height 2.0))) 8 12 (display (raise 0.5)))))) +(ert-deftest compat-remove-display-text-property () + (with-temp-buffer + (insert "Foo bar zot gazonk") + (add-display-text-property 4 12 'height 2.0) + (add-display-text-property 2 8 'raise 0.5) + (remove-display-text-property 6 10 'height) + (should-equal (get-text-property 2 'display) '(raise 0.5)) + (should-equal (get-text-property 11 'display) '(height 2.0)) + (should-equal (get-text-property 5 'display) + '((raise 0.5) (height 2.0))) + (should-not (get-text-property 9 'display)))) + (ert-deftest compat-line-number-at-pos () (with-temp-buffer (insert "\n\n\n") @@ -917,42 +932,6 @@ (should-error (ignore-error foo (read "")))) -(ert-deftest compat-hash-table-empty-p () - (should (hash-table-empty-p (make-hash-table))) - (let ((ht (make-hash-table))) - (puthash 'k 'v ht) - (should-not (hash-table-empty-p ht)))) - -(ert-deftest compat-thread-first () - (should-equal (thread-first (+ 40 2)) 42) - (should-equal (thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) 39) - (should-equal (thread-first - "this-is-a-string" - (split-string "-") - (nbutlast 2) - (append (list "good"))) - (list "this" "is" "good"))) - -(ert-deftest compat-thread-last () - (should-equal (thread-last (+ 40 2)) 42) - (should-equal (thread-last - 5 - (+ 20) - (/ 25) - - - (+ 40)) 39) - (should-equal (thread-last - (list 1 -2 3 -4 5) - (mapcar #'abs) - (cl-reduce #'+) - (format "abs sum is: %s")) - "abs sum is: 15")) - (ert-deftest compat-ntake () (should-not (ntake 5 nil)) (should-equal '(1 2) (ntake 5 (list 1 2))) @@ -967,9 +946,6 @@ (should-not (drop 5 nil)) (should-equal '(3 4 5) (drop 2 '(1 2 3 4 5)))) -(ert-deftest compat-format-message () - (should-equal (format-message "a=%s b=%s" 1 2) "a=1 b=2")) - (defvar compat-tests--boundp) (defvar compat-tests--global-boundp) (ert-deftest compat-buffer-local-boundp () @@ -1133,6 +1109,15 @@ (with-current-buffer inner (should-not (buffer-modified-p)))))))) +(ert-deftest compat-with-work-buffer () + (with-work-buffer + (should (string-match-p "\\` \\*work\\*" (buffer-name))) + (let ((outer (current-buffer))) + (with-work-buffer + (should (string-match-p "\\` \\*work\\*" (buffer-name))) + (let ((inner (current-buffer))) + (should-not (eq outer inner))))))) + (ert-deftest compat-insert-into-buffer () ;; Without optional compat--arguments (with-temp-buffer @@ -1159,15 +1144,6 @@ (insert-into-buffer other 2 3)) (should-equal (buffer-string) "abce")))) -(ert-deftest compat-bool-vector () - (should-equal (bool-vector) (bool-vector-not (bool-vector))) - (should-equal (bool-vector t) (bool-vector-not (bool-vector nil))) - (should-equal (bool-vector nil) (bool-vector-not (bool-vector t))) - (should-equal (bool-vector t t) (bool-vector-not (bool-vector nil nil))) - (should-equal (bool-vector t nil) (bool-vector-not (bool-vector nil t))) - (should-equal (bool-vector nil t) (bool-vector-not (bool-vector t nil))) - (should-equal (bool-vector nil nil) (bool-vector-not (bool-vector t t)))) - (ert-deftest compat-assoc () ;; Fallback behaviour: (should-not (compat-call assoc 1 nil)) ;empty list @@ -1536,20 +1512,6 @@ (should-equal 1 (length (compat-call directory-files-and-attributes "." nil nil nil nil 1))) (should-equal 2 (length (compat-call directory-files-and-attributes "." nil nil nil nil 2)))) -(ert-deftest compat-directory-name-p () - (should (directory-name-p "/")) - (should-not (directory-name-p "/file")) - (should-not (directory-name-p "/dir/file")) - (should (directory-name-p "/dir/")) - (should-not (directory-name-p "/dir")) - (should (directory-name-p "/dir/subdir/")) - (should-not (directory-name-p "/dir/subdir")) - (should (directory-name-p "dir/")) - (should-not (directory-name-p "file")) - (should-not (directory-name-p "dir/file")) - (should (directory-name-p "dir/subdir/")) - (should-not (directory-name-p "dir/subdir"))) - (ert-deftest compat-directory-empty-p () (ert-with-temp-directory dir (should (directory-empty-p dir)) @@ -1660,12 +1622,6 @@ (should-equal "1 k" (compat-call file-size-human-readable 1000 'si " ")) (should-equal "1 kA" (compat-call file-size-human-readable 1000 'si " " "A"))) -(ert-deftest compat-with-file-modes () - (let ((old (default-file-modes))) - (with-file-modes (1+ old) - (should-equal (default-file-modes) (1+ old))) - (should-equal (default-file-modes) old))) - (ert-deftest compat-file-modes-number-to-symbolic () (should-equal "-rwx------" (file-modes-number-to-symbolic #o700)) (should-equal "-rwxrwx---" (file-modes-number-to-symbolic #o770)) @@ -1964,12 +1920,6 @@ (should-not (string-equal-ignore-case "abc" "abCD")) (should (string-equal-ignore-case "S" "s"))) -(ert-deftest compat-string-greaterp () - (should (string-greaterp "b" "a")) - (should-not (string-greaterp "a" "b")) - (should (string-greaterp "aaab" "aaaa")) - (should-not (string-greaterp "aaaa" "aaab"))) - (ert-deftest compat-string-clean-whitespace () (should-equal "a b c" (string-clean-whitespace "a b c")) (should-equal "a b c" (string-clean-whitespace " a b c")) @@ -2239,7 +2189,7 @@ (should-not (string-search (compat-tests--string-to-multibyte "\370") (compat-tests--string-to-multibyte "\303\270"))) (should-equal 3 (string-search "\303\270" "foo\303\270")) - (when (version<= "27" emacs-version) + (when (<= 27 emacs-major-version) ;; FIXME The commit a1f76adfb03c23bb4242928e8efe6193c301f0c1 in ;; emacs.git fixes the behaviour of regular expressions matching ;; raw bytes. The compatibility functions should updated to @@ -2269,7 +2219,7 @@ (should-equal "labarbarbarzot" (string-replace "fo" "bar" "lafofofozot")) (should-equal "axb" (string-replace "\377" "x" "a\377b")) (should-equal "axø" (string-replace "\377" "x" "a\377ø")) - (when (version<= "27" emacs-version) + (when (<= 27 emacs-major-version) ;; FIXME The commit a1f76adfb03c23bb4242928e8efe6193c301f0c1 ;; in emacs.git fixes the behaviour of regular ;; expressions matching raw bytes. The compatibility @@ -2330,72 +2280,6 @@ (should-equal "else" (if-let* (((= 5 6))) "then" "else"))) -(ert-deftest compat-when-let () - (static-if (< emacs-major-version 31) ;; deprecated on Emacs 31 - (progn - ;; FIXME Broken on Emacs 25 - (static-if (= emacs-major-version 25) - (should-equal "second" - (when-let - ((x 3) - (y 2) - (z (+ x y)) - ;; ((= z 5)) ;; FIXME Broken on Emacs 25 - (true t)) - "first" "second")) - (should-equal "second" - (when-let - ((x 3) - (y 2) - (z (+ x y)) - ((= z 5)) - (true t)) - "first" "second")) - (should-equal "then" (when-let (((= 5 5))) "then")) - (should-not (when-let (((= 5 6))) t))) - (should-equal "last" - (when-let (e (memq 0 '(1 2 3 0 5 6))) - "first" "last")) - (should-equal "last" (when-let ((e (memq 0 '(1 2 3 0 5 6)))) - "first" "last")) - (should-not (when-let ((e (memq 0 '(1 2 3 5 6))) - (d (memq 0 '(1 2 3 0 5 6)))) - "first" "last"))))) - -(ert-deftest compat-if-let () - (static-if (< emacs-major-version 31) ;; deprecated on Emacs 31 - (progn - ;; FIXME Broken on Emacs 25 - (static-if (= emacs-major-version 25) - (should-equal "then" - (if-let - ((x 3) - (y 2) - (z (+ x y)) - ;; ((= z 5)) ;; FIXME Broken on Emacs 25 - (true t)) - "then" "else")) - (should-equal "then" - (if-let - ((x 3) - (y 2) - (z (+ x y)) - ((= z 5)) - (true t)) - "then" "else")) - (should-equal "else" (if-let (((= 5 6))) "then" "else")) - (should-not (if-let (((= 5 6))) t nil))) - (should (if-let (e (memq 0 '(1 2 3 0 5 6))) - e)) - (should (if-let ((e (memq 0 '(1 2 3 0 5 6)))) - e)) - (should-not (if-let ((e (memq 0 '(1 2 3 5 6))) - (d (memq 0 '(1 2 3 0 5 6)))) - t)) - (should-not (if-let ((d (memq 0 '(1 2 3 0 5 6))) - (e (memq 0 '(1 2 3 5 6)))) - t))))) - (ert-deftest compat-and-let* () (should ;trivial body (and-let* @@ -2764,27 +2648,6 @@ (ert-deftest compat-macroexp-warn-and-return () (should-equal (macroexp-warn-and-return "test warning" '(some form)) '(some form))) -(ert-deftest compat-macroexp-parse-body () - (should-equal '(((declare test)) . (a b c)) - (macroexp-parse-body '((declare test) a b c))) - (should-equal '(((interactive)) . (a b c)) - (macroexp-parse-body '((interactive) a b c))) - (should-equal '(((interactive) (cl-declare)) . (a b c)) - (macroexp-parse-body '((interactive) (cl-declare) a b c)))) - -(ert-deftest compat-macroexp-quote () - (should-equal nil (macroexp-quote nil)) - (should-equal t (macroexp-quote t)) - (should-equal :key (macroexp-quote :key)) - (should-equal "str" (macroexp-quote "str")) - (should-equal ''sym (macroexp-quote 'sym)) - (should-equal ''(1 2 3) (macroexp-quote '(1 2 3)))) - -(ert-deftest compat-macroexpand-1 () - (should-equal '(if a b c) (macroexpand-1 '(if a b c))) - (should-equal '(if a (progn b)) (macroexpand-1 '(when a b))) - (should-equal '(if a (progn (unless b c))) (macroexpand-1 '(when a (unless b c))))) - ;; NOTE: `with-suppressed-warnings' does not work inside of `ert-deftest'?! (defun compat-tests--with-suppressed-warnings () (with-suppressed-warnings ((interactive-only goto-line) @@ -2921,6 +2784,25 @@ (should-equal '(nil nil nil 9 4 2020 nil nil nil) (date-ordinal-to-time 2020 100)) (should-equal '(nil nil nil 19 7 2021 nil nil nil) (date-ordinal-to-time 2021 200))) +(ert-deftest compat-seconds-to-string () + (should-equal (compat-call seconds-to-string 0) "0s") + (should-equal (compat-call seconds-to-string 9) "9.00s") + (should-equal (compat-call seconds-to-string 99) "99.00s") + (should-equal (compat-call seconds-to-string 999) "16.65m") + (should-equal (compat-call seconds-to-string 9999) "2.78h") + (should-equal (compat-call seconds-to-string 99999) "27.78h") + (should-equal (compat-call seconds-to-string 999999) "11.57d") + (should-equal (compat-call seconds-to-string 9999999) "115.74d") + (should-equal (compat-call seconds-to-string 99999999) "3.17y") + (should-equal (compat-call seconds-to-string 999999999) "31.69y") + ;; New functionality + (should-equal (compat-call seconds-to-string 999 'readable) "17 minutes") + (should-equal (compat-call seconds-to-string 999 'readable 'abbrev) "17m") + (should-equal (compat-call seconds-to-string 999 'readable 'abbrev 2) "16.65m") + (should-equal (compat-call seconds-to-string 999999 'readable) "2 weeks") + (should-equal (compat-call seconds-to-string 999999 'readable 'abbrev) "2w") + (should-equal (compat-call seconds-to-string 999999 'readable 'abbrev 4) "1.6534w")) + (ert-deftest compat-regexp-opt () ;; Ensure `regexp-opt' doesn't change the existing ;; behaviour: @@ -2950,12 +2832,10 @@ (ert-deftest compat-region-bounds () (should-error (region-bounds)) - ;; FIXME: On Emacs 24 `region-bounds' always returns a continuous region. - (when (> emacs-major-version 24) - (let ((region-extract-function #'ignore)) - (should-not (region-bounds))) - (let ((region-extract-function (lambda (_) '((2 . 3) (6 . 7))))) - (should-equal (region-bounds) '((2 . 3) (6 . 7))))) + (let ((region-extract-function #'ignore)) + (should-not (region-bounds))) + (let ((region-extract-function (lambda (_) '((2 . 3) (6 . 7))))) + (should-equal (region-bounds) '((2 . 3) (6 . 7)))) (with-temp-buffer (insert "abc\ndef\n") (set-mark 2) @@ -2963,9 +2843,8 @@ (should-equal (region-bounds) '((2 . 7))))) (ert-deftest compat-region-noncontiguous-p () - (when (> emacs-major-version 24) - (let ((region-extract-function (lambda (_) '((2 . 3) (6 . 7))))) - (should (region-noncontiguous-p)))) + (let ((region-extract-function (lambda (_) '((2 . 3) (6 . 7))))) + (should (region-noncontiguous-p))) (with-temp-buffer (insert "abc\ndef\n") (set-mark 2) @@ -2974,11 +2853,9 @@ (should-not (region-noncontiguous-p)) (should-not (use-region-noncontiguous-p)) (should (use-region-p)) - ;; FIXME: On Emacs 24 `region-bounds' always returns a continuous region. - (when (> emacs-major-version 24) - (let ((region-extract-function (lambda (_) '((2 . 3) (6 . 7))))) - (should (region-noncontiguous-p)) - (should (use-region-noncontiguous-p)))))) + (let ((region-extract-function (lambda (_) '((2 . 3) (6 . 7))))) + (should (region-noncontiguous-p)) + (should (use-region-noncontiguous-p))))) (ert-deftest compat-get-scratch-buffer-create () (should-equal "*scratch*" (buffer-name (get-scratch-buffer-create))) @@ -3016,21 +2893,6 @@ (should-equal (ring-size ring) 3) (should-equal (ring-elements ring) '(5 4 3)))) -(ert-deftest compat-save-mark-and-excursion () - (with-temp-buffer - (insert "a\nb\nc") - (goto-char 1) - (set-mark 2) - (should-equal (point) 1) - (should-equal (mark) 2) - (save-mark-and-excursion - (goto-char 3) - (set-mark 4) - (should-equal (point) 3) - (should-equal (mark) 4)) - (should-equal (point) 1) - (should-equal (mark) 2))) - (ert-deftest compat-text-quoting-style () (should (text-quoting-style)) (let ((text-quoting-style t)) @@ -3128,6 +2990,14 @@ (cl-with-gensyms (x y) `(let ((,x 1) (,y 2)) (+ ,x ,y)))) +(ert-deftest compat-pcase-cl-type () + (should-equal "int" (pcase 1 ((cl-type fixnum) "int"))) + (should-equal "int" (pcase 1 ((cl-type integer) "int"))) + (should-equal "int" (pcase 1 ((cl-type (integer 0 10)) "int"))) + (should-equal "bool" (pcase t ((cl-type boolean) "bool"))) + (should-equal "bool" (pcase nil ((cl-type boolean) "bool"))) + (should-not (pcase t ((cl-type fixnum) "fixnum")))) + (ert-deftest compat-cl-with-gensyms () (should-equal 3 (compat-tests--with-gensyms))) @@ -3137,7 +3007,7 @@ (ert-deftest compat-cl-once-only () (let ((x 0)) - (should-equal (cons 1 1) (compat-tests--once-only (cl-incf x))) + (should-equal (cons 1 1) (compat-tests--once-only (incf x))) (should-equal 1 x))) (ert-deftest compat-cl-constantly () @@ -3171,6 +3041,67 @@ (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) + (should (hash-table-contains-p :foo h)) + (should-not (hash-table-contains-p :bar h)) + (should-not (hash-table-contains-p 'missing h)) + (should-not (hash-table-contains-p '#:missing h)))) + (ert-deftest compat-copy-tree () ;; Adapted from Emacs /test/lisp/subr-tests.el ;; Check that values other than conses, vectors and records are @@ -3213,6 +3144,14 @@ (should-not (static-if nil "true")) (should-equal "else2" (static-if nil "true" "else1" "else2"))) +(ert-deftest compat-static-when () + (should-equal "true2" (static-when t "true1" "true2")) + (should-not (static-when nil "true1" "true2"))) + +(ert-deftest compat-static-unless () + (should-not (static-unless t "false1" "false2")) + (should-equal "false2" (static-unless nil "false1" "false2"))) + (ert-deftest compat-completion-lazy-hilit () (let ((completion-lazy-hilit t) (completion-lazy-hilit-fn (lambda (x) (concat "<" x ">")))) @@ -3293,6 +3232,26 @@ (let ((completion-category-overrides '((compat-test (a . 10))))) (should-equal 10 (compat-call completion-metadata-get md 'a)))))) +(ert-deftest compat-completion-table-with-metadata () + (let* ((md '((category . text))) + (table (completion-table-with-metadata '("word") md)) + (md2 (completion-metadata "" table nil))) + (should-equal (car md2) 'metadata) + (should (eq (cdr md2) md)))) + +(ert-deftest compat-completion-list-candidate-at-point () + (let ((minibuffer-completion-table (list "first" "second" "third"))) + (minibuffer-completion-help (point-max) (point-max)) + (with-current-buffer "*Completions*" + (goto-char (point-min)) + (search-forward ":") + (should-not (completion-list-candidate-at-point)) + (forward-line 1) + (let ((cand (completion-list-candidate-at-point))) + (should-equal "first" (car cand)) + (should (integerp (nth 1 cand))) + (should-equal (+ 5 (nth 1 cand)) (nth 2 cand)))))) + (ert-deftest compat-untrusted-content () (should (local-variable-if-set-p 'untrusted-content))) @@ -3315,5 +3274,176 @@ (trusted-content '("compat-tests.el"))) (should-not (trusted-content-p)))) +(ert-deftest compat-oddp () + (should (oddp 1)) + (should (oddp -1)) + (should (oddp 3)) + (should (oddp most-positive-fixnum)) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should (oddp (+ most-positive-fixnum 2)))) + (should-not (oddp 0)) + (should-not (oddp -2)) + (should-not (oddp 10)) + (should-not (oddp (1- most-positive-fixnum))) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should-not (oddp (1+ most-positive-fixnum)))) + (should-error (oddp 1.0)) + (should-error (oddp 0.0))) + +(ert-deftest compat-evenp () + (should (evenp 0)) + (should (evenp -2)) + (should (evenp 10)) + (should (evenp (1- most-positive-fixnum))) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should (evenp (1+ most-positive-fixnum)))) + (should-not (evenp 1)) + (should-not (evenp -1)) + (should-not (evenp 3)) + (should-not (evenp most-positive-fixnum)) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should-not (evenp (+ most-positive-fixnum 2)))) + (should-error (evenp 1.0)) + (should-error (evenp 0.0))) + +(ert-deftest compat-plusp () + (should (plusp 1)) + (should (plusp most-positive-fixnum)) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should (plusp (1+ most-positive-fixnum)))) + (should (plusp 1.0)) + (should (plusp 1.0e+INF)) + (should (plusp 1e-100)) + (with-temp-buffer (should (plusp (point-max-marker)))) + (should-not (plusp 0)) + (should-not (plusp 0.0)) + (should-not (plusp most-negative-fixnum)) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should-not (plusp (1- most-negative-fixnum)))) + (should-not (plusp -1.0)) + (should-not (plusp -1.0e+INF)) + (should-not (plusp -1e-100)) + (should-error (plusp "")) + (should-error (plusp [])) + (should-error (plusp (make-hash-table))) + (should-error (plusp 'not-a-number))) + +(ert-deftest compat-minusp () + (should-not (minusp 0)) + (should-not (minusp 0.0)) + (should (minusp most-negative-fixnum)) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should (minusp (1- most-negative-fixnum)))) + (should (minusp -1.0)) + (should (minusp -1.0e+INF)) + (should (minusp -1e-100)) + (should-not (minusp 1)) + (should-not (minusp most-positive-fixnum)) + (unless (memq (symbol-function 'bignump) '(nil ignore)) + (should-not (minusp (1+ most-positive-fixnum)))) + (should-not (minusp 1.0)) + (should-not (minusp 1.0e+INF)) + (should-not (minusp 1e-100)) + (with-temp-buffer (should-not (minusp (point-max-marker)))) + (should-error (minusp "")) + (should-error (minusp [])) + (should-error (minusp (make-hash-table))) + (should-error (minusp 'not-a-number))) + +(ert-deftest compat-incf () + (let ((x 3)) + (incf x) + (should (= x 4)) + (incf x nil) + (should (= x 5)) + (incf x 2) + (should (= x 7)) + (incf x 2.2) + (should (= x (+ 3 1 1 2 2.2)))) + (let ((list (list 1 2 3))) + (incf (nth 1 list)) + (should (= (nth 1 list) 3)) + (incf (nth 2 list) 1.0e+INF) + (should (= (nth 2 list) 1.0e+INF))) + (let ((alist (list (cons 'a 1) (cons 'b 2) (cons 'c 3)))) + (incf (alist-get 'b alist)) + (should (= (alist-get 'b alist) 3)) + (incf (alist-get 'b alist) -1) + (should (= (alist-get 'b alist) 2))) + (should-error (eval '(incf 3) t)) + (should-error (eval '(incf nil) t)) + (should-error (eval '(incf [a b c]) t)) + (let ((x 0)) + (should-error (eval '(incf x 'symb) t)) + (should-error (eval '(incf x [a b c]) t)) + (ignore x)) + (let ((vec (vector 1 2 3)) (i 0)) + (incf (aref vec (incf i))) + (should-equal [1 3 3] vec))) + +(ert-deftest compat-decf () + (let ((x 3)) + (decf x) + (should (= x 2)) + (decf x nil) + (should (= x 1)) + (decf x 2) + (should (= x -1)) + (decf x 2.2) + (should (= x (- 0 1 2.2)))) + (let ((list (list 1 2 3))) + (decf (nth 1 list)) + (should (= (nth 1 list) 1)) + (decf (nth 2 list) 1.0e+INF) + (should (= (nth 2 list) -1.0e+INF))) + (let ((alist (list (cons 'a 1) (cons 'b 2) (cons 'c 3)))) + (decf (alist-get 'b alist)) + (should (= (alist-get 'b alist) 1)) + (decf (alist-get 'b alist) -1) + (should (= (alist-get 'b alist) 2))) + (should-error (eval '(decf 3) t)) + (should-error (eval '(decf nil) t)) + (should-error (eval '(decf [a b c]) t)) + (let ((x 0)) + (should-error (eval '(decf x 'symb) t)) + (should-error (eval '(decf x [a b c]) t)) + (ignore x)) + (let ((vec (vector 1 2 3)) (i 2)) + (decf (aref vec (decf i))) + (should-equal [1 1 3] vec))) + +(ert-deftest compat-color-blend () + ;; example from the docstring + (should-equal (color-blend '(1 0.5 1) '(0 0 0) 0.75) + '(0.75 0.375 0.75)) + ;; tests from test/lisp/color-tests.el + (should-equal (color-blend '(1.0 0.0 0.0) '(0.0 1.0 0.0)) '(0.5 0.5 0.0)) + (should-equal (color-blend '(1.0 1.0 1.0) '(0.0 1.0 0.0)) '(0.5 1.0 0.5)) + (should-equal (color-blend '(0.0 0.39215686274509803 0.0) '(0.9607843137254902 0.8705882352941177 0.7019607843137254)) + '(0.4803921568627451 0.6313725490196078 0.3509803921568627)) + ;; other tests + (should-equal (color-blend '(1 0.5 1) '(0 0 0) 1) + '(1 0.5 1)) + (should (cl-equalp (color-blend '(1 0.5 1) '(0 0 0) 0) + '(0 0 0))) + (should (cl-equalp (color-blend '(1 0.5 1) '(0 0 0) 1.0) + '(1 0.5 1))) + (should (cl-equalp (color-blend '(1 0.5 1) '(0 0 0) 0.0) + '(0 0 0))) + (should (cl-equalp (color-blend '(100 0 0) '(0 0 0)) + '(50 0 0))) + (should (cl-equalp (color-blend '(-100 0 0) '(100 0 0)) + '(0 0 0))) + (should-error (color-blend 'red 'blue)) + (should-error (color-blend "red" "#0000ff")) + (should-error (color-blend '() '())) + (should (cl-equalp (color-blend '(0 0 0 0) '(1 1 1 1)) + '(0.5 0.5 0.5))) + (should-not (cl-equalp (color-blend '(0 0 0) '(1 1 1) (/ 0.0)) + '(-0.0e+NaN -0.0e+NaN -0.0e+NaN))) + (should-error (color-blend '(0 0 zero) '(1 1 1))) + (should-error (color-blend '(0 0 0) '(1 1 one))) + (should-error (color-blend [0 0 0] [1 1 1]))) + (provide 'compat-tests) ;;; compat-tests.el ends here @@ -6,7 +6,7 @@ ;; Maintainer: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de> ;; Version: 30.1.0.1 ;; URL: https://github.com/emacs-compat/compat -;; Package-Requires: ((emacs "24.4") (seq "2.23")) +;; Package-Requires: ((emacs "25.1")) ;; Keywords: lisp, maint ;; This program is free software; you can redistribute it and/or modify @@ -50,9 +50,9 @@ ;; time and runtime, but only if needed. (eval-when-compile (defmacro compat--maybe-require () - (when (version< emacs-version "30.1") - (require 'compat-30) - '(require 'compat-30)))) + (when (< emacs-major-version 31) + (require 'compat-31) + '(require 'compat-31)))) (compat--maybe-require) ;;;; Macros for extended compatibility function calls diff --git a/compat.texi b/compat.texi index c4000a5..3786e91 100644 --- a/compat.texi +++ b/compat.texi @@ -69,12 +69,12 @@ Introduction Support -* Emacs 25.1:: Compatibility support for Emacs 25.1 * Emacs 26.1:: Compatibility support for Emacs 26.1 * Emacs 27.1:: Compatibility support for Emacs 27.1 * Emacs 28.1:: Compatibility support for Emacs 28.1 * Emacs 29.1:: Compatibility support for Emacs 29.1 * Emacs 30.1:: Compatibility support for Emacs 30.1 +* Emacs 31.1:: Compatibility support for Emacs 31.1 @end detailmenu @end menu @@ -96,7 +96,7 @@ for Emacs Lisp. By using Compat, an Elisp package does not have to make the decision to either use new and useful functionality or support old versions of Emacs. -The library provides support back until Emacs 24.4. The intended +The library provides support back until Emacs 25.1. The intended audience are package developers that are interested in using newer developments, without having to break compatibility. @@ -109,10 +109,10 @@ mirrors the version of Emacs releases. The current version of Compat corresponds to the current Emacs release. @example -;; Package-Requires: ((emacs "24.4") (compat "30.1.0.1")) +;; Package-Requires: ((emacs "25.1") (compat "30.1.0.1")) @end example -There is no need to depend on @code{emacs 24.4} specifically. One can +There is no need to depend on @code{emacs 25.1} specifically. One can choose any newer version, if features not provided by Compat necessitate it, for example bug fixes or UI improvements. @@ -198,11 +198,11 @@ technical reasons. The scope is intentionally restricted in order to limit the size of Compat and to ensure that the library stays maintainable. -Emacs version 24.4 is chosen as the oldest version supported by -Compat, since Elisp has seen significant changes at that version. -Since 24.4 Emacs major versions consistently bump the major version -number. On the library level, subr-x was introduced in 24.4. Most -popular Emacs packages already require 24.4 or even newer versions of +Emacs version 25.1 is chosen as the oldest version supported by Compat, +since Elisp has seen significant changes at that version. Since 25.1 +Emacs major versions consistently bump the major version number. On the +library level, seq and generics were introduced in 25.1. Most popular +Emacs packages already require 25.1 or even newer versions of Emacs. Supporting for more historical Emacs versions would complicate maintenance while only few packages and users would benefit. @@ -297,283 +297,14 @@ This section goes into the features that Compat manages and doesn't manage to provide for each Emacs version. @menu -* Emacs 25.1:: Compatibility support for Emacs 25.1 * Emacs 26.1:: Compatibility support for Emacs 26.1 * Emacs 27.1:: Compatibility support for Emacs 27.1 * Emacs 28.1:: Compatibility support for Emacs 28.1 * Emacs 29.1:: Compatibility support for Emacs 29.1 * Emacs 30.1:: Compatibility support for Emacs 30.1 +* Emacs 31.1:: Compatibility support for Emacs 31.1 @end menu -@node Emacs 25.1 -@section Emacs 25.1 - -@subsection Added Definitions -The following functions and macros are implemented in Emacs -25.1. These functions are made available by Compat on Emacs versions -older than 25.1. - -@c copied from lispref/help.texi -@defopt text-quoting-style -The value of this user option is a symbol that specifies the style -Emacs should use for single quotes in the wording of help and -messages. If the option's value is @code{curve}, the style is -@t{‘like this’} with curved single quotes. If the value is -@code{straight}, the style is @t{'like this'} with straight -apostrophes. If the value is @code{grave}, quotes are not translated -and the style is @t{`like this'} with grave accent and apostrophe, the -standard style before Emacs version 25. The default value @code{nil} -acts like @code{curve} if curved single quotes seem to be displayable, -and like @code{grave} otherwise. - -This option is useful on platforms that have problems with curved -quotes. You can customize it freely according to your personal -preference. -@end defopt - -@c based on lisp/simple.el -@defun region-bounds -Return the boundaries of the region. Value is a list of one or more -cons cells of the form @code{(start . end)}. It will have more than -one cons cell when the region is non-contiguous, see -@code{region-noncontiguous-p} and @code{extract-rectangle-bounds}. -@end defun - -@c based on lisp/simple.el -@defun region-noncontiguous-p -Return non-nil if the region contains several pieces. An example is a -rectangular region handled as a list of separate contiguous regions -for each line. -@end defun - -@c copied from lispref/positions.texi -@defmac save-mark-and-excursion body@dots{} -This macro is like @code{save-excursion}, but also saves and restores -the mark location and @code{mark-active}. This macro does what -@code{save-excursion} did before Emacs 25.1. -@end defmac - -@c copied from lispref/strings.texi -@defun format-message string &rest objects -This function acts like @code{format}, except it also converts any -grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per -the value of @code{text-quoting-style}. - -Typically grave accent and apostrophe in the format translate to -matching curved quotes, e.g., @t{"Missing `%s'"} might result in -@t{"Missing ‘foo’"}. @xref{Text Quoting Style,,,elisp}, for how to -influence or inhibit this translation. - -@ref{Formatting Strings,,,elisp}. -@end defun - -@c copied from lispref/files.texi -@defun directory-name-p filename -This function returns non-@code{nil} if @var{filename} ends with a -directory separator character. This is the forward slash @samp{/} on -GNU and other POSIX-like systems; MS-Windows and MS-DOS recognize both -the forward slash and the backslash @samp{\} as directory separators. - -@xref{Directory Names,,,elisp}. -@end defun - -@c copied from lispref/strings.texi -@defun string-greaterp string1 string2 -This function returns the result of comparing @var{string1} and -@var{string2} in the opposite order, i.e., it is equivalent to calling -@code{(string-lessp @var{string2} @var{string1})}. - -@xref{Text Comparison,,,elisp}. -@end defun - -@c copied from lispref/files.texi -@defmac with-file-modes mode body@dots{} -This macro evaluates the @var{body} forms with the default permissions -for new files temporarily set to @var{modes} (whose value is as for -@code{set-file-modes} above). When finished, it restores the original -default file permissions, and returns the value of the last form in -@var{body}. - -This is useful for creating private files, for example. - -@xref{Changing Files,,,elisp}. -@end defmac - -@c copied from lispref/lists.texi -@defun alist-get key alist &optional default remove -This function is similar to @code{assq}. It finds the first association -@w{@code{(@var{key} . @var{value})}} by comparing @var{key} with -@var{alist} elements, and, if found, returns the @var{value} of that -association. If no association is found, the function returns -@var{default}. - -This is a generalized variable (@pxref{Generalized Variables,,,elisp}) -that can be used to change a value with @code{setf}. When using it to -set a value, optional argument @var{remove} non-@code{nil} means to -remove @var{key}'s association from @var{alist} if the new value is -@code{eql} to @var{default}. - -@ref{Association Lists,,,elisp}. -@end defun - -@defmac if-let (bindings@dots{}) then &rest else@dots{} -As with @code{let*}, @var{bindings} will consist of -@code{(@var{symbol} @var{value-form})} entries that are evaluated and -bound sequentially. If all @var{value-form} evaluate to -non-@code{nil} values, then @var{then} is evaluated as were the case -with a regular @code{let*} expression, with all the variables bound. -If any @var{value-form} evaluates to @code{nil}, @var{else} is -evaluated, without any bound variables. - -A binding may also optionally drop the @var{symbol}, and simplify to -@code{(@var{value-form})} if only the test is of interest. - -For the sake of backwards compatibility, it is possible to write a -single binding without a binding list: - -@example -@group -(if-let* (@var{symbol} (test)) foo bar) -@equiv{} -(if-let* ((@var{symbol} (test))) foo bar) -@end group -@end example -@end defmac - -@defmac when-let (bindings@dots{}) &rest body -As with @code{when}, if one is only interested in the case where all -@var{bindings} are non-nil. Otherwise @var{bindings} are interpreted -just as they are by @code{if-let*}. -@end defmac - -@c based on lisp/emacs-lisp/subr-x.el -@defun hash-table-empty hash-table -Check whether @var{hash-table} is empty (has 0 elements). -@end defun - -@c based on lisp/emacs-lisp/subr-x.el -@defmac thread-first &rest forms -Combine @var{forms} into a single expression by ``threading'' each -element as the @emph{first} argument of their successor. Elements of -@var{forms} can either be an list of an atom. - -For example, consider the threading expression and it's equivalent -macro expansion: - -@example -(thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) -@equiv{} -(+ (- (/ (+ 5 20) 25)) 40) -@end example - -Note how the single @code{-} got converted into a list before threading. -This example uses arithmetic functions, but @code{thread-first} is not -restricted to arithmetic or side-effect free code. -@end defmac - -@defmac thread-last &rest forms -Combine @var{forms} into a single expression by ``threading'' each -element as the @emph{last} argument of their successor. Elements of -@var{forms} can either be an list of an atom. - -For example, consider the threading expression and it's equivalent -macro expansion: - -@example -(thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) -@equiv{} -(+ 40 (- (/ 25 (+ 20 5)))) -@end example - -Note how the single @code{-} got converted into a list before threading. -This example uses arithmetic functions, but @code{thread-last} is not -restricted to arithmetic or side-effect free code. -@end defmac - -@c copied from lispref/macros.texi -@defun macroexpand-1 form &optional environment -This function expands macros like @code{macroexpand}, but it only -performs one step of the expansion: if the result is another macro call, -@code{macroexpand-1} will not expand it. - -@xref{Expansion,Expansion,,elisp}. -@end defun - -@c based on lisp/emacs-lisp/macroexp.el -@defun macroexp-quote e -Return an expression @var{e} such that @code{(eval e)} is @var{v}. -@end defun - -@c based on lisp/emacs-lisp/macroexp.el -@defun macroexp-parse body -Parse a function @var{body} into @code{(declarations . exps)}. -@end defun - -@defun bool-vector &rest objects -This function creates and returns a bool-vector whose elements are the -arguments, @var{objects}. - -@xref{Bool-Vectors,,,elisp}. -@end defun - -@subsection Missing Definitions -Compat does not provide support for the following Lisp features -implemented in 25.1: - -@itemize -@item -The function @code{macroexp-macroexpand}. -@item -The macro @code{macroexp-let2*}. -@item -The function @code{directory-files-recursively}. -@item -New @code{pcase} patterns. -@item -The hook @code{prefix-command-echo-keystrokes-functions} and -@code{prefix-command-preserve-state-hook}. -@item -The hook @code{pre-redisplay-functions}. -@item -The function @code{make-process}. -@item -Support for the variable @code{inhibit-message}. -@item -The @code{define-inline} functionality. -@item -The functions @code{string-collate-lessp} and -@code{string-collate-equalp}. -@item -The function @code{funcall-interactively}. -@item -The function @code{buffer-substring-with-bidi-context}. -@item -The function @code{font-info}. -@item -The function @code{default-font-width}. -@item -The function @code{window-font-height} and @code{window-font-width}. -@item -The function @code{window-max-chars-per-line}. -@item -The function @code{set-binary-mode}. -@item -The functions @code{bufferpos-to-filepos} and -@code{filepos-to-bufferpos}. -@item -The @code{thunk} library. -@end itemize - @node Emacs 26.1 @section Emacs 26.1 @@ -1669,8 +1400,8 @@ The following functions and macros are implemented in Emacs 28.1. These functions are made available by Compat on Emacs versions older than 28.1. -The @code{defcustom} type @code{natnum} introduced in Emacs 28.1 is -made available by Compat. +The @code{defcustom} type @code{natnum} and the @code{pcase} pattern +@code{cl-type} introduced in Emacs 28.1 are made available by Compat. @c copied from lispref/processes.texi @defun process-lines-ignore-status program &rest args @@ -2469,6 +2200,7 @@ will be called when the user clicks on the button. The optional is called. If @code{nil}, the button is used as the parameter instead. @end defun +@c copied from lispref/display.texi @defun buttonize-region start end callback &optional data help-echo Make the region between @var{start} and @var{end} into a button. When clicked, @var{callback} will be called with the @var{data} as the @@ -3717,6 +3449,246 @@ argument must not contain cycles. Compat does not provide support for the following Lisp features implemented in 30.1: +@node Emacs 31.1 +@section Emacs 31.1 + +@subsection Added Definitions +The following functions and macros are implemented in Emacs +31.1. These functions are made available by Compat on Emacs versions +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 +@var{start} to @var{end}. @var{spec} is the @sc{car} of the display +specification to remove, e.g.@: @code{height} or @code{'(margin nil)}. + +If any text in the region has any other @code{display} properties, those +properties are retained. For instance: + +@lisp +@group +(add-display-text-property 1 8 'raise 0.5) +(add-display-text-property 4 8 'height 2.0) +(remove-display-text-property 2 6 'raise) +@end group +@end lisp + +After doing this, the text will have the following @code{display} +properties: + +@itemize @bullet +@item +The region from 1 to 2, only @code{raise} + +@item +The region from 2 to 4, no properties + +@item +The region from 4 to 6, only @code{height} + +@item +The region from 6 to 8, both @code{raise} and @code{height} + +@end itemize + +@var{object} is either a string or a buffer to remove the specification +from. If omitted, @var{object} defaults to the current buffer. +@end defun + +@c based on lisp/subr.el +@defmac hash-table-contains-p key table +Return non-nil if @var{table} has an element with @var{key}. +@end defmac + +@c copied from lispref/control.texi +@defmac static-when condition body... +Test @var{condition} at macro-expansion time. If its value is +non-@code{nil}, expand the macro to evaluate all @var{body} forms +sequentially and return the value of the last one, or @code{nil} if there +are none. +@end defmac + +@c copied from lispref/control.texi +@defmac static-unless condition body... +Test @var{condition} at macro-expansion time. If its value is @code{nil}, +expand the macro to evaluate all @var{body} forms sequentially and return +the value of the last one, or @code{nil} if there are none. +@end defmac + +@c copied from lispref/display.texi +@defun unbuttonize-region start end +This function removes all buttons between @var{start} and @var{end} in +the current buffer (both overlay and text-property based ones). +@end defun + +@c based on lisp/minibuffer.el +@defun completion-table-with-metadata table metadata +Return new completion @var{table} with @var{metadata}. @var{metadata} +should be an alist of completion metadata. See +@code{completion-metadata} for a list of supported metadata. +@end defun + +@c based on lisp/minibuffer.el +@defun completion-list-candidate-at-point &optional pt +Candidate string and bounds at @var{pt} in completions buffer. The +return value has the format (@var{str} @var{beg} @var{end}). The +optional argument @var{pt} defaults to @code{(point)}. +@end defun + +@c based on lisp/emacs-lisp/subr-x.el +@defmac with-work-buffer &rest body +Create a work buffer, and evaluate @var{body} there like @code{progn}. +Like @code{with-temp-buffer}, but reuse an already created temporary +buffer when possible, instead of creating a new one on each call. +@end defmac + +@c copied from lispref/numbers.texi +@defun plusp number +This predicate tests whether its argument is positive, and returns +@code{t} if so, @code{nil} otherwise. The argument must be a number. +@end defun + +@c copied from lispref/numbers.texi +@defun minusp number +This predicate tests whether its argument is negative, and returns +@code{t} if so, @code{nil} otherwise. The argument must be a number. +@end defun + +@c copied from lispref/numbers.texi +@defun oddp integer +This predicate tests whether its argument is an odd number, and returns +@code{t} if so, @code{nil} otherwise. The argument must be an integer. +@end defun + +@c copied from lispref/numbers.texi +@defun evenp integer +This predicate tests whether its argument is an even number, and returns +@code{t} if so, @code{nil} otherwise. The argument must be an integer. +@end defun + +@c copied from lispref/numbers.texi +@defmac incf place &optional delta +This macro increments the number stored in @var{place} by one, or +by @var{delta} if specified. It returns the incremented value. + +@var{place} can be a symbol or a generalized variable, +@pxref{generalised variable,Generalized Variables,,elisp}. For example, +@w{@samp{(incf i)}} is equivalent to @w{@samp{(setq i (1+ i))}}, and +@w{@samp{(incf (car x) 2)}} is equivalent to @w{@samp{(setcar x (+ (car +x) 2))}}. +@end defmac + +@c copied from lispref/numbers.texi +@defmac decf place &optional delta +This macro decrements the number stored in @var{place} by one, or +by @var{delta} if specified. It returns the decremented value. +@end defmac + +@defun color-blend a b &optional alpha +Interpolate between the two colors @var{a} and @var{b}. Both arguments +are a list of three numbers @samp{(RED GREEN BLUE)} representing a +coordinate in a (0,1)-RGB color space. The optional argument +@var{alpha} should be a value between 0 and 1 and adjusts how strongly +the function will skew in either direction: Values towards 1 tend +towards @var{a}, while values towards 0 tend towards @var{b}. By +default, the argument defaults to 0.5. +@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 31.1: + +@c copied from lispref/os.texi +@defun compat-call@ seconds-to-string delay &optional readable abbrev precision +Return a string describing a given @var{delay} (in seconds). By +default, this function formats the returned string as a floating-point +number in units selected according to the value of @var{delay}. For +example, a delay of 9861.5 seconds yields @samp{2.74h}, since the value +of @var{delay} is longer than 1 hour, but shorter than 1 day. The +output formatting can be further controlled by the optional arguments, +if optional argument @var{readable} is non-@code{nil}. If +@var{readable}'s value is @code{expanded}, the returned string will +describe @var{delay} using two units; for example, a delay of 9861.5 +seconds with @var{readable} set to the symbol @code{expanded} returns +@samp{2 hours 44 minutes}, but if @var{readable} is @code{t}, the +function returns @samp{3 hours}. Optional argument @var{abbrev}, if +non-@code{nil}, means to abbreviate the units: use @samp{h} instead of +@samp{hours}, @samp{m} instead of @samp{minutes}, etc. If +@var{precision} is a whole integer number, the function rounds the value +of the smallest unit it produces to that many digits after the decimal +point; thus, 9861.5 with @var{precision} set to 3 yields @samp{2.739 +hours}. If @var{precision} is a non-negative float smaller than 1, the +function rounds to that value. +@end defun + +@subsection Missing Definitions +Compat does not provide support for the following Lisp features +implemented in 31.1: + +@c Placeholder + @node Development @chapter Development |