[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] dynamic-modules-rc2 ae901dd: Add external modules
|
From: |
Teodor Zlatanov |
|
Subject: |
[Emacs-diffs] dynamic-modules-rc2 ae901dd: Add external modules |
|
Date: |
Fri, 05 Dec 2014 01:01:25 +0000 |
branch: dynamic-modules-rc2
commit ae901ddbfff04e8b1b0d63c452a6ca3f4c81fb17
Author: Aurélien Aptel <address@hidden>
Commit: Ted Zlatanov <address@hidden>
Add external modules
* 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.
---
ChangeLog | 4 +
configure.ac | 23 ++++-
modules/.gitignore | 2 +
modules/ChangeLog | 11 ++
modules/curl/Makefile.in | 15 +++
modules/curl/curl.c | 118 +++++++++++++++++++++
modules/elisp/Makefile.in | 12 ++
modules/elisp/elisp.c | 38 +++++++
modules/fmod/Makefile.in | 12 ++
modules/fmod/fmod.c | 60 +++++++++++
modules/opaque/Makefile.in | 12 ++
modules/opaque/opaque.c | 64 +++++++++++
modules/yaml/Makefile.in | 15 +++
modules/yaml/tests/alias.yaml | 14 +++
modules/yaml/tests/map.yaml | 4 +
modules/yaml/tests/multi.yaml | 16 +++
modules/yaml/tests/nest.yaml | 12 ++
modules/yaml/tests/scal.yaml | 2 +
modules/yaml/tests/seq.yaml | 5 +
modules/yaml/yaml-test.el | 24 ++++
modules/yaml/yaml.c | 232 +++++++++++++++++++++++++++++++++++++++++
src/ChangeLog | 17 +++
src/Makefile.in | 4 +-
src/alloc.c | 1 +
src/doc.c | 139 +++++++++++++++---------
src/lisp.h | 2 +-
src/lread.c | 162 +++++++++++++++++++++++++----
27 files changed, 942 insertions(+), 78 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index cd7698c..2152f9e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2014-12-02 Aurélien Aptel <address@hidden>
+
+ * configure.ac: Add libtool support and module Makefiles.
+
2014-12-01 Lars Magne Ingebrigtsen <address@hidden>
* .gitignore: Ignore loaddefs directly under lisp, and in
diff --git a/configure.ac b/configure.ac
index 010abc8..f9fee9d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -355,6 +355,8 @@ OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings
support])
OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
+OPTION_DEFAULT_OFF([ltdl], [compile with dynamic module loading support])
+
AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
[use a file notification library (LIB one of: yes, gfile, inotify, w32,
no)])],
@@ -3179,6 +3181,18 @@ if test "${HAVE_ZLIB}" = "yes"; then
fi
AC_SUBST(LIBZ)
+HAVE_LTDL=no
+LIBLTDL=
+if test "${with_ltdl}" != "no"; then
+ AC_CHECK_HEADER(ltdl.h, HAVE_LTDL=yes, HAVE_LTDL=no)
+ AC_CHECK_LIB(ltdl, lt_dlopen, HAVE_LTDL=yes, HAVE_LTDL=no)
+fi
+if test "${HAVE_LTDL}" = "yes"; then
+ AC_DEFINE(HAVE_LTDL, 1, [Define to 1 if you have the ltdl library (-lltdl).])
+ LIBLTDL="-lltdl -Wl,--export-dynamic"
+fi
+AC_SUBST(LIBLTDL)
+
### Use -lpng if available, unless `--with-png=no'.
HAVE_PNG=no
LIBPNG=
@@ -5049,7 +5063,7 @@ optsep=
emacs_config_features=
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS \
GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
- LIBOTF XFT ZLIB; do
+ LIBOTF XFT ZLIB LTDL; do
case $opt in
NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;;
@@ -5088,6 +5102,7 @@ echo " Does Emacs use -lm17n-flt?
${HAVE_M17N_FLT}
echo " Does Emacs use -lotf? ${HAVE_LIBOTF}"
echo " Does Emacs use -lxft? ${HAVE_XFT}"
echo " Does Emacs directly use zlib? ${HAVE_ZLIB}"
+echo " Does Emacs use -lltdl? ${HAVE_LTDL}"
echo " Does Emacs use toolkit scroll bars?
${USE_TOOLKIT_SCROLL_BARS}"
echo
@@ -5154,12 +5169,14 @@ dnl This will work, but you get a config.status that is
not quite right
dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html).
dnl That doesn't have any obvious consequences for Emacs, but on the whole
dnl it seems better to just live with the duplication.
-SUBDIR_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"
+SUBDIR_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"
AC_CONFIG_FILES([Makefile 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])
+ leim/Makefile \
+ modules/curl/Makefile modules/elisp/Makefile modules/fmod/Makefile
modules/yaml/Makefile \
+ nextstep/Makefile nt/Makefile])
dnl test/ is not present in release tarfiles.
opt_makefile=test/automated/Makefile
diff --git a/modules/.gitignore b/modules/.gitignore
new file mode 100644
index 0000000..fc15e0a
--- /dev/null
+++ b/modules/.gitignore
@@ -0,0 +1,2 @@
+*/*.doc
+*/*.so
diff --git a/modules/ChangeLog b/modules/ChangeLog
new file mode 100644
index 0000000..180d48e
--- /dev/null
+++ b/modules/ChangeLog
@@ -0,0 +1,11 @@
+2014-12-02 Aurélien Aptel <address@hidden>
+
+ * 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 0000000..2e7fda0
--- /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 0000000..b8b2bb6
--- /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 0000000..8df325e
--- /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 0000000..aabb24e
--- /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 0000000..ad9016a
--- /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 0000000..57da616
--- /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 0000000..7f50732
--- /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 0000000..2366b2e
--- /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 0000000..32f61e9
--- /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 0000000..c3dade3
--- /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 0000000..4021d74
--- /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 0000000..1eb61f7
--- /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 0000000..8a453df
--- /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 0000000..aecd198
--- /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 0000000..15b6a9e
--- /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 0000000..5f9b5c0
--- /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 0000000..3ff1334
--- /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);
+}
diff --git a/src/ChangeLog b/src/ChangeLog
index 7dc2b92..c344a0f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,20 @@
+2014-12-02 Aurélien Aptel <address@hidden>
+
+ * 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.
+
+ * lisp.h: Make the doc field of Lisp_Subr a Lisp_Object.
+
+ * 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.
+
+ * alloc.c (mark_object): Mark the doc field of Lisp_Subr as object.
+
+ * Makefile.in: Support libtool.
+
2014-12-02 Eli Zaretskii <address@hidden>
* bidi.c (bidi_find_first_overridden): New function.
diff --git a/src/Makefile.in b/src/Makefile.in
index 00ac04a..d3468d1 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -224,6 +224,8 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
LIBZ = @LIBZ@
+LIBLTDL = @LIBLTDL@
+
XRANDR_LIBS = @XRANDR_LIBS@
XRANDR_CFLAGS = @XRANDR_CFLAGS@
@@ -425,7 +427,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE)
$(LIBIMAGE) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
- $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ)
+ $(GFILENOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBLTDL)
all: emacs$(EXEEXT) $(OTHER_FILES)
.PHONY: all
diff --git a/src/alloc.c b/src/alloc.c
index 1019c2a..f15b978 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6348,6 +6348,7 @@ mark_object (Lisp_Object arg)
break;
case PVEC_SUBR:
+ mark_object (XSUBR (obj)->doc);
break;
case PVEC_FREE:
diff --git a/src/doc.c b/src/doc.c
index 1b87c23..5290b5d 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -56,6 +56,15 @@ read_bytecode_char (bool unreadflag)
return *read_bytecode_pointer++;
}
+/* A module doc file must have a doc extension */
+static bool
+doc_is_from_module_p (const char* path)
+{
+ int len = strlen (path);
+ return len > 4 && (strcmp (path + len - 4, ".doc") == 0
+ || (strcmp (path + len - 4, ".DOC") == 0));
+}
+
/* Extract a doc string from a file. FILEPOS says where to get it.
If it is an integer, use that position in the standard DOC file.
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)
return Qnil;
/* Put the file name in NAME as a C string.
- If it is relative, combine it with Vdoc_directory. */
+ If it is relative and not from a module, combine it with Vdoc_directory.
*/
tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
- if (NILP (tem))
+ if (NILP (tem) && !doc_is_from_module_p (SSDATA (file)))
{
Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
minsize = SCHARS (docdir);
@@ -211,7 +220,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool
definition)
SAFE_FREE ();
/* Sanity checking. */
- if (CONSP (filepos))
+ if (CONSP (filepos) && !doc_is_from_module_p (name))
{
int test = 1;
/* A dynamic docstring should be either at the very beginning of a "#@
@@ -321,7 +330,7 @@ reread_doc_file (Lisp_Object file)
#endif
if (NILP (file))
- Fsnarf_documentation (Vdoc_file_name);
+ Fsnarf_documentation (Vdoc_file_name, Qnil);
else
Fload (file, Qt, Qt, Qt, Qnil);
@@ -356,14 +365,16 @@ string is passed through `substitute-command-keys'. */)
fun = XCDR (fun);
if (SUBRP (fun))
{
- if (XSUBR (fun)->doc == 0)
- return Qnil;
- /* FIXME: This is not portable, as it assumes that string
- pointers have the top bit clear. */
- else if ((intptr_t) XSUBR (fun)->doc >= 0)
- doc = build_string (XSUBR (fun)->doc);
+ Lisp_Object subrdoc = XSUBR (fun)->doc;
+
+ if (NILP (subrdoc))
+ return Qnil;
+ else if (STRINGP (subrdoc))
+ return subrdoc;
+ else if (INTEGERP (subrdoc) || CONSP (subrdoc))
+ doc = subrdoc;
else
- doc = make_number ((intptr_t) XSUBR (fun)->doc);
+ error ("invalid value in subr doc field");
}
else if (COMPILEDP (fun))
{
@@ -495,7 +506,7 @@ aren't strings. */)
/* Scanning the DOC files and placing docstring offsets into functions. */
static void
-store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
+store_function_docstring (Lisp_Object obj, Lisp_Object filename, ptrdiff_t
offset, bool module)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
@@ -506,8 +517,8 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
- intptr_t negative_offset = - offset;
- XSUBR (fun)->doc = (char *) negative_offset;
+ Lisp_Object neg = make_number (-offset); /* XXX: no sure why.. */
+ XSUBR (fun)->doc = module ? Fcons (filename, neg) : neg;
}
/* If it's a lisp form, stick it in the form. */
@@ -526,7 +537,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
- store_function_docstring (XCDR (fun), offset);
+ store_function_docstring (XCDR (fun), filename, offset, module);
}
/* Bytecode objects sometimes have slots for it. */
@@ -542,9 +553,24 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t
offset)
}
}
+static bool
+build_file_p (const char* file, ptrdiff_t len)
+{
+ /* file can be longer than len, can't use xstrdup */
+ char *ofile = xmalloc (len + 1);
+ memcpy (ofile, file, len);
+ ofile[len] = 0;
+
+ if (ofile[len-1] == 'c')
+ ofile[len-1] = 'o';
+
+ bool res = NILP (Fmember (build_string (ofile), Vbuild_files));
+ xfree (ofile);
+ return res;
+}
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
- 1, 1, 0,
+ 1, 2, 0,
doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
This searches the `etc/DOC...' file for doc strings and
records them in function and variable definitions.
@@ -552,7 +578,7 @@ The function takes one argument, FILENAME, a string;
it specifies the file name (without a directory) of the DOC file.
That file is found in `../etc' now; later, when the dumped Emacs is run,
the same file name is found in the `doc-directory'. */)
- (Lisp_Object filename)
+ (Lisp_Object filename, Lisp_Object module)
{
int fd;
char buf[1024 + 1];
@@ -573,22 +599,48 @@ the same file name is found in the `doc-directory'. */)
CHECK_STRING (filename);
- if
+ /* Vbuild_files is nil when temacs is run, and non-nil after that. */
+ if (NILP (Vbuild_files))
+ {
+ static char const *const buildobj[] =
+ {
+ #include "buildobj.h"
+ };
+ int i = ARRAYELTS (buildobj);
+ while (0 <= --i)
+ Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
+ Vbuild_files = Fpurecopy (Vbuild_files);
+ }
+
+ if (NILP (module))
+ {
+ /* If we're not processing a module doc, the doc file becomes
+ the "global" DOC file */
+ Vdoc_file_name = filename;
+
+ if
#ifndef CANNOT_DUMP
- (!NILP (Vpurify_flag))
+ (!NILP (Vpurify_flag))
#else /* CANNOT_DUMP */
- (0)
+ (0)
#endif /* CANNOT_DUMP */
- {
- static char const sibling_etc[] = "../etc/";
- dirname = sibling_etc;
- dirlen = sizeof sibling_etc - 1;
+ {
+ static char const sibling_etc[] = "../etc/";
+ dirname = sibling_etc;
+ dirlen = sizeof sibling_etc - 1;
+ }
+ else
+ {
+ CHECK_STRING (Vdoc_directory);
+ dirname = SSDATA (Vdoc_directory);
+ dirlen = SBYTES (Vdoc_directory);
+ }
}
else
{
- CHECK_STRING (Vdoc_directory);
- dirname = SSDATA (Vdoc_directory);
- dirlen = SBYTES (Vdoc_directory);
+ static char const empty_prefix_dir[] = "";
+ dirname = empty_prefix_dir;
+ dirlen = 0;
}
count = SPECPDL_INDEX ();
@@ -597,18 +649,6 @@ the same file name is found in the `doc-directory'. */)
strcpy (name, dirname);
strcat (name, SSDATA (filename)); /*** Add this line ***/
- /* Vbuild_files is nil when temacs is run, and non-nil after that. */
- if (NILP (Vbuild_files))
- {
- static char const *const buildobj[] =
- {
- #include "buildobj.h"
- };
- int i = ARRAYELTS (buildobj);
- while (0 <= --i)
- Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
- Vbuild_files = Fpurecopy (Vbuild_files);
- }
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
@@ -618,7 +658,6 @@ the same file name is found in the `doc-directory'. */)
open_errno);
}
record_unwind_protect_int (close_file_unwind, fd);
- Vdoc_file_name = filename;
filled = 0;
pos = 0;
while (1)
@@ -641,18 +680,13 @@ the same file name is found in the `doc-directory'. */)
if (p[1] == 'S')
{
skip_file = 0;
- if (end - p > 4 && end[-2] == '.'
- && (end[-1] == 'o' || end[-1] == 'c'))
+ if (NILP (module)
+ && end - p > 4
+ && end[-2] == '.'
+ && (end[-1] == 'o' || end[-1] == 'c')
+ && build_file_p (&p[2], end - p - 2))
{
- ptrdiff_t len = end - p - 2;
- char *fromfile = SAFE_ALLOCA (len + 1);
- memcpy (fromfile, &p[2], len);
- fromfile[len] = 0;
- if (fromfile[len-1] == 'c')
- fromfile[len-1] = 'o';
-
- skip_file = NILP (Fmember (build_string (fromfile),
- Vbuild_files));
+ skip_file = 1;
}
}
@@ -672,6 +706,7 @@ the same file name is found in the `doc-directory'. */)
/* Install file-position as variable-documentation property
and make it negative for a user-variable
(doc starts with a `*'). */
+ /* TODO: handle module var */
if (!NILP (Fboundp (sym))
|| !NILP (Fmemq (sym, delayed_init)))
Fput (sym, Qvariable_documentation,
@@ -683,7 +718,7 @@ the same file name is found in the `doc-directory'. */)
else if (p[1] == 'F')
{
if (!NILP (Ffboundp (sym)))
- store_function_docstring (sym, pos + end + 1 - buf);
+ store_function_docstring (sym, filename, pos + end + 1 -
buf, !NILP (module));
}
else if (p[1] == 'S')
; /* Just a source file name boundary marker. Ignore it. */
diff --git a/src/lisp.h b/src/lisp.h
index a56c4a7..dc855f5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1513,7 +1513,7 @@ struct Lisp_Subr
short min_args, max_args;
const char *symbol_name;
const char *intspec;
- const char *doc;
+ Lisp_Object doc;
};
enum char_table_specials
diff --git a/src/lread.c b/src/lread.c
index 6f71ff5..3a2c29a 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/>. */
#define file_tell ftell
#endif
+#ifdef HAVE_LTDL
+#include <ltdl.h>
+#endif
+
/* Hash table read constants. */
static Lisp_Object Qhash_table, Qdata;
static Lisp_Object Qtest;
@@ -982,7 +986,15 @@ required.
This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
(void)
{
- Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
+ Lisp_Object lst = Qnil, suffixes, suffix, ext;
+
+ /* module suffixes, then regular elisp suffixes */
+
+ Lisp_Object args[2];
+ args[0] = Vload_module_suffixes;
+ args[1] = Vload_suffixes;
+ suffixes = Fappend (2, args);
+
while (CONSP (suffixes))
{
Lisp_Object exts = Vload_file_rep_suffixes;
@@ -998,6 +1010,86 @@ This uses the variables `load-suffixes' and
`load-file-rep-suffixes'. */)
return Fnreverse (lst);
}
+DEFUN ("load-module", Fload_module, Sload_module, 1, 1, 0,
+ doc: /* Dymamically load a compiled module. */)
+ (Lisp_Object file)
+{
+#ifdef HAVE_LTDL
+ static int lt_init_done = 0;
+ lt_dlhandle handle;
+ void (*module_init) ();
+ void *gpl_sym;
+ Lisp_Object doc_name, args[2];
+
+ /* init libtool once per emacs process */
+ if (!lt_init_done)
+ {
+ int ret = lt_dlinit ();
+ if (ret)
+ {
+ const char* s = lt_dlerror ();
+ error ("ltdl init fail: %s", s);
+ }
+ lt_init_done = 1;
+ }
+
+ CHECK_STRING (file);
+
+ handle = lt_dlopen (SDATA (file));
+ if (!handle)
+ error ("Cannot load file %s", SDATA (file));
+
+ gpl_sym = lt_dlsym (handle, "plugin_is_GPL_compatible");
+ if (!gpl_sym)
+ error ("Module %s is not GPL compatible", SDATA (file));
+
+ module_init = (void (*) ()) lt_dlsym (handle, "init");
+ if (!module_init)
+ error ("Module %s does not have an init function.", SDATA (file));
+
+ module_init ();
+
+ /* build doc file path and install it */
+ args[0] = Fsubstring (file, make_number (0), make_number (-3));
+ args[1] = build_string (".doc");
+ doc_name = Fconcat (2, args);
+ Fsnarf_documentation (doc_name, Qt);
+
+ return Qt;
+#else
+ return Qnil;
+#endif
+}
+
+
+/* Return true if STRING ends with SUFFIX. */
+static bool string_suffix_p (Lisp_Object string, const char *suffix)
+{
+ const ptrdiff_t len = strlen (suffix);
+ return memcmp (SDATA (string) + SBYTES (string) - len, suffix, len) == 0;
+}
+
+/* Return true if STRING ends with any element of SUFFIXES. */
+static bool string_suffixes_p (Lisp_Object string, Lisp_Object suffixes)
+{
+ ptrdiff_t length = SBYTES (string), suflen;
+ Lisp_Object tail, suffix;
+
+ for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
+ {
+ suffix = XCAR (tail);
+ suflen = SBYTES (suffix);
+
+ if (suflen <= length)
+ {
+ if (memcmp (SDATA (string) + length - suflen, SDATA (suffix),
suflen) == 0)
+ return true;
+ }
+ }
+
+ return false;
+}
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el',
@@ -1055,6 +1147,8 @@ Return t if the file exists and loads successfully. */)
bool newer = 0;
/* True means we are loading a compiled file. */
bool compiled = 0;
+ /* True means we are loading a dynamic module. */
+ bool module = 0;
Lisp_Object handler;
bool safe_p = 1;
const char *fmode = "r";
@@ -1105,18 +1199,14 @@ Return t if the file exists and loads successfully. */)
if (! NILP (must_suffix))
{
- /* Don't insist on adding a suffix if FILE already ends with one. */
- ptrdiff_t size = SBYTES (file);
- if (size > 3
- && !strcmp (SSDATA (file) + size - 3, ".el"))
- must_suffix = Qnil;
- else if (size > 4
- && !strcmp (SSDATA (file) + size - 4, ".elc"))
- must_suffix = Qnil;
- /* Don't insist on adding a suffix
- if the argument includes a directory name. */
- else if (! NILP (Ffile_name_directory (file)))
- must_suffix = Qnil;
+ /* Don't insist on adding a suffix if FILE already ends with
+ one or if FILE includes a directory name. */
+ if (string_suffixes_p (file, Vload_module_suffixes)
+ || string_suffixes_p (file, Vload_suffixes)
+ || ! NILP (Ffile_name_directory (file)))
+ {
+ must_suffix = Qnil;
+ }
}
if (!NILP (nosuffix))
@@ -1227,7 +1317,7 @@ Return t if the file exists and loads successfully. */)
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
- if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
+ if (string_suffix_p (found, ".elc")
|| (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
/* Load .elc files directly, but not when they are
remote and have no handler! */
@@ -1289,6 +1379,12 @@ Return t if the file exists and loads successfully. */)
UNGCPRO;
}
}
+#ifdef HAVE_LTDL
+ else if (string_suffixes_p (found, Vload_module_suffixes))
+ {
+ module = 1;
+ }
+#endif
else
{
/* We are loading a source file (*.el). */
@@ -1338,7 +1434,9 @@ Return t if the file exists and loads successfully. */)
if (NILP (nomessage) || force_load_messages)
{
- if (!safe_p)
+ if (module)
+ message_with_string ("Loading %s (dymamic module)...", file, 1);
+ else if (!safe_p)
message_with_string ("Loading %s (compiled; note unsafe, not compiled
in Emacs)...",
file, 1);
else if (!compiled)
@@ -1358,7 +1456,14 @@ Return t if the file exists and loads successfully. */)
if (lisp_file_lexically_bound_p (Qget_file_char))
Fset (Qlexical_binding, Qt);
- if (! version || version >= 22)
+#ifdef HAVE_LTDL
+ if (module)
+ {
+ /* XXX: should the fd/stream be closed before loading the module? */
+ Fload_module (found);
+ }
+#endif
+ else if (! version || version >= 22)
readevalloop (Qget_file_char, stream, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
else
@@ -1387,7 +1492,9 @@ Return t if the file exists and loads successfully. */)
if (!noninteractive && (NILP (nomessage) || force_load_messages))
{
- if (!safe_p)
+ if (module)
+ message_with_string ("Loading %s (dymamic module)...done", file, 1);
+ else if (!safe_p)
message_with_string ("Loading %s (compiled; note unsafe, not compiled
in Emacs)...done",
file, 1);
else if (!compiled)
@@ -3837,9 +3944,6 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
if (!SYMBOLP (tem))
{
- /* Creating a non-pure string from a string literal not implemented yet.
- We could just use make_string here and live with the extra copy. */
- eassert (!NILP (Vpurify_flag));
tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem));
}
return tem;
@@ -4094,6 +4198,7 @@ void
defsubr (struct Lisp_Subr *sname)
{
Lisp_Object sym, tem;
+ sname->doc = Qnil;
sym = intern_c_string (sname->symbol_name);
XSETPVECTYPE (sname, PVEC_SUBR);
XSETSUBR (tem, sname);
@@ -4491,6 +4596,7 @@ syms_of_lread (void)
defsubr (&Sget_file_char);
defsubr (&Smapatoms);
defsubr (&Slocate_file_internal);
+ defsubr (&Sload_module);
DEFVAR_LISP ("obarray", Vobarray,
doc: /* Symbol table for use by `intern' and `read'.
@@ -4551,8 +4657,22 @@ Initialized during startup as described in Info node
`(elisp)Library Search'. *
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
+
Vload_suffixes = list2 (build_pure_c_string (".elc"),
- build_pure_c_string (".el"));
+ build_pure_c_string (".el"));
+
+ DEFVAR_LISP ("load-module-suffixes", Vload_module_suffixes,
+ doc: /* List of suffixes for modules files.
+This list should not include the empty string. See `load-suffixes'. */);
+
+#ifdef HAVE_LTDL
+ Vload_module_suffixes = list3 (build_pure_c_string (".dll"),
+ build_pure_c_string (".so"),
+ build_pure_c_string (".dylib"));
+#else
+ Vload_module_suffixes = Qnil;
+#endif
+
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.