print.c 67.4 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Lisp object printing and output streams.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
4
Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
23
#include "sysstdio.h"
24

Jim Blandy's avatar
Jim Blandy committed
25
#include "lisp.h"
26
#include "character.h"
27
#include "buffer.h"
Kenichi Handa's avatar
Kenichi Handa committed
28
#include "charset.h"
29
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
30
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
31 32 33 34
#include "window.h"
#include "process.h"
#include "dispextern.h"
#include "termchar.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
35
#include "intervals.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
36
#include "blockinput.h"
37
#include "termhooks.h"		/* For struct terminal.  */
Kenichi Handa's avatar
Kenichi Handa committed
38
#include "font.h"
jave's avatar
jave committed
39

40
#include <c-ctype.h>
Paul Eggert's avatar
Paul Eggert committed
41
#include <float.h>
Paul Eggert's avatar
Paul Eggert committed
42
#include <ftoastr.h>
Paul Eggert's avatar
Paul Eggert committed
43

Jim Blandy's avatar
Jim Blandy committed
44
/* Avoid actual stack overflow in print.  */
45
static ptrdiff_t print_depth;
Jim Blandy's avatar
Jim Blandy committed
46

47
/* Level of nesting inside outputting backquote in new style.  */
48
static ptrdiff_t new_backquote_output;
49

50 51
/* Detect most circularities to print finite output.  */
#define PRINT_CIRCLE 200
52
static Lisp_Object being_printed[PRINT_CIRCLE];
53

54 55 56
/* Last char printed to stdout by printchar.  */
static unsigned int printchar_stdout_last;

57 58
/* When printing into a buffer, first we put the text in this
   block, then insert it all at once.  */
59
static char *print_buffer;
60 61

/* Size allocated in print_buffer.  */
62
static ptrdiff_t print_buffer_size;
63
/* Chars stored in print_buffer.  */
64
static ptrdiff_t print_buffer_pos;
65
/* Bytes stored in print_buffer.  */
66
static ptrdiff_t print_buffer_pos_byte;
67

68 69 70 71 72 73 74 75
/* Vprint_number_table is a table, that keeps objects that are going to
   be printed, to allow use of #n= and #n# to express sharing.
   For any given object, the table can give the following values:
     t    the object will be printed only once.
     -N   the object will be printed several times and will take number N.
     N    the object has been printed so we can refer to it as #N#.
   print_number_index holds the largest N already used.
   N has to be striclty larger than 0 since we need to distinguish -N.  */
76
static ptrdiff_t print_number_index;
77
static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
Jim Blandy's avatar
Jim Blandy committed
78

79
/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
80
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
81

Jim Blandy's avatar
Jim Blandy committed
82

83
/* Low level output routines for characters and strings.  */
Jim Blandy's avatar
Jim Blandy committed
84 85

/* Lisp functions to do output using a stream
86
   must have the stream in a variable called printcharfun
87 88
   and must start with PRINTPREPARE, end with PRINTFINISH.
   Use printchar to output one character,
89
   or call strout to output a block of characters.  */
90

91
#define PRINTPREPARE							\
92
   struct buffer *old = current_buffer;					\
93 94 95
   ptrdiff_t old_point = -1, start_point = -1;				\
   ptrdiff_t old_point_byte = -1, start_point_byte = -1;		\
   ptrdiff_t specpdl_count = SPECPDL_INDEX ();				\
96
   bool free_print_buffer = 0;						\
97 98
   bool multibyte							\
     = !NILP (BVAR (current_buffer, enable_multibyte_characters));	\
99
   Lisp_Object original = printcharfun;					\
