/[emacs]/emacs/src/lread.c
ViewVC logotype

Diff of /emacs/src/lread.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.277.2.3 by fx, Thu Jul 18 16:30:36 2002 UTC revision 1.277.2.4 by handa, Wed Jul 24 10:51:15 2002 UTC
# Line 31  Boston, MA 02111-1307, USA.  */ Line 31  Boston, MA 02111-1307, USA.  */
31  #include "buffer.h"  #include "buffer.h"
32  #include "character.h"  #include "character.h"
33  #include "charset.h"  #include "charset.h"
34    #include "coding.h"
35  #include <epaths.h>  #include <epaths.h>
36  #include "commands.h"  #include "commands.h"
37  #include "keyboard.h"  #include "keyboard.h"
# Line 83  Lisp_Object Qascii_character, Qload, Qlo Line 84  Lisp_Object Qascii_character, Qload, Qlo
84  Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;  Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
85  Lisp_Object Qinhibit_file_name_operation;  Lisp_Object Qinhibit_file_name_operation;
86    
87    /* Used instead of Qget_file_char while loading *.elc files compiled
88       by Emacs 21 or older.  */
89    static Lisp_Object Qget_emacs_mule_file_char;
90    
91    static Lisp_Object Qload_force_doc_strings;
92    
93  extern Lisp_Object Qevent_symbol_element_mask;  extern Lisp_Object Qevent_symbol_element_mask;
94  extern Lisp_Object Qfile_exists_p;  extern Lisp_Object Qfile_exists_p;
95    
# Line 126  static int load_force_doc_strings; Line 133  static int load_force_doc_strings;
133  /* Nonzero means read should convert strings to unibyte.  */  /* Nonzero means read should convert strings to unibyte.  */
134  static int load_convert_to_unibyte;  static int load_convert_to_unibyte;
135    
136    /* Nonzero means READCHAR should read bytes one by one (not character)
137       when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
138       This is set to 1 by read1 temporarily while handling #@NUMBER.  */
139    static int load_each_byte;
140    
141  /* Function to use for loading an Emacs lisp source file (not  /* Function to use for loading an Emacs lisp source file (not
142     compiled) instead of readevalloop.  */     compiled) instead of readevalloop.  */
143  Lisp_Object Vload_source_file_function;  Lisp_Object Vload_source_file_function;
# Line 147  static int read_from_string_index; Line 159  static int read_from_string_index;
159  static int read_from_string_index_byte;  static int read_from_string_index_byte;
160  static int read_from_string_limit;  static int read_from_string_limit;
161    
 /* Number of bytes left to read in the buffer character  
    that `readchar' has already advanced over.  */  
 static int readchar_backlog;  
   
162  /* This contains the last string skipped with #@.  */  /* This contains the last string skipped with #@.  */
163  static char *saved_doc_string;  static char *saved_doc_string;
164  /* Length of buffer allocated in saved_doc_string.  */  /* Length of buffer allocated in saved_doc_string.  */
# Line 190  int load_dangerous_libraries; Line 198  int load_dangerous_libraries;
198    
199  static Lisp_Object Vbytecomp_version_regexp;  static Lisp_Object Vbytecomp_version_regexp;
200    
201    static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
202                                         Lisp_Object));
203    
204  static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,  static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
205                                Lisp_Object (*) (), int,                                Lisp_Object (*) (), int,
206                                Lisp_Object, Lisp_Object));                                Lisp_Object, Lisp_Object));
# Line 197  static Lisp_Object load_unwind P_ ((Lisp Line 208  static Lisp_Object load_unwind P_ ((Lisp
208  static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));  static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
209    
210    
211    /* Functions that read one byte from the current source READCHARFUN
212       or unreads one byte.  If the integer argument C is -1, it returns
213       one read byte, or -1 when there's no more byte in the source.  If C
214       is 0 or positive, it unreads C, and the return value is not
215       interesting.  */
216    
217    static int readbyte_for_lambda P_ ((int, Lisp_Object));
218    static int readbyte_from_file P_ ((int, Lisp_Object));
219    static int readbyte_from_string P_ ((int, Lisp_Object));
220    
221  /* Handle unreading and rereading of characters.  /* Handle unreading and rereading of characters.
222     Write READCHAR to read a character,     Write READCHAR to read a character,
223     UNREAD(c) to unread c to be read again.     UNREAD(c) to unread c to be read again.
224    
225     These macros actually read/unread a byte code, multibyte characters     These macros correctly read/unread multibyte characters.  */
    are not handled here.  The caller should manage them if necessary.  
  */  
