diff options
| author | Aurélien Aptel | 2014-12-02 16:17:10 -0500 |
|---|---|---|
| committer | Ted Zlatanov | 2014-12-04 19:54:16 -0500 |
| commit | ae901ddbfff04e8b1b0d63c452a6ca3f4c81fb17 (patch) | |
| tree | b806504944c633be45255321d1203bbcc2504781 | |
| parent | dd601050e7db69f322eea09d99751d8e6363b153 (diff) | |
| download | emacs-old-branches/dynamic-modules-rc2.tar.gz emacs-old-branches/dynamic-modules-rc2.zip | |
Add external modulesold-branches/dynamic-modules-rc2
* 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-- | ChangeLog | 4 | ||||
| -rw-r--r-- | configure.ac | 23 | ||||
| -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 | ||||
| -rw-r--r-- | src/ChangeLog | 17 | ||||
| -rw-r--r-- | src/Makefile.in | 4 | ||||
| -rw-r--r-- | src/alloc.c | 1 | ||||
| -rw-r--r-- | src/doc.c | 139 | ||||
| -rw-r--r-- | src/lisp.h | 2 | ||||
| -rw-r--r-- | src/lread.c | 162 |
27 files changed, 942 insertions, 78 deletions
| @@ -1,3 +1,7 @@ | |||
| 1 | 2014-12-02 Aurélien Aptel <aurelien.aptel@gmail.com> | ||
| 2 | |||
| 3 | * configure.ac: Add libtool support and module Makefiles. | ||
| 4 | |||
| 1 | 2014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | 2014-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]) | |||
| 355 | OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) | 355 | OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) |
| 356 | OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) | 356 | OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) |
| 357 | OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) | 357 | OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support]) |
| 358 | OPTION_DEFAULT_OFF([ltdl], [compile with dynamic module loading support]) | ||
| 359 | |||
| 358 | 360 | ||
| 359 | AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], | 361 | AC_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 | |||
| 3179 | fi | 3181 | fi |
| 3180 | AC_SUBST(LIBZ) | 3182 | AC_SUBST(LIBZ) |
| 3181 | 3183 | ||
| 3184 | HAVE_LTDL=no | ||
| 3185 | LIBLTDL= | ||
| 3186 | if 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) | ||
| 3189 | fi | ||
| 3190 | if 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" | ||
| 3193 | fi | ||
| 3194 | AC_SUBST(LIBLTDL) | ||
| 3195 | |||
| 3182 | ### Use -lpng if available, unless `--with-png=no'. | 3196 | ### Use -lpng if available, unless `--with-png=no'. |
| 3183 | HAVE_PNG=no | 3197 | HAVE_PNG=no |
| 3184 | LIBPNG= | 3198 | LIBPNG= |
| @@ -5049,7 +5063,7 @@ optsep= | |||
| 5049 | emacs_config_features= | 5063 | emacs_config_features= |
| 5050 | for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS \ | 5064 | for 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} | |||
| 5088 | echo " Does Emacs use -lotf? ${HAVE_LIBOTF}" | 5102 | echo " Does Emacs use -lotf? ${HAVE_LIBOTF}" |
| 5089 | echo " Does Emacs use -lxft? ${HAVE_XFT}" | 5103 | echo " Does Emacs use -lxft? ${HAVE_XFT}" |
| 5090 | echo " Does Emacs directly use zlib? ${HAVE_ZLIB}" | 5104 | echo " Does Emacs directly use zlib? ${HAVE_ZLIB}" |
| 5105 | echo " Does Emacs use -lltdl? ${HAVE_LTDL}" | ||
| 5091 | 5106 | ||
| 5092 | echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" | 5107 | echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}" |
| 5093 | echo | 5108 | echo |
| @@ -5154,12 +5169,14 @@ dnl This will work, but you get a config.status that is not quite right | |||
| 5154 | dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html). | 5169 | dnl (see http://lists.gnu.org/archive/html/bug-autoconf/2008-08/msg00028.html). |
| 5155 | dnl That doesn't have any obvious consequences for Emacs, but on the whole | 5170 | dnl That doesn't have any obvious consequences for Emacs, but on the whole |
| 5156 | dnl it seems better to just live with the duplication. | 5171 | dnl it seems better to just live with the duplication. |
| 5157 | 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" | 5172 | 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" |
| 5158 | 5173 | ||
| 5159 | AC_CONFIG_FILES([Makefile lib/Makefile lib-src/Makefile oldXMenu/Makefile \ | 5174 | AC_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 | ||
| 5164 | dnl test/ is not present in release tarfiles. | 5181 | dnl test/ is not present in release tarfiles. |
| 5165 | opt_makefile=test/automated/Makefile | 5182 | opt_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 @@ | |||
| 1 | 2014-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 @@ | |||
| 1 | ROOT = ../.. | ||
| 2 | |||
| 3 | CFLAGS = `pkg-config libcurl --cflags` | ||
| 4 | LDFLAGS = `pkg-config libcurl --libs` | ||
| 5 | |||
| 6 | all: 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 | |||
| 9 | int plugin_is_GPL_compatible; | ||
| 10 | static Lisp_Object Qcurl; | ||
| 11 | |||
| 12 | struct buffer | ||
| 13 | { | ||
| 14 | char *p; | ||
| 15 | size_t size, capacity; | ||
| 16 | }; | ||
| 17 | |||
| 18 | struct 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 */ | ||
| 27 | static size_t | ||
| 28 | write_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 | |||
| 47 | EXFUN (Fcurl_make, 0); | ||
| 48 | DEFUN ("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 | |||
| 60 | EXFUN (Fcurl_fetch_url, 2); | ||
| 61 | DEFUN ("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 | |||
| 84 | EXFUN (Fcurl_content, 1); | ||
| 85 | DEFUN ("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 | |||
| 93 | EXFUN (Fcurl_free, 1); | ||
| 94 | DEFUN ("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 | |||
| 105 | void 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 @@ | |||
| 1 | ROOT = ../.. | ||
| 2 | |||
| 3 | all: 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 | |||
| 5 | int plugin_is_GPL_compatible; | ||
| 6 | |||
| 7 | static Lisp_Object Qelisp, Qreplace_regexp_in_string; | ||
| 8 | |||
| 9 | #define MAKE_STRING(s) (make_string (s, sizeof(s)-1)) | ||
| 10 | |||
| 11 | EXFUN (Felisp_test, 0); | ||
| 12 | DEFUN ("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 | |||
| 30 | void 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 @@ | |||
| 1 | ROOT = ../.. | ||
| 2 | |||
| 3 | all: 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 | |||
| 8 | int plugin_is_GPL_compatible; | ||
| 9 | |||
| 10 | /* module feature name */ | ||
| 11 | static Lisp_Object Qfmod; | ||
| 12 | |||
| 13 | /* define a new lisp function */ | ||
| 14 | |||
| 15 | EXFUN (Ffmod, 2); | ||
| 16 | DEFUN ("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 | |||
| 23 | EXFUN (Ffmod_test1, 0); | ||
| 24 | DEFUN ("fmod-test1", Ffmod_test1, Sfmod_test1, 0, 0, 0, | ||
| 25 | doc: "Return 1") | ||
| 26 | (void) | ||
| 27 | { | ||
| 28 | return make_float (1.); | ||
| 29 | } | ||
| 30 | |||
| 31 | EXFUN (Ffmod_test2, 0); | ||
| 32 | DEFUN ("fmod-test2", Ffmod_test2, Sfmod_test2, 0, 0, 0, | ||
| 33 | doc: "Return 2") | ||
| 34 | (void) | ||
| 35 | { | ||
| 36 | return make_float (2.); | ||
| 37 | } | ||
| 38 | |||
| 39 | |||
| 40 | EXFUN (Ffmod_test3, 0); | ||
| 41 | DEFUN ("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 | |||
| 50 | void 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 @@ | |||
| 1 | ROOT = ../.. | ||
| 2 | |||
| 3 | all: 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 | |||
| 4 | int plugin_is_GPL_compatible; | ||
| 5 | static Lisp_Object Qopaque; | ||
| 6 | |||
| 7 | struct opaque | ||
| 8 | { | ||
| 9 | int a, b, c; | ||
| 10 | }; | ||
| 11 | |||
| 12 | static Lisp_Object Qa, Qb, Qc; | ||
| 13 | |||
| 14 | EXFUN (Fopaque_make, 3); | ||
| 15 | DEFUN ("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 | |||
| 31 | EXFUN (Fopaque_free, 1); | ||
| 32 | DEFUN ("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 | |||
| 41 | EXFUN (Fopaque_get, 2); | ||
| 42 | DEFUN ("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 | |||
| 51 | void 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 @@ | |||
| 1 | ROOT = ../.. | ||
| 2 | |||
| 3 | CFLAGS = `pkg-config yaml-0.1 --cflags` | ||
| 4 | LDFLAGS = `pkg-config yaml-0.1 --libs` | ||
| 5 | |||
| 6 | all: 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 | --- | ||
| 2 | invoice: 34843 | ||
| 3 | date : 2001-01-23 | ||
| 4 | bill-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 | ||
| 14 | 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 @@ | |||
| 1 | --- | ||
| 2 | a: 1 | ||
| 3 | b: 2 | ||
| 4 | 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 @@ | |||
| 1 | --- | ||
| 2 | a: 1 | ||
| 3 | b: | ||
| 4 | - 1 | ||
| 5 | - 2 | ||
| 6 | - 3 | ||
| 7 | --- | ||
| 8 | foo: | ||
| 9 | bar: 1 | ||
| 10 | baz: 2 | ||
| 11 | bad: 3 | ||
| 12 | zob: | ||
| 13 | - 42 | ||
| 14 | - 43 | ||
| 15 | --- | ||
| 16 | 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 @@ | |||
| 1 | --- | ||
| 2 | product: | ||
| 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 | ||
| 11 | tax : 251.42 | ||
| 12 | 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 @@ | |||
| 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 @@ | |||
| 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 | |||
| 13 | int plugin_is_GPL_compatible; | ||
| 14 | static Lisp_Object Qyaml; | ||
| 15 | |||
| 16 | typedef unsigned char uchar; | ||
| 17 | |||
| 18 | struct context | ||
| 19 | { | ||
| 20 | yaml_parser_t p; | ||
| 21 | int error; | ||
| 22 | Lisp_Object anchors; /* hashtable mapping alias to values */ | ||
| 23 | }; | ||
| 24 | |||
| 25 | static Lisp_Object parse_scalar (struct context *ctx, yaml_event_t *e); | ||
| 26 | static Lisp_Object parse_sequence (struct context *ctx, yaml_event_t *e); | ||
| 27 | static Lisp_Object parse_mapping (struct context *ctx, yaml_event_t *e); | ||
| 28 | |||
| 29 | static Lisp_Object | ||
| 30 | parse_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 | |||
| 86 | static Lisp_Object | ||
| 87 | parse_scalar (struct context *ctx, yaml_event_t *e) | ||
| 88 | { | ||
| 89 | return make_string ((char*)e->data.scalar.value, e->data.scalar.length); | ||
| 90 | } | ||
| 91 | |||
| 92 | static Lisp_Object | ||
| 93 | parse_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 | |||
| 113 | static Lisp_Object | ||
| 114 | parse_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 | |||
| 136 | static void | ||
| 137 | context_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 | |||
| 146 | EXFUN (Fyaml_parse_string, 1); | ||
| 147 | DEFUN ("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 | |||
| 165 | EXFUN (Fyaml_parse_buffer, 0); | ||
| 166 | DEFUN ("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 | |||
| 184 | EXFUN (Fyaml_parse_file, 1); | ||
| 185 | DEFUN ("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 | |||
| 223 | void 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 @@ | |||
| 1 | 2014-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 | |||
| 1 | 2014-12-02 Eli Zaretskii <eliz@gnu.org> | 18 | 2014-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 | ||
| 225 | LIBZ = @LIBZ@ | 225 | LIBZ = @LIBZ@ |
| 226 | 226 | ||
| 227 | LIBLTDL = @LIBLTDL@ | ||
| 228 | |||
| 227 | XRANDR_LIBS = @XRANDR_LIBS@ | 229 | XRANDR_LIBS = @XRANDR_LIBS@ |
| 228 | XRANDR_CFLAGS = @XRANDR_CFLAGS@ | 230 | XRANDR_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 | ||
| 430 | all: emacs$(EXEEXT) $(OTHER_FILES) | 432 | all: 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: |
| @@ -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 */ | ||
| 60 | static bool | ||
| 61 | doc_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 | ||
| 497 | static void | 508 | static void |
| 498 | store_function_docstring (Lisp_Object obj, ptrdiff_t offset) | 509 | store_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 | ||
| 556 | static bool | ||
| 557 | build_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 | ||
| 546 | DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, | 572 | DEFUN ("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. |
| 549 | This searches the `etc/DOC...' file for doc strings and | 575 | This searches the `etc/DOC...' file for doc strings and |
| 550 | records them in function and variable definitions. | 576 | records them in function and variable definitions. |
| @@ -552,7 +578,7 @@ The function takes one argument, FILENAME, a string; | |||
| 552 | it specifies the file name (without a directory) of the DOC file. | 578 | it specifies the file name (without a directory) of the DOC file. |
| 553 | That file is found in `../etc' now; later, when the dumped Emacs is run, | 579 | That file is found in `../etc' now; later, when the dumped Emacs is run, |
| 554 | the same file name is found in the `doc-directory'. */) | 580 | the 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 | ||
| 1519 | enum char_table_specials | 1519 | enum 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. */ |
| 68 | static Lisp_Object Qhash_table, Qdata; | 72 | static Lisp_Object Qhash_table, Qdata; |
| 69 | static Lisp_Object Qtest; | 73 | static Lisp_Object Qtest; |
| @@ -982,7 +986,15 @@ required. | |||
| 982 | This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) | 986 | This 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 | ||
| 1013 | DEFUN ("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. */ | ||
| 1066 | static 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. */ | ||
| 1073 | static 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 | |||
| 1001 | DEFUN ("load", Fload, Sload, 1, 5, 0, | 1093 | DEFUN ("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. |
| 1003 | First try FILE with `.elc' appended, then try with `.el', | 1095 | First 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 | |||
| 4094 | defsubr (struct Lisp_Subr *sname) | 4198 | defsubr (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'. * | |||
| 4551 | This list should not include the empty string. | 4657 | This 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, |
| 4553 | to the specified file name if a Lisp suffix is allowed or required. */); | 4659 | to 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. | ||
| 4666 | This 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 \ |
| 4558 | the same file. | 4678 | the same file. |