]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
(LD_SWITCH_MACHINE):
[gnu-emacs] / src / lread.c
index 8c3a0e5d9b030ab01074393e6526c3bed56a7b1a..60583bafbb27ccb6e69b91df81b17b0418fad740 100644 (file)
@@ -1,6 +1,6 @@
 /* Lisp parsing and input streams.
-   Copyright (C) 1985, 1986, 1987, 1988, 1989, 
-   1993, 1994, 1995 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 1997
+      Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -30,6 +30,7 @@ Boston, MA 02111-1307, USA.  */
 
 #ifndef standalone
 #include "buffer.h"
+#include "charset.h"
 #include <paths.h>
 #include "commands.h"
 #include "keyboard.h"
@@ -73,8 +74,10 @@ Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
 Lisp_Object Qascii_character, Qload, Qload_file_name;
 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
+Lisp_Object Qinhibit_file_name_operation;
 
 extern Lisp_Object Qevent_symbol_element_mask;
+extern Lisp_Object Qfile_exists_p;
 
 /* non-zero if inside `load' */
 int load_in_progress;
@@ -92,6 +95,9 @@ Lisp_Object Vload_history;
 /* This is used to build the load history. */
 Lisp_Object Vcurrent_load_list;
 
+/* List of files that were preloaded.  */
+Lisp_Object Vpreloaded_file_list;
+
 /* Name of file actually being read by `load'.  */
 Lisp_Object Vload_file_name;
 
@@ -107,6 +113,10 @@ Lisp_Object read_objects;
 /* Nonzero means load should forcibly load all dynamic doc strings.  */
 static int load_force_doc_strings;
 
+/* Function to use for loading an Emacs lisp source file (not
+   compiled) instead of readevalloop.  */
+Lisp_Object Vload_source_file_function;
+
 /* List of descriptors now open for Fload.  */
 static Lisp_Object load_descriptor_list;
 
@@ -137,7 +147,11 @@ static int new_backquote_flag;
 \f
 /* Handle unreading and rereading of characters.
    Write READCHAR to read a character,
-   UNREAD(c) to unread c to be read again. */
+   UNREAD(c) to unread c to be read again.
+
+   These macros actually read/unread a byte code, multibyte characters
+   are not handled here.  The caller should manage them if necessary.
+ */
 
 #define READCHAR readchar (readcharfun)
 #define UNREAD(c) unreadchar (readcharfun, c)
@@ -433,6 +447,13 @@ Return t if file exists.")
        return Qnil;
     }
 
+  /* If FD is 0, that means openp found a remote file.  */
+  if (fd == 0)
+    {
+      handler = Ffind_file_name_handler (found, Qload);
+      return call5 (handler, Qload, found, noerror, nomessage, Qt);
+    }
+
   if (!bcmp (&(XSTRING (found)->data[XSTRING (found)->size - 4]),
             ".elc", 4))
     {
@@ -459,6 +480,17 @@ Return t if file exists.")
        }
       XSTRING (found)->data[XSTRING (found)->size - 1] = 'c';
     }
+  else
+    {
+      /* We are loading a source file (*.el).  */
+      if (!NILP (Vload_source_file_function))
+       {
+         close (fd);
+         return call4 (Vload_source_file_function, found, file,
+                       NILP (noerror) ? Qnil : Qt,
+                       NILP (nomessage) ? Qnil : Qt);
+       }
+    }
 
 #ifdef DOS_NT
   close (fd);
@@ -472,6 +504,9 @@ Return t if file exists.")
       error ("Failure to create stdio stream for %s", XSTRING (file)->data);
     }
 