226    
227  #define READCHAR readchar (readcharfun)  #define READCHAR readchar (readcharfun)
228  #define UNREAD(c) unreadchar (readcharfun, c)  #define UNREAD(c) unreadchar (readcharfun, c)
229    
230    /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
231       Qlambda, or a cons, we use this to keep unread character because a
232       file stream can't handle multibyte-char unreading.  The value -1
233       means that there's no unread character. */
234    static int unread_char;
235    
236    
237  static int  static int
238  readchar (readcharfun)  readchar (readcharfun)
239       Lisp_Object readcharfun;       Lisp_Object readcharfun;
240  {  {
241    Lisp_Object tem;    Lisp_Object tem;
242    register int c;    register int c;
243      int (*readbyte) P_ ((int, Lisp_Object));
244      unsigned char buf[MAX_MULTIBYTE_LENGTH];
245      int i, len;
246      int emacs_mule_encoding = 0;
247    
248    if (BUFFERP (readcharfun))    if (BUFFERP (readcharfun))
249      {      {
# Line 221  readchar (readcharfun) Line 251  readchar (readcharfun)
251    
252        int pt_byte = BUF_PT_BYTE (inbuffer);        int pt_byte = BUF_PT_BYTE (inbuffer);
253    
       if (readchar_backlog > 0)  
         /* We get the address of the byte just passed,  
            which is the last byte of the character.  
            The other bytes in this character are consecutive with it,  
            because the gap can't be in the middle of a character.  */  
         return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1)  
                  - --readchar_backlog);  
   
254        if (pt_byte >= BUF_ZV_BYTE (inbuffer))        if (pt_byte >= BUF_ZV_BYTE (inbuffer))
255          return -1;          return -1;
256    
       readchar_backlog = -1;  
   
257        if (! NILP (inbuffer->enable_multibyte_characters))        if (! NILP (inbuffer->enable_multibyte_characters))
258          {          {
259            /* Fetch the character code from the buffer.  */            /* Fetch the character code from the buffer.  */
# Line 244  readchar (readcharfun) Line 264  readchar (readcharfun)
264        else        else
265          {          {
266            c = BUF_FETCH_BYTE (inbuffer, pt_byte);            c = BUF_FETCH_BYTE (inbuffer, pt_byte);
267              if (! ASCII_BYTE_P (c))
268                c = BYTE8_TO_CHAR (c);
269            pt_byte++;            pt_byte++;
270          }          }
271        SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);        SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
# Line 256  readchar (readcharfun) Line 278  readchar (readcharfun)
278    
279        int bytepos = marker_byte_position (readcharfun);        int bytepos = marker_byte_position (readcharfun);
280    
       if (readchar_backlog > 0)  
         /* We get the address of the byte just passed,  
            which is the last byte of the character.  
            The other bytes in this character are consecutive with it,  
            because the gap can't be in the middle of a character.  */  
         return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1)  
                  - --readchar_backlog);  
   
281        if (bytepos >= BUF_ZV_BYTE (inbuffer))        if (bytepos >= BUF_ZV_BYTE (inbuffer))
282          return -1;          return -1;
283    
       readchar_backlog = -1;  
   
284        if (! NILP (inbuffer->enable_multibyte_characters))        if (! NILP (inbuffer->enable_multibyte_characters))
285          {          {
286            /* Fetch the character code from the buffer.  */            /* Fetch the character code from the buffer.  */
# Line 279  readchar (readcharfun) Line 291  readchar (readcharfun)
291        else        else
292          {          {
293            c = BUF_FETCH_BYTE (inbuffer, bytepos);            c = BUF_FETCH_BYTE (inbuffer, bytepos);
294              if (! ASCII_BYTE_P (c))
295                c = BYTE8_TO_CHAR (c);
296            bytepos++;            bytepos++;
297          }          }
298    
# Line 289  readchar (readcharfun) Line 303  readchar (readcharfun)
303      }      }
304    
305    if (EQ (readcharfun, Qlambda))    if (EQ (readcharfun, Qlambda))
306      return read_bytecode_char (0);      {
307          readbyte = readbyte_for_lambda;
308          goto read_multibyte;
309        }
310    if (EQ (readcharfun, Qget_file_char))    if (EQ (readcharfun, Qget_file_char))
311      {      {
312        c = getc (instream);        readbyte = readbyte_from_file;
313  #ifdef EINTR        goto read_multibyte;
       /* Interrupted reads have been observed while reading over the network */  
       while (c == EOF && ferror (instream) && errno == EINTR)  
         {  
           clearerr (instream);  
           c = getc (instream);  
         }  
 #endif  
       return c;  
314      }      }
   
315    if (STRINGP (readcharfun))    if (STRINGP (readcharfun))
316      {      {
317        if (read_from_string_index >= read_from_string_limit)        if (read_from_string_index >= read_from_string_limit)
# Line 316  readchar (readcharfun) Line 323  readchar (readcharfun)
323    
324        return c;        return c;
325      }      }
326      if (CONSP (readcharfun))
327        {
328          /* This is the case that read_vector is reading from a unibyte
329             string that contains a byte sequence previously skipped
330             because of #@NUMBER.  The car part of readcharfun is that
331             string, and the cdr part is a value of readcharfun given to
332             read_vector.  */
333          readbyte = readbyte_from_string;
334          if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
335            emacs_mule_encoding = 1;
336          goto read_multibyte;
337        }
338      if (EQ (readcharfun, Qget_emacs_mule_file_char))
339        {
340          readbyte = readbyte_from_file;
341          emacs_mule_encoding = 1;
342          goto read_multibyte;
343        }
344    
345    tem = call0 (readcharfun);    tem = call0 (readcharfun);
346    
347    if (NILP (tem))    if (NILP (tem))
348      return -1;      return -1;
349    return XINT (tem);    return XINT (tem);
350    
351     read_multibyte:
352      if (unread_char >= 0)
353        {
354          c = unread_char;
355          unread_char = -1;
356          return c;
357        }
358      c = (*readbyte) (-1, readcharfun);
359      if (c < 0 || ASCII_BYTE_P (c) || load_each_byte)
360        return c;
361      if (emacs_mule_encoding)
362        return read_emacs_mule_char (c, readbyte, readcharfun);
363      i = 0;
364      buf[i++] = c;
365      len = BYTES_BY_CHAR_HEAD (c);
366      while (i < len)
367        {
368          c = (*readbyte) (-1, readcharfun);
369          if (c < 0 || ! TRAILING_CODE_P (c))
370            {
371              while (--i > 1)
372                (*readbyte) (buf[i], readcharfun);
373              return BYTE8_TO_CHAR (buf[0]);
374            }
375          buf[i++] = c;
376        }
377      return STRING_CHAR (buf, i);
378  }  }
379    
380    
381  /* Unread the character C in the way appropriate for the stream READCHARFUN.  /* Unread the character C in the way appropriate for the stream READCHARFUN.
382     If the stream is a user function, call it with the char as argument.  */     If the stream is a user function, call it with the char as argument.  */
383    
# Line 341  unreadchar (readcharfun, c) Line 395  unreadchar (readcharfun, c)
395        struct buffer *b = XBUFFER (readcharfun);        struct buffer *b = XBUFFER (readcharfun);
396        int bytepos = BUF_PT_BYTE (b);        int bytepos = BUF_PT_BYTE (b);
397    
398        if (readchar_backlog >= 0)        BUF_PT (b)--;
399          readchar_backlog++;        if (! NILP (b->enable_multibyte_characters))
400            BUF_DEC_POS (b, bytepos);
401        else        else
402          {          bytepos--;
           BUF_PT (b)--;  
           if (! NILP (b->enable_multibyte_characters))  
             BUF_DEC_POS (b, bytepos);  
           else  
             bytepos--;  
403    
404            BUF_PT_BYTE (b) = bytepos;        BUF_PT_BYTE (b) = bytepos;
         }  
