/[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.317 by fx, Mon Jun 2 18:36:33 2003 UTC revision 1.317.2.1 by handa, Mon Sep 8 12:48:11 2003 UTC
# Line 29  Boston, MA 02111-1307, USA.  */ Line 29  Boston, MA 02111-1307, USA.  */
29  #include "lisp.h"  #include "lisp.h"
30  #include "intervals.h"  #include "intervals.h"
31  #include "buffer.h"  #include "buffer.h"
32    #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 86  Lisp_Object Qascii_character, Qload, Qlo Line 88  Lisp_Object Qascii_character, Qload, Qlo
88  Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;  Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
89  Lisp_Object Qinhibit_file_name_operation;  Lisp_Object Qinhibit_file_name_operation;
90    
91    /* Used instead of Qget_file_char while loading *.elc files compiled
92       by Emacs 21 or older.  */
93    static Lisp_Object Qget_emacs_mule_file_char;
94    
95    static Lisp_Object Qload_force_doc_strings;
96    
97  extern Lisp_Object Qevent_symbol_element_mask;  extern Lisp_Object Qevent_symbol_element_mask;
98  extern Lisp_Object Qfile_exists_p;  extern Lisp_Object Qfile_exists_p;
99    
# Line 129  static int load_force_doc_strings; Line 137  static int load_force_doc_strings;
137  /* Nonzero means read should convert strings to unibyte.  */  /* Nonzero means read should convert strings to unibyte.  */
138  static int load_convert_to_unibyte;  static int load_convert_to_unibyte;
139    
140    /* Nonzero means READCHAR should read bytes one by one (not character)
141       when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
142       This is set to 1 by read1 temporarily while handling #@NUMBER.  */
143    static int load_each_byte;
144    
145  /* Function to use for loading an Emacs lisp source file (not  /* Function to use for loading an Emacs lisp source file (not
146     compiled) instead of readevalloop.  */     compiled) instead of readevalloop.  */
147  Lisp_Object Vload_source_file_function;  Lisp_Object Vload_source_file_function;
# Line 157  static int read_from_string_index; Line 170  static int read_from_string_index;
170  static int read_from_string_index_byte;  static int read_from_string_index_byte;
171  static int read_from_string_limit;  static int read_from_string_limit;
172    
 /* Number of bytes left to read in the buffer character  
    that `readchar' has already advanced over.  */  
 static int readchar_backlog;  
173  /* Number of characters read in the current call to Fread or  /* Number of characters read in the current call to Fread or
174     Fread_from_string. */     Fread_from_string. */
175  static int readchar_count;  static int readchar_count;
# Line 203  int load_dangerous_libraries; Line 213  int load_dangerous_libraries;
213    
214  static Lisp_Object Vbytecomp_version_regexp;  static Lisp_Object Vbytecomp_version_regexp;
215    
216  static void to_multibyte P_ ((char **, char **, int *));  static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
217                                         Lisp_Object));
218    
219  static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,  static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
220                                Lisp_Object (*) (), int,                                Lisp_Object (*) (), int,
221                                Lisp_Object, Lisp_Object));                                Lisp_Object, Lisp_Object));
# Line 211  static Lisp_Object load_unwind P_ ((Lisp Line 223  static Lisp_Object load_unwind P_ ((Lisp
223  static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));  static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
224    
225    
226    /* Functions that read one byte from the current source READCHARFUN
227       or unreads one byte.  If the integer argument C is -1, it returns
228       one read byte, or -1 when there's no more byte in the source.  If C
229       is 0 or positive, it unreads C, and the return value is not
230       interesting.  */
231    
232    static int readbyte_for_lambda P_ ((int, Lisp_Object));
233    static int readbyte_from_file P_ ((int, Lisp_Object));
234    static int readbyte_from_string P_ ((int, Lisp_Object));
235    
236  /* Handle unreading and rereading of characters.  /* Handle unreading and rereading of characters.
237     Write READCHAR to read a character,     Write READCHAR to read a character,
238     UNREAD(c) to unread c to be read again.     UNREAD(c) to unread c to be read again.
239    
240     The READCHAR and UNREAD macros are meant for reading/unreading a     These macros correctly read/unread multibyte characters.  */
    byte code; they do not handle multibyte characters.  The caller  
    should manage them if necessary.  
   
    [ Actually that seems to be a lie; READCHAR will definitely read  
      multibyte characters from buffer sources, at least.  Is the  
      comment just out of date?  
      -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]  
  */  
