X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8e6208c5d2c91d70f2338d1c3d788e194c6c9d52..87850793c3c5351531e26a2f47797ddef82eb722:/src/print.c diff --git a/src/print.c b/src/print.c index 5d42b580be..be26917628 100644 --- a/src/print.c +++ b/src/print.c @@ -15,7 +15,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ #include @@ -325,10 +326,10 @@ print_string (string, printcharfun) } DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0, - "Output character CHAR to stream PRINTCHARFUN.\n\ + "Output character CHARACTER to stream PRINTCHARFUN.\n\ PRINTCHARFUN defaults to the value of `standard-output' (which see).") - (ch, printcharfun) - Lisp_Object ch, printcharfun; + (character, printcharfun) + Lisp_Object character, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; @@ -337,11 +338,11 @@ PRINTCHARFUN defaults to the value of `standard-output' (which see).") if (NILP (printcharfun)) printcharfun = Vstandard_output; - CHECK_NUMBER (ch, 0); + CHECK_NUMBER (character, 0); PRINTPREPARE; - PRINTCHAR (XINT (ch)); + PRINTCHAR (XINT (character)); PRINTFINISH; - return ch; + return character; } /* Used from outside of print.c to print a block of SIZE chars at DATA @@ -491,8 +492,8 @@ DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0, Quoting characters are printed when needed to make output that `read'\n\ can handle, whenever this is possible.\n\ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") - (obj, printcharfun) - Lisp_Object obj, printcharfun; + (object, printcharfun) + Lisp_Object object, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; @@ -506,9 +507,9 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") printcharfun = Vstandard_output; PRINTPREPARE; print_depth = 0; - print (obj, printcharfun, 1); + print (object, printcharfun, 1); PRINTFINISH; - return obj; + return object; } /* a buffer which is used to hold output being built by prin1-to-string */ @@ -519,30 +520,38 @@ DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, any Lisp object. Quoting characters are used when needed to make output\n\ that `read' can handle, whenever this is possible, unless the optional\n\ second argument NOESCAPE is non-nil.") - (obj, noescape) - Lisp_Object obj, noescape; + (object, noescape) + Lisp_Object object, noescape; { struct buffer *old = current_buffer; int old_point = -1; int start_point; Lisp_Object original, printcharfun; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; + Lisp_Object tem; + + /* 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. */ + tem = Vdeactivate_mark; + GCPRO2 (object, tem); printcharfun = Vprin1_to_string_buffer; PRINTPREPARE; print_depth = 0; - print (obj, printcharfun, NILP (noescape)); + print (object, printcharfun, NILP (noescape)); /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */ PRINTFINISH; set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); - obj = Fbuffer_string (); + object = Fbuffer_string (); - GCPRO1 (obj); Ferase_buffer (); set_buffer_internal (old); + + Vdeactivate_mark = tem; UNGCPRO; - return obj; + return object; } DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0, @@ -550,8 +559,8 @@ DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0, No quoting characters are used; no delimiters are printed around\n\ the contents of strings.\n\ Output stream is PRINTCHARFUN, or value of standard-output (which see).") - (obj, printcharfun) - Lisp_Object obj, printcharfun; + (object, printcharfun) + Lisp_Object object, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; @@ -562,9 +571,9 @@ Output stream is PRINTCHARFUN, or value of standard-output (which see).") printcharfun = Vstandard_output; PRINTPREPARE; print_depth = 0; - print (obj, printcharfun, 0); + print (object, printcharfun, 0); PRINTFINISH; - return obj; + return object; } DEFUN ("print", Fprint, Sprint, 1, 2, 0, @@ -572,8 +581,8 @@ DEFUN ("print", Fprint, Sprint, 1, 2, 0, Quoting characters are printed when needed to make output that `read'\n\ can handle, whenever this is possible.\n\ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") - (obj, printcharfun) - Lisp_Object obj, printcharfun; + (object, printcharfun) + Lisp_Object object, printcharfun; { struct buffer *old = current_buffer; int old_point = -1; @@ -587,11 +596,11 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") #endif /* MAX_PRINT_CHARS */ if (NILP (printcharfun)) printcharfun = Vstandard_output; - GCPRO1 (obj); + GCPRO1 (object); PRINTPREPARE; print_depth = 0; PRINTCHAR ('\n'); - print (obj, printcharfun, 1); + print (object, printcharfun, 1); PRINTCHAR ('\n'); PRINTFINISH; #ifdef MAX_PRINT_CHARS @@ -599,7 +608,7 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).") print_chars = 0; #endif /* MAX_PRINT_CHARS */ UNGCPRO; - return obj; + return object; } /* The subroutine object for external-debugging-output is kept here @@ -1017,6 +1026,12 @@ print (obj, printcharfun, escapeflag) sprintf (buf, "%d", XBOOL_VECTOR (obj)->size); strout (buf, -1, printcharfun); PRINTCHAR ('\"'); + + /* Don't print more characters than the specified maximum. */ + if (INTEGERP (Vprint_length) + && XINT (Vprint_length) < size_in_chars) + size_in_chars = XINT (Vprint_length); + for (i = 0; i < size_in_chars; i++) { QUIT; @@ -1115,6 +1130,12 @@ print (obj, printcharfun, escapeflag) { register int i; register Lisp_Object tem; + + /* Don't print more elements than the specified maximum. */ + if (INTEGERP (Vprint_length) + && XINT (Vprint_length) < size) + size = XINT (Vprint_length); + for (i = 0; i < size; i++) { if (i) PRINTCHAR (' ');