405      }      }
406    else if (MARKERP (readcharfun))    else if (MARKERP (readcharfun))
407      {      {
408        struct buffer *b = XMARKER (readcharfun)->buffer;        struct buffer *b = XMARKER (readcharfun)->buffer;
409        int bytepos = XMARKER (readcharfun)->bytepos;        int bytepos = XMARKER (readcharfun)->bytepos;
410    
411        if (readchar_backlog >= 0)        XMARKER (readcharfun)->charpos--;
412          readchar_backlog++;        if (! NILP (b->enable_multibyte_characters))
413            BUF_DEC_POS (b, bytepos);
414        else        else
415          {          bytepos--;
           XMARKER (readcharfun)->charpos--;  
           if (! NILP (b->enable_multibyte_characters))  
             BUF_DEC_POS (b, bytepos);  
           else  
             bytepos--;  
416    
417            XMARKER (readcharfun)->bytepos = bytepos;        XMARKER (readcharfun)->bytepos = bytepos;
         }  
418      }      }
419    else if (STRINGP (readcharfun))    else if (STRINGP (readcharfun))
420      {      {
# Line 378  unreadchar (readcharfun, c) Line 422  unreadchar (readcharfun, c)
422        read_from_string_index_byte        read_from_string_index_byte
423          = string_char_to_byte (readcharfun, read_from_string_index);          = string_char_to_byte (readcharfun, read_from_string_index);
424      }      }
425      else if (CONSP (readcharfun))
426        {
427          unread_char = c;
428        }
429    else if (EQ (readcharfun, Qlambda))    else if (EQ (readcharfun, Qlambda))
430      read_bytecode_char (1);      {
431    else if (EQ (readcharfun, Qget_file_char))        unread_char = c;
432      ungetc (c, instream);      }
433      else if (EQ (readcharfun, Qget_file_char)
434               || EQ (readcharfun, Qget_emacs_mule_file_char))
435        {
436          if (load_each_byte)
437            ungetc (c, instream);
438          else
439            unread_char = c;
440        }
441    else    else
442      call1 (readcharfun, make_number (c));      call1 (readcharfun, make_number (c));
443  }  }
444    
445    static int
446    readbyte_for_lambda (c, readcharfun)
447         int c;
448         Lisp_Object readcharfun;
449    {
450      return read_bytecode_char (c >= 0);
451    }
452    
453    
454    static int
455    readbyte_from_file (c, readcharfun)
456         int c;
457         Lisp_Object readcharfun;
458    {
459      if (c >= 0)
460        {
461          ungetc (c, instream);
462          return 0;
463        }
464    
465      c = getc (instream);
466    #ifdef EINTR
467      /* Interrupted reads have been observed while reading over the network */
468      while (c == EOF && ferror (instream) && errno == EINTR)
469        {
470          clearerr (instream);
471          c = getc (instream);
472        }
473    #endif
474      return (c == EOF ? -1 : c);
475    }
476    
477    static int
478    readbyte_from_string (c, readcharfun)
479         int c;
480         Lisp_Object readcharfun;
481    {
482      Lisp_Object string = XCAR (readcharfun);
483    
484      if (c >= 0)
485        {
486          read_from_string_index--;
487          read_from_string_index_byte
488            = string_char_to_byte (string, read_from_string_index);
489        }
490      
491      if (read_from_string_index >= read_from_string_limit)
492        c = -1;
493      else
494        FETCH_STRING_CHAR_ADVANCE (c, string,
495                                   read_from_string_index,
496                                   read_from_string_index_byte);
497      return c;
498    }
499    
500    
501    /* Read one non-ASCII character from INSTREAM.  The character is
502       encoded in `emacs-mule' and the first byte is already read in
503       C.  */
504    
505    extern char emacs_mule_bytes[256];
506    
507    static int
508    read_emacs_mule_char (c, readbyte, readcharfun)
509         int c;
510         int (*readbyte) P_ ((int, Lisp_Object));
511         Lisp_Object readcharfun;
512    {
513      /* Emacs-mule coding uses at most 4-byte for one character.  */
514      unsigned char buf[4];
515      int len = emacs_mule_bytes[c];
516      struct charset *charset;
517      int i;
518      unsigned code;
519    
520      if (len == 1)
521        /* C is not a valid leading-code of `emacs-mule'.  */
522        return BYTE8_TO_CHAR (c);
523    
524      i = 0;
525      buf[i++] = c;
526      while (i < len)
527        {
528          c = (*readbyte) (-1, readcharfun);
529          if (c < 0xA0)
530            {
531              while (--i > 1)
532                (*readbyte) (buf[i], readcharfun);
533              return BYTE8_TO_CHAR (buf[0]);
534            }
535          buf[i++] = c;
536        }
537    
538      if (len == 2)
539        {
540          charset = emacs_mule_charset[c];
541          code = buf[1] & 0x7F;
542        }
543      else if (len == 3)
544        {
545          if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
546              || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
547            {
548              charset = emacs_mule_charset[buf[1]];
549              code = buf[2] & 0x7F;
550            }
551          else
552            {
553              charset = emacs_mule_charset[buf[0]];
554              code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
555            }
556        }
557      else
558        {
559          charset = emacs_mule_charset[buf[1]];
560          code = ((buf[2] << 8) | buf[3]) & 0x7F7F;      
561        }
562      c = DECODE_CHAR (charset, code);
563      if (c < 0)
564        Fsignal (Qinvalid_read_syntax,
565                 Fcons (build_string ("invalid multibyte form"), Qnil));
566      return c;
567    }
568    
569    
570  static Lisp_Object read0 (), read1 (), read_list (), read_vector ();  static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
 static int read_multibyte ();  