241    
242  #define READCHAR readchar (readcharfun)  #define READCHAR readchar (readcharfun)
243  #define UNREAD(c) unreadchar (readcharfun, c)  #define UNREAD(c) unreadchar (readcharfun, c)
244    
245    /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
246       Qlambda, or a cons, we use this to keep an unread character because
247       a file stream can't handle multibyte-char unreading.  The value -1
248       means that there's no unread character. */
249    static int unread_char;
250    
251  static int  static int
252  readchar (readcharfun)  readchar (readcharfun)
253       Lisp_Object readcharfun;       Lisp_Object readcharfun;
254  {  {
255    Lisp_Object tem;    Lisp_Object tem;
256    register int c;    register int c;
257      int (*readbyte) P_ ((int, Lisp_Object));
258      unsigned char buf[MAX_MULTIBYTE_LENGTH];
259      int i, len;
260      int emacs_mule_encoding = 0;
261    
262    readchar_count++;    readchar_count++;
263    
# Line 242  readchar (readcharfun) Line 266  readchar (readcharfun)
266        register struct buffer *inbuffer = XBUFFER (readcharfun);        register struct buffer *inbuffer = XBUFFER (readcharfun);
267    
268        int pt_byte = BUF_PT_BYTE (inbuffer);        int pt_byte = BUF_PT_BYTE (inbuffer);
       int orig_pt_byte = pt_byte;  
   
       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);  
269    
270        if (pt_byte >= BUF_ZV_BYTE (inbuffer))        if (pt_byte >= BUF_ZV_BYTE (inbuffer))
271          return -1;          return -1;
272    
       readchar_backlog = -1;  
   
273        if (! NILP (inbuffer->enable_multibyte_characters))        if (! NILP (inbuffer->enable_multibyte_characters))
274          {          {
275            /* Fetch the character code from the buffer.  */            /* Fetch the character code from the buffer.  */
# Line 267  readchar (readcharfun) Line 280  readchar (readcharfun)
280        else        else
281          {          {
282            c = BUF_FETCH_BYTE (inbuffer, pt_byte);            c = BUF_FETCH_BYTE (inbuffer, pt_byte);
283              if (! ASCII_BYTE_P (c))
284                c = BYTE8_TO_CHAR (c);
285            pt_byte++;            pt_byte++;
286          }          }
287        SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);        SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
# Line 278  readchar (readcharfun) Line 293  readchar (readcharfun)
293        register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;        register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
294    
295        int bytepos = marker_byte_position (readcharfun);        int bytepos = marker_byte_position (readcharfun);
       int orig_bytepos = bytepos;  
   
       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);  
296    
297        if (bytepos >= BUF_ZV_BYTE (inbuffer))        if (bytepos >= BUF_ZV_BYTE (inbuffer))
298          return -1;          return -1;
299    
       readchar_backlog = -1;  
   
300        if (! NILP (inbuffer->enable_multibyte_characters))        if (! NILP (inbuffer->enable_multibyte_characters))
301          {          {
302            /* Fetch the character code from the buffer.  */            /* Fetch the character code from the buffer.  */
# Line 303  readchar (readcharfun) Line 307  readchar (readcharfun)
307        else        else
308          {          {
309            c = BUF_FETCH_BYTE (inbuffer, bytepos);            c = BUF_FETCH_BYTE (inbuffer, bytepos);
310              if (! ASCII_BYTE_P (c))
311                c = BYTE8_TO_CHAR (c);
312            bytepos++;            bytepos++;
313          }          }
314    
# Line 313  readchar (readcharfun) Line 319  readchar (readcharfun)
319      }      }
320    
321    if (EQ (readcharfun, Qlambda))    if (EQ (readcharfun, Qlambda))
322      return read_bytecode_char (0);      {
323          readbyte = readbyte_for_lambda;
324          goto read_multibyte;
325        }
326    
327    if (EQ (readcharfun, Qget_file_char))    if (EQ (readcharfun, Qget_file_char))
328      {      {
329        c = getc (instream);        readbyte = readbyte_from_file;
330  #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;  
331      }      }
332    
333    if (STRINGP (readcharfun))    if (STRINGP (readcharfun))
# Line 341  readchar (readcharfun) Line 342  readchar (readcharfun)
342        return c;        return c;
343      }      }
344    
345      if (CONSP (readcharfun))
346        {
347          /* This is the case that read_vector is reading from a unibyte
348             string that contains a byte sequence previously skipped
349             because of #@NUMBER.  The car part of readcharfun is that
350             string, and the cdr part is a value of readcharfun given to
351             read_vector.  */
352          readbyte = readbyte_from_string;
353          if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
354            emacs_mule_encoding = 1;
355          goto read_multibyte;
356        }
357    
358      if (EQ (readcharfun, Qget_emacs_mule_file_char))
359        {
360          readbyte = readbyte_from_file;
361          emacs_mule_encoding = 1;
362          goto read_multibyte;
363        }
364    
365    tem = call0 (readcharfun);    tem = call0 (readcharfun);
366    
367    if (NILP (tem))    if (NILP (tem))
368      return -1;      return -1;
369    return XINT (tem);    return XINT (tem);
370    
371     read_multibyte:
372      if (unread_char >= 0)
373        {
374          c = unread_char;
375          unread_char = -1;
376          return c;
377        }
378      c = (*readbyte) (-1, readcharfun);
379      if (c < 0 || ASCII_BYTE_P (c) || load_each_byte)
380        return c;
381      if (emacs_mule_encoding)
382        return read_emacs_mule_char (c, readbyte, readcharfun);
383      i = 0;
384      buf[i++] = c;
385      len = BYTES_BY_CHAR_HEAD (c);
386      while (i < len)
387        {
388          c = (*readbyte) (-1, readcharfun);
389          if (c < 0 || ! TRAILING_CODE_P (c))
390            {
391              while (--i > 1)
392                (*readbyte) (buf[i], readcharfun);
393              return BYTE8_TO_CHAR (buf[0]);
394            }
395          buf[i++] = c;
396        }
397      return STRING_CHAR (buf, i);
398  }  }
399    
400  /* Unread the character C in the way appropriate for the stream READCHARFUN.  /* Unread the character C in the way appropriate for the stream READCHARFUN.
# Line 366  unreadchar (readcharfun, c) Line 415  unreadchar (readcharfun, c)
415        struct buffer *b = XBUFFER (readcharfun);        struct buffer *b = XBUFFER (readcharfun);
416        int bytepos = BUF_PT_BYTE (b);        int bytepos = BUF_PT_BYTE (b);
417    
418        if (readchar_backlog >= 0)        BUF_PT (b)--;
419          readchar_backlog++;        if (! NILP (b->enable_multibyte_characters))
420            BUF_DEC_POS (b, bytepos);
421        else        else
422          {          bytepos--;
           BUF_PT (b)--;  
           if (! NILP (b->enable_multibyte_characters))  
             BUF_DEC_POS (b, bytepos);  
           else  
             bytepos--;  
423    
424            BUF_PT_BYTE (b) = bytepos;        BUF_PT_BYTE (b) = bytepos;
         }  
425      }      }
426    else if (MARKERP (readcharfun))    else if (MARKERP (readcharfun))
427      {      {
428        struct buffer *b = XMARKER (readcharfun)->buffer;        struct buffer *b = XMARKER (readcharfun)->buffer;
429        int bytepos = XMARKER (readcharfun)->bytepos;        int bytepos = XMARKER (readcharfun)->bytepos;
430    
431        if (readchar_backlog >= 0)        XMARKER (readcharfun)->charpos--;
432          readchar_backlog++;        if (! NILP (b->enable_multibyte_characters))
433            BUF_DEC_POS (b, bytepos);
434        else        else
435          {          bytepos--;
           XMARKER (readcharfun)->charpos--;  
           if (! NILP (b->enable_multibyte_characters))  
             BUF_DEC_POS (b, bytepos);  
           else  
             bytepos--;  
436    
437            XMARKER (readcharfun)->bytepos = bytepos;        XMARKER (readcharfun)->bytepos = bytepos;
         }  
438      }      }
439    else if (STRINGP (readcharfun))    else if (STRINGP (readcharfun))
440      {      {
# Line 403  unreadchar (readcharfun, c) Line 442  unreadchar (readcharfun, c)
442        read_from_string_index_byte        read_from_string_index_byte
443          = string_char_to_byte (readcharfun, read_from_string_index);          = string_char_to_byte (readcharfun, read_from_string_index);
444      }      }
445      else if (CONSP (readcharfun))
446        {
447          unread_char = c;
448        }
449    else if (EQ (readcharfun, Qlambda))    else if (EQ (readcharfun, Qlambda))
450      read_bytecode_char (1);      {
451    else if (EQ (readcharfun, Qget_file_char))        unread_char = c;
452      ungetc (c, instream);      }
453      else if (EQ (readcharfun, Qget_file_char)
454               || EQ (readcharfun, Qget_emacs_mule_file_char))
455        {
456          if (load_each_byte)
457            ungetc (c, instream);
458          else
459            unread_char = c;
460        }
461    else    else
462      call1 (readcharfun, make_number (c));      call1 (readcharfun, make_number (c));
463  }  }
464    
465    static int
466    readbyte_for_lambda (c, readcharfun)
467         int c;
468         Lisp_Object readcharfun;
469    {
470      return read_bytecode_char (c >= 0);
471    }
472    
473    
474    static int
475    readbyte_from_file (c, readcharfun)
476         int c;
477         Lisp_Object readcharfun;
478    {
479      if (c >= 0)
480        {
481          ungetc (c, instream);
482          return 0;
483        }
484    
485      c = getc (instream);
486    #ifdef EINTR
487      /* Interrupted reads have been observed while reading over the network */
488      while (c == EOF && ferror (instream) && errno == EINTR)
489        {
490          clearerr (instream);
491          c = getc (instream);
492        }
493    #endif
494      return (c == EOF ? -1 : c);
495    }
496    
497    static int
498    readbyte_from_string (c, readcharfun)
499         int c;
500         Lisp_Object readcharfun;
501    {
502      Lisp_Object string = XCAR (readcharfun);
503    
504      if (c >= 0)
505        {
506          read_from_string_index--;
507          read_from_string_index_byte
508            = string_char_to_byte (string, read_from_string_index);
509        }
510    
511      if (read_from_string_index >= read_from_string_limit)
512        c = -1;
513      else
514        FETCH_STRING_CHAR_ADVANCE (c, string,
515                                   read_from_string_index,
516                                   read_from_string_index_byte);
517      return c;
518    }
519    
520    
521    /* Read one non-ASCII character from INSTREAM.  The character is
522       encoded in `emacs-mule' and the first byte is already read in
523       C.  */
524    
525    extern char emacs_mule_bytes[256];
526    
527    static int
528    read_emacs_mule_char (c, readbyte, readcharfun)
529         int c;
530         int (*readbyte) P_ ((int, Lisp_Object));
531         Lisp_Object readcharfun;
532    {
533      /* Emacs-mule coding uses at most 4-byte for one character.  */
534      unsigned char buf[4];
535      int len = emacs_mule_bytes[c];
536      struct charset *charset;
537      int i;
538      unsigned code;
539    
540      if (len == 1)
541        /* C is not a valid leading-code of `emacs-mule'.  */
542        return BYTE8_TO_CHAR (c);
543    
544      i = 0;
545      buf[i++] = c;
546      while (i < len)
547        {
548          c = (*readbyte) (-1, readcharfun);
549          if (c < 0xA0)
550            {
551              while (--i > 1)
552                (*readbyte) (buf[i], readcharfun);
553              return BYTE8_TO_CHAR (buf[0]);
554            }
555          buf[i++] = c;
556        }
557    
558      if (len == 2)
559        {
560          charset = emacs_mule_charset[buf[0]];
561          code = buf[1] & 0x7F;
562        }
563      else if (len == 3)
564        {
565          if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
566              || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
567            {
568              charset = emacs_mule_charset[buf[1]];
569              code = buf[2] & 0x7F;
570            }
571          else
572            {
573              charset = emacs_mule_charset[buf[0]];
574              code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
575            }
576        }
577      else
578        {
579          charset = emacs_mule_charset[buf[1]];
580          code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
581        }
582      c = DECODE_CHAR (charset, code);
583      if (c < 0)
584        Fsignal (Qinvalid_read_syntax,
585                 Fcons (build_string ("invalid multibyte form"), Qnil));
586      return c;
587    }
588    
589    
590  static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,  static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
591                                              Lisp_Object));                                              Lisp_Object));
592  static Lisp_Object read0 P_ ((Lisp_Object));  static Lisp_Object read0 P_ ((Lisp_Object));
# Line 418  static Lisp_Object read1 P_ ((Lisp_Objec Line 594  static Lisp_Object read1 P_ ((Lisp_Objec
594    
595  static Lisp_Object read_list P_ ((int, Lisp_Object));  static Lisp_Object read_list P_ ((int, Lisp_Object));
596  static Lisp_Object read_vector P_ ((Lisp_Object, int));  static Lisp_Object read_vector P_ ((Lisp_Object, int));
 static int read_multibyte P_ ((int, Lisp_Object));  