100 101 102 103 104 105 106 107 108
   if (NILP (printcharfun)) printcharfun = Qt;				\
   if (BUFFERP (printcharfun))						\
     {									\
       if (XBUFFER (printcharfun) != current_buffer)			\
	 Fset_buffer (printcharfun);					\
       printcharfun = Qnil;						\
     }									\
   if (MARKERP (printcharfun))						\
     {									\
109
       ptrdiff_t marker_pos;						\
Andreas Schwab's avatar
Andreas Schwab committed
110
       if (! XMARKER (printcharfun)->buffer)				\
111
         error ("Marker does not point anywhere");			\
112 113 114 115
       if (XMARKER (printcharfun)->buffer != current_buffer)		\
         set_buffer_internal (XMARKER (printcharfun)->buffer);		\
       marker_pos = marker_position (printcharfun);			\
       if (marker_pos < BEGV || marker_pos > ZV)			\
Joakim Verona's avatar
Joakim Verona committed
116 117
	 signal_error ("Marker is outside the accessible "		\
		       "part of the buffer", printcharfun);		\
118 119
       old_point = PT;							\
       old_point_byte = PT_BYTE;					\
120
       SET_PT_BOTH (marker_pos,						\
121 122 123 124 125 126 127 128
		    marker_byte_position (printcharfun));		\
       start_point = PT;						\
       start_point_byte = PT_BYTE;					\
       printcharfun = Qnil;						\
     }									\
   if (NILP (printcharfun))						\
     {									\
       Lisp_Object string;						\
Joakim Verona's avatar
Joakim Verona committed
129
       if (NILP (BVAR (current_buffer, enable_multibyte_characters))	\
130 131
	   && ! print_escape_multibyte)					\
         specbind (Qprint_escape_multibyte, Qt);			\
Joakim Verona's avatar
Joakim Verona committed
132
       if (! NILP (BVAR (current_buffer, enable_multibyte_characters))	\
133 134
	   && ! print_escape_nonascii)					\
         specbind (Qprint_escape_nonascii, Qt);				\
135 136 137 138 139 140 141 142 143
       if (print_buffer != 0)						\
	 {								\
	   string = make_string_from_bytes (print_buffer,		\
					    print_buffer_pos,		\
					    print_buffer_pos_byte);	\
	   record_unwind_protect (print_unwind, string);		\
	 }								\
       else								\
	 {								\
144
	   int new_size = 1000;						\
Dmitry Antipov's avatar
Dmitry Antipov committed
145
	   print_buffer = xmalloc (new_size);				\
146
	   print_buffer_size = new_size;				\
147 148 149 150 151
	   free_print_buffer = 1;					\
	 }								\
       print_buffer_pos = 0;						\
       print_buffer_pos_byte = 0;					\
     }									\
152
   if (EQ (printcharfun, Qt) && ! noninteractive)			\
153
     setup_echo_area_for_printing (multibyte);
Jim Blandy's avatar
Jim Blandy committed
154

155 156 157 158
#define PRINTFINISH							\
   if (NILP (printcharfun))						\
     {									\
       if (print_buffer_pos != print_buffer_pos_byte			\
Joakim Verona's avatar
Joakim Verona committed
159
	   && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
160
	 {								\
161 162
	   USE_SAFE_ALLOCA;						\
	   unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1);	\
163 164
	   copy_text ((unsigned char *) print_buffer, temp,		\
		      print_buffer_pos_byte, 1, 0);			\
165
	   insert_1_both ((char *) temp, print_buffer_pos,		\
166
			  print_buffer_pos, 0, 1, 0);			\
167
	   SAFE_FREE ();						\
168 169 170 171
	 }								\
       else								\
	 insert_1_both (print_buffer, print_buffer_pos,			\
			print_buffer_pos_byte, 0, 1, 0);		\
172
       signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
173 174 175 176 177 178 179 180 181 182 183 184
     }									\
   if (free_print_buffer)						\
     {									\
       xfree (print_buffer);						\
       print_buffer = 0;						\
     }									\
   unbind_to (specpdl_count, Qnil);					\
   if (MARKERP (original))						\
     set_marker_both (original, Qnil, PT, PT_BYTE);			\
   if (old_point >= 0)							\
     SET_PT_BOTH (old_point + (old_point >= start_point			\
			       ? PT - start_point : 0),			\
185
		  old_point_byte + (old_point_byte >= start_point_byte	\
Andreas Schwab's avatar
Andreas Schwab committed
186
				    ? PT_BYTE - start_point_byte : 0));	\
187
   set_buffer_internal (old);
Jim Blandy's avatar
Jim Blandy committed
188

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

192
static void
193
print_unwind (Lisp_Object saved_text)
194
{
195
  memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
196 197
}

198 199 200 201 202

/* Print character CH using method FUN.  FUN nil means print to
   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.  */
Jim Blandy's avatar
Jim Blandy committed
203 204

