comparison src/print.c @ 109126:aec1143e8d85

Convert (most) functions in src to standard C. * src/alloc.c: Convert function definitions to standard C. * src/atimer.c: * src/bidi.c: * src/bytecode.c: * src/callint.c: * src/callproc.c: * src/casefiddle.c: * src/casetab.c: * src/category.c: * src/ccl.c: * src/character.c: * src/charset.c: * src/chartab.c: * src/cmds.c: * src/coding.c: * src/composite.c: * src/data.c: * src/dbusbind.c: * src/dired.c: * src/dispnew.c: * src/doc.c: * src/doprnt.c: * src/ecrt0.c: * src/editfns.c: * src/fileio.c: * src/filelock.c: * src/filemode.c: * src/fns.c: * src/font.c: * src/fontset.c: * src/frame.c: * src/fringe.c: * src/ftfont.c: * src/ftxfont.c: * src/gtkutil.c: * src/indent.c: * src/insdel.c: * src/intervals.c: * src/keymap.c: * src/lread.c: * src/macros.c: * src/marker.c: * src/md5.c: * src/menu.c: * src/minibuf.c: * src/prefix-args.c: * src/print.c: * src/ralloc.c: * src/regex.c: * src/region-cache.c: * src/scroll.c: * src/search.c: * src/sound.c: * src/strftime.c: * src/syntax.c: * src/sysdep.c: * src/termcap.c: * src/terminal.c: * src/terminfo.c: * src/textprop.c: * src/tparam.c: * src/undo.c: * src/unexelf.c: * src/window.c: * src/xfaces.c: * src/xfns.c: * src/xfont.c: * src/xftfont.c: * src/xgselect.c: * src/xmenu.c: * src/xrdb.c: * src/xselect.c: * src/xsettings.c: * src/xsmfns.c: * src/xterm.c: Likewise.

109125:12b02558bf51

extern int noninteractive_need_newline;

extern int minibuffer_auto_raise;

void print_interval ();

/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
int print_output_debug_flag = 1;



/* This is used to restore the saved contents of print_buffer
   when there is a recursive call to print.  */

static Lisp_Object
print_unwind (saved_text)
     Lisp_Object saved_text;
{
  bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
  return Qnil;
}

   print_buffer.  FUN t means print to echo area or stdout if
   non-interactive.  If FUN is neither nil nor t, call FUN with CH as
   argument.  */

