compat.el (11930B)
1 ;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2021-2023 Free Software Foundation, Inc. 4 5 ;; Author: Philip Kaludercic <philipk@posteo.net>, Daniel Mendler <mail@daniel-mendler.de> 6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>, Compat Development <~pkal/compat-devel@lists.sr.ht> 7 ;; Version: 29.1.1.1 8 ;; URL: https://github.com/emacs-compat/compat 9 ;; Package-Requires: ((emacs "24.4")) 10 ;; Keywords: lisp 11 12 ;; This program is free software; you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; This program is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;; To allow for the usage of Emacs functions and macros that are 28 ;; defined in newer versions of Emacs, compat.el provides definitions 29 ;; that are installed ONLY if necessary. If Compat is installed on a 30 ;; recent version of Emacs, all of the definitions are disabled at 31 ;; compile time, such that no negative performance impact is incurred. 32 ;; These reimplementations of functions and macros are at least 33 ;; subsets of the actual implementations. Be sure to read the 34 ;; documentation string to make sure. 35 ;; 36 ;; Not every function provided in newer versions of Emacs is provided 37 ;; here. Some depend on new features from the core, others cannot be 38 ;; implemented to a meaningful degree. Please consult the Compat 39 ;; manual for details. The main audience for this library are not 40 ;; regular users, but package maintainers. Therefore commands and 41 ;; user options are usually not implemented here. 42 43 ;;; Code: 44 45 (when (eval-when-compile (< emacs-major-version 29)) 46 (require 'compat-29)) 47 48 ;;;; Macros for explicit compatibility function calls 49 50 (defmacro compat-function (fun) 51 "Return compatibility function symbol for FUN. 52 53 If the Emacs version provides a sufficiently recent version of 54 FUN, the symbol FUN is returned itself. Otherwise the macro 55 returns the symbol of a compatibility function which supports the 56 behavior and calling convention of the current stable Emacs 57 version. For example Compat 29.1 will provide compatibility 58 functions which implement the behavior and calling convention of 59 Emacs 29.1." 60 (let ((compat (intern (format "compat--%s" fun)))) 61 `#',(if (fboundp compat) compat fun))) 62 63 (defmacro compat-call (fun &rest args) 64 "Call compatibility function or macro FUN with ARGS. 65 66 See `compat-function' for the compatibility function resolution." 67 (let ((compat (intern (format "compat--%s" fun)))) 68 `(,(if (fboundp compat) compat fun) ,@args))) 69 70 ;;;; Emacs 27 (Conditionally defined functions) 71 72 ;; TODO Maybe the functions should be moved to a separate file compat-cond.el, 73 ;; which will be always loaded? However this file maybe empty, so maybe the best 74 ;; place for these functions is indeed here. Conditionally-defined functions are 75 ;; a special complicated edge case, which need more testing. Therefore the json 76 ;; functions are currently marked as untested. 77 78 (eval-when-compile (load "compat-macs.el" nil t t)) 79 (compat-declare-version "27.1") 80 81 ;;;;; Defined in json.c 82 83 (declare-function json-serialize nil (object &rest args)) 84 (declare-function json-encode "json" (object)) 85 (declare-function json-read-from-string "json" (string)) 86 (declare-function json-read "json" ()) 87 (defvar json-encoding-pretty-print) 88 (defvar json-object-type) 89 (defvar json-array-type) 90 (defvar json-false) 91 (defvar json-null) 92 93 (compat-defun json-serialize (object &rest args) ;; <UNTESTED> 94 "Return the JSON representation of OBJECT as a string. 95 96 OBJECT must be t, a number, string, vector, hashtable, alist, plist, 97 or the Lisp equivalents to the JSON null and false values, and its 98 elements must recursively consist of the same kinds of values. t will 99 be converted to the JSON true value. Vectors will be converted to 100 JSON arrays, whereas hashtables, alists and plists are converted to 101 JSON objects. Hashtable keys must be strings without embedded null 102 characters and must be unique within each object. Alist and plist 103 keys must be symbols; if a key is duplicate, the first instance is 104 used. 105 106 The Lisp equivalents to the JSON null and false values are 107 configurable in the arguments ARGS, a list of keyword/argument pairs: 108 109 The keyword argument `:null-object' specifies which object to use 110 to represent a JSON null value. It defaults to `:null'. 111 112 The keyword argument `:false-object' specifies which object to use to 113 represent a JSON false value. It defaults to `:false'. 114 115 In you specify the same value for `:null-object' and `:false-object', 116 a potentially ambiguous situation, the JSON output will not contain 117 any JSON false values." 118 :cond (not (condition-case nil 119 (equal (json-serialize '()) "{}") 120 (:success t) 121 (void-function nil) 122 (json-unavailable nil))) 123 (unless (fboundp 'json-encode) 124 (require 'json)) 125 (letrec ((fix (lambda (obj) 126 (cond 127 ((hash-table-p obj) 128 (let ((ht (copy-hash-table obj))) 129 (maphash 130 (lambda (key val) 131 (unless (stringp key) 132 (signal 133 'wrong-type-argument 134 (list 'stringp key))) 135 (puthash key (funcall fix val) ht)) 136 obj) 137 ht)) 138 ((and (listp obj) (consp (car obj))) ;alist 139 (mapcar 140 (lambda (ent) 141 (cons (symbol-name (car ent)) 142 (funcall fix (cdr ent)))) 143 obj)) 144 ((listp obj) ;plist 145 (let (alist) 146 (while obj 147 (push (cons (cond 148 ((keywordp (car obj)) 149 (substring 150 (symbol-name (car obj)) 151 1)) 152 ((symbolp (car obj)) 153 (symbol-name (car obj))) 154 ((signal 155 'wrong-type-argument 156 (list 'symbolp (car obj))))) 157 (funcall fix (cadr obj))) 158 alist) 159 (unless (consp (cdr obj)) 160 (signal 'wrong-type-argument '(consp nil))) 161 (setq obj (cddr obj))) 162 (nreverse alist))) 163 ((vectorp obj) 164 (let ((vec (make-vector (length obj) nil))) 165 (dotimes (i (length obj)) 166 (aset vec i (funcall fix (aref obj i)))) 167 vec)) 168 (obj)))) 169 (json-encoding-pretty-print nil) 170 (json-false (or (plist-get args :false-object) :false)) 171 (json-null (or (plist-get args :null-object) :null))) 172 (json-encode (funcall fix object)))) 173 174 (compat-defun json-insert (object &rest args) ;; <UNTESTED> 175 "Insert the JSON representation of OBJECT before point. 176 This is the same as (insert (json-serialize OBJECT)), but potentially 177 faster. See the function `json-serialize' for allowed values of 178 OBJECT." 179 :cond (not (condition-case nil 180 (equal (json-serialize '()) "{}") 181 (:success t) 182 (void-function nil) 183 (json-unavailable nil))) 184 (insert (apply #'json-serialize object args))) 185 186 (compat-defun json-parse-string (string &rest args) ;; <UNTESTED> 187 "Parse the JSON STRING into a Lisp object. 188 This is essentially the reverse operation of `json-serialize', which 189 see. The returned object will be the JSON null value, the JSON false 190 value, t, a number, a string, a vector, a list, a hashtable, an alist, 191 or a plist. Its elements will be further objects of these types. If 192 there are duplicate keys in an object, all but the last one are 193 ignored. If STRING doesn't contain a valid JSON object, this function 194 signals an error of type `json-parse-error'. 195 196 The arguments ARGS are a list of keyword/argument pairs: 197 198 The keyword argument `:object-type' specifies which Lisp type is used 199 to represent objects; it can be `hash-table', `alist' or `plist'. It 200 defaults to `hash-table'. 201 202 The keyword argument `:array-type' specifies which Lisp type is used 203 to represent arrays; it can be `array' (the default) or `list'. 204 205 The keyword argument `:null-object' specifies which object to use 206 to represent a JSON null value. It defaults to `:null'. 207 208 The keyword argument `:false-object' specifies which object to use to 209 represent a JSON false value. It defaults to `:false'." 210 :cond (not (condition-case nil 211 (equal (json-serialize '()) "{}") 212 (:success t) 213 (void-function nil) 214 (json-unavailable nil))) 215 (unless (fboundp 'json-read-from-string) 216 (require 'json)) 217 (condition-case err 218 (let ((json-object-type (or (plist-get args :object-type) 'hash-table)) 219 (json-array-type (or (plist-get args :array-type) 'vector)) 220 (json-false (or (plist-get args :false-object) :false)) 221 (json-null (or (plist-get args :null-object) :null))) 222 (when (eq json-array-type 'array) 223 (setq json-array-type 'vector)) 224 (json-read-from-string string)) 225 (json-error (signal 'json-parse-error err)))) 226 227 (compat-defun json-parse-buffer (&rest args) ;; <UNTESTED> 228 "Read JSON object from current buffer starting at point. 229 Move point after the end of the object if parsing was successful. 230 On error, don't move point. 231 232 The returned object will be a vector, list, hashtable, alist, or 233 plist. Its elements will be the JSON null value, the JSON false 234 value, t, numbers, strings, or further vectors, lists, hashtables, 235 alists, or plists. If there are duplicate keys in an object, all 236 but the last one are ignored. 237 238 If the current buffer doesn't contain a valid JSON object, the 239 function signals an error of type `json-parse-error'. 240 241 The arguments ARGS are a list of keyword/argument pairs: 242 243 The keyword argument `:object-type' specifies which Lisp type is used 244 to represent objects; it can be `hash-table', `alist' or `plist'. It 245 defaults to `hash-table'. 246 247 The keyword argument `:array-type' specifies which Lisp type is used 248 to represent arrays; it can be `array' (the default) or `list'. 249 250 The keyword argument `:null-object' specifies which object to use 251 to represent a JSON null value. It defaults to `:null'. 252 253 The keyword argument `:false-object' specifies which object to use to 254 represent a JSON false value. It defaults to `:false'." 255 :cond (not (condition-case nil 256 (equal (json-serialize '()) "{}") 257 (:success t) 258 (void-function nil) 259 (json-unavailable nil))) 260 (unless (fboundp 'json-read) 261 (require 'json)) 262 (condition-case err 263 (let ((json-object-type (or (plist-get args :object-type) 'hash-table)) 264 (json-array-type (or (plist-get args :array-type) 'vector)) 265 (json-false (or (plist-get args :false-object) :false)) 266 (json-null (or (plist-get args :null-object) :null))) 267 (when (eq json-array-type 'array) 268 (setq json-array-type 'vector)) 269 (json-read)) 270 (json-error (signal 'json-parse-buffer err)))) 271 272 (provide 'compat) 273 ;;; compat.el ends here