static void
205
printchar (unsigned int ch, Lisp_Object fun)
Jim Blandy's avatar
Jim Blandy committed
206
{
207 208 209
  if (!NILP (fun) && !EQ (fun, Qt))
    call1 (fun, make_number (ch));
  else
Jim Blandy's avatar
Jim Blandy committed
210
    {
211 212 213
      unsigned char str[MAX_MULTIBYTE_LENGTH];
      int len = CHAR_STRING (ch, str);

214
      QUIT;
215

216
      if (NILP (fun))
217
	{
218
	  ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
219 220 221
	  if (incr > 0)
	    print_buffer = xpalloc (print_buffer, &print_buffer_size,
				    incr, -1, 1);
222
	  memcpy (print_buffer + print_buffer_pos_byte, str, len);
223 224
	  print_buffer_pos += 1;
	  print_buffer_pos_byte += len;
225
	}
226
      else if (noninteractive)
227
	{
228
	  printchar_stdout_last = ch;
229 230
	  fwrite (str, 1, len, stdout);
	  noninteractive_need_newline = 1;
231
	}
232
      else
233
	{
234
	  bool multibyte_p
Tom Tromey's avatar
Tom Tromey committed
235
	    = !NILP (BVAR (current_buffer, enable_multibyte_characters));
236

237
	  setup_echo_area_for_printing (multibyte_p);
238
	  insert_char (ch);
239
	  message_dolog ((char *) str, len, 0, multibyte_p);
240
	}
Jim Blandy's avatar
Jim Blandy committed
241 242 243
    }
}

244 245

/* Output SIZE characters, SIZE_BYTE bytes from string PTR using
246
   method PRINTCHARFUN.  PRINTCHARFUN nil means output to
247 248 249
   print_buffer.  PRINTCHARFUN t means output to the echo area or to
   stdout if non-interactive.  If neither nil nor t, call Lisp
   function PRINTCHARFUN for each character printed.  MULTIBYTE
250 251 252 253
   non-zero means PTR contains multibyte characters.

   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.  */
254

Jim Blandy's avatar
Jim Blandy committed
255
static void
256
strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
257
	Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
258
{
259
  if (NILP (printcharfun))
Jim Blandy's avatar
Jim Blandy committed
260
    {
261
      ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
262
      if (incr > 0)
263
	print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
264
      memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
265
      print_buffer_pos += size;
266
      print_buffer_pos_byte += size_byte;
Jim Blandy's avatar
Jim Blandy committed
267
    }
268
  else if (noninteractive && EQ (printcharfun, Qt))
Jim Blandy's avatar
Jim Blandy committed
269
    {
270 271 272 273 274 275 276 277 278
      fwrite (ptr, 1, size_byte, stdout);
      noninteractive_need_newline = 1;
    }
  else if (EQ (printcharfun, Qt))
    {
      /* Output to echo area.  We're trying to avoid a little overhead
	 here, that's the reason we don't call printchar to do the
	 job.  */
      int i;
279
      bool multibyte_p
Tom Tromey's avatar
Tom Tromey committed
280
	= !NILP (BVAR (current_buffer, enable_multibyte_characters));
281

282
      setup_echo_area_for_printing (multibyte_p);
283
      message_dolog (ptr, size_byte, 0, multibyte_p);
284

285
      if (size == size_byte)
Jim Blandy's avatar
Jim Blandy committed
286
	{
287
	  for (i = 0; i < size; ++i)
Andreas Schwab's avatar
Andreas Schwab committed
288
	    insert_char ((unsigned char) *ptr++);
Jim Blandy's avatar
Jim Blandy committed
289
	}
290
      else
Jim Blandy's avatar
Jim Blandy committed
291
	{
292 293
	  int len;
	  for (i = 0; i < size_byte; i += len)
294
	    {
295 296
	      int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
					       len);
297
	      insert_char (ch);
298
	    }
Jim Blandy's avatar
Jim Blandy committed
299
	}
300 301 302 303
    }
  else
    {
      /* PRINTCHARFUN is a Lisp function.  */
304
      ptrdiff_t i = 0;
Jim Blandy's avatar
Jim Blandy committed
305

306
      if (size == size_byte)
307
	{
308
	  while (i < size_byte)
309
	    {
310
	      int ch = ptr[i++];
311
	      printchar (ch, printcharfun);
312 313
	    }
	}
314
      else
Karl Heuer's avatar
Karl Heuer committed
315
	{
316 317 318 319 320 321
	  while (i < size_byte)
	    {
	      /* Here, we must convert each multi-byte form to the
		 corresponding character code before handing it to
		 PRINTCHAR.  */
	      int len;
322 323
	      int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
					       len);
324
	      printchar (ch, printcharfun);
325 326
	      i += len;
	    }
Karl Heuer's avatar
Karl Heuer committed
327
	}