597    
598  static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,  static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
599                                                    Lisp_Object));                                                    Lisp_Object));
# Line 593  DEFUN ("get-file-char", Fget_file_char, Line 768  DEFUN ("get-file-char", Fget_file_char,
768    
769    
770    
771  /* Value is non-zero if the file asswociated with file descriptor FD  /* Value is a version number of byte compiled code if the file
772     is a compiled Lisp file that's safe to load.  Only files compiled     asswociated with file descriptor FD is a compiled Lisp file that's
773     with Emacs are safe to load.  Files compiled with XEmacs can lead     safe to load.  Only files compiled with Emacs are safe to load.
774     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
775     byte compiler.  */     because of an incompatible change in the byte compiler.  */
776    
777  static int  static int
778  safe_to_load_p (fd)  safe_to_load_p (fd)
# Line 606  safe_to_load_p (fd) Line 781  safe_to_load_p (fd)
781    char buf[512];    char buf[512];
782    int nbytes, i;    int nbytes, i;
783    int safe_p = 1;    int safe_p = 1;
784      int version = 1;
785    
786    /* Read the first few bytes from the file, and look for a line    /* Read the first few bytes from the file, and look for a line
787       specifying the byte compiler version used.  */       specifying the byte compiler version used.  */
# Line 615  safe_to_load_p (fd) Line 791  safe_to_load_p (fd)
791        buf[nbytes] = '\0';        buf[nbytes] = '\0';
792    
793        /* Skip to the next newline, skipping over the initial `ELC'        /* Skip to the next newline, skipping over the initial `ELC'
794           with NUL bytes following it.  */           with NUL bytes following it, but note the version.  */
795        for (i = 0; i < nbytes && buf[i] != '\n'; ++i)        for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
796          ;          if (i == 4)
797              version = buf[i];
798    
799        if (i < nbytes        if (i == nbytes
800            && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,            || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
801                                                buf + i) < 0)                                                buf + i) < 0)
802          safe_p = 0;          safe_p = 0;
803      }      }
804      if (safe_p)
805        safe_p = version;
806    
807    lseek (fd, 0, SEEK_SET);    lseek (fd, 0, SEEK_SET);
808    return safe_p;    return safe_p;
# Line 683  Return t if file exists.  */) Line 862  Return t if file exists.  */)
862    Lisp_Object handler;    Lisp_Object handler;
863    int safe_p = 1;    int safe_p = 1;
864    char *fmode = "r";    char *fmode = "r";
865      int version;
866    
867  #ifdef DOS_NT  #ifdef DOS_NT
868    fmode = "rt";    fmode = "rt";
869  #endif /* DOS_NT */  #endif /* DOS_NT */
# Line 798  Return t if file exists.  */) Line 979  Return t if file exists.  */)
979      Vloads_in_progress = Fcons (found, Vloads_in_progress);      Vloads_in_progress = Fcons (found, Vloads_in_progress);
980    }    }
981    
982      version = -1;
983    if (!bcmp (SDATA (found) + SBYTES (found) - 4,    if (!bcmp (SDATA (found) + SBYTES (found) - 4,
984               ".elc", 4))               ".elc", 4)
985          || (version = safe_to_load_p (fd)) > 0)
986      /* Load .elc files directly, but not when they are      /* Load .elc files directly, but not when they are
987         remote and have no handler!  */         remote and have no handler!  */
988      {      {
# Line 808  Return t if file exists.  */) Line 991  Return t if file exists.  */)
991            struct stat s1, s2;            struct stat s1, s2;
992            int result;            int result;
993    
994            if (!safe_to_load_p (fd))            if (version < 0
995                  && ! (version = safe_to_load_p (fd)))
996              {              {
997                safe_p = 0;                safe_p = 0;
998                if (!load_dangerous_libraries)                if (!load_dangerous_libraries)
# Line 911  Return t if file exists.  */) Line 1095  Return t if file exists.  */)
1095    load_descriptor_list    load_descriptor_list
1096      = Fcons (make_number (fileno (stream)), load_descriptor_list);      = Fcons (make_number (fileno (stream)), load_descriptor_list);
1097    load_in_progress++;    load_in_progress++;
1098    readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);    if (! version || version >= 22)
1099        readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);
1100      else
1101        {
1102          /* We can't handle a file which was compiled with
1103             byte-compile-dynamic by older version of Emacs.  */
1104          specbind (Qload_force_doc_strings, Qt);
1105          readevalloop (Qget_emacs_mule_file_char, stream, file, Feval, 0,
1106                        Qnil, Qnil);
1107        }
1108    unbind_to (count, Qnil);    unbind_to (count, Qnil);
1109    
1110    /* Run any load-hooks for this file.  */    /* Run any load-hooks for this file.  */
# Line 1317  readevalloop (readcharfun, stream, sourc Line 1510  readevalloop (readcharfun, stream, sourc
1510    record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);    record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1511    load_convert_to_unibyte = !NILP (unibyte);    load_convert_to_unibyte = !NILP (unibyte);
1512    
   readchar_backlog = -1;  
   
1513    GCPRO1 (sourcename);    GCPRO1 (sourcename);
1514    
1515    LOADHIST_ATTACH (sourcename);    LOADHIST_ATTACH (sourcename);
# Line 1526  read_internal_start (stream, start, end) Line 1717  read_internal_start (stream, start, end)
1717  {  {
1718    Lisp_Object retval;    Lisp_Object retval;
1719    
   readchar_backlog = -1;  
1720    readchar_count = 0;    readchar_count = 0;
1721    new_backquote_flag = 0;    new_backquote_flag = 0;
1722    read_objects = Qnil;    read_objects = Qnil;
# Line 1534  read_internal_start (stream, start, end) Line 1724  read_internal_start (stream, start, end)
1724        || EQ (Vread_with_symbol_positions, stream))        || EQ (Vread_with_symbol_positions, stream))
1725      Vread_symbol_positions_list = Qnil;      Vread_symbol_positions_list = Qnil;
1726    
1727    if (STRINGP (stream))    if (STRINGP (stream)
1728          || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1729      {      {
1730        int startval, endval;        int startval, endval;
1731          Lisp_Object string;
1732    
1733          if (STRINGP (stream))
1734            string = stream;
1735          else
1736            string = XCAR (stream);
1737    
1738        if (NILP (end))        if (NILP (end))
1739          endval = SCHARS (stream);          endval = SCHARS (string);
1740        else        else
1741          {          {
1742            CHECK_NUMBER (end);            CHECK_NUMBER (end);
1743            endval = XINT (end);            endval = XINT (end);
1744            if (endval < 0 || endval > SCHARS (stream))            if (endval < 0 || endval > SCHARS (string))
1745              args_out_of_range (stream, end);              args_out_of_range (string, end);
1746          }          }
1747    
1748        if (NILP (start))        if (NILP (start))
# Line 1554  read_internal_start (stream, start, end) Line 1752  read_internal_start (stream, start, end)
1752            CHECK_NUMBER (start);            CHECK_NUMBER (start);
1753            startval = XINT (start);            startval = XINT (start);
1754            if (startval < 0 || startval > endval)            if (startval < 0 || startval > endval)
1755              args_out_of_range (stream, start);              args_out_of_range (string, start);
1756          }          }
1757        read_from_string_index = startval;        read_from_string_index = startval;
1758        read_from_string_index_byte = string_char_to_byte (stream, startval);        read_from_string_index_byte = string_char_to_byte (string, startval);
1759        read_from_string_limit = endval;        read_from_string_limit = endval;
1760      }      }
1761    
# Line 1590  read0 (readcharfun) Line 1788  read0 (readcharfun)
1788  static int read_buffer_size;  static int read_buffer_size;
1789  static char *read_buffer;  static char *read_buffer;
1790    
 /* 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_MULTIBYTE_LENGTH];  
   int len = 0;  
   int bytes;  
   
   if (c < 0)  
     return c;  
   
   str[len++] = c;  
   while ((c = READCHAR) >= 0xA0  
          && len < MAX_MULTIBYTE_LENGTH)  
     {  
       str[len++] = c;  
       readchar_count--;  
     }  
   UNREAD (c);  
   if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))  
     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]);  
   return str[0];  
 }  
   
1791  /* Read a \-escape sequence, assuming we already read the `\'.  /* Read a \-escape sequence, assuming we already read the `\'.
1792     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, store 2 into *BYTEREP.  
    Otherwise store 0 into *BYTEREP.  */  