571  static Lisp_Object substitute_object_recurse ();  static Lisp_Object substitute_object_recurse ();
572  static void        substitute_object_in_subtree (), substitute_in_interval ();  static void        substitute_object_in_subtree (), substitute_in_interval ();
573    
# Line 553  DEFUN ("get-file-char", Fget_file_char, Line 733  DEFUN ("get-file-char", Fget_file_char,
733    
734    
735    
736  /* Value is non-zero if the file asswociated with file descriptor FD  /* Value is a version number of byte compiled code if the file
737     is a compiled Lisp file that's safe to load.  Only files compiled     associated with file descriptor FD is a compiled Lisp file that's
738     with Emacs are safe to load.  Files compiled with XEmacs can lead     safe to load.  Only files compiled with Emacs are safe to load.
739     to a crash in Fbyte_code because of an incompatible change in the     Files compiled with XEmacs can lead to a crash in Fbyte_code
740     byte compiler.  */     because of an incompatible change in the byte compiler.  */
741    
742  static int  static int
743  safe_to_load_p (fd)  safe_to_load_p (fd)
# Line 578  safe_to_load_p (fd) Line 758  safe_to_load_p (fd)
758           with NUL bytes following it, but note the version.  */           with NUL bytes following it, but note the version.  */
759        for (i = 0; i < nbytes && buf[i] != '\n'; ++i)        for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
760          if (i == 4)          if (i == 4)
761            version = buf[i];            version = buf[i];
762    
763        if (i < nbytes        if (i < nbytes
764            && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,            && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
# Line 637  Return t if file exists.  */) Line 817  Return t if file exists.  */)
817    Lisp_Object handler;    Lisp_Object handler;
818    int safe_p = 1;    int safe_p = 1;
819    char *fmode = "r";    char *fmode = "r";
820      int version;
821    
822  #ifdef DOS_NT  #ifdef DOS_NT
823    fmode = "rt";    fmode = "rt";
824  #endif /* DOS_NT */  #endif /* DOS_NT */
# Line 744  Return t if file exists.  */) Line 926  Return t if file exists.  */)
926      Vloads_in_progress = Fcons (found, Vloads_in_progress);      Vloads_in_progress = Fcons (found, Vloads_in_progress);
927    }    }
928    
929      version = -1;
930    if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]),    if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]),
931               ".elc", 4))               ".elc", 4)
932          || (version = safe_to_load_p (fd)) > 0)
933      /* Load .elc files directly, but not when they are      /* Load .elc files directly, but not when they are
934         remote and have no handler!  */         remote and have no handler!  */
935      {      {
936        if (fd != -2)        if (fd != -2)
937          {          {
938            struct stat s1, s2;            struct stat s1, s2;
939            int result, version;            int result;
940    
941            if (!(version = safe_to_load_p (fd)))            if (version < 0
942                  && ! (version = safe_to_load_p (fd)))
943              {              {
944                safe_p = 0;                safe_p = 0;
945                if (!load_dangerous_libraries)                if (!load_dangerous_libraries)
# Line 769  Return t if file exists.  */) Line 954  Return t if file exists.  */)
954    
955            compiled = 1;            compiled = 1;
956    
           if (version == 20)    /* 21 isn't used */  
             /* We're loading something compiled with Mule 3, 4 or 5,  
                and thus potentially emacs-mule-encoded; load it with  
                code conversion.  (Perhaps the test should actually be  
                <22?)  We could check further on whether the comment  
                mentions multibyte and only code-convert if it does.  I  
                doubt it's worth the effort. -- fx  */  
             {  
               Lisp_Object val;  
   
               if (fd >= 0)  
                 emacs_close (fd);  
               /* load-with-code-conversion currently fails with  
                  emacs-mule non-ASCII doc strings.  */  
               error ("Can't currently load Emacs 20/1-compiled files: %s",  
                      XSTRING (found)->data);  
 #if 0  
               val = call4 (intern ("load-with-code-conversion"), found, file,  
                            NILP (noerror) ? Qnil : Qt,  
                            NILP (nomessage) ? Qnil : Qt);  
 #endif  
               return unbind_to (count, val);  
             }  
   
957  #ifdef DOS_NT  #ifdef DOS_NT
958            fmode = "rb";            fmode = "rb";
959  #endif /* DOS_NT */  #endif /* DOS_NT */
# Line 868  Return t if file exists.  */) Line 1029  Return t if file exists.  */)
1029    load_descriptor_list    load_descriptor_list
1030      = Fcons (make_number (fileno (stream)), load_descriptor_list);      = Fcons (make_number (fileno (stream)), load_descriptor_list);
1031    load_in_progress++;    load_in_progress++;
1032    readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);    if (version >= 22)
1033        readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);
1034      else
1035        {
1036          /* We can't handle a file which was compiled with
1037             byte-compile-dynamic by older version of Emacs.  */
1038          specbind (Qload_force_doc_strings, Qt);
1039          readevalloop (Qget_emacs_mule_file_char, stream, file, Feval, 0,
1040                        Qnil, Qnil);
1041        }
1042    unbind_to (count, Qnil);    unbind_to (count, Qnil);
1043    
1044    /* Run any load-hooks for this file.  */    /* Run any load-hooks for this file.  */
# Line 1242  readevalloop (readcharfun, stream, sourc Line 1412  readevalloop (readcharfun, stream, sourc
1412    record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);    record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1413    load_convert_to_unibyte = !NILP (unibyte);    load_convert_to_unibyte = !NILP (unibyte);
1414    
   readchar_backlog = -1;  
   
1415    GCPRO1 (sourcename);    GCPRO1 (sourcename);
1416    
1417    LOADHIST_ATTACH (sourcename);    LOADHIST_ATTACH (sourcename);
# Line 1423  STREAM or the value of `standard-input' Line 1591  STREAM or the value of `standard-input'
1591    if (EQ (stream, Qt))    if (EQ (stream, Qt))
1592      stream = Qread_char;      stream = Qread_char;
1593    
   readchar_backlog = -1;  
1594    new_backquote_flag = 0;    new_backquote_flag = 0;
1595    read_objects = Qnil;    read_objects = Qnil;
1596    
1597    if (EQ (stream, Qread_char))    if (EQ (stream, Qread_char))
1598      return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);      return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1599    
1600    if (STRINGP (stream))    if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1601      return Fcar (Fread_from_string (stream, Qnil, Qnil));      return Fcar (Fread_from_string (stream, Qnil, Qnil));
1602    
1603    return read0 (stream);    return read0 (stream);
# Line 1445  START and END optionally delimit a subst Line 1612  START and END optionally delimit a subst
1612       Lisp_Object string, start, end;       Lisp_Object string, start, end;
1613  {  {
1614    int startval, endval;    int startval, endval;
1615      Lisp_Object str;
1616    Lisp_Object tem;    Lisp_Object tem;
1617    
1618    CHECK_STRING (string);    if (CONSP (string))
1619        str = XCAR (string);
1620      else
1621        str = string;
1622      CHECK_STRING (str);
1623    
1624    if (NILP (end))    if (NILP (end))
1625      endval = XSTRING (string)->size;      endval = XSTRING (str)->size;
1626    else    else
1627      {      {
1628        CHECK_NUMBER (end);        CHECK_NUMBER (end);
1629        endval = XINT (end);        endval = XINT (end);
1630        if (endval < 0 || endval > XSTRING (string)->size)        if (endval < 0 || endval > XSTRING (str)->size)
1631          args_out_of_range (string, end);          args_out_of_range (str, end);
1632      }      }
1633    
1634    if (NILP (start))    if (NILP (start))
# Line 1466  START and END optionally delimit a subst Line 1638  START and END optionally delimit a subst
1638        CHECK_NUMBER (start);        CHECK_NUMBER (start);
1639        startval = XINT (start);        startval = XINT (start);
1640        if (startval < 0 || startval > endval)        if (startval < 0 || startval > endval)
1641          args_out_of_range (string, start);          args_out_of_range (str, start);
1642      }      }
1643    
1644    read_from_string_index = startval;    read_from_string_index = startval;
1645    read_from_string_index_byte = string_char_to_byte (string, startval);    read_from_string_index_byte = string_char_to_byte (str, startval);
1646    read_from_string_limit = endval;    read_from_string_limit = endval;
1647    
1648    new_backquote_flag = 0;    new_backquote_flag = 0;
# Line 1502  read0 (readcharfun) Line 1674  read0 (readcharfun)
1674  static int read_buffer_size;  static int read_buffer_size;
1675  static char *read_buffer;  static char *read_buffer;
1676    
 /* 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.  Store the byte length of the form into *NBYTES.  */  
   
 static int  
 read_multibyte (c, readcharfun, nbytes)  
      register int c;  
      Lisp_Object readcharfun;  
      int *nbytes;  
 {  
   /* We need the actual character code of this multibyte  
      characters.  */  
   unsigned char str[MAX_MULTIBYTE_LENGTH];  
   int len = 0;  
   int bytes = BYTES_BY_CHAR_HEAD (c);  
   
   str[len++] = c;  
   while (len < bytes)  
     {  
       c = READCHAR;  
       if (CHAR_HEAD_P (c))  
         {  
           UNREAD (c);  
           break;  
         }  
       str[len++] = c;  
     }  
   
   if (len == bytes && MULTIBYTE_LENGTH_NO_CHECK (str) > 0)  
     {  
       *nbytes = len;  
       return STRING_CHAR (str, len);  
     }  
   /* The byte sequence is not valid as multibyte.  Unread all bytes  
      but the first one, and return the first byte.  */  
   while (--len > 0)  
     UNREAD (str[len]);  
   *nbytes = 1;  
   return str[0];  
 }  
   
1677  /* Read a \-escape sequence, assuming we already read the `\'.  /* Read a \-escape sequence, assuming we already read the `\'.
1678     If the escape sequence forces unibyte, store 1 into *BYTEREP.     If the escape sequence forces unibyte, return eight-bit-char.  */
    If the escape sequence forces multibyte and the returned character  
    is raw 8-bit char, store 2 into *BYTEREP.  
    If the escape sequence forces multibyte and the returned character  
    is not raw 8-bit char, store 3 into *BYTEREP.  
    Otherwise store 0 into *BYTEREP.  */  
1679    
1680  static int  static int
1681  read_escape (readcharfun, stringp, byterep)  read_escape (readcharfun, stringp)
1682       Lisp_Object readcharfun;       Lisp_Object readcharfun;
1683       int stringp;       int stringp;
      int *byterep;  
1684  {  {
1685    register int c = READCHAR;    register int c = READCHAR;
1686    
   *byterep = 0;  
   
1687    switch (c)    switch (c)
1688      {      {
1689      case -1:      case -1:
# Line 1597  read_escape (readcharfun, stringp, byter Line 1720  read_escape (readcharfun, stringp, byter
1720          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1721        c = READCHAR;        c = READCHAR;
1722        if (c == '\\')        if (c == '\\')
1723          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1724        return c | meta_modifier;        return c | meta_modifier;
1725    
1726      case 'S':      case 'S':
# Line 1606  read_escape (readcharfun, stringp, byter Line 1729  read_escape (readcharfun, stringp, byter
1729          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1730        c = READCHAR;        c = READCHAR;
1731        if (c == '\\')        if (c == '\\')
1732          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1733        return c | shift_modifier;        return c | shift_modifier;
1734    
1735      case 'H':      case 'H':
# Line 1615  read_escape (readcharfun, stringp, byter Line 1738  read_escape (readcharfun, stringp, byter
1738          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1739        c = READCHAR;        c = READCHAR;
1740        if (c == '\\')        if (c == '\\')
1741          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1742        return c | hyper_modifier;        return c | hyper_modifier;
1743    
1744      case 'A':      case 'A':
# Line 1624  read_escape (readcharfun, stringp, byter Line 1747  read_escape (readcharfun, stringp, byter
1747          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1748        c = READCHAR;        c = READCHAR;
1749        if (c == '\\')        if (c == '\\')
1750          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1751        return c | alt_modifier;        return c | alt_modifier;
1752    
1753      case 's':      case 's':
# Line 1633  read_escape (readcharfun, stringp, byter Line 1756  read_escape (readcharfun, stringp, byter
1756          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1757        c = READCHAR;        c = READCHAR;
1758        if (c == '\\')        if (c == '\\')
1759          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1760        return c | super_modifier;        return c | super_modifier;
1761    
1762      case 'C':      case 'C':
# Line 1643  read_escape (readcharfun, stringp, byter Line 1766  read_escape (readcharfun, stringp, byter
1766      case '^':      case '^':
1767        c = READCHAR;        c = READCHAR;
1768        if (c == '\\')        if (c == '\\')
1769          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1770        if ((c & ~CHAR_MODIFIER_MASK) == '?')        if ((c & ~CHAR_MODIFIER_MASK) == '?')
1771          return 0177 | (c & CHAR_MODIFIER_MASK);          return 0177 | (c & CHAR_MODIFIER_MASK);
1772        else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))        else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
# Line 1683  read_escape (readcharfun, stringp, byter Line 1806  read_escape (readcharfun, stringp, byter
1806                }                }
1807            }            }
1808                    
1809          if (c < 0x100)          if (! ASCII_BYTE_P (i))
1810            *byterep = 1;            i = BYTE8_TO_CHAR (i);
         else  
           *byterep = 3;  
