daniel/emacs-conf
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2026-06-27 11:34:21 +02:00
parent 4be4f859c4
commit 1aaef48596
246 changed files with 7997 additions and 4359 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
lisp/compat/NEWS.org
View File

@@ -1,7 +1,38 @@
#+link: compat-srht https://todo.sr.ht/~pkal/compat/
#+link: compat-gh https://github.com/emacs-compat/compat/issues/
#+options: toc:nil num:nil author:nil
* Release of "Compat" Version 31.0.0.1
- compat-31: Improve =with-work-buffer= implementation.
(Release <2026-05-03 Sun>)
* Release of "Compat" Version 31.0.0.0
- compat-28: New pcase pattern =cl-type=.
- compat-29: Add =string-glyph-compose= and =string-glyph-decompose=.
- 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=, =member-if=, =any=, =all=.
- compat-31: New function =set-local=.
- compat-31: New function =ensure-proper-list=.
- compat-31: New error API functions =error-type-p=, =error-has-type-p=, =error-type=
and =error-slot-value=.
- 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.
(Release <2026-05-01 Fri>)
* Release of "Compat" Version 30.1.0.1
- compat-28: Fix =named-let= tail recursion.
@@ -275,7 +306,7 @@
* Release of "Compat" Version 28.1.2.2
This is a minor release that hopes to address [[compat-srht:7]].
This is a minor release.
(Release <2022-08-25 Thu>)
@@ -297,8 +328,8 @@ include much more documentation that had been the case previously.
The main change of this release has been the major simplification of
Compat's initialisation system, improving the situation around issues
people had been reporting ([[compat-srht:4]], once again) with unconventional
or unpopular packaging systems.
people had been reporting with unconventional or unpopular packaging
systems.
In addition to this, the following functional changes have been made:
@@ -314,7 +345,6 @@ Minor improvements to manual are also part of this release.
This release just contains a hot-fix for an issue introduced in the
last version, where compat.el raises an error during byte compilation.
See [[compat-srht:4]].
(Release <2022-06-19 Sun>)
@@ -322,11 +352,9 @@ See [[compat-srht:4]].
Two main changes have necessitated a new patch release:
1. Fix issues related to the loading of compat when uncompiled. See
[[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this thread]] for more details on the problem.
1. Fix issues related to the loading of compat when uncompiled.
2. Fix issues related to the loading of compat on old pre-releases
(think of 28.0.50). See [[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this thread]] for more details on the
problem.
(think of 28.0.50).
(Released <2022-06-22 Wed>)
@@ -334,7 +362,7 @@ Two main changes have necessitated a new patch release:
This is a minor release fixing a bug in =json-serialize=, that could
cause unintended side-effects, not related to packages using Compat
directly (see [[compat-srht:2]]).
directly.
(Released <2022-05-05 Thu>)

260
lisp/compat/compat-25.el
View File

@@ -1,260 +0,0 @@
;;; compat-25.el --- Functionality added in Emacs 25.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 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

10
lisp/compat/compat-26.el
View File

@@ -1,6 +1,6 @@
;;; compat-26.el --- Functionality added in Emacs 26.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; 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
@@ -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)

2
lisp/compat/compat-27.el
View File

@@ -1,6 +1,6 @@
;;; compat-27.el --- Functionality added in Emacs 27.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; 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

10
lisp/compat/compat-28.el
View File

@@ -1,6 +1,6 @@
;;; compat-28.el --- Functionality added in Emacs 28.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; 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
@@ -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

74
lisp/compat/compat-29.el
View File

