/* Lisp object printing and output streams.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object Qtemp_buffer_setup_hook;
/* These are used to print like we read. */
-extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
Lisp_Object Vfloat_output_format, Qfloat_output_format;
#define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
#define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
-/* Nonzero means print newline to stdout before next minibuffer message.
- Defined in xdisp.c */
-
-extern int noninteractive_need_newline;
-
-extern int minibuffer_auto_raise;
-
-void print_interval ();
+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;
when there is a recursive call to print. */
static Lisp_Object
-print_unwind (saved_text)
- Lisp_Object saved_text;
+print_unwind (Lisp_Object saved_text)
{
- bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
+ memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
return Qnil;
}
argument. */
static void
-printchar (ch, fun)
- unsigned int ch;
- Lisp_Object fun;
+printchar (unsigned int ch, Lisp_Object fun)
{
if (!NILP (fun) && !EQ (fun, Qt))
call1 (fun, make_number (ch));
if (print_buffer_pos_byte + len >= print_buffer_size)
print_buffer = (char *) xrealloc (print_buffer,
print_buffer_size *= 2);
- bcopy (str, print_buffer + print_buffer_pos_byte, len);
+ memcpy (print_buffer + print_buffer_pos_byte, str, len);
print_buffer_pos += 1;
print_buffer_pos_byte += len;
}
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;
+strout (const char *ptr, int size, int size_byte, Lisp_Object printcharfun,
+ int multibyte)
{
if (size < 0)
size_byte = size = strlen (ptr);
print_buffer = (char *) xrealloc (print_buffer,
print_buffer_size);
}
- bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
+ memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
print_buffer_pos += size;
print_buffer_pos_byte += size_byte;
}
int len;
for (i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
+ int ch = STRING_CHAR_AND_LENGTH (ptr + i, len);
insert_char (ch);
}
}
corresponding character code before handing it to
PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
+ int ch = STRING_CHAR_AND_LENGTH (ptr + i, len);
PRINTCHAR (ch);
i += len;
}
because printing one char can relocate. */
static void
-print_string (string, printcharfun)
- Lisp_Object string;
- Lisp_Object printcharfun;
+print_string (Lisp_Object string, Lisp_Object printcharfun)
{
if (EQ (printcharfun, Qt) || NILP (printcharfun))
{
if (chars < bytes)
{
newstr = make_uninit_multibyte_string (chars, bytes);
- bcopy (SDATA (string), SDATA (newstr), chars);
+ memcpy (SDATA (newstr), SDATA (string), chars);
str_to_multibyte (SDATA (newstr), bytes, chars);
string = newstr;
}
USE_SAFE_ALLOCA;
SAFE_ALLOCA (buffer, char *, nbytes);
- bcopy (SDATA (string), buffer, nbytes);
+ memcpy (buffer, SDATA (string), nbytes);
strout (buffer, chars, SBYTES (string),
printcharfun, STRING_MULTIBYTE (string));
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
- size_byte - i, len);
+ int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
PRINTCHAR (ch);
i += len;
}
DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
doc: /* Output character CHARACTER to stream PRINTCHARFUN.
PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
- (character, printcharfun)
- Lisp_Object character, printcharfun;
+ (Lisp_Object character, Lisp_Object printcharfun)
{
PRINTDECLARE;
Do not use this on the contents of a Lisp string. */
void
-write_string (data, size)
- char *data;
- int size;
+write_string (const char *data, int size)
{
PRINTDECLARE;
Lisp_Object 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;
+write_string_1 (const char *data, int size, Lisp_Object printcharfun)
{
PRINTDECLARE;
void
-temp_output_buffer_setup (bufname)
- const char *bufname;
+temp_output_buffer_setup (const char *bufname)
{
int count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
}
Lisp_Object
-internal_with_output_to_temp_buffer (bufname, function, args)
- const char *bufname;
- Lisp_Object (*function) P_ ((Lisp_Object));
- Lisp_Object args;
+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;
if it uses `temp-buffer-show-function'.
usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
- (args)
- Lisp_Object args;
+ (Lisp_Object args)
{
struct gcpro gcpro1;
Lisp_Object name;
}
\f
-static void print ();
-static void print_preprocess ();
-static void print_preprocess_string ();
-static void print_object ();
+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)
- Lisp_Object printcharfun;
+ (Lisp_Object printcharfun)
{
PRINTDECLARE;
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead. */)
- (object, printcharfun)
- Lisp_Object object, printcharfun;
+ (Lisp_Object object, Lisp_Object printcharfun)
{
PRINTDECLARE;
a list, a buffer, a window, a frame, etc.
A printed representation of an object is text which describes that object. */)
- (object, noescape)
- Lisp_Object object, noescape;
+ (Lisp_Object object, Lisp_Object noescape)
{
Lisp_Object printcharfun;
/* struct gcpro gcpro1, gcpro2; */
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead. */)
- (object, printcharfun)
- Lisp_Object object, printcharfun;
+ (Lisp_Object object, Lisp_Object printcharfun)
{
PRINTDECLARE;
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead. */)
- (object, printcharfun)
- Lisp_Object object, printcharfun;
+ (Lisp_Object object, Lisp_Object printcharfun)
{
PRINTDECLARE;
struct gcpro gcpro1;
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. */)
- (character)
- Lisp_Object character;
+ (Lisp_Object character)
{
CHECK_NUMBER (character);
putc (XINT (character), stderr);
print_output_debug_flag from being optimized away. */
void
-debug_output_compilation_hack (x)
- int x;
+debug_output_compilation_hack (int x)
{
print_output_debug_flag = x;
}
If FILE is nil, reset target to the initial stderr stream.
Optional arg APPEND non-nil (interactively, with prefix arg) means
append to existing target file. */)
- (file, append)
- Lisp_Object file, append;
+ (Lisp_Object file, Lisp_Object append)
{
if (initial_stderr_stream != NULL)
{
/* This is the interface for debugging printing. */
void
-debug_print (arg)
- Lisp_Object arg;
+debug_print (Lisp_Object arg)
{
Fprin1 (arg, Qexternal_debugging_output);
fprintf (stderr, "\r\n");
}
void
-safe_debug_print (arg)
- Lisp_Object arg;
+safe_debug_print (Lisp_Object arg)
{
int valid = valid_lisp_object_p (arg);
doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
See Info anchor `(elisp)Definition of signal' for some details on how this
error message is constructed. */)
- (obj)
- Lisp_Object obj;
+ (Lisp_Object obj)
{
struct buffer *old = current_buffer;
Lisp_Object value;
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;
+print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
+ Lisp_Object caller)
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
{
Lisp_Object cname = SYMBOL_NAME (caller);
char *name = alloca (SBYTES (cname));
- bcopy (SDATA (cname), name, SBYTES (cname));
+ memcpy (name, SDATA (cname), SBYTES (cname));
message_dolog (name, SBYTES (cname), 0, 0);
message_dolog (": ", 2, 0, 0);
}
*/
void
-float_to_string (buf, data)
- unsigned char *buf;
- double data;
+float_to_string (unsigned char *buf, double data)
{
unsigned char *cp;
int width;
\f
static void
-print (obj, printcharfun, escapeflag)
- Lisp_Object obj;
- register Lisp_Object printcharfun;
- int escapeflag;
+print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
new_backquote_output = 0;
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;
+print_preprocess (Lisp_Object obj)
{
int i;
EMACS_INT size;
loop:
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+ || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++)
print_preprocess (XVECTOR (obj)->contents[i]);
+ if (HASH_TABLE_P (obj))
+ { /* For hash tables, the key_and_value slot is past
+ `size' because it needs to be marked specially in case
+ the table is weak. */
+ struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+ print_preprocess (h->key_and_value);
+ }
break;
default:
}
static void
-print_preprocess_string (interval, arg)
- INTERVAL interval;
- Lisp_Object arg;
+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 ();
+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
static int print_check_string_result;
static void
-print_check_string_charset_prop (interval, string)
- INTERVAL interval;
- Lisp_Object string;
+print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
{
Lisp_Object val;
static Lisp_Object print_prune_charset_plist;
static Lisp_Object
-print_prune_string_charset (string)
- Lisp_Object string;
+print_prune_string_charset (Lisp_Object string)
{
print_check_string_result = 0;
traverse_intervals (STRING_INTERVALS (string), 0,
}
static void
-print_object (obj, printcharfun, escapeflag)
- Lisp_Object obj;
- register Lisp_Object printcharfun;
- int escapeflag;
+print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
char buf[40];
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+ || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
switch (XTYPE (obj))
{
- case Lisp_Int:
+ case_Lisp_Int:
if (sizeof (int) == sizeof (EMACS_INT))
sprintf (buf, "%d", (int) XINT (obj));
else if (sizeof (long) == sizeof (EMACS_INT))
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (str + i_byte,
- size_byte - i_byte, len);
+ c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
i_byte += len;
}
else
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+ int i, real_size, size;
#if 0
strout ("#<hash-table", -1, -1, printcharfun, 0);
if (SYMBOLP (h->test))
strout (" data ", -1, -1, printcharfun, 0);
/* Print the data here as a plist. */
- int i;
-
- int real_size = HASH_TABLE_SIZE (h);
- int size = real_size;
+ real_size = HASH_TABLE_SIZE (h);
+ size = real_size;
/* Don't print more elements than the specified maximum. */
if (NATNUMP (Vprint_length)
else
{
EMACS_INT size = XVECTOR (obj)->size;
- if (COMPILEDP (obj))
+ if (FUNVECP (obj))
{
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;
strout ("#<misc free cell>", -1, -1, printcharfun, 0);
break;
- case Lisp_Misc_Intfwd:
- sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
- strout (buf, -1, -1, printcharfun, 0);
- break;
-
- case Lisp_Misc_Boolfwd:
- sprintf (buf, "#<boolfwd to %s>",
- (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
- strout (buf, -1, -1, printcharfun, 0);
- break;
-
- case Lisp_Misc_Objfwd:
- strout ("#<objfwd to ", -1, -1, printcharfun, 0);
- print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
- case Lisp_Misc_Buffer_Objfwd:
- strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
- print_object (PER_BUFFER_VALUE (current_buffer,
- XBUFFER_OBJFWD (obj)->offset),
- printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
- case Lisp_Misc_Kboard_Objfwd:
- strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
- print_object (*(Lisp_Object *) ((char *) current_kboard
- + XKBOARD_OBJFWD (obj)->offset),
- printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
- case Lisp_Misc_Buffer_Local_Value:
- strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
- if (XBUFFER_LOCAL_VALUE (obj)->local_if_set)
- strout ("[local-if-set] ", -1, -1, printcharfun, 0);
- strout ("[realvalue] ", -1, -1, printcharfun, 0);
- print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
- printcharfun, escapeflag);
- if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
- strout ("[local in buffer] ", -1, -1, printcharfun, 0);
- else
- strout ("[buffer] ", -1, -1, printcharfun, 0);
- print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
- printcharfun, escapeflag);
- if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
- {
- if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
- strout ("[local in frame] ", -1, -1, printcharfun, 0);
- else
- strout ("[frame] ", -1, -1, printcharfun, 0);
- print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
- printcharfun, escapeflag);
- }
- strout ("[alist-elt] ", -1, -1, printcharfun, 0);
- print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
- printcharfun, escapeflag);
- strout ("[default-value] ", -1, -1, printcharfun, 0);
- print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
- printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
case Lisp_Misc_Save_Value:
strout ("#<save_value ", -1, -1, printcharfun, 0);
sprintf(buf, "ptr=0x%08lx int=%d",
This is part of printing a string that has text properties. */
void
-print_interval (interval, printcharfun)
- INTERVAL interval;
- Lisp_Object printcharfun;
+print_interval (INTERVAL interval, Lisp_Object printcharfun)
{
if (NILP (interval->plist))
return;
\f
void
-syms_of_print ()
+syms_of_print (void)
{
- Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
+ Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
staticpro (&Qtemp_buffer_setup_hook);
DEFVAR_LISP ("standard-output", &Vstandard_output,
or a marker (output is inserted and the marker is advanced)
or the symbol t (output appears in the echo area). */);
Vstandard_output = Qt;
- Qstandard_output = intern ("standard-output");
+ Qstandard_output = intern_c_string ("standard-output");
staticpro (&Qstandard_output);
DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
A value of nil means to use the shortest notation
that represents the number without losing information. */);
Vfloat_output_format = Qnil;
- Qfloat_output_format = intern ("float-output-format");
+ Qfloat_output_format = intern_c_string ("float-output-format");
staticpro (&Qfloat_output_format);
DEFVAR_LISP ("print-length", &Vprint_length,
defsubr (&Sredirect_debugging_output);
#endif
- Qexternal_debugging_output = intern ("external-debugging-output");
+ Qexternal_debugging_output = intern_c_string ("external-debugging-output");
staticpro (&Qexternal_debugging_output);
- Qprint_escape_newlines = intern ("print-escape-newlines");
+ Qprint_escape_newlines = intern_c_string ("print-escape-newlines");
staticpro (&Qprint_escape_newlines);
- Qprint_escape_multibyte = intern ("print-escape-multibyte");
+ Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte");
staticpro (&Qprint_escape_multibyte);
- Qprint_escape_nonascii = intern ("print-escape-nonascii");
+ Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii");
staticpro (&Qprint_escape_nonascii);
print_prune_charset_plist = Qnil;
HCoop / bpt / emacs.git / blobdiff