1793    
1794  static int  static int
1795  read_escape (readcharfun, stringp, byterep)  read_escape (readcharfun, stringp)
1796       Lisp_Object readcharfun;       Lisp_Object readcharfun;
1797       int stringp;       int stringp;
      int *byterep;  
1798  {  {
1799    register int c = READCHAR;    register int c = READCHAR;
1800    
   *byterep = 0;  
   
1801    switch (c)    switch (c)
1802      {      {
1803      case -1:      case -1:
# Line 1676  read_escape (readcharfun, stringp, byter Line 1834  read_escape (readcharfun, stringp, byter
1834          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1835        c = READCHAR;        c = READCHAR;
1836        if (c == '\\')        if (c == '\\')
1837          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1838        return c | meta_modifier;        return c | meta_modifier;
1839    
1840      case 'S':      case 'S':
# Line 1685  read_escape (readcharfun, stringp, byter Line 1843  read_escape (readcharfun, stringp, byter
1843          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1844        c = READCHAR;        c = READCHAR;
1845        if (c == '\\')        if (c == '\\')
1846          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1847        return c | shift_modifier;        return c | shift_modifier;
1848    
1849      case 'H':      case 'H':
# Line 1694  read_escape (readcharfun, stringp, byter Line 1852  read_escape (readcharfun, stringp, byter
1852          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1853        c = READCHAR;        c = READCHAR;
1854        if (c == '\\')        if (c == '\\')
1855          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1856        return c | hyper_modifier;        return c | hyper_modifier;
1857    
1858      case 'A':      case 'A':
# Line 1703  read_escape (readcharfun, stringp, byter Line 1861  read_escape (readcharfun, stringp, byter
1861          error ("Invalid escape character syntax");          error ("Invalid escape character syntax");
1862        c = READCHAR;        c = READCHAR;
1863        if (c == '\\')        if (c == '\\')
1864          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1865        return c | alt_modifier;        return c | alt_modifier;
1866    
1867      case 's':      case 's':
# Line 1716  read_escape (readcharfun, stringp, byter Line 1874  read_escape (readcharfun, stringp, byter
1874        }        }
1875        c = READCHAR;        c = READCHAR;
1876        if (c == '\\')        if (c == '\\')
1877          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1878        return c | super_modifier;        return c | super_modifier;
1879    
1880      case 'C':      case 'C':
# Line 1726  read_escape (readcharfun, stringp, byter Line 1884  read_escape (readcharfun, stringp, byter
1884      case '^':      case '^':
1885        c = READCHAR;        c = READCHAR;
1886        if (c == '\\')        if (c == '\\')
1887          c = read_escape (readcharfun, 0, byterep);          c = read_escape (readcharfun, 0);
1888        if ((c & ~CHAR_MODIFIER_MASK) == '?')        if ((c & ~CHAR_MODIFIER_MASK) == '?')
1889          return 0177 | (c & CHAR_MODIFIER_MASK);          return 0177 | (c & CHAR_MODIFIER_MASK);
1890        else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))        else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
# Line 1766  read_escape (readcharfun, stringp, byter Line 1924  read_escape (readcharfun, stringp, byter
1924                }                }
1925            }            }
1926    
1927          *byterep = 1;          if (i >= 0x80 && i < 0x100)
1928              i = BYTE8_TO_CHAR (i);
1929          return i;          return i;
1930        }        }
1931    
# Line 1774  read_escape (readcharfun, stringp, byter Line 1933  read_escape (readcharfun, stringp, byter
1933        /* A hex escape, as in ANSI C.  */        /* A hex escape, as in ANSI C.  */
1934        {        {
1935          int i = 0;          int i = 0;
1936            int count = 0;
1937          while (1)          while (1)
1938            {            {
1939              c = READCHAR;              c = READCHAR;
# Line 1796  read_escape (readcharfun, stringp, byter Line 1956  read_escape (readcharfun, stringp, byter
1956                  UNREAD (c);                  UNREAD (c);
1957                  break;                  break;
1958                }                }
1959                count++;
1960            }            }
1961    
1962          *byterep = 2;          if (count < 3 && i >= 0x80)
1963              return BYTE8_TO_CHAR (i);
1964          return i;          return i;
1965        }        }
1966    
1967      default:      default:
       if (BASE_LEADING_CODE_P (c))  
         c = read_multibyte (c, readcharfun);  
