comparison src/print.c @ 24:4103f0995bd7 r19-15b95

Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 859a2309aef8
children 441bb1e64a06
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
586 print_internal (obj, the_stream, 1); 586 print_internal (obj, the_stream, 1);
587 write_char_internal ("\n", the_stream); 587 write_char_internal ("\n", the_stream);
588 print_finish (the_stream); 588 print_finish (the_stream);
589 UNGCPRO; 589 UNGCPRO;
590 return obj; 590 return obj;
591 }
592
593 # include "emacsfns.h"
594 /* Synched with Emacs 19.34 */
595 DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
596 Convert an error value (ERROR-SYMBOL . DATA) to an error message.
597 */
598 (obj))
599 {
600 struct buffer *old = XBUFFER(Fcurrent_buffer());
601 Lisp_Object original, printcharfun, value;
602 struct gcpro gcpro1;
603
604 print_error_message (obj, Vprin1_to_string_buffer, NULL);
605
606 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
607 value = Fbuffer_substring (Fpoint_min(Fcurrent_buffer()),
608 Fpoint_max(Fcurrent_buffer()),
609 Fcurrent_buffer());
610
611 GCPRO1 (value);
612 Ferase_buffer (Fcurrent_buffer());
613 set_buffer_internal (old);
614 UNGCPRO;
615
616 return value;
617 }
618
619 /* Print an error message for the error DATA
620 onto Lisp output stream STREAM (suitable for the print functions). */
621
622 print_error_message (data, stream)
623 Lisp_Object data, stream;
624 {
625 Lisp_Object errname, errmsg, file_error, tail;
626 struct gcpro gcpro1;
627 int i;
628
629 errname = Fcar (data);
630
631 if (EQ (errname, Qerror))
632 {
633 data = Fcdr (data);
634 if (!CONSP (data)) data = Qnil;
635 errmsg = Fcar (data);
636 file_error = Qnil;
637 }
638 else
639 {
640 errmsg = Fget (errname, Qerror_message, Qnil);
641 file_error = Fmemq (Qfile_error,
642 Fget (errname, Qerror_conditions, Qnil));
643 }
644
645 /* Print an error message including the data items. */
646
647 tail = Fcdr_safe (data);
648 GCPRO1 (tail);
649
650 /* For file-error, make error message by concatenating
651 all the data items. They are all strings. */
652 if (!NILP (file_error) && !NILP (tail))
653 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
654
655 if (STRINGP (errmsg))
656 Fprinc (errmsg, stream);
657 else
658 write_string_1 ("Peculiar error", 14, stream);
659
660 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
661 {
662 write_string_1 (i ? ", " : ": ", 2, stream);
663 if (!NILP (file_error))
664 Fprinc (Fcar (tail), stream);
665 else
666 Fprin1 (Fcar (tail), stream);
667 }
668 UNGCPRO;
591 } 669 }
592 670
593 #ifdef LISP_FLOAT_TYPE 671 #ifdef LISP_FLOAT_TYPE
594 672
595 Lisp_Object Vfloat_output_format; 673 Lisp_Object Vfloat_output_format;
1395 defsymbol (&Qprint_string_length, "print-string-length"); 1473 defsymbol (&Qprint_string_length, "print-string-length");
1396 DEFSUBR (Fprin1); 1474 DEFSUBR (Fprin1);
1397 DEFSUBR (Fprin1_to_string); 1475 DEFSUBR (Fprin1_to_string);
1398 DEFSUBR (Fprinc); 1476 DEFSUBR (Fprinc);
1399 DEFSUBR (Fprint); 1477 DEFSUBR (Fprint);
1478 DEFSUBR (Ferror_message_string);
1400 DEFSUBR (Fterpri); 1479 DEFSUBR (Fterpri);
1401 DEFSUBR (Fwrite_char); 1480 DEFSUBR (Fwrite_char);
1402 DEFSUBR (Falternate_debugging_output); 1481 DEFSUBR (Falternate_debugging_output);
1403 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output"); 1482 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
1404 DEFSUBR (Fexternal_debugging_output); 1483 DEFSUBR (Fexternal_debugging_output);