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

update of packages

Browse Source
This commit is contained in:
Daniel Weschke
2023-11-04 19:26:41 +01:00
parent e162a12b58
commit 3b54a3236d
726 changed files with 297673 additions and 34585 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,9 +1,6 @@
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*-
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*-
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: lisp
;; Copyright (C) 2021-2023 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
@@ -20,297 +17,249 @@
;;; Commentary:
;; These macros are used to define compatibility functions, macros and
;; advice.
;; 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.
;;; Code:
(defmacro compat--ignore (&rest _)
"Ignore all arguments."
nil)
;; We always require subr-x at compile time for the fboundp check
;; since definitions have been moved around. The cl-lib macros are
;; needed by compatibility definitions.
(require 'subr-x)
(require 'cl-lib)
(defvar compat--inhibit-prefixed nil
"Non-nil means that prefixed definitions are not loaded.
A prefixed function is something like `compat-assoc', that is
only made visible when the respective compatibility version file
is loaded (in this case `compat-26').")
(defvar compat-macs--version nil
"Version of the currently defined compatibility definitions.")
(defmacro compat--inhibit-prefixed (&rest body)
"Ignore BODY unless `compat--inhibit-prefixed' is true."
`(unless (bound-and-true-p compat--inhibit-prefixed)
,@body))
(defun compat-macs--strict (cond &rest error)
"Assert strict COND, otherwise fail with ERROR."
(when (bound-and-true-p compat-strict)
(apply #'compat-macs--assert cond error)))
(defvar compat-current-version nil
"Default version to use when no explicit version was given.")
(defun compat-macs--assert (cond &rest error)
"Assert COND, otherwise fail with ERROR."
(unless cond (apply #'error error)))
(defmacro compat-declare-version (version)
"Set the Emacs version that is currently being handled to VERSION."
;; FIXME: Avoid setting the version for any definition that might
;; follow, but try to restrict it to the current file/buffer.
(setq compat-current-version version)
nil)
(defun compat-macs--docstring (type name docstring)
"Format DOCSTRING for NAME of TYPE.
Prepend compatibility notice to the actual documentation string."
(with-temp-buffer
(insert
(format
"[Compatibility %s for `%s', defined in Emacs %s. \
See (compat) Emacs %s' for more details.]\n\n%s"
type name compat-macs--version compat-macs--version docstring))
(let ((fill-column 80))
(fill-region (point-min) (point-max)))
(buffer-string)))
(defvar compat--generate-function #'compat--generate-default
"Function used to generate compatibility code.
The function must take six arguments: NAME, DEF-FN, INSTALL-FN,
CHECK-FN, ATTR and TYPE. The resulting body is constructed by
invoking the functions DEF-FN (passed the \"realname\" and the
version number, returning the compatibility definition), the
INSTALL-FN (passed the \"realname\" and returning the
installation code), CHECK-FN (passed the \"realname\" and
returning a check to see if the compatibility definition should
be installed). ATTR is a plist used to modify the generated
code. The following attributes are handled, all others are
ignored:
(defun compat-macs--check-attributes (attrs preds)
"Check ATTRS given PREDS predicate plist and return rest."
(while (keywordp (car attrs))
(compat-macs--assert (cdr attrs) "Attribute list length is odd")
(compat-macs--assert (let ((p (plist-get preds (car attrs))))
(and p (or (eq p t) (funcall p (cadr attrs)))))
"Invalid attribute %s" (car attrs))
(setq attrs (cddr attrs)))
attrs)
- :min-version :: Prevent the compatibility definition from begin
installed in versions older than indicated (string).
(defun compat-macs--guard (attrs preds fun)
"Guard compatibility definition generation.
The version constraints specified by ATTRS are checked. PREDS is
a plist of predicates for arguments which are passed to FUN."
(declare (indent 2))
(compat-macs--assert compat-macs--version "No `compat-version' was declared")
(let* ((body (compat-macs--check-attributes
attrs `(,@preds :feature symbolp)))
(feature (plist-get attrs :feature))
(attrs `(:body ,body ,@attrs))
args)
;; Require feature at compile time
(when feature
(compat-macs--assert (not (eq feature 'subr-x)) "Invalid feature subr-x")
(require feature))
;; The current Emacs must be older than the currently declared version.
(when (version< emacs-version compat-macs--version)
(while preds
(push (plist-get attrs (car preds)) args)
(setq preds (cddr preds)))
(setq body (apply fun (nreverse args)))
(if (and feature body)
`(with-eval-after-load ',feature ,@body)
(macroexp-progn body)))))
- :max-version :: Prevent the compatibility definition from begin
installed in versions newer than indicated (string).
(defun compat-macs--defun (type name arglist docstring rest)
"Define function NAME of TYPE with ARGLIST and DOCSTRING.
REST are attributes and the function BODY."
(compat-macs--guard
rest (list :extended (lambda (x) (or (booleanp x) (version-to-list x)))
:obsolete (lambda (x) (or (booleanp x) (stringp x)))
:body t)
(lambda (extended obsolete body)
(when (stringp extended)
(compat-macs--assert
(and (version< extended compat-macs--version) (version< "24.4" extended))
"Invalid :extended version %s for %s %s" extended type name)
(setq extended (version<= extended emacs-version)))
(compat-macs--strict (eq extended (fboundp name))
"Wrong :extended flag for %s %s" type name)
;; Remove unsupported declares. It might be possible to set these
;; properties otherwise. That should be looked into and implemented
;; if it is the case.
(when (and (listp (car-safe body)) (eq (caar body) 'declare) (<= emacs-major-version 25))
(setcar body (assq-delete-all 'pure (assq-delete-all
'side-effect-free (car body)))))
;; Use `:extended' name if the function is already defined.
(let* ((defname (if (and extended (fboundp name))
(intern (format "compat--%s" name))
name))
(def `(,(if (memq '&key arglist)
(if (eq type 'macro) 'cl-defmacro 'cl-defun)
(if (eq type 'macro) 'defmacro 'defun))
,defname ,arglist
,(compat-macs--docstring type name docstring)
,@body)))
`(,@(if (eq defname name)
;; An additional fboundp check is performed at runtime to make
;; sure that we never redefine an existing definition if Compat
;; is loaded on a newer Emacs version. Declare the function,
;; such that the byte compiler does not complain about possibly
;; missing functions at runtime. The warnings are generated due
;; to the fboundp check.
`((declare-function ,name nil)
(unless (fboundp ',name) ,def))
(list def))
,@(when obsolete
`((make-obsolete
',defname ,(if (stringp obsolete) obsolete "No substitute")
,compat-macs--version))))))))
- :feature :: The library the code is supposed to be loaded
with (via `eval-after-load').
(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
body. The attributes specify the conditions under which the
definition is generated.
- :cond :: Only install the compatibility code, iff the value
evaluates to non-nil.
- :feature :: Wrap the definition with `with-eval-after-load' for
the given feature."
(declare (debug ([&rest keywordp sexp] def-body))
(indent 1))
(compat-macs--guard rest '(:body t)
(lambda (body)
(compat-macs--assert body "The guarded body is empty")
(if (eq cond t)
body
(compat-macs--strict (eval cond t) "Guard %S failed" cond)
`((when ,cond ,@body))))))
For prefixed functions, this can be interpreted as a test to
`defalias' an existing definition or not.
(defmacro compat-defalias (name def &rest attrs)
"Define compatibility alias NAME as DEF.
ATTRS is a plist of attributes, which specify the conditions
under which the definition is generated.
- :no-highlight :: Do not highlight this definition as
compatibility function.
- :obsolete :: Mark the alias as obsolete if t.
- :version :: Manual specification of the version the compatee
code was defined in (string).
- :realname :: Manual specification of a \"realname\" to use for
the compatibility definition (symbol).
- :notes :: Additional notes that a developer using this
compatibility function should keep in mind.
- :prefix :: Add a `compat-' prefix to the name, and define the
compatibility code unconditionally.
TYPE is used to set the symbol property `compat-type' for NAME.")
(defun compat--generate-default (name def-fn install-fn check-fn attr type)
"Generate a leaner compatibility definition.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(let* ((min-version (plist-get attr :min-version))
(max-version (plist-get attr :max-version))
(feature (plist-get attr :feature))
(cond (plist-get attr :cond))
(version (or (plist-get attr :version)
compat-current-version))
(realname (or (plist-get attr :realname)
(intern (format "compat--%S" name))))
(check (cond
((or (and min-version
(version< emacs-version min-version))
(and max-version
(version< max-version emacs-version)))
'(compat--ignore))
((plist-get attr :prefix)
'(compat--inhibit-prefixed))
((and version (version<= version emacs-version) (not cond))
'(compat--ignore))
(`(when (and ,(if cond cond t)
,(funcall check-fn)))))))
(cond
((and (plist-get attr :prefix) (memq type '(func macro))
(string-match "\\`compat-\\(.+\\)\\'" (symbol-name name))
(let* ((actual-name (intern (match-string 1 (symbol-name name))))
(body (funcall install-fn actual-name version)))
(when (and (version<= version emacs-version)
(fboundp actual-name))
`(,@check
,(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body))))))
((plist-get attr :realname)
`(progn
,(funcall def-fn realname version)
(,@check
,(let ((body (funcall install-fn realname version)))
(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body)))))
((let* ((body (if (eq type 'advice)
`(,@check
,(funcall def-fn realname version)
,(funcall install-fn realname version))
`(,@check ,(funcall def-fn name version)))))
(if feature
;; See https://nullprogram.com/blog/2018/02/22/:
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
body))))))
(defun compat-generate-common (name def-fn install-fn check-fn attr type)
"Common code for generating compatibility definitions.
See `compat-generate-function' for details on the arguments NAME,
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
(when (and (plist-get attr :cond) (plist-get attr :prefix))
(error "A prefixed function %s cannot have a condition" name))
(funcall compat--generate-function
name def-fn install-fn check-fn attr type))
(defun compat-common-fdefine (type name arglist docstring rest)
"Generate compatibility code for a function NAME.
TYPE is one of `func', for functions and `macro' for macros, and
`advice' ARGLIST is passed on directly to the definition, and
DOCSTRING is prepended with a compatibility note. REST contains
the remaining definition, that may begin with a property list of
attributes (see `compat-generate-common')."
(let ((oldname name) (body rest))
(while (keywordp (car body))
(setq body (cddr body)))
;; It might be possible to set these properties otherwise. That
;; should be looked into and implemented if it is the case.
(when (and (listp (car-safe body)) (eq (caar body) 'declare))
(when (version<= emacs-version "25")
(delq (assq 'side-effect-free (car body)) (car body))
(delq (assq 'pure (car body)) (car body))))
;; Check if we want an explicitly prefixed function
(when (plist-get rest :prefix)
(setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
`(,(cond
((memq type '(func advice)) 'defun)
((eq type 'macro) 'defmacro)
((error "Unknown type")))
,realname ,arglist
;; Prepend compatibility notice to the actual
;; documentation string.
,(let ((type (cond
((eq type 'func) "function")
((eq type 'macro) "macro")
((eq type 'advice) "advice")
((error "Unknown type")))))
(if version
(format
"[Compatibility %s for `%S', defined in Emacs %s]\n\n%s"
type oldname version docstring)
(format
"[Compatibility %s for `%S']\n\n%s"
type oldname docstring)))
;; Advice may use the implicit variable `oldfun', but
;; to avoid triggering the byte compiler, we make
;; sure the argument is used at least once.
,@(if (eq type 'advice)
(cons '(ignore oldfun) body)
body)))
(lambda (realname _version)
(cond
((memq type '(func macro))
;; Functions and macros are installed by
;; aliasing the name of the compatible
;; function to the name of the compatibility
;; function.
`(defalias ',name #',realname))
((eq type 'advice)
`(advice-add ',name :around #',realname))))
(lambda ()
(cond
((memq type '(func macro))
`(not (fboundp ',name)))
((eq type 'advice) t)))
rest type)))
- :feature :: See `compat-guard'."
(declare (debug (name symbolp [&rest keywordp sexp])))
(compat-macs--guard attrs '(:obsolete booleanp)
(lambda (obsolete)
(compat-macs--strict (not (fboundp name)) "%s already defined" name)
;; The fboundp 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 (fboundp ',name)
(defalias ',name ',def
,(compat-macs--docstring 'function name
(get name 'function-documentation)))
,@(when obsolete
`((make-obsolete ',name ',def ,compat-macs--version))))))))
(defmacro compat-defun (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility function.
The function must be documented in DOCSTRING. REST may begin
with a plist, that is interpreted by the macro but not passed on
to the actual function. See `compat-generate-common' for a
listing of attributes.
"Define compatibility function NAME with arguments ARGLIST.
The function must be documented in DOCSTRING. REST is an
attribute plist followed by the function body. The attributes
specify the conditions under which the definition is generated.
The definition will only be installed, if the version this
function was defined in, as indicated by the `:version'
attribute, is greater than the current Emacs version."
- :extended :: Mark the function as extended if t. The function
must be called explicitly via `compat-call'. This attribute
should be used for functions which extend already existing
functions, e.g., functions which changed their calling
convention or their behavior. The value can also be a version
string, which specifies the Emacs version when the original
version of the function was introduced.
- :obsolete :: Mark the function as obsolete if t, can be a
string describing the obsoletion.
- :feature :: See `compat-guard'."
(declare (debug (&define name (&rest symbolp)
stringp
[&rest keywordp sexp]
def-body))
(doc-string 3) (indent 2))
(compat-common-fdefine 'func name arglist docstring rest))
(compat-macs--defun 'function name arglist docstring rest))
(defmacro compat-defmacro (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility macro.
The macro must be documented in DOCSTRING. REST may begin
with a plist, that is interpreted by this macro but not passed on
to the actual macro. See `compat-generate-common' for a
listing of attributes.
The definition will only be installed, if the version this
function was defined in, as indicated by the `:version'
attribute, is greater than the current Emacs version."
"Define compatibility macro NAME with arguments ARGLIST.
The macro must be documented in DOCSTRING. REST is an attribute
plist followed by the macro body. See `compat-defun' for
details."
(declare (debug compat-defun) (doc-string 3) (indent 2))
(compat-common-fdefine 'macro name arglist docstring rest))
(compat-macs--defun 'macro name arglist docstring rest))
(defmacro compat-advise (name arglist docstring &rest rest)
"Define NAME with arguments ARGLIST as a compatibility advice.
The advice function must be documented in DOCSTRING. REST may
begin with a plist, that is interpreted by this macro but not
passed on to the actual advice function. See
`compat-generate-common' for a listing of attributes. The advice
wraps the old definition, that is accessible via using the symbol
`oldfun'.
(defmacro compat-defvar (name initval docstring &rest attrs)
"Define compatibility variable NAME with initial value INITVAL.
The variable must be documented in DOCSTRING. ATTRS is a plist
of attributes, which specify the conditions under which the
definition is generated.
The advice will only be installed, if the version this function
was defined in, as indicated by the `:version' attribute, is
greater than the current Emacs version."
(declare (debug compat-defun) (doc-string 3) (indent 2))
(compat-common-fdefine 'advice name (cons 'oldfun arglist) docstring rest))
- :constant :: Mark the variable as constant if t.
(defmacro compat-defvar (name initval docstring &rest attr)
"Declare compatibility variable NAME with initial value INITVAL.
The obligatory documentation string DOCSTRING must be given.
- :local :: Make the variable buffer-local if t. If the value is
`permanent' make the variable additionally permanently local.
The remaining arguments ATTR form a plist, modifying the
behaviour of this macro. See `compat-generate-common' for a
listing of attributes. Furthermore, `compat-defvar' also handles
the attribute `:local' that either makes the variable permanent
local with a value of `permanent' or just buffer local with any
non-nil value."
- :obsolete :: Mark the variable as obsolete if t, can be a
string describing the obsoletion.
- :feature :: See `compat-guard'."
(declare (debug (name form stringp [&rest keywordp sexp]))
(doc-string 3) (indent 2))
;; Check if we want an explicitly prefixed function
(let ((oldname name))
(when (plist-get attr :prefix)
(setq name (intern (format "compat-%s" name))))
(compat-generate-common
name
(lambda (realname version)
(let ((localp (plist-get attr :local)))
`(progn
(,(if (plist-get attr :constant) 'defconst 'defvar)
,realname ,initval
;; Prepend compatibility notice to the actual
;; documentation string.
,(if version
(format
"[Compatibility variable for `%S', defined in Emacs %s]\n\n%s"
oldname version docstring)
(format
"[Compatibility variable for `%S']\n\n%s"
oldname docstring)))
;; Make variable as local if necessary
,(cond
((eq localp 'permanent)
`(put ',realname 'permanent-local t))
(localp
`(make-variable-buffer-local ',realname))))))
(lambda (realname _version)
`(defvaralias ',name ',realname))
(lambda ()
`(not (boundp ',name)))
attr 'variable)))
(compat-macs--guard
attrs (list :constant #'booleanp
:local (lambda (x) (memq x '(nil t permanent)))
:obsolete (lambda (x) (or (booleanp x) (stringp x))))
(lambda (constant local obsolete)
(compat-macs--strict (not (boundp name)) "%s already defined" name)
(compat-macs--assert (not (and constant local)) "Both :constant 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)
(,(if constant 'defconst 'defvar)
,name ,initval
,(compat-macs--docstring 'variable name docstring))
,@(when obsolete
`((make-obsolete-variable
',name ,(if (stringp obsolete) obsolete "No substitute")
,compat-macs--version))))
,@(and local `((make-variable-buffer-local ',name)))
,@(and (eq local 'permanent) `((put ',name 'permanent-local t)))))))
(defmacro compat-version (version)
"Set the Emacs version that is currently being handled to VERSION."
(setq compat-macs--version version)
nil)
(defmacro compat-require (feature version)
"Require FEATURE if the Emacs version is less than VERSION."
(when (version< emacs-version version)
(require feature)
`(require ',feature)))
(provide 'compat-macs)
;;; compat-macs.el ends here