/* Lisp object printing and output streams.
Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
- Copyright (C) 1995, 1996 Ben Wing.
+ Copyright (C) 1995, 1996, 2000 Ben Wing.
This file is part of XEmacs.
#include "insdel.h"
#include "lstream.h"
#include "sysfile.h"
+#ifdef WIN32_NATIVE
+#include "console-msw.h"
+#endif
-#include <limits.h>
#include <float.h>
/* Define if not in float.h */
#ifndef DBL_DIG
int stdout_needs_newline;
-/* Write a string (in internal format) to stdio stream STREAM. */
+#ifdef WIN32_NATIVE
+static int no_useful_stderr;
+#endif
-void
-write_string_to_stdio_stream (FILE *stream, struct console *con,
- CONST Bufbyte *str,
- Bytecount offset, Bytecount len,
- enum external_data_format fmt)
+static void
+std_handle_out_external (FILE *stream, Lisp_Object lstream,
+ const Extbyte *extptr, Extcount extlen,
+ /* is this really stdout/stderr?
+ (controls termscript writing) */
+ int output_is_std_handle,
+ int must_flush)
{
- int extlen;
- CONST Extbyte *extptr;
-
- GET_CHARPTR_EXT_DATA_ALLOCA (str + offset, len, fmt, extptr, extlen);
if (stream)
{
- fwrite (extptr, 1, extlen, stream);
-#ifdef WINDOWSNT
- /* Q122442 says that pipes are "treated as files, not as
- devices", and that this is a feature. Before I found that
- article, I thought it was a bug. Thanks MS, I feel much
- better now. - kkm */
- if (stream == stdout || stream == stderr)
- fflush (stream);
+#ifdef WIN32_NATIVE
+ if (!no_useful_stderr)
+ no_useful_stderr = GetStdHandle (STD_ERROR_HANDLE) == 0 ? 1 : -1;
+
+ /* we typically have no useful stdout/stderr under windows if we're
+ being invoked graphically. */
+ if (!noninteractive || no_useful_stderr > 0)
+ mswindows_output_console_string (extptr, extlen);
+ else
+#endif
+ {
+ fwrite (extptr, 1, extlen, stream);
+#ifdef WIN32_NATIVE
+ /* Q122442 says that pipes are "treated as files, not as
+ devices", and that this is a feature. Before I found that
+ article, I thought it was a bug. Thanks MS, I feel much
+ better now. - kkm */
+ must_flush = 1;
#endif
+ if (must_flush)
+ fflush (stream);
+ }
}
else
- {
- assert (CONSOLE_TTY_P (con));
- Lstream_write (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream),
- extptr, extlen);
- }
- if (stream == stdout || stream == stderr ||
- (!stream && CONSOLE_TTY_DATA (con)->is_stdio))
+ Lstream_write (XLSTREAM (lstream), extptr, extlen);
+
+ if (output_is_std_handle)
{
if (termscript)
{
}
}
+/* #### The following function should be replaced a call to the
+ emacs_doprnt_*() functions. This is the only way to ensure that
+ I18N3 works properly (many implementations of the *printf()
+ functions, including the ones included in glibc, do not implement
+ the %###$ argument-positioning syntax).
+
+ Note, however, that to do this, we'd have to
+
+ 1) pre-allocate all the lstreams and do whatever else was necessary
+ to make sure that no allocation occurs, since these functions may be
+ called from fatal_error_signal().
+
+ 2) (to be really correct) make a new lstream that outputs using
+ mswindows_output_console_string(). */
+
+static int
+std_handle_out_va (FILE *stream, const char *fmt, va_list args)
+{
+ Bufbyte kludge[8192];
+ Extbyte *extptr;
+ Extcount extlen;
+ int retval;
+
+ retval = vsprintf ((char *) kludge, fmt, args);
+ if (initialized && !fatal_error_in_progress)
+ TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)),
+ ALLOCA, (extptr, extlen),
+ Qnative);
+ else
+ {
+ extptr = (Extbyte *) kludge;
+ extlen = (Extcount) strlen ((char *) kludge);
+ }
+
+ std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1);
+ return retval;
+}
+
+/* Output portably to stderr or its equivalent; call GETTEXT on the
+ format string. Automatically flush when done. */
+
+int
+stderr_out (const char *fmt, ...)
+{
+ int retval;
+ va_list args;
+ va_start (args, fmt);
+ retval =
+ std_handle_out_va
+ (stderr, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
+ args);
+ va_end (args);
+ return retval;
+}
+
+/* Output portably to stdout or its equivalent; call GETTEXT on the
+ format string. Automatically flush when done. */
+
+int
+stdout_out (const char *fmt, ...)
+{
+ int retval;
+ va_list args;
+ va_start (args, fmt);
+ retval =
+ std_handle_out_va
+ (stdout, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
+ args);
+ va_end (args);
+ return retval;
+}
+
+DOESNT_RETURN
+fatal (const char *fmt, ...)
+{
+ va_list args;
+ va_start (args, fmt);
+
+ stderr_out ("\nXEmacs: ");
+ std_handle_out_va (stderr, GETTEXT (fmt), args);
+ stderr_out ("\n");
+
+ va_end (args);
+ exit (1);
+}
+
+/* Write a string (in internal format) to stdio stream STREAM. */
+
+void
+write_string_to_stdio_stream (FILE *stream, struct console *con,
+ const Bufbyte *str,
+ Bytecount offset, Bytecount len,
+ Lisp_Object coding_system,
+ int must_flush)
+{
+ Extcount extlen;
+ const Extbyte *extptr;
+
+ /* #### yuck! sometimes this function is called with string data,
+ and the following call may gc. */
+ {
+ Bufbyte *puta = (Bufbyte *) alloca (len);
+ memcpy (puta, str + offset, len);
+ TO_EXTERNAL_FORMAT (DATA, (puta, len),
+ ALLOCA, (extptr, extlen),
+ coding_system);
+ }
+
+ if (stream)
+ std_handle_out_external (stream, Qnil, extptr, extlen,
+ stream == stdout || stream == stderr, must_flush);
+ else
+ {
+ assert (CONSOLE_TTY_P (con));
+ std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream,
+ extptr, extlen,
+ CONSOLE_TTY_DATA (con)->is_stdio, must_flush);
+ }
+}
+
/* Write a string to the output location specified in FUNCTION.
Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
buffer_insert_string_1() in insdel.c. */
static void
-output_string (Lisp_Object function, CONST Bufbyte *nonreloc,
+output_string (Lisp_Object function, const Bufbyte *nonreloc,
Lisp_Object reloc, Bytecount offset, Bytecount len)
{
/* This function can GC */
other functions that take both a nonreloc and a reloc, or things
may get confused and an assertion failure in
fixup_internal_substring() may get triggered. */
- CONST Bufbyte *newnonreloc = nonreloc;
+ const Bufbyte *newnonreloc = nonreloc;
struct gcpro gcpro1, gcpro2;
/* Emacs won't print while GCing, but an external debugger might */
else if (EQ (function, Qt) || EQ (function, Qnil))
{
write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
- FORMAT_TERMINAL);
+ Qterminal, print_unbuffered);
}
else
{
\f
/* Used for printing a single-byte character (*not* any Emchar). */
#define write_char_internal(string_of_length_1, stream) \
- output_string (stream, (CONST Bufbyte *) (string_of_length_1), \
+ output_string (stream, (const Bufbyte *) (string_of_length_1), \
Qnil, 0, 1)
/* NOTE: Do not call this with the data of a Lisp_String, as
canonicalize_printcharfun() (i.e. Qnil means stdout, not
Vstandard_output, etc.) */
void
-write_string_1 (CONST Bufbyte *str, Bytecount size, Lisp_Object stream)
+write_string_1 (const Bufbyte *str, Bytecount size, Lisp_Object stream)
{
/* This function can GC */
#ifdef ERROR_CHECK_BUFPOS
}
void
-write_c_string (CONST char *str, Lisp_Object stream)
+write_c_string (const char *str, Lisp_Object stream)
{
/* This function can GC */
- write_string_1 ((CONST Bufbyte *) str, strlen (str), stream);
+ write_string_1 ((const Bufbyte *) str, strlen (str), stream);
}
\f
/*
* This buffer should be at least as large as the max string size of the
- * largest float, printed in the biggest notation. This is undoubtably
+ * largest float, printed in the biggest notation. This is undoubtedly
* 20d float_output_format, with the negative of the C-constant "HUGE"
* from <math.h>.
*
}
#endif /* LISP_FLOAT_TYPE */
-/* Print NUMBER to BUFFER. The digits are first written in reverse
- order (the least significant digit first), and are then reversed.
- This is equivalent to sprintf(buffer, "%ld", number), only much
- faster.
+/* Print NUMBER to BUFFER. This is equivalent to sprintf(buffer,
+ "%ld", number), only much faster.
BUFFER should accept 24 bytes. This should suffice for the longest
numbers on 64-bit machines, including the `-' sign and the trailing
}
\f
static void
-print_vector_internal (CONST char *start, CONST char *end,
+print_vector_internal (const char *start, const char *end,
Lisp_Object obj,
Lisp_Object printcharfun, int escapeflag)
{
void
print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
- struct Lisp_String *s = XSTRING (obj);
+ Lisp_String *s = XSTRING (obj);
/* We distinguish between Bytecounts and Charcounts, to make
Vprint_string_length work correctly under Mule. */
Charcount size = string_char_length (s);
{
p += set_charptr_emchar ((Bufbyte *) p, ch);
}
-
+
output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf);
break;
/* This function can GC */
/* #### Bug!! (intern "") isn't printed in some distinguished way */
/* #### (the reader also loses on it) */
- struct Lisp_String *name = symbol_name (XSYMBOL (obj));
+ Lisp_String *name = symbol_name (XSYMBOL (obj));
Bytecount size = string_length (name);
struct gcpro gcpro1, gcpro2;
Bufbyte str[MAX_EMCHAR_LEN];
Bytecount len;
int extlen;
- CONST Extbyte *extptr;
+ const Extbyte *extptr;
CHECK_CHAR_COERCE_INT (character);
len = set_charptr_emchar (str, XCHAR (character));
- GET_CHARPTR_EXT_DATA_ALLOCA (str, len, FORMAT_TERMINAL, extptr, extlen);
+ TO_EXTERNAL_FORMAT (DATA, (str, len),
+ ALLOCA, (extptr, extlen),
+ Qterminal);
memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
alternate_do_pointer += extlen;
alternate_do_string[alternate_do_pointer] = 0;
to stderr. You can use this function to write directly to the terminal.
This function can be used as the STREAM argument of Fprint() or the like.
+Under MS Windows, this writes output to the console window (which is
+created, if necessary), unless XEmacs is being run noninteractively
+\(i.e. using the `-batch' argument).
+
If you have opened a termscript file (using `open-termscript'), then
the output also will be logged to this file.
*/
write_string_to_stdio_stream (file, con,
XSTRING_DATA (char_or_string),
0, XSTRING_LENGTH (char_or_string),
- FORMAT_TERMINAL);
+ Qterminal, 1);
else
{
Bufbyte str[MAX_EMCHAR_LEN];
CHECK_CHAR_COERCE_INT (char_or_string);
len = set_charptr_emchar (str, XCHAR (char_or_string));
- write_string_to_stdio_stream (file, con, str, 0, len, FORMAT_TERMINAL);
+ write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
}
return char_or_string;
#if 1
/* Debugging kludge -- unbuffered */
-static int debug_print_length = 50;
-static int debug_print_level = 15;
+static int debug_print_length = 50;
+static int debug_print_level = 15;
+static int debug_print_readably = -1;
static void
debug_print_no_newline (Lisp_Object debug_print_obj)
{
/* This function can GC */
- int old_print_readably = print_readably;
- int old_print_depth = print_depth;
- Lisp_Object old_print_length = Vprint_length;
- Lisp_Object old_print_level = Vprint_level;
- Lisp_Object old_inhibit_quit = Vinhibit_quit;
+ int save_print_readably = print_readably;
+ int save_print_depth = print_depth;
+ Lisp_Object save_Vprint_length = Vprint_length;
+ Lisp_Object save_Vprint_level = Vprint_level;
+ Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
struct gcpro gcpro1, gcpro2, gcpro3;
- GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
+ GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
if (gc_in_progress)
stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
print_depth = 0;
- print_readably = 0;
+ print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
print_unbuffered++;
/* Could use unwind-protect, but why bother? */
if (debug_print_length > 0)
Vprint_length = make_int (debug_print_length);
if (debug_print_level > 0)
Vprint_level = make_int (debug_print_level);
+
print_internal (debug_print_obj, Qexternal_debugging_output, 1);
- Vinhibit_quit = old_inhibit_quit;
- Vprint_level = old_print_level;
- Vprint_length = old_print_length;
- print_depth = old_print_depth;
- print_readably = old_print_readably;
+
+ Vinhibit_quit = save_Vinhibit_quit;
+ Vprint_level = save_Vprint_level;
+ Vprint_length = save_Vprint_length;
+ print_depth = save_print_depth;
+ print_readably = save_print_readably;
print_unbuffered--;
UNGCPRO;
}
{
debug_print_no_newline (debug_print_obj);
stderr_out ("\n");
- fflush (stderr);
}
/* Debugging kludge -- unbuffered */
Fbacktrace (Qexternal_debugging_output, Qt);
stderr_out ("\n");
- fflush (stderr);
Vinhibit_quit = old_inhibit_quit;
Vprint_level = old_print_level;
int first = 1;
struct backtrace *bt = backtrace_list;
stderr_out (" [");
- fflush (stderr);
while (length > 0 && bt)
{
if (!first)
{
stderr_out (", ");
- fflush (stderr);
}
if (COMPILED_FUNCTIONP (*bt->function))
{
if (!NILP (ann))
{
stderr_out ("<compiled-function from ");
- fflush (stderr);
debug_print_no_newline (ann);
stderr_out (">");
- fflush (stderr);
}
else
{
stderr_out ("<compiled-function of unknown origin>");
- fflush (stderr);
}
}
else
bt = bt->next;
}
stderr_out ("]\n");
- fflush (stderr);
}
#endif /* debugging kludge */