Jim Blandy's avatar
Jim Blandy committed
328 329 330 331
    }
}

/* Print the contents of a string STRING using PRINTCHARFUN.
332 333
   It isn't safe to use strout in many cases,
   because printing one char can relocate.  */
Jim Blandy's avatar
Jim Blandy committed
334

335
static void
336
print_string (Lisp_Object string, Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
337
{
338
  if (EQ (printcharfun, Qt) || NILP (printcharfun))
339
    {
340
      ptrdiff_t chars;
341

342 343 344
      if (print_escape_nonascii)
	string = string_escape_byte8 (string);

345
      if (STRING_MULTIBYTE (string))
346
	chars = SCHARS (string);
347 348
      else if (! print_escape_nonascii
	       && (EQ (printcharfun, Qt)
Tom Tromey's avatar
Tom Tromey committed
349 350
		   ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))
		   : ! NILP (BVAR (current_buffer, enable_multibyte_characters))))
351 352 353 354 355
	{
	  /* If unibyte string STRING contains 8-bit codes, we must
	     convert STRING to a multibyte string containing the same
	     character codes.  */
	  Lisp_Object newstr;
356
	  ptrdiff_t bytes;
357

358
	  chars = SBYTES (string);
359
	  bytes = count_size_as_multibyte (SDATA (string), chars);
360 361 362
	  if (chars < bytes)
	    {
	      newstr = make_uninit_multibyte_string (chars, bytes);
363
	      memcpy (SDATA (newstr), SDATA (string), chars);
364
	      str_to_multibyte (SDATA (newstr), bytes, chars);
365 366 367
	      string = newstr;
	    }
	}
368
      else
369
	chars = SBYTES (string);
370

371 372 373
      if (EQ (printcharfun, Qt))
	{
	  /* Output to echo area.  */
374
	  ptrdiff_t nbytes = SBYTES (string);
375 376 377 378

	  /* Copy the string contents so that relocation of STRING by
	     GC does not cause trouble.  */
	  USE_SAFE_ALLOCA;
379
	  char *buffer = SAFE_ALLOCA (nbytes);
380
	  memcpy (buffer, SDATA (string), nbytes);
381

382
	  strout (buffer, chars, nbytes, printcharfun);
383 384 385 386 387

	  SAFE_FREE ();
	}
      else
	/* No need to copy, since output to print_buffer can't GC.  */
388
	strout (SSDATA (string), chars, SBYTES (string), printcharfun);
389
    }
Jim Blandy's avatar
Jim Blandy committed
390 391
  else
    {
392 393
      /* Otherwise, string may be relocated by printing one char.
	 So re-fetch the string address for each character.  */
394 395 396
      ptrdiff_t i;
      ptrdiff_t size = SCHARS (string);
      ptrdiff_t size_byte = SBYTES (string);
Jim Blandy's avatar
Jim Blandy committed
397 398
      struct gcpro gcpro1;
      GCPRO1 (string);
399 400
      if (size == size_byte)
	for (i = 0; i < size; i++)
401
	  printchar (SREF (string, i), printcharfun);
402
      else
Kenichi Handa's avatar
Kenichi Handa committed
403
	for (i = 0; i < size_byte; )
404 405 406 407
	  {
	    /* Here, we must convert each multi-byte form to the
	       corresponding character code before handing it to PRINTCHAR.  */
	    int len;
408
	    int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
409
	    printchar (ch, printcharfun);
410 411
	    i += len;
	  }
Jim Blandy's avatar
Jim Blandy committed
412 413 414 415 416
      UNGCPRO;
    }
}

DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
417 418
       doc: /* Output character CHARACTER to stream PRINTCHARFUN.
PRINTCHARFUN defaults to the value of `standard-output' (which see).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
419
  (Lisp_Object character, Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
420
{
Jim Blandy's avatar
Jim Blandy committed
421
  if (NILP (printcharfun))
Jim Blandy's avatar
Jim Blandy committed
422
    printcharfun = Vstandard_output;
423
  CHECK_NUMBER (character);
Jim Blandy's avatar
Jim Blandy committed
424
  PRINTPREPARE;
425
  printchar (XINT (character), printcharfun);
Jim Blandy's avatar
Jim Blandy committed
426
  PRINTFINISH;
427
  return character;
Jim Blandy's avatar
Jim Blandy committed
428 429
}

430 431
/* Print the contents of a unibyte C string STRING using PRINTCHARFUN.
   The caller should arrange to put this inside PRINTPREPARE and PRINTFINISH.
Jim Blandy's avatar
Jim Blandy committed
432 433
   Do not use this on the contents of a Lisp string.  */

434 435
static void
print_c_string (char const *string, Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
436
{
437 438 439
  ptrdiff_t len = strlen (string);
  strout (string, len, len, printcharfun);
}
Jim Blandy's avatar
Jim Blandy committed
440

441 442
/* Print unibyte C string at DATA on a specified stream PRINTCHARFUN.
   Do not use this on the contents of a Lisp string.  */
Jim Blandy's avatar
Jim Blandy committed
443

444 445 446
static void
write_string_1 (const char *data, Lisp_Object printcharfun)
{
Jim Blandy's avatar
Jim Blandy committed
447
  PRINTPREPARE;
448
  print_c_string (data, printcharfun);
Jim Blandy's avatar
Jim Blandy committed
449 450 451
  PRINTFINISH;
}

452 453
/* Used from outside of print.c to print a C unibyte
   string at DATA on the default output stream.
Jim Blandy's avatar
Jim Blandy committed
454 455
   Do not use this on the contents of a Lisp string.  */

456 457
void
write_string (const char *data)
Jim Blandy's avatar
Jim Blandy committed
458
{
459
  write_string_1 (data, Vstandard_output);
Jim Blandy's avatar
Jim Blandy committed
460 461 462 463
}


void
464
temp_output_buffer_setup (const char *bufname)
Jim Blandy's avatar
Jim Blandy committed
465
{
466
  ptrdiff_t count = SPECPDL_INDEX ();
Jim Blandy's avatar
Jim Blandy committed
467 468 469
  register struct buffer *old = current_buffer;
  register Lisp_Object buf;

470
  record_unwind_current_buffer ();
471

Jim Blandy's avatar
Jim Blandy committed
472 473
  Fset_buffer (Fget_buffer_create (build_string (bufname)));

474
  Fkill_all_local_variables ();
475
  delete_all_overlays (current_buffer);
Paul Eggert's avatar
Paul Eggert committed
476 477 478 479
  bset_directory (current_buffer, BVAR (old, directory));
  bset_read_only (current_buffer, Qnil);
  bset_filename (current_buffer, Qnil);
  bset_undo_list (current_buffer, Qt);
480 481
  eassert (current_buffer->overlays_before == NULL);
  eassert (current_buffer->overlays_after == NULL);
Paul Eggert's avatar
Paul Eggert committed
482 483
  bset_enable_multibyte_characters
    (current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
484 485
  specbind (Qinhibit_read_only, Qt);
  specbind (Qinhibit_modification_hooks, Qt);
Jim Blandy's avatar
Jim Blandy committed
486
  Ferase_buffer ();
487
  XSETBUFFER (buf, current_buffer);
Jim Blandy's avatar
Jim Blandy committed
488

489
  run_hook (Qtemp_buffer_setup_hook);
490 491 492 493

  unbind_to (count, Qnil);

  specbind (Qstandard_output, buf);
Jim Blandy's avatar
Jim Blandy committed
494 495
}

496 497 498 499
static void print (Lisp_Object, Lisp_Object, bool);
static void print_preprocess (Lisp_Object);
static void print_preprocess_string (INTERVAL, Lisp_Object);
static void print_object (Lisp_Object, Lisp_Object, bool);
Jim Blandy's avatar
Jim Blandy committed
500

501
DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0,
502
       doc: /* Output a newline to stream PRINTCHARFUN.
503 504
If ENSURE is non-nil only output a newline if not already at the
beginning of a line.  Value is non-nil if a newline is printed.
505
If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
506
  (Lisp_Object printcharfun, Lisp_Object ensure)
Jim Blandy's avatar
Jim Blandy committed
507
{
508
  Lisp_Object val;
Jim Blandy's avatar
Jim Blandy committed
509

Jim Blandy's avatar
Jim Blandy committed
510
  if (NILP (printcharfun))
Jim Blandy's avatar
Jim Blandy committed
511 512
    printcharfun = Vstandard_output;
  PRINTPREPARE;
513 514 515 516 517 518 519 520

  if (NILP (ensure))
    val = Qt;
  /* Difficult to check if at line beginning so abort.  */
  else if (FUNCTIONP (printcharfun))
    signal_error ("Unsupported function argument", printcharfun);
  else if (noninteractive && !NILP (printcharfun))
    val = printchar_stdout_last == 10 ? Qnil : Qt;
521 522
  else
    val = NILP (Fbolp ()) ? Qt : Qnil;
523

524 525
  if (!NILP (val))
    printchar ('\n', printcharfun);
Jim Blandy's avatar
Jim Blandy committed
526
  PRINTFINISH;
527
  return val;
Jim Blandy's avatar
Jim Blandy committed
528 529
}

Paul Eggert's avatar
Paul Eggert committed
530
DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
531 532
       doc: /* Output the printed representation of OBJECT, any Lisp object.
Quoting characters are printed when needed to make output that `read'
Eli Zaretskii's avatar
Eli Zaretskii committed
533
can handle, whenever this is possible.  For complex objects, the behavior
Pavel Janík's avatar
Pavel Janík committed
534
is controlled by `print-level' and `print-length', which see.
535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552

OBJECT is any of the Lisp data types: a number, a string, a symbol,
a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.

Optional argument PRINTCHARFUN is the output stream, which can be one
of these:

   - a buffer, in which case output is inserted into that buffer at point;
   - a marker, in which case output is inserted at marker's position;
   - a function, in which case that function is called once for each
     character of OBJECT's printed representation;
   - a symbol, in which case that symbol's function definition is called; or
   - t, in which case the output is displayed in the echo area.

If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
553
  (Lisp_Object object, Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
554
{
Jim Blandy's avatar
Jim Blandy committed
555
  if (NILP (printcharfun))
Jim Blandy's avatar
Jim Blandy committed
556 557
    printcharfun = Vstandard_output;
  PRINTPREPARE;
558
  print (object, printcharfun, 1);
Jim Blandy's avatar
Jim Blandy committed
559
  PRINTFINISH;
560
  return object;
Jim Blandy's avatar
Jim Blandy committed
561 562 563 564 565
}

/* a buffer which is used to hold output being built by prin1-to-string */
Lisp_Object Vprin1_to_string_buffer;

Paul Eggert's avatar
Paul Eggert committed
566
DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
567 568
       doc: /* Return a string containing the printed representation of OBJECT.
OBJECT can be any Lisp object.  This function outputs quoting characters
Pavel Janík's avatar
Pavel Janík committed
569
when necessary to make output that `read' can handle, whenever possible,
570 571
unless the optional second argument NOESCAPE is non-nil.  For complex objects,
the behavior is controlled by `print-level' and `print-length', which see.
572 573 574 575 576

OBJECT is any of the Lisp data types: a number, a string, a symbol,
a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
577
  (Lisp_Object object, Lisp_Object noescape)
Jim Blandy's avatar
Jim Blandy committed
578
{
579
  ptrdiff_t count = SPECPDL_INDEX ();
580 581

  specbind (Qinhibit_modification_hooks, Qt);
582

583 584 585 586 587 588
  /* Save and restore this: we are altering a buffer
     but we don't want to deactivate the mark just for that.
     No need for specbind, since errors deactivate the mark.  */
  Lisp_Object save_deactivate_mark = Vdeactivate_mark;
  bool prev_abort_on_gc = abort_on_gc;
  abort_on_gc = true;
Jim Blandy's avatar
Jim Blandy committed
589

590 591 592 593 594 595 596
  Lisp_Object printcharfun = Vprin1_to_string_buffer;
  PRINTPREPARE;
  print (object, printcharfun, NILP (noescape));
  /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
  PRINTFINISH;

  struct buffer *previous = current_buffer;
Jim Blandy's avatar
Jim Blandy committed
597
  set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
598
  object = Fbuffer_string ();
599 600
  if (SBYTES (object) == SCHARS (object))
    STRING_SET_UNIBYTE (object);
Jim Blandy's avatar
Jim Blandy committed
601

602
  /* Note that this won't make prepare_to_modify_buffer call
Kenichi Handa's avatar
Kenichi Handa committed
603 604
     ask-user-about-supersession-threat because this buffer
     does not visit a file.  */
Jim Blandy's avatar
Jim Blandy committed
605
  Ferase_buffer ();
Kenichi Handa's avatar
Kenichi Handa committed
606
  set_buffer_internal (previous);
607

608
  Vdeactivate_mark = save_deactivate_mark;
Jim Blandy's avatar
Jim Blandy committed
609

610
  abort_on_gc = prev_abort_on_gc;
611
  return unbind_to (count, object);
Jim Blandy's avatar
Jim Blandy committed
612 613
}

