9 files changed, 324 insertions, 0 deletions

diff --git a/modules/yaml/Makefile.in b/modules/yaml/Makefile.in
new file mode 100644
index 00000000000..32f61e9df4f
--- /dev/null
+++ b/modules/yaml/Makefile.in
@@ -0,0 +1,15 @@
+ROOT = ../..
+
+CFLAGS  = `pkg-config yaml-0.1 --cflags`
+LDFLAGS = `pkg-config yaml-0.1 --libs`
+
+all: yaml.so yaml.doc
+
+%.so: %.o
+        gcc -shared $(LDFLAGS) -o $@ $<
+
+%.o: %.c
+        gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib $(CFLAGS) -fPIC -c $<
+
+%.doc: %.c
+        $(ROOT)/lib-src/make-docfile $< > $@
diff --git a/modules/yaml/tests/alias.yaml b/modules/yaml/tests/alias.yaml
new file mode 100644
index 00000000000..c3dade3a011
--- /dev/null
+++ b/modules/yaml/tests/alias.yaml
@@ -0,0 +1,14 @@
+---
+invoice: 34843
+date   : 2001-01-23
+bill-to: &id001
+    given  : Chris
+    family : Dumars
+    address:
+        lines: |
+            458 Walkman Dr.
+            Suite #292
+        city    : Royal Oak
+        state   : MI
+        postal  : 48046
+ship-to: *id001
diff --git a/modules/yaml/tests/map.yaml b/modules/yaml/tests/map.yaml
new file mode 100644
index 00000000000..4021d74248a
--- /dev/null
+++ b/modules/yaml/tests/map.yaml
@@ -0,0 +1,4 @@
+---
+a: 1
+b: 2
+c: 3
diff --git a/modules/yaml/tests/multi.yaml b/modules/yaml/tests/multi.yaml
new file mode 100644
index 00000000000..1eb61f7df3e
--- /dev/null
+++ b/modules/yaml/tests/multi.yaml
@@ -0,0 +1,16 @@
+---
+a: 1
+b:
+    - 1
+    - 2
+    - 3
+---
+foo:
+    bar: 1
+    baz: 2
+    bad: 3
+zob:
+    - 42
+    - 43
+---
+abc
diff --git a/modules/yaml/tests/nest.yaml b/modules/yaml/tests/nest.yaml
new file mode 100644
index 00000000000..8a453dfc771
--- /dev/null
+++ b/modules/yaml/tests/nest.yaml
@@ -0,0 +1,12 @@
+---
+product:
+    - sku         : BL394D
+      quantity    : 4
+      description : Basketball
+      price       : 450.00
+    - sku         : BL4438H
+      quantity    : 1
+      description : Super Hoop
+      price       : 2392.00
+tax  : 251.42
+total: 4443.52
diff --git a/modules/yaml/tests/scal.yaml b/modules/yaml/tests/scal.yaml
new file mode 100644
index 00000000000..aecd198b598
--- /dev/null
+++ b/modules/yaml/tests/scal.yaml
@@ -0,0 +1,2 @@
+---
+abc
diff --git a/modules/yaml/tests/seq.yaml b/modules/yaml/tests/seq.yaml
new file mode 100644
index 00000000000..15b6a9e3dc0
--- /dev/null
+++ b/modules/yaml/tests/seq.yaml
@@ -0,0 +1,5 @@
+---
+- abc
+- def
+- ghi
+- jkl
diff --git a/modules/yaml/yaml-test.el b/modules/yaml/yaml-test.el
new file mode 100644
index 00000000000..5f9b5c0ef10
--- /dev/null
+++ b/modules/yaml/yaml-test.el
@@ -0,0 +1,24 @@
+
+(defun yaml-expand-file (file)
+  (if (not (string-match-p "/" file))
+      (expand-file-name
+       (concat "~/prog/c/emacs/dyn/modules/yaml/tests/" file))
+    file))
+
+(defun yaml-test-file (file)
+  (require 'yaml)
+  (require 'json)
+  (with-current-buffer (get-buffer-create "out")
+    (erase-buffer)
+    (insert (json-encode (yaml-parse-file (yaml-expand-file file))))
+    (json-pretty-print (point-min) (point-max))))
+
+(defun yaml-test-buffer (file)
+  (require 'yaml)
+  (require 'json)
+  (with-current-buffer (get-buffer-create "out")
+    (erase-buffer)
+    (insert (json-encode (with-temp-buffer
+                           (insert-file-contents (yaml-expand-file file))
+                           (yaml-parse))))
+    (json-pretty-print (point-min) (point-max))))
diff --git a/modules/yaml/yaml.c b/modules/yaml/yaml.c
new file mode 100644
index 00000000000..3ff133476ee
--- /dev/null
+++ b/modules/yaml/yaml.c
@@ -0,0 +1,232 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <yaml.h>
+
+
+#include <config.h>
+#include <lisp.h>
+
+#include <character.h> /* buffer.h needs it */
+#include <buffer.h>
+
+int plugin_is_GPL_compatible;
+static Lisp_Object Qyaml;
+
+typedef unsigned char uchar;
+
+struct context
+{
+  yaml_parser_t p;
+  int error;
+  Lisp_Object anchors; /* hashtable mapping alias to values */
+};
+
+static Lisp_Object parse_scalar (struct context *ctx, yaml_event_t *e);
+static Lisp_Object parse_sequence (struct context *ctx, yaml_event_t *e);
+static Lisp_Object parse_mapping (struct context *ctx, yaml_event_t *e);
+
+static Lisp_Object
+parse_element (struct context *ctx)
+{
+  Lisp_Object res = Qnil;
+  yaml_event_t e;
+
+ redo:
+  yaml_parser_parse (&ctx->p, &e);
+  const char *s = (char*)e.data.alias.anchor;
+
+  switch (e.type)
+    {
+    case YAML_STREAM_START_EVENT:
+      /* a stream is a sequence of documents */
+      res = parse_sequence (ctx, &e);
+      break;
+
+    case YAML_DOCUMENT_START_EVENT:
+    case YAML_DOCUMENT_END_EVENT:
+      /* keep reading */
+      yaml_event_delete (&e);
+      goto redo;
+
+    case YAML_ALIAS_EVENT:
+      res = Fgethash (make_string (s, strlen (s)), ctx->anchors, Qnil);
+      break;
+
+    case YAML_SCALAR_EVENT:
+      res = parse_scalar (ctx, &e);
+      if (s)
+        Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
+      break;
+
+    case YAML_SEQUENCE_START_EVENT:
+      res = parse_sequence (ctx, &e);
+      if (s)
+        Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
+      break;
+
+    case YAML_MAPPING_START_EVENT:
+      res = parse_mapping (ctx, &e);
+      if (s)
+        Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
+      break;
+
+    case YAML_NO_EVENT:
+    case YAML_MAPPING_END_EVENT:
+    case YAML_SEQUENCE_END_EVENT:
+    case YAML_STREAM_END_EVENT:
+      res = Qnil;
+      break;
+    }
+
+  yaml_event_delete (&e);
+  return res;
+}
+
+static Lisp_Object
+parse_scalar (struct context *ctx, yaml_event_t *e)
+{
+  return make_string ((char*)e->data.scalar.value, e->data.scalar.length);
+}
+
+static Lisp_Object
+parse_sequence (struct context *ctx, yaml_event_t *e)
+{
+  /* always >= 1 elements in sequence */
+  Lisp_Object cons = Fcons (parse_element (ctx), Qnil);
+  Lisp_Object res = cons;
+
+  while (1)
+    {
+      Lisp_Object e = parse_element (ctx);
+
+      if (NILP (e))
+        break;
+
+      XSETCDR (cons, Fcons(e, Qnil));
+      cons = XCDR (cons);
+    }
+
+  return res;
+}
+
+static Lisp_Object
+parse_mapping (struct context *ctx, yaml_event_t *e)
+{
+  Lisp_Object args[2];
+  args[0] = QCtest;
+  args[1] = Qequal;
+  Lisp_Object res = Fmake_hash_table (2, args);
+
+  while (1)
+    {
+      Lisp_Object key = parse_element (ctx);
+
+      if (NILP (key))
+        break;
+
+      Lisp_Object val = parse_element (ctx);
+
+      Fputhash (key, val, res);
+    }
+
+  return res;
+}
+
+static void
+context_init (struct context *ctx)
+{
+  memset (ctx, 0, sizeof (*ctx));
+  Lisp_Object args[2];
+  args[0] = QCtest;
+  args[1] = Qequal;
+  ctx->anchors = Fmake_hash_table (2, args);
+}
+
+EXFUN (Fyaml_parse_string, 1);
+DEFUN ("yaml-parse-string", Fyaml_parse_string, Syaml_parse_string, 1, 1, 0,
+       doc: "Parse STRING as yaml.")
+  (Lisp_Object string)
+{
+  struct context ctx;
+  Lisp_Object res = Qnil;
+
+  context_init (&ctx);
+
+  yaml_parser_initialize (&ctx.p);
+  yaml_parser_set_input_string (&ctx.p, SDATA (string), SBYTES (string));
+  res = parse_element (&ctx);
+  yaml_parser_delete (&ctx.p);
+
+  return res;
+}
+
+
+EXFUN (Fyaml_parse_buffer, 0);
+DEFUN ("yaml-parse-buffer", Fyaml_parse_buffer, Syaml_parse_buffer, 0, 0, 0,
+       doc: "Parse current buffer as yaml.")
+  (void)
+{
+  struct context ctx;
+  Lisp_Object res = Qnil;
+
+  context_init (&ctx);
+
+  yaml_parser_initialize (&ctx.p);
+  yaml_parser_set_input_string (&ctx.p, BYTE_POS_ADDR (BEGV_BYTE), ZV_BYTE - BEGV_BYTE);
+  res = parse_element (&ctx);
+  yaml_parser_delete (&ctx.p);
+
+  return res;
+}
+
+
+EXFUN (Fyaml_parse_file, 1);
+DEFUN ("yaml-parse-file", Fyaml_parse_file, Syaml_parse_file, 1, 1, 0,
+       doc: "Parse FILE as yaml.")
+  (Lisp_Object file)
+{
+  struct gcpro gcpro1;
+  struct context ctx;
+
+  context_init (&ctx);
+
+  int r;
+  FILE *fh;
+  Lisp_Object res = Qnil;
+
+  fh = fopen((char*)SDATA (file), "r");
+
+  if (!fh)
+    goto out;
+
+  r = yaml_parser_initialize (&ctx.p);
+
+  if (!r)
+    goto out_close;
+
+  yaml_parser_set_input_file (&ctx.p, fh);
+
+  GCPRO1 (ctx.anchors);
+  res = parse_element (&ctx);
+  UNGCPRO;
+
+  yaml_parser_delete (&ctx.p);
+
+ out_close:
+  fclose (fh);
+
+ out:
+  return res;
+}
+
+void init ()
+{
+  DEFSYM (Qyaml, "yaml");
+
+  defsubr (&Syaml_parse_file);
+  defsubr (&Syaml_parse_string);
+  defsubr (&Syaml_parse_buffer);
+
+  Fprovide (Qyaml, Qnil);
+}