(U+5D10): Add `sound@ja/on'; add U+6606 as a target of `<-formed'; add

[chise/xemacs-chise.git.1] / src / lread.c

diff --git a/src/lread.c b/src/lread.c
index a4505e0..d62b0d8 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -218,14 +218,14 @@ EXFUN (Fread_from_string, 3);
 \f
 
 static DOESNT_RETURN
 \f
 
 static DOESNT_RETURN

-syntax_error (CONST char *string)
+read_syntax_error (const char *string)

 {
   signal_error (Qinvalid_read_syntax,
                list1 (build_translated_string (string)));
 }
 
 static Lisp_Object
 {
   signal_error (Qinvalid_read_syntax,
                list1 (build_translated_string (string)));
 }
 
 static Lisp_Object

-continuable_syntax_error (CONST char *string)
+continuable_read_syntax_error (const char *string)

 {
   return Fsignal (Qinvalid_read_syntax,
                  list1 (build_translated_string (string)));
 {
   return Fsignal (Qinvalid_read_syntax,
                  list1 (build_translated_string (string)));

@@ -258,12 +258,13 @@ readchar (Lisp_Object readcharfun)
       Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
 #ifdef DEBUG_XEMACS /* testing Mule */
       static int testing_mule = 0; /* Change via debugger */
       Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
 #ifdef DEBUG_XEMACS /* testing Mule */
       static int testing_mule = 0; /* Change via debugger */

-      if (testing_mule) {
-        if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
-        else if (c == '\n')         fprintf (stderr, "\\n\n");
-        else                        fprintf (stderr, "\\%o ", c);
-      }
-#endif
+      if (testing_mule)
+       {
+         if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
+         else if (c == '\n')         stderr_out ("\\n\n");
+         else                        stderr_out ("\\%o ", c);
+       }
+#endif /* testing Mule */

       return c;
     }
   else if (MARKERP (readcharfun))
       return c;
     }
   else if (MARKERP (readcharfun))

@@ -536,7 +537,7 @@ system that was used for the decoding is stored into it.  It will in
 general be different from CODESYS if CODESYS specifies automatic
 encoding detection or end-of-line detection.
 */
 general be different from CODESYS if CODESYS specifies automatic
 encoding detection or end-of-line detection.
 */

-       (file, no_error, nomessage, nosuffix, codesys, used_codesys))
+       (file, noerror, nomessage, nosuffix, codesys, used_codesys))

 {
   /* This function can GC */
   int fd = -1;
 {
   /* This function can GC */
   int fd = -1;

@@ -567,7 +568,7 @@ encoding detection or end-of-line detection.
   /* If file name is magic, call the handler.  */
   handler = Ffind_file_name_handler (file, Qload);
   if (!NILP (handler))
   /* If file name is magic, call the handler.  */
   handler = Ffind_file_name_handler (file, Qload);
   if (!NILP (handler))

-    RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
+    RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,

                          nomessage, nosuffix));
 
   /* Do this after the handler to avoid
                          nomessage, nosuffix));
 
   /* Do this after the handler to avoid

@@ -596,7 +597,7 @@ encoding detection or end-of-line detection.
 
       if (fd < 0)
        {
 
       if (fd < 0)
        {

-         if (NILP (no_error))
+         if (NILP (noerror))

            signal_file_error ("Cannot open load file", file);
          else
            {
            signal_file_error ("Cannot open load file", file);
          else
            {

@@ -623,7 +624,7 @@ encoding detection or end-of-line detection.
              int result;
              /* temporarily hack the 'c' off the end of the filename */
              foundstr[foundlen - 1] = '\0';
              int result;
              /* temporarily hack the 'c' off the end of the filename */
              foundstr[foundlen - 1] = '\0';