614
DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635
       doc: /* Output the printed representation of OBJECT, any Lisp object.
No quoting characters are used; no delimiters are printed around
the contents of strings.

OBJECT is any of the Lisp data types: a number, a string, a symbol,
a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.

Optional argument PRINTCHARFUN is the output stream, which can be one
of these:

   - a buffer, in which case output is inserted into that buffer at point;
   - a marker, in which case output is inserted at marker's position;
   - a function, in which case that function is called once for each
     character of OBJECT's printed representation;
   - a symbol, in which case that symbol's function definition is called; or
   - t, in which case the output is displayed in the echo area.

If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
636
  (Lisp_Object object, Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
637
{
Jim Blandy's avatar
Jim Blandy committed
638
  if (NILP (printcharfun))
Jim Blandy's avatar
Jim Blandy committed
639 640
    printcharfun = Vstandard_output;
  PRINTPREPARE;
641
  print (object, printcharfun, 0);
Jim Blandy's avatar
Jim Blandy committed
642
  PRINTFINISH;
643
  return object;
Jim Blandy's avatar
Jim Blandy committed
644 645
}

Paul Eggert's avatar
Paul Eggert committed
646
DEFUN ("print", Fprint, Sprint, 1, 2, 0,
647 648
       doc: /* Output the printed representation of OBJECT, with newlines around it.
Quoting characters are printed when needed to make output that `read'
Eli Zaretskii's avatar
Eli Zaretskii committed
649
can handle, whenever this is possible.  For complex objects, the behavior
Pavel Janík's avatar
Pavel Janík committed
650
is controlled by `print-level' and `print-length', which see.
651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668

OBJECT is any of the Lisp data types: a number, a string, a symbol,
a list, a buffer, a window, a frame, etc.

A printed representation of an object is text which describes that object.

Optional argument PRINTCHARFUN is the output stream, which can be one
of these:

   - a buffer, in which case output is inserted into that buffer at point;
   - a marker, in which case output is inserted at marker's position;
   - a function, in which case that function is called once for each
     character of OBJECT's printed representation;
   - a symbol, in which case that symbol's function definition is called; or
   - t, in which case the output is displayed in the echo area.

If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
669
  (Lisp_Object object, Lisp_Object printcharfun)
Jim Blandy's avatar
Jim Blandy committed
670 671 672
{
  struct gcpro gcpro1;

Jim Blandy's avatar
Jim Blandy committed
673
  if (NILP (printcharfun))
Jim Blandy's avatar
Jim Blandy committed
674
    printcharfun = Vstandard_output;
675
  GCPRO1 (object);
Jim Blandy's avatar
Jim Blandy committed
676
  PRINTPREPARE;
677
  printchar ('\n', printcharfun);
678
  print (object, printcharfun, 1);
679
  printchar ('\n', printcharfun);
Jim Blandy's avatar
Jim Blandy committed
680 681
  PRINTFINISH;
  UNGCPRO;
682
  return object;
Jim Blandy's avatar
Jim Blandy committed
683 684
}

Jim Blandy's avatar
Jim Blandy committed
685
DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
686 687 688
       doc: /* Write CHARACTER to stderr.
You can call print while debugging emacs, and pass it this function
to make it write to the debugging output.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
689
  (Lisp_Object character)
Jim Blandy's avatar
Jim Blandy committed
690
{
691
  unsigned int ch;
692

693 694 695
  CHECK_NUMBER (character);
  ch = XINT (character);
  if (ASCII_CHAR_P (ch))
696
    {
697 698 699 700 701 702 703 704 705 706
      putc (ch, stderr);
#ifdef WINDOWSNT
      /* Send the output to a debugger (nothing happens if there isn't
	 one).  */
      if (print_output_debug_flag)
	{
	  char buf[2] = {(char) XINT (character), '\0'};
	  OutputDebugString (buf);
	}
