Mercurial > emacs
comparison src/print.c @ 1967:239a8c1cb40f
(print--string case):
Any non-null interval means print intervals.
Get rid of var obj1; just use obj.
(print): Never declare OBJ arg as `register'.
Special handling for strings with intervals.
(print_intervals): New function.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 01 Mar 1993 08:59:36 +0000 |
parents | 94ff5d9ef48a |
children | 0f88f314fc34 |
comparison
equal
deleted
inserted
replaced
1966:bcc34323a475 | 1967:239a8c1cb40f |
---|---|
1 /* Lisp object printing and output streams. | 1 /* Lisp object printing and output streams. |
2 Copyright (C) 1985, 1986, 1988, 1992 Free Software Foundation, Inc. | 2 Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc. |
3 | 3 |
4 This file is part of GNU Emacs. | 4 This file is part of GNU Emacs. |
5 | 5 |
6 GNU Emacs is free software; you can redistribute it and/or modify | 6 GNU Emacs is free software; you can redistribute it and/or modify |
7 it under the terms of the GNU General Public License as published by | 7 it under the terms of the GNU General Public License as published by |
30 #include "process.h" | 30 #include "process.h" |
31 #include "dispextern.h" | 31 #include "dispextern.h" |
32 #include "termchar.h" | 32 #include "termchar.h" |
33 #endif /* not standalone */ | 33 #endif /* not standalone */ |
34 | 34 |
35 #ifdef USE_TEXT_PROPERTIES | |
36 #include "intervals.h" | |
37 #endif | |
38 | |
35 Lisp_Object Vstandard_output, Qstandard_output; | 39 Lisp_Object Vstandard_output, Qstandard_output; |
36 | 40 |
37 #ifdef LISP_FLOAT_TYPE | 41 #ifdef LISP_FLOAT_TYPE |
38 Lisp_Object Vfloat_output_format, Qfloat_output_format; | 42 Lisp_Object Vfloat_output_format, Qfloat_output_format; |
39 #endif /* LISP_FLOAT_TYPE */ | 43 #endif /* LISP_FLOAT_TYPE */ |
67 extern int noninteractive_need_newline; | 71 extern int noninteractive_need_newline; |
68 #ifdef MAX_PRINT_CHARS | 72 #ifdef MAX_PRINT_CHARS |
69 static int print_chars; | 73 static int print_chars; |
70 static int max_print; | 74 static int max_print; |
71 #endif /* MAX_PRINT_CHARS */ | 75 #endif /* MAX_PRINT_CHARS */ |
76 | |
77 void print_interval (); | |
72 | 78 |
73 #if 0 | 79 #if 0 |
74 /* Convert between chars and GLYPHs */ | 80 /* Convert between chars and GLYPHs */ |
75 | 81 |
76 int | 82 int |
661 } | 667 } |
662 #endif /* LISP_FLOAT_TYPE */ | 668 #endif /* LISP_FLOAT_TYPE */ |
663 | 669 |
664 static void | 670 static void |
665 print (obj, printcharfun, escapeflag) | 671 print (obj, printcharfun, escapeflag) |
666 #ifndef RTPC_REGISTER_BUG | |
667 register Lisp_Object obj; | |
668 #else | |
669 Lisp_Object obj; | 672 Lisp_Object obj; |
670 #endif | |
671 register Lisp_Object printcharfun; | 673 register Lisp_Object printcharfun; |
672 int escapeflag; | 674 int escapeflag; |
673 { | 675 { |
674 char buf[30]; | 676 char buf[30]; |
675 | 677 |
742 print_string (obj, printcharfun); | 744 print_string (obj, printcharfun); |
743 else | 745 else |
744 { | 746 { |
745 register int i; | 747 register int i; |
746 register unsigned char c; | 748 register unsigned char c; |
747 Lisp_Object obj1; | |
748 struct gcpro gcpro1; | 749 struct gcpro gcpro1; |
749 | 750 |
750 /* You can't gcpro register variables, so copy obj to a | 751 GCPRO1 (obj); |
751 non-register variable so we can gcpro it without | 752 |
752 making it non-register. */ | 753 #ifdef USE_TEXT_PROPERTIES |
753 obj1 = obj; | 754 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) |
754 GCPRO1 (obj1); | 755 { |
756 PRINTCHAR ('#'); | |
757 PRINTCHAR ('('); | |
758 } | |
759 #endif | |
755 | 760 |
756 PRINTCHAR ('\"'); | 761 PRINTCHAR ('\"'); |
757 for (i = 0; i < XSTRING (obj)->size; i++) | 762 for (i = 0; i < XSTRING (obj)->size; i++) |
758 { | 763 { |
759 QUIT; | 764 QUIT; |
769 PRINTCHAR ('\\'); | 774 PRINTCHAR ('\\'); |
770 PRINTCHAR (c); | 775 PRINTCHAR (c); |
771 } | 776 } |
772 } | 777 } |
773 PRINTCHAR ('\"'); | 778 PRINTCHAR ('\"'); |
779 | |
780 #ifdef USE_TEXT_PROPERTIES | |
781 if (!NULL_INTERVAL_P (XSTRING (obj)->intervals)) | |
782 { | |
783 PRINTCHAR (' '); | |
784 traverse_intervals (XSTRING (obj)->intervals, | |
785 0, 0, print_interval, printcharfun); | |
786 PRINTCHAR (')'); | |
787 } | |
788 #endif | |
789 | |
774 UNGCPRO; | 790 UNGCPRO; |
775 } | 791 } |
776 break; | 792 break; |
777 | 793 |
778 case Lisp_Symbol: | 794 case Lisp_Symbol: |
942 } | 958 } |
943 | 959 |
944 print_depth--; | 960 print_depth--; |
945 } | 961 } |
946 | 962 |
963 #ifdef USE_TEXT_PROPERTIES | |
964 | |
965 /* Print a description of INTERVAL using PRINTCHARFUN. | |
966 This is part of printing a string that has text properties. */ | |
967 | |
968 void | |
969 print_interval (interval, printcharfun) | |
970 INTERVAL interval; | |
971 Lisp_Object printcharfun; | |
972 { | |
973 print (make_number (interval->position), printcharfun, 1); | |
974 PRINTCHAR (' '); | |
975 print (make_number (interval->position + LENGTH (interval)), | |
976 printcharfun, 1); | |
977 PRINTCHAR (' '); | |
978 print (interval->plist, printcharfun, 1); | |
979 PRINTCHAR (' '); | |
980 } | |
981 | |
982 #endif /* USE_TEXT_PROPERTIES */ | |
983 | |
947 void | 984 void |
948 syms_of_print () | 985 syms_of_print () |
949 { | 986 { |
950 staticpro (&Qprint_escape_newlines); | 987 staticpro (&Qprint_escape_newlines); |
951 Qprint_escape_newlines = intern ("print-escape-newlines"); | 988 Qprint_escape_newlines = intern ("print-escape-newlines"); |