static void
printchar (ch, fun)
     unsigned int ch;
     Lisp_Object fun;
{
  if (!NILP (fun) && !EQ (fun, Qt))
    call1 (fun, make_number (ch));
  else
    {

   In the case where PRINTCHARFUN is nil, it is safe for PTR to point
   to data in a Lisp string.  Otherwise that is not safe.  */

static void
strout (ptr, size, size_byte, printcharfun, multibyte)
     char *ptr;
     int size, size_byte;
     Lisp_Object printcharfun;
     int multibyte;
{
  if (size < 0)
    size_byte = size = strlen (ptr);

  if (NILP (printcharfun))

/* Print the contents of a string STRING using PRINTCHARFUN.
   It isn't safe to use strout in many cases,
   because printing one char can relocate.  */

static void
print_string (string, printcharfun)
     Lisp_Object string;
     Lisp_Object printcharfun;
{
  if (EQ (printcharfun, Qt) || NILP (printcharfun))
    {
      int chars;

/* Used from outside of print.c to print a block of SIZE
   single-byte chars at DATA on the default output stream.
   Do not use this on the contents of a Lisp string.  */

void
write_string (data, size)
     char *data;
     int size;
{
  PRINTDECLARE;
  Lisp_Object printcharfun;

  printcharfun = Vstandard_output;

/* Used from outside of print.c to print a block of SIZE
   single-byte chars at DATA on a specified stream PRINTCHARFUN.
   Do not use this on the contents of a Lisp string.  */

void
write_string_1 (data, size, printcharfun)
     char *data;
     int size;
     Lisp_Object printcharfun;
{
  PRINTDECLARE;

  PRINTPREPARE;
  strout (data, size, size, printcharfun, 0);
  PRINTFINISH;
}


void
temp_output_buffer_setup (bufname)
    const char *bufname;
{
  int count = SPECPDL_INDEX ();
  register struct buffer *old = current_buffer;
  register Lisp_Object buf;

  specbind (Qstandard_output, buf);
}

Lisp_Object
internal_with_output_to_temp_buffer (bufname, function, args)
     const char *bufname;
     Lisp_Object (*function) (Lisp_Object);
     Lisp_Object args;
{
  int count = SPECPDL_INDEX ();
  Lisp_Object buf, val;
  struct gcpro gcpro1;

  return unbind_to (count, val);
}


static void print ();
static void print_preprocess ();
static void print_preprocess_string ();
static void print_object ();

DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
       doc: /* Output a newline to stream PRINTCHARFUN.
If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
  (printcharfun)

/* This function is never called.  Its purpose is to prevent
   print_output_debug_flag from being optimized away.  */

void
debug_output_compilation_hack (x)
     int x;
{
  print_output_debug_flag = x;
}

#if defined (GNU_LINUX)

/* This is the interface for debugging printing.  */

void
debug_print (arg)
     Lisp_Object arg;
{
  Fprin1 (arg, Qexternal_debugging_output);
  fprintf (stderr, "\r\n");
}

void
safe_debug_print (arg)
     Lisp_Object arg;
{
  int valid = valid_lisp_object_p (arg);

  if (valid > 0)
    debug_print (arg);

   STREAM (suitable for the print functions).
   CONTEXT is a C string describing the context of the error.
   CALLER is the Lisp function inside which the error was signaled.  */

void
print_error_message (data, stream, context, caller)
     Lisp_Object data, stream;
     char *context;
     Lisp_Object caller;
{
  Lisp_Object errname, errmsg, file_error, tail;
  struct gcpro gcpro1;
  int i;

 * re-writing _doprnt to be more sane)?
 * 			-wsr
 */

void
float_to_string (buf, data)
     unsigned char *buf;
     double data;
{
  unsigned char *cp;
  int width;

  /* Check for plus infinity in a way that won't lose

    }
}


static void
print (obj, printcharfun, escapeflag)
     Lisp_Object obj;
     register Lisp_Object printcharfun;
     int escapeflag;
{
  new_backquote_output = 0;

  /* Reset print_number_index and Vprint_number_table only when
     the variable Vprint_continuous_numbering is nil.  Otherwise,

   string (its text properties will be traced), or a symbol that has
   no obarray (this is for the print-gensym feature).
   The status fields of Vprint_number_table mean whether each object appears
   more than once in OBJ: Qnil at the first time, and Qt after that .  */
static void
print_preprocess (obj)
     Lisp_Object obj;
{
  int i;
  EMACS_INT size;
  int loop_count = 0;
  Lisp_Object halftail;

    }
  print_depth--;
}

static void
print_preprocess_string (interval, arg)
     INTERVAL interval;
     Lisp_Object arg;
{
  print_preprocess (interval->plist);
}

/* A flag to control printing of `charset' text property.
   The default value is Qdefault. */
Lisp_Object Vprint_charset_text_property;
extern Lisp_Object Qdefault;

static void print_check_string_charset_prop ();

#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2

/* Bitwize or of the abobe macros. */
static int print_check_string_result;

static void
print_check_string_charset_prop (interval, string)
     INTERVAL interval;
     Lisp_Object string;
{
  Lisp_Object val;

  if (NILP (interval->plist)
      || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND

/* The value is (charset . nil).  */
static Lisp_Object print_prune_charset_plist;

static Lisp_Object
print_prune_string_charset (string)
     Lisp_Object string;
{
  print_check_string_result = 0;
  traverse_intervals (STRING_INTERVALS (string), 0,
		      print_check_string_charset_prop, string);
  if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))

    }
  return string;
}

static void
print_object (obj, printcharfun, escapeflag)
     Lisp_Object obj;
     register Lisp_Object printcharfun;
     int escapeflag;
{
  char buf[40];

  QUIT;

/* Print a description of INTERVAL using PRINTCHARFUN.
   This is part of printing a string that has text properties.  */

void
print_interval (interval, printcharfun)
     INTERVAL interval;
     Lisp_Object printcharfun;
{
  if (NILP (interval->plist))
    return;
  PRINTCHAR (' ');
  print_object (make_number (interval->position), printcharfun, 1);

  print_object (interval->plist, printcharfun, 1);
}


void
syms_of_print ()
{
  Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
  staticpro (&Qtemp_buffer_setup_hook);

  DEFVAR_LISP ("standard-output", &Vstandard_output,

109126:aec1143e8d85

extern int noninteractive_need_newline;

extern int minibuffer_auto_raise;

void print_interval (INTERVAL interval, Lisp_Object printcharfun);

/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
int print_output_debug_flag = 1;



/* This is used to restore the saved contents of print_buffer
   when there is a recursive call to print.  */

static Lisp_Object
print_unwind (Lisp_Object saved_text)
{
  bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
  return Qnil;
}

   print_buffer.  FUN t means print to echo area or stdout if
   non-interactive.  If FUN is neither nil nor t, call FUN with CH as
   argument.  */

static void
printchar (unsigned int ch, Lisp_Object fun)
{
  if (!NILP (fun) && !EQ (fun, Qt))
    call1 (fun, make_number (ch));
  else
    {

   In the case where PRINTCHARFUN is nil, it is safe for PTR to point
   to data in a Lisp string.  Otherwise that is not safe.  */

static void
strout (char *ptr, int size, int size_byte, Lisp_Object printcharfun, int multibyte)
{
  if (size < 0)
    size_byte = size = strlen (ptr);

  if (NILP (printcharfun))

/* Print the contents of a string STRING using PRINTCHARFUN.
   It isn't safe to use strout in many cases,
   because printing one char can relocate.  */

static void
print_string (Lisp_Object string, Lisp_Object printcharfun)
{
  if (EQ (printcharfun, Qt) || NILP (printcharfun))
    {
      int chars;

/* Used from outside of print.c to print a block of SIZE
   single-byte chars at DATA on the default output stream.
   Do not use this on the contents of a Lisp string.  */

void
write_string (char *data, int size)
{
  PRINTDECLARE;
  Lisp_Object printcharfun;

  printcharfun = Vstandard_output;

/* Used from outside of print.c to print a block of SIZE
   single-byte chars at DATA on a specified stream PRINTCHARFUN.
   Do not use this on the contents of a Lisp string.  */

void
write_string_1 (char *data, int size, Lisp_Object printcharfun)
{
  PRINTDECLARE;

  PRINTPREPARE;
  strout (data, size, size, printcharfun, 0);
  PRINTFINISH;
}


void
temp_output_buffer_setup (const char *bufname)
{
  int count = SPECPDL_INDEX ();
  register struct buffer *old = current_buffer;
  register Lisp_Object buf;

  specbind (Qstandard_output, buf);
}

Lisp_Object
internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args)
{
  int count = SPECPDL_INDEX ();
  Lisp_Object buf, val;
  struct gcpro gcpro1;

  return unbind_to (count, val);
}


static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
static void print_preprocess (Lisp_Object obj);
static void print_preprocess_string (INTERVAL interval, Lisp_Object arg);
static void print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);

DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
       doc: /* Output a newline to stream PRINTCHARFUN.
If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
  (printcharfun)

/* This function is never called.  Its purpose is to prevent
   print_output_debug_flag from being optimized away.  */

void
debug_output_compilation_hack (int x)
{
  print_output_debug_flag = x;
}

#if defined (GNU_LINUX)

/* This is the interface for debugging printing.  */

void
debug_print (Lisp_Object arg)
{
  Fprin1 (arg, Qexternal_debugging_output);
  fprintf (stderr, "\r\n");
}

void
safe_debug_print (Lisp_Object arg)
{
  int valid = valid_lisp_object_p (arg);

  if (valid > 0)
    debug_print (arg);

   STREAM (suitable for the print functions).
   CONTEXT is a C string describing the context of the error.
   CALLER is the Lisp function inside which the error was signaled.  */

void
print_error_message (Lisp_Object data, Lisp_Object stream, char *context, Lisp_Object caller)
{
  Lisp_Object errname, errmsg, file_error, tail;
  struct gcpro gcpro1;
  int i;

 * re-writing _doprnt to be more sane)?
 * 			-wsr
 */

void
float_to_string (unsigned char *buf, double data)
{
  unsigned char *cp;
  int width;

  /* Check for plus infinity in a way that won't lose

    }
}


static void
print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
  new_backquote_output = 0;

  /* Reset print_number_index and Vprint_number_table only when
     the variable Vprint_continuous_numbering is nil.  Otherwise,

   string (its text properties will be traced), or a symbol that has
   no obarray (this is for the print-gensym feature).
   The status fields of Vprint_number_table mean whether each object appears
   more than once in OBJ: Qnil at the first time, and Qt after that .  */
static void
print_preprocess (Lisp_Object obj)
{
  int i;
  EMACS_INT size;
  int loop_count = 0;
  Lisp_Object halftail;

    }
  print_depth--;
}

static void
print_preprocess_string (INTERVAL interval, Lisp_Object arg)
{
  print_preprocess (interval->plist);
}

/* A flag to control printing of `charset' text property.
   The default value is Qdefault. */
Lisp_Object Vprint_charset_text_property;
extern Lisp_Object Qdefault;

static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string);

#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2

/* Bitwize or of the abobe macros. */
static int print_check_string_result;

static void
print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
{
  Lisp_Object val;

  if (NILP (interval->plist)
      || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND

/* The value is (charset . nil).  */
static Lisp_Object print_prune_charset_plist;

static Lisp_Object
print_prune_string_charset (Lisp_Object string)
{
  print_check_string_result = 0;
  traverse_intervals (STRING_INTERVALS (string), 0,
		      print_check_string_charset_prop, string);
  if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))

    }
  return string;
}

static void
print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
  char buf[40];

  QUIT;

/* Print a description of INTERVAL using PRINTCHARFUN.
   This is part of printing a string that has text properties.  */

void
print_interval (INTERVAL interval, Lisp_Object printcharfun)
{
  if (NILP (interval->plist))
    return;
  PRINTCHAR (' ');
  print_object (make_number (interval->position), printcharfun, 1);

  print_object (interval->plist, printcharfun, 1);
}


void
syms_of_print (void)
{
  Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
  staticpro (&Qtemp_buffer_setup_hook);

  DEFVAR_LISP ("standard-output", &Vstandard_output,