diff options
| -rw-r--r-- | NEWS.org | 1 | ||||
| -rw-r--r-- | compat-28.el | 53 | ||||
| -rw-r--r-- | compat-tests.el | 60 | ||||
| -rw-r--r-- | compat.el | 202 | ||||
| -rw-r--r-- | compat.texi | 101 |
5 files changed, 1 insertions, 416 deletions
@@ -4,6 +4,7 @@ - Add tests. - Add links from compatibility definitions to tests. +- Drop JSON parsing support (libjansson API). - compat-26: Add ~buffer-hash~. - compat-27: Add ~fixnump~ and ~bignump~. - compat-27: Add ~with-minibuffer-selected-window~. diff --git a/compat-28.el b/compat-28.el index 8219633..6aef33d 100644 --- a/compat-28.el +++ b/compat-28.el @@ -150,59 +150,6 @@ If COUNT is non-nil and a natural number, the function will (setf (nthcdr count files) nil)) files)) -;;;; 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 (RFC 8259)." - :explicit t - :cond (= 27 emacs-major-version) - (if (or (listp object) (vectorp object)) - (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 (RFC 8259)." - :explicit t - :cond (= 27 emacs-major-version) - (if (or (listp object) (vectorp object)) - (apply #'json-insert 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 (RFC 8259)." - :explicit t - :cond (= 27 emacs-major-version) - (if (string-match-p "\\`[[:space:]]*[[{]" string) - (apply #'json-parse-string string args) - ;; Wrap the string in an array, and extract the value back using - ;; `elt', to ensure that no matter what the value of `:array-type' - ;; 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 (RFC 8259)." - :explicit t - :cond (= 27 emacs-major-version) - (if (looking-at-p "[[:space:]]*[[{]") - (apply #'json-parse-buffer args) - (catch 'escape - (atomic-change-group - (with-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\" "\"" st) - (modify-syntax-entry ?. "_" st) - st) - (let ((inhibit-read-only t)) - (save-excursion - (insert "[") - (forward-sexp 1) - (insert "]")))) - (throw 'escape (elt (apply #'json-parse-buffer args) 0)))))) - ;;;; xfaces.c (compat-defun color-values-from-color-spec (spec) ;; <compat-tests:color-values-from-color-spec> diff --git a/compat-tests.el b/compat-tests.el index e71f2e4..a6f1938 100644 --- a/compat-tests.el +++ b/compat-tests.el @@ -1960,66 +1960,6 @@ (should-equal (compat-call alist-get "one" alist-2 nil nil #'string=) "eins"))) -(ert-deftest json-serialize () - (let ((input-1 '((:key . ["abc" 2]) (yek . t))) - (input-2 '(:key ["abc" 2] yek t)) - ;; TODO fix broken test - ;;(input-3 (let ((ht (make-hash-table))) - ;; (puthash "key" ["abc" 2] ht) - ;; (puthash "yek" t ht) - ;; ht)) - ) - (should-equal (json-serialize input-1) - "{\":key\":[\"abc\",2],\"yek\":true}") - (should-equal (json-serialize input-2) - "{\"key\":[\"abc\",2],\"yek\":true}") - (should (member (json-serialize input-2) - '("{\"key\":[\"abc\",2],\"yek\":true}" - "{\"yek\":true,\"key\":[\"abc\",2]}"))) - ;; TODO fix broken test - ;; (should-equal (json-serialize input-3) - ;; "{\"key\":[\"abc\",2],\"yek\":true}")) - (should-error (json-serialize '(("a" . 1))) - :type '(wrong-type-argument symbolp "a")) - (should-error (json-serialize '("a" 1)) - :type '(wrong-type-argument symbolp "a")) - (should-error (json-serialize '("a" 1 2)) - :type '(wrong-type-argument symbolp "a")) - (should-error (json-serialize '(:a 1 2)) - :type '(wrong-type-argument consp nil)) - (should-error (json-serialize - (let ((ht (make-hash-table))) - (puthash 'a 1 ht) - ht)) - :type '(wrong-type-argument stringp a)))) - -(ert-deftest json-parse-string () - ;; TODO fix broken tests! - ;; (should-equal 0 (json-parse-string "0")) - ;; (should-equal 1 (json-parse-string "1")) - ;; (should-equal 0.5 (json-parse-string "0.5")) - ;; (should-equal 'foo (json-parse-string "null" :null-object 'foo)) - (should-equal [1 2 3] (json-parse-string "[1,2,3]")) - (should-equal ["a" 2 3] (json-parse-string "[\"a\",2,3]")) - (should-equal [["a" 2] 3] (json-parse-string "[[\"a\",2],3]")) - (should-equal '(("a" 2) 3) (json-parse-string "[[\"a\",2],3]" :array-type 'list)) - (should-equal ["false" t] (json-parse-string "[false, true]" :false-object "false")) - (let ((input "{\"key\":[\"abc\", 2], \"yek\": null}")) - (let ((obj (json-parse-string input :object-type 'alist))) - (should-equal (cdr (assq 'key obj)) ["abc" 2]) - (should-equal (cdr (assq 'yek obj)) :null)) - (let ((obj (json-parse-string input :object-type 'plist))) - (should-equal (plist-get obj :key) ["abc" 2]) - (should-equal (plist-get obj :yek) :null)) - (let ((obj (json-parse-string input))) - (should-equal (gethash "key" obj) ["abc" 2]) - (should-equal (gethash "yek" obj) :null)))) - -(ert-deftest json-insert () - (with-temp-buffer - (json-insert '((:key . ["abc" 2]) (yek . t))) - (should-equal (buffer-string) "{\":key\":[\"abc\",2],\"yek\":true}"))) - (ert-deftest make-prop-match () (should (prop-match-p (make-prop-match))) (should (prop-match-p (make-prop-match :end 1))) @@ -67,207 +67,5 @@ See `compat-function' for the compatibility function resolution." (let ((compat (intern (format "compat--%s" fun)))) `(,(if (fboundp compat) compat fun) ,@args))) -;;;; Emacs 27 (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)) -(compat-declare-version "27.1") - -;;;;; Defined in json.c - -(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 diff --git a/compat.texi b/compat.texi index 2013853..a92b9f0 100644 --- a/compat.texi +++ b/compat.texi @@ -935,79 +935,6 @@ accurate results with raw bytes. @xref{Text Comparison,,,elisp}. @end defun -@c copied from lispref/text.texi -@defun json-serialize object &rest args -This function returns a new Lisp string which contains the JSON -representation of @var{object}. The argument @var{args} is a list of -keyword/argument pairs. The following keywords are accepted: - -@table @code -@item :null-object -The value decides which Lisp object to use to represent the JSON keyword -@code{null}. It defaults to the symbol @code{:null}. - -@item :false-object -The value decides which Lisp object to use to represent the JSON keyword -@code{false}. It defaults to the symbol @code{:false}. -@end table - -@xref{Parsing JSON,,,elisp}. -@end defun - -@c copied from lispref/text.texi -@defun json-insert object &rest args -This function inserts the JSON representation of @var{object} into the -current buffer before point. The argument @var{args} are interpreted as -in @code{json-parse-string}. - -@xref{Parsing JSON,,,elisp}. -@end defun - -@c copied from lispref/text.texi -@defun json-parse-string string &rest args -This function parses the JSON value in @var{string}, which must be a -Lisp string. If @var{string} doesn't contain a valid JSON object, this -function signals the @code{json-parse-error} error. - -The argument @var{args} is a list of keyword/argument pairs. The -following keywords are accepted: - -@table @code -@item :object-type -The value decides which Lisp object to use for representing the -key-value mappings of a JSON object. It can be either -@code{hash-table}, the default, to make hashtables with strings as keys; -@code{alist} to use alists with symbols as keys; or @code{plist} to use -plists with keyword symbols as keys. - -@item :array-type -The value decides which Lisp object to use for representing a JSON -array. It can be either @code{array}, the default, to use Lisp arrays; -or @code{list} to use lists. - -@item :null-object -The value decides which Lisp object to use to represent the JSON keyword -@code{null}. It defaults to the symbol @code{:null}. - -@item :false-object -The value decides which Lisp object to use to represent the JSON keyword -@code{false}. It defaults to the symbol @code{:false}. -@end table - -@xref{Parsing JSON,,,elisp}. -@end defun - -@c copied from lispref/text.texi -@defun json-parse-buffer &rest args -This function reads the next JSON value from the current buffer, -starting at point. It moves point to the position immediately after the -value if contains a valid JSON object; otherwise it signals the -@code{json-parse-error} error and doesn't move point. The arguments -@var{args} are interpreted as in @code{json-parse-string}. - -@xref{Parsing JSON,,,elisp}. -@end defun - @c copied from lispref/control.texi @defmac ignore-errors body@dots{} This construct executes @var{body}, ignoring any errors that occur @@ -1974,34 +1901,6 @@ This compatibility version handles the optional arguments @var{from} and @var{to}. @end defun -@defun compat-call@ json-serialize -@xref{Emacs 27.1}. - -This compatibility version handles primitive, top-level JSON values -(numbers, strings, booleans). -@end defun - -@defun compat-call@ json-insert -@xref{Emacs 27.1}. - -This compatibility version handles primitive, top-level JSON values -(numbers, strings, booleans). -@end defun - -@defun compat-call@ json-parse-string -@xref{Emacs 27.1}. - -This compatibility version handles primitive, top-level JSON values -(numbers, strings, booleans). -@end defun - -@defun compat-call@ json-parse-buffer -@xref{Emacs 27.1}. - -This compatibility version handles primitive, top-level JSON values -(numbers, strings, booleans). -@end defun - @c copied from on lisp/window.el @defun compat-call@ count-windows Return the number of live windows on the selected frame. |