branch: externals/compat
commit d6a4ed48bca8c99e9e9d9617eaa4ae4a0dceca46
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Move json functions to compat.el
These functions are defined conditionally. Therefore they must not be
part of the versioned files. Conditionally-defined functions are a
special complicated edge case, which need more testing. Therefore the
json functions are currently marked as UNTESTED.
---
compat-27.el | 195 +----------------------------------------------------
compat-28.el | 11 ++-
compat-macs.el | 24 +++----
compat-tests.el | 3 +-
compat.el | 203 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 222 insertions(+), 214 deletions(-)
diff --git a/compat-27.el b/compat-27.el
index 37af8fa08e..f692836551 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -110,199 +110,6 @@ Letter-case is significant, but text properties are
ignored."
(when fn (throw 'found fn))))))
((signal 'wrong-type-argument (list 'keymapp keymap)))))
-;;;; Defined in json.c
-
-(declare-function json-encode "json" (object))
-(declare-function json-read-from-string "json" (string))
-(declare-function json-read "json" ())
-(defvar json-encoding-pretty-print)
-(defvar json-object-type)
-(defvar json-array-type)
-(defvar json-false)
-(defvar json-null)
-
-;; The function is declared to satisfy the byte compiler while testing
-;; if native JSON parsing is available.;
-(declare-function json-serialize nil (object &rest args))
-(compat-defun json-serialize (object &rest args) ;; <UNTESTED>
- "Return the JSON representation of OBJECT as a string.
-
-OBJECT must be t, a number, string, vector, hashtable, alist, plist,
-or the Lisp equivalents to the JSON null and false values, and its
-elements must recursively consist of the same kinds of values. t will
-be converted to the JSON true value. Vectors will be converted to
-JSON arrays, whereas hashtables, alists and plists are converted to
-JSON objects. Hashtable keys must be strings without embedded null
-characters and must be unique within each object. Alist and plist
-keys must be symbols; if a key is duplicate, the first instance is
-used.
-
-The Lisp equivalents to the JSON null and false values are
-configurable in the arguments ARGS, a list of keyword/argument pairs:
-
-The keyword argument `:null-object' specifies which object to use
-to represent a JSON null value. It defaults to `:null'.
-
-The keyword argument `:false-object' specifies which object to use to
-represent a JSON false value. It defaults to `:false'.
-
-In you specify the same value for `:null-object' and `:false-object',
-a potentially ambiguous situation, the JSON output will not contain
-any JSON false values."
- :cond (not (condition-case nil
- (equal (json-serialize '()) "{}")
- (:success t)
- (void-function nil)
- (json-unavailable nil)))
- (unless (fboundp 'json-encode)
- (require 'json))
- (letrec ((fix (lambda (obj)
- (cond
- ((hash-table-p obj)
- (let ((ht (copy-hash-table obj)))
- (maphash
- (lambda (key val)
- (unless (stringp key)
- (signal
- 'wrong-type-argument
- (list 'stringp key)))
- (puthash key (funcall fix val) ht))
- obj)
- ht))
- ((and (listp obj) (consp (car obj))) ;alist
- (mapcar
- (lambda (ent)
- (cons (symbol-name (car ent))
- (funcall fix (cdr ent))))
- obj))
- ((listp obj) ;plist
- (let (alist)
- (while obj
- (push (cons (cond
- ((keywordp (car obj))
- (substring
- (symbol-name (car obj))
- 1))
- ((symbolp (car obj))
- (symbol-name (car obj)))
- ((signal
- 'wrong-type-argument
- (list 'symbolp (car obj)))))
- (funcall fix (cadr obj)))
- alist)
- (unless (consp (cdr obj))
- (signal 'wrong-type-argument '(consp nil)))
- (setq obj (cddr obj)))
- (nreverse alist)))
- ((vectorp obj)
- (let ((vec (make-vector (length obj) nil)))
- (dotimes (i (length obj))
- (aset vec i (funcall fix (aref obj i))))
- vec))
- (obj))))
- (json-encoding-pretty-print nil)
- (json-false (or (plist-get args :false-object) :false))
- (json-null (or (plist-get args :null-object) :null)))
- (json-encode (funcall fix object))))
-
-(compat-defun json-insert (object &rest args) ;; <UNTESTED>
- "Insert the JSON representation of OBJECT before point.
-This is the same as (insert (json-serialize OBJECT)), but potentially
-faster. See the function `json-serialize' for allowed values of
-OBJECT."
- :cond (not (condition-case nil
- (equal (json-serialize '()) "{}")
- (:success t)
- (void-function nil)
- (json-unavailable nil)))
- (insert (apply #'json-serialize object args)))
-
-(compat-defun json-parse-string (string &rest args) ;; <UNTESTED>
- "Parse the JSON STRING into a Lisp object.
-This is essentially the reverse operation of `json-serialize', which
-see. The returned object will be the JSON null value, the JSON false
-value, t, a number, a string, a vector, a list, a hashtable, an alist,
-or a plist. Its elements will be further objects of these types. If
-there are duplicate keys in an object, all but the last one are
-ignored. If STRING doesn't contain a valid JSON object, this function
-signals an error of type `json-parse-error'.
-
-The arguments ARGS are a list of keyword/argument pairs:
-
-The keyword argument `:object-type' specifies which Lisp type is used
-to represent objects; it can be `hash-table', `alist' or `plist'. It
-defaults to `hash-table'.
-
-The keyword argument `:array-type' specifies which Lisp type is used
-to represent arrays; it can be `array' (the default) or `list'.
-
-The keyword argument `:null-object' specifies which object to use
-to represent a JSON null value. It defaults to `:null'.
-
-The keyword argument `:false-object' specifies which object to use to
-represent a JSON false value. It defaults to `:false'."
- :cond (not (condition-case nil
- (equal (json-serialize '()) "{}")
- (:success t)
- (void-function nil)
- (json-unavailable nil)))
- (unless (fboundp 'json-read-from-string)
- (require 'json))
- (condition-case err
- (let ((json-object-type (or (plist-get args :object-type) 'hash-table))
- (json-array-type (or (plist-get args :array-type) 'vector))
- (json-false (or (plist-get args :false-object) :false))
- (json-null (or (plist-get args :null-object) :null)))
- (when (eq json-array-type 'array)
- (setq json-array-type 'vector))
- (json-read-from-string string))
- (json-error (signal 'json-parse-error err))))
-
-(compat-defun json-parse-buffer (&rest args) ;; <UNTESTED>
- "Read JSON object from current buffer starting at point.
-Move point after the end of the object if parsing was successful.
-On error, don't move point.
-
-The returned object will be a vector, list, hashtable, alist, or
-plist. Its elements will be the JSON null value, the JSON false
-value, t, numbers, strings, or further vectors, lists, hashtables,
-alists, or plists. If there are duplicate keys in an object, all
-but the last one are ignored.
-
-If the current buffer doesn't contain a valid JSON object, the
-function signals an error of type `json-parse-error'.
-
-The arguments ARGS are a list of keyword/argument pairs:
-
-The keyword argument `:object-type' specifies which Lisp type is used
-to represent objects; it can be `hash-table', `alist' or `plist'. It
-defaults to `hash-table'.
-
-The keyword argument `:array-type' specifies which Lisp type is used
-to represent arrays; it can be `array' (the default) or `list'.
-
-The keyword argument `:null-object' specifies which object to use
-to represent a JSON null value. It defaults to `:null'.
-
-The keyword argument `:false-object' specifies which object to use to
-represent a JSON false value. It defaults to `:false'."
- :cond (not (condition-case nil
- (equal (json-serialize '()) "{}")
- (:success t)
- (void-function nil)
- (json-unavailable nil)))
- (unless (fboundp 'json-read)
- (require 'json))
- (condition-case err
- (let ((json-object-type (or (plist-get args :object-type) 'hash-table))
- (json-array-type (or (plist-get args :array-type) 'vector))
- (json-false (or (plist-get args :false-object) :false))
- (json-null (or (plist-get args :null-object) :null)))
- (when (eq json-array-type 'array)
- (setq json-array-type 'vector))
- (json-read))
- (json-error (signal 'json-parse-buffer err))))
-
;;;; Defined in timefns.c
(compat-defun time-equal-p (t1 t2) ;; <OK>
@@ -527,7 +334,7 @@ This is an integer indicating the UTC offset in seconds,
i.e.,
the number of seconds east of Greenwich."
(nth 8 time))
-;; TODO define gv-setters
+;; TODO define gv-setters for decoded-time-*
;;;; Defined in files.el
diff --git a/compat-28.el b/compat-28.el
index a3e2e4a58e..7f0ca8602d 100644
--- a/compat-28.el
+++ b/compat-28.el
@@ -155,6 +155,7 @@ If COUNT is non-nil and a natural number, the function will
;;;; Defined in json.c
+;; TODO Check interaction with conditionally defined json functions
(compat-defun json-serialize (object &rest args) ;; <UNTESTED>
"Handle top-level JSON values."
:explicit t
@@ -163,19 +164,16 @@ If COUNT is non-nil and a natural number, the function
will
(apply #'json-serialize object args)
(substring (json-serialize (list object)) 1 -1)))
+;; TODO Check interaction with conditionally defined json functions
(compat-defun json-insert (object &rest args) ;; <UNTESTED>
"Handle top-level JSON values."
:explicit t
:min-version "27"
(if (or (listp object) (vectorp object))
(apply #'json-insert object args)
- ;; `compat-json-serialize' is not sharp-quoted as the byte
- ;; compiled doesn't always know that the function has been
- ;; defined, but it will only be used in this function if the
- ;; prefixed definition of `json-serialize' (see above) has also
- ;; been defined.
- (insert (apply 'compat-json-serialize object args))))
+ (insert (apply #'compat--json-serialize object args))))
+;; TODO Check interaction with conditionally defined json functions
(compat-defun json-parse-string (string &rest args) ;; <UNTESTED>
"Handle top-level JSON values."
:explicit t
@@ -187,6 +185,7 @@ If COUNT is non-nil and a natural number, the function will
;; is we can access the first element.
(elt (apply #'json-parse-string (concat "[" string "]") args) 0)))
+;; TODO Check interaction with conditionally defined json functions
(compat-defun json-parse-buffer (&rest args) ;; <UNTESTED>
"Handle top-level JSON values."
:explicit t
diff --git a/compat-macs.el b/compat-macs.el
index cf3239e529..62e1bce0f5 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -71,11 +71,12 @@ If this is not documented on yourself system, you can check
\
;; Min/max version bounds must be satisfied.
(or (not min-version) (version<= min-version emacs-version))
(or (not max-version) (version< emacs-version max-version))
- ;; If a condition is specified, it must be satisfied.
- (or (not cond) (eval cond t))
- ;; The current Emacs must be older than the current declared Compat
- ;; version, see `compat-declare-version'.
- (version< emacs-version compat--current-version))))
+ ;; If a condition is specified, no version check is performed.
+ (if cond
+ (eval cond t)
+ ;; The current Emacs must be older than the current declared Compat
+ ;; version, see `compat-declare-version'.
+ (version< emacs-version compat--current-version)))))
(defun compat--guarded-definition (attrs args fun)
"Guard compatibility definition generation.
@@ -128,7 +129,7 @@ REST are attributes and the function BODY."
;; feature, such that the byte compiler does not complain
;; about possibly missing functions at runtime. The warnings
;; are generated due to the unless fboundp check.
- `((declare-function ,name "ext:compat-declare")
+ `((declare-function ,name nil)
(unless (fboundp ',name) ,def))
(list def))))))
@@ -137,16 +138,15 @@ REST are attributes and the function BODY."
ATTRS is a plist of attributes, which specify the conditions
under which the definition is generated.
-- :min-version :: Only install the definition if the Emacs
- version is greater or equal than the given version.
+- :min-version :: Install the definition if the Emacs version is
+ greater or equal than the given version.
-- :max-version :: Only install the definition if the Emacs
- version is smaller than the given version.
+- :max-version :: Install the definition if the Emacs version is
+ smaller than the given version.
- :feature :: Wrap the definition with `with-eval-after-load'.
-- :cond :: Only install the definition if :cond evaluates to
- non-nil."
+- :cond :: Install the definition if :cond evaluates to non-nil."
(declare (debug (name symbolp [&rest keywordp sexp])))
(compat--guarded-definition attrs ()
(lambda ()
diff --git a/compat-tests.el b/compat-tests.el
index 79dcc85434..43b6bfce42 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1009,9 +1009,8 @@
;; in the following commit:
;; https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=c44190c
;;
- ;; Therefore, we must make sure, that the test
+ ;; TODO Therefore, we must make sure, that the test
;; doesn't fail because of this bug:
- ;; TODO
;; (should (= (string-distance "" "") 0))
)
(should-equal 0 (string-distance "a" "a"))
diff --git a/compat.el b/compat.el
index 269b947920..bb787f3cb4 100644
--- a/compat.el
+++ b/compat.el
@@ -45,6 +45,8 @@
(when (eval-when-compile (< emacs-major-version 29))
(require 'compat-29))
+;;;; Macros for explicit compatibility function calls
+
(defmacro compat-function (fun)
"Return compatibility function symbol for FUN.
@@ -60,5 +62,206 @@ See `compat-function' for the compatibility function
resolution."
(let ((compat (intern (format "compat--%s" fun))))
`(,(if (fboundp compat) compat fun) ,@args)))
+;;;; Conditionally defined functions
+
+;; TODO Maybe the functions should be moved to a separate file compat-cond.el,
+;; which will be always loaded? However this file maybe empty, so maybe the
best
+;; place for these functions is indeed here. Conditionally-defined functions
are
+;; a special complicated edge case, which need more testing. Therefore the json
+;; functions are currently marked as untested.
+
+(eval-when-compile (load "compat-macs.el" nil t t))
+
+;;;;; Defined in json.c as part of Emacs 27
+
+(declare-function json-serialize nil (object &rest args))
+(declare-function json-encode "json" (object))
+(declare-function json-read-from-string "json" (string))
+(declare-function json-read "json" ())
+(defvar json-encoding-pretty-print)
+(defvar json-object-type)
+(defvar json-array-type)
+(defvar json-false)
+(defvar json-null)
+
+(compat-defun json-serialize (object &rest args) ;; <UNTESTED>
+ "Return the JSON representation of OBJECT as a string.
+
+OBJECT must be t, a number, string, vector, hashtable, alist, plist,
+or the Lisp equivalents to the JSON null and false values, and its
+elements must recursively consist of the same kinds of values. t will
+be converted to the JSON true value. Vectors will be converted to
+JSON arrays, whereas hashtables, alists and plists are converted to
+JSON objects. Hashtable keys must be strings without embedded null
+characters and must be unique within each object. Alist and plist
+keys must be symbols; if a key is duplicate, the first instance is
+used.
+
+The Lisp equivalents to the JSON null and false values are
+configurable in the arguments ARGS, a list of keyword/argument pairs:
+
+The keyword argument `:null-object' specifies which object to use
+to represent a JSON null value. It defaults to `:null'.
+
+The keyword argument `:false-object' specifies which object to use to
+represent a JSON false value. It defaults to `:false'.
+
+In you specify the same value for `:null-object' and `:false-object',
+a potentially ambiguous situation, the JSON output will not contain
+any JSON false values."
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
+ (unless (fboundp 'json-encode)
+ (require 'json))
+ (letrec ((fix (lambda (obj)
+ (cond
+ ((hash-table-p obj)
+ (let ((ht (copy-hash-table obj)))
+ (maphash
+ (lambda (key val)
+ (unless (stringp key)
+ (signal
+ 'wrong-type-argument
+ (list 'stringp key)))
+ (puthash key (funcall fix val) ht))
+ obj)
+ ht))
+ ((and (listp obj) (consp (car obj))) ;alist
+ (mapcar
+ (lambda (ent)
+ (cons (symbol-name (car ent))
+ (funcall fix (cdr ent))))
+ obj))
+ ((listp obj) ;plist
+ (let (alist)
+ (while obj
+ (push (cons (cond
+ ((keywordp (car obj))
+ (substring
+ (symbol-name (car obj))
+ 1))
+ ((symbolp (car obj))
+ (symbol-name (car obj)))
+ ((signal
+ 'wrong-type-argument
+ (list 'symbolp (car obj)))))
+ (funcall fix (cadr obj)))
+ alist)
+ (unless (consp (cdr obj))
+ (signal 'wrong-type-argument '(consp nil)))
+ (setq obj (cddr obj)))
+ (nreverse alist)))
+ ((vectorp obj)
+ (let ((vec (make-vector (length obj) nil)))
+ (dotimes (i (length obj))
+ (aset vec i (funcall fix (aref obj i))))
+ vec))
+ (obj))))
+ (json-encoding-pretty-print nil)
+ (json-false (or (plist-get args :false-object) :false))
+ (json-null (or (plist-get args :null-object) :null)))
+ (json-encode (funcall fix object))))
+
+(compat-defun json-insert (object &rest args) ;; <UNTESTED>
+ "Insert the JSON representation of OBJECT before point.
+This is the same as (insert (json-serialize OBJECT)), but potentially
+faster. See the function `json-serialize' for allowed values of
+OBJECT."
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
+ (insert (apply #'json-serialize object args)))
+
+(compat-defun json-parse-string (string &rest args) ;; <UNTESTED>
+ "Parse the JSON STRING into a Lisp object.
+This is essentially the reverse operation of `json-serialize', which
+see. The returned object will be the JSON null value, the JSON false
+value, t, a number, a string, a vector, a list, a hashtable, an alist,
+or a plist. Its elements will be further objects of these types. If
+there are duplicate keys in an object, all but the last one are
+ignored. If STRING doesn't contain a valid JSON object, this function
+signals an error of type `json-parse-error'.
+
+The arguments ARGS are a list of keyword/argument pairs:
+
+The keyword argument `:object-type' specifies which Lisp type is used
+to represent objects; it can be `hash-table', `alist' or `plist'. It
+defaults to `hash-table'.
+
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' (the default) or `list'.
+
+The keyword argument `:null-object' specifies which object to use
+to represent a JSON null value. It defaults to `:null'.
+
+The keyword argument `:false-object' specifies which object to use to
+represent a JSON false value. It defaults to `:false'."
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
+ (unless (fboundp 'json-read-from-string)
+ (require 'json))
+ (condition-case err
+ (let ((json-object-type (or (plist-get args :object-type) 'hash-table))
+ (json-array-type (or (plist-get args :array-type) 'vector))
+ (json-false (or (plist-get args :false-object) :false))
+ (json-null (or (plist-get args :null-object) :null)))
+ (when (eq json-array-type 'array)
+ (setq json-array-type 'vector))
+ (json-read-from-string string))
+ (json-error (signal 'json-parse-error err))))
+
+(compat-defun json-parse-buffer (&rest args) ;; <UNTESTED>
+ "Read JSON object from current buffer starting at point.
+Move point after the end of the object if parsing was successful.
+On error, don't move point.
+
+The returned object will be a vector, list, hashtable, alist, or
+plist. Its elements will be the JSON null value, the JSON false
+value, t, numbers, strings, or further vectors, lists, hashtables,
+alists, or plists. If there are duplicate keys in an object, all
+but the last one are ignored.
+
+If the current buffer doesn't contain a valid JSON object, the
+function signals an error of type `json-parse-error'.
+
+The arguments ARGS are a list of keyword/argument pairs:
+
+The keyword argument `:object-type' specifies which Lisp type is used
+to represent objects; it can be `hash-table', `alist' or `plist'. It
+defaults to `hash-table'.
+
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' (the default) or `list'.
+
+The keyword argument `:null-object' specifies which object to use
+to represent a JSON null value. It defaults to `:null'.
+
+The keyword argument `:false-object' specifies which object to use to
+represent a JSON false value. It defaults to `:false'."
+ :cond (not (condition-case nil
+ (equal (json-serialize '()) "{}")
+ (:success t)
+ (void-function nil)
+ (json-unavailable nil)))
+ (unless (fboundp 'json-read)
+ (require 'json))
+ (condition-case err
+ (let ((json-object-type (or (plist-get args :object-type) 'hash-table))
+ (json-array-type (or (plist-get args :array-type) 'vector))
+ (json-false (or (plist-get args :false-object) :false))
+ (json-null (or (plist-get args :null-object) :null)))
+ (when (eq json-array-type 'array)
+ (setq json-array-type 'vector))
+ (json-read))
+ (json-error (signal 'json-parse-buffer err))))
+
(provide 'compat)
;;; compat.el ends here