1811          return i;          return i;
1812        }        }
1813    
# Line 1721  read_escape (readcharfun, stringp, byter Line 1842  read_escape (readcharfun, stringp, byter
1842            }            }
1843    
1844          if (count < 3 && i >= 0x80)          if (count < 3 && i >= 0x80)
1845            *byterep = 2;            return BYTE8_TO_CHAR (i);
         else  
           *byterep = 3;  
1846          return i;          return i;
1847        }        }
1848    
1849      default:      default:
       if (EQ (readcharfun, Qget_file_char)  
           && BASE_LEADING_CODE_P (c))  
         {  
           int nbytes;  
   
           c = read_multibyte (c, readcharfun, &nbytes);  
           if (nbytes > 1)  
             *byterep = 3;  
         }  
1850        return c;        return c;
1851      }      }
1852  }  }
# Line 1824  read1 (readcharfun, pch, first_in_list) Line 1934  read1 (readcharfun, pch, first_in_list)
1934    int uninterned_symbol = 0;    int uninterned_symbol = 0;
1935    
1936    *pch = 0;    *pch = 0;
1937      load_each_byte = 0;
1938    
1939   retry:   retry:
1940    
# Line 1898  read1 (readcharfun, pch, first_in_list) Line 2009  read1 (readcharfun, pch, first_in_list)
2009    
2010                UNREAD (c);                UNREAD (c);
2011                tmp = read1 (readcharfun, pch, first_in_list);                tmp = read1 (readcharfun, pch, first_in_list);
2012                if (size_in_chars != XSTRING (tmp)->size                if (STRING_MULTIBYTE (tmp)
2013                    /* We used to print 1 char too many                    || (size_in_chars != XSTRING (tmp)->size
2014                       when the number of bits was a multiple of 8.                        /* We used to print 1 char too many
2015                       Accept such input in case it came from an old version.  */                           when the number of bits was a multiple of 8.
2016                    && ! (XFASTINT (length)                           Accept such input in case it came from an old
2017                          == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR))                           version.  */
2018                          && ! (XFASTINT (length)
2019                                == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR)))
2020                  Fsignal (Qinvalid_read_syntax,                  Fsignal (Qinvalid_read_syntax,
2021                           Fcons (make_string ("#&...", 5), Qnil));                           Fcons (make_string ("#&...", 5), Qnil));
2022                                    
# Line 1969  read1 (readcharfun, pch, first_in_list) Line 2082  read1 (readcharfun, pch, first_in_list)
2082          {          {
2083            int i, nskip = 0;            int i, nskip = 0;
2084    
2085              load_each_byte = 1;
2086            /* Read a decimal integer.  */            /* Read a decimal integer.  */
2087            while ((c = READCHAR) >= 0            while ((c = READCHAR) >= 0
2088                   && c >= '0' && c <= '9')                   && c >= '0' && c <= '9')
# Line 1979  read1 (readcharfun, pch, first_in_list) Line 2093  read1 (readcharfun, pch, first_in_list)
2093            if (c >= 0)            if (c >= 0)
2094              UNREAD (c);              UNREAD (c);
2095                        
2096            if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))            if (load_force_doc_strings
2097                  && (EQ (readcharfun, Qget_file_char)
2098                      || EQ (readcharfun, Qget_emacs_mule_file_char)))
2099              {              {
2100                /* If we are supposed to force doc strings into core right now,                /* If we are supposed to force doc strings into core right now,
2101                   record the last string that we skipped,                   record the last string that we skipped,
# Line 2031  read1 (readcharfun, pch, first_in_list) Line 2147  read1 (readcharfun, pch, first_in_list)
2147                  c = READCHAR;                  c = READCHAR;
2148              }              }
2149    
2150              load_each_byte = 0;
2151            goto retry;            goto retry;
2152          }          }
2153        if (c == '$')        if (c == '$')
# Line 2152  read1 (readcharfun, pch, first_in_list) Line 2269  read1 (readcharfun, pch, first_in_list)
2269    
2270      case '?':      case '?':
2271        {        {
2272          int discard;          int modifiers;
2273    
2274          c = READCHAR;          c = READCHAR;
2275          if (c < 0)          if (c < 0)
2276            end_of_file_error ();            end_of_file_error ();
   
2277          if (c == '\\')          if (c == '\\')
2278            c = read_escape (readcharfun, 0, &discard);            c = read_escape (readcharfun, 0);
2279          else if (EQ (readcharfun, Qget_file_char)          modifiers = c & CHAR_MODIFIER_MASK;
2280                   && BASE_LEADING_CODE_P (c))          c &= ~CHAR_MODIFIER_MASK;
2281            c = read_multibyte (c, readcharfun, &discard);          if (CHAR_BYTE8_P (c))
2282              c = CHAR_TO_BYTE8 (c);
2283            c |= modifiers;
2284    
2285          return make_number (c);          return make_number (c);
2286        }        }
# Line 2196  read1 (readcharfun, pch, first_in_list) Line 2314  read1 (readcharfun, pch, first_in_list)
2314              if (c == '\\')              if (c == '\\')
2315                {                {
2316                  int modifiers;                  int modifiers;
                 int byterep;  
2317    
2318                  c = read_escape (readcharfun, 1, &byterep);                  c = read_escape (readcharfun, 1);
2319    
2320                  /* C is -1 if \ newline has just been seen */                  /* C is -1 if \ newline has just been seen */
2321                  if (c == -1)                  if (c == -1)
# Line 2211  read1 (readcharfun, pch, first_in_list) Line 2328  read1 (readcharfun, pch, first_in_list)
2328                  modifiers = c & CHAR_MODIFIER_MASK;                  modifiers = c & CHAR_MODIFIER_MASK;
2329                  c = c & ~CHAR_MODIFIER_MASK;                  c = c & ~CHAR_MODIFIER_MASK;
2330    
2331                  if (byterep == 1)                  if (CHAR_BYTE8_P (c))
2332                    {                    force_singlebyte = 1;
2333                      force_singlebyte = 1;                  else if (! ASCII_CHAR_P (c))
2334                      if (c >= 0x80)                    force_multibyte = 1;
2335                        /*  Raw 8-bit code */                  else            /* i.e. ASCII_CHAR_P (c) */
                       c = BYTE8_TO_CHAR (c);  
                   }  
                 else if (byterep > 1)  
                   {  
                     force_multibyte = 1;  
                     if (byterep == 2)  
                       c = BYTE8_TO_CHAR (c);  
                   }  
                 else if (c >= 0x80)  
                   {  
                     force_singlebyte = 1;  
                     c = BYTE8_TO_CHAR (c);  
                   }  
   
                 if (ASCII_CHAR_P (c))  
2336                    {                    {
2337                      /* Allow `\C- ' and `\C-?'.  */                      /* Allow `\C- ' and `\C-?'.  */
2338                      if (modifiers == CHAR_CTL)                      if (modifiers == CHAR_CTL)
# Line 2264  read1 (readcharfun, pch, first_in_list) Line 2366  read1 (readcharfun, pch, first_in_list)
2366                    error ("Invalid modifier in string");                    error ("Invalid modifier in string");
2367                  p += CHAR_STRING (c, (unsigned char *) p);                  p += CHAR_STRING (c, (unsigned char *) p);
2368                }                }
2369              else if (c >= 0x80)              else
2370                {                {
                 if (EQ (readcharfun, Qget_file_char))  
                   {  
                     if (BASE_LEADING_CODE_P (c))  
                       {  
                         int nbytes;  
                         c = read_multibyte (c, readcharfun, &nbytes);  
                         if (nbytes > 1)  
                           force_multibyte = 1;  
                         else  
                           {  
                             force_singlebyte = 1;  
                             c = BYTE8_TO_CHAR (c);  
                           }  
                       }  
                     else  
                       {  
                         force_singlebyte = 1;  
                         c = BYTE8_TO_CHAR (c);  
                       }  
                   }  
                 else  
                   force_multibyte = 1;  
2371                  p += CHAR_STRING (c, (unsigned char *) p);                  p += CHAR_STRING (c, (unsigned char *) p);
2372                }                }
             else  
               *p++ = c;  
2373              nchars++;              nchars++;
2374            }            }
2375          if (c < 0)          if (c < 0)
# Line 2371  read1 (readcharfun, pch, first_in_list) Line 2449  read1 (readcharfun, pch, first_in_list)
2449                    quoted = 1;                    quoted = 1;
2450                  }                  }
2451    
2452                if (! SINGLE_BYTE_CHAR_P (c))                p += CHAR_STRING (c, p);
                 p += CHAR_STRING (c, p);  
               else  
                 *p++ = c;  
   
