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

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-06-22 17:08:08 +02:00
parent 54e5633369
commit 16a0a6db93
558 changed files with 68349 additions and 26568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
lisp/compat/NEWS.org
View File

@@ -2,6 +2,82 @@
#+link: compat-gh https://github.com/emacs-compat/compat/issues/
#+options: toc:nil num:nil author:nil
* Release of "Compat" Version 30.1.0.1
- compat-28: Fix =named-let= tail recursion.
(Release <2025-06-19 Thu>)
* Release of "Compat" Version 30.1.0.0
- compat-30: Add oklab color functions.
(Release <2025-04-02 Wed>)
* Release of "Compat" Version 30.0.2.0
- compat-30: Rename =trusted-files= to =trusted-content=.
(Release <2025-01-04 Sat>)
* Release of "Compat" Version 30.0.1.0
- compat-30: New variable =untrusted-content=.
- compat-30: New variable =trusted-files=.
- compat-30: New function =trusted-content-p=.
(Release <2024-12-15 Sun>)
* Release of "Compat" Version 30.0.0.0
- compat-28: Mark =subr-native-elisp-p= as obsolete (renamed in Emacs 30).
- compat-30: New function =char-to-name=.
- compat-30: New function =obarray-clear=.
- compat-30: New function =interpreted-function-p=.
- compat-30: New function =primitive-function-p=.
- compat-30: New function =closurep=.
- compat-30: Add extended function =sort= with keyword arguments.
- compat-30: New function =value<=.
- compat-30: Add extended =copy-tree= with support for copying records with
non-nil optional second argument.
- compat-30: New macro =static-if=.
- compat-30: New alias =drop=.
- compat-30: New function =merge-ordered-lists=.
- compat-30: New variables =completion-lazy-hilit= and =completion-lazy-hilit-fn=
and new function =completion-lazy-hilit=.
- compat-30: New function =require-with-check=.
- compat-30: New functions =find-buffer= and =get-truename-buffer=.
- compat-30: Add extended =completion-metadata-get= with support for
=completion-category-overrides= and =completion-extra-properties=.
(Release <2024-07-08 Mon>)
* Release of "Compat" Version 29.1.4.5
- Minor optimization of ~plist-get~ and ~plist-put~.
- Minor compatibility adjustments for the Emacs 30 development version.
- A minimal version of =compat.el= will be part of Emacs 30. Emacs :core packages
can directly ~(require 'compat)~ without the ~NOERROR~ flag. Furthermore Compat
will not be installed unnecessarily. If a package depending on Emacs 25.1 and
Compat 29.1 is installed on Emacs 30.1, Compat 29.1 will not be installed from
ELPA, since Emacs 30.1 already provides the required functionality.
(Release <2024-03-16 Sat>)
* Release of "Compat" Version 29.1.4.4
- Fix ~Package-Requires~ header in compat.el
- Fix ~Maintainer~ header in compat.el
(Release <2023-11-13 Mon>)
* Release of "Compat" Version 29.1.4.3
- compat-29: Add function =char-uppercase-p=.
- compat-29: Add function =window-configuration-equal-p=.
(Release <2023-11-04 Sat>)
* Release of "Compat" Version 29.1.4.2
- compat-28: Improve =make-separator-line= visuals on graphic displays.
@@ -265,7 +341,7 @@ directly (see [[compat-srht:2]]).
* Release of "Compat" Version 28.1.1.0
This release mostly fixes a number of smaller bugs that were not
identified as of 28.1.0.0. Nevertheless these warrent a version bump,
identified as of 28.1.0.0. Nevertheless these warrant a version bump,
as some of these changes a functional. These include:
- The addition of the =file-attribute-*= accessor functions.

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

@@ -1,6 +1,6 @@
;;; compat-25.el --- Functionality added in Emacs 25.1 -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; 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
@@ -40,23 +40,6 @@ usage: (bool-vector &rest OBJECTS)"
i (1+ i)))
vec))
;;;; Defined in fns.c
(compat-defun sort (seq predicate) ;; <compat-tests:sort>
"Handle vector SEQ."
:extended t
(cond
((listp seq)
(sort seq predicate))
((vectorp seq)
(let* ((list (sort (append seq nil) predicate))
(p list) (i 0))
(while p
(aset seq i (car p))
(setq i (1+ i) p (cdr p)))
(apply #'vector list)))
((signal 'wrong-type-argument 'list-or-vector-p))))
;;;; Defined in editfns.c
(compat-defalias format-message format) ;; <compat-tests:format-message>
@@ -267,5 +250,11 @@ itself or not."
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

4
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-2023 Free Software Foundation, Inc.
;; 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
@@ -75,7 +75,7 @@ see `region-noncontiguous-p' and `extract-rectangle-bounds'."
;;;; Defined in subr.el
(compat-defun provided-mode-derived-p (mode &rest modes) ;; <compat-tests:provided-derived-mode-p>
(compat-defun provided-mode-derived-p (mode &rest modes) ;; <compat-tests:provided-mode-derived-p>
"Non-nil if MODE is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards.
If you just want to check `major-mode', use `derived-mode-p'."

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-2023 Free Software Foundation, Inc.
;; 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

39
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-2023 Free Software Foundation, Inc.
;; 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
@@ -34,7 +34,7 @@
;; FIXME Should handle multibyte regular expressions
(compat-defun string-search (needle haystack &optional start-pos) ;; <compat-tests:string-search>
"Search for the string NEEDLE in the strign HAYSTACK.
"Search for the string NEEDLE in the string HAYSTACK.
The return value is the position of the first occurrence of
NEEDLE in HAYSTACK, or nil if no match was found.
@@ -52,9 +52,8 @@ issues are inherited."
(when (and start-pos (or (< (length haystack) start-pos)
(< start-pos 0)))
(signal 'args-out-of-range (list start-pos)))
(save-match-data
(let ((case-fold-search nil))
(string-match (regexp-quote needle) haystack start-pos))))
(let (case-fold-search)
(string-match-p (regexp-quote needle) haystack start-pos)))
(compat-defun length= (sequence length) ;; [[compat-tests:length=]]
"Returns non-nil if SEQUENCE has a length equal to LENGTH."
@@ -66,7 +65,7 @@ issues are inherited."
t))
((arrayp sequence)
(= (length sequence) length))
((signal 'wrong-type-argument sequence))))
(t (signal 'wrong-type-argument (list 'sequencep sequence)))))
(compat-defun length< (sequence length) ;; [[compat-tests:length<]]
"Returns non-nil if SEQUENCE is shorter than LENGTH."
@@ -76,7 +75,7 @@ issues are inherited."
(null (nthcdr (1- length) sequence)))
((arrayp sequence)
(< (length sequence) length))
((signal 'wrong-type-argument sequence))))
(t (signal 'wrong-type-argument (list 'sequencep sequence)))))
(compat-defun length> (sequence length) ;; [[compat-tests:length>]]
"Returns non-nil if SEQUENCE is longer than LENGTH."
@@ -85,7 +84,7 @@ issues are inherited."
(and (nthcdr length sequence) t))
((arrayp sequence)
(> (length sequence) length))
((signal 'wrong-type-argument sequence))))
(t (signal 'wrong-type-argument (list 'sequencep sequence)))))
;;;; Defined in fileio.c
@@ -191,7 +190,7 @@ and BLUE, is normalized to have its value in [0,65535]."
;; The "RGBi" (RGB Intensity) specification is defined by
;; XCMS[0], see [1] for the implementation in Xlib.
;;
;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
;; [0] https://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
;; [1] https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392
((string-match
;; (rx bos "rgbi:" (* space)
@@ -355,11 +354,10 @@ REPLACEMENT can use the following special elements:
(compat-defun buffer-local-boundp (symbol buffer) ;; <compat-tests:buffer-local-boundp>
"Return non-nil if SYMBOL is bound in BUFFER.
Also see `local-variable-p'."
(catch 'fail
(condition-case nil
(buffer-local-value symbol buffer)
(void-variable nil (throw 'fail nil)))
t))
(condition-case nil
(progn (buffer-local-value symbol buffer)
t)
(void-variable nil)))
(compat-defmacro with-existing-directory (&rest body) ;; <compat-tests:with-existing-directory>
"Execute BODY with `default-directory' bound to an existing directory.
@@ -398,7 +396,8 @@ not a list, return a one-element list containing OBJECT."
;;;; Defined in data.c
(compat-defalias subr-native-elisp-p ignore) ;; <compat-tests:subr-native-elisp-p>
;; Renamed in Emacs 30 to `native-comp-function-p'.
(compat-defalias subr-native-elisp-p ignore :obsolete t) ;; <compat-tests:obsolete-subr-native-elisp-p>
;;;; Defined in subr-x.el
@@ -519,7 +518,11 @@ as the new values of the bound variables in the recursive invocation."
(cons (car handler)
(funcall tco-progn (cdr handler))))
(nthcdr 3 expr))))
((memq (car-safe expr) '(and progn))
((eq (car-safe expr) 'and)
(if (cddr expr)
(funcall tco `(if ,(cadr expr) ,(cons 'and (cddr expr))))
(funcall tco (cadr expr))))
((eq (car-safe expr) 'progn)
(cons (car expr) (funcall tco-progn (cdr expr))))
((memq (car-safe expr) '(let let*))
(append (list (car expr) (cadr expr))
@@ -784,7 +787,7 @@ Other uses risk returning non-nil value that point to the wrong file."
;;;; Defined in env.el
(compat-defmacro with-environment-variables (variables &rest body) ;; <compat-tests:with-environment-variables>
"Set VARIABLES in the environent and execute BODY.
"Set VARIABLES in the environment and execute BODY.
VARIABLES is a list of variable settings of the form (VAR VALUE),
where VAR is the name of the variable (a string) and VALUE
is its value (also a string).
@@ -837,7 +840,7 @@ function will never return nil."
;;;; Defined in button.el
;; Obsolete Alias since 29
(compat-defalias button-buttonize buttonize :obsolete t) ;; <compat-tests:button-buttonize>
(compat-defalias button-buttonize buttonize :obsolete t) ;; <compat-tests:obsolete-button-buttonize>
;;;; Defined in wid-edit.el

64
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-2023 Free Software Foundation, Inc.
;; 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
@@ -37,6 +37,10 @@
(locate-file "simple" load-path (get-load-suffixes))))
"Directory where Emacs's own *.el and *.elc Lisp files are installed.")
;;;; Defined in window.c
(compat-defalias window-configuration-equal-p compare-window-configurations) ;; <compat-tests:window-configuration-equal-p>
;;;; Defined in xdisp.c
(compat-defun get-display-property (position prop &optional object properties) ;; <compat-tests:get-display-property>
@@ -98,38 +102,40 @@ Unibyte strings are converted to multibyte for comparison."
(compat-defun plist-get (plist prop &optional predicate) ;; <compat-tests:plist-get>
"Handle optional argument PREDICATE."
:extended t
(if (or (null predicate) (eq predicate 'eq))
(plist-get plist prop)
(catch 'found
(while (consp plist)
(when (funcall predicate prop (car plist))
(throw 'found (cadr plist)))
(setq plist (cddr plist))))))
(pcase predicate
((or `nil `eq) (plist-get plist prop))
(`equal (lax-plist-get plist prop))
(_ (catch 'found
(while (consp plist)
(when (funcall predicate prop (car plist))
(throw 'found (cadr plist)))
(setq plist (cddr plist)))))))
(compat-defun plist-put (plist prop val &optional predicate) ;; <compat-tests:plist-get>
"Handle optional argument PREDICATE."
:extended t
(if (or (null predicate) (eq predicate 'eq))
(plist-put plist prop val)
(catch 'found
(let ((tail plist))
(while (consp tail)
(when (funcall predicate prop (car tail))
(setcar (cdr tail) val)
(throw 'found plist))
(setq tail (cddr tail))))
(nconc plist (list prop val)))))
(pcase predicate
((or `nil `eq) (plist-put plist prop val))
(`equal (lax-plist-put plist prop val))
(_ (catch 'found
(let ((tail plist))
(while (consp tail)
(when (funcall predicate prop (car tail))
(setcar (cdr tail) val)
(throw 'found plist))
(setq tail (cddr tail))))
(nconc plist (list prop val))))))
(compat-defun plist-member (plist prop &optional predicate) ;; <compat-tests:plist-get>
"Handle optional argument PREDICATE."
:extended t
(if (or (null predicate) (eq predicate 'eq))
(plist-member plist prop)
(catch 'found
(while (consp plist)
(when (funcall predicate prop (car plist))
(throw 'found plist))
(setq plist (cddr plist))))))
(pcase predicate
((or `nil `eq) (plist-member plist prop))
(_ (catch 'found
(while (consp plist)
(when (funcall predicate prop (car plist))
(throw 'found plist))
(setq plist (cddr plist)))))))
;;;; Defined in gv.el
@@ -506,6 +512,14 @@ thus overriding the value of the TIMEOUT argument to that function.")
;;;; Defined in simple.el
(compat-defun char-uppercase-p (char) ;; <compat-tests:char-uppercase-p>
"Return non-nil if CHAR is an upper-case character.
If the Unicode tables are not yet available, e.g. during bootstrap,
then gives correct answers only for ASCII characters."
(cond ((unicode-property-table-internal 'lowercase)
(characterp (get-char-code-property char 'lowercase)))
((and (>= char ?A) (<= char ?Z)))))
(compat-defun use-region-noncontiguous-p () ;; <compat-tests:region-noncontiguous-p>
"Return non-nil for a non-contiguous region if `use-region-p'."
(and (use-region-p) (region-noncontiguous-p)))

474
lisp/compat/compat-30.el Normal file
View File

@@ -0,0 +1,474 @@
;;; compat-30.el --- Functionality added in Emacs 30 -*- lexical-binding: t; -*-
;; Copyright (C) 2023-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 30, needed by older Emacs versions.
;;; Code:
(eval-when-compile (load "compat-macs.el" nil t t))
(compat-require compat-29 "29.1")
(compat-version "29.3")
(compat-defvar untrusted-content nil ;; <compat-tests:untrusted-content>
"Non-nil means that current buffer originated from an untrusted source.
Email clients and some other modes may set this non-nil to mark the
buffer contents as untrusted.
This variable might be subject to change without notice."
:local permanent)
(compat-version "30.1")
;;;; Defined in lread.c
(compat-defun obarray-clear (ob) ;; <compat-tests:obarray-clear>
"Remove all symbols from obarray OB."
(fillarray ob 0))
;;;; Defined in buffer.c
(compat-defun find-buffer (variable value) ;; <compat-tests:find-buffer>
"Return the buffer with buffer-local VARIABLE equal to VALUE.
If there is no such live buffer, return nil."
(cl-loop for buffer the buffers
if (equal (buffer-local-value variable buffer) value)
return buffer))
(compat-defun get-truename-buffer (filename) ;; <compat-tests:get-truename-buffer>
"Return the buffer with `file-truename' equal to FILENAME (a string).
If there is no such live buffer, return nil.
See also `find-buffer-visiting'."
(find-buffer 'buffer-file-truename filename))
;;;; Defined in files.el
(compat-defvar trusted-content nil ;; <compat-tests:trusted-content>
"List of files and directories whose content we trust.
Be extra careful here since trusting means that Emacs might execute the
code contained within those files and directories without an explicit
request by the user.
One important case when this might happen is when `flymake-mode' is
enabled (for example, when it is added to a mode hook).
Each element of the list should be a string:
- If it ends in \"/\", it is considered as a directory name and means that
Emacs should trust all the files whose name has this directory as a prefix.
- else it is considered as a file name.
Use abbreviated file names. For example, an entry \"~/mycode\" means
that Emacs will trust all the files in your directory \"mycode\".
This variable can also be set to `:all', in which case Emacs will trust
all files, which opens a gaping security hole."
:risky t)
(compat-defun trusted-content-p () ;; <compat-tests:trusted-content-p>
"Return non-nil if we trust the contents of the current buffer.
Here, \"trust\" means that we are willing to run code found inside of it.
See also `trusted-content'."
(and (not untrusted-content)
(or
(eq trusted-content :all)
(and
buffer-file-truename
(with-demoted-errors "trusted-content-p: %S"
(let ((exists (file-exists-p buffer-file-truename)))
(or
(if (and exists user-init-file)
(file-equal-p buffer-file-truename user-init-file)
(equal buffer-file-truename user-init-file))
(let ((file (abbreviate-file-name buffer-file-truename))
(trusted nil))
(dolist (tf trusted-content)
(when (or (if exists (file-equal-p tf file) (equal tf file))
(and (string-suffix-p "/" tf)
(string-prefix-p tf file)))
(setq trusted t)))
trusted))))))))
(compat-defun require-with-check (feature &optional filename noerror) ;; <compat-tests:require-with-check>
"If FEATURE is not already loaded, load it from FILENAME.
This is like `require' except if FEATURE is already a member of the list
`features’, then check if it was provided by a different file than the
one that is about to be loaded now (presumably because `load-path' has
been changed since FILENAME was loaded). If that is the case, either
signal an error (the default), or forcibly reload the new file (if
NOERROR is equal to `reload'), or otherwise emit a warning."
(let ((lh load-history)
(res (require feature filename (if (eq noerror 'reload) nil noerror))))
;; If the `feature' was not yet provided, `require' just loaded the right
;; file, so we're done.
(when (and res (eq lh load-history))
;; If `require' did nothing, we need to make sure that was warranted.
(let* ((fn (locate-file (or filename (symbol-name feature))
load-path (get-load-suffixes) nil
)) ;; load-prefer-newer
;; We used to look for `fn' in `load-history' with `assoc'
;; which works in most cases, but in some cases (e.g. when
;; `load-prefer-newer' is set) `locate-file' can return a
;; different file than the file that `require' would load,
;; so the file won't be found in `load-history' even though
;; we did load "it". (bug#74040)
;; So use a "permissive" search which doesn't pay attention to
;; differences between file extensions.
(prefix (if (string-match
(concat (regexp-opt (get-load-suffixes)) "\\'") fn)
(concat (substring fn 0 (match-beginning 0)) ".")
fn))
(lh load-history))
(while (and lh (let ((file (car-safe (car lh))))
(not (and file (string-prefix-p prefix file)))))
(setq lh (cdr lh)))
(cond
(lh nil) ;We loaded the right file.
((eq noerror 'reload) (load fn nil 'nomessage))
((and fn (memq feature features))
(funcall (if noerror #'warn #'error)
"Feature `%S' is now provided by a different file %s"
feature fn))
(fn
(funcall (if noerror #'warn #'error)
"Could not load file %s" fn))
(t
(funcall (if noerror #'warn #'error)
"Could not locate file %s in load path"
(or filename (symbol-name feature)))))))
res))
;;;; Defined in minibuffer.el
(compat-defun completion--metadata-get-1 (metadata prop) ;; <compat-tests:completion-metadata-get>
"Helper function.
See for `completion-metadata-get' for METADATA and PROP arguments."
(or (alist-get prop metadata)
(plist-get completion-extra-properties
(or (get prop 'completion-extra-properties--keyword)
(put prop 'completion-extra-properties--keyword
(intern (concat ":" (symbol-name prop))))))))
(compat-defun completion-metadata-get (metadata prop) ;; <compat-tests:completion-metadata-get>
"Get property PROP from completion METADATA.
If the metadata specifies a completion category, the variables
`completion-category-overrides' and
`completion-category-defaults' take precedence for
category-specific overrides. If the completion metadata does not
specify the property, the `completion-extra-properties' plist is
consulted. Note that the keys of the
`completion-extra-properties' plist are keyword symbols, not
plain symbols."
:extended t
(if-let ((cat (and (not (eq prop 'category))
(completion--metadata-get-1 metadata 'category)))
(over (completion--category-override cat prop)))
(cdr over)
(completion--metadata-get-1 metadata prop)))
(compat-defvar completion-lazy-hilit nil ;; <compat-tests:completion-lazy-hilit>
"If non-nil, request lazy highlighting of completion candidates.
Lisp programs (a.k.a. \"front ends\") that present completion
candidates may opt to bind this variable to a non-nil value when
calling functions (such as `completion-all-completions') which
produce completion candidates. This tells the underlying
completion styles that they do not need to fontify (i.e.,
propertize with the `face' property) completion candidates in a
way that highlights the matching parts. Then it is the front end
which presents the candidates that becomes responsible for this
fontification. The front end does that by calling the function
`completion-lazy-hilit' on each completion candidate that is to be
displayed to the user.
Note that only some completion styles take advantage of this
variable for optimization purposes. Other styles will ignore the
hint and fontify eagerly as usual. It is still safe for a
front end to call `completion-lazy-hilit' in these situations.
To author a completion style that takes advantage of this variable,
see `completion-lazy-hilit-fn' and `completion-pcm--hilit-commonality'.")
(compat-defvar completion-lazy-hilit-fn nil ;; <compat-tests:completion-lazy-hilit>
"Fontification function set by lazy-highlighting completions styles.
When a given style wants to enable support for `completion-lazy-hilit'
\(which see), that style should set this variable to a function of one
argument. It will be called with each completion candidate, a string, to
be displayed to the user, and should destructively propertize these
strings with the `face' property.")
(compat-defun completion-lazy-hilit (str) ;; <compat-tests:completion-lazy-hilit>
"Return a copy of completion candidate STR that is `face'-propertized.
See documentation of the variable `completion-lazy-hilit' for more
details."
(if (and completion-lazy-hilit completion-lazy-hilit-fn)
(funcall completion-lazy-hilit-fn (copy-sequence str))
str))
;;;; Defined in color.el
(compat-defun color-oklab-to-xyz (l a b) ;; <compat-tests:color-oklab-to-xyz>
"Convert the OkLab color represented by L A B to CIE XYZ.
Oklab is a perceptual color space created by Björn Ottosson
<https://bottosson.github.io/posts/oklab/>. It has the property that
changes in the hue and saturation of a color can be made while maintaining
the same perceived lightness."
:feature color
(let ((ll (expt (+ (* 1.0 l) (* 0.39633779 a) (* 0.21580376 b)) 3))
(mm (expt (+ (* 1.00000001 l) (* -0.10556134 a) (* -0.06385417 b)) 3))
(ss (expt (+ (* 1.00000005 l) (* -0.08948418 a) (* -1.29148554 b)) 3)))
(list (+ (* ll 1.22701385) (* mm -0.55779998) (* ss 0.28125615))
(+ (* ll -0.04058018) (* mm 1.11225687) (* ss -0.07167668))
(+ (* ll -0.07638128) (* mm -0.42148198) (* ss 1.58616322)))))
(compat-defun color-xyz-to-oklab (x y z) ;; <compat-tests:color-xyz-to-oklab>
"Convert the CIE XYZ color represented by X Y Z to Oklab."
:feature color
(let ((ll (+ (* x 0.8189330101) (* y 0.3618667424) (* z -0.1288597137)))
(mm (+ (* x 0.0329845436) (* y 0.9293118715) (* z 0.0361456387)))
(ss (+ (* x 0.0482003018) (* y 0.2643662691) (* z 0.6338517070))))
(let*
((cube-root (lambda (f)
(if (< f 0)
(- (expt (- f) (/ 1.0 3.0)))
(expt f (/ 1.0 3.0)))))
(lll (funcall cube-root ll))
(mmm (funcall cube-root mm))
(sss (funcall cube-root ss)))
(list (+ (* lll 0.2104542553) (* mmm 0.7936177850) (* sss -0.0040720468))
(+ (* lll 1.9779984951) (* mmm -2.4285922050) (* sss 0.4505937099))
(+ (* lll 0.0259040371) (* mmm 0.7827717662) (* sss -0.8086757660))))))
(compat-defun color-oklab-to-srgb (l a b) ;; <compat-tests:color-oklab-to-srgb>
"Convert the Oklab color represented by L A B to sRGB."
:feature color
(apply #'color-xyz-to-srgb (color-oklab-to-xyz l a b)))
(compat-defun color-srgb-to-oklab (r g b) ;; <compat-tests:color-srgb-to-oklab>
"Convert the sRGB color R G B to Oklab."
:feature color
(apply #'color-xyz-to-oklab (color-srgb-to-xyz r g b)))
;;;; Defined in subr.el
(compat-defmacro static-if (condition then-form &rest else-forms) ;; <compat-tests:static-if>
"A conditional compilation macro.
Evaluate CONDITION at macro-expansion time. If it is non-nil,
expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS
enclosed in a `progn' form. ELSE-FORMS may be empty."
(declare (indent 2) (debug (sexp sexp &rest sexp)))
(if (eval condition lexical-binding)
then-form
(cons 'progn else-forms)))
(compat-defun closurep (object) ;; <compat-tests:closurep>
"Return t if OBJECT is a function of type closure."
(declare (side-effect-free error-free))
(eq (car-safe object) 'closure))
(compat-defalias interpreted-function-p closurep) ;; <compat-tests:closurep>
(compat-defun primitive-function-p (object) ;; <compat-tests:primitive-function-p>
"Return t if OBJECT is a built-in primitive function.
This excludes special forms, since they are not functions."
(declare (side-effect-free error-free))
(and (subrp object)
(not (or (with-no-warnings (subr-native-elisp-p object))
(special-form-p object)))))
(compat-defalias drop nthcdr) ;; <compat-tests:drop>
(compat-defun merge-ordered-lists (lists &optional error-function) ;; <compat-tests:merge-ordered-lists>
"Merge LISTS in a consistent order.
LISTS is a list of lists of elements.
Merge them into a single list containing the same elements (removing
duplicates), obeying their relative positions in each list.
The order of the (sub)lists determines the final order in those cases where
the order within the sublists does not impose a unique choice.
Equality of elements is tested with `eql'.
If a consistent order does not exist, call ERROR-FUNCTION with
a remaining list of lists that we do not know how to merge.
It should return the candidate to use to continue the merge, which
has to be the head of one of the lists.
By default we choose the head of the first list."
(let ((result '()))
(setq lists (remq nil lists))
(while (cdr (setq lists (delq nil lists)))
(let* ((next nil)
(tail lists))
(while tail
(let ((candidate (caar tail))
(other-lists lists))
(while other-lists
(if (not (memql candidate (cdr (car other-lists))))
(setq other-lists (cdr other-lists))
(setq candidate nil)
(setq other-lists nil)))
(if (not candidate)
(setq tail (cdr tail))
(setq next candidate)
(setq tail nil))))
(unless next
(setq next (funcall (or error-function #'caar) lists))
(unless (funcall
(eval-when-compile (if (fboundp 'compat--assoc) 'compat--assoc 'assoc))
next lists #'eql)
(error "Invalid candidate returned by error-function: %S" next)))
(push next result)
(setq lists
(mapcar (lambda (l) (if (eql (car l) next) (cdr l) l))
lists))))
(if (null result) (car lists)
(append (nreverse result) (car lists)))))
(compat-defun copy-tree (tree &optional vectors-and-records) ;; <compat-tests:copy-tree>
"Handle copying records when optional arg is non-nil."
:extended t
(declare (side-effect-free error-free))
(if (fboundp 'recordp)
(if (consp tree)
(let (result)
(while (consp tree)
(let ((newcar (car tree)))
(if (or (consp (car tree))
(and vectors-and-records
(or (vectorp (car tree)) (recordp (car tree)))))
(setq newcar (compat--copy-tree (car tree) vectors-and-records)))
(push newcar result))
(setq tree (cdr tree)))
(nconc (nreverse result)
(if (and vectors-and-records (or (vectorp tree) (recordp tree)))
(compat--copy-tree tree vectors-and-records)
tree)))
(if (and vectors-and-records (or (vectorp tree) (recordp tree)))
(let ((i (length (setq tree (copy-sequence tree)))))
(while (>= (setq i (1- i)) 0)
(aset tree i (compat--copy-tree (aref tree i) vectors-and-records)))
tree)
tree))
(copy-tree tree vectors-and-records)))
;;;; Defined in fns.c
(compat-defun value< (a b) ;; <compat-tests:value<>
"Return non-nil if A precedes B in standard value order.
A and B must have the same basic type.
Numbers are compared with <.
Strings and symbols are compared with string-lessp.
Lists, vectors, bool-vectors and records are compared lexicographically.
Markers are compared lexicographically by buffer and position.
Buffers and processes are compared by name.
Other types are considered unordered and the return value will be ‘nil’."
(cond
((or (and (numberp a) (numberp b))
(and (markerp a) (markerp b)))
(< a b))
((or (and (stringp a) (stringp b))
(and (symbolp a) (symbolp b)))
(string< a b))
((and (listp a) (listp b))
(while (and (consp a) (consp b) (equal (car a) (car b)))
(setq a (cdr a) b (cdr b)))
(cond
((not b) nil)
((not a) t)
((and (consp a) (consp b)) (value< (car a) (car b)))
(t (value< a b))))
((and (vectorp a) (vectorp b))
(let* ((na (length a))
(nb (length b))
(n (min na nb))
(i 0))
(while (and (< i n) (equal (aref a i) (aref b i)))
(cl-incf i))
(if (< i n) (value< (aref a i) (aref b i)) (< n nb))))
((and (bufferp a) (bufferp b))
;; `buffer-name' is nil for killed buffers.
(setq a (buffer-name a)
b (buffer-name b))
(cond
((and a b) (string< a b))
(b t)))
((and (processp a) (processp b))
(string< (process-name a) (process-name b)))
;; TODO Add support for more types here.
;; Other values of equal type are considered unordered (return value nil).
((eq (type-of a) (type-of b)) nil)
;; Different types.
(t (error "value< type mismatch: %S %S" a b))))
(compat-defun sort (seq &optional lessp &rest rest) ;; <compat-tests:sort>
"Sort function with support for keyword arguments.
The following arguments are defined:
:key FUNC -- FUNC is a function that takes a single element from SEQ and
returns the key value to be used in comparison. If absent or nil,
`identity' is used.
:lessp FUNC -- FUNC is a function that takes two arguments and returns
non-nil if the first element should come before the second.
If absent or nil, `value<' is used.
:reverse BOOL -- if BOOL is non-nil, the sorting order implied by FUNC is
reversed. This does not affect stability: equal elements still retain
their order in the input sequence.
:in-place BOOL -- if BOOL is non-nil, SEQ is sorted in-place and returned.
Otherwise, a sorted copy of SEQ is returned and SEQ remains unmodified;
this is the default.
For compatibility, the calling convention (sort SEQ LESSP) can also be used;
in this case, sorting is always done in-place."
:extended t
(let ((in-place t) (reverse nil) (orig-seq seq))
(when (or (not lessp) rest)
(setq
rest (if lessp (cons lessp rest) rest)
in-place (plist-get rest :in-place)
reverse (plist-get rest :reverse)
lessp (let ((key (plist-get rest :key))
(< (or (plist-get rest :lessp) #'value<)))
(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)))
;;;; Defined in mule-cmds.el
(compat-defun char-to-name (char) ;; <compat-tests:char-to-name>
"Return the Unicode name for CHAR, if it has one, else nil.
Return nil if CHAR is not a character."
(and (characterp char)
(or (get-char-code-property char 'name)
(get-char-code-property char 'old-name))))
(provide 'compat-30)
;;; compat-30.el ends here

27
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-2023 Free Software Foundation, Inc.
;; 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
@@ -17,12 +17,13 @@
;;; Commentary:
;; This file provides *internal* macros, which are used by Compat to
;; facilitate the definition of compatibility functions, macros and
;; variables. The `compat-macs' feature should never be loaded at
;; runtime in your Emacs and will only be used during byte
;; compilation. Every definition provided here should be considered
;; internal and may change any time between Compat releases.
;; WARNING: This file provides *internal* macros. The macros are used
;; by Compat to facilitate the definition of compatibility functions,
;; compatibility macros and compatibility variables. The
;; `compat-macs' feature should never be loaded at runtime in your
;; Emacs and will only be used during byte compilation. Every
;; definition provided here is internal, may change any time between
;; Compat releases and must not be used by other packages.
;;; Code:
@@ -141,7 +142,7 @@ REST are attributes and the function BODY."
(defmacro compat-guard (cond &rest rest)
"Guard definition with a runtime COND and a version check.
The runtime condition must make sure that no definition is
overriden. REST is an attribute plist followed by the definition
overridden. REST is an attribute plist followed by the definition
body. The attributes specify the conditions under which the
definition is generated.
@@ -220,6 +221,8 @@ definition is generated.
- :constant :: Mark the variable as constant if t.
- :risky :: Mark the variable as risky if t.
- :local :: Make the variable buffer-local if t. If the value is
`permanent' make the variable additionally permanently local.
@@ -231,15 +234,18 @@ definition is generated.
(doc-string 3) (indent 2))
(compat-macs--guard
attrs (list :constant #'booleanp
:risky #'booleanp
:local (lambda (x) (memq x '(nil t permanent)))
:obsolete (lambda (x) (or (booleanp x) (stringp x))))
(lambda (constant local obsolete)
(lambda (constant risky local obsolete)
(compat-macs--strict (not (boundp name)) "%s already defined" name)
(compat-macs--assert (not (and constant local)) "Both :constant and :local")
(compat-macs--assert (not (and local risky)) "Both :risky and :local")
;; The boundp check is performed at runtime to make sure that we never
;; redefine an existing definition if Compat is loaded on a newer Emacs
;; version.
`((unless (boundp ',name)
`((defvar ,name)
(unless (boundp ',name)
(,(if constant 'defconst 'defvar)
,name ,initval
,(compat-macs--docstring 'variable name docstring))
@@ -248,6 +254,7 @@ definition is generated.
',name ,(if (stringp obsolete) obsolete "No substitute")
,compat-macs--version))))
,@(and local `((make-variable-buffer-local ',name)))
,@(and risky `((put ',name 'risky-local-variable t)))
,@(and (eq local 'permanent) `((put ',name 'permanent-local t)))))))
(defmacro compat-version (version)

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" "29.1.4.2" "Emacs Lisp Compatibility Library" '((emacs "24.4") (seq "2.3")) :commit "74300f16a1630a33a86710aa20c1fc26f5f89f75" :authors '(("Philip Kaludercic" . "philipk@posteo.net") ("Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '(("Daniel Mendler" . "mail@daniel-mendler.de") ("Compat Development" . "~pkal/compat-devel@lists.sr.ht")) :keywords '("lisp" "maint") :url "https://github.com/emacs-compat/compat")
(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")

18
lisp/compat/compat.el
View File

@@ -1,12 +1,12 @@
;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de>
;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>, Compat Development <~pkal/compat-devel@lists.sr.ht>
;; Version: 29.1.4.2
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
;; Version: 30.1.0.1
;; URL: https://github.com/emacs-compat/compat
;; Package-Requires: ((emacs "24.4") (seq "2.3"))
;; Package-Requires: ((emacs "24.4") (seq "2.23"))
;; Keywords: lisp, maint
;; This program is free software; you can redistribute it and/or modify
@@ -49,11 +49,11 @@
;; Ensure that the newest compatibility layer is required at compile
;; time and runtime, but only if needed.
(eval-when-compile
(defmacro compat--maybe-require-29 ()
(when (version< emacs-version "29.1")
(require 'compat-29)
'(require 'compat-29))))
(compat--maybe-require-29)
(defmacro compat--maybe-require ()
(when (version< emacs-version "30.1")
(require 'compat-30)
'(require 'compat-30))))
(compat--maybe-require)
;;;; Macros for extended compatibility function calls

930
lisp/compat/compat.info
View File

File diff suppressed because it is too large Load Diff