compat-macs.el (11779B)
1 ;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*- 2 3 ;; Copyright (C) 2021-2024 Free Software Foundation, Inc. 4 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 18 ;;; Commentary: 19 20 ;; WARNING: This file provides *internal* macros. The macros are used 21 ;; by Compat to facilitate the definition of compatibility functions, 22 ;; compatibility macros and compatibility variables. The 23 ;; `compat-macs' feature should never be loaded at runtime in your 24 ;; Emacs and will only be used during byte compilation. Every 25 ;; definition provided here is internal, may change any time between 26 ;; Compat releases and must not be used by other packages. 27 28 ;;; Code: 29 30 ;; We always require subr-x at compile time for the fboundp check 31 ;; since definitions have been moved around. The cl-lib macros are 32 ;; needed by compatibility definitions. 33 (require 'subr-x) 34 (require 'cl-lib) 35 36 (defvar compat-macs--version nil 37 "Version of the currently defined compatibility definitions.") 38 39 (defun compat-macs--strict (cond &rest error) 40 "Assert strict COND, otherwise fail with ERROR." 41 (when (bound-and-true-p compat-strict) 42 (apply #'compat-macs--assert cond error))) 43 44 (defun compat-macs--assert (cond &rest error) 45 "Assert COND, otherwise fail with ERROR." 46 (unless cond (apply #'error error))) 47 48 (defun compat-macs--docstring (type name docstring) 49 "Format DOCSTRING for NAME of TYPE. 50 Prepend compatibility notice to the actual documentation string." 51 (with-temp-buffer 52 (insert 53 (format 54 "[Compatibility %s for `%s', defined in Emacs %s. \ 55 See (compat) Emacs %s' for more details.]\n\n%s" 56 type name compat-macs--version compat-macs--version docstring)) 57 (let ((fill-column 80)) 58 (fill-region (point-min) (point-max))) 59 (buffer-string))) 60 61 (defun compat-macs--check-attributes (attrs preds) 62 "Check ATTRS given PREDS predicate plist and return rest." 63 (while (keywordp (car attrs)) 64 (compat-macs--assert (cdr attrs) "Attribute list length is odd") 65 (compat-macs--assert (let ((p (plist-get preds (car attrs)))) 66 (and p (or (eq p t) (funcall p (cadr attrs))))) 67 "Invalid attribute %s" (car attrs)) 68 (setq attrs (cddr attrs))) 69 attrs) 70 71 (defun compat-macs--guard (attrs preds fun) 72 "Guard compatibility definition generation. 73 The version constraints specified by ATTRS are checked. PREDS is 74 a plist of predicates for arguments which are passed to FUN." 75 (declare (indent 2)) 76 (compat-macs--assert compat-macs--version "No `compat-version' was declared") 77 (let* ((body (compat-macs--check-attributes 78 attrs `(,@preds :feature symbolp))) 79 (feature (plist-get attrs :feature)) 80 (attrs `(:body ,body ,@attrs)) 81 args) 82 ;; Require feature at compile time 83 (when feature 84 (compat-macs--assert (not (eq feature 'subr-x)) "Invalid feature subr-x") 85 (require feature)) 86 ;; The current Emacs must be older than the currently declared version. 87 (when (version< emacs-version compat-macs--version) 88 (while preds 89 (push (plist-get attrs (car preds)) args) 90 (setq preds (cddr preds))) 91 (setq body (apply fun (nreverse args))) 92 (if (and feature body) 93 `(with-eval-after-load ',feature ,@body) 94 (macroexp-progn body))))) 95 96 (defun compat-macs--defun (type name arglist docstring rest) 97 "Define function NAME of TYPE with ARGLIST and DOCSTRING. 98 REST are attributes and the function BODY." 99 (compat-macs--guard 100 rest (list :extended (lambda (x) (or (booleanp x) (version-to-list x))) 101 :obsolete (lambda (x) (or (booleanp x) (stringp x))) 102 :body t) 103 (lambda (extended obsolete body) 104 (when (stringp extended) 105 (compat-macs--assert 106 (and (version< extended compat-macs--version) (version< "24.4" extended)) 107 "Invalid :extended version %s for %s %s" extended type name) 108 (setq extended (version<= extended emacs-version))) 109 (compat-macs--strict (eq extended (fboundp name)) 110 "Wrong :extended flag for %s %s" type name) 111 ;; Remove unsupported declares. It might be possible to set these 112 ;; properties otherwise. That should be looked into and implemented 113 ;; if it is the case. 114 (when (and (listp (car-safe body)) (eq (caar body) 'declare) (<= emacs-major-version 25)) 115 (setcar body (assq-delete-all 'pure (assq-delete-all 116 'side-effect-free (car body))))) 117 ;; Use `:extended' name if the function is already defined. 118 (let* ((defname (if (and extended (fboundp name)) 119 (intern (format "compat--%s" name)) 120 name)) 121 (def `(,(if (memq '&key arglist) 122 (if (eq type 'macro) 'cl-defmacro 'cl-defun) 123 (if (eq type 'macro) 'defmacro 'defun)) 124 ,defname ,arglist 125 ,(compat-macs--docstring type name docstring) 126 ,@body))) 127 `(,@(if (eq defname name) 128 ;; An additional fboundp check is performed at runtime to make 129 ;; sure that we never redefine an existing definition if Compat 130 ;; is loaded on a newer Emacs version. Declare the function, 131 ;; such that the byte compiler does not complain about possibly 132 ;; missing functions at runtime. The warnings are generated due 133 ;; to the fboundp check. 134 `((declare-function ,name nil) 135 (unless (fboundp ',name) ,def)) 136 (list def)) 137 ,@(when obsolete 138 `((make-obsolete 139 ',defname ,(if (stringp obsolete) obsolete "No substitute") 140 ,compat-macs--version)))))))) 141 142 (defmacro compat-guard (cond &rest rest) 143 "Guard definition with a runtime COND and a version check. 144 The runtime condition must make sure that no definition is 145 overridden. REST is an attribute plist followed by the definition 146 body. The attributes specify the conditions under which the 147 definition is generated. 148 149 - :feature :: Wrap the definition with `with-eval-after-load' for 150 the given feature." 151 (declare (debug ([&rest keywordp sexp] def-body)) 152 (indent 1)) 153 (compat-macs--guard rest '(:body t) 154 (lambda (body) 155 (compat-macs--assert body "The guarded body is empty") 156 (if (eq cond t) 157 body 158 (compat-macs--strict (eval cond t) "Guard %S failed" cond) 159 `((when ,cond ,@body)))))) 160 161 (defmacro compat-defalias (name def &rest attrs) 162 "Define compatibility alias NAME as DEF. 163 ATTRS is a plist of attributes, which specify the conditions 164 under which the definition is generated. 165 166 - :obsolete :: Mark the alias as obsolete if t. 167 168 - :feature :: See `compat-guard'." 169 (declare (debug (name symbolp [&rest keywordp sexp]))) 170 (compat-macs--guard attrs '(:obsolete booleanp) 171 (lambda (obsolete) 172 (compat-macs--strict (not (fboundp name)) "%s already defined" name) 173 ;; The fboundp check is performed at runtime to make sure that we never 174 ;; redefine an existing definition if Compat is loaded on a newer Emacs 175 ;; version. 176 `((unless (fboundp ',name) 177 (defalias ',name ',def 178 ,(compat-macs--docstring 'function name 179 (get name 'function-documentation))) 180 ,@(when obsolete 181 `((make-obsolete ',name ',def ,compat-macs--version)))))))) 182 183 (defmacro compat-defun (name arglist docstring &rest rest) 184 "Define compatibility function NAME with arguments ARGLIST. 185 The function must be documented in DOCSTRING. REST is an 186 attribute plist followed by the function body. The attributes 187 specify the conditions under which the definition is generated. 188 189 - :extended :: Mark the function as extended if t. The function 190 must be called explicitly via `compat-call'. This attribute 191 should be used for functions which extend already existing 192 functions, e.g., functions which changed their calling 193 convention or their behavior. The value can also be a version 194 string, which specifies the Emacs version when the original 195 version of the function was introduced. 196 197 - :obsolete :: Mark the function as obsolete if t, can be a 198 string describing the obsoletion. 199 200 - :feature :: See `compat-guard'." 201 (declare (debug (&define name (&rest symbolp) 202 stringp 203 [&rest keywordp sexp] 204 def-body)) 205 (doc-string 3) (indent 2)) 206 (compat-macs--defun 'function name arglist docstring rest)) 207 208 (defmacro compat-defmacro (name arglist docstring &rest rest) 209 "Define compatibility macro NAME with arguments ARGLIST. 210 The macro must be documented in DOCSTRING. REST is an attribute 211 plist followed by the macro body. See `compat-defun' for 212 details." 213 (declare (debug compat-defun) (doc-string 3) (indent 2)) 214 (compat-macs--defun 'macro name arglist docstring rest)) 215 216 (defmacro compat-defvar (name initval docstring &rest attrs) 217 "Define compatibility variable NAME with initial value INITVAL. 218 The variable must be documented in DOCSTRING. ATTRS is a plist 219 of attributes, which specify the conditions under which the 220 definition is generated. 221 222 - :constant :: Mark the variable as constant if t. 223 224 - :local :: Make the variable buffer-local if t. If the value is 225 `permanent' make the variable additionally permanently local. 226 227 - :obsolete :: Mark the variable as obsolete if t, can be a 228 string describing the obsoletion. 229 230 - :feature :: See `compat-guard'." 231 (declare (debug (name form stringp [&rest keywordp sexp])) 232 (doc-string 3) (indent 2)) 233 (compat-macs--guard 234 attrs (list :constant #'booleanp 235 :local (lambda (x) (memq x '(nil t permanent))) 236 :obsolete (lambda (x) (or (booleanp x) (stringp x)))) 237 (lambda (constant local obsolete) 238 (compat-macs--strict (not (boundp name)) "%s already defined" name) 239 (compat-macs--assert (not (and constant local)) "Both :constant and :local") 240 ;; The boundp check is performed at runtime to make sure that we never 241 ;; redefine an existing definition if Compat is loaded on a newer Emacs 242 ;; version. 243 `((defvar ,name) 244 (unless (boundp ',name) 245 (,(if constant 'defconst 'defvar) 246 ,name ,initval 247 ,(compat-macs--docstring 'variable name docstring)) 248 ,@(when obsolete 249 `((make-obsolete-variable 250 ',name ,(if (stringp obsolete) obsolete "No substitute") 251 ,compat-macs--version)))) 252 ,@(and local `((make-variable-buffer-local ',name))) 253 ,@(and (eq local 'permanent) `((put ',name 'permanent-local t))))))) 254 255 (defmacro compat-version (version) 256 "Set the Emacs version that is currently being handled to VERSION." 257 (setq compat-macs--version version) 258 nil) 259 260 (defmacro compat-require (feature version) 261 "Require FEATURE if the Emacs version is less than VERSION." 262 (when (version< emacs-version version) 263 (require feature) 264 `(require ',feature))) 265 266 (provide 'compat-macs) 267 ;;; compat-macs.el ends here