Commit ab203e36 authored by Philipp Stephani's avatar Philipp Stephani

Implement native JSON support using Jansson

* configure.ac: New option --with-json.

* src/json.c (Fjson_serialize, Fjson_insert, Fjson_parse_string)
(Fjson_parse_buffer): New defuns.
(json_malloc, json_free, json_has_prefix, json_has_suffix)
(json_make_string, json_build_string, json_encode)
(json_out_of_memory, json_parse_error)
(json_release_object, check_string_without_embedded_nulls, json_check)
(lisp_to_json, lisp_to_json_toplevel, lisp_to_json_toplevel_1)
(json_insert, json_insert_callback, json_to_lisp)
(json_read_buffer_callback, Fjson_parse_buffer, define_error): New
helper functions.
(init_json, syms_of_json): New file.

* src/lisp.h: Declaration for init_json and syms_of_json.

* src/emacs.c (main): Enable JSON functions.

* src/eval.c (internal_catch_all, internal_catch_all_1): New helper
functions to catch all signals.
(syms_of_eval): Add uninterned symbol to signify out of memory.

* src/Makefile.in (JSON_LIBS, JSON_CFLAGS, JSON_OBJ, EMACS_CFLAGS)
(base_obj, LIBES): Compile json.c if --with-json is enabled.

* test/src/json-tests.el (json-serialize/roundtrip)
(json-serialize/object, json-parse-string/object)
(json-parse-string/string, json-serialize/string)
(json-parse-string/incomplete, json-parse-string/trailing)
(json-parse-buffer/incomplete, json-parse-buffer/trailing): New unit
tests.

