X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/39eb0cb563f5287270f3946804456dc766386638..924a09e9161c05d9d69d85fa102910b10ece372f:/src/print.c diff --git a/src/print.c b/src/print.c index 4ad34534da..49331ef098 100644 --- a/src/print.c +++ b/src/print.c @@ -1,6 +1,6 @@ /* Lisp object printing and output streams. -Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software +Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -58,6 +58,9 @@ static ptrdiff_t new_backquote_output; #define PRINT_CIRCLE 200 static Lisp_Object being_printed[PRINT_CIRCLE]; +/* Last char printed to stdout by printchar. */ +static unsigned int printchar_stdout_last; + /* When printing into a buffer, first we put the text in this block, then insert it all at once. */ static char *print_buffer; @@ -169,11 +172,13 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; if (print_buffer_pos != print_buffer_pos_byte \ && NILP (BVAR (current_buffer, enable_multibyte_characters)))\ { \ - unsigned char *temp = alloca (print_buffer_pos + 1); \ + USE_SAFE_ALLOCA; \ + unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1); \ copy_text ((unsigned char *) print_buffer, temp, \ print_buffer_pos_byte, 1, 0); \ insert_1_both ((char *) temp, print_buffer_pos, \ print_buffer_pos, 0, 1, 0); \ + SAFE_FREE (); \ } \ else \ insert_1_both (print_buffer, print_buffer_pos, \ @@ -236,6 +241,7 @@ printchar (unsigned int ch, Lisp_Object fun) } else if (noninteractive) { + printchar_stdout_last = ch; fwrite (str, 1, len, stdout); noninteractive_need_newline = 1; } @@ -513,19 +519,33 @@ static void print_preprocess (Lisp_Object); static void print_preprocess_string (INTERVAL, Lisp_Object); static void print_object (Lisp_Object, Lisp_Object, bool); -DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, +DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, doc: /* Output a newline to stream PRINTCHARFUN. +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. If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */) - (Lisp_Object printcharfun) + (Lisp_Object printcharfun, Lisp_Object ensure) { - PRINTDECLARE; + Lisp_Object val = Qnil; + PRINTDECLARE; if (NILP (printcharfun)) printcharfun = Vstandard_output; PRINTPREPARE; - PRINTCHAR ('\n'); + + 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; + else if (NILP (Fbolp ())) + val = Qt; + + if (!NILP (val)) PRINTCHAR ('\n'); PRINTFINISH; - return Qt; + return val; } DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, @@ -581,7 +601,6 @@ A printed representation of an object is text which describes that object. */) { Lisp_Object printcharfun; bool prev_abort_on_gc; - /* struct gcpro gcpro1, gcpro2; */ Lisp_Object save_deactivate_mark; ptrdiff_t count = SPECPDL_INDEX (); struct buffer *previous; @@ -595,7 +614,6 @@ A printed representation of an object is text which describes that object. */) but we don't want to deactivate the mark just for that. No need for specbind, since errors deactivate the mark. */ save_deactivate_mark = Vdeactivate_mark; - /* GCPRO2 (object, save_deactivate_mark); */ prev_abort_on_gc = abort_on_gc; abort_on_gc = 1; @@ -619,7 +637,6 @@ A printed representation of an object is text which describes that object. */) set_buffer_internal (previous); Vdeactivate_mark = save_deactivate_mark; - /* UNGCPRO; */ abort_on_gc = prev_abort_on_gc; return unbind_to (count, object); @@ -709,17 +726,36 @@ You can call print while debugging emacs, and pass it this function to make it write to the debugging output. */) (Lisp_Object character) { - CHECK_NUMBER (character); - putc (XINT (character) & 0xFF, stderr); + unsigned int ch; -#ifdef WINDOWSNT - /* Send the output to a debugger (nothing happens if there isn't one). */ - if (print_output_debug_flag) + CHECK_NUMBER (character); + ch = XINT (character); + if (ASCII_CHAR_P (ch)) { - char buf[2] = {(char) XINT (character), '\0'}; - OutputDebugString (buf); + 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 } + else + { + unsigned char mbstr[MAX_MULTIBYTE_LENGTH]; + ptrdiff_t len = CHAR_STRING (ch, mbstr); + Lisp_Object encoded_ch = + ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len)); + + fwrite (SSDATA (encoded_ch), SBYTES (encoded_ch), 1, stderr); +#ifdef WINDOWSNT + if (print_output_debug_flag) + OutputDebugString (SSDATA (encoded_ch)); #endif + } return character; } @@ -1119,7 +1155,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) 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 . */ + more than once in OBJ: Qnil at the first time, and Qt after that. */ static void print_preprocess (Lisp_Object obj) { @@ -1209,7 +1245,8 @@ print_preprocess (Lisp_Object obj) size = ASIZE (obj); if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; - for (i = 0; i < size; i++) + for (i = (SUB_CHAR_TABLE_P (obj) + ? SUB_CHAR_TABLE_OFFSET : 0); i < size; i++) print_preprocess (AREF (obj, i)); if (HASH_TABLE_P (obj)) { /* For hash tables, the key_and_value slot is past @@ -1389,9 +1426,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_string (obj, printcharfun); else { - register ptrdiff_t i_byte; + register ptrdiff_t i, i_byte; struct gcpro gcpro1; - unsigned char *str; ptrdiff_t size_byte; /* 1 means we must ensure that the next character we output cannot be taken as part of a hex character escape. */ @@ -1410,23 +1446,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } PRINTCHAR ('\"'); - str = SDATA (obj); size_byte = SBYTES (obj); - for (i_byte = 0; i_byte < size_byte;) + for (i = 0, i_byte = 0; i_byte < size_byte;) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ - int len; int c; - if (multibyte) - { - c = STRING_CHAR_AND_LENGTH (str + i_byte, len); - i_byte += len; - } - else - c = str[i_byte++]; + FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte); QUIT; @@ -1462,7 +1490,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) strout (outbuf, len, len, printcharfun); } else if (! multibyte - && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c) + && SINGLE_BYTE_CHAR_P (c) && ! ASCII_CHAR_P (c) && print_escape_nonascii) { /* When printing in a multibyte buffer @@ -1704,15 +1732,14 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) int len; unsigned char c; struct gcpro gcpro1; - ptrdiff_t size_in_chars - = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); - + EMACS_INT size = bool_vector_size (obj); + ptrdiff_t size_in_chars = bool_vector_bytes (size); + ptrdiff_t real_size_in_chars = size_in_chars; GCPRO1 (obj); PRINTCHAR ('#'); PRINTCHAR ('&'); - len = sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size); + len = sprintf (buf, "%"pI"d", size); strout (buf, len, len, printcharfun); PRINTCHAR ('\"'); @@ -1726,7 +1753,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) for (i = 0; i < size_in_chars; i++) { QUIT; - c = XBOOL_VECTOR (obj)->data[i]; + c = bool_vector_uchar_data (obj)[i]; if (c == '\n' && print_escape_newlines) { PRINTCHAR ('\\'); @@ -1752,6 +1779,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) PRINTCHAR (c); } } + + if (size_in_chars < real_size_in_chars) + strout (" ...", 4, 4, printcharfun); PRINTCHAR ('\"'); UNGCPRO; @@ -1764,8 +1794,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else if (WINDOWP (obj)) { - void *ptr = XWINDOW (obj); - int len = sprintf (buf, "#sequence_number); strout (buf, len, len, printcharfun); if (BUFFERP (XWINDOW (obj)->contents)) { @@ -1955,7 +1986,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) Otherwise we'll make a line extremely long, which results in slow redisplay. */ if (SUB_CHAR_TABLE_P (obj) - && XINT (XSUB_CHAR_TABLE (obj)->depth) == 3) + && XSUB_CHAR_TABLE (obj)->depth == 3) PRINTCHAR ('\n'); PRINTCHAR ('#'); PRINTCHAR ('^'); @@ -1968,16 +1999,24 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) PRINTCHAR ('['); { - register int i; + int i, idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0; register Lisp_Object tem; ptrdiff_t real_size = size; + /* For a sub char-table, print heading non-Lisp data first. */ + if (SUB_CHAR_TABLE_P (obj)) + { + i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth, + XSUB_CHAR_TABLE (obj)->min_char); + strout (buf, i, i, printcharfun); + } + /* Don't print more elements than the specified maximum. */ if (NATNUMP (Vprint_length) && XFASTINT (Vprint_length) < size) size = XFASTINT (Vprint_length); - for (i = 0; i < size; i++) + for (i = idx; i < size; i++) { if (i) PRINTCHAR (' '); tem = AREF (obj, i);