Mercurial > hg > xemacs-beta

comparison src/print.c @ 219:262b8bb4a523 r20-4b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents d44af0c54775
children 2c611d1463a6
comparison
equal deleted inserted replaced
218:c9f226976f56 219:262b8bb4a523
519 print_finish (the_stream); 519 print_finish (the_stream);
520 UNGCPRO; 520 UNGCPRO;
521 return object; 521 return object;
522 } 522 }
523 523
524 /* a buffer which is used to hold output being built by prin1-to-string */ 524 /* Stream to which prin1-to-string prints. */
525 Lisp_Object Vprin1_to_string_buffer; 525 static Lisp_Object Vprin1_to_string_stream;
526 526
527 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /* 527 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /*
528 Return a string containing the printed representation of OBJECT, 528 Return a string containing the printed representation of OBJECT,
529 any Lisp object. Quoting characters are used when needed to make output 529 any Lisp object. Quoting characters are used when needed to make output
530 that `read' can handle, whenever this is possible, unless the optional 530 that `read' can handle, whenever this is possible, unless the optional
531 second argument NOESCAPE is non-nil. 531 second argument NOESCAPE is non-nil.
532 */ 532 */
533 (object, noescape)) 533 (object, noescape))
534 { 534 {
535 /* This function can GC */ 535 /* This function can GC */
536 struct buffer *out = XBUFFER (Vprin1_to_string_buffer); 536 Lisp_Object result = Qnil;
537 Lisp_Object stream = Qnil; 537 Lstream *stream;
538 struct gcpro gcpro1, gcpro2; 538 struct gcpro gcpro1;
539 539
540 GCPRO2 (object, stream); 540 /* We avoid creating a new stream for every invocation of
541 stream = print_prepare (Vprin1_to_string_buffer); 541 prin1_to_string, for better memory usage. */
542 Ferase_buffer (Vprin1_to_string_buffer); 542
543 if (NILP (Vprin1_to_string_stream))
544 Vprin1_to_string_stream = make_resizing_buffer_output_stream ();
545 stream = XLSTREAM (Vprin1_to_string_stream);
546 Lstream_rewind (stream);
547
548 /* In case a caller forgot to protect. */
549 GCPRO1 (object);
543 print_depth = 0; 550 print_depth = 0;
544 print_internal (object, stream, NILP (noescape)); 551 print_internal (object, Vprin1_to_string_stream, NILP (noescape));
545 print_finish (stream); 552 Lstream_flush (stream);
546 stream = Qnil; /* No GC surprises! */
547 object = make_string_from_buffer (out,
548 BUF_BEG (out),
549 BUF_Z (out) - 1);
550 Ferase_buffer (Vprin1_to_string_buffer);
551 UNGCPRO; 553 UNGCPRO;
552 return object; 554 result = make_string (resizing_buffer_stream_ptr (stream),
555 Lstream_byte_count (stream));
556 return result;
553 } 557 }
554 558
555 DEFUN ("princ", Fprinc, 1, 2, 0, /* 559 DEFUN ("princ", Fprinc, 1, 2, 0, /*
556 Output the printed representation of OBJECT, any Lisp object. 560 Output the printed representation of OBJECT, any Lisp object.
557 No quoting characters are used; no delimiters are printed around 561 No quoting characters are used; no delimiters are printed around
604 Convert an error value (ERROR-SYMBOL . DATA) to an error message. 608 Convert an error value (ERROR-SYMBOL . DATA) to an error message.
605 */ 609 */
606 (data)) 610 (data))
607 { 611 {
608 /* This function can GC */ 612 /* This function can GC */
609 struct buffer *pbuf; 613
610 Lisp_Object value; 614 /* This should maybe use Vprin1_to_string_stream... However, it's
615 called sufficiently rarely, so I don't think it should matter. */
616 Lisp_Object stream = make_resizing_buffer_output_stream ();
611 struct gcpro gcpro1; 617 struct gcpro gcpro1;
612 618 GCPRO1 (stream);
613 print_error_message (data, Vprin1_to_string_buffer); 619
614 620 print_error_message (data, stream);
615 pbuf = XBUFFER (Vprin1_to_string_buffer); 621 Lstream_flush (XLSTREAM (stream));
616 value = make_string_from_buffer (pbuf,
617 BUF_BEGV (pbuf),
618 BUF_ZV (pbuf) - BUF_BEGV (pbuf));
619 GCPRO1 (value);
620 Ferase_buffer (Vprin1_to_string_buffer);
621 UNGCPRO; 622 UNGCPRO;
622 623 return make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
623 return value; 624 Lstream_byte_count (XLSTREAM (stream)));
624 } 625 }
625 626
626 /* Print an error message for the error DATA onto Lisp output stream 627 /* Print an error message for the error DATA onto Lisp output stream
627 STREAM (suitable for the print functions). 628 STREAM (suitable for the print functions).
628 629
1768 Label for minibuffer messages created with `print'. This should 1769 Label for minibuffer messages created with `print'. This should
1769 generally be bound with `let' rather than set. (See `display-message'.) 1770 generally be bound with `let' rather than set. (See `display-message'.)
1770 */ ); 1771 */ );
1771 Vprint_message_label = Qprint; 1772 Vprint_message_label = Qprint;
1772 1773
1773 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ 1774 Vprin1_to_string_stream = Qnil;
1774 staticpro (&Vprin1_to_string_buffer); 1775 staticpro (&Vprin1_to_string_stream);
1775 } 1776 }