* doc/lispref/text.texi (Parsing JSON): New manual section.
parent 402e790a
......@@ -355,6 +355,7 @@ OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support])
OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)])
OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support])
OPTION_DEFAULT_ON([json], [don't compile with native JSON support])
OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
......@@ -2870,6 +2871,22 @@ fi
AC_SUBST(LIBSYSTEMD_LIBS)
AC_SUBST(LIBSYSTEMD_CFLAGS)
HAVE_JSON=no
JSON_OBJ=
if test "${with_json}" = yes; then
EMACS_CHECK_MODULES([JSON], [jansson >= 2.5],
[HAVE_JSON=yes], [HAVE_JSON=no])
if test "${HAVE_JSON}" = yes; then
AC_DEFINE(HAVE_JSON, 1, [Define if using Jansson.])
JSON_OBJ=json.o
fi
fi
AC_SUBST(JSON_LIBS)
AC_SUBST(JSON_CFLAGS)
AC_SUBST(JSON_OBJ)
NOTIFY_OBJ=
NOTIFY_SUMMARY=no
......@@ -5366,7 +5383,7 @@ emacs_config_features=
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \
XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do
XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2; do
case $opt in
CANNOT_DUMP) eval val=\${$opt} ;;
......@@ -5416,6 +5433,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use -lotf? ${HAVE_LIBOTF}
Does Emacs use -lxft? ${HAVE_XFT}
Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD}
Does Emacs use -ljansson? ${HAVE_JSON}
Does Emacs directly use zlib? ${HAVE_ZLIB}
Does Emacs have dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}
......
......@@ -61,6 +61,7 @@ the character after point.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
* Parsing HTML/XML:: Parsing HTML and XML.
* Parsing JSON:: Parsing and generating JSON values.
* Atomic Changes:: Installing several buffer changes atomically.
* Change Hooks:: Supplying functions to be run when text is changed.
@end menu
......@@ -4934,6 +4935,92 @@ textual nodes that just contain white-space.
@end table
@node Parsing JSON
@section Parsing and generating JSON values
@cindex JSON
When Emacs is compiled with JSON support, it provides a couple of
functions to convert between Lisp objects and JSON values. Any JSON
value can be converted to a Lisp object, but not vice versa.
Specifically:
@itemize
@item
JSON has a couple of keywords: @code{null}, @code{false}, and
@code{true}. These are represented in Lisp using the keywords
@code{:null}, @code{:false}, and @code{t}, respectively.
@item
JSON only has floating-point numbers. They can represent both Lisp
integers and Lisp floating-point numbers.
@item
JSON strings are always Unicode strings. Lisp strings can contain
non-Unicode characters.
@item
JSON has only one sequence type, the array. JSON arrays are
represented using Lisp vectors.
@item
JSON has only one map type, the object. JSON objects are represented
using Lisp hashtables.
@end itemize
@noindent
Note that @code{nil} doesn't represent any JSON values: this is to
avoid confusion, because @code{nil} could either represent
@code{null}, @code{false}, or an empty array, all of which are
different JSON values.
If some Lisp object can't be represented in JSON, the serialization
functions will signal an error of type @code{wrong-type-argument}.
The parsing functions will signal the following errors:
@table @code
@item json-end-of-file
Signaled when encountering a premature end of the input text.
@item json-trailing-content
Signaled when encountering unexpected input after the first JSON
object parsed.
@item json-parse-error
Signaled when encountering invalid JSON syntax.
@end table
Only top-level values (arrays and objects) can be serialized to
JSON. The subobjects within these top-level values can be of any
type. Likewise, the parsing functions will only return vectors and
hashtables.
@defun json-serialize object
This function returns a new Lisp string which contains the JSON
representation of @var{object}.
@end defun
@defun json-insert object
This function inserts the JSON representation of @var{object} into the
current buffer before point.
@end defun
@defun json-parse-string string
This function parses the JSON value in @var{string}, which must be a
Lisp string.
@end defun
@defun json-parse-buffer
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 a value could be read and converted to Lisp; otherwise it
doesn't move point.
@end defun
@node Atomic Changes
@section Atomic Change Groups
@cindex atomic changes
......
......@@ -24,6 +24,13 @@ When you add a new item, use the appropriate mark if you are sure it applies,
* Installation Changes in Emacs 27.1
** The new configure option '--with-json' adds support for JSON using
the Jansson library. It is on by default; use 'configure
--with-json=no' to build without Jansson support. The new JSON
functions 'json-serialize', 'json-insert', 'json-parse-string', and
'json-parse-buffer' are typically much faster than their Lisp
counterparts from json.el.
* Startup Changes in Emacs 27.1
......@@ -164,6 +171,10 @@ remote systems, which support this check.
If the optional third argument is non-nil, 'make-string' will produce
a multibyte string even if its second argument is an ASCII character.
** New JSON parsing and serialization functions 'json-serialize',
'json-insert', 'json-parse-string', and 'json-parse-buffer'. These
are implemented in C using the Jansson library.
* Changes in Emacs 27.1 on Non-Free Operating Systems
......
......@@ -312,6 +312,10 @@ LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@
LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@
JSON_LIBS = @JSON_LIBS@
JSON_CFLAGS = @JSON_CFLAGS@
JSON_OBJ = @JSON_OBJ@
INTERVALS_H = dispextern.h intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
......@@ -363,7 +367,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
$(WEBKIT_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
$(LIBSYSTEMD_CFLAGS) \
$(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \
$(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
$(WERROR_CFLAGS)
ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS)
......@@ -397,7 +401,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
thread.o systhread.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ)
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
......@@ -493,7 +497,8 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
$(JSON_LIBS)
## FORCE it so that admin/unidata can decide whether these files
## are up-to-date. Although since charprop depends on bootstrap-emacs,
......
......@@ -1262,6 +1262,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
running_asynch_code = 0;
init_random ();
#ifdef HAVE_JSON
init_json ();
#endif
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
......@@ -1608,6 +1612,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_threads ();
syms_of_profiler ();
#ifdef HAVE_JSON
syms_of_json ();
#endif
keys_of_casefiddle ();
keys_of_cmds ();
keys_of_buffer ();
......
......@@ -1416,6 +1416,57 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
}
}
static Lisp_Object
internal_catch_all_1 (Lisp_Object (*function) (void *), void *argument)
{
struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
if (c == NULL)
return Qcatch_all_memory_full;
if (sys_setjmp (c->jmp) == 0)
{
Lisp_Object val = function (argument);
eassert (handlerlist == c);
handlerlist = c->next;
return val;
}
else
{
eassert (handlerlist == c);
Lisp_Object val = c->val;
handlerlist = c->next;
Fsignal (Qno_catch, val);
}
}
/* Like a combination of internal_condition_case_1 and internal_catch.
Catches all signals and throws. Never exits nonlocally; returns
Qcatch_all_memory_full if no handler could be allocated. */
Lisp_Object
internal_catch_all (Lisp_Object (*function) (void *), void *argument,
Lisp_Object (*handler) (Lisp_Object))
{
struct handler *c = push_handler_nosignal (Qt, CONDITION_CASE);
if (c == NULL)
return Qcatch_all_memory_full;
if (sys_setjmp (c->jmp) == 0)
{
Lisp_Object val = internal_catch_all_1 (function, argument);
eassert (handlerlist == c);
handlerlist = c->next;
return val;
}
else
{
eassert (handlerlist == c);
Lisp_Object val = c->val;
handlerlist = c->next;
return handler (val);
}
}
struct handler *
push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
{
......@@ -4067,6 +4118,9 @@ alist of active lexical bindings. */);
inhibit_lisp_code = Qnil;
DEFSYM (Qcatch_all_memory_full, "catch-all-memory-full");
Funintern (Qcatch_all_memory_full, Qnil);
defsubr (&Sor);
defsubr (&Sand);
defsubr (&Sif);
......
This diff is collapsed.
......@@ -3452,6 +3452,12 @@ extern int x_bitmap_mask (struct frame *, ptrdiff_t);
extern void reset_image_types (void);
extern void syms_of_image (void);
#ifdef HAVE_JSON
/* Defined in json.c. */
extern void init_json (void);
extern void syms_of_json (void);
#endif
/* Defined in insdel.c. */
extern void move_gap_both (ptrdiff_t, ptrdiff_t);
extern _Noreturn void buffer_overflow (void);
......@@ -3875,6 +3881,7 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp
extern Lisp_Object internal_condition_case_n
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (Lisp_Object));
extern struct handler *push_handler (Lisp_Object, enum handlertype);
extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
extern void specbind (Lisp_Object, Lisp_Object);
......
;;; json-tests.el --- unit tests for json.c -*- lexical-binding: t; -*-
;; Copyright (C) 2017 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit tests for src/json.c.
;;; Code:
(require 'cl-lib)
(require 'map)
(ert-deftest json-serialize/roundtrip ()
(let ((lisp [:null :false t 0 123 -456 3.75 "abcαβγ"])
(json "[null,false,true,0,123,-456,3.75,\"abcαβγ\"]"))
(should (equal (json-serialize lisp) json))
(with-temp-buffer
(json-insert lisp)
(should (equal (buffer-string) json))
(should (eobp)))
(should (equal (json-parse-string json) lisp))
(with-temp-buffer
(insert json)
(goto-char 1)
(should (equal (json-parse-buffer) lisp))
(should (eobp)))))
(ert-deftest json-serialize/object ()
(let ((table (make-hash-table :test #'equal)))
(puthash "abc" [1 2 t] table)
(puthash "def" :null table)
(should (equal (json-serialize table)
"{\"abc\":[1,2,true],\"def\":null}"))))
(ert-deftest json-parse-string/object ()
(let ((actual
(json-parse-string
"{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")))
(should (hash-table-p actual))
(should (equal (hash-table-count actual) 2))
(should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
'(("abc" . [9 :false]) ("def" . :null))))))
(ert-deftest json-parse-string/string ()
(should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)
(should (equal (json-parse-string "[\"foo \\\"bar\\\"\"]") ["foo \"bar\""]))
(should (equal (json-parse-string "[\"abcαβγ\"]") ["abcαβγ"]))
(should (equal (json-parse-string "[\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"]")
["\nasdфывfgh\t"]))
(should (equal (json-parse-string "[\"\\uD834\\uDD1E\"]") ["\U0001D11E"]))
(should-error (json-parse-string "foo") :type 'json-parse-error))
(ert-deftest json-serialize/string ()
(should (equal (json-serialize ["foo"]) "[\"foo\"]"))
(should (equal (json-serialize ["a\n\fb"]) "[\"a\\n\\fb\"]"))
(should (equal (json-serialize ["\nasdфыв\u001f\u007ffgh\t"])
"[\"\\nasdфыв\\u001F\u007ffgh\\t\"]")))
(ert-deftest json-parse-string/incomplete ()
(should-error (json-parse-string "[123") :type 'json-end-of-file))
(ert-deftest json-parse-string/trailing ()
(should-error (json-parse-string "[123] [456]") :type 'json-trailing-content))
(ert-deftest json-parse-buffer/incomplete ()
(with-temp-buffer
(insert "[123")
(goto-char 1)
(should-error (json-parse-buffer) :type 'json-end-of-file)
(should (bobp))))
(ert-deftest json-parse-buffer/trailing ()
(with-temp-buffer
(insert "[123] [456]")
(goto-char 1)
(should (equal (json-parse-buffer) [123]))
(should-not (bobp))
(should (looking-at-p (rx " [456]" eos)))))
(provide 'json-tests)
;;; json-tests.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment