X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/fb724e553757e9d3344be443ab5f329afc9bf91c..77ab81d0545e980c57c0a35510ade29a9e43b4cd:/src/print.c diff --git a/src/print.c b/src/print.c index 682212d5e3..10878d0f05 100644 --- a/src/print.c +++ b/src/print.c @@ -42,7 +42,6 @@ Lisp_Object Vstandard_output, Qstandard_output; 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; @@ -97,11 +96,11 @@ Lisp_Object being_printed[PRINT_CIRCLE]; char *print_buffer; /* Size allocated in print_buffer. */ -int print_buffer_size; +EMACS_INT print_buffer_size; /* Chars stored in print_buffer. */ -int print_buffer_pos; +EMACS_INT print_buffer_pos; /* Bytes stored in print_buffer. */ -int print_buffer_pos_byte; +EMACS_INT print_buffer_pos_byte; /* Maximum length of list to print in full; noninteger means effectively infinity */ @@ -146,32 +145,21 @@ Lisp_Object Vprint_circle; Lisp_Object Vprint_continuous_numbering; -/* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...], - where OBJn are objects going to be printed, and STATn are their status, - which may be different meanings during process. See the comments of - the functions print and print_preprocess for details. - print_number_index keeps the last position the next object should be added, - twice of which is the actual vector position in Vprint_number_table. */ +/* 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. */ int print_number_index; Lisp_Object Vprint_number_table; -/* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE. - PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE. - See the comment of the variable Vprint_number_table. */ -#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; +int print_output_debug_flag EXTERNALLY_VISIBLE = 1; /* Low level output routines for characters and strings */ @@ -185,8 +173,8 @@ int print_output_debug_flag = 1; #define PRINTDECLARE \ struct buffer *old = current_buffer; \ - int old_point = -1, start_point = -1; \ - int old_point_byte = -1, start_point_byte = -1; \ + EMACS_INT old_point = -1, start_point = -1; \ + EMACS_INT old_point_byte = -1, start_point_byte = -1; \ int specpdl_count = SPECPDL_INDEX (); \ int free_print_buffer = 0; \ int multibyte = !NILP (current_buffer->enable_multibyte_characters); \ @@ -287,10 +275,9 @@ 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; } @@ -301,9 +288,7 @@ print_unwind (saved_text) 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)); @@ -319,7 +304,7 @@ printchar (ch, fun) 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; } @@ -353,11 +338,8 @@ printchar (ch, fun) 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, EMACS_INT size, EMACS_INT size_byte, + Lisp_Object printcharfun, int multibyte) { if (size < 0) size_byte = size = strlen (ptr); @@ -370,7 +352,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte) 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; } @@ -409,7 +391,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte) else { /* PRINTCHARFUN is a Lisp function. */ - int i = 0; + EMACS_INT i = 0; if (size == size_byte) { @@ -440,13 +422,11 @@ strout (ptr, size, size_byte, printcharfun, multibyte) 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)) { - int chars; + EMACS_INT chars; if (print_escape_nonascii) string = string_escape_byte8 (string); @@ -462,14 +442,14 @@ print_string (string, printcharfun) convert STRING to a multibyte string containing the same character codes. */ Lisp_Object newstr; - int bytes; + EMACS_INT bytes; chars = SBYTES (string); bytes = parse_str_to_multibyte (SDATA (string), chars); 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; } @@ -480,7 +460,7 @@ print_string (string, printcharfun) if (EQ (printcharfun, Qt)) { /* Output to echo area. */ - int nbytes = SBYTES (string); + EMACS_INT nbytes = SBYTES (string); char *buffer; /* Copy the string contents so that relocation of STRING by @@ -488,7 +468,7 @@ print_string (string, printcharfun) 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)); @@ -505,9 +485,9 @@ print_string (string, printcharfun) { /* Otherwise, string may be relocated by printing one char. So re-fetch the string address for each character. */ - int i; - int size = SCHARS (string); - int size_byte = SBYTES (string); + EMACS_INT i; + EMACS_INT size = SCHARS (string); + EMACS_INT size_byte = SBYTES (string); struct gcpro gcpro1; GCPRO1 (string); if (size == size_byte) @@ -530,8 +510,7 @@ print_string (string, printcharfun) 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; @@ -549,9 +528,7 @@ PRINTCHARFUN defaults to the value of `standard-output' (which see). */) 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; @@ -563,15 +540,12 @@ write_string (data, size) PRINTFINISH; } -/* Used from outside of print.c to print a block of SIZE - single-byte chars at DATA on a specified stream PRINTCHARFUN. +/* Used 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; +static void +write_string_1 (const char *data, int size, Lisp_Object printcharfun) { PRINTDECLARE; @@ -582,8 +556,7 @@ write_string_1 (data, size, printcharfun) 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; @@ -616,10 +589,7 @@ temp_output_buffer_setup (bufname) } 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; @@ -670,8 +640,7 @@ temporarily selected. But it doesn't run `temp-buffer-show-hook' 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; @@ -695,16 +664,15 @@ usage: (with-output-to-temp-buffer BUFNAME BODY...) */) } -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; @@ -739,8 +707,7 @@ of these: 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; @@ -766,8 +733,7 @@ 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. */) - (object, noescape) - Lisp_Object object, noescape; + (Lisp_Object object, Lisp_Object noescape) { Lisp_Object printcharfun; /* struct gcpro gcpro1, gcpro2; */ @@ -835,8 +801,7 @@ of these: 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; @@ -871,8 +836,7 @@ of these: 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; @@ -897,11 +861,10 @@ DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugg 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); + putc ((int) XINT (character), stderr); #ifdef WINDOWSNT /* Send the output to a debugger (nothing happens if there isn't one). */ @@ -919,8 +882,7 @@ to make it write to the debugging output. */) 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; } @@ -941,8 +903,7 @@ DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugg 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) { @@ -974,16 +935,14 @@ append to existing target file. */) /* 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); @@ -1002,8 +961,7 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string, 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; @@ -1037,10 +995,8 @@ error message is constructed. */) 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; @@ -1055,7 +1011,7 @@ print_error_message (data, stream, context, caller) { 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); } @@ -1125,9 +1081,7 @@ print_error_message (data, stream, context, caller) */ void -float_to_string (buf, data) - unsigned char *buf; - double data; +float_to_string (unsigned char *buf, double data) { unsigned char *cp; int width; @@ -1250,10 +1204,7 @@ float_to_string (buf, data) 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; @@ -1271,33 +1222,24 @@ print (obj, printcharfun, escapeflag) /* Construct Vprint_number_table for print-gensym and print-circle. */ if (!NILP (Vprint_gensym) || !NILP (Vprint_circle)) { - int i, start, index; - start = index = print_number_index; /* Construct Vprint_number_table. This increments print_number_index for the objects added. */ print_depth = 0; print_preprocess (obj); - /* Remove unnecessary objects, which appear only once in OBJ; - that is, whose status is Qnil. Compactify the necessary objects. */ - for (i = start; i < print_number_index; i++) - if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i))) - { - PRINT_NUMBER_OBJECT (Vprint_number_table, index) - = PRINT_NUMBER_OBJECT (Vprint_number_table, i); - index++; - } - - /* Clear out objects outside the active part of the table. */ - for (i = index; i < print_number_index; i++) - PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil; - - /* Reset the status field for the next print step. Now this - field means whether the object has already been printed. */ - for (i = start; i < print_number_index; i++) - PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil; + if (HASH_TABLE_P (Vprint_number_table)) + { /* Remove unnecessary objects, which appear only once in OBJ; + that is, whose status is Qt. + Maybe a better way to do that is to copy elements to + a new hash table. */ + struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table); + int i; - print_number_index = index; + for (i = 0; i < HASH_TABLE_SIZE (h); ++i) + if (!NILP (HASH_HASH (h, i)) + && EQ (HASH_VALUE (h, i), Qt)) + Fremhash (HASH_KEY (h, i), Vprint_number_table); + } } print_depth = 0; @@ -1312,8 +1254,7 @@ print (obj, printcharfun, escapeflag) 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; @@ -1346,48 +1287,40 @@ print_preprocess (obj) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) { + if (!HASH_TABLE_P (Vprint_number_table)) + { + Lisp_Object args[2]; + args[0] = QCtest; + args[1] = Qeq; + Vprint_number_table = Fmake_hash_table (2, args); + } + /* In case print-circle is nil and print-gensym is t, add OBJ to Vprint_number_table only when OBJ is a symbol. */ if (! NILP (Vprint_circle) || SYMBOLP (obj)) { - for (i = 0; i < print_number_index; i++) - if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj)) - { - /* OBJ appears more than once. Let's remember that. */ - PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt; - print_depth--; - return; - } - - /* OBJ is not yet recorded. Let's add to the table. */ - if (print_number_index == 0) - { - /* Initialize the table. */ - Vprint_number_table = Fmake_vector (make_number (40), Qnil); - } - else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2) - { - /* Reallocate the table. */ - int i = print_number_index * 4; - Lisp_Object old_table = Vprint_number_table; - Vprint_number_table = Fmake_vector (make_number (i), Qnil); - for (i = 0; i < print_number_index; i++) + Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); + if (!NILP (num) + /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, + always print the gensym with a number. This is a special for + the lisp function byte-compile-output-docform. */ + || (!NILP (Vprint_continuous_numbering) + && SYMBOLP (obj) + && !SYMBOL_INTERNED_P (obj))) + { /* OBJ appears more than once. Let's remember that. */ + if (!INTEGERP (num)) { - PRINT_NUMBER_OBJECT (Vprint_number_table, i) - = PRINT_NUMBER_OBJECT (old_table, i); - PRINT_NUMBER_STATUS (Vprint_number_table, i) - = PRINT_NUMBER_STATUS (old_table, i); + print_number_index++; + /* Negative number indicates it hasn't been printed yet. */ + Fputhash (obj, make_number (- print_number_index), + Vprint_number_table); } + print_depth--; + return; } - PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj; - /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, - always print the gensym with a number. This is a special for - the lisp function byte-compile-output-docform. */ - if (!NILP (Vprint_continuous_numbering) - && SYMBOLP (obj) - && !SYMBOL_INTERNED_P (obj)) - PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt; - print_number_index++; + else + /* OBJ is not yet recorded. Let's add to the table. */ + Fputhash (obj, Qt, Vprint_number_table); } switch (XTYPE (obj)) @@ -1418,8 +1351,8 @@ print_preprocess (obj) 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. */ + `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); } @@ -1433,9 +1366,7 @@ print_preprocess (obj) } static void -print_preprocess_string (interval, arg) - INTERVAL interval; - Lisp_Object arg; +print_preprocess_string (INTERVAL interval, Lisp_Object arg) { print_preprocess (interval->plist); } @@ -1443,9 +1374,8 @@ print_preprocess_string (interval, arg) /* 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 @@ -1454,9 +1384,7 @@ static void print_check_string_charset_prop (); 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; @@ -1481,8 +1409,8 @@ print_check_string_charset_prop (interval, string) || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { int i, c; - int charpos = interval->position; - int bytepos = string_char_to_byte (string, charpos); + EMACS_INT charpos = interval->position; + EMACS_INT bytepos = string_char_to_byte (string, charpos); Lisp_Object charset; charset = XCAR (XCDR (val)); @@ -1503,8 +1431,7 @@ print_check_string_charset_prop (interval, string) 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, @@ -1528,10 +1455,7 @@ print_prune_string_charset (string) } 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]; @@ -1565,28 +1489,26 @@ print_object (obj, printcharfun, escapeflag) else { /* With the print-circle feature. */ - int i; - for (i = 0; i < print_number_index; i++) - if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj)) - { - if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i))) - { - /* Add a prefix #n= if OBJ has not yet been printed; - that is, its status field is nil. */ - sprintf (buf, "#%d=", i + 1); - strout (buf, -1, -1, printcharfun, 0); - /* OBJ is going to be printed. Set the status to t. */ - PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt; - break; - } - else - { - /* Just print #n# if OBJ has already been printed. */ - sprintf (buf, "#%d#", i + 1); - strout (buf, -1, -1, printcharfun, 0); - return; - } - } + Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); + if (INTEGERP (num)) + { + int n = XINT (num); + if (n < 0) + { /* Add a prefix #n= if OBJ has not yet been printed; + that is, its status field is nil. */ + sprintf (buf, "#%d=", -n); + strout (buf, -1, -1, printcharfun, 0); + /* OBJ is going to be printed. Remember that fact. */ + Fputhash (obj, make_number (- n), Vprint_number_table); + } + else + { + /* Just print #n# if OBJ has already been printed. */ + sprintf (buf, "#%d#", n); + strout (buf, -1, -1, printcharfun, 0); + return; + } + } } } @@ -1618,10 +1540,10 @@ print_object (obj, printcharfun, escapeflag) print_string (obj, printcharfun); else { - register int i, i_byte; + register EMACS_INT i, i_byte; struct gcpro gcpro1; unsigned char *str; - int size_byte; + EMACS_INT size_byte; /* 1 means we must ensure that the next character we output cannot be taken as part of a hex character escape. */ int need_nonhex = 0; @@ -1739,7 +1661,8 @@ print_object (obj, printcharfun, escapeflag) register unsigned char *p = SDATA (SYMBOL_NAME (obj)); register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj)); register int c; - int i, i_byte, size_byte; + int i, i_byte; + EMACS_INT size_byte; Lisp_Object name; name = SYMBOL_NAME (obj); @@ -1858,7 +1781,8 @@ print_object (obj, printcharfun, escapeflag) } { - int print_length, i; + EMACS_INT print_length; + int i; Lisp_Object halftail = obj; /* Negative values of print-length are invalid in CL. @@ -1887,23 +1811,13 @@ print_object (obj, printcharfun, escapeflag) /* With the print-circle feature. */ if (i != 0) { - int i; - for (i = 0; i < print_number_index; i++) - if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), - obj)) - { - if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i))) - { - strout (" . ", 3, 3, printcharfun, 0); - print_object (obj, printcharfun, escapeflag); - } - else - { - sprintf (buf, " . #%d#", i + 1); - strout (buf, -1, -1, printcharfun, 0); - } - goto end_of_list; - } + Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); + if (INTEGERP (num)) + { + strout (" . ", 3, 3, printcharfun, 0); + print_object (obj, printcharfun, escapeflag); + goto end_of_list; + } } } @@ -1953,7 +1867,7 @@ print_object (obj, printcharfun, escapeflag) register int i; register unsigned char c; struct gcpro gcpro1; - int size_in_chars + EMACS_INT size_in_chars = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR); @@ -2039,7 +1953,8 @@ print_object (obj, printcharfun, escapeflag) else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - int i, real_size, size; + int i; + EMACS_INT real_size, size; #if 0 strout ("#test)) @@ -2205,7 +2120,7 @@ print_object (obj, printcharfun, escapeflag) { register int i; register Lisp_Object tem; - int real_size = size; + EMACS_INT real_size = size; /* Don't print more elements than the specified maximum. */ if (NATNUMP (Vprint_length) @@ -2237,7 +2152,7 @@ print_object (obj, printcharfun, escapeflag) strout ("in no buffer", -1, -1, printcharfun, 0); else { - sprintf (buf, "at %d", marker_position (obj)); + sprintf (buf, "at %ld", (long)marker_position (obj)); strout (buf, -1, -1, printcharfun, 0); strout (" in ", -1, -1, printcharfun, 0); print_string (XMARKER (obj)->buffer->name, printcharfun); @@ -2251,9 +2166,9 @@ print_object (obj, printcharfun, escapeflag) strout ("in no buffer", -1, -1, printcharfun, 0); else { - sprintf (buf, "from %d to %d in ", - marker_position (OVERLAY_START (obj)), - marker_position (OVERLAY_END (obj))); + sprintf (buf, "from %ld to %ld in ", + (long)marker_position (OVERLAY_START (obj)), + (long)marker_position (OVERLAY_END (obj))); strout (buf, -1, -1, printcharfun, 0); print_string (XMARKER (OVERLAY_START (obj))->buffer->name, printcharfun); @@ -2267,70 +2182,6 @@ print_object (obj, printcharfun, escapeflag) strout ("#", -1, -1, printcharfun, 0); break; - case Lisp_Misc_Intfwd: - sprintf (buf, "#", (long) *XINTFWD (obj)->intvar); - strout (buf, -1, -1, printcharfun, 0); - break; - - case Lisp_Misc_Boolfwd: - sprintf (buf, "#", - (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); - strout (buf, -1, -1, printcharfun, 0); - break; - - case Lisp_Misc_Objfwd: - strout ("#objvar, printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - - case Lisp_Misc_Buffer_Objfwd: - strout ("#offset), - printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - - case Lisp_Misc_Kboard_Objfwd: - strout ("#offset), - printcharfun, escapeflag); - PRINTCHAR ('>'); - break; - - case Lisp_Misc_Buffer_Local_Value: - strout ("#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 ("#plist)) return; @@ -2388,7 +2237,7 @@ print_interval (interval, printcharfun) void -syms_of_print () +syms_of_print (void) { Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook"); staticpro (&Qtemp_buffer_setup_hook);