#endif
707
    }
708 709 710 711 712
  else
    {
      unsigned char mbstr[MAX_MULTIBYTE_LENGTH];
      ptrdiff_t len = CHAR_STRING (ch, mbstr);
      Lisp_Object encoded_ch =
713
	ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len));
714 715 716 717 718

      fwrite (SSDATA (encoded_ch), SBYTES (encoded_ch), 1, stderr);
#ifdef WINDOWSNT
      if (print_output_debug_flag)
	OutputDebugString (SSDATA (encoded_ch));
719
#endif
720
    }
721

Jim Blandy's avatar
Jim Blandy committed
722 723
  return character;
}
724

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

728
extern void debug_output_compilation_hack (bool) EXTERNALLY_VISIBLE;
729
void
730
debug_output_compilation_hack (bool x)
731 732 733
{
  print_output_debug_flag = x;
}
Kenichi Handa's avatar
Kenichi Handa committed
734

Andreas Schwab's avatar
Andreas Schwab committed
735
#if defined (GNU_LINUX)
Kenichi Handa's avatar
Kenichi Handa committed
736 737 738 739 740 741

/* This functionality is not vitally important in general, so we rely on
   non-portable ability to use stderr as lvalue.  */

#define WITH_REDIRECT_DEBUGGING_OUTPUT 1

