19 files changed, 668 insertions, 0 deletions

diff --git a/modules/.gitignore b/modules/.gitignore
new file mode 100644
index 00000000000..fc15e0a56d7
--- /dev/null
+++ b/modules/.gitignore
@@ -0,0 +1,2 @@
+*/*.doc
+*/*.so
diff --git a/modules/ChangeLog b/modules/ChangeLog
new file mode 100644
index 00000000000..180d48e5bc4
--- /dev/null
+++ b/modules/ChangeLog
@@ -0,0 +1,11 @@
+2014-12-02  Aurélien Aptel  <aurelien.aptel@gmail.com>
+
+        * curl: Add new module.
+
+        * elisp: Add new module.
+
+        * fmod: Add new module.
+
+        * yaml: Add new module.
+
+        * opaque: Add new module.
diff --git a/modules/curl/Makefile.in b/modules/curl/Makefile.in
new file mode 100644
index 00000000000..2e7fda08bae
--- /dev/null
+++ b/modules/curl/Makefile.in
@@ -0,0 +1,15 @@
+ROOT = ../..
+
+CFLAGS  = `pkg-config libcurl --cflags`
+LDFLAGS = `pkg-config libcurl --libs`
+
+all: curl.so curl.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/curl/curl.c b/modules/curl/curl.c
new file mode 100644
index 00000000000..b8b2bb63a44
--- /dev/null
+++ b/modules/curl/curl.c
@@ -0,0 +1,118 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <curl/curl.h>
+
+#include <config.h>
+#include <lisp.h>
+
+int plugin_is_GPL_compatible;
+static Lisp_Object Qcurl;
+
+struct buffer
+{
+  char *p;
+  size_t size, capacity;
+};
+
+struct Lisp_CURL
+{
+  struct buffer buf;
+  CURL *curl;
+};
+
+#define XCURL(x) ((struct Lisp_CURL*)XSAVE_POINTER (x, 0))
+
+/* curl write callback */
+static size_t
+write_cb (void *src, size_t size, size_t nb, void *userp)
+{
+  struct buffer *buf = userp;
+  size_t total = size*nb;
+
+  if (buf->size + total > buf->capacity)
+    {
+      buf->capacity = 2 * (buf->size + total);
+      buf->p = realloc (buf->p, buf->capacity);
+    }
+
+  memcpy (buf->p + buf->size, src, total);
+  buf->size += total;
+  buf->p[buf->size] = 0;
+
+  return total;
+}
+
+
+EXFUN (Fcurl_make, 0);
+DEFUN ("curl-make", Fcurl_make, Scurl_make, 0, 0, 0,
+       doc: "Return a new CURL handle.")
+  (void)
+{
+  struct Lisp_CURL *p = calloc (sizeof (*p), 1);
+  p->buf.p = calloc (1, 1); /* so that realloc always work */
+  p->buf.capacity = 0;
+  p->curl = curl_easy_init ();
+  return make_save_ptr ((void*)p);
+}
+
+
+EXFUN (Fcurl_fetch_url, 2);
+DEFUN ("curl-fetch-url", Fcurl_fetch_url, Scurl_fetch_url, 2, 2, 0,
+       doc: "Fetch and store the content of URL using HANDLE.\n"
+       "Return t if successful otherwise return an error string.")
+  (Lisp_Object handle, Lisp_Object url)
+{
+  CURLcode res;
+  struct Lisp_CURL *c = XCURL (handle);
+
+  curl_easy_setopt (c->curl, CURLOPT_URL, SSDATA (url));
+  curl_easy_setopt (c->curl, CURLOPT_WRITEFUNCTION, write_cb);
+  curl_easy_setopt (c->curl, CURLOPT_WRITEDATA, (void*)&c->buf);
+  curl_easy_setopt (c->curl, CURLOPT_USERAGENT, "curl-in-emacs/1.0");
+  res = curl_easy_perform (c->curl);
+
+  if (res != CURLE_OK)
+    {
+      const char* error = curl_easy_strerror (res);
+      return make_string (error, strlen (error));
+    }
+
+  return Qt;
+}
+
+EXFUN (Fcurl_content, 1);
+DEFUN ("curl-content", Fcurl_content, Scurl_content, 1, 1, 0,
+       doc: "Return the content of a successful fetch made in HANDLE.")
+  (Lisp_Object handle)
+{
+  struct Lisp_CURL *c = XCURL (handle);
+  return make_string (c->buf.p, c->buf.size);
+}
+
+EXFUN (Fcurl_free, 1);
+DEFUN ("curl-free", Fcurl_free, Scurl_free, 1, 1, 0,
+       doc: "Free curl HANDLE.")
+  (Lisp_Object handle)
+{
+  struct Lisp_CURL *c = XCURL (handle);
+  free (c->buf.p);
+  curl_easy_cleanup (c->curl);
+
+  return Qt;
+}
+
+void init ()
+{
+  curl_global_init (CURL_GLOBAL_ALL);
+  /* when unloading: curl_global_cleanup(); */
+
+  DEFSYM (Qcurl, "curl");
+
+  defsubr (&Scurl_make);
+  defsubr (&Scurl_fetch_url);
+  defsubr (&Scurl_content);
+  defsubr (&Scurl_free);
+
+  Fprovide (Qcurl, Qnil);
+}
diff --git a/modules/elisp/Makefile.in b/modules/elisp/Makefile.in
new file mode 100644
index 00000000000..8df325e76b7
--- /dev/null
+++ b/modules/elisp/Makefile.in
@@ -0,0 +1,12 @@
+ROOT = ../..
+
+all: elisp.so elisp.doc
+
+%.so: %.o
+        gcc -shared -o $@ $<
+
+%.o: %.c
+        gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
+
+%.doc: %.c
+        $(ROOT)/lib-src/make-docfile $< > $@
diff --git a/modules/elisp/elisp.c b/modules/elisp/elisp.c
new file mode 100644
index 00000000000..aabb24e01c6
--- /dev/null
+++ b/modules/elisp/elisp.c
@@ -0,0 +1,38 @@
+#include <string.h>
+#include <config.h>
+#include <lisp.h>
+
+int plugin_is_GPL_compatible;
+
+static Lisp_Object Qelisp, Qreplace_regexp_in_string;
+
+#define MAKE_STRING(s) (make_string (s, sizeof(s)-1))
+
+EXFUN (Felisp_test, 0);
+DEFUN ("elisp-test", Felisp_test, Selisp_test, 0, 0, 0,
+       doc: "Eval some lisp.")
+    (void)
+{
+    Lisp_Object string  = MAKE_STRING ("no-more-dash");
+    Lisp_Object regex   = MAKE_STRING ("[-]");
+    Lisp_Object replace = MAKE_STRING (" ");
+    Lisp_Object res;
+
+    struct gcpro gcpro1, gcpro2, gcpro3;
+    GCPRO3 (string, regex, replace);
+    res = call3 (Qreplace_regexp_in_string, regex, replace, string);
+    UNGCPRO;
+
+    return res;
+}
+
+
+void init ()
+{
+  DEFSYM (Qelisp, "elisp");
+  DEFSYM (Qreplace_regexp_in_string, "replace-regexp-in-string");
+
+  defsubr (&Selisp_test);
+
+  Fprovide (Qelisp, Qnil);
+}
diff --git a/modules/fmod/Makefile.in b/modules/fmod/Makefile.in
new file mode 100644
index 00000000000..ad9016a1cee
--- /dev/null
+++ b/modules/fmod/Makefile.in
@@ -0,0 +1,12 @@
+ROOT = ../..
+
+all: fmod.so fmod.doc
+
+%.so: %.o
+        gcc -shared -o $@ $<
+
+%.o: %.c
+        gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
+
+%.doc: %.c
+        $(ROOT)/lib-src/make-docfile $< > $@
diff --git a/modules/fmod/fmod.c b/modules/fmod/fmod.c
new file mode 100644
index 00000000000..57da6168ae2
--- /dev/null
+++ b/modules/fmod/fmod.c
@@ -0,0 +1,60 @@
+#include <config.h>
+#include <lisp.h>
+
+#include <math.h>
+
+/* emacs checks for this symbol before running the module */
+
+int plugin_is_GPL_compatible;
+
+/* module feature name */
+static Lisp_Object Qfmod;
+
+/* define a new lisp function */
+
+EXFUN (Ffmod, 2);
+DEFUN ("fmod", Ffmod, Sfmod, 2, 2, 0,
+       doc: "Returns the floating-point remainder of NUMER/DENOM")
+  (Lisp_Object numer, Lisp_Object denom)
+{
+  return make_float (fmod (extract_float (numer), extract_float (denom)));
+}
+
+EXFUN (Ffmod_test1, 0);
+DEFUN ("fmod-test1", Ffmod_test1, Sfmod_test1, 0, 0, 0,
+       doc: "Return 1")
+  (void)
+{
+  return make_float (1.);
+}
+
+EXFUN (Ffmod_test2, 0);
+DEFUN ("fmod-test2", Ffmod_test2, Sfmod_test2, 0, 0, 0,
+       doc: "Return 2")
+  (void)
+{
+  return make_float (2.);
+}
+
+
+EXFUN (Ffmod_test3, 0);
+DEFUN ("fmod-test3", Ffmod_test3, Sfmod_test3, 0, 0, 0,
+       doc: "Return 3")
+  (void)
+{
+  return make_float (3.);
+}
+
+/* entry point of the module */
+
+void init ()
+{
+  DEFSYM (Qfmod, "fmod");
+
+  defsubr (&Sfmod);
+  defsubr (&Sfmod_test1);
+  defsubr (&Sfmod_test2);
+  defsubr (&Sfmod_test3);
+
+  Fprovide (Qfmod, Qnil);
+}
diff --git a/modules/opaque/Makefile.in b/modules/opaque/Makefile.in
new file mode 100644
index 00000000000..7f507326cfe
--- /dev/null
+++ b/modules/opaque/Makefile.in
@@ -0,0 +1,12 @@
+ROOT = ../..
+
+all: opaque.so opaque.doc
+
+%.so: %.o
+        gcc -shared -o $@ $<
+
+%.o: %.c
+        gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
+
+%.doc: %.c
+        $(ROOT)/lib-src/make-docfile $< > $@
diff --git a/modules/opaque/opaque.c b/modules/opaque/opaque.c
new file mode 100644
index 00000000000..2366b2ed2e9
--- /dev/null
+++ b/modules/opaque/opaque.c
@@ -0,0 +1,64 @@
+#include <config.h>
+#include <lisp.h>
+
+int plugin_is_GPL_compatible;
+static Lisp_Object Qopaque;
+
+struct opaque
+{
+  int a, b, c;
+};
+
+static Lisp_Object Qa, Qb, Qc;
+
+EXFUN (Fopaque_make, 3);
+DEFUN ("opaque-make", Fopaque_make, Sopaque_make, 3, 3, 0,
+       doc: "Make opaque type.")
+  (Lisp_Object a, Lisp_Object b, Lisp_Object c)
+{
+  struct opaque *p = malloc (sizeof (*p));
+  p->a = XINT (a);
+  p->b = XINT (b);
+  p->c = XINT (c);
+
+  /*
+    store p as a the first slot (index 0) of a Lisp_Save_Value (which
+    is a Lisp_Misc)
+  */
+  return make_save_ptr ((void*)p);
+}
+
+EXFUN (Fopaque_free, 1);
+DEFUN ("opaque-free", Fopaque_free, Sopaque_free, 1, 1, 0,
+       doc: "Free opaque object OBJ.")
+  (Lisp_Object obj)
+{
+  /* the pointer is in the first slot (index 0) */
+  free (XSAVE_POINTER (obj, 0));
+  return Qnil;
+}
+
+EXFUN (Fopaque_get, 2);
+DEFUN ("opaque-get", Fopaque_get, Sopaque_get, 2, 2, 0,
+       doc: "Return the field F (`a', `b', `c') of the opaque object OBJ.")
+  (Lisp_Object obj, Lisp_Object f)
+{
+  struct opaque *p = XSAVE_POINTER (obj, 0);
+  int val = EQ (f, Qa) ? p->a : EQ (f, Qb) ? p->b : EQ (f, Qc) ? p->c : -1;
+  return make_number (val);
+}
+
+void init ()
+{
+  DEFSYM (Qopaque, "opaque");
+
+  DEFSYM (Qa, "a");
+  DEFSYM (Qb, "b");
+  DEFSYM (Qc, "c");
+
+  defsubr (&Sopaque_make);
+  defsubr (&Sopaque_free);
+  defsubr (&Sopaque_get);
+
+  Fprovide (Qopaque, Qnil);
+}
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);
+}