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

Diff of /emacs/src/print.c

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

revision 1.175 by raeburn, Mon May 20 08:06:27 2002 UTC revision 1.175.2.1 by miles, Fri Apr 4 06:21:02 2003 UTC
# Line 91  Lisp_Object Vfloat_output_format, Qfloat Line 91  Lisp_Object Vfloat_output_format, Qfloat
91  /* Avoid actual stack overflow in print.  */  /* Avoid actual stack overflow in print.  */
92  int print_depth;  int print_depth;
93    
94    /* Nonzero if inside outputting backquote in old style.  */
95    int old_backquote_output;
96    
97  /* Detect most circularities to print finite output.  */  /* Detect most circularities to print finite output.  */
98  #define PRINT_CIRCLE 200  #define PRINT_CIRCLE 200
99  Lisp_Object being_printed[PRINT_CIRCLE];  Lisp_Object being_printed[PRINT_CIRCLE];
# Line 186  void print_interval (); Line 189  void print_interval ();
189     and must start with PRINTPREPARE, end with PRINTFINISH,     and must start with PRINTPREPARE, end with PRINTFINISH,
190     and use PRINTDECLARE to declare common variables.     and use PRINTDECLARE to declare common variables.
191     Use PRINTCHAR to output one character,     Use PRINTCHAR to output one character,
192     or call strout to output a block of characters. */     or call strout to output a block of characters. */
193    
194  #define PRINTDECLARE                                                    \  #define PRINTDECLARE                                                    \
195     struct buffer *old = current_buffer;                                 \     struct buffer *old = current_buffer;                                 \
196     int old_point = -1, start_point = -1;                                \     int old_point = -1, start_point = -1;                                \
197     int old_point_byte = -1, start_point_byte = -1;                      \     int old_point_byte = -1, start_point_byte = -1;                      \
198     int specpdl_count = specpdl_ptr - specpdl;                           \     int specpdl_count = SPECPDL_INDEX ();                                \
199     int free_print_buffer = 0;                                           \     int free_print_buffer = 0;                                           \
200     int multibyte = !NILP (current_buffer->enable_multibyte_characters); \     int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
201     Lisp_Object original     Lisp_Object original
# Line 290  static Lisp_Object Line 293  static Lisp_Object
293  print_unwind (saved_text)  print_unwind (saved_text)
294       Lisp_Object saved_text;       Lisp_Object saved_text;
295  {  {
296    bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size);    bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
297    return Qnil;    return Qnil;
298  }  }
299    
# Line 318  printchar (ch, fun) Line 321  printchar (ch, fun)
321        int len = CHAR_STRING (ch, str);        int len = CHAR_STRING (ch, str);
322    
323        QUIT;        QUIT;
324          
325        if (NILP (fun))        if (NILP (fun))
326          {          {
327            if (print_buffer_pos_byte + len >= print_buffer_size)            if (print_buffer_pos_byte + len >= print_buffer_size)
# Line 337  printchar (ch, fun) Line 340  printchar (ch, fun)
340          {          {
341            int multibyte_p            int multibyte_p
342              = !NILP (current_buffer->enable_multibyte_characters);              = !NILP (current_buffer->enable_multibyte_characters);
343              
344            setup_echo_area_for_printing (multibyte_p);            setup_echo_area_for_printing (multibyte_p);
345            insert_char (ch);            insert_char (ch);
346            message_dolog (str, len, 0, multibyte_p);            message_dolog (str, len, 0, multibyte_p);
# Line 394  strout (ptr, size, size_byte, printcharf Line 397  strout (ptr, size, size_byte, printcharf
397        int i;        int i;
398        int multibyte_p        int multibyte_p
399          = !NILP (current_buffer->enable_multibyte_characters);          = !NILP (current_buffer->enable_multibyte_characters);
400          
401        setup_echo_area_for_printing (multibyte_p);        setup_echo_area_for_printing (multibyte_p);
402        message_dolog (ptr, size_byte, 0, multibyte_p);        message_dolog (ptr, size_byte, 0, multibyte_p);
403          
404        if (size == size_byte)        if (size == size_byte)
405          {          {
406            for (i = 0; i < size; ++i)            for (i = 0; i < size; ++i)
# Line 412  strout (ptr, size, size_byte, printcharf Line 415  strout (ptr, size, size_byte, printcharf
415                insert_char (ch);                insert_char (ch);
416              }              }
417          }          }
418          
419  #ifdef MAX_PRINT_CHARS  #ifdef MAX_PRINT_CHARS
420        if (max_print)        if (max_print)
421          print_chars += size;          print_chars += size;
# Line 461  print_string (string, printcharfun) Line 464  print_string (string, printcharfun)
464        int chars;        int chars;
465    
466        if (STRING_MULTIBYTE (string))        if (STRING_MULTIBYTE (string))
467          chars = XSTRING (string)->size;          chars = SCHARS (string);
468        else if (EQ (printcharfun, Qt)        else if (EQ (printcharfun, Qt)
469                 ? ! NILP (buffer_defaults.enable_multibyte_characters)                 ? ! NILP (buffer_defaults.enable_multibyte_characters)
470                 : ! NILP (current_buffer->enable_multibyte_characters))                 : ! NILP (current_buffer->enable_multibyte_characters))
# Line 472  print_string (string, printcharfun) Line 475  print_string (string, printcharfun)
475            Lisp_Object newstr;            Lisp_Object newstr;
476            int bytes;            int bytes;
477    
478            chars = STRING_BYTES (XSTRING (string));            chars = SBYTES (string);
479            bytes = parse_str_to_multibyte (XSTRING (string)->data, chars);            bytes = parse_str_to_multibyte (SDATA (string), chars);
480            if (chars < bytes)            if (chars < bytes)
481              {              {
482                newstr = make_uninit_multibyte_string (chars, bytes);                newstr = make_uninit_multibyte_string (chars, bytes);
483                bcopy (XSTRING (string)->data, XSTRING (newstr)->data, chars);                bcopy (SDATA (string), SDATA (newstr), chars);
484                str_to_multibyte (XSTRING (newstr)->data, bytes, chars);                str_to_multibyte (SDATA (newstr), bytes, chars);
485                string = newstr;                string = newstr;
486              }              }
487          }          }
488        else        else
489          chars = STRING_BYTES (XSTRING (string));          chars = SBYTES (string);
490    
491        /* strout is safe for output to a frame (echo area) or to print_buffer.  */        /* strout is safe for output to a frame (echo area) or to print_buffer.  */
492        strout (XSTRING (string)->data,        strout (SDATA (string),
493                chars, STRING_BYTES (XSTRING (string)),                chars, SBYTES (string),
494                printcharfun, STRING_MULTIBYTE (string));                printcharfun, STRING_MULTIBYTE (string));
495      }      }
496    else    else
# Line 495  print_string (string, printcharfun) Line 498  print_string (string, printcharfun)
498        /* Otherwise, string may be relocated by printing one char.        /* Otherwise, string may be relocated by printing one char.
499           So re-fetch the string address for each character.  */           So re-fetch the string address for each character.  */
500        int i;        int i;
501        int size = XSTRING (string)->size;        int size = SCHARS (string);
502        int size_byte = STRING_BYTES (XSTRING (string));        int size_byte = SBYTES (string);
503        struct gcpro gcpro1;        struct gcpro gcpro1;
504        GCPRO1 (string);        GCPRO1 (string);
505        if (size == size_byte)        if (size == size_byte)
506          for (i = 0; i < size; i++)          for (i = 0; i < size; i++)
507            PRINTCHAR (XSTRING (string)->data[i]);            PRINTCHAR (SREF (string, i));
508        else        else
509          for (i = 0; i < size_byte; i++)          for (i = 0; i < size_byte; i++)
510            {            {
511              /* Here, we must convert each multi-byte form to the              /* Here, we must convert each multi-byte form to the
512                 corresponding character code before handing it to PRINTCHAR.  */                 corresponding character code before handing it to PRINTCHAR.  */
513              int len;              int len;
514              int ch = STRING_CHAR_AND_LENGTH (XSTRING (string)->data + i,              int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
515                                               size_byte - i, len);                                               size_byte - i, len);
516              if (!CHAR_VALID_P (ch, 0))              if (!CHAR_VALID_P (ch, 0))
517                {                {
518                  ch = XSTRING (string)->data[i];                  ch = SREF (string, i);
519                  len = 1;                  len = 1;
520                }                }
521              PRINTCHAR (ch);              PRINTCHAR (ch);
# Line 578  write_string_1 (data, size, printcharfun Line 581  write_string_1 (data, size, printcharfun
581    
582  void  void
583  temp_output_buffer_setup (bufname)  temp_output_buffer_setup (bufname)
584      char *bufname;      const char *bufname;
585  {  {
586    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
587    register struct buffer *old = current_buffer;    register struct buffer *old = current_buffer;
588    register Lisp_Object buf;    register Lisp_Object buf;
589    
# Line 588  temp_output_buffer_setup (bufname) Line 591  temp_output_buffer_setup (bufname)
591    
592    Fset_buffer (Fget_buffer_create (build_string (bufname)));    Fset_buffer (Fget_buffer_create (build_string (bufname)));
593    
594      Fkill_all_local_variables ();
595    current_buffer->directory = old->directory;    current_buffer->directory = old->directory;
596    current_buffer->read_only = Qnil;    current_buffer->read_only = Qnil;
597    current_buffer->filename = Qnil;    current_buffer->filename = Qnil;
# Line 608  temp_output_buffer_setup (bufname) Line 612  temp_output_buffer_setup (bufname)
612    
613  Lisp_Object  Lisp_Object
614  internal_with_output_to_temp_buffer (bufname, function, args)  internal_with_output_to_temp_buffer (bufname, function, args)
615       char *bufname;       const char *bufname;
616       Lisp_Object (*function) P_ ((Lisp_Object));       Lisp_Object (*function) P_ ((Lisp_Object));
617       Lisp_Object args;       Lisp_Object args;
618  {  {
619    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
620    Lisp_Object buf, val;    Lisp_Object buf, val;
621    struct gcpro gcpro1;    struct gcpro gcpro1;
622    
# Line 649  to display it temporarily selected. Line 653  to display it temporarily selected.
653    
654  If variable `temp-buffer-show-function' is non-nil, call it at the end  If variable `temp-buffer-show-function' is non-nil, call it at the end
655  to get the buffer displayed instead of just displaying the non-selected  to get the buffer displayed instead of just displaying the non-selected
656  buffer and calling the hook.  It gets one argument, the buffer to display.    buffer and calling the hook.  It gets one argument, the buffer to display.
657    
658  usage: (with-output-to-temp-buffer BUFFNAME BODY ...)  */)  usage: (with-output-to-temp-buffer BUFFNAME BODY ...)  */)
659       (args)       (args)
# Line 657  usage: (with-output-to-temp-buffer BUFFN Line 661  usage: (with-output-to-temp-buffer BUFFN
661  {  {
662    struct gcpro gcpro1;    struct gcpro gcpro1;
663    Lisp_Object name;    Lisp_Object name;
664    int count = specpdl_ptr - specpdl;    int count = SPECPDL_INDEX ();
665    Lisp_Object buf, val;    Lisp_Object buf, val;
666    
667    GCPRO1(args);    GCPRO1(args);
668    name = Feval (Fcar (args));    name = Feval (Fcar (args));
669    CHECK_STRING (name);    CHECK_STRING (name);
670    temp_output_buffer_setup (XSTRING (name)->data);    temp_output_buffer_setup (SDATA (name));
671    buf = Vstandard_output;    buf = Vstandard_output;
672    UNGCPRO;    UNGCPRO;
673    
# Line 771  A printed representation of an object is Line 775  A printed representation of an object is
775    PRINTFINISH;    PRINTFINISH;
776    set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));    set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
777    object = Fbuffer_string ();    object = Fbuffer_string ();
778      if (SBYTES (object) == SCHARS (object))
779        STRING_SET_UNIBYTE (object);
780    
781    Ferase_buffer ();    Ferase_buffer ();
782    set_buffer_internal (old);    set_buffer_internal (old);
# Line 919  DEFUN ("error-message-string", Ferror_me Line 925  DEFUN ("error-message-string", Ferror_me
925        && NILP (XCDR (XCDR (obj))))        && NILP (XCDR (XCDR (obj))))
926      return XCAR (XCDR (obj));      return XCAR (XCDR (obj));
927    
928    print_error_message (obj, Vprin1_to_string_buffer);    print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
929    
930    set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));    set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
931    value = Fbuffer_string ();    value = Fbuffer_string ();
# Line 936  DEFUN ("error-message-string", Ferror_me Line 942  DEFUN ("error-message-string", Ferror_me
942     STREAM (suitable for the print functions).  */     STREAM (suitable for the print functions).  */
943    
944  void  void
945  print_error_message (data, stream)  print_error_message (data, stream, context, caller)
946       Lisp_Object data, stream;       Lisp_Object data, stream;
947         char *context;
948         Lisp_Object caller;
949  {  {
950    Lisp_Object errname, errmsg, file_error, tail;    Lisp_Object errname, errmsg, file_error, tail;
951    struct gcpro gcpro1;    struct gcpro gcpro1;
952    int i;    int i;
953    
954      if (context != 0)
955        write_string_1 (context, -1, stream);
956    
957      /* If we know from where the error was signaled, show it in
958       *Messages*.  */
959      if (!NILP (caller) && SYMBOLP (caller))
960        {
961          const char *name = SDATA (SYMBOL_NAME (caller));
962          message_dolog (name, strlen (name), 0, 0);
963          message_dolog (": ", 2, 0, 0);
964        }
965    
966    errname = Fcar (data);    errname = Fcar (data);
967    
968    if (EQ (errname, Qerror))    if (EQ (errname, Qerror))
# Line 966  print_error_message (data, stream) Line 986  print_error_message (data, stream)
986    tail = Fcdr_safe (data);    tail = Fcdr_safe (data);
987    GCPRO1 (tail);    GCPRO1 (tail);
988    
   /* If we know from where the error was signaled, show it in  
      *Messages*.  */  
   if (!NILP (Vsignaling_function) && SYMBOLP (Vsignaling_function))  
     {  
       char *name = XSTRING (SYMBOL_NAME (Vsignaling_function))->data;  
       message_dolog (name, strlen (name), 0, 0);  
       message_dolog (": ", 2, 0, 0);  
       Vsignaling_function = Qnil;  
     }  
   
989    /* For file-error, make error message by concatenating    /* For file-error, make error message by concatenating
990       all the data items.  They are all strings.  */       all the data items.  They are all strings.  */
991    if (!NILP (file_error) && CONSP (tail))    if (!NILP (file_error) && CONSP (tail))
# Line 997  print_error_message (data, stream) Line 1007  print_error_message (data, stream)
1007        else        else
1008          Fprin1 (obj, stream);          Fprin1 (obj, stream);
1009      }      }
1010      
1011    UNGCPRO;    UNGCPRO;
1012  }  }
1013    
# Line 1008  print_error_message (data, stream) Line 1018  print_error_message (data, stream)
1018   * largest float, printed in the biggest notation.  This is undoubtedly   * largest float, printed in the biggest notation.  This is undoubtedly
1019   * 20d float_output_format, with the negative of the C-constant "HUGE"   * 20d float_output_format, with the negative of the C-constant "HUGE"
1020   * from <math.h>.   * from <math.h>.
1021   *   *
1022   * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.   * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1023   *   *
1024   * I assume that IEEE-754 format numbers can take 329 bytes for the worst   * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1025   * case of -1e307 in 20d float_output_format. What is one to do (short of   * case of -1e307 in 20d float_output_format. What is one to do (short of
1026   * re-writing _doprnt to be more sane)?   * re-writing _doprnt to be more sane)?
# Line 1024  float_to_string (buf, data) Line 1034  float_to_string (buf, data)
1034  {  {
1035    unsigned char *cp;    unsigned char *cp;
1036    int width;    int width;
1037          
1038    /* Check for plus infinity in a way that won't lose    /* Check for plus infinity in a way that won't lose
1039       if there is no plus infinity.  */       if there is no plus infinity.  */
1040    if (data == data / 2 && data > 1.0)    if (data == data / 2 && data > 1.0)
# Line 1053  float_to_string (buf, data) Line 1063  float_to_string (buf, data)
1063              *buf++ = '-';              *buf++ = '-';
1064              break;              break;
1065            }            }
1066          
1067        strcpy (buf, "0.0e+NaN");        strcpy (buf, "0.0e+NaN");
1068        return;        return;
1069      }      }
# Line 1083  float_to_string (buf, data) Line 1093  float_to_string (buf, data)
1093        /* Check that the spec we have is fully valid.        /* Check that the spec we have is fully valid.
1094           This means not only valid for printf,           This means not only valid for printf,
1095           but meant for floats, and reasonable.  */           but meant for floats, and reasonable.  */
1096        cp = XSTRING (Vfloat_output_format)->data;        cp = SDATA (Vfloat_output_format);
1097    
1098        if (cp[0] != '%')        if (cp[0] != '%')
1099          goto lose;          goto lose;
# Line 1113  float_to_string (buf, data) Line 1123  float_to_string (buf, data)
1123        if (cp[1] != 0)        if (cp[1] != 0)
1124          goto lose;          goto lose;
1125    
1126        sprintf (buf, XSTRING (Vfloat_output_format)->data, data);        sprintf (buf, SDATA (Vfloat_output_format), data);
1127      }      }
1128    
1129    /* Make sure there is a decimal point with digit after, or an    /* Make sure there is a decimal point with digit after, or an
# Line 1149  print (obj, printcharfun, escapeflag) Line 1159  print (obj, printcharfun, escapeflag)
1159       int escapeflag;       int escapeflag;
1160  {  {
1161    print_depth = 0;    print_depth = 0;
1162      old_backquote_output = 0;
1163    
1164    /* Reset print_number_index and Vprint_number_table only when    /* Reset print_number_index and Vprint_number_table only when
1165       the variable Vprint_continuous_numbering is nil.  Otherwise,       the variable Vprint_continuous_numbering is nil.  Otherwise,
# Line 1164  print (obj, printcharfun, escapeflag) Line 1175  print (obj, printcharfun, escapeflag)
1175    if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))    if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1176      {      {
1177        int i, start, index;        int i, start, index;
       /* Construct Vprint_number_table.  */  
