xemacs-beta: src/print.c comparison

comparison src/print.c @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13

author	cvs
date	Mon, 13 Aug 2007 09:49:09 +0200
parents	929b76928fce
children	6075d714658b

comparison

equal deleted inserted replaced

-:a38aed19690b
+:8eaf7971accc
 /* The subroutine object for external-debugging-output is kept here
 for the convenience of the debugger.  */
 Lisp_Object Qexternal_debugging_output;
 Lisp_Object Qalternate_debugging_output;
 /* Avoid actual stack overflow in print.  */
 static int print_depth;
 /* Maximum length of list or vector to print in full; noninteger means
 effectively infinity */
 int stdout_needs_newline;
 /* Write a string (in internal format) to stdio stream STREAM. */
 void
 write_string_to_stdio_stream (FILE *stream, struct console *con,
 			      CONST Bufbyte *str,
 			      Bytecount offset, Bytecount len,
 			      enum external_data_format fmt)
 {
 #ifndef standalone
 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
 #endif
 }
-return (printcharfun);
+return printcharfun;
 }
 static Lisp_Object
 print_prepare (Lisp_Object printcharfun)
 {
 FILE *stdio_stream = 0;
 /* Emacs won't print whilst GCing, but an external debugger might */
 if (gc_in_progress)
-return (Qnil);
+return Qnil;
 printcharfun = canonicalize_printcharfun (printcharfun);
 if (EQ (printcharfun, Qnil))
 {
 stdio_stream = stdout;
 }
 #if 0 /* Don't bother */
 else if (SUBRP (indirect_function (printcharfun, 0))
 && (XSUBR (indirect_function (printcharfun, 0))
 == Sexternal_debugging_output))
 {
 stdio_stream = stderr;
 }
 #endif
 return make_print_output_stream (stdio_stream, printcharfun);
 }
 static void
 print_finish (Lisp_Object stream)
 set_buffer_internal (old);
 }
 Lisp_Object
 internal_with_output_to_temp_buffer (CONST char *bufname,
 Lisp_Object (*function) (Lisp_Object arg),
 Lisp_Object arg,
 Lisp_Object same_frame)
 {
 int speccount = specpdl_depth ();
 struct gcpro gcpro1, gcpro2, gcpro3;
 Lisp_Object buf = Qnil;
 Ferase_buffer (Fcurrent_buffer ());
 print_depth = 0;
 print_internal (object, stream, NILP (noescape));
 print_finish (stream);
 stream = Qnil;                /* No GC surprises! */
 object = make_string_from_buffer (out,
 				    BUF_BEG (out),
 				    BUF_Z (out) - 1);
 Ferase_buffer (Fcurrent_buffer ());
 Fset_buffer (old);
 UNGCPRO;
-return (object);
+return object;
 }
 DEFUN ("princ", Fprinc, 1, 2, 0, /*
 Output the printed representation of OBJECT, any Lisp object.
 No quoting characters are used; no delimiters are printed around
 the_stream = print_prepare (stream);
 print_depth = 0;
 print_internal (obj, the_stream, 0);
 print_finish (the_stream);
 UNGCPRO;
-return (obj);
+return obj;
 }
 DEFUN ("print", Fprint, 1, 2, 0, /*
 Output the printed representation of OBJECT, with newlines around it.
 Quoting characters are printed when needed to make output that `read'
 /*
 * This buffer should be at least as large as the max string size of the
 * largest float, printed in the biggest notation.  This is undoubtably
 * 20d float_output_format, with the negative of the C-constant "HUGE"
 * from <math.h>.
 *
 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
 *
 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
 * case of -1e307 in 20d float_output_format. What is one to do (short of
 * re-writing _doprnt to be more sane)?
 * 			-wsr
 */
 {
 Bufbyte *cp, c;
 int width;
 if (NILP (Vfloat_output_format)
 || !STRINGP (Vfloat_output_format))
 lose:
 sprintf (buf, "%.16g", data);
 else			/* oink oink */
 	{
 	  width *= 10;
 	  width += c - '0';
 	}
 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
 	goto lose;
 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
 	goto lose;
 }
 #endif /* LISP_FLOAT_TYPE */
 static void
 print_vector_internal (CONST char *start, CONST char *end,
 Lisp_Object obj,
 Lisp_Object printcharfun, int escapeflag)
 {
 /* This function can GC */
 int i;
-int len = vector_length (XVECTOR (obj));
+int len = XVECTOR_LENGTH (obj);
 int last = len;
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (obj, printcharfun);
 if (INTP (Vprint_length))
 }
 write_c_string (start, printcharfun);
 for (i = 0; i < last; i++)
 {
-Lisp_Object elt = vector_data (XVECTOR (obj))[i];
+Lisp_Object elt = XVECTOR_DATA (obj)[i];
 if (i != 0) write_char_internal (" ", printcharfun);
 print_internal (elt, printcharfun, escapeflag);
 }
 UNGCPRO;
 if (last != len)
 void
 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
 			 int escapeflag)
 {
 char buf[200];
-sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%x>",
+sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%p>",
 	   XRECORD_LHEADER (obj)->implementation->name,
-	   (EMACS_INT) XPNTR (obj));
+	   (void *) XPNTR (obj));
 write_c_string (buf, printcharfun);
 }
 void
 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 switch (XTYPE (obj))
 {
 case Lisp_Int:
 {
-	sprintf (buf, "%d", XINT (obj));
+	sprintf (buf, "%ld", (long) XINT (obj));
 	write_c_string (buf, printcharfun);
 	break;
 }
 case Lisp_Char:
 	    write_char_internal ("\"", printcharfun);
 	    for (i = 0; i < max; i++)
 	      {
 		Bufbyte ch = string_byte (s, i);
 		if (ch == '\"' || ch == '\\'
 		    || (ch == '\n' && print_escape_newlines))
 		  {
 		    if (i > last)
 		      {
 			output_string (printcharfun, 0, obj, last,
 print_depth--;
 }
 static void
 print_compiled_function_internal (CONST char *start, CONST char *end,
 				  Lisp_Object obj,
 				  Lisp_Object printcharfun, int escapeflag)
 {
 /* This function can GC */
 struct Lisp_Compiled_Function *b =
 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
 output_string (printcharfun, 0, nameobj, 0, size);
 return;
 }
 GCPRO2 (obj, printcharfun);
 if (print_gensym)
 {
 Lisp_Object tem = oblookup (Vobarray, string_data (name), size);
 if (!EQ (tem, obj))
 	/* (read) would return a new symbol with the same name.
 	   This isn't quite correct, because that symbol might not
 confusing = 1;
 else
 goto not_yet_confused;
 for (; confusing < size; confusing++)
 {
 if (!isdigit (data[confusing]))
 {
 confusing = 0;
 break;
 }
 {
 Lisp_Object nameobj;
 Bytecount i;
 Bytecount last = 0;
 XSETSTRING (nameobj, name);
 for (i = 0; i < size; i++)
 {
 	Bufbyte c = string_byte (name, i);

Mercurial > hg > xemacs-beta

comparison src/print.c @ 173:8eaf7971accc r20-3b13