diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/.gitignore | 2 | ||||
-rw-r--r-- | modules/ChangeLog | 11 | ||||
-rw-r--r-- | modules/curl/Makefile.in | 15 | ||||
-rw-r--r-- | modules/curl/curl.c | 118 | ||||
-rw-r--r-- | modules/elisp/Makefile.in | 12 | ||||
-rw-r--r-- | modules/elisp/elisp.c | 38 | ||||
-rw-r--r-- | modules/fmod/Makefile.in | 12 | ||||
-rw-r--r-- | modules/fmod/fmod.c | 60 | ||||
-rw-r--r-- | modules/opaque/Makefile.in | 12 | ||||
-rw-r--r-- | modules/opaque/opaque.c | 64 | ||||
-rw-r--r-- | modules/yaml/Makefile.in | 15 | ||||
-rw-r--r-- | modules/yaml/tests/alias.yaml | 14 | ||||
-rw-r--r-- | modules/yaml/tests/map.yaml | 4 | ||||
-rw-r--r-- | modules/yaml/tests/multi.yaml | 16 | ||||
-rw-r--r-- | modules/yaml/tests/nest.yaml | 12 | ||||
-rw-r--r-- | modules/yaml/tests/scal.yaml | 2 | ||||
-rw-r--r-- | modules/yaml/tests/seq.yaml | 5 | ||||
-rw-r--r-- | modules/yaml/yaml-test.el | 24 | ||||
-rw-r--r-- | modules/yaml/yaml.c | 232 |
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); +} |