-             result = stat (foundstr, &s2);
+             result = xemacs_stat (foundstr, &s2);

              if (result >= 0 &&
                  (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
               {
              if (result >= 0 &&
                  (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
               {

@@ -676,7 +677,7 @@ encoding detection or end-of-line detection.
   {
     /* Lisp_Object's must be malloc'ed, not stack-allocated */
     Lisp_Object lispstream = Qnil;
   {
     /* Lisp_Object's must be malloc'ed, not stack-allocated */
     Lisp_Object lispstream = Qnil;

-    CONST int block_size = 8192;
+    const int block_size = 8192;

     struct gcpro ngcpro1;
 
     NGCPRO1 (lispstream);
     struct gcpro ngcpro1;
 
     NGCPRO1 (lispstream);

@@ -978,12 +979,12 @@ locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
   else
     {
       /* Case c) */
   else
     {
       /* Case c) */

-      CONST char *nsuffix = (CONST char *) XSTRING_DATA (suffixes);
+      const char *nsuffix = (const char *) XSTRING_DATA (suffixes);

 
       while (1)
        {
          char *esuffix = (char *) strchr (nsuffix, ':');
 
       while (1)
        {
          char *esuffix = (char *) strchr (nsuffix, ':');

-         int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
+         int lsuffix = esuffix ? esuffix - nsuffix : (int) strlen (nsuffix);

 
          /* Concatenate path element/specified name with the suffix.  */
          strncpy (fn + fn_len, nsuffix, lsuffix);
 
          /* Concatenate path element/specified name with the suffix.  */
          strncpy (fn + fn_len, nsuffix, lsuffix);

@@ -1014,7 +1015,7 @@ locate_file_in_directory_mapper (char *fn, void *arg)
   struct stat st;
 
   /* Ignore file if it's a directory.  */
   struct stat st;
 
   /* Ignore file if it's a directory.  */

-  if (stat (fn, &st) >= 0
+  if (xemacs_stat (fn, &st) >= 0

       && (st.st_mode & S_IFMT) != S_IFDIR)
     {
       /* Check that we can access or open it.  */
       && (st.st_mode & S_IFMT) != S_IFDIR)
     {
       /* Check that we can access or open it.  */

@@ -1029,7 +1030,7 @@ locate_file_in_directory_mapper (char *fn, void *arg)
          if (closure->storeptr)
            *closure->storeptr = build_string (fn);
 
          if (closure->storeptr)
            *closure->storeptr = build_string (fn);
 

-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE

          /* If we actually opened the file, set close-on-exec flag
             on the new descriptor so that subprocesses can't whack
             at it.  */
          /* If we actually opened the file, set close-on-exec flag
             on the new descriptor so that subprocesses can't whack
             at it.  */

@@ -1185,7 +1186,7 @@ can be used if the internal tables grow too large, or when dumping.
 
    MODE nonnegative means don't open the files,
    just look for one for which access(file,MODE) succeeds.  In this case,
 
    MODE nonnegative means don't open the files,
    just look for one for which access(file,MODE) succeeds.  In this case,

-   returns 1 on success.
+   returns a nonnegative value on success.  On failure, returns -1.

 
    If STOREPTR is nonzero, it points to a slot where the name of
    the file actually found should be stored as a Lisp string.
 
    If STOREPTR is nonzero, it points to a slot where the name of
    the file actually found should be stored as a Lisp string.

@@ -1230,7 +1231,7 @@ locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
       int found = 0;
 
       /* If this path element is relative, we have to look by hand. */
       int found = 0;
 
       /* If this path element is relative, we have to look by hand. */

-      if (NILP (Ffile_name_absolute_p (pathel)))
+      if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))

        {
          val = locate_file_in_directory (pathel, str, suffixes, storeptr,
                                          mode);
        {
          val = locate_file_in_directory (pathel, str, suffixes, storeptr,
                                          mode);

@@ -1470,22 +1471,21 @@ Execute BUFFER as Lisp code.
 Programs can pass two arguments, BUFFER and PRINTFLAG.
 BUFFER is the buffer to evaluate (nil means use current buffer).
 PRINTFLAG controls printing of output:
 Programs can pass two arguments, BUFFER and PRINTFLAG.
 BUFFER is the buffer to evaluate (nil means use current buffer).
 PRINTFLAG controls printing of output:

-nil means discard it; anything else is stream for print.
+nil means discard it; anything else is a stream for printing.

 
 If there is no error, point does not move.  If there is an error,
 point remains at the end of the last character read from the buffer.
 
 If there is no error, point does not move.  If there is an error,
 point remains at the end of the last character read from the buffer.

-Execute BUFFER as Lisp code.

 */
 */

-       (bufname, printflag))
+       (buffer, printflag))

 {
   /* This function can GC */
   int speccount = specpdl_depth ();
   Lisp_Object tem, buf;
 
 {
   /* This function can GC */
   int speccount = specpdl_depth ();
   Lisp_Object tem, buf;
 

-  if (NILP (bufname))
+  if (NILP (buffer))

     buf = Fcurrent_buffer ();
   else
     buf = Fcurrent_buffer ();
   else

-    buf = Fget_buffer (bufname);
+    buf = Fget_buffer (buffer);

   if (NILP (buf))
     error ("No such buffer.");
 
   if (NILP (buf))
     error ("No such buffer.");
 

@@ -1519,10 +1519,10 @@ point remains at the end of the last character read from the buffer.
 
 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
 Execute the region as Lisp code.
 
 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
 Execute the region as Lisp code.

-When called from programs, expects two arguments,
+When called from programs, expects two arguments START and END

 giving starting and ending indices in the current buffer
 of the text to be executed.
 giving starting and ending indices in the current buffer
 of the text to be executed.

-Programs can pass third argument PRINTFLAG which controls output:
+Programs can pass third optional argument STREAM which controls output:

 nil means discard it; anything else is stream for printing it.
 
 If there is no error, point does not move.  If there is an error,
 nil means discard it; anything else is stream for printing it.
 
 If there is no error, point does not move.  If there is an error,

@@ -1532,28 +1532,28 @@ Note:  Before evaling the region, this function narrows the buffer to it.
 If the code being eval'd should happen to trigger a redisplay you may
 see some text temporarily disappear because of this.
 */
 If the code being eval'd should happen to trigger a redisplay you may
 see some text temporarily disappear because of this.
 */

-       (b, e, printflag))
+       (start, end, stream))

 {
   /* This function can GC */
   int speccount = specpdl_depth ();
   Lisp_Object tem;
   Lisp_Object cbuf = Fcurrent_buffer ();
 
 {
   /* This function can GC */
   int speccount = specpdl_depth ();
   Lisp_Object tem;
   Lisp_Object cbuf = Fcurrent_buffer ();
 

-  if (NILP (printflag))
+  if (NILP (stream))

     tem = Qsymbolp;             /* #### #@[]*&$#*[& SI:NULL-STREAM */
   else
     tem = Qsymbolp;             /* #### #@[]*&$#*[& SI:NULL-STREAM */
   else

-    tem = printflag;
+    tem = stream;

   specbind (Qstandard_output, tem);
 
   specbind (Qstandard_output, tem);
 

-  if (NILP (printflag))
+  if (NILP (stream))

     record_unwind_protect (save_excursion_restore, save_excursion_save ());
   record_unwind_protect (save_restriction_restore, save_restriction_save ());
 
     record_unwind_protect (save_excursion_restore, save_excursion_save ());
   record_unwind_protect (save_restriction_restore, save_restriction_save ());
 

-  /* This both uses b and checks its type.  */
-  Fgoto_char (b, cbuf);
-  Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
+  /* This both uses start and checks its type.  */
+  Fgoto_char (start, cbuf);
+  Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);

   readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
   readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,

-               !NILP (printflag));
+               !NILP (stream));

 
   return unbind_to (speccount, Qnil);
 }
 
   return unbind_to (speccount, Qnil);
 }

@@ -1632,6 +1632,26 @@ START and END optionally delimit a substring of STRING from which to read;
   return tem;
 }
 
   return tem;
 }
 

+Lisp_Object
+read_from_c_string (const unsigned char* str, size_t size)
+{
+  Lisp_Object tem;
+  Lisp_Object lispstream = Qnil;
+  struct gcpro gcpro1;
+
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+  Vcurrent_compiled_function_annotation = Qnil;
+#endif
+  GCPRO1 (lispstream);
+  lispstream = make_fixed_buffer_input_stream (str, size);
+
+  Vread_objects = Qnil;
+
+  tem = read0 (lispstream);
+  Lstream_delete (XLSTREAM (lispstream));
+  UNGCPRO;
+  return tem;
+}

 \f
 #ifdef LISP_BACKQUOTES
 
 \f
 #ifdef LISP_BACKQUOTES
 

@@ -1815,6 +1835,25 @@ read_escape (Lisp_Object readcharfun)
          }
        return i;
       }
          }
        return i;
       }

+    case 'u':
+      {
+       REGISTER Emchar i = 0;
+       REGISTER int count = 0;
+       while (++count <= 6)
+         {
+           c = readchar (readcharfun);
+           /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
+           if      (c >= '0' && c <= '9')  i = (i << 4) + (c - '0');
+           else if (c >= 'a' && c <= 'f')  i = (i << 4) + (c - 'a') + 10;
+            else if (c >= 'A' && c <= 'F')  i = (i << 4) + (c - 'A') + 10;
+           else
+             {
+               unreadchar (readcharfun, c);
+               break;
+             }
+         }
+       return i;
+      }

 
 #ifdef MULE
       /* #### need some way of reading an extended character with
 
 #ifdef MULE
       /* #### need some way of reading an extended character with

@@ -1870,7 +1909,7 @@ read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
   return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
 }
 
   return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
 }
 

-static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
+static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);

 
 static Lisp_Object
 read_atom (Lisp_Object readcharfun,
 
 static Lisp_Object
 read_atom (Lisp_Object readcharfun,

@@ -1921,7 +1960,7 @@ read_atom (Lisp_Object readcharfun,
                else if (sizeof (long) == sizeof (EMACS_INT))
                  number = atol (read_buffer);
                else
                else if (sizeof (long) == sizeof (EMACS_INT))
                  number = atol (read_buffer);
                else

-                 abort ();
+                 ABORT ();

                return make_int (number);
              }
 #else
                return make_int (number);
              }
 #else

@@ -1950,10 +1989,10 @@ read_atom (Lisp_Object readcharfun,
 
 
 static Lisp_Object
 
 
 static Lisp_Object

-parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
+parse_integer (const Bufbyte *buf, Bytecount len, int base)

 {
 {

-  CONST Bufbyte *lim = buf + len;
-  CONST Bufbyte *p = buf;
+  const Bufbyte *lim = buf + len;
+  const Bufbyte *p = buf;

   EMACS_UINT num = 0;
   int negativland = 0;
 
   EMACS_UINT num = 0;
   int negativland = 0;
 

@@ -2035,23 +2074,27 @@ static Lisp_Object
 read_bit_vector (Lisp_Object readcharfun)
 {
   unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
 read_bit_vector (Lisp_Object readcharfun)
 {
   unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);

-  Emchar c;

   Lisp_Object val;
 
   while (1)
     {
   Lisp_Object val;
 
   while (1)
     {

-      c = readchar (readcharfun);
-      if (c != '0' && c != '1')
-       break;
-      Dynarr_add (dyn, (unsigned char) (c - '0'));
+      unsigned char bit;
+      Emchar c = readchar (readcharfun);
+      if (c == '0')
+       bit = 0;
+      else if (c == '1')
+       bit = 1;
+      else
+       {
+         if (c >= 0)
+           unreadchar (readcharfun, c);
+         break;
+       }
+      Dynarr_add (dyn, bit);

     }
 
     }
 

-  if (c >= 0)
-    unreadchar (readcharfun, c);
-

   val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
                                          Dynarr_length (dyn));
   val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
                                          Dynarr_length (dyn));

-

   Dynarr_free (dyn);
 
   return val;
   Dynarr_free (dyn);
 
   return val;

@@ -2120,17 +2163,17 @@ read_structure (Lisp_Object readcharfun)
 
   GCPRO2 (orig_list, already_seen);
   if (c != '(')
 
   GCPRO2 (orig_list, already_seen);
   if (c != '(')

-    RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
+    RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));

   list = read_list (readcharfun, ')', 0, 0);
   orig_list = list;
   {
     int len = XINT (Flength (list));
     if (len == 0)
   list = read_list (readcharfun, ')', 0, 0);
   orig_list = list;
   {
     int len = XINT (Flength (list));
     if (len == 0)

-      RETURN_UNGCPRO (continuable_syntax_error
+      RETURN_UNGCPRO (continuable_read_syntax_error

                      ("structure type not specified"));
     if (!(len & 1))
       RETURN_UNGCPRO
                      ("structure type not specified"));
     if (!(len & 1))
       RETURN_UNGCPRO

-       (continuable_syntax_error
+       (continuable_read_syntax_error

         ("structures must have alternating keyword/value pairs"));
   }
 
         ("structures must have alternating keyword/value pairs"));
   }
 

@@ -2194,8 +2237,8 @@ read_structure (Lisp_Object readcharfun)
 
 \f
 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
 
 \f
 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,

-                                          int terminator);
-static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
+                                          Emchar terminator);
+static Lisp_Object read_vector (Lisp_Object readcharfun, Emchar terminator);

 
 /* Get the next character; filter out whitespace and comments */
 
 
 /* Get the next character; filter out whitespace and comments */
 

@@ -2497,15 +2540,15 @@ retry:
          case '+':
          case '-':
            {
          case '+':
          case '-':
            {

-             Lisp_Object fexp, obj, tem;
+             Lisp_Object feature_exp, obj, tem;

              struct gcpro gcpro1, gcpro2;
 
              struct gcpro gcpro1, gcpro2;
 

-             fexp = read0(readcharfun);
+             feature_exp = read0(readcharfun);

              obj = read0(readcharfun);
 
              /* the call to `featurep' may GC. */
              obj = read0(readcharfun);
 
              /* the call to `featurep' may GC. */

-             GCPRO2 (fexp, obj);
-             tem = call1 (Qfeaturep, fexp);
+             GCPRO2 (feature_exp, obj);
+             tem = call1 (Qfeaturep, feature_exp);

              UNGCPRO;
 
              if (c == '+' &&  NILP(tem)) goto retry;
              UNGCPRO;
 
              if (c == '+' &&  NILP(tem)) goto retry;

@@ -2696,10 +2739,10 @@ retry:
 #define EXP_INT 16
 
 int
 #define EXP_INT 16
 
 int

-isfloat_string (CONST char *cp)
+isfloat_string (const char *cp)

 {
   int state = 0;
 {
   int state = 0;

-  CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
+  const Bufbyte *ucp = (const Bufbyte *) cp;

 
   if (*ucp == '+' || *ucp == '-')
     ucp++;
 
   if (*ucp == '+' || *ucp == '-')
     ucp++;

@@ -2767,9 +2810,9 @@ sequence_reader (Lisp_Object readcharfun,
        unreadchar (readcharfun, ch);
 #ifdef FEATUREP_SYNTAX
       if (ch == ']')
        unreadchar (readcharfun, ch);
 #ifdef FEATUREP_SYNTAX
       if (ch == ']')

-       syntax_error ("\"]\" in a list");
+       read_syntax_error ("\"]\" in a list");

       else if (ch == ')')
       else if (ch == ')')

-       syntax_error ("\")\" in a vector");
+       read_syntax_error ("\")\" in a vector");

 #endif
       state = ((conser) (readcharfun, state, len));
     }
 #endif
       state = ((conser) (readcharfun, state, len));
     }

@@ -2809,15 +2852,15 @@ read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
          goto done;
        }
       else if (ch == ']')
          goto done;
        }
       else if (ch == ']')

-       syntax_error ("']' in a list");
+       read_syntax_error ("']' in a list");

       else if (ch == ')')
       else if (ch == ')')

-       syntax_error ("')' in a vector");
+       read_syntax_error ("')' in a vector");

       else
 #endif
       if (ch != '.')
        signal_simple_error ("BUG! Internal reader error", elt);
       else if (!s->allow_dotted_lists)
       else
 #endif
       if (ch != '.')
        signal_simple_error ("BUG! Internal reader error", elt);
       else if (!s->allow_dotted_lists)

-       syntax_error ("\".\" in a vector");
+       read_syntax_error ("\".\" in a vector");

       else
        {
          if (!NILP (s->tail))
       else
        {
          if (!NILP (s->tail))

@@ -2835,7 +2878,7 @@ read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
                  goto done;
                }
            }
                  goto done;
                }
            }

-         syntax_error (". in wrong context");
+         read_syntax_error (". in wrong context");

        }
     }
 
        }
     }
 

@@ -3030,7 +3073,7 @@ read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
   len = XINT (Flength (stuff));
   if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
     return
   len = XINT (Flength (stuff));
   if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
     return

-      continuable_syntax_error ("#[...] used with wrong number of elements");
+      continuable_read_syntax_error ("#[...] used with wrong number of elements");

 
   for (iii = 0; CONSP (stuff); iii++)
     {
 
   for (iii = 0; CONSP (stuff); iii++)
     {