comparison src/print.c @ 100:4be1180a9e89 r20-1b2

Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children a145efe76779
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
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;
1434 defsymbol (&Qprint_string_length, "print-string-length"); 1512 defsymbol (&Qprint_string_length, "print-string-length");
1435 DEFSUBR (Fprin1); 1513 DEFSUBR (Fprin1);
1436 DEFSUBR (Fprin1_to_string); 1514 DEFSUBR (Fprin1_to_string);
1437 DEFSUBR (Fprinc); 1515 DEFSUBR (Fprinc);
1438 DEFSUBR (Fprint); 1516 DEFSUBR (Fprint);
1517 DEFSUBR (Ferror_message_string);
1439 DEFSUBR (Fterpri); 1518 DEFSUBR (Fterpri);
1440 DEFSUBR (Fwrite_char); 1519 DEFSUBR (Fwrite_char);
1441 DEFSUBR (Falternate_debugging_output); 1520 DEFSUBR (Falternate_debugging_output);
1442 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output"); 1521 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
1443 DEFSUBR (Fexternal_debugging_output); 1522 DEFSUBR (Fexternal_debugging_output);