2453                c = READCHAR;                c = READCHAR;
2454              }              }
2455    
# Line 2702  read_vector (readcharfun, bytecodeflag) Line 2776  read_vector (readcharfun, bytecodeflag)
2776                    XSTRING (bytestr)->size = STRING_BYTES (XSTRING (bytestr));                    XSTRING (bytestr)->size = STRING_BYTES (XSTRING (bytestr));
2777                    SET_STRING_BYTES (XSTRING (bytestr), -1);                    SET_STRING_BYTES (XSTRING (bytestr), -1);
2778    
2779                    item = Fread (bytestr);                    item = Fread (Fcons (bytestr, readcharfun));
2780                    if (!CONSP (item))                    if (!CONSP (item))
2781                      error ("invalid byte code");                      error ("invalid byte code");
2782    
# Line 2715  read_vector (readcharfun, bytecodeflag) Line 2789  read_vector (readcharfun, bytecodeflag)
2789                /* Now handle the bytecode slot.  */                /* Now handle the bytecode slot.  */
2790                ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;                ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
2791              }              }
2792              else if (i == COMPILED_DOC_STRING
2793                       && STRINGP (item)
2794                       && ! STRING_MULTIBYTE (item))
2795                {
2796                  if (EQ (readcharfun, Qget_emacs_mule_file_char))
2797                    item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
2798                  else
2799                    item = Fstring_as_multibyte (item);
2800                }
2801          }          }
2802        ptr[i] = read_pure ? Fpurecopy (item) : item;        ptr[i] = read_pure ? Fpurecopy (item) : item;
2803        otem = XCONS (tem);        otem = XCONS (tem);
# Line 2812  read_list (flag, readcharfun) Line 2895  read_list (flag, readcharfun)
2895                    if (doc_reference == 2)                    if (doc_reference == 2)
2896                      {                      {
2897                        /* Get a doc string from the file we are loading.                        /* Get a doc string from the file we are loading.
2898                           If it's in saved_doc_string, get it from there.  */                           If it's in saved_doc_string, get it from there.
2899    
2900                             Here, we don't know if the string is a
2901                             bytecode string or a doc string.  As a
2902                             bytecode string must be unibyte, we always
2903                             return a unibyte string.  If it is actually a
2904                             doc string, caller must make it
2905                             multibyte.  */
2906                        int pos = XINT (XCDR (val));                        int pos = XINT (XCDR (val));
2907                        /* Position is negative for user variables.  */                        /* Position is negative for user variables.  */
2908                        if (pos < 0) pos = -pos;                        if (pos < 0) pos = -pos;
# Line 2844  read_list (flag, readcharfun) Line 2934  read_list (flag, readcharfun)
2934                                  saved_doc_string[to++] = c;                                  saved_doc_string[to++] = c;
2935                              }                              }
2936    
2937                            return make_string (saved_doc_string + start,                            return make_unibyte_string (saved_doc_string + start,
2938                                                to - start);                                                        to - start);
2939                          }                          }
2940                        /* Look in prev_saved_doc_string the same way.  */                        /* Look in prev_saved_doc_string the same way.  */
2941                        else if (pos >= prev_saved_doc_string_position                        else if (pos >= prev_saved_doc_string_position
# Line 2876  read_list (flag, readcharfun) Line 2966  read_list (flag, readcharfun)
2966                                  prev_saved_doc_string[to++] = c;                                  prev_saved_doc_string[to++] = c;
2967                              }                              }
2968    
2969                            return make_string (prev_saved_doc_string + start,                            return make_unibyte_string (prev_saved_doc_string
2970                                                to - start);                                                        + start,
2971                                                          to - start);
2972                          }                          }
2973                        else                        else
2974                          return get_doc_string (val, 0, 0);                          return get_doc_string (val, 1, 0);
2975                      }                      }
2976    
2977                    return val;                    return val;
# Line 3764  to load.  See also `load-dangerous-libra Line 3855  to load.  See also `load-dangerous-libra
3855    Qget_file_char = intern ("get-file-char");    Qget_file_char = intern ("get-file-char");
3856    staticpro (&Qget_file_char);    staticpro (&Qget_file_char);
3857    
3858      Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
3859      staticpro (&Qget_emacs_mule_file_char);
3860    
3861      Qload_force_doc_strings = intern ("load-force-doc-strings");
3862      staticpro (&Qload_force_doc_strings);
3863    
3864    Qbackquote = intern ("`");    Qbackquote = intern ("`");
3865    staticpro (&Qbackquote);    staticpro (&Qbackquote);
3866    Qcomma = intern (",");    Qcomma = intern (",");

Legend:
Removed from v.1.277.2.3  
changed lines
  Added in v.1.277.2.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26