aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAurélien Aptel2014-12-02 16:17:10 -0500
committerTed Zlatanov2014-12-04 19:54:16 -0500
commitae901ddbfff04e8b1b0d63c452a6ca3f4c81fb17 (patch)
treeb806504944c633be45255321d1203bbcc2504781
parentdd601050e7db69f322eea09d99751d8e6363b153 (diff)
downloademacs-old-branches/dynamic-modules-rc2.tar.gz
emacs-old-branches/dynamic-modules-rc2.zip
* configure.ac: Add libtool support and module Makefiles. * src/Makefile.in: Support libtool. * src/alloc.c (mark_object): Mark the doc field of Lisp_Subr as object. * src/doc.c (doc_is_from_module_p, get_doc_string, reread_doc_file) (store_function_docstring, build_file_p, Fsnarf_documentation): Support docstrings for external modules. * src/lisp.h: Make the doc field of Lisp_Subr a Lisp_Object. * src/lread.c (Fget_load_suffixes, Fload_module, string_suffixes_p) (string_suffix_p, Fload, intern_c_string_1, defsubr) (syms_of_lread): Add loading of external modules and the docstrings of their functions. * modules/curl: New module. * modules/elisp: New module. * modules/fmod: New module. * modules/opaque: New module. * modules/yaml: New module.
-rw-r--r--ChangeLog4
-rw-r--r--configure.ac23
-rw-r--r--modules/.gitignore2
-rw-r--r--modules/ChangeLog11
-rw-r--r--modules/curl/Makefile.in15
-rw-r--r--modules/curl/curl.c118
-rw-r--r--modules/elisp/Makefile.in12
-rw-r--r--modules/elisp/elisp.c38
-rw-r--r--modules/fmod/Makefile.in12
-rw-r--r--modules/fmod/fmod.c60
-rw-r--r--modules/opaque/Makefile.in12
-rw-r--r--modules/opaque/opaque.c64
-rw-r--r--modules/yaml/Makefile.in15
-rw-r--r--modules/yaml/tests/alias.yaml14
-rw-r--r--modules/yaml/tests/map.yaml4
-rw-r--r--modules/yaml/tests/multi.yaml16
-rw-r--r--modules/yaml/tests/nest.yaml12
-rw-r--r--modules/yaml/tests/scal.yaml2
-rw-r--r--modules/yaml/tests/seq.yaml5
-rw-r--r--modules/yaml/yaml-test.el24
-rw-r--r--modules/yaml/yaml.c232
-rw-r--r--src/ChangeLog17
-rw-r--r--src/Makefile.in4
-rw-r--r--src/alloc.c1
-rw-r--r--src/doc.c139
-rw-r--r--src/lisp.h2
-rw-r--r--src/lread.c162
27 files changed, 942 insertions, 78 deletions
diff --git a/ChangeLog b/ChangeLog
index cd7698c0ab5..2152f9ecb10 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
12014-12-02 Aurélien Aptel <aurelien.aptel@gmail.com>
2
3 * configure.ac: Add libtool support and module Makefiles.
4
12014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org> 52014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 6
3 * .gitignore: Ignore loaddefs directly under lisp, and in 7 * .gitignore: Ignore loaddefs directly under lisp, and in
diff --git a/configure.ac b/configure.ac
index 010abc8544c..f9fee9d884d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -355,6 +355,8 @@ OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support])
355OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) 355OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
356OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) 356OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
357OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) 357OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
358OPTION_DEFAULT_OFF([ltdl], [compile with dynamic module loading support])
359
358 360
359AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], 361AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
360 [use a file notification library (LIB one of: yes, gfile, inotify, w32, no)])], 362 [use a file notification library (LIB one of: yes, gfile, inotify, w32, no)])],
@@ -3179,6 +3181,18 @@ if test "${HAVE_ZLIB}" = "yes"; then
3179fi 3181fi
3180AC_SUBST(LIBZ) 3182AC_SUBST(LIBZ)
3181 3183
3184HAVE_LTDL=no
3185LIBLTDL=
3186if test "${with_ltdl}" != "no"; then
3187 AC_CHECK_HEADER(ltdl.h, HAVE_LTDL=yes, HAVE_LTDL=no)
3188 AC_CHECK_LIB(ltdl, lt_dlopen, HAVE_LTDL=yes, HAVE_LTDL=no)
3189fi
3190if test "${HAVE_LTDL}" = "yes"; then
3191 AC_DEFINE(HAVE_LTDL, 1, [Define to 1 if you have the ltdl library (-lltdl).])
3192 LIBLTDL="-lltdl -Wl,--export-dynamic"
3193fi
3194AC_SUBST(LIBLTDL)
3195
3182### Use -lpng if available, unless `--with-png=no'. 3196### Use -lpng if available, unless `--with-png=no'.
3183HAVE_PNG=no 3197HAVE_PNG=no
3184LIBPNG= 3198LIBPNG=
@@ -5049,7 +5063,7 @@ optsep=
5049emacs_config_features= 5063emacs_config_features=
5050for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS \ 5064for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS \
5051 GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ 5065 GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
5052 LIBOTF XFT ZLIB; do 5066 LIBOTF XFT ZLIB LTDL; do
5053 5067
5054 case $opt in 5068 case $opt in
5055 NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;; 5069 NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;;
@@ -5088,6 +5102,7 @@ echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}
5088echo " Does Emacs use -lotf? ${HAVE_LIBOTF}" 5102echo " Does Emacs use -lotf? ${HAVE_LIBOTF}"
5089echo " Does Emacs use -lxft? ${HAVE_XFT}" 5103echo " Does Emacs use -lxft? ${HAVE_XFT}"
5090echo " Does Emacs directly use zlib? ${HAVE_ZLIB}" 5104echo " Does Emacs directly use zlib? ${HAVE_ZLIB}"
5105echo " Does Emacs use -lltdl? ${HAVE_LTDL}"
5091 5106
5092echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" 5107echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}"
5093echo 5108echo
@@ -5154,12 +5169,14 @@ dnl This will work, but you get a config.status that is not quite right
5154dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html). 5169dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html).
5155dnl That doesn't have any obvious consequences for Emacs, but on the whole 5170dnl That doesn't have any obvious consequences for Emacs, but on the whole
5156dnl it seems better to just live with the duplication. 5171dnl it seems better to just live with the duplication.
5157SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile nt/Makefile" 5172SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile modules/curl/Makefile modules/elisp/Makefile modules/fmod/Makefile modules/opaque/Makefile modules/yaml/Makefile nextstep/Makefile nt/Makefile"
5158 5173
5159AC_CONFIG_FILES([Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \ 5174AC_CONFIG_FILES([Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \
5160 doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \ 5175 doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile \
5161 doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile \ 5176 doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile \
5162 leim/Makefile nextstep/Makefile nt/Makefile]) 5177 leim/Makefile \
5178 modules/curl/Makefile modules/elisp/Makefile modules/fmod/Makefile modules/yaml/Makefile \
5179 nextstep/Makefile nt/Makefile])
5163 5180
5164dnl test/ is not present in release tarfiles. 5181dnl test/ is not present in release tarfiles.
5165opt_makefile=test/automated/Makefile 5182opt_makefile=test/automated/Makefile
diff --git a/modules/.gitignore b/modules/.gitignore
new file mode 100644
index 00000000000..fc15e0a56d7
--- /dev/null
+++ b/modules/.gitignore
@@ -0,0 +1,2 @@
1*/*.doc
2*/*.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 @@
12014-12-02 Aurélien Aptel <aurelien.aptel@gmail.com>
2
3 * curl: Add new module.
4
5 * elisp: Add new module.
6
7 * fmod: Add new module.
8
9 * yaml: Add new module.
10
11 * 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 @@
1ROOT = ../..
2
3CFLAGS = `pkg-config libcurl --cflags`
4LDFLAGS = `pkg-config libcurl --libs`
5
6all: curl.so curl.doc
7
8%.so: %.o
9 gcc -shared $(LDFLAGS) -o $@ $<
10
11%.o: %.c
12 gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib $(CFLAGS) -fPIC -c $<
13
14%.doc: %.c
15 $(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 @@
1#include <stdio.h>
2#include <stdlib.h>
3#include <string.h>
4#include <curl/curl.h>
5
6#include <config.h>
7#include <lisp.h>
8
9int plugin_is_GPL_compatible;
10static Lisp_Object Qcurl;
11
12struct buffer
13{
14 char *p;
15 size_t size, capacity;
16};
17
18struct Lisp_CURL
19{
20 struct buffer buf;
21 CURL *curl;
22};
23
24#define XCURL(x) ((struct Lisp_CURL*)XSAVE_POINTER (x, 0))
25
26/* curl write callback */
27static size_t
28write_cb (void *src, size_t size, size_t nb, void *userp)
29{
30 struct buffer *buf = userp;
31 size_t total = size*nb;
32
33 if (buf->size + total > buf->capacity)
34 {
35 buf->capacity = 2 * (buf->size + total);
36 buf->p = realloc (buf->p, buf->capacity);
37 }
38
39 memcpy (buf->p + buf->size, src, total);
40 buf->size += total;
41 buf->p[buf->size] = 0;
42
43 return total;
44}
45
46
47EXFUN (Fcurl_make, 0);
48DEFUN ("curl-make", Fcurl_make, Scurl_make, 0, 0, 0,
49 doc: "Return a new CURL handle.")
50 (void)
51{
52 struct Lisp_CURL *p = calloc (sizeof (*p), 1);
53 p->buf.p = calloc (1, 1); /* so that realloc always work */
54 p->buf.capacity = 0;
55 p->curl = curl_easy_init ();
56 return make_save_ptr ((void*)p);
57}
58
59
60EXFUN (Fcurl_fetch_url, 2);
61DEFUN ("curl-fetch-url", Fcurl_fetch_url, Scurl_fetch_url, 2, 2, 0,
62 doc: "Fetch and store the content of URL using HANDLE.\n"
63 "Return t if successful otherwise return an error string.")
64 (Lisp_Object handle, Lisp_Object url)
65{
66 CURLcode res;
67 struct Lisp_CURL *c = XCURL (handle);
68
69 curl_easy_setopt (c->curl, CURLOPT_URL, SSDATA (url));
70 curl_easy_setopt (c->curl, CURLOPT_WRITEFUNCTION, write_cb);
71 curl_easy_setopt (c->curl, CURLOPT_WRITEDATA, (void*)&c->buf);
72 curl_easy_setopt (c->curl, CURLOPT_USERAGENT, "curl-in-emacs/1.0");
73 res = curl_easy_perform (c->curl);
74
75 if (res != CURLE_OK)
76 {
77 const char* error = curl_easy_strerror (res);
78 return make_string (error, strlen (error));
79 }
80
81 return Qt;
82}
83
84EXFUN (Fcurl_content, 1);
85DEFUN ("curl-content", Fcurl_content, Scurl_content, 1, 1, 0,
86 doc: "Return the content of a successful fetch made in HANDLE.")
87 (Lisp_Object handle)
88{
89 struct Lisp_CURL *c = XCURL (handle);
90 return make_string (c->buf.p, c->buf.size);
91}
92
93EXFUN (Fcurl_free, 1);
94DEFUN ("curl-free", Fcurl_free, Scurl_free, 1, 1, 0,
95 doc: "Free curl HANDLE.")
96 (Lisp_Object handle)
97{
98 struct Lisp_CURL *c = XCURL (handle);
99 free (c->buf.p);
100 curl_easy_cleanup (c->curl);
101
102 return Qt;
103}
104
105void init ()
106{
107 curl_global_init (CURL_GLOBAL_ALL);
108 /* when unloading: curl_global_cleanup(); */
109
110 DEFSYM (Qcurl, "curl");
111
112 defsubr (&Scurl_make);
113 defsubr (&Scurl_fetch_url);
114 defsubr (&Scurl_content);
115 defsubr (&Scurl_free);
116
117 Fprovide (Qcurl, Qnil);
118}
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 @@
1ROOT = ../..
2
3all: elisp.so elisp.doc
4
5%.so: %.o
6 gcc -shared -o $@ $<
7
8%.o: %.c
9 gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
10
11%.doc: %.c
12 $(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 @@
1#include <string.h>
2#include <config.h>
3#include <lisp.h>
4
5int plugin_is_GPL_compatible;
6
7static Lisp_Object Qelisp, Qreplace_regexp_in_string;
8
9#define MAKE_STRING(s) (make_string (s, sizeof(s)-1))
10
11EXFUN (Felisp_test, 0);
12DEFUN ("elisp-test", Felisp_test, Selisp_test, 0, 0, 0,
13 doc: "Eval some lisp.")
14 (void)
15{
16 Lisp_Object string = MAKE_STRING ("no-more-dash");
17 Lisp_Object regex = MAKE_STRING ("[-]");
18 Lisp_Object replace = MAKE_STRING (" ");
19 Lisp_Object res;
20
21 struct gcpro gcpro1, gcpro2, gcpro3;
22 GCPRO3 (string, regex, replace);
23 res = call3 (Qreplace_regexp_in_string, regex, replace, string);
24 UNGCPRO;
25
26 return res;
27}
28
29
30void init ()
31{
32 DEFSYM (Qelisp, "elisp");
33 DEFSYM (Qreplace_regexp_in_string, "replace-regexp-in-string");
34
35 defsubr (&Selisp_test);
36
37 Fprovide (Qelisp, Qnil);
38}
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 @@
1ROOT = ../..
2
3all: fmod.so fmod.doc
4
5%.so: %.o
6 gcc -shared -o $@ $<
7
8%.o: %.c
9 gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
10
11%.doc: %.c
12 $(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 @@
1#include <config.h>
2#include <lisp.h>
3
4#include <math.h>
5
6/* emacs checks for this symbol before running the module */
7
8int plugin_is_GPL_compatible;
9
10/* module feature name */
11static Lisp_Object Qfmod;
12
13/* define a new lisp function */
14
15EXFUN (Ffmod, 2);
16DEFUN ("fmod", Ffmod, Sfmod, 2, 2, 0,
17 doc: "Returns the floating-point remainder of NUMER/DENOM")
18 (Lisp_Object numer, Lisp_Object denom)
19{
20 return make_float (fmod (extract_float (numer), extract_float (denom)));
21}
22
23EXFUN (Ffmod_test1, 0);
24DEFUN ("fmod-test1", Ffmod_test1, Sfmod_test1, 0, 0, 0,
25 doc: "Return 1")
26 (void)
27{
28 return make_float (1.);
29}
30
31EXFUN (Ffmod_test2, 0);
32DEFUN ("fmod-test2", Ffmod_test2, Sfmod_test2, 0, 0, 0,
33 doc: "Return 2")
34 (void)
35{
36 return make_float (2.);
37}
38
39
40EXFUN (Ffmod_test3, 0);
41DEFUN ("fmod-test3", Ffmod_test3, Sfmod_test3, 0, 0, 0,
42 doc: "Return 3")
43 (void)
44{
45 return make_float (3.);
46}
47
48/* entry point of the module */
49
50void init ()
51{
52 DEFSYM (Qfmod, "fmod");
53
54 defsubr (&Sfmod);
55 defsubr (&Sfmod_test1);
56 defsubr (&Sfmod_test2);
57 defsubr (&Sfmod_test3);
58
59 Fprovide (Qfmod, Qnil);
60}
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 @@
1ROOT = ../..
2
3all: opaque.so opaque.doc
4
5%.so: %.o
6 gcc -shared -o $@ $<
7
8%.o: %.c
9 gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib -fPIC -c $<
10
11%.doc: %.c
12 $(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 @@
1#include <config.h>
2#include <lisp.h>
3
4int plugin_is_GPL_compatible;
5static Lisp_Object Qopaque;
6
7struct opaque
8{
9 int a, b, c;
10};
11
12static Lisp_Object Qa, Qb, Qc;
13
14EXFUN (Fopaque_make, 3);
15DEFUN ("opaque-make", Fopaque_make, Sopaque_make, 3, 3, 0,
16 doc: "Make opaque type.")
17 (Lisp_Object a, Lisp_Object b, Lisp_Object c)
18{
19 struct opaque *p = malloc (sizeof (*p));
20 p->a = XINT (a);
21 p->b = XINT (b);
22 p->c = XINT (c);
23
24 /*
25 store p as a the first slot (index 0) of a Lisp_Save_Value (which
26 is a Lisp_Misc)
27 */
28 return make_save_ptr ((void*)p);
29}
30
31EXFUN (Fopaque_free, 1);
32DEFUN ("opaque-free", Fopaque_free, Sopaque_free, 1, 1, 0,
33 doc: "Free opaque object OBJ.")
34 (Lisp_Object obj)
35{
36 /* the pointer is in the first slot (index 0) */
37 free (XSAVE_POINTER (obj, 0));
38 return Qnil;
39}
40
41EXFUN (Fopaque_get, 2);
42DEFUN ("opaque-get", Fopaque_get, Sopaque_get, 2, 2, 0,
43 doc: "Return the field F (`a', `b', `c') of the opaque object OBJ.")
44 (Lisp_Object obj, Lisp_Object f)
45{
46 struct opaque *p = XSAVE_POINTER (obj, 0);
47 int val = EQ (f, Qa) ? p->a : EQ (f, Qb) ? p->b : EQ (f, Qc) ? p->c : -1;
48 return make_number (val);
49}
50
51void init ()
52{
53 DEFSYM (Qopaque, "opaque");
54
55 DEFSYM (Qa, "a");
56 DEFSYM (Qb, "b");
57 DEFSYM (Qc, "c");
58
59 defsubr (&Sopaque_make);
60 defsubr (&Sopaque_free);
61 defsubr (&Sopaque_get);
62
63 Fprovide (Qopaque, Qnil);
64}
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 @@
1ROOT = ../..
2
3CFLAGS = `pkg-config yaml-0.1 --cflags`
4LDFLAGS = `pkg-config yaml-0.1 --libs`
5
6all: yaml.so yaml.doc
7
8%.so: %.o
9 gcc -shared $(LDFLAGS) -o $@ $<
10
11%.o: %.c
12 gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib $(CFLAGS) -fPIC -c $<
13
14%.doc: %.c
15 $(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 @@
1---
2invoice: 34843
3date : 2001-01-23
4bill-to: &id001
5 given : Chris
6 family : Dumars
7 address:
8 lines: |
9 458 Walkman Dr.
10 Suite #292
11 city : Royal Oak
12 state : MI
13 postal : 48046
14ship-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 @@
1---
2a: 1
3b: 2
4c: 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 @@
1---
2a: 1
3b:
4 - 1
5 - 2
6 - 3
7---
8foo:
9 bar: 1
10 baz: 2
11 bad: 3
12zob:
13 - 42
14 - 43
15---
16abc
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 @@
1---
2product:
3 - sku : BL394D
4 quantity : 4
5 description : Basketball
6 price : 450.00
7 - sku : BL4438H
8 quantity : 1
9 description : Super Hoop
10 price : 2392.00
11tax : 251.42
12total: 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 @@
1---
2abc
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 @@
1---
2- abc
3- def
4- ghi
5- 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 @@
1
2(defun yaml-expand-file (file)
3 (if (not (string-match-p "/" file))
4 (expand-file-name
5 (concat "~/prog/c/emacs/dyn/modules/yaml/tests/" file))
6 file))
7
8(defun yaml-test-file (file)
9 (require 'yaml)
10 (require 'json)
11 (with-current-buffer (get-buffer-create "out")
12 (erase-buffer)
13 (insert (json-encode (yaml-parse-file (yaml-expand-file file))))
14 (json-pretty-print (point-min) (point-max))))
15
16(defun yaml-test-buffer (file)
17 (require 'yaml)
18 (require 'json)
19 (with-current-buffer (get-buffer-create "out")
20 (erase-buffer)
21 (insert (json-encode (with-temp-buffer
22 (insert-file-contents (yaml-expand-file file))
23 (yaml-parse))))
24 (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 @@
1#include <stdio.h>
2#include <stdlib.h>
3#include <string.h>
4#include <yaml.h>
5
6
7#include <config.h>
8#include <lisp.h>
9
10#include <character.h> /* buffer.h needs it */
11#include <buffer.h>
12
13int plugin_is_GPL_compatible;
14static Lisp_Object Qyaml;
15
16typedef unsigned char uchar;
17
18struct context
19{
20 yaml_parser_t p;
21 int error;
22 Lisp_Object anchors; /* hashtable mapping alias to values */
23};
24
25static Lisp_Object parse_scalar (struct context *ctx, yaml_event_t *e);
26static Lisp_Object parse_sequence (struct context *ctx, yaml_event_t *e);
27static Lisp_Object parse_mapping (struct context *ctx, yaml_event_t *e);
28
29static Lisp_Object
30parse_element (struct context *ctx)
31{
32 Lisp_Object res = Qnil;
33 yaml_event_t e;
34
35 redo:
36 yaml_parser_parse (&ctx->p, &e);
37 const char *s = (char*)e.data.alias.anchor;
38
39 switch (e.type)
40 {
41 case YAML_STREAM_START_EVENT:
42 /* a stream is a sequence of documents */
43 res = parse_sequence (ctx, &e);
44 break;
45
46 case YAML_DOCUMENT_START_EVENT:
47 case YAML_DOCUMENT_END_EVENT:
48 /* keep reading */
49 yaml_event_delete (&e);
50 goto redo;
51
52 case YAML_ALIAS_EVENT:
53 res = Fgethash (make_string (s, strlen (s)), ctx->anchors, Qnil);
54 break;
55
56 case YAML_SCALAR_EVENT:
57 res = parse_scalar (ctx, &e);
58 if (s)
59 Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
60 break;
61
62 case YAML_SEQUENCE_START_EVENT:
63 res = parse_sequence (ctx, &e);
64 if (s)
65 Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
66 break;
67
68 case YAML_MAPPING_START_EVENT:
69 res = parse_mapping (ctx, &e);
70 if (s)
71 Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
72 break;
73
74 case YAML_NO_EVENT:
75 case YAML_MAPPING_END_EVENT:
76 case YAML_SEQUENCE_END_EVENT:
77 case YAML_STREAM_END_EVENT:
78 res = Qnil;
79 break;
80 }
81
82 yaml_event_delete (&e);
83 return res;
84}
85
86static Lisp_Object
87parse_scalar (struct context *ctx, yaml_event_t *e)
88{
89 return make_string ((char*)e->data.scalar.value, e->data.scalar.length);
90}
91
92static Lisp_Object
93parse_sequence (struct context *ctx, yaml_event_t *e)
94{
95 /* always >= 1 elements in sequence */
96 Lisp_Object cons = Fcons (parse_element (ctx), Qnil);
97 Lisp_Object res = cons;
98
99 while (1)
100 {
101 Lisp_Object e = parse_element (ctx);
102
103 if (NILP (e))
104 break;
105
106 XSETCDR (cons, Fcons(e, Qnil));
107 cons = XCDR (cons);
108 }
109
110 return res;
111}
112
113static Lisp_Object
114parse_mapping (struct context *ctx, yaml_event_t *e)
115{
116 Lisp_Object args[2];
117 args[0] = QCtest;
118 args[1] = Qequal;
119 Lisp_Object res = Fmake_hash_table (2, args);
120
121 while (1)
122 {
123 Lisp_Object key = parse_element (ctx);
124
125 if (NILP (key))
126 break;
127
128 Lisp_Object val = parse_element (ctx);
129
130 Fputhash (key, val, res);
131 }
132
133 return res;
134}
135
136static void
137context_init (struct context *ctx)
138{
139 memset (ctx, 0, sizeof (*ctx));
140 Lisp_Object args[2];
141 args[0] = QCtest;
142 args[1] = Qequal;
143 ctx->anchors = Fmake_hash_table (2, args);
144}
145
146EXFUN (Fyaml_parse_string, 1);
147DEFUN ("yaml-parse-string", Fyaml_parse_string, Syaml_parse_string, 1, 1, 0,
148 doc: "Parse STRING as yaml.")
149 (Lisp_Object string)
150{
151 struct context ctx;
152 Lisp_Object res = Qnil;
153
154 context_init (&ctx);
155
156 yaml_parser_initialize (&ctx.p);
157 yaml_parser_set_input_string (&ctx.p, SDATA (string), SBYTES (string));
158 res = parse_element (&ctx);
159 yaml_parser_delete (&ctx.p);
160
161 return res;
162}
163
164
165EXFUN (Fyaml_parse_buffer, 0);
166DEFUN ("yaml-parse-buffer", Fyaml_parse_buffer, Syaml_parse_buffer, 0, 0, 0,
167 doc: "Parse current buffer as yaml.")
168 (void)
169{
170 struct context ctx;
171 Lisp_Object res = Qnil;
172
173 context_init (&ctx);
174
175 yaml_parser_initialize (&ctx.p);
176 yaml_parser_set_input_string (&ctx.p, BYTE_POS_ADDR (BEGV_BYTE), ZV_BYTE - BEGV_BYTE);
177 res = parse_element (&ctx);
178 yaml_parser_delete (&ctx.p);
179
180 return res;
181}
182
183
184EXFUN (Fyaml_parse_file, 1);
185DEFUN ("yaml-parse-file", Fyaml_parse_file, Syaml_parse_file, 1, 1, 0,
186 doc: "Parse FILE as yaml.")
187 (Lisp_Object file)
188{
189 struct gcpro gcpro1;
190 struct context ctx;
191
192 context_init (&ctx);
193
194 int r;
195 FILE *fh;
196 Lisp_Object res = Qnil;
197
198 fh = fopen((char*)SDATA (file), "r");
199
200 if (!fh)
201 goto out;
202
203 r = yaml_parser_initialize (&ctx.p);
204
205 if (!r)
206 goto out_close;
207
208 yaml_parser_set_input_file (&ctx.p, fh);
209
210 GCPRO1 (ctx.anchors);
211 res = parse_element (&ctx);
212 UNGCPRO;
213
214 yaml_parser_delete (&ctx.p);
215
216 out_close:
217 fclose (fh);
218
219 out:
220 return res;
221}
222
223void init ()
224{
225 DEFSYM (Qyaml, "yaml");
226
227 defsubr (&Syaml_parse_file);
228 defsubr (&Syaml_parse_string);
229 defsubr (&Syaml_parse_buffer);
230
231 Fprovide (Qyaml, Qnil);
232}
diff --git a/src/ChangeLog b/src/ChangeLog
index 7dc2b928f1e..c344a0f9433 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,20 @@
12014-12-02 Aurélien Aptel <aurelien.aptel@gmail.com>
2
3 * lread.c (Fget_load_suffixes, Fload_module, string_suffixes_p)
4 (string_suffix_p, Fload, intern_c_string_1, defsubr)
5 (syms_of_lread): Add loading of external modules and the
6 docstrings of their functions.
7
8 * lisp.h: Make the doc field of Lisp_Subr a Lisp_Object.
9
10 * doc.c (doc_is_from_module_p, get_doc_string, reread_doc_file)
11 (store_function_docstring, build_file_p, Fsnarf_documentation):
12 Support docstrings for external modules.
13
14 * alloc.c (mark_object): Mark the doc field of Lisp_Subr as object.
15
16 * Makefile.in: Support libtool.
17
12014-12-02 Eli Zaretskii <eliz@gnu.org> 182014-12-02 Eli Zaretskii <eliz@gnu.org>
2 19
3 * bidi.c (bidi_find_first_overridden): New function. 20 * bidi.c (bidi_find_first_overridden): New function.
diff --git a/src/Makefile.in b/src/Makefile.in
index 00ac04aa836..d3468d1d1e3 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -224,6 +224,8 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
224 224
225LIBZ = @LIBZ@ 225LIBZ = @LIBZ@
226 226
227LIBLTDL = @LIBLTDL@
228
227XRANDR_LIBS = @XRANDR_LIBS@ 229XRANDR_LIBS = @XRANDR_LIBS@
228XRANDR_CFLAGS = @XRANDR_CFLAGS@ 230XRANDR_CFLAGS = @XRANDR_CFLAGS@
229 231
@@ -425,7 +427,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
425 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ 427 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
426 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ 428 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
427 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ 429 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
428 $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) 430 $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBLTDL)
429 431
430all: emacs$(EXEEXT) $(OTHER_FILES) 432all: emacs$(EXEEXT) $(OTHER_FILES)
431.PHONY: all 433.PHONY: all
diff --git a/src/alloc.c b/src/alloc.c
index 1019c2af6cc..f15b978d52d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6348,6 +6348,7 @@ mark_object (Lisp_Object arg)
6348 break; 6348 break;
6349 6349
6350 case PVEC_SUBR: 6350 case PVEC_SUBR:
6351 mark_object (XSUBR (obj)->doc);
6351 break; 6352 break;
6352 6353
6353 case PVEC_FREE: 6354 case PVEC_FREE:
diff --git a/src/doc.c b/src/doc.c
index 1b87c23e949..5290b5d277a 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -56,6 +56,15 @@ read_bytecode_char (bool unreadflag)
56 return *read_bytecode_pointer++; 56 return *read_bytecode_pointer++;
57} 57}
58 58
59/* A module doc file must have a doc extension */
60static bool
61doc_is_from_module_p (const char* path)
62{
63 int len = strlen (path);
64 return len > 4 && (strcmp (path + len - 4, ".doc") == 0
65 || (strcmp (path + len - 4, ".DOC") == 0));
66}
67
59/* Extract a doc string from a file. FILEPOS says where to get it. 68/* Extract a doc string from a file. FILEPOS says where to get it.
60 If it is an integer, use that position in the standard DOC file. 69 If it is an integer, use that position in the standard DOC file.
61 If it is (FILE . INTEGER), use FILE as the file name 70 If it is (FILE . INTEGER), use FILE as the file name
@@ -109,11 +118,11 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
109 return Qnil; 118 return Qnil;
110 119
111 /* Put the file name in NAME as a C string. 120 /* Put the file name in NAME as a C string.
112 If it is relative, combine it with Vdoc_directory. */ 121 If it is relative and not from a module, combine it with Vdoc_directory. */
113 122
114 tem = Ffile_name_absolute_p (file); 123 tem = Ffile_name_absolute_p (file);
115 file = ENCODE_FILE (file); 124 file = ENCODE_FILE (file);
116 if (NILP (tem)) 125 if (NILP (tem) && !doc_is_from_module_p (SSDATA (file)))
117 { 126 {
118 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory); 127 Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
119 minsize = SCHARS (docdir); 128 minsize = SCHARS (docdir);
@@ -211,7 +220,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
211 SAFE_FREE (); 220 SAFE_FREE ();
212 221
213 /* Sanity checking. */ 222 /* Sanity checking. */
214 if (CONSP (filepos)) 223 if (CONSP (filepos) && !doc_is_from_module_p (name))
215 { 224 {
216 int test = 1; 225 int test = 1;
217 /* A dynamic docstring should be either at the very beginning of a "#@ 226 /* A dynamic docstring should be either at the very beginning of a "#@
@@ -321,7 +330,7 @@ reread_doc_file (Lisp_Object file)
321#endif 330#endif
322 331
323 if (NILP (file)) 332 if (NILP (file))
324 Fsnarf_documentation (Vdoc_file_name); 333 Fsnarf_documentation (Vdoc_file_name, Qnil);
325 else 334 else
326 Fload (file, Qt, Qt, Qt, Qnil); 335 Fload (file, Qt, Qt, Qt, Qnil);
327 336
@@ -356,14 +365,16 @@ string is passed through `substitute-command-keys'. */)
356 fun = XCDR (fun); 365 fun = XCDR (fun);
357 if (SUBRP (fun)) 366 if (SUBRP (fun))
358 { 367 {
359 if (XSUBR (fun)->doc == 0) 368 Lisp_Object subrdoc = XSUBR (fun)->doc;
360 return Qnil; 369
361 /* FIXME: This is not portable, as it assumes that string 370 if (NILP (subrdoc))
362 pointers have the top bit clear. */ 371 return Qnil;
363 else if ((intptr_t) XSUBR (fun)->doc >= 0) 372 else if (STRINGP (subrdoc))
364 doc = build_string (XSUBR (fun)->doc); 373 return subrdoc;
374 else if (INTEGERP (subrdoc) || CONSP (subrdoc))
375 doc = subrdoc;
365 else 376 else
366 doc = make_number ((intptr_t) XSUBR (fun)->doc); 377 error ("invalid value in subr doc field");
367 } 378 }
368 else if (COMPILEDP (fun)) 379 else if (COMPILEDP (fun))
369 { 380 {
@@ -495,7 +506,7 @@ aren't strings. */)
495/* Scanning the DOC files and placing docstring offsets into functions. */ 506/* Scanning the DOC files and placing docstring offsets into functions. */
496 507
497static void 508static void
498store_function_docstring (Lisp_Object obj, ptrdiff_t offset) 509store_function_docstring (Lisp_Object obj, Lisp_Object filename, ptrdiff_t offset, bool module)
499{ 510{
500 /* Don't use indirect_function here, or defaliases will apply their 511 /* Don't use indirect_function here, or defaliases will apply their
501 docstrings to the base functions (Bug#2603). */ 512 docstrings to the base functions (Bug#2603). */
@@ -506,8 +517,8 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
506 /* Lisp_Subrs have a slot for it. */ 517 /* Lisp_Subrs have a slot for it. */
507 if (SUBRP (fun)) 518 if (SUBRP (fun))
508 { 519 {
509 intptr_t negative_offset = - offset; 520 Lisp_Object neg = make_number (-offset); /* XXX: no sure why.. */
510 XSUBR (fun)->doc = (char *) negative_offset; 521 XSUBR (fun)->doc = module ? Fcons (filename, neg) : neg;
511 } 522 }
512 523
513 /* If it's a lisp form, stick it in the form. */ 524 /* If it's a lisp form, stick it in the form. */
@@ -526,7 +537,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
526 XSETCAR (tem, make_number (offset)); 537 XSETCAR (tem, make_number (offset));
527 } 538 }
528 else if (EQ (tem, Qmacro)) 539 else if (EQ (tem, Qmacro))
529 store_function_docstring (XCDR (fun), offset); 540 store_function_docstring (XCDR (fun), filename, offset, module);
530 } 541 }
531 542
532 /* Bytecode objects sometimes have slots for it. */ 543 /* Bytecode objects sometimes have slots for it. */
@@ -542,9 +553,24 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
542 } 553 }
543} 554}
544 555
556static bool
557build_file_p (const char* file, ptrdiff_t len)
558{
559 /* file can be longer than len, can't use xstrdup */
560 char *ofile = xmalloc (len + 1);
561 memcpy (ofile, file, len);
562 ofile[len] = 0;
563
564 if (ofile[len-1] == 'c')
565 ofile[len-1] = 'o';
566
567 bool res = NILP (Fmember (build_string (ofile), Vbuild_files));
568 xfree (ofile);
569 return res;
570}
545 571
546DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, 572DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
547 1, 1, 0, 573 1, 2, 0,
548 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file. 574 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
549This searches the `etc/DOC...' file for doc strings and 575This searches the `etc/DOC...' file for doc strings and
550records them in function and variable definitions. 576records them in function and variable definitions.
@@ -552,7 +578,7 @@ The function takes one argument, FILENAME, a string;
552it specifies the file name (without a directory) of the DOC file. 578it specifies the file name (without a directory) of the DOC file.
553That file is found in `../etc' now; later, when the dumped Emacs is run, 579That file is found in `../etc' now; later, when the dumped Emacs is run,
554the same file name is found in the `doc-directory'. */) 580the same file name is found in the `doc-directory'. */)
555 (Lisp_Object filename) 581 (Lisp_Object filename, Lisp_Object module)
556{ 582{
557 int fd; 583 int fd;
558 char buf[1024 + 1]; 584 char buf[1024 + 1];
@@ -573,22 +599,48 @@ the same file name is found in the `doc-directory'. */)
573 599
574 CHECK_STRING (filename); 600 CHECK_STRING (filename);
575 601
576 if 602 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
603 if (NILP (Vbuild_files))
604 {
605 static char const *const buildobj[] =
606 {
607 #include "buildobj.h"
608 };
609 int i = ARRAYELTS (buildobj);
610 while (0 <= --i)
611 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
612 Vbuild_files = Fpurecopy (Vbuild_files);
613 }
614
615 if (NILP (module))
616 {
617 /* If we're not processing a module doc, the doc file becomes
618 the "global" DOC file */
619 Vdoc_file_name = filename;
620
621 if
577#ifndef CANNOT_DUMP 622#ifndef CANNOT_DUMP
578 (!NILP (Vpurify_flag)) 623 (!NILP (Vpurify_flag))
579#else /* CANNOT_DUMP */ 624#else /* CANNOT_DUMP */
580 (0) 625 (0)
581#endif /* CANNOT_DUMP */ 626#endif /* CANNOT_DUMP */
582 { 627 {
583 static char const sibling_etc[] = "../etc/"; 628 static char const sibling_etc[] = "../etc/";
584 dirname = sibling_etc; 629 dirname = sibling_etc;
585 dirlen = sizeof sibling_etc - 1; 630 dirlen = sizeof sibling_etc - 1;
631 }
632 else
633 {
634 CHECK_STRING (Vdoc_directory);
635 dirname = SSDATA (Vdoc_directory);
636 dirlen = SBYTES (Vdoc_directory);
637 }
586 } 638 }
587 else 639 else
588 { 640 {
589 CHECK_STRING (Vdoc_directory); 641 static char const empty_prefix_dir[] = "";
590 dirname = SSDATA (Vdoc_directory); 642 dirname = empty_prefix_dir;
591 dirlen = SBYTES (Vdoc_directory); 643 dirlen = 0;
592 } 644 }
593 645
594 count = SPECPDL_INDEX (); 646 count = SPECPDL_INDEX ();
@@ -597,18 +649,6 @@ the same file name is found in the `doc-directory'. */)
597 strcpy (name, dirname); 649 strcpy (name, dirname);
598 strcat (name, SSDATA (filename)); /*** Add this line ***/ 650 strcat (name, SSDATA (filename)); /*** Add this line ***/
599 651
600 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
601 if (NILP (Vbuild_files))
602 {
603 static char const *const buildobj[] =
604 {
605 #include "buildobj.h"
606 };
607 int i = ARRAYELTS (buildobj);
608 while (0 <= --i)
609 Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
610 Vbuild_files = Fpurecopy (Vbuild_files);
611 }
612 652
613 fd = emacs_open (name, O_RDONLY, 0); 653 fd = emacs_open (name, O_RDONLY, 0);
614 if (fd < 0) 654 if (fd < 0)
@@ -618,7 +658,6 @@ the same file name is found in the `doc-directory'. */)
618 open_errno); 658 open_errno);
619 } 659 }
620 record_unwind_protect_int (close_file_unwind, fd); 660 record_unwind_protect_int (close_file_unwind, fd);
621 Vdoc_file_name = filename;
622 filled = 0; 661 filled = 0;
623 pos = 0; 662 pos = 0;
624 while (1) 663 while (1)
@@ -641,18 +680,13 @@ the same file name is found in the `doc-directory'. */)
641 if (p[1] == 'S') 680 if (p[1] == 'S')
642 { 681 {
643 skip_file = 0; 682 skip_file = 0;
644 if (end - p > 4 && end[-2] == '.' 683 if (NILP (module)
645 && (end[-1] == 'o' || end[-1] == 'c')) 684 && end - p > 4
685 && end[-2] == '.'
686 && (end[-1] == 'o' || end[-1] == 'c')
687 && build_file_p (&p[2], end - p - 2))
646 { 688 {
647 ptrdiff_t len = end - p - 2; 689 skip_file = 1;
648 char *fromfile = SAFE_ALLOCA (len + 1);
649 memcpy (fromfile, &p[2], len);
650 fromfile[len] = 0;
651 if (fromfile[len-1] == 'c')
652 fromfile[len-1] = 'o';
653
654 skip_file = NILP (Fmember (build_string (fromfile),
655 Vbuild_files));
656 } 690 }
657 } 691 }
658 692
@@ -672,6 +706,7 @@ the same file name is found in the `doc-directory'. */)
672 /* Install file-position as variable-documentation property 706 /* Install file-position as variable-documentation property
673 and make it negative for a user-variable 707 and make it negative for a user-variable
674 (doc starts with a `*'). */ 708 (doc starts with a `*'). */
709 /* TODO: handle module var */
675 if (!NILP (Fboundp (sym)) 710 if (!NILP (Fboundp (sym))
676 || !NILP (Fmemq (sym, delayed_init))) 711 || !NILP (Fmemq (sym, delayed_init)))
677 Fput (sym, Qvariable_documentation, 712 Fput (sym, Qvariable_documentation,
@@ -683,7 +718,7 @@ the same file name is found in the `doc-directory'. */)
683 else if (p[1] == 'F') 718 else if (p[1] == 'F')
684 { 719 {
685 if (!NILP (Ffboundp (sym))) 720 if (!NILP (Ffboundp (sym)))
686 store_function_docstring (sym, pos + end + 1 - buf); 721 store_function_docstring (sym, filename, pos + end + 1 - buf, !NILP (module));
687 } 722 }
688 else if (p[1] == 'S') 723 else if (p[1] == 'S')
689 ; /* Just a source file name boundary marker. Ignore it. */ 724 ; /* Just a source file name boundary marker. Ignore it. */
diff --git a/src/lisp.h b/src/lisp.h
index a56c4a73bf8..dc855f5e2bf 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1513,7 +1513,7 @@ struct Lisp_Subr
1513 short min_args, max_args; 1513 short min_args, max_args;
1514 const char *symbol_name; 1514 const char *symbol_name;
1515 const char *intspec; 1515 const char *intspec;
1516 const char *doc; 1516 Lisp_Object doc;
1517 }; 1517 };
1518 1518
1519enum char_table_specials 1519enum char_table_specials
diff --git a/src/lread.c b/src/lread.c
index 6f71ff5f468..3a2c29a616b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -64,6 +64,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
64#define file_tell ftell 64#define file_tell ftell
65#endif 65#endif
66 66
67#ifdef HAVE_LTDL
68#include <ltdl.h>
69#endif
70
67/* Hash table read constants. */ 71/* Hash table read constants. */
68static Lisp_Object Qhash_table, Qdata; 72static Lisp_Object Qhash_table, Qdata;
69static Lisp_Object Qtest; 73static Lisp_Object Qtest;
@@ -982,7 +986,15 @@ required.
982This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) 986This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
983 (void) 987 (void)
984{ 988{
985 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; 989 Lisp_Object lst = Qnil, suffixes, suffix, ext;
990
991 /* module suffixes, then regular elisp suffixes */
992
993 Lisp_Object args[2];
994 args[0] = Vload_module_suffixes;
995 args[1] = Vload_suffixes;
996 suffixes = Fappend (2, args);
997
986 while (CONSP (suffixes)) 998 while (CONSP (suffixes))
987 { 999 {
988 Lisp_Object exts = Vload_file_rep_suffixes; 1000 Lisp_Object exts = Vload_file_rep_suffixes;
@@ -998,6 +1010,86 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
998 return Fnreverse (lst); 1010 return Fnreverse (lst);
999} 1011}
1000 1012
1013DEFUN ("load-module", Fload_module, Sload_module, 1, 1, 0,
1014 doc: /* Dymamically load a compiled module. */)
1015 (Lisp_Object file)
1016{
1017#ifdef HAVE_LTDL
1018 static int lt_init_done = 0;
1019 lt_dlhandle handle;
1020 void (*module_init) ();
1021 void *gpl_sym;
1022 Lisp_Object doc_name, args[2];
1023
1024 /* init libtool once per emacs process */
1025 if (!lt_init_done)
1026 {
1027 int ret = lt_dlinit ();
1028 if (ret)
1029 {
1030 const char* s = lt_dlerror ();
1031 error ("ltdl init fail: %s", s);
1032 }
1033 lt_init_done = 1;
1034 }
1035
1036 CHECK_STRING (file);
1037
1038 handle = lt_dlopen (SDATA (file));
1039 if (!handle)
1040 error ("Cannot load file %s", SDATA (file));
1041
1042 gpl_sym = lt_dlsym (handle, "plugin_is_GPL_compatible");
1043 if (!gpl_sym)
1044 error ("Module %s is not GPL compatible", SDATA (file));
1045
1046 module_init = (void (*) ()) lt_dlsym (handle, "init");
1047 if (!module_init)
1048 error ("Module %s does not have an init function.", SDATA (file));
1049
1050 module_init ();
1051
1052 /* build doc file path and install it */
1053 args[0] = Fsubstring (file, make_number (0), make_number (-3));
1054 args[1] = build_string (".doc");
1055 doc_name = Fconcat (2, args);
1056 Fsnarf_documentation (doc_name, Qt);
1057
1058 return Qt;
1059#else
1060 return Qnil;
1061#endif
1062}
1063
1064
1065/* Return true if STRING ends with SUFFIX. */
1066static bool string_suffix_p (Lisp_Object string, const char *suffix)
1067{
1068 const ptrdiff_t len = strlen (suffix);
1069 return memcmp (SDATA (string) + SBYTES (string) - len, suffix, len) == 0;
1070}
1071
1072/* Return true if STRING ends with any element of SUFFIXES. */
1073static bool string_suffixes_p (Lisp_Object string, Lisp_Object suffixes)
1074{
1075 ptrdiff_t length = SBYTES (string), suflen;
1076 Lisp_Object tail, suffix;
1077
1078 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1079 {
1080 suffix = XCAR (tail);
1081 suflen = SBYTES (suffix);
1082
1083 if (suflen <= length)
1084 {
1085 if (memcmp (SDATA (string) + length - suflen, SDATA (suffix), suflen) == 0)
1086 return true;
1087 }
1088 }
1089
1090 return false;
1091}
1092
1001DEFUN ("load", Fload, Sload, 1, 5, 0, 1093DEFUN ("load", Fload, Sload, 1, 5, 0,
1002 doc: /* Execute a file of Lisp code named FILE. 1094 doc: /* Execute a file of Lisp code named FILE.
1003First try FILE with `.elc' appended, then try with `.el', 1095First try FILE with `.elc' appended, then try with `.el',
@@ -1055,6 +1147,8 @@ Return t if the file exists and loads successfully. */)
1055 bool newer = 0; 1147 bool newer = 0;
1056 /* True means we are loading a compiled file. */ 1148 /* True means we are loading a compiled file. */
1057 bool compiled = 0; 1149 bool compiled = 0;
1150 /* True means we are loading a dynamic module. */
1151 bool module = 0;
1058 Lisp_Object handler; 1152 Lisp_Object handler;
1059 bool safe_p = 1; 1153 bool safe_p = 1;
1060 const char *fmode = "r"; 1154 const char *fmode = "r";
@@ -1105,18 +1199,14 @@ Return t if the file exists and loads successfully. */)
1105 1199
1106 if (! NILP (must_suffix)) 1200 if (! NILP (must_suffix))
1107 { 1201 {
1108 /* Don't insist on adding a suffix if FILE already ends with one. */ 1202 /* Don't insist on adding a suffix if FILE already ends with
1109 ptrdiff_t size = SBYTES (file); 1203 one or if FILE includes a directory name. */
1110 if (size > 3 1204 if (string_suffixes_p (file, Vload_module_suffixes)
1111 && !strcmp (SSDATA (file) + size - 3, ".el")) 1205 || string_suffixes_p (file, Vload_suffixes)
1112 must_suffix = Qnil; 1206 || ! NILP (Ffile_name_directory (file)))
1113 else if (size > 4 1207 {
1114 && !strcmp (SSDATA (file) + size - 4, ".elc")) 1208 must_suffix = Qnil;
1115 must_suffix = Qnil; 1209 }
1116 /* Don't insist on adding a suffix
1117 if the argument includes a directory name. */
1118 else if (! NILP (Ffile_name_directory (file)))
1119 must_suffix = Qnil;
1120 } 1210 }
1121 1211
1122 if (!NILP (nosuffix)) 1212 if (!NILP (nosuffix))
@@ -1227,7 +1317,7 @@ Return t if the file exists and loads successfully. */)
1227 specbind (Qold_style_backquotes, Qnil); 1317 specbind (Qold_style_backquotes, Qnil);
1228 record_unwind_protect (load_warn_old_style_backquotes, file); 1318 record_unwind_protect (load_warn_old_style_backquotes, file);
1229 1319
1230 if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4) 1320 if (string_suffix_p (found, ".elc")
1231 || (fd >= 0 && (version = safe_to_load_version (fd)) > 0)) 1321 || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
1232 /* Load .elc files directly, but not when they are 1322 /* Load .elc files directly, but not when they are
1233 remote and have no handler! */ 1323 remote and have no handler! */
@@ -1289,6 +1379,12 @@ Return t if the file exists and loads successfully. */)
1289 UNGCPRO; 1379 UNGCPRO;
1290 } 1380 }
1291 } 1381 }
1382#ifdef HAVE_LTDL
1383 else if (string_suffixes_p (found, Vload_module_suffixes))
1384 {
1385 module = 1;
1386 }
1387#endif
1292 else 1388 else
1293 { 1389 {
1294 /* We are loading a source file (*.el). */ 1390 /* We are loading a source file (*.el). */
@@ -1338,7 +1434,9 @@ Return t if the file exists and loads successfully. */)
1338 1434
1339 if (NILP (nomessage) || force_load_messages) 1435 if (NILP (nomessage) || force_load_messages)
1340 { 1436 {
1341 if (!safe_p) 1437 if (module)
1438 message_with_string ("Loading %s (dymamic module)...", file, 1);
1439 else if (!safe_p)
1342 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...", 1440 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1343 file, 1); 1441 file, 1);
1344 else if (!compiled) 1442 else if (!compiled)
@@ -1358,7 +1456,14 @@ Return t if the file exists and loads successfully. */)
1358 if (lisp_file_lexically_bound_p (Qget_file_char)) 1456 if (lisp_file_lexically_bound_p (Qget_file_char))
1359 Fset (Qlexical_binding, Qt); 1457 Fset (Qlexical_binding, Qt);
1360 1458
1361 if (! version || version >= 22) 1459#ifdef HAVE_LTDL
1460 if (module)
1461 {
1462 /* XXX: should the fd/stream be closed before loading the module? */
1463 Fload_module (found);
1464 }
1465#endif
1466 else if (! version || version >= 22)
1362 readevalloop (Qget_file_char, stream, hist_file_name, 1467 readevalloop (Qget_file_char, stream, hist_file_name,
1363 0, Qnil, Qnil, Qnil, Qnil); 1468 0, Qnil, Qnil, Qnil, Qnil);
1364 else 1469 else
@@ -1387,7 +1492,9 @@ Return t if the file exists and loads successfully. */)
1387 1492
1388 if (!noninteractive && (NILP (nomessage) || force_load_messages)) 1493 if (!noninteractive && (NILP (nomessage) || force_load_messages))
1389 { 1494 {
1390 if (!safe_p) 1495 if (module)
1496 message_with_string ("Loading %s (dymamic module)...done", file, 1);
1497 else if (!safe_p)
1391 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done", 1498 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1392 file, 1); 1499 file, 1);
1393 else if (!compiled) 1500 else if (!compiled)
@@ -3837,9 +3944,6 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
3837 3944
3838 if (!SYMBOLP (tem)) 3945 if (!SYMBOLP (tem))
3839 { 3946 {
3840 /* Creating a non-pure string from a string literal not implemented yet.
3841 We could just use make_string here and live with the extra copy. */
3842 eassert (!NILP (Vpurify_flag));
3843 tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem)); 3947 tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem));
3844 } 3948 }
3845 return tem; 3949 return tem;
@@ -4094,6 +4198,7 @@ void
4094defsubr (struct Lisp_Subr *sname) 4198defsubr (struct Lisp_Subr *sname)
4095{ 4199{
4096 Lisp_Object sym, tem; 4200 Lisp_Object sym, tem;
4201 sname->doc = Qnil;
4097 sym = intern_c_string (sname->symbol_name); 4202 sym = intern_c_string (sname->symbol_name);
4098 XSETPVECTYPE (sname, PVEC_SUBR); 4203 XSETPVECTYPE (sname, PVEC_SUBR);
4099 XSETSUBR (tem, sname); 4204 XSETSUBR (tem, sname);
@@ -4491,6 +4596,7 @@ syms_of_lread (void)
4491 defsubr (&Sget_file_char); 4596 defsubr (&Sget_file_char);
4492 defsubr (&Smapatoms); 4597 defsubr (&Smapatoms);
4493 defsubr (&Slocate_file_internal); 4598 defsubr (&Slocate_file_internal);
4599 defsubr (&Sload_module);
4494 4600
4495 DEFVAR_LISP ("obarray", Vobarray, 4601 DEFVAR_LISP ("obarray", Vobarray,
4496 doc: /* Symbol table for use by `intern' and `read'. 4602 doc: /* Symbol table for use by `intern' and `read'.
@@ -4551,8 +4657,22 @@ Initialized during startup as described in Info node `(elisp)Library Search'. *
4551This list should not include the empty string. 4657This list should not include the empty string.
4552`load' and related functions try to append these suffixes, in order, 4658`load' and related functions try to append these suffixes, in order,
4553to the specified file name if a Lisp suffix is allowed or required. */); 4659to the specified file name if a Lisp suffix is allowed or required. */);
4660
4554 Vload_suffixes = list2 (build_pure_c_string (".elc"), 4661 Vload_suffixes = list2 (build_pure_c_string (".elc"),
4555 build_pure_c_string (".el")); 4662 build_pure_c_string (".el"));
4663
4664 DEFVAR_LISP ("load-module-suffixes", Vload_module_suffixes,
4665 doc: /* List of suffixes for modules files.
4666This list should not include the empty string. See `load-suffixes'. */);
4667
4668#ifdef HAVE_LTDL
4669 Vload_module_suffixes = list3 (build_pure_c_string (".dll"),
4670 build_pure_c_string (".so"),
4671 build_pure_c_string (".dylib"));
4672#else
4673 Vload_module_suffixes = Qnil;
4674#endif
4675
4556 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes, 4676 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
4557 doc: /* List of suffixes that indicate representations of \ 4677 doc: /* List of suffixes that indicate representations of \
4558the same file. 4678the same file.