diff options
Diffstat (limited to 'src')
| -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 |
6 files changed, 250 insertions, 75 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 7dc2b928f1e..c344a0f9433 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,20 @@ +2014-12-02 Aurélien Aptel <aurelien.aptel@gmail.com> + + * 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 <eliz@gnu.org> * 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@ 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 1019c2af6cc..f15b978d52d 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 1b87c23e949..5290b5d277a 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 a56c4a73bf8..dc855f5e2bf 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 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/>. */ #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. |