compat-macs.el (10040B)
1 ;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*- 2 3 ;; Copyright (C) 2021-2023 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 ;; These macros are used to define compatibility functions and macros. 21 22 ;;; Code: 23 24 ;; We always require subr-x at compile since many functions have been moved 25 ;; around. 26 (require 'subr-x) 27 28 (defvar compat--version nil 29 "Version of the currently defined compatibility definitions.") 30 31 (defmacro compat-declare-version (version) 32 "Set the Emacs version that is currently being handled to VERSION." 33 (setq compat--version version) 34 (let ((before (1- (car (version-to-list version))))) 35 (when (and (< 24 before) (< emacs-major-version before)) 36 `(require ',(intern (format "compat-%d" before)))))) 37 38 (defun compat--format-docstring (type name docstring) 39 "Format DOCSTRING for NAME of TYPE. 40 Prepend compatibility notice to the actual documentation string." 41 (with-temp-buffer 42 (insert 43 (format 44 "[Compatibility %s for `%S', defined in Emacs %s. \ 45 If this is not documented on yourself system, you can check \ 46 `(compat) Emacs %s' for more details.]\n\n%s" 47 type name 48 compat--version compat--version 49 docstring)) 50 (let ((fill-column 80)) 51 (fill-region (point-min) (point-max))) 52 (buffer-string))) 53 54 (defun compat--check-attributes (attrs allowed) 55 "Check ATTRS for ALLOWED keys and return rest." 56 (while (keywordp (car attrs)) 57 (unless (memq (car attrs) allowed) 58 (error "Invalid attribute %s" (car attrs))) 59 (unless (cdr attrs) 60 (error "Odd number of element in attribute list")) 61 (setq attrs (cddr attrs))) 62 attrs) 63 64 (defun compat--condition-satisfied (attrs) 65 "Check that version constraints specified by ATTRS are satisfied." 66 (let ((min-version (plist-get attrs :min-version)) 67 (max-version (plist-get attrs :max-version)) 68 (cond (plist-get attrs :cond))) 69 ;; Min/max version bounds must be satisfied. 70 (and 71 ;; Min/max version bounds must be satisfied. 72 (or (not min-version) (version<= min-version emacs-version)) 73 (or (not max-version) (version< emacs-version max-version)) 74 ;; If a condition is specified, no version check is performed. 75 (if cond 76 (eval cond t) 77 ;; The current Emacs must be older than the current declared Compat 78 ;; version, see `compat-declare-version'. 79 (version< emacs-version compat--version))))) 80 81 (defun compat--guarded-definition (attrs args fun) 82 "Guard compatibility definition generation. 83 The version constraints specified by ATTRS are checked. 84 ARGS is a list of keywords which are looked up and passed to FUN." 85 (declare (indent 2)) 86 (let* ((body (compat--check-attributes 87 attrs `(,@args :min-version :max-version :cond :feature))) 88 (feature (plist-get attrs :feature)) 89 (attrs `(:body ,body ,@attrs))) 90 ;; Require feature at compile time 91 (when feature 92 (when (eq feature 'subr-x) 93 (error "Feature subr-x must not be specified")) 94 ;; If the feature does not exist, treat it as nil. The function will then 95 ;; be defined on the toplevel and not in a `with-eval-after-load' block. 96 (setq feature (require feature nil t))) 97 (when (compat--condition-satisfied attrs) 98 (setq body (apply fun (mapcar (lambda (x) (plist-get attrs x)) args))) 99 (when body 100 (if feature 101 `(with-eval-after-load ',feature ,@body) 102 (macroexp-progn body)))))) 103 104 (defun compat--function-definition (type name arglist docstring rest) 105 "Define function NAME of TYPE with ARGLIST and DOCSTRING. 106 REST are attributes and the function BODY." 107 (compat--guarded-definition rest '(:explicit :body) 108 (lambda (explicit body) 109 ;; Remove unsupported declares. It might be possible to set these 110 ;; properties otherwise. That should be looked into and implemented 111 ;; if it is the case. 112 (when (and (listp (car-safe body)) (eq (caar body) 'declare)) 113 (when (version<= emacs-version "25") 114 (delq (assq 'side-effect-free (car body)) (car body)) 115 (delq (assq 'pure (car body)) (car body)))) 116 ;; Use `:explicit' name if the function is already defined. 117 (let* ((defname (if (and explicit (fboundp name)) 118 (intern (format "compat--%s" name)) 119 name)) 120 (def `(,(if (eq type 'macro) 'defmacro 'defun) 121 ,defname ,arglist 122 ,(compat--format-docstring type name docstring) 123 ,@body))) 124 ;; An additional fboundp check is performed at runtime to make 125 ;; sure that we never redefine an existing definition if Compat 126 ;; is loaded on a newer Emacs version. 127 (if (eq defname name) 128 ;; Declare the function in a non-existing compat-declare 129 ;; feature, such that the byte compiler does not complain 130 ;; about possibly missing functions at runtime. The warnings 131 ;; are generated due to the unless fboundp check. 132 `((declare-function ,name nil) 133 (unless (fboundp ',name) ,def)) 134 (list def)))))) 135 136 (defmacro compat-defalias (name def &rest attrs) 137 "Define compatibility alias NAME as DEF. 138 ATTRS is a plist of attributes, which specify the conditions 139 under which the definition is generated. 140 141 - :obsolete :: Mark the alias as obsolete. 142 143 - :min-version :: Install the definition if the Emacs version is 144 greater or equal than the given version. 145 146 - :max-version :: Install the definition if the Emacs version is 147 smaller than the given version. 148 149 - :feature :: Wrap the definition with `with-eval-after-load'. 150 151 - :cond :: Install the definition if :cond evaluates to non-nil." 152 (declare (debug (name symbolp [&rest keywordp sexp]))) 153 (compat--guarded-definition attrs '(:obsolete) 154 (lambda (obsolete) 155 ;; The fboundp check is performed at runtime to make sure that we never 156 ;; redefine an existing definition if Compat is loaded on a newer Emacs 157 ;; version. 158 `((unless (fboundp ',name) 159 ,(let ((doc (compat--format-docstring 160 'function name 161 (get name 'function-documentation)))) 162 (if obsolete 163 `(define-obsolete-function-alias 164 ',name ',def ,compat--version ,doc) 165 `(defalias ',name ',def ,doc)))))))) 166 167 (defmacro compat-defun (name arglist docstring &rest rest) 168 "Define compatibility function NAME with arguments ARGLIST. 169 The function must be documented in DOCSTRING. REST is an 170 attribute plist followed by the function body. The attributes 171 specify the conditions under which the compatiblity function is 172 defined. 173 174 - :explicit :: Make the definition available such that it can be 175 called explicitly via `compat-call'. 176 177 - :min-version :: Install the definition if the Emacs version is 178 greater or equal than the given version. 179 180 - :max-version :: Install the definition if the Emacs version is 181 smaller than the given version. 182 183 - :feature :: Wrap the definition with `with-eval-after-load'. 184 185 - :cond :: Install the definition if :cond evaluates to non-nil." 186 (declare (debug (&define name (&rest symbolp) 187 stringp 188 [&rest keywordp sexp] 189 def-body)) 190 (doc-string 3) (indent 2)) 191 (compat--function-definition 'function name arglist docstring rest)) 192 193 (defmacro compat-defmacro (name arglist docstring &rest rest) 194 "Define compatibility macro NAME with arguments ARGLIST. 195 The macro must be documented in DOCSTRING. REST is an attribute 196 plist followed by the macro body. See `compat-defun' for 197 details." 198 (declare (debug compat-defun) (doc-string 3) (indent 2)) 199 (compat--function-definition 'macro name arglist docstring rest)) 200 201 (defmacro compat-defvar (name initval docstring &rest attrs) 202 "Define compatibility variable NAME with initial value INITVAL. 203 The variable must be documented in DOCSTRING. ATTRS is a plist 204 of attributes, which specify the conditions under which the 205 definition is generated. 206 207 - :constant :: Define a constant if non-nil. 208 209 - :local :: Make the variable permanently local if the value is 210 `permanent'. For other non-nil values make the variable 211 buffer-local. 212 213 - :min-version :: Install the definition if the Emacs version is 214 greater or equal than the given version. 215 216 - :max-version :: Install the definition if the Emacs version is 217 smaller than the given version. 218 219 - :feature :: Wrap the definition with `with-eval-after-load'. 220 221 - :cond :: Install the definition if :cond evaluates to non-nil." 222 (declare (debug (name form stringp [&rest keywordp sexp])) 223 (doc-string 3) (indent 2)) 224 (compat--guarded-definition attrs '(:local :constant) 225 (lambda (local constant) 226 ;; The boundp check is performed at runtime to make sure that we never 227 ;; redefine an existing definition if Compat is loaded on a newer Emacs 228 ;; version. 229 `((unless (boundp ',name) 230 (,(if constant 'defconst 'defvar) 231 ,name ,initval 232 ,(compat--format-docstring 'variable name docstring)) 233 ,@(cond 234 ((eq local 'permanent) 235 `((put ',name 'permanent-local t))) 236 (local 237 `((make-variable-buffer-local ',name))))))))) 238 239 (provide 'compat-macs) 240 ;;; compat-macs.el ends here