1178        start = index = print_number_index;        start = index = print_number_index;
1179          /* Construct Vprint_number_table.
1180             This increments print_number_index for the objects added.  */
1181        print_preprocess (obj);        print_preprocess (obj);
1182    
1183        /* Remove unnecessary objects, which appear only once in OBJ;        /* Remove unnecessary objects, which appear only once in OBJ;
1184           that is, whose status is Qnil.  */           that is, whose status is Qnil.  Compactify the necessary objects.  */
1185        for (i = start; i < print_number_index; i++)        for (i = start; i < print_number_index; i++)
1186          if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))          if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1187            {            {
1188              PRINT_NUMBER_OBJECT (Vprint_number_table, index)              PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1189                = PRINT_NUMBER_OBJECT (Vprint_number_table, i);                = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
             /* Reset the status field for the next print step.  Now this  
                field means whether the object has already been printed.  */  
             PRINT_NUMBER_STATUS (Vprint_number_table, index) = Qnil;  
1190              index++;              index++;
1191            }            }
1192    
1193          /* Clear out objects outside the active part of the table.  */
1194          for (i = index; i < print_number_index; i++)
1195            PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1196    
1197          /* Reset the status field for the next print step.  Now this
1198             field means whether the object has already been printed.  */
1199          for (i = start; i < print_number_index; i++)
1200            PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1201    
1202        print_number_index = index;        print_number_index = index;
1203      }      }
1204    
# Line 1252  print_preprocess (obj) Line 1272  print_preprocess (obj)
1272          {          {
1273          case Lisp_String:          case Lisp_String:
1274            /* A string may have text properties, which can be circular.  */            /* A string may have text properties, which can be circular.  */
1275            traverse_intervals_noorder (XSTRING (obj)->intervals,            traverse_intervals_noorder (STRING_INTERVALS (obj),
1276                                        print_preprocess_string, Qnil);                                        print_preprocess_string, Qnil);
1277            break;            break;
1278    
# Line 1388  print_object (obj, printcharfun, escapef Line 1408  print_object (obj, printcharfun, escapef
1408    
1409            GCPRO1 (obj);            GCPRO1 (obj);
1410    
1411            if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))            if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1412              {              {
1413                PRINTCHAR ('#');                PRINTCHAR ('#');
1414                PRINTCHAR ('(');                PRINTCHAR ('(');
1415              }              }
1416    
1417            PRINTCHAR ('\"');            PRINTCHAR ('\"');
1418            str = XSTRING (obj)->data;            str = SDATA (obj);
1419            size_byte = STRING_BYTES (XSTRING (obj));            size_byte = SBYTES (obj);
1420    
1421            for (i = 0, i_byte = 0; i_byte < size_byte;)            for (i = 0, i_byte = 0; i_byte < size_byte;)
1422              {              {
# Line 1476  print_object (obj, printcharfun, escapef Line 1496  print_object (obj, printcharfun, escapef
1496              }              }
1497            PRINTCHAR ('\"');            PRINTCHAR ('\"');
1498    
1499            if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))            if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1500              {              {
1501                traverse_intervals (XSTRING (obj)->intervals,                traverse_intervals (STRING_INTERVALS (obj),
1502                                    0, print_interval, printcharfun);                                    0, print_interval, printcharfun);
1503                PRINTCHAR (')');                PRINTCHAR (')');
1504              }              }
# Line 1490  print_object (obj, printcharfun, escapef Line 1510  print_object (obj, printcharfun, escapef
1510      case Lisp_Symbol:      case Lisp_Symbol:
1511        {        {
1512          register int confusing;          register int confusing;
1513          register unsigned char *p = XSTRING (SYMBOL_NAME (obj))->data;          register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1514          register unsigned char *end = p + STRING_BYTES (XSTRING (SYMBOL_NAME (obj)));          register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1515          register int c;          register int c;
1516          int i, i_byte, size_byte;          int i, i_byte, size_byte;
1517          Lisp_Object name;          Lisp_Object name;
# Line 1526  print_object (obj, printcharfun, escapef Line 1546  print_object (obj, printcharfun, escapef
1546              PRINTCHAR (':');              PRINTCHAR (':');
1547            }            }
1548    
1549          size_byte = STRING_BYTES (XSTRING (name));          size_byte = SBYTES (name);
1550    
1551          for (i = 0, i_byte = 0; i_byte < size_byte;)          for (i = 0, i_byte = 0; i_byte < size_byte;)
1552            {            {
# Line 1568  print_object (obj, printcharfun, escapef Line 1588  print_object (obj, printcharfun, escapef
1588            print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);            print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1589          }          }
1590        else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))        else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1591                   && ! old_backquote_output
1592                 && ((EQ (XCAR (obj), Qbackquote)                 && ((EQ (XCAR (obj), Qbackquote)
1593                      || EQ (XCAR (obj), Qcomma)                      || EQ (XCAR (obj), Qcomma)
1594                      || EQ (XCAR (obj), Qcomma_at)                      || EQ (XCAR (obj), Qcomma_at)
# Line 1579  print_object (obj, printcharfun, escapef Line 1600  print_object (obj, printcharfun, escapef
1600        else        else
1601          {          {
1602            PRINTCHAR ('(');            PRINTCHAR ('(');
1603    
1604              /* If the first element is a backquote form,
1605                 print it old-style so it won't be misunderstood.  */
1606              if (print_quoted && CONSP (XCAR (obj))
1607                  && CONSP (XCDR (XCAR (obj)))
1608                  && NILP (XCDR (XCDR (XCAR (obj))))
1609                  && EQ (XCAR (XCAR (obj)), Qbackquote))
1610                {
1611                  Lisp_Object tem;
1612                  tem = XCAR (obj);
1613                  PRINTCHAR ('(');
1614    
1615                  print_object (Qbackquote, printcharfun, 0);
1616                  PRINTCHAR (' ');
1617    
1618                  ++old_backquote_output;
1619                  print_object (XCAR (XCDR (tem)), printcharfun, 0);
1620                  --old_backquote_output;
1621                  PRINTCHAR (')');
1622    
1623                  obj = XCDR (obj);
1624                }
1625    
1626            {            {
1627              int print_length, i;              int print_length, i;
1628              Lisp_Object halftail = obj;              Lisp_Object halftail = obj;
# Line 1628  print_object (obj, printcharfun, escapef Line 1672  print_object (obj, printcharfun, escapef
1672                              }                              }
1673                        }                        }
1674                    }                    }
1675                    
1676                  if (i++)                  if (i++)
1677                    PRINTCHAR (' ');                    PRINTCHAR (' ');
1678                    
1679                  if (print_length && i > print_length)                  if (print_length && i > print_length)
1680                    {                    {
1681                      strout ("...", 3, 3, printcharfun, 0);                      strout ("...", 3, 3, printcharfun, 0);
1682                      goto end_of_list;                      goto end_of_list;
1683                    }                    }
1684                    
1685                  print_object (XCAR (obj), printcharfun, escapeflag);                  print_object (XCAR (obj), printcharfun, escapeflag);
1686                    
1687                  obj = XCDR (obj);                  obj = XCDR (obj);
1688                  if (!(i & 1))                  if (!(i & 1))
1689                    halftail = XCDR (halftail);                    halftail = XCDR (halftail);
# Line 1652  print_object (obj, printcharfun, escapef Line 1696  print_object (obj, printcharfun, escapef
1696                strout (" . ", 3, 3, printcharfun, 0);                strout (" . ", 3, 3, printcharfun, 0);
1697                print_object (obj, printcharfun, escapeflag);                print_object (obj, printcharfun, escapeflag);
1698              }              }
1699              
1700          end_of_list:          end_of_list:
1701            PRINTCHAR (')');            PRINTCHAR (')');
1702          }          }
# Line 1744  print_object (obj, printcharfun, escapef Line 1788  print_object (obj, printcharfun, escapef
1788              {              {
1789                PRINTCHAR (' ');                PRINTCHAR (' ');
1790                PRINTCHAR ('\'');                PRINTCHAR ('\'');
1791                strout (XSTRING (SYMBOL_NAME (h->test))->data, -1, -1, printcharfun, 0);                strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1792                PRINTCHAR (' ');                PRINTCHAR (' ');
1793                strout (XSTRING (SYMBOL_NAME (h->weak))->data, -1, -1, printcharfun, 0);                strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1794                PRINTCHAR (' ');                PRINTCHAR (' ');
1795                sprintf (buf, "%d/%d", XFASTINT (h->count),                sprintf (buf, "%d/%d", XFASTINT (h->count),
1796                         XVECTOR (h->next)->size);                         XVECTOR (h->next)->size);
# Line 2082  This variable should not be set with `se Line 2126  This variable should not be set with `se
2126    DEFVAR_LISP ("print-number-table", &Vprint_number_table,    DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2127                 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.                 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2128  The Lisp printer uses this vector to detect Lisp objects referenced more  The Lisp printer uses this vector to detect Lisp objects referenced more
2129  than once.  When `print-continuous-numbering' is bound to t, you should  than once.
2130  probably also bind `print-number-table' to nil.  This ensures that the  
2131  value of `print-number-table' can be garbage-collected once the printing  When you bind `print-continuous-numbering' to t, you should probably
2132  is done.  */);  also bind `print-number-table' to nil.  This ensures that the value of
2133    `print-number-table' can be garbage-collected once the printing is
2134    done.  If all elements of `print-number-table' are nil, it means that
2135    the printing done so far has not found any shared structure or objects
2136    that need to be recorded in the table.  */);
2137    Vprint_number_table = Qnil;    Vprint_number_table = Qnil;
2138    
2139    /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */    /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */

Legend:
Removed from v.1.175  
changed lines
  Added in v.1.175.2.1

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