1968        return c;        return c;
1969      }      }
1970  }  }
# Line 1876  read_integer (readcharfun, radix) Line 2036  read_integer (readcharfun, radix)
2036  }  }
2037    
2038    
 /* Convert unibyte text in read_buffer to multibyte.  
   
    Initially, *P is a pointer after the end of the unibyte text, and  
    the pointer *END points after the end of read_buffer.  
   
    If read_buffer doesn't have enough room to hold the result  
    of the conversion, reallocate it and adjust *P and *END.  
   
    At the end, make *P point after the result of the conversion, and  
    return in *NCHARS the number of characters in the converted  
    text.  */  
   
 static void  
 to_multibyte (p, end, nchars)  
      char **p, **end;  
      int *nchars;  
 {  
   int nbytes;  
   
   parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars);  
   if (read_buffer_size < 2 * nbytes)  
     {  
       int offset = *p - read_buffer;  
       read_buffer_size = 2 * max (read_buffer_size, nbytes);  
       read_buffer = (char *) xrealloc (read_buffer, read_buffer_size);  
       *p = read_buffer + offset;  
       *end = read_buffer + read_buffer_size;  
     }  
   
   if (nbytes != *nchars)  
     nbytes = str_as_multibyte (read_buffer, read_buffer_size,  
                                *p - read_buffer, nchars);  
   
   *p = read_buffer + nbytes;  
 }  
   
   