742
static FILE *initial_stderr_stream = NULL;
Kenichi Handa's avatar
Kenichi Handa committed
743 744 745 746 747 748 749

DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
       1, 2,
       "FDebug output file: \nP",
       doc: /* Redirect debugging output (stderr stream) to file FILE.
If FILE is nil, reset target to the initial stderr stream.
Optional arg APPEND non-nil (interactively, with prefix arg) means
750
append to existing target file.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
751
  (Lisp_Object file, Lisp_Object append)
Kenichi Handa's avatar
Kenichi Handa committed
752 753
{
  if (initial_stderr_stream != NULL)
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
754
    {
755
      block_input ();
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
756
      fclose (stderr);
757
      unblock_input ();
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
758
    }
Kenichi Handa's avatar
Kenichi Handa committed
759 760 761 762 763 764 765
  stderr = initial_stderr_stream;
  initial_stderr_stream = NULL;

  if (STRINGP (file))
    {
      file = Fexpand_file_name (file, Qnil);
      initial_stderr_stream = stderr;
766
      stderr = emacs_fopen (SSDATA (file), NILP (append) ? "w" : "a");
Kenichi Handa's avatar
Kenichi Handa committed
767 768 769 770
      if (stderr == NULL)
	{
	  stderr = initial_stderr_stream;
	  initial_stderr_stream = NULL;
771
	  report_file_error ("Cannot open debugging output stream", file);
Kenichi Handa's avatar
Kenichi Handa committed
772 773 774 775 776 777 778
	}
    }
  return Qnil;
}
#endif /* GNU_LINUX */


779 780 781
/* This is the interface for debugging printing.  */

void
782
debug_print (Lisp_Object arg)
783 784
{
  Fprin1 (arg, Qexternal_debugging_output);
785
  fprintf (stderr, "\r\n");
786
}
787

788
void safe_debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
789
void
790
safe_debug_print (Lisp_Object arg)
791 792 793 794 795 796
{
  int valid = valid_lisp_object_p (arg);

  if (valid > 0)
    debug_print (arg);
  else
797 798 799 800 801 802
    {
      EMACS_UINT n = XLI (arg);
      fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
	       !valid ? "INVALID" : "SOME",
	       n);
    }
803 804
}