diff options
Diffstat (limited to 'src/print.c')
| -rw-r--r-- | src/print.c | 35 |
1 files changed, 26 insertions, 9 deletions
diff --git a/src/print.c b/src/print.c index 57fac7af378..49331ef0984 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -58,6 +58,9 @@ static ptrdiff_t new_backquote_output; | |||
| 58 | #define PRINT_CIRCLE 200 | 58 | #define PRINT_CIRCLE 200 |
| 59 | static Lisp_Object being_printed[PRINT_CIRCLE]; | 59 | static Lisp_Object being_printed[PRINT_CIRCLE]; |
| 60 | 60 | ||
| 61 | /* Last char printed to stdout by printchar. */ | ||
| 62 | static unsigned int printchar_stdout_last; | ||
| 63 | |||
| 61 | /* When printing into a buffer, first we put the text in this | 64 | /* When printing into a buffer, first we put the text in this |
| 62 | block, then insert it all at once. */ | 65 | block, then insert it all at once. */ |
| 63 | static char *print_buffer; | 66 | static char *print_buffer; |
| @@ -169,11 +172,13 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; | |||
| 169 | if (print_buffer_pos != print_buffer_pos_byte \ | 172 | if (print_buffer_pos != print_buffer_pos_byte \ |
| 170 | && NILP (BVAR (current_buffer, enable_multibyte_characters)))\ | 173 | && NILP (BVAR (current_buffer, enable_multibyte_characters)))\ |
| 171 | { \ | 174 | { \ |
| 172 | unsigned char *temp = alloca (print_buffer_pos + 1); \ | 175 | USE_SAFE_ALLOCA; \ |
| 176 | unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1); \ | ||
| 173 | copy_text ((unsigned char *) print_buffer, temp, \ | 177 | copy_text ((unsigned char *) print_buffer, temp, \ |
| 174 | print_buffer_pos_byte, 1, 0); \ | 178 | print_buffer_pos_byte, 1, 0); \ |
| 175 | insert_1_both ((char *) temp, print_buffer_pos, \ | 179 | insert_1_both ((char *) temp, print_buffer_pos, \ |
| 176 | print_buffer_pos, 0, 1, 0); \ | 180 | print_buffer_pos, 0, 1, 0); \ |
| 181 | SAFE_FREE (); \ | ||
| 177 | } \ | 182 | } \ |
| 178 | else \ | 183 | else \ |
| 179 | insert_1_both (print_buffer, print_buffer_pos, \ | 184 | insert_1_both (print_buffer, print_buffer_pos, \ |
| @@ -236,6 +241,7 @@ printchar (unsigned int ch, Lisp_Object fun) | |||
| 236 | } | 241 | } |
| 237 | else if (noninteractive) | 242 | else if (noninteractive) |
| 238 | { | 243 | { |
| 244 | printchar_stdout_last = ch; | ||
| 239 | fwrite (str, 1, len, stdout); | 245 | fwrite (str, 1, len, stdout); |
| 240 | noninteractive_need_newline = 1; | 246 | noninteractive_need_newline = 1; |
| 241 | } | 247 | } |
| @@ -513,19 +519,33 @@ static void print_preprocess (Lisp_Object); | |||
| 513 | static void print_preprocess_string (INTERVAL, Lisp_Object); | 519 | static void print_preprocess_string (INTERVAL, Lisp_Object); |
| 514 | static void print_object (Lisp_Object, Lisp_Object, bool); | 520 | static void print_object (Lisp_Object, Lisp_Object, bool); |
| 515 | 521 | ||
| 516 | DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, | 522 | DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, |
| 517 | doc: /* Output a newline to stream PRINTCHARFUN. | 523 | doc: /* Output a newline to stream PRINTCHARFUN. |
| 524 | If ENSURE is non-nil only output a newline if not already at the | ||
| 525 | beginning of a line. Value is non-nil if a newline is printed. | ||
| 518 | If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */) | 526 | If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */) |
| 519 | (Lisp_Object printcharfun) | 527 | (Lisp_Object printcharfun, Lisp_Object ensure) |
| 520 | { | 528 | { |
| 521 | PRINTDECLARE; | 529 | Lisp_Object val = Qnil; |
| 522 | 530 | ||
| 531 | PRINTDECLARE; | ||
| 523 | if (NILP (printcharfun)) | 532 | if (NILP (printcharfun)) |
| 524 | printcharfun = Vstandard_output; | 533 | printcharfun = Vstandard_output; |
| 525 | PRINTPREPARE; | 534 | PRINTPREPARE; |
| 526 | PRINTCHAR ('\n'); | 535 | |
| 536 | if (NILP (ensure)) | ||
| 537 | val = Qt; | ||
| 538 | /* Difficult to check if at line beginning so abort. */ | ||
| 539 | else if (FUNCTIONP (printcharfun)) | ||
| 540 | signal_error ("Unsupported function argument", printcharfun); | ||
| 541 | else if (noninteractive && !NILP (printcharfun)) | ||
| 542 | val = printchar_stdout_last == 10 ? Qnil : Qt; | ||
| 543 | else if (NILP (Fbolp ())) | ||
| 544 | val = Qt; | ||
| 545 | |||
| 546 | if (!NILP (val)) PRINTCHAR ('\n'); | ||
| 527 | PRINTFINISH; | 547 | PRINTFINISH; |
| 528 | return Qt; | 548 | return val; |
| 529 | } | 549 | } |
| 530 | 550 | ||
| 531 | DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, | 551 | DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, |
| @@ -581,7 +601,6 @@ A printed representation of an object is text which describes that object. */) | |||
| 581 | { | 601 | { |
| 582 | Lisp_Object printcharfun; | 602 | Lisp_Object printcharfun; |
| 583 | bool prev_abort_on_gc; | 603 | bool prev_abort_on_gc; |
| 584 | /* struct gcpro gcpro1, gcpro2; */ | ||
| 585 | Lisp_Object save_deactivate_mark; | 604 | Lisp_Object save_deactivate_mark; |
| 586 | ptrdiff_t count = SPECPDL_INDEX (); | 605 | ptrdiff_t count = SPECPDL_INDEX (); |
| 587 | struct buffer *previous; | 606 | struct buffer *previous; |
| @@ -595,7 +614,6 @@ A printed representation of an object is text which describes that object. */) | |||
| 595 | but we don't want to deactivate the mark just for that. | 614 | but we don't want to deactivate the mark just for that. |
| 596 | No need for specbind, since errors deactivate the mark. */ | 615 | No need for specbind, since errors deactivate the mark. */ |
| 597 | save_deactivate_mark = Vdeactivate_mark; | 616 | save_deactivate_mark = Vdeactivate_mark; |
| 598 | /* GCPRO2 (object, save_deactivate_mark); */ | ||
| 599 | prev_abort_on_gc = abort_on_gc; | 617 | prev_abort_on_gc = abort_on_gc; |
| 600 | abort_on_gc = 1; | 618 | abort_on_gc = 1; |
| 601 | 619 | ||
| @@ -619,7 +637,6 @@ A printed representation of an object is text which describes that object. */) | |||
| 619 | set_buffer_internal (previous); | 637 | set_buffer_internal (previous); |
| 620 | 638 | ||
| 621 | Vdeactivate_mark = save_deactivate_mark; | 639 | Vdeactivate_mark = save_deactivate_mark; |
| 622 | /* UNGCPRO; */ | ||
| 623 | 640 | ||
| 624 | abort_on_gc = prev_abort_on_gc; | 641 | abort_on_gc = prev_abort_on_gc; |
| 625 | return unbind_to (count, object); | 642 | return unbind_to (count, object); |