267 lines
11 KiB
EmacsLisp
267 lines
11 KiB
EmacsLisp
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*-
|
|
|
|
;; 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
|
|
;; 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:
|
|
|
|
;; 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:
|
|
|
|
;; 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-macs--version nil
|
|
"Version of the currently defined compatibility definitions.")
|
|
|
|
(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)))
|
|
|
|
(defun compat-macs--assert (cond &rest error)
|
|
"Assert COND, otherwise fail with ERROR."
|
|
(unless cond (apply #'error error)))
|
|
|
|
(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)))
|
|
|
|
(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)
|
|
|
|
(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)))))
|
|
|
|
(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))
|
|
(when (<= emacs-major-version 25)
|
|
(delq (assq 'side-effect-free (car body)) (car body))
|
|
(delq (assq 'pure (car body)) (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))))))))
|
|
|
|
(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.
|
|
|
|
- :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))))))
|
|
|
|
(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.
|
|
|
|
- :obsolete :: Mark the alias as obsolete if t.
|
|
|
|
- :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 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.
|
|
|
|
- :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-macs--defun 'function name arglist docstring rest))
|
|
|
|
(defmacro compat-defmacro (name arglist docstring &rest rest)
|
|
"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-macs--defun 'macro name arglist docstring rest))
|
|
|
|
(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.
|
|
|
|
- :constant :: Mark the variable as constant if t.
|
|
|
|
- :local :: Make the variable buffer-local if t. If the value is
|
|
`permanent' make the variable additionally permanently local.
|
|
|
|
- :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))
|
|
(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
|