2039  /* If the next token is ')' or ']' or '.', we store that character  /* If the next token is ')' or ']' or '.', we store that character
2040     in *PCH and the return value is not interesting.  Else, we store     in *PCH and the return value is not interesting.  Else, we store
2041     zero in *PCH and we read and return one lisp object.     zero in *PCH and we read and return one lisp object.
# Line 1929  read1 (readcharfun, pch, first_in_list) Line 2052  read1 (readcharfun, pch, first_in_list)
2052    int uninterned_symbol = 0;    int uninterned_symbol = 0;
2053    
2054    *pch = 0;    *pch = 0;
2055      load_each_byte = 0;
2056    
2057   retry:   retry:
2058    
# Line 1960  read1 (readcharfun, pch, first_in_list) Line 2084  read1 (readcharfun, pch, first_in_list)
2084              {              {
2085                Lisp_Object tmp;                Lisp_Object tmp;
2086                tmp = read_vector (readcharfun, 0);                tmp = read_vector (readcharfun, 0);
2087                if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS                if (XVECTOR (tmp)->size != VECSIZE (struct Lisp_Char_Table))
                   || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10)  
2088                  error ("Invalid size char-table");                  error ("Invalid size char-table");
2089                XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));                XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
               XCHAR_TABLE (tmp)->top = Qt;  
2090                return tmp;                return tmp;
2091              }              }
2092            else if (c == '^')            else if (c == '^')
# Line 1973  read1 (readcharfun, pch, first_in_list) Line 2095  read1 (readcharfun, pch, first_in_list)
2095                if (c == '[')                if (c == '[')
2096                  {                  {
2097                    Lisp_Object tmp;                    Lisp_Object tmp;
2098                      int depth, size;
2099    
2100                    tmp = read_vector (readcharfun, 0);                    tmp = read_vector (readcharfun, 0);
2101                    if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS)                    if (!INTEGERP (AREF (tmp, 0)))
2102                        error ("Invalid depth in char-table");
2103                      depth = XINT (AREF (tmp, 0));
2104                      if (depth < 1 || depth > 3)
2105                        error ("Invalid depth in char-table");
2106                      size = XVECTOR (tmp)->size + 2;
2107                      if (chartab_size [depth] != size)
2108                      error ("Invalid size char-table");                      error ("Invalid size char-table");
2109                    XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));                    XSETSUB_CHAR_TABLE (tmp, XSUB_CHAR_TABLE (tmp));
                   XCHAR_TABLE (tmp)->top = Qnil;  
2110                    return tmp;                    return tmp;
2111                  }                  }
2112                Fsignal (Qinvalid_read_syntax,                Fsignal (Qinvalid_read_syntax,
# Line 1998  read1 (readcharfun, pch, first_in_list) Line 2127  read1 (readcharfun, pch, first_in_list)
2127    
2128                UNREAD (c);                UNREAD (c);
2129                tmp = read1 (readcharfun, pch, first_in_list);                tmp = read1 (readcharfun, pch, first_in_list);
2130                if (size_in_chars != SCHARS (tmp)                if (STRING_MULTIBYTE (tmp)
2131                    /* We used to print 1 char too many                    || (size_in_chars != SCHARS (tmp)
2132                       when the number of bits was a multiple of 8.                        /* We used to print 1 char too many
2133                       Accept such input in case it came from an old version.  */                           when the number of bits was a multiple of 8.
2134                    && ! (XFASTINT (length)                           Accept such input in case it came from an old
2135                          == (SCHARS (tmp) - 1) * BITS_PER_CHAR))                           version.  */
2136                          && ! (XFASTINT (length)
2137                                == (SCHARS (tmp) - 1) * BITS_PER_CHAR)))
2138                  Fsignal (Qinvalid_read_syntax,                  Fsignal (Qinvalid_read_syntax,
2139                           Fcons (make_string ("#&...", 5), Qnil));                           Fcons (make_string ("#&...", 5), Qnil));
2140    
# Line 2069  read1 (readcharfun, pch, first_in_list) Line 2200  read1 (readcharfun, pch, first_in_list)
2200          {          {
2201            int i, nskip = 0;            int i, nskip = 0;
2202    
2203              load_each_byte = 1;
2204            /* Read a decimal integer.  */            /* Read a decimal integer.  */
2205            while ((c = READCHAR) >= 0            while ((c = READCHAR) >= 0
2206                   && c >= '0' && c <= '9')                   && c >= '0' && c <= '9')
# Line 2079  read1 (readcharfun, pch, first_in_list) Line 2211  read1 (readcharfun, pch, first_in_list)
2211            if (c >= 0)            if (c >= 0)
2212              UNREAD (c);              UNREAD (c);
2213    
2214            if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))            if (load_force_doc_strings
2215                  && (EQ (readcharfun, Qget_file_char)
2216                      || EQ (readcharfun, Qget_emacs_mule_file_char)))
2217              {              {
2218                /* If we are supposed to force doc strings into core right now,                /* If we are supposed to force doc strings into core right now,
2219                   record the last string that we skipped,                   record the last string that we skipped,
# Line 2131  read1 (readcharfun, pch, first_in_list) Line 2265  read1 (readcharfun, pch, first_in_list)
2265                  c = READCHAR;                  c = READCHAR;
2266              }              }
2267    
2268              load_each_byte = 0;
2269            goto retry;            goto retry;
2270          }          }
2271        if (c == '!')        if (c == '!')
# Line 2260  read1 (readcharfun, pch, first_in_list) Line 2395  read1 (readcharfun, pch, first_in_list)
2395    
2396      case '?':      case '?':
2397        {        {
2398          int discard;          int modifiers;
2399          int next_char;          int next_char;
2400          int ok;          int ok;
2401    
# Line 2276  read1 (readcharfun, pch, first_in_list) Line 2411  read1 (readcharfun, pch, first_in_list)
2411            return make_number (c);            return make_number (c);
2412    
2413          if (c == '\\')          if (c == '\\')
2414            c = read_escape (readcharfun, 0, &discard);            c = read_escape (readcharfun, 0);
2415          else if (BASE_LEADING_CODE_P (c))          modifiers = c & CHAR_MODIFIER_MASK;
2416            c = read_multibyte (c, readcharfun);          c &= ~CHAR_MODIFIER_MASK;
2417            if (CHAR_BYTE8_P (c))
2418              c = CHAR_TO_BYTE8 (c);
2419            c |= modifiers;
2420    
2421          next_char = READCHAR;          next_char = READCHAR;
2422          if (next_char == '.')          if (next_char == '.')
# Line 2313  read1 (readcharfun, pch, first_in_list) Line 2451  read1 (readcharfun, pch, first_in_list)
2451          char *p = read_buffer;          char *p = read_buffer;
2452          char *end = read_buffer + read_buffer_size;          char *end = read_buffer + read_buffer_size;
2453          register int c;          register int c;
2454          /* 1 if we saw an escape sequence specifying          /* Nonzero if we saw an escape sequence specifying
2455             a multibyte character, or a multibyte character.  */             a multibyte character.  */
2456          int force_multibyte = 0;          int force_multibyte = 0;
2457          /* 1 if we saw an escape sequence specifying          /* Nonzero if we saw an escape sequence specifying
2458             a single-byte character.  */             a single-byte character.  */
2459          int force_singlebyte = 0;          int force_singlebyte = 0;
         /* 1 if read_buffer contains multibyte text now.  */  
         int is_multibyte = 0;  
2460          int cancel = 0;          int cancel = 0;
2461          int nchars = 0;          int nchars = 0;
2462    
# Line 2338  read1 (readcharfun, pch, first_in_list) Line 2474  read1 (readcharfun, pch, first_in_list)
2474    
2475              if (c == '\\')              if (c == '\\')
2476                {                {
2477                  int byterep;                  int modifiers;
2478    
2479                  c = read_escape (readcharfun, 1, &byterep);                  c = read_escape (readcharfun, 1);
2480    
2481                  /* C is -1 if \ newline has just been seen */                  /* C is -1 if \ newline has just been seen */
2482                  if (c == -1)                  if (c == -1)
# Line 2350  read1 (readcharfun, pch, first_in_list) Line 2486  read1 (readcharfun, pch, first_in_list)
2486                      continue;                      continue;
2487                    }                    }
2488    
2489                  if (byterep == 1)                  modifiers = c & CHAR_MODIFIER_MASK;
2490                    c = c & ~CHAR_MODIFIER_MASK;
2491    
2492                    if (CHAR_BYTE8_P (c))
2493                    force_singlebyte = 1;                    force_singlebyte = 1;
2494                  else if (byterep == 2)                  else if (! ASCII_CHAR_P (c))
2495                    force_multibyte = 1;                    force_multibyte = 1;
2496                }                  else            /* i.e. ASCII_CHAR_P (c) */
2497                      {
2498                        /* Allow `\C- ' and `\C-?'.  */
2499                        if (modifiers == CHAR_CTL)
2500                          {
2501                            if (c == ' ')
2502                              c = 0, modifiers = 0;
2503                            else if (c == '?')
2504                              c = 127, modifiers = 0;
2505                          }
2506                        if (modifiers & CHAR_SHIFT)
2507                          {
2508                            /* Shift modifier is valid only with [A-Za-z].  */
2509                            if (c >= 'A' && c <= 'Z')
2510                              modifiers &= ~CHAR_SHIFT;
2511                            else if (c >= 'a' && c <= 'z')
2512                              c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2513                          }
2514    
2515                        if (modifiers & CHAR_META)
2516                          {
2517                            /* Move the meta bit to the right place for a
2518                               string.  */
2519                            modifiers &= ~CHAR_META;
2520                            c = BYTE8_TO_CHAR (c | 0x80);
2521                            force_singlebyte = 1;
2522                          }
2523                      }
2524    
2525              /* A character that must be multibyte forces multibyte.  */                  /* Any modifiers remaining are invalid.  */
2526              if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK))                  if (modifiers)
2527                force_multibyte = 1;                    error ("Invalid modifier in string");
2528                    p += CHAR_STRING (c, (unsigned char *) p);
             /* If we just discovered the need to be multibyte,  
                convert the text accumulated thus far.  */  
             if (force_multibyte && ! is_multibyte)  
               {  
                 is_multibyte = 1;  
                 to_multibyte (&p, &end, &nchars);  
2529                }                }
2530                else
             /* Allow `\C- ' and `\C-?'.  */  
             if (c == (CHAR_CTL | ' '))  
               c = 0;  
             else if (c == (CHAR_CTL | '?'))  
               c = 127;  
               
             if (c & CHAR_SHIFT)  