+  if (! NILP (Vpurify_flag))
+    Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
+
   if (NILP (nomessage))
     {
       if (newer)
@@ -490,6 +525,7 @@ Return t if file exists.")
   record_unwind_protect (load_unwind, lispstream);
   record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
   specbind (Qload_file_name, found);
+  specbind (Qinhibit_file_name_operation, Qnil);
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
@@ -579,7 +615,11 @@ complete_filename_p (pathname)
 
    If STOREPTR is nonzero, it points to a slot where the name of
    the file actually found should be stored as a Lisp string.
-   Nil is stored there on failure.  */
+   nil is stored there on failure.
+
+   If the file we find is remote, return 0
+   but store the found remote file name in *STOREPTR.
+   We do not check for remote files if EXEC_ONLY is nonzero.  */
 
 int
 openp (path, str, suffix, storeptr, exec_only)
@@ -594,7 +634,7 @@ openp (path, str, suffix, storeptr, exec_only)
   register char *fn = buf;
   int absolute = 0;
   int want_size;
-  register Lisp_Object filename;
+  Lisp_Object filename;
   struct stat st;
   struct gcpro gcpro1;
 
@@ -634,6 +674,7 @@ openp (path, str, suffix, storeptr, exec_only)
        {
          char *esuffix = (char *) index (nsuffix, ':');
          int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix);
+         Lisp_Object handler;
 
          /* Concatenate path element/specified name with the suffix.
             If the directory starts with /:, remove that.  */
@@ -654,23 +695,52 @@ openp (path, str, suffix, storeptr, exec_only)
          if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */
            strncat (fn, nsuffix, lsuffix);
 
-         /* Ignore file if it's a directory.  */
-         if (stat (fn, &st) >= 0
-             && (st.st_mode & S_IFMT) != S_IFDIR)
+         /* Check that the file exists and is not a directory.  */
+         if (absolute)
+           handler = Qnil;
+         else
+           handler = Ffind_file_name_handler (filename, Qfile_exists_p);
+         if (! NILP (handler) && ! exec_only)
            {
-             /* Check that we can access or open it.  */
-             if (exec_only)
-               fd = (access (fn, X_OK) == 0) ? 1 : -1;
-             else
-               fd = open (fn, O_RDONLY, 0);
+             Lisp_Object string;
+             int exists;
+
+             string = build_string (fn);
+             exists = ! NILP (exec_only ? Ffile_executable_p (string)
+                              : Ffile_readable_p (string));
+             if (exists
+                 && ! NILP (Ffile_directory_p (build_string (fn))))
+               exists = 0;
 
-             if (fd >= 0)
+             if (exists)
                {
                  /* We succeeded; return this descriptor and filename.  */
                  if (storeptr)
                    *storeptr = build_string (fn);
                  UNGCPRO;
-                 return fd;
+                 return 0;
+               }
+           }
+         else
+           {
+             int exists = (stat (fn, &st) >= 0
+                           && (st.st_mode & S_IFMT) != S_IFDIR);
+             if (exists)
+               {
+                 /* Check that we can access or open it.  */
+                 if (exec_only)
+                   fd = (access (fn, X_OK) == 0) ? 1 : -1;
+                 else
+                   fd = open (fn, O_RDONLY, 0);
+
+                 if (fd >= 0)
+                   {
+                     /* We succeeded; return this descriptor and filename.  */
+                     if (storeptr)
+                       *storeptr = build_string (fn);
+                     UNGCPRO;
+                     return fd;
+                   }
                }
            }
 
@@ -854,8 +924,7 @@ BUFFER is the buffer to evaluate (nil means use current buffer).\n\
 PRINTFLAG controls printing of output:\n\
 nil means discard it; anything else is stream for print.\n\
 \n\
-If there is no error, point does not move.  If there is an error,\n\
-point remains at the end of the last character read from the buffer.")
+This function preserves the position of point.")
   (buffer, printflag)
      Lisp_Object buffer, printflag;
 {
@@ -1042,6 +1111,27 @@ read0 (readcharfun)
 static int read_buffer_size;
 static char *read_buffer;
 
+/* Read multibyte form and return it as a character.  C is a first
+   byte of multibyte form, and rest of them are read from
+   READCHARFUN.  */
+static int
+read_multibyte (c, readcharfun)
+     register int c;
+     Lisp_Object readcharfun;
+{
+  /* We need the actual character code of this multibyte
+     characters.  */
+  unsigned char str[MAX_LENGTH_OF_MULTI_BYTE_FORM];
+  int len = 0;
+
+  str[len++] = c;
+  while ((c = READCHAR) >= 0xA0
+        && len < MAX_LENGTH_OF_MULTI_BYTE_FORM)
+    str[len++] = c;
+  UNREAD (c);
+  return STRING_CHAR (str, len);
+}
+
 static int
 read_escape (readcharfun)
      Lisp_Object readcharfun;
@@ -1196,6 +1286,8 @@ read_escape (readcharfun)
       }
 
     default:
+      if (BASE_LEADING_CODE_P (c))
+       c = read_multibyte (c, readcharfun);
       return c;
     }
 }
@@ -1250,8 +1342,25 @@ read1 (readcharfun, pch, first_in_list)
                  || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10)
                error ("Invalid size char-table");
              XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
+             XCHAR_TABLE (tmp)->top = Qt;
              return tmp;
            }
+         else if (c == '^')
+           {
+             c = READCHAR;
+             if (c == '[')
+               {
+                 Lisp_Object tmp;
+                 tmp = read_vector (readcharfun);
+                 if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS)
+                   error ("Invalid size char-table");
+                 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
+                 XCHAR_TABLE (tmp)->top = Qnil;
+                 return tmp;
+               }
+             Fsignal (Qinvalid_read_syntax,
+                      Fcons (make_string ("#^^", 3), Qnil));
+           }
          Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
        }
       if (c == '&')
@@ -1262,12 +1371,17 @@ read1 (readcharfun, pch, first_in_list)
          if (c == '"')
            {
              Lisp_Object tmp, val;
-             int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR)
+             int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1)
                                   / BITS_PER_CHAR);
 
              UNREAD (c);
              tmp = read1 (readcharfun, pch, first_in_list);
-             if (size_in_chars != XSTRING (tmp)->size)
+             if (size_in_chars != XSTRING (tmp)->size
+                 /* We used to print 1 char too many
+                    when the number of bits was a multiple of 8.
+                    Accept such input in case it came from an old version.  */
+                 && ! (XFASTINT (length)
+                       == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR))
                Fsignal (Qinvalid_read_syntax,
                         Fcons (make_string ("#&...", 5), Qnil));
                
@@ -1475,9 +1589,10 @@ read1 (readcharfun, pch, first_in_list)
        if (c < 0) return Fsignal (Qend_of_file, Qnil);
 
        if (c == '\\')
-         XSETINT (val, read_escape (readcharfun));
-       else
-         XSETINT (val, c);
+         c = read_escape (readcharfun);
+       else if (BASE_LEADING_CODE_P (c))
+         c = read_multibyte (c, readcharfun);
+       XSETINT (val, c);
 
        return val;
       }
@@ -1924,10 +2039,7 @@ intern (str)
   tem = oblookup (obarray, str, len);
   if (SYMBOLP (tem))
     return tem;
-  return Fintern ((!NILP (Vpurify_flag)
-                  ? make_pure_string (str, len)
-                  : make_string (str, len)),
-                 obarray);
+  return Fintern (make_string (str, len), obarray);
 }
 
 /* Create an uninterned symbol with name STR.  */
