xemacs-beta: src/print.c comparison

comparison src/print.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 /* 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.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 #include "extents.h"
 #include "frame.h"
 #include "insdel.h"
 #include "lstream.h"
 #include "sysfile.h"
+#ifdef WIN32_NATIVE
-#include <limits.h>
+#include "console-msw.h"
+#endif
 #include <float.h>
 /* Define if not in float.h */
 #ifndef DBL_DIG
 #define DBL_DIG 16
 #endif
 Lisp_Object Vstandard_output, Qstandard_output;
 /* The subroutine object for external-debugging-output is kept here
 for the convenience of the debugger.  */
-Lisp_Object Qexternal_debugging_output;
+Lisp_Object Qexternal_debugging_output, Qalternate_debugging_output;
+#ifdef HAVE_MS_WINDOWS
+Lisp_Object Qmswindows_debugging_output;
+#endif
 /* Avoid actual stack overflow in print.  */
 static int print_depth;
 /* Detect most circularities to print finite output.  */
 int stdout_needs_newline;
-/* Write a string (in internal format) to stdio stream STREAM. */
+static void
+std_handle_out_external (FILE *stream, Lisp_Object lstream,
-void
+			 const Extbyte *extptr, Extcount extlen,
-write_string_to_stdio_stream (FILE *stream, struct console *con,
+			 /* is this really stdout/stderr?
-			      CONST Bufbyte *str,
+			    (controls termscript writing) */
-			      Bytecount offset, Bytecount len,
+			 int output_is_std_handle,
-			      Lisp_Object coding_system)
+			 int must_flush)
 {
-Extcount extlen;
-CONST Extbyte *extptr;
-TO_EXTERNAL_FORMAT (DATA, (str + offset, len),
-		      ALLOCA, (extptr, extlen),
-		      coding_system);
 if (stream)
 {
-fwrite (extptr, 1, extlen, stream);
+#ifdef WIN32_NATIVE
-#ifdef WINDOWSNT
+HANDLE errhand = GetStdHandle (STD_INPUT_HANDLE);
-/* Q122442 says that pipes are "treated as files, not as
+int no_useful_stderr = errhand == 0 || errhand == INVALID_HANDLE_VALUE;
-	 devices", and that this is a feature. Before I found that
-	 article, I thought it was a bug. Thanks MS, I feel much
+if (!no_useful_stderr)
-	 better now. - kkm */
+	no_useful_stderr = !PeekNamedPipe (errhand, 0, 0, 0, 0, 0);
-if (stream == stdout || stream == stderr)
+/* we typically have no useful stdout/stderr under windows if we're
-	fflush (stream);
+	 being invoked graphically. */
+if (no_useful_stderr)
+	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
-{
+Lstream_write (XLSTREAM (lstream), extptr, extlen);
-assert (CONSOLE_TTY_P (con));
-Lstream_write (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream),
+if (output_is_std_handle)
-		     extptr, extlen);
-}
-if (stream == stdout || stream == stderr ||
-(!stream && CONSOLE_TTY_DATA (con)->is_stdio))
 {
 if (termscript)
 	{
 	  fwrite (extptr, 1, extlen, termscript);
 	  fflush (termscript);
 	}
 stdout_needs_newline = (extptr[extlen - 1] != '\n');
 }
 }
+/* #### 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 */
 Charcount cclen;
 /* We change the value of nonreloc (fetching it from reloc as
 necessary), but we don't want to pass this changed value on to
 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 */
 if (gc_in_progress) return;
 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
 }
 else if (EQ (function, Qt) || EQ (function, Qnil))
 {
 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
-				    Qterminal);
+				    Qterminal, print_unbuffered);
 }
 else
 {
 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
 Charcount iii;
 }
 }
 /* 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
 printcharfun might cause a GC, which might cause the string's data
 to be relocated.  To princ a Lisp string, use:
 Also note that STREAM should be the result of
 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
 assert (size >= 0);
 #endif
 output_string (stream, str, Qnil, 0, size);
 }
 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);
 }
 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /*
 Output character CH to stream STREAM.
 buf [(buf [0] == '-' ? 1 : 0)] = '0';
 }
 }
 #endif /* LISP_FLOAT_TYPE */