2531                {                {
2532                  /* Shift modifier is valid only with [A-Za-z].  */                  p += CHAR_STRING (c, (unsigned char *) p);
2533                  if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')                  if (CHAR_BYTE8_P (c))
2534                    c &= ~CHAR_SHIFT;                    force_singlebyte = 1;
2535                  else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')                  else if (! ASCII_CHAR_P (c))
2536                    c = (c & ~CHAR_SHIFT) - ('a' - 'A');                    force_multibyte = 1;
2537                }                }
   
             if (c & CHAR_META)  
               /* Move the meta bit to the right place for a string.  */  
               c = (c & ~CHAR_META) | 0x80;  
             if (c & CHAR_MODIFIER_MASK)  
               error ("Invalid modifier in string");  
   
             if (is_multibyte)  
               p += CHAR_STRING (c, p);  
             else  
               *p++ = c;  
   
2538              nchars++;              nchars++;
2539            }            }
2540    
# Line 2406  read1 (readcharfun, pch, first_in_list) Line 2547  read1 (readcharfun, pch, first_in_list)
2547          if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)          if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2548            return make_number (0);            return make_number (0);
2549    
2550          if (is_multibyte || force_singlebyte)          if (force_multibyte)
2551              /* READ_BUFFER already contains valid multibyte forms.  */
2552            ;            ;
2553          else if (load_convert_to_unibyte)          else if (force_singlebyte)
           {  
             Lisp_Object string;  
             to_multibyte (&p, &end, &nchars);  
             if (p - read_buffer != nchars)  
               {  
                 string = make_multibyte_string (read_buffer, nchars,  
                                                 p - read_buffer);  
                 return Fstring_make_unibyte (string);  
               }  
             /* We can make a unibyte string directly.  */  
             is_multibyte = 0;  
           }  
         else if (EQ (readcharfun, Qget_file_char)  
                  || EQ (readcharfun, Qlambda))  
2554            {            {
2555              /* Nowadays, reading directly from a file is used only for              nchars = str_as_unibyte (read_buffer, p - read_buffer);
2556                 compiled Emacs Lisp files, and those always use the              p = read_buffer + nchars;
                Emacs internal encoding.  Meanwhile, Qlambda is used  
                for reading dynamic byte code (compiled with  
                byte-compile-dynamic = t).  So make the string multibyte  
                if the string contains any multibyte sequences.  
                (to_multibyte is a no-op if not.)  */  
             to_multibyte (&p, &end, &nchars);  
             is_multibyte = (p - read_buffer) != nchars;  
2557            }            }
2558          else          else
2559            /* In all other cases, if we read these bytes as            /* Otherwise, READ_BUFFER contains only ASCII.  */
              separate characters, treat them as separate characters now.  */  