@@ -1,6 +1,6 @@
;;; compat-29.el --- Functionality added in Emacs 29.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; 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
@@ -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.
(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.
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))))
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.
@@ -641,6 +609,30 @@ The variable list SPEC is the same as in `if-let*'."
,@body)
(throw ',done nil))))))
;;;; Defined in ucs-normalize.el
(compat-defun string-glyph-compose (string) ;; <compat-tests:string-glyph-compose>
"Compose STRING according to the Unicode NFC.
This returns a new string obtained by canonical decomposition
of STRING (see `ucs-normalize-NFC-string') followed by canonical
composition, a.k.a. the \"Unicode Normalization Form C\" of STRING.
For instance:
(string-glyph-compose \"Å\") => \"Å\""
(unless (fboundp 'ucs-normalize-NFC-string)
(require 'ucs-normalize))
(ucs-normalize-NFC-string string))
(compat-defun string-glyph-decompose (string) ;; <compat-tests:string-glyph-decompose>
"Decompose STRING according to the Unicode NFD.
This returns a new string that is the canonical decomposition of STRING,
a.k.a. the \"Unicode Normalization Form D\" of STRING. For instance:
(ucs-normalize-NFD-string \"Å\") => \"Å\""
(unless (fboundp 'ucs-normalize-NFD-string)
(require 'ucs-normalize))
(ucs-normalize-NFD-string string))
;;;; Defined in files.el
(compat-defun directory-abbrev-make-regexp (directory) ;; <compat-tests:directory-abbrev-make-regexp>

26
lisp/compat/compat-30.el
View File

@@ -1,6 +1,6 @@
;;; compat-30.el --- Functionality added in Emacs 30 -*- lexical-binding: t; -*-
;; Copyright (C) 2023-2025 Free Software Foundation, Inc.
;; Copyright (C) 2023-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
@@ -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

416
lisp/compat/compat-31.el Normal file
View File

@@ -0,0 +1,416 @@
;;; 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 error-type-p (symbol) ;; <compat-tests:error-api>
"Return non-nil if SYMBOL is a condition type."
(get symbol 'error-conditions))
(compat-defun error-has-type-p (error condition) ;; <compat-tests:error-api>
"Return non-nil if ERROR is of type CONDITION (or a subtype of it)."
(unless (let ((type (car-safe error)))
(and type (symbolp type) (listp (cdr error))
(error-type-p type)))
(signal 'wrong-type-argument (list error)))
(or (eq condition t)
(memq condition (get (car error) 'error-conditions))))
(compat-defalias error-type car ;; <compat-tests:error-api>
"Return the symbol which represents the type of ERROR.
\n(fn ERROR)")
(compat-defalias error-slot-value elt ;; <compat-tests:error-api>
"Access the SLOT of object ERROR.
Slots are specified by position, and slot 0 is the error symbol.
\n(fn ERROR SLOT)")
(compat-defun ensure-proper-list (object) ;; <compat-tests:ensure-proper-list>
"Return OBJECT as a list.
If OBJECT is already a proper list, return OBJECT itself. If it's not a
proper list, return a one-element list containing OBJECT.
`ensure-list' is usually preferable because that function runs in
constant time, but this one has to traverse the whole of OBJECT."
(declare (side-effect-free error-free))
(if (proper-list-p object)
object
(list object)))
(compat-defun set-local (variable value) ;; <compat-tests:set-local>
"Make VARIABLE buffer local and set it to VALUE."
(set (make-local-variable variable) value))
(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 member-if (pred list) ;; <compat-tests:member-if>
"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-defalias any member-if) ;; <compat-tests:member-if>
(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)))
(unless remove
(put-text-property sub-start sub-end 'display (list spec value)
object))
(let ((changed nil)
type)
(setq disp
(cond
((vectorp disp)
(setq type 'vector)
(seq-into disp 'list))
((or (not (consp (car-safe disp)))
(eq (caar disp) 'margin))
(setq type 'scalar)
(list disp))
(t
(setq type 'list)
disp)))
(when-let* ((old (assoc spec disp)))
(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)))
(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-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'.")
;; On Emacs 29 and newer `kill-all-local-variables' has a KILL-PERMANENT argument.
(static-if (< emacs-major-version 29) nil
(compat-defvar work-buffer--list nil ;; <compat-tests:with-work-buffer>
"List of work buffers.")
(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 " *work*" t))))
(compat-defun work-buffer--release (buffer) ;; <compat-tests:with-work-buffer>
"Release work BUFFER."
(if (buffer-live-p buffer)
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(delete-all-overlays))
(let (change-major-mode-hook)
(setq buffer-read-only nil)
(kill-all-local-variables t))
(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. Avoid
retaining state referring to a work buffer, and kill any indirect
buffers you create that use a work buffer as a base."
(declare (indent 0) (debug t))
(static-if (< emacs-major-version 29)
`(with-temp-buffer ,@body)
(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

4
lisp/compat/compat-macs.el
View File

@@ -1,6 +1,6 @@
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; 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
@@ -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))

2
lisp/compat/compat-pkg.el
View File

@@ -1,2 +1,2 @@
;; Generated package description from compat.el -*- no-byte-compile: t -*-
(define-package "compat" "30.1.0.1" "Emacs Lisp Compatibility Library" '((emacs "24.4") (seq "2.23")) :commit "cccd41f549fa88031a32deb26253b462021d7e12" :authors '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp" "maint") :url "https://github.com/emacs-compat/compat")
(define-package "compat" "31.0.0.1" "Emacs Lisp Compatibility Library" '((emacs "25.1")) :commit "b5b48183689b536f72b1214106afeabc465da9d4" :authors '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :keywords '("lisp" "maint") :url "https://github.com/emacs-compat/compat")

14
lisp/compat/compat.el
View File

@@ -1,12 +1,12 @@
;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Copyright (C) 2021-2026 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de>
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; Version: 30.1.0.1
;; Maintainer: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de>
;; Version: 31.0.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

698
lisp/compat/compat.info
View File

File diff suppressed because it is too large Load Diff