@@ -1967,6 +2079,9 @@ it defaults to the value of `obarray'.")
   sym = Fmake_symbol (string);
   XSYMBOL (sym)->obarray = obarray;
 
+  if (XSTRING (string)->data[0] == ':')
+    XSYMBOL (sym)->value = sym;
+
   ptr = &XVECTOR (obarray)->contents[XINT (tem)];
   if (SYMBOLP (*ptr))
     XSYMBOL (sym)->next = XSYMBOL (*ptr);
@@ -2133,7 +2248,7 @@ map_obarray (obarray, fn, arg)
   for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
     {
       tail = XVECTOR (obarray)->contents[i];
-      if (XFASTINT (tail) != 0)
+      if (SYMBOLP (tail))
        while (1)
          {
            (*fn) (tail, arg);
@@ -2393,6 +2508,16 @@ init_lread ()
                   Lisp dirs instead.  */
                Vload_path = nconc2 (Vload_path, dump_path);
 
+             /* Add leim under the installation dir, if it exists.  */
+             tem = Fexpand_file_name (build_string ("leim"),
+                                      Vinstallation_directory);
+             tem1 = Ffile_exists_p (tem);
+             if (!NILP (tem1))
+               {
+                 if (NILP (Fmember (tem, Vload_path)))
+                   Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
+               }
+
              /* Add site-list under the installation dir, if it exists.  */
              tem = Fexpand_file_name (build_string ("site-lisp"),
                                       Vinstallation_directory);
@@ -2402,15 +2527,58 @@ init_lread ()
                  if (NILP (Fmember (tem, Vload_path)))
                    Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
                }
+
+             /* If Emacs was not built in the source directory,
+                and it is run from where it was built, add to load-path
+                the lisp, leim and site-lisp dirs under that directory.  */
+
+             if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
+               {
+                 Lisp_Object tem2;
+
+                 tem = Fexpand_file_name (build_string ("src/Makefile"),
+                                          Vinstallation_directory);
+                 tem1 = Ffile_exists_p (tem);
+
+                 /* Don't be fooled if they moved the entire source tree
+                    AFTER dumping Emacs.  If the build directory is indeed
+                    different from the source dir, src/Makefile.in and
+                    src/Makefile will not be found together.  */
+                 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
+                                          Vinstallation_directory);
+                 tem2 = Ffile_exists_p (tem);
+                 if (!NILP (tem1) && NILP (tem2))
+                   {
+                     tem = Fexpand_file_name (build_string ("lisp"),
+                                              Vsource_directory);
+
+                     if (NILP (Fmember (tem, Vload_path)))
+                       Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
+
+                     tem = Fexpand_file_name (build_string ("leim"),
+                                              Vsource_directory);
+
+                     if (NILP (Fmember (tem, Vload_path)))
+                       Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
+
+                     tem = Fexpand_file_name (build_string ("site-lisp"),
+                                              Vsource_directory);
+
+                     if (NILP (Fmember (tem, Vload_path)))
+                       Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
+                   }
+               }
            }
        }
     }
   else
     {
-      /* ../lisp refers to the build directory.
-        NORMAL refers to the lisp dir in the source directory.  */
-      Vload_path = Fcons (build_string ("../lisp"),
-                         decode_env_path (0, normal));
+      /* NORMAL refers to the lisp dir in the source directory.  */
+      /* We used to add ../lisp at the front here, but
+        that caused trouble because it was copied from dump_path
+        into Vload_path, aboe, when Vinstallation_directory was non-nil.
+        It should be unnecessary.  */
+      Vload_path = decode_env_path (0, normal);
       dump_path = Vload_path;
     }
 #endif
@@ -2548,6 +2716,15 @@ or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
 The default is nil, which means use the function `read'.");
   Vload_read_function = Qnil;
 
+  DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
+    "Function called in `load' for loading an Emacs lisp source file.\n\
+This function is for doing code conversion before reading the source file.\n\
+If nil, loading is done without any code conversion.\n\
+Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
+ FULLNAME is the full name of FILE.\n\
+See `load' for the meaning of the remaining arguments.");
+  Vload_source_file_function = Qnil;
+
   DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
      "Non-nil means `load' should force-load all dynamic doc strings.\n\
 This is useful when the file being loaded is a temporary copy.");
@@ -2560,6 +2737,10 @@ You cannot count on them to still be there!");
     = Fexpand_file_name (build_string ("../"),
                         Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
 
+  DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
+     "List of files that were preloaded (when dumping Emacs).");
+  Vpreloaded_file_list = Qnil;
+
   /* Vsource_directory was initialized in init_lread.  */
 
   load_descriptor_list = Qnil;
@@ -2586,6 +2767,9 @@ You cannot count on them to still be there!");
   Qcomma_dot = intern (",.");
   staticpro (&Qcomma_dot);
 
+  Qinhibit_file_name_operation = intern ("inhibit-file-name-operation");
+  staticpro (&Qinhibit_file_name_operation);
+
   Qascii_character = intern ("ascii-character");
   staticpro (&Qascii_character);