2560            ;            ;
2561    
2562          /* We want readchar_count to be the number of characters, not          /* We want readchar_count to be the number of characters, not
# Line 2446  read1 (readcharfun, pch, first_in_list) Line 2566  read1 (readcharfun, pch, first_in_list)
2566          /* readchar_count -= (p - read_buffer) - nchars; */          /* readchar_count -= (p - read_buffer) - nchars; */
2567          if (read_pure)          if (read_pure)
2568            return make_pure_string (read_buffer, nchars, p - read_buffer,            return make_pure_string (read_buffer, nchars, p - read_buffer,
2569                                     is_multibyte);                                     (force_multibyte
2570                                        || (p - read_buffer != nchars)));
2571          return make_specified_string (read_buffer, nchars, p - read_buffer,          return make_specified_string (read_buffer, nchars, p - read_buffer,
2572                                        is_multibyte);                                        (force_multibyte
2573                                           || (p - read_buffer != nchars)));
2574        }        }
2575    
2576      case '.':      case '.':
# Line 2503  read1 (readcharfun, pch, first_in_list) Line 2625  read1 (readcharfun, pch, first_in_list)
2625                    quoted = 1;                    quoted = 1;
2626                  }                  }
2627    
2628                if (! SINGLE_BYTE_CHAR_P (c))                p += CHAR_STRING (c, p);
                 p += CHAR_STRING (c, p);  
               else  
                 *p++ = c;  
   
2629                c = READCHAR;                c = READCHAR;
2630              }              }
2631    
# Line 2541  read1 (readcharfun, pch, first_in_list) Line 2659  read1 (readcharfun, pch, first_in_list)
2659                    {                    {
2660                      if (p1[-1] == '.')                      if (p1[-1] == '.')
2661                        p1[-1] = '\0';                        p1[-1] = '\0';
2662                        /* Fixme: if we have strtol, use that, and check
2663                           for overflow.  */
2664                      if (sizeof (int) == sizeof (EMACS_INT))                      if (sizeof (int) == sizeof (EMACS_INT))
2665                        XSETINT (val, atoi (read_buffer));                        XSETINT (val, atoi (read_buffer));
2666                      else if (sizeof (long) == sizeof (EMACS_INT))                      else if (sizeof (long) == sizeof (EMACS_INT))
# Line 2844  read_vector (readcharfun, bytecodeflag) Line 2964  read_vector (readcharfun, bytecodeflag)
2964                    STRING_SET_CHARS (bytestr, SBYTES (bytestr));                    STRING_SET_CHARS (bytestr, SBYTES (bytestr));
2965                    STRING_SET_UNIBYTE (bytestr);                    STRING_SET_UNIBYTE (bytestr);
2966    
2967                    item = Fread (bytestr);                    item = Fread (Fcons (bytestr, readcharfun));
2968                    if (!CONSP (item))                    if (!CONSP (item))
2969                      error ("invalid byte code");                      error ("invalid byte code");
2970    
# Line 2857  read_vector (readcharfun, bytecodeflag) Line 2977  read_vector (readcharfun, bytecodeflag)
2977                /* Now handle the bytecode slot.  */                /* Now handle the bytecode slot.  */
2978                ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;                ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
2979              }              }
2980              else if (i == COMPILED_DOC_STRING
2981                       && STRINGP (item)
2982                       && ! STRING_MULTIBYTE (item))
2983                {
2984                  if (EQ (readcharfun, Qget_emacs_mule_file_char))
2985                    item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
2986                  else
2987                    item = Fstring_as_multibyte (item);
2988                }
2989          }          }
2990        ptr[i] = read_pure ? Fpurecopy (item) : item;        ptr[i] = read_pure ? Fpurecopy (item) : item;
2991        otem = XCONS (tem);        otem = XCONS (tem);
# Line 2954  read_list (flag, readcharfun) Line 3083  read_list (flag, readcharfun)
3083                    if (doc_reference == 2)                    if (doc_reference == 2)
3084                      {                      {
3085                        /* Get a doc string from the file we are loading.                        /* Get a doc string from the file we are loading.
3086                           If it's in saved_doc_string, get it from there.  */                           If it's in saved_doc_string, get it from there.
3087    
3088                             Here, we don't know if the string is a
3089                             bytecode string or a doc string.  As a
3090                             bytecode string must be unibyte, we always
3091                             return a unibyte string.  If it is actually a
3092                             doc string, caller must make it
3093                             multibyte.  */
3094    
3095                        int pos = XINT (XCDR (val));                        int pos = XINT (XCDR (val));
3096                        /* Position is negative for user variables.  */                        /* Position is negative for user variables.  */
3097                        if (pos < 0) pos = -pos;                        if (pos < 0) pos = -pos;
# Line 2986  read_list (flag, readcharfun) Line 3123  read_list (flag, readcharfun)
3123                                  saved_doc_string[to++] = c;                                  saved_doc_string[to++] = c;
3124                              }                              }
3125    
3126                            return make_string (saved_doc_string + start,                            return make_unibyte_string (saved_doc_string + start,
3127                                                to - start);                                                        to - start);
3128                          }                          }
3129                        /* Look in prev_saved_doc_string the same way.  */                        /* Look in prev_saved_doc_string the same way.  */
3130                        else if (pos >= prev_saved_doc_string_position                        else if (pos >= prev_saved_doc_string_position
# Line 3018  read_list (flag, readcharfun) Line 3155  read_list (flag, readcharfun)
3155                                  prev_saved_doc_string[to++] = c;                                  prev_saved_doc_string[to++] = c;
3156                              }                              }
3157    
3158                            return make_string (prev_saved_doc_string + start,                            return make_unibyte_string (prev_saved_doc_string
3159                                                to - start);                                                        + start,
3160                                                          to - start);
3161                          }                          }
3162                        else                        else
3163                          return get_doc_string (val, 0, 0);                          return get_doc_string (val, 1, 0);
3164                      }                      }
3165    
3166                    return val;                    return val;
# Line 3937  to load.  See also `load-dangerous-libra Line 4075  to load.  See also `load-dangerous-libra
4075    Qget_file_char = intern ("get-file-char");    Qget_file_char = intern ("get-file-char");
4076    staticpro (&Qget_file_char);    staticpro (&Qget_file_char);
4077    
4078      Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
4079      staticpro (&Qget_emacs_mule_file_char);
4080    
4081      Qload_force_doc_strings = intern ("load-force-doc-strings");
4082      staticpro (&Qload_force_doc_strings);
4083    
4084    Qbackquote = intern ("`");    Qbackquote = intern ("`");
4085    staticpro (&Qbackquote);    staticpro (&Qbackquote);
4086    Qcomma = intern (",");    Qcomma = intern (",");

Legend:
Removed from v.1.317  
changed lines
  Added in v.1.317.2.1

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