-/* Print NUMBER to BUFFER.  The digits are first written in reverse
+/* Print NUMBER to BUFFER.  This is equivalent to sprintf(buffer,
-order (the least significant digit first), and are then reversed.
+"%ld", number), only much faster.
-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
 \0.  */
 void
 *p = '\0';
 #endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
 }
 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)
 {
 /* This function can GC */
 int i;
 /* If we print an uninterned symbol as part of a complex object and
 the flag print-gensym is non-nil, prefix it with #n= to read the
 object back with the #n# reader syntax later if needed.  */
 if (!NILP (Vprint_gensym)
-/* #### Test whether this produces a noticable slow-down for
+/* #### Test whether this produces a noticeable slow-down for
 printing when print-gensym is non-nil.  */
 && !EQ (obj, oblookup (Vobarray,
 			     string_data (symbol_name (XSYMBOL (obj))),
 			     string_length (symbol_name (XSYMBOL (obj))))))
 {
 output_string (printcharfun, 0, nameobj, last, size - last);
 }
 UNGCPRO;
 }
-/* #ifdef DEBUG_XEMACS */
+/* Useful on systems or in places where writing to stdout is unavailable or
-/* I don't like seeing `Note: Strange doc (not fboundp) for function
+not working. */
-alternate-debugging-output @ 429542' -slb */
-/* #### Eek!  Any clue how to get rid of it?  In fact, how about
-getting rid of this function altogether?  Does anything actually
-*use* it?  --hniksic */
 static int alternate_do_pointer;
 static char alternate_do_string[5000];
 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
 (character))
 {
 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));
 TO_EXTERNAL_FORMAT (DATA, (str, len),
 		      ALLOCA, (extptr, extlen),
 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
 alternate_do_pointer += extlen;
 alternate_do_string[alternate_do_pointer] = 0;
 return character;
 }
-/* #endif / * DEBUG_XEMACS */
 DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
 Write CHAR-OR-STRING to stderr or stdout.
 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
 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.
 */
 (char_or_string, stdout_p, device))
 if (STRINGP (char_or_string))
 write_string_to_stdio_stream (file, con,
 				  XSTRING_DATA (char_or_string),
 				  0, XSTRING_LENGTH (char_or_string),
-				  Qterminal);
+				  Qterminal, 1);
 else
 {
 Bufbyte str[MAX_EMCHAR_LEN];
 Bytecount 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, Qterminal);
+write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
 }
 return char_or_string;
 }
 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);
+alternate_do_pointer = 0;
+print_internal (debug_print_obj, Qalternate_debugging_output, 1);
+#ifdef WIN32_NATIVE
+/* Write out to the debugger, as well */
+print_internal (debug_print_obj, Qmswindows_debugging_output, 1);
+#endif
 Vinhibit_quit  = save_Vinhibit_quit;
 Vprint_level   = save_Vprint_level;
 Vprint_length  = save_Vprint_length;
 print_depth    = save_print_depth;
 void
 debug_print (Lisp_Object debug_print_obj)
 {
 debug_print_no_newline (debug_print_obj);
 stderr_out ("\n");
-fflush (stderr);
 }
 /* Debugging kludge -- unbuffered */
 /* This function provided for the benefit of the debugger.  */
 void debug_backtrace (void);
 if (debug_print_level > 0)
 Vprint_level = make_int (debug_print_level);
 Fbacktrace (Qexternal_debugging_output, Qt);
 stderr_out ("\n");
-fflush (stderr);
 Vinhibit_quit  = old_inhibit_quit;
 Vprint_level   = old_print_level;
 Vprint_length  = old_print_length;
 print_depth    = old_print_depth;
 debug_short_backtrace (int length)
 {
 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 defined(COMPILED_FUNCTION_ANNOTATION_HACK)
 	  Lisp_Object ann =
 	  Lisp_Object ann = Qnil;
 #endif
 	  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
 	debug_print_no_newline (*bt->function);
 first = 0;
 length--;
 bt = bt->next;
 }
 stderr_out ("]\n");
-fflush (stderr);
 }
 #endif /* debugging kludge */
 DEFSUBR (Fwrite_char);
 DEFSUBR (Falternate_debugging_output);
 DEFSUBR (Fexternal_debugging_output);
 DEFSUBR (Fopen_termscript);
 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
+defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
+#ifdef HAVE_MS_WINDOWS
+defsymbol (&Qmswindows_debugging_output, "mswindows-debugging-output");
+#endif
 DEFSUBR (Fwith_output_to_temp_buffer);
 }
 void
 reinit_vars_of_print (void)

Mercurial > hg > xemacs-beta

comparison src/print.c @ 442:abe6d1db359e r21-2-36