comparison src/print.c @ 404:2f8bb876ab1d r21-2-32

Import from CVS: tag r21-2-32
author cvs
date Mon, 13 Aug 2007 11:16:07 +0200
parents 74fd4e045ea6
children 501cfd01ee6d
comparison
equal deleted inserted replaced
403:9f011ab08d48 404:2f8bb876ab1d
1 /* Lisp object printing and output streams. 1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc. 2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996 Ben Wing. 3 Copyright (C) 1995, 1996, 2000 Ben Wing.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
36 #include "extents.h" 36 #include "extents.h"
37 #include "frame.h" 37 #include "frame.h"
38 #include "insdel.h" 38 #include "insdel.h"
39 #include "lstream.h" 39 #include "lstream.h"
40 #include "sysfile.h" 40 #include "sysfile.h"
41 #ifdef WINDOWSNT
42 #include "console-msw.h"
43 #endif
41 44
42 #include <limits.h> 45 #include <limits.h>
43 #include <float.h> 46 #include <float.h>
44 /* Define if not in float.h */ 47 /* Define if not in float.h */
45 #ifndef DBL_DIG 48 #ifndef DBL_DIG
101 104
102 105
103 106
104 int stdout_needs_newline; 107 int stdout_needs_newline;
105 108
106 /* Write a string (in internal format) to stdio stream STREAM. */ 109 static void
107 110 std_handle_out_external (FILE *stream, Lisp_Object lstream,
108 void 111 const Extbyte *extptr, Extcount extlen,
109 write_string_to_stdio_stream (FILE *stream, struct console *con, 112 /* is this really stdout/stderr?
110 const Bufbyte *str, 113 (controls termscript writing) */
111 Bytecount offset, Bytecount len, 114 int output_is_std_handle,
112 Lisp_Object coding_system) 115 int must_flush)
113 { 116 {
114 Extcount extlen;
115 const Extbyte *extptr;
116
117 TO_EXTERNAL_FORMAT (DATA, (str + offset, len),
118 ALLOCA, (extptr, extlen),
119 coding_system);
120 if (stream) 117 if (stream)
121 { 118 {
122 fwrite (extptr, 1, extlen, stream);
123 #ifdef WINDOWSNT 119 #ifdef WINDOWSNT
124 /* Q122442 says that pipes are "treated as files, not as 120 /* we typically have no useful stdout/stderr under windows if we're
125 devices", and that this is a feature. Before I found that 121 being invoked graphically. */
126 article, I thought it was a bug. Thanks MS, I feel much 122 if (!noninteractive)
127 better now. - kkm */ 123 msw_output_console_string (extptr, extlen);
128 if (stream == stdout || stream == stderr) 124 else
129 fflush (stream);
130 #endif 125 #endif
126 {
127 fwrite (extptr, 1, extlen, stream);
128 #ifdef WINDOWSNT
129 /* Q122442 says that pipes are "treated as files, not as
130 devices", and that this is a feature. Before I found that
131 article, I thought it was a bug. Thanks MS, I feel much
132 better now. - kkm */
133 must_flush = 1;
134 #endif
135 if (must_flush)
136 fflush (stream);
137 }
131 } 138 }
132 else 139 else
133 { 140 Lstream_write (XLSTREAM (lstream), extptr, extlen);
134 assert (CONSOLE_TTY_P (con)); 141
135 Lstream_write (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream), 142 if (output_is_std_handle)
136 extptr, extlen);
137 }
138 if (stream == stdout || stream == stderr ||
139 (!stream && CONSOLE_TTY_DATA (con)->is_stdio))
140 { 143 {
141 if (termscript) 144 if (termscript)
142 { 145 {
143 fwrite (extptr, 1, extlen, termscript); 146 fwrite (extptr, 1, extlen, termscript);
144 fflush (termscript); 147 fflush (termscript);
145 } 148 }
146 stdout_needs_newline = (extptr[extlen - 1] != '\n'); 149 stdout_needs_newline = (extptr[extlen - 1] != '\n');
150 }
151 }
152
153 /* #### The following function should be replaced a call to the
154 emacs_doprnt_*() functions. This is the only way to ensure that
155 I18N3 works properly (many implementations of the *printf()
156 functions, including the ones included in glibc, do not implement
157 the %###$ argument-positioning syntax).
158
159 Note, however, that to do this, we'd have to
160
161 1) pre-allocate all the lstreams and do whatever else was necessary
162 to make sure that no allocation occurs, since these functions may be
163 called from fatal_error_signal().
164
165 2) (to be really correct) make a new lstream that outputs using
166 msw_output_console_string(). */
167
168 static int
169 std_handle_out_va (FILE *stream, const char *fmt, va_list args)
170 {
171 Bufbyte kludge[8192];
172 Extbyte *extptr;
173 Extcount extlen;
174 int retval;
175
176 retval = vsprintf ((char *) kludge, fmt, args);
177 TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)),
178 ALLOCA, (extptr, extlen),
179 Qnative);
180 std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1);
181 return retval;
182 }
183
184 /* Output portably to stderr or its equivalent; call GETTEXT on the
185 format string. Automatically flush when done. */
186
187 int
188 stderr_out (const char *fmt, ...)
189 {
190 int retval;
191 va_list args;
192 va_start (args, fmt);
193 retval = std_handle_out_va (stderr, GETTEXT (fmt), args);
194 va_end (args);
195 return retval;
196 }
197
198 /* Output portably to stdout or its equivalent; call GETTEXT on the
199 format string. Automatically flush when done. */
200
201 int
202 stdout_out (const char *fmt, ...)
203 {
204 int retval;
205 va_list args;
206 va_start (args, fmt);
207 retval = std_handle_out_va (stdout, GETTEXT (fmt), args);
208 va_end (args);
209 return retval;
210 }
211
212 DOESNT_RETURN
213 fatal (const char *fmt, ...)
214 {
215 va_list args;
216 va_start (args, fmt);
217
218 stderr_out ("\nXEmacs: ");
219 std_handle_out_va (stderr, GETTEXT (fmt), args);
220 stderr_out ("\n");
221
222 va_end (args);
223 exit (1);
224 }
225
226 /* Write a string (in internal format) to stdio stream STREAM. */
227
228 void
229 write_string_to_stdio_stream (FILE *stream, struct console *con,
230 const Bufbyte *str,
231 Bytecount offset, Bytecount len,
232 Lisp_Object coding_system,
233 int must_flush)
234 {
235 Extcount extlen;
236 const Extbyte *extptr;
237
238 /* #### yuck! sometimes this function is called with string data,
239 and the following call may gc. */
240 {
241 Bufbyte *puta = (Bufbyte *) alloca (len);
242 memcpy (puta, str + offset, len);
243 TO_EXTERNAL_FORMAT (DATA, (puta, len),
244 ALLOCA, (extptr, extlen),
245 coding_system);
246 }
247
248 if (stream)
249 std_handle_out_external (stream, Qnil, extptr, extlen,
250 stream == stdout || stream == stderr, must_flush);
251 else
252 {
253 assert (CONSOLE_TTY_P (con));
254 std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream,
255 extptr, extlen,
256 CONSOLE_TTY_DATA (con)->is_stdio, must_flush);
147 } 257 }
148 } 258 }
149 259
150 /* Write a string to the output location specified in FUNCTION. 260 /* Write a string to the output location specified in FUNCTION.
151 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in 261 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
236 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label); 346 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
237 } 347 }
238 else if (EQ (function, Qt) || EQ (function, Qnil)) 348 else if (EQ (function, Qt) || EQ (function, Qnil))
239 { 349 {
240 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len, 350 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
241 Qterminal); 351 Qterminal, print_unbuffered);
242 } 352 }
243 else 353 else
244 { 354 {
245 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset); 355 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
246 Charcount iii; 356 Charcount iii;
1425 Write CHAR-OR-STRING to stderr or stdout. 1535 Write CHAR-OR-STRING to stderr or stdout.
1426 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write 1536 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
1427 to stderr. You can use this function to write directly to the terminal. 1537 to stderr. You can use this function to write directly to the terminal.
1428 This function can be used as the STREAM argument of Fprint() or the like. 1538 This function can be used as the STREAM argument of Fprint() or the like.
1429 1539
1540 Under MS Windows, this writes output to the console window (which is
1541 created, if necessary), unless XEmacs is being run noninteractively
1542 (i.e. using the `-batch' argument).
1543
1430 If you have opened a termscript file (using `open-termscript'), then 1544 If you have opened a termscript file (using `open-termscript'), then
1431 the output also will be logged to this file. 1545 the output also will be logged to this file.
1432 */ 1546 */
1433 (char_or_string, stdout_p, device)) 1547 (char_or_string, stdout_p, device))
1434 { 1548 {
1459 1573
1460 if (STRINGP (char_or_string)) 1574 if (STRINGP (char_or_string))
1461 write_string_to_stdio_stream (file, con, 1575 write_string_to_stdio_stream (file, con,
1462 XSTRING_DATA (char_or_string), 1576 XSTRING_DATA (char_or_string),
1463 0, XSTRING_LENGTH (char_or_string), 1577 0, XSTRING_LENGTH (char_or_string),
1464 Qterminal); 1578 Qterminal, 1);
1465 else 1579 else
1466 { 1580 {
1467 Bufbyte str[MAX_EMCHAR_LEN]; 1581 Bufbyte str[MAX_EMCHAR_LEN];
1468 Bytecount len; 1582 Bytecount len;
1469 1583
1470 CHECK_CHAR_COERCE_INT (char_or_string); 1584 CHECK_CHAR_COERCE_INT (char_or_string);
1471 len = set_charptr_emchar (str, XCHAR (char_or_string)); 1585 len = set_charptr_emchar (str, XCHAR (char_or_string));
1472 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal); 1586 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
1473 } 1587 }
1474 1588
1475 return char_or_string; 1589 return char_or_string;
1476 } 1590 }
1477 1591
1540 void 1654 void
1541 debug_print (Lisp_Object debug_print_obj) 1655 debug_print (Lisp_Object debug_print_obj)
1542 { 1656 {
1543 debug_print_no_newline (debug_print_obj); 1657 debug_print_no_newline (debug_print_obj);
1544 stderr_out ("\n"); 1658 stderr_out ("\n");
1545 fflush (stderr);
1546 } 1659 }
1547 1660
1548 /* Debugging kludge -- unbuffered */ 1661 /* Debugging kludge -- unbuffered */
1549 /* This function provided for the benefit of the debugger. */ 1662 /* This function provided for the benefit of the debugger. */
1550 void debug_backtrace (void); 1663 void debug_backtrace (void);
1573 if (debug_print_level > 0) 1686 if (debug_print_level > 0)
1574 Vprint_level = make_int (debug_print_level); 1687 Vprint_level = make_int (debug_print_level);
1575 1688
1576 Fbacktrace (Qexternal_debugging_output, Qt); 1689 Fbacktrace (Qexternal_debugging_output, Qt);
1577 stderr_out ("\n"); 1690 stderr_out ("\n");
1578 fflush (stderr);
1579 1691
1580 Vinhibit_quit = old_inhibit_quit; 1692 Vinhibit_quit = old_inhibit_quit;
1581 Vprint_level = old_print_level; 1693 Vprint_level = old_print_level;
1582 Vprint_length = old_print_length; 1694 Vprint_length = old_print_length;
1583 print_depth = old_print_depth; 1695 print_depth = old_print_depth;
1591 debug_short_backtrace (int length) 1703 debug_short_backtrace (int length)
1592 { 1704 {
1593 int first = 1; 1705 int first = 1;
1594 struct backtrace *bt = backtrace_list; 1706 struct backtrace *bt = backtrace_list;
1595 stderr_out (" ["); 1707 stderr_out (" [");
1596 fflush (stderr);
1597 while (length > 0 && bt) 1708 while (length > 0 && bt)
1598 { 1709 {
1599 if (!first) 1710 if (!first)
1600 { 1711 {
1601 stderr_out (", "); 1712 stderr_out (", ");
1602 fflush (stderr);
1603 } 1713 }
1604 if (COMPILED_FUNCTIONP (*bt->function)) 1714 if (COMPILED_FUNCTIONP (*bt->function))
1605 { 1715 {
1606 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK) 1716 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
1607 Lisp_Object ann = 1717 Lisp_Object ann =
1610 Lisp_Object ann = Qnil; 1720 Lisp_Object ann = Qnil;
1611 #endif 1721 #endif
1612 if (!NILP (ann)) 1722 if (!NILP (ann))
1613 { 1723 {
1614 stderr_out ("<compiled-function from "); 1724 stderr_out ("<compiled-function from ");
1615 fflush (stderr);
1616 debug_print_no_newline (ann); 1725 debug_print_no_newline (ann);
1617 stderr_out (">"); 1726 stderr_out (">");
1618 fflush (stderr);
1619 } 1727 }
1620 else 1728 else
1621 { 1729 {
1622 stderr_out ("<compiled-function of unknown origin>"); 1730 stderr_out ("<compiled-function of unknown origin>");
1623 fflush (stderr);
1624 } 1731 }
1625 } 1732 }
1626 else 1733 else
1627 debug_print_no_newline (*bt->function); 1734 debug_print_no_newline (*bt->function);
1628 first = 0; 1735 first = 0;
1629 length--; 1736 length--;
1630 bt = bt->next; 1737 bt = bt->next;
1631 } 1738 }
1632 stderr_out ("]\n"); 1739 stderr_out ("]\n");
1633 fflush (stderr);
1634 } 1740 }
1635 1741
1636 #endif /* debugging kludge */ 1742 #endif /* debugging kludge */
1637 1743
1638 1744