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");