View | Details | Raw Unified | Return to bug 17398 | Differences between
and this patch

Collapse All | Expand All

(-)src/include/Defn.h (-1 / +22 lines)
Lines 979-984 extern0 int R_PCRE_limit_recursion; Link Here
979
# define onsigusr2              Rf_onsigusr2
979
# define onsigusr2              Rf_onsigusr2
980
# define parse			Rf_parse
980
# define parse			Rf_parse
981
# define patchArgsByActuals	Rf_patchArgsByActuals
981
# define patchArgsByActuals	Rf_patchArgsByActuals
982
# define PrintInit              Rf_PrintInit
982
# define PrintDefaults		Rf_PrintDefaults
983
# define PrintDefaults		Rf_PrintDefaults
983
# define PrintGreeting		Rf_PrintGreeting
984
# define PrintGreeting		Rf_PrintGreeting
984
# define PrintValueEnv		Rf_PrintValueEnv
985
# define PrintValueEnv		Rf_PrintValueEnv
Lines 1093-1098 SEXP Rf_StringFromReal(double, int*); Link Here
1093
SEXP Rf_StringFromComplex(Rcomplex, int*);
1094
SEXP Rf_StringFromComplex(Rcomplex, int*);
1094
SEXP Rf_EnsureString(SEXP);
1095
SEXP Rf_EnsureString(SEXP);
1095
1096
1097
/* ../../main/print.c : */
1098
typedef struct {
1099
    int width;
1100
    int na_width;
1101
    int na_width_noquote;
1102
    int digits;
1103
    int scipen;
1104
    int gap;
1105
    int quote;
1106
    int right;
1107
    int max;
1108
    SEXP na_string;
1109
    SEXP na_string_noquote;
1110
    int useSource;
1111
    int cutoff; // for deparsed language objects
1112
    SEXP env;
1113
    SEXP callArgs;
1114
} R_PrintData;
1115
1096
/* Other Internally Used Functions */
1116
/* Other Internally Used Functions */
1097
1117
1098
SEXP Rf_allocCharsxp(R_len_t);
1118
SEXP Rf_allocCharsxp(R_len_t);
Lines 1192-1201 RETSIGTYPE onsigusr2(int); Link Here
1192
R_xlen_t OneIndex(SEXP, SEXP, R_xlen_t, int, SEXP*, int, SEXP);
1212
R_xlen_t OneIndex(SEXP, SEXP, R_xlen_t, int, SEXP*, int, SEXP);
1193
SEXP parse(FILE*, int);
1213
SEXP parse(FILE*, int);
1194
SEXP patchArgsByActuals(SEXP, SEXP, SEXP);
1214
SEXP patchArgsByActuals(SEXP, SEXP, SEXP);
1215
void PrintInit(R_PrintData *, SEXP);
1195
void PrintDefaults(void);
1216
void PrintDefaults(void);
1196
void PrintGreeting(void);
1217
void PrintGreeting(void);
1197
void PrintValueEnv(SEXP, SEXP);
1218
void PrintValueEnv(SEXP, SEXP);
1198
void PrintValueRec(SEXP, SEXP);
1219
void PrintValueRec(SEXP, R_PrintData *);
1199
void PrintVersion(char *, size_t len);
1220
void PrintVersion(char *, size_t len);
1200
void PrintVersion_part_1(char *, size_t len);
1221
void PrintVersion_part_1(char *, size_t len);
1201
void PrintVersionString(char *, size_t len);
1222
void PrintVersionString(char *, size_t len);
(-)src/include/Print.h (-16 / +3 lines)
Lines 37-58 Link Here
37
#define printNamedVector    Rf_printNamedVector
37
#define printNamedVector    Rf_printNamedVector
38
#define printVector         Rf_printVector
38
#define printVector         Rf_printVector
39
39
40
typedef struct {
40
/* For backward compatibility */
41
    int width;
41
#define R_print_par_t R_PrintData
42
    int na_width;
42
43
    int na_width_noquote;
44
    int digits;
45
    int scipen;
46
    int gap;
47
    int quote;
48
    int right;
49
    int max;
50
    SEXP na_string;
51
    SEXP na_string_noquote;
52
    int useSource;
53
    int cutoff; // for deparsed language objects
54
    SEXP callArgs;
55
} R_print_par_t;
56
extern R_print_par_t R_print;
43
extern R_print_par_t R_print;
57
44
58
/* Computation of printing formats */
45
/* Computation of printing formats */
(-)src/main/eval.c (-1 / +5 lines)
Lines 1484-1490 static void PrintCall(SEXP call, SEXP rho) Link Here
1484
        blines = asInteger(GetOption1(install("deparse.max.lines")));
1484
        blines = asInteger(GetOption1(install("deparse.max.lines")));
1485
    if(blines != NA_INTEGER && blines > 0)
1485
    if(blines != NA_INTEGER && blines > 0)
1486
	R_BrowseLines = blines;
1486
	R_BrowseLines = blines;
1487
    PrintValueRec(call, rho);
1487
1488
    R_PrintData pars;
1489
    PrintInit(&pars, rho);
1490
    PrintValueRec(call, &pars);
1491
1488
    R_BrowseLines = old_bl;
1492
    R_BrowseLines = old_bl;
1489
}
1493
}
1490
1494
(-)src/main/main.c (-1 / +5 lines)
Lines 1186-1192 static void PrintCall(SEXP call, SEXP rho) Link Here
1186
	blines = asInteger(GetOption1(install("deparse.max.lines")));
1186
	blines = asInteger(GetOption1(install("deparse.max.lines")));
1187
    if(blines != NA_INTEGER && blines > 0)
1187
    if(blines != NA_INTEGER && blines > 0)
1188
	R_BrowseLines = blines;
1188
	R_BrowseLines = blines;
1189
    PrintValueRec(call, rho);
1189
1190
    R_PrintData pars;
1191
    PrintInit(&pars, rho);
1192
    PrintValueRec(call, &pars);
1193
1190
    R_BrowseLines = old_bl;
1194
    R_BrowseLines = old_bl;
1191
}
1195
}
1192
1196
(-)src/main/print.c (-120 / +121 lines)
Lines 67-106 Link Here
67
#include <R_ext/RS.h>
67
#include <R_ext/RS.h>
68
68
69
/* Global print parameter struct: */
69
/* Global print parameter struct: */
70
R_print_par_t R_print;
70
R_PrintData R_print;
71
71
72
static void printAttributes(SEXP, SEXP, Rboolean);
72
static void printAttributes(SEXP, R_PrintData *, Rboolean);
73
static void PrintSpecial(SEXP);
73
static void PrintObject(SEXP, R_PrintData *);
74
static void PrintObject(SEXP, SEXP);
75
74
76
75
77
#define TAGBUFLEN 256
76
#define TAGBUFLEN 256
78
#define TAGBUFLEN0 TAGBUFLEN + 6
77
#define TAGBUFLEN0 TAGBUFLEN + 6
79
static char tagbuf[TAGBUFLEN0 * 2]; /* over-allocate to allow overflow check */
78
static char tagbuf[TAGBUFLEN0 * 2]; /* over-allocate to allow overflow check */
80
79
80
void PrintInit(R_PrintData *data, SEXP env)
81
{
82
    data->na_string = NA_STRING;
83
    data->na_string_noquote = mkChar("<NA>");
84
    data->na_width = (int) strlen(CHAR(data->na_string));
85
    data->na_width_noquote = (int) strlen(CHAR(data->na_string_noquote));
86
    data->quote = 1;
87
    data->right = Rprt_adj_left;
88
    data->digits = GetOptionDigits();
89
    data->scipen = asInteger(GetOption1(install("scipen")));
90
    if (data->scipen == NA_INTEGER) data->scipen = 0;
91
    data->max = asInteger(GetOption1(install("max.print")));
92
    if (data->max == NA_INTEGER || data->max < 0) data->max = 99999;
93
    else if(data->max == INT_MAX) data->max--; // so we can add
94
    data->gap = 1;
95
    data->width = GetOptionWidth();
96
    data->useSource = USESOURCE;
97
    data->cutoff = GetOptionCutoff();
98
    data->env = env;
99
    data->callArgs = R_NilValue;
100
}
81
101
82
/* Used in X11 module for dataentry */
102
/* Used in X11 module for dataentry */
83
/* NB this is called by R.app even though it is in no public header, so
103
/* NB this is called by R.app even though it is in no public header, so
84
   alter there if you alter this */
104
   alter there if you alter this */
85
void PrintDefaults(void)
105
void PrintDefaults(void)
86
{
106
{
87
    R_print.na_string = NA_STRING;
107
    PrintInit(&R_print, R_GlobalEnv);
88
    R_print.na_string_noquote = mkChar("<NA>");
89
    R_print.na_width = (int) strlen(CHAR(R_print.na_string));
90
    R_print.na_width_noquote = (int) strlen(CHAR(R_print.na_string_noquote));
91
    R_print.quote = 1;
92
    R_print.right = Rprt_adj_left;
93
    R_print.digits = GetOptionDigits();
94
    R_print.scipen = asInteger(GetOption1(install("scipen")));
95
    if (R_print.scipen == NA_INTEGER) R_print.scipen = 0;
96
    R_print.max = asInteger(GetOption1(install("max.print")));
97
    if (R_print.max == NA_INTEGER || R_print.max < 0) R_print.max = 99999;
98
    else if(R_print.max == INT_MAX) R_print.max--; // so we can add
99
    R_print.gap = 1;
100
    R_print.width = GetOptionWidth();
101
    R_print.useSource = USESOURCE;
102
    R_print.cutoff = GetOptionCutoff();
103
    R_print.callArgs = R_NilValue;
104
}
108
}
105
109
106
SEXP attribute_hidden do_invisible(SEXP call, SEXP op, SEXP args, SEXP rho)
110
SEXP attribute_hidden do_invisible(SEXP call, SEXP op, SEXP args, SEXP rho)
Lines 155-174 SEXP attribute_hidden do_prmatrix(SEXP call, SEXP op, SEXP args, SEXP rho) Link Here
155
    return x;
159
    return x;
156
}/* do_prmatrix */
160
}/* do_prmatrix */
157
161
158
static void PrintLanguage(SEXP s, Rboolean useSource)
162
static void PrintLanguage(SEXP s, R_PrintData *data)
159
{
163
{
160
    int i;
164
    int i;
161
    SEXP t = getAttrib(s, R_SrcrefSymbol);
165
    SEXP t = getAttrib(s, R_SrcrefSymbol);
162
    Rboolean useSrc = useSource && isInteger(t);
166
    Rboolean useSrc = data->useSource && isInteger(t);
163
    if (useSrc) {
167
    if (useSrc) {
164
	PROTECT(t = lang2(R_AsCharacterSymbol, t));
168
	PROTECT(t = lang2(R_AsCharacterSymbol, t));
165
	t = eval(t, R_BaseEnv);
169
	t = eval(t, R_BaseEnv);
166
	UNPROTECT(1);
170
	UNPROTECT(1);
167
    } else {
171
    } else {
168
        /* Save parameters as deparsing calls PrintDefaults() */
172
	t = deparse1w(s, 0, data->useSource | DEFAULTDEPARSE);
169
        R_print_par_t pars = R_print;
173
        R_print = *data; /* Deparsing calls PrintDefaults() */
170
	t = deparse1w(s, 0, useSource | DEFAULTDEPARSE);
171
        R_print = pars;
172
    }
174
    }
173
    PROTECT(t);
175
    PROTECT(t);
174
    for (i = 0; i < LENGTH(t); i++) {
176
    for (i = 0; i < LENGTH(t); i++) {
Lines 177-185 static void PrintLanguage(SEXP s, Rboolean useSource) Link Here
177
    UNPROTECT(1);
179
    UNPROTECT(1);
178
}
180
}
179
181
180
static void PrintClosure(SEXP s, Rboolean useSource)
182
static void PrintClosure(SEXP s, R_PrintData *data)
181
{
183
{
182
    PrintLanguage(s, useSource);
184
    PrintLanguage(s, data);
183
185
184
    if (isByteCode(BODY(s)))
186
    if (isByteCode(BODY(s)))
185
        Rprintf("<bytecode: %p>\n", BODY(s));
187
        Rprintf("<bytecode: %p>\n", BODY(s));
Lines 192-266 static void PrintClosure(SEXP s, Rboolean useSource) Link Here
192
			   right, max, useS4)) */
194
			   right, max, useS4)) */
193
SEXP attribute_hidden do_printdefault(SEXP call, SEXP op, SEXP args, SEXP rho)
195
SEXP attribute_hidden do_printdefault(SEXP call, SEXP op, SEXP args, SEXP rho)
194
{
196
{
195
    SEXP naprint;
196
197
    checkArity(op, args);
197
    checkArity(op, args);
198
    PrintDefaults();
199
198
200
    SEXP x = CAR(args); args = CDR(args);
199
    SEXP x = CAR(args); args = CDR(args);
201
    SEXP env = CAR(args); args = CDR(args);
200
    SEXP env = CAR(args); args = CDR(args);
202
201
202
    R_PrintData data;
203
    PrintInit(&data, env);
204
203
    if(!isNull(CAR(args))) {
205
    if(!isNull(CAR(args))) {
204
	R_print.digits = asInteger(CAR(args));
206
	data.digits = asInteger(CAR(args));
205
	if (R_print.digits == NA_INTEGER ||
207
	if (data.digits == NA_INTEGER ||
206
	    R_print.digits < R_MIN_DIGITS_OPT ||
208
	    data.digits < R_MIN_DIGITS_OPT ||
207
	    R_print.digits > R_MAX_DIGITS_OPT)
209
	    data.digits > R_MAX_DIGITS_OPT)
208
	    error(_("invalid '%s' argument"), "digits");
210
	    error(_("invalid '%s' argument"), "digits");
209
    }
211
    }
210
    args = CDR(args);
212
    args = CDR(args);
211
213
212
    R_print.quote = asLogical(CAR(args));
214
    data.quote = asLogical(CAR(args));
213
    if(R_print.quote == NA_LOGICAL)
215
    if(data.quote == NA_LOGICAL)
214
	error(_("invalid '%s' argument"), "quote");
216
	error(_("invalid '%s' argument"), "quote");
215
    args = CDR(args);
217
    args = CDR(args);
216
218
217
    naprint = CAR(args);
219
    SEXP naprint = CAR(args);
218
    if(!isNull(naprint))  {
220
    if(!isNull(naprint))  {
219
	if(!isString(naprint) || LENGTH(naprint) < 1)
221
	if(!isString(naprint) || LENGTH(naprint) < 1)
220
	    error(_("invalid 'na.print' specification"));
222
	    error(_("invalid 'na.print' specification"));
221
	R_print.na_string = R_print.na_string_noquote = STRING_ELT(naprint, 0);
223
	data.na_string = data.na_string_noquote = STRING_ELT(naprint, 0);
222
	R_print.na_width = R_print.na_width_noquote =
224
	data.na_width = data.na_width_noquote =
223
	    (int) strlen(CHAR(R_print.na_string));
225
	    (int) strlen(CHAR(data.na_string));
224
    }
226
    }
225
    args = CDR(args);
227
    args = CDR(args);
226
228
227
    if(!isNull(CAR(args))) {
229
    if(!isNull(CAR(args))) {
228
	R_print.gap = asInteger(CAR(args));
230
	data.gap = asInteger(CAR(args));
229
	if (R_print.gap == NA_INTEGER || R_print.gap < 0)
231
	if (data.gap == NA_INTEGER || data.gap < 0)
230
	    error(_("'gap' must be non-negative integer"));
232
	    error(_("'gap' must be non-negative integer"));
231
    }
233
    }
232
    args = CDR(args);
234
    args = CDR(args);
233
235
234
    R_print.right = (Rprt_adj) asLogical(CAR(args)); /* Should this be asInteger()? */
236
    data.right = (Rprt_adj) asLogical(CAR(args)); /* Should this be asInteger()? */
235
    if(R_print.right == NA_LOGICAL)
237
    if(data.right == NA_LOGICAL)
236
	error(_("invalid '%s' argument"), "right");
238
	error(_("invalid '%s' argument"), "right");
237
    args = CDR(args);
239
    args = CDR(args);
238
240
239
    if(!isNull(CAR(args))) {
241
    if(!isNull(CAR(args))) {
240
	R_print.max = asInteger(CAR(args));
242
	data.max = asInteger(CAR(args));
241
	if(R_print.max == NA_INTEGER || R_print.max < 0)
243
	if(data.max == NA_INTEGER || data.max < 0)
242
	    error(_("invalid '%s' argument"), "max");
244
	    error(_("invalid '%s' argument"), "max");
243
	else if(R_print.max == INT_MAX) R_print.max--; // so we can add
245
	else if(data.max == INT_MAX) data.max--; // so we can add
244
    }
246
    }
245
    args = CDR(args);
247
    args = CDR(args);
246
248
247
    R_print.useSource = asLogical(CAR(args));
249
    data.useSource = asLogical(CAR(args));
248
    if(R_print.useSource == NA_LOGICAL)
250
    if(data.useSource == NA_LOGICAL)
249
	error(_("invalid '%s' argument"), "useSource");
251
	error(_("invalid '%s' argument"), "useSource");
250
    if(R_print.useSource) R_print.useSource = USESOURCE;
252
    if(data.useSource) data.useSource = USESOURCE;
251
    args = CDR(args);
253
    args = CDR(args);
252
254
253
    int noParams = asLogical(CAR(args)); args = CDR(args);
255
    int noParams = asLogical(CAR(args)); args = CDR(args);
254
    if (noParams == NA_LOGICAL)
256
    if (noParams == NA_LOGICAL)
255
        error(_("invalid 'noParams' internal argument"));
257
        error(_("invalid 'noParams' internal argument"));
256
258
257
    R_print.callArgs = CAR(args);
259
    data.callArgs = CAR(args);
260
261
262
    /* Initialise the global R_init as other routines still depend on it */
263
    R_print = data;
258
264
259
    tagbuf[0] = '\0';
265
    tagbuf[0] = '\0';
260
    if (noParams && IS_S4_OBJECT(x) && isMethodsDispatchOn())
266
    if (noParams && IS_S4_OBJECT(x) && isMethodsDispatchOn())
261
        PrintObject(x, env);
267
        PrintObject(x, &data);
262
    else
268
    else
263
        PrintValueRec(x, env);
269
        PrintValueRec(x, &data);
264
270
265
    PrintDefaults(); /* reset, as na.print etc may have been set */
271
    PrintDefaults(); /* reset, as na.print etc may have been set */
266
    return x;
272
    return x;
Lines 270-276 SEXP attribute_hidden do_printdefault(SEXP call, SEXP op, SEXP args, SEXP rho) Link Here
270
  NOTE: The S3/S4 versions do not save and restore state like
276
  NOTE: The S3/S4 versions do not save and restore state like
271
        PrintObject() does.
277
        PrintObject() does.
272
*/
278
*/
273
static void PrintObjectS4(SEXP s, SEXP env)
279
static void PrintObjectS4(SEXP s, R_PrintData *data)
274
{
280
{
275
    /*
281
    /*
276
      Note that can assume there is a loaded "methods"
282
      Note that can assume there is a loaded "methods"
Lines 288-298 static void PrintObjectS4(SEXP s, SEXP env) Link Here
288
294
289
    SEXP call = PROTECT(lang2(fun, s));
295
    SEXP call = PROTECT(lang2(fun, s));
290
296
291
    eval(call, env);
297
    eval(call, data->env);
292
    UNPROTECT(2);
298
    UNPROTECT(2);
293
}
299
}
294
300
295
static void PrintObjectS3(SEXP s, SEXP env)
301
static void PrintObjectS3(SEXP s, R_PrintData *data)
296
{
302
{
297
    /*
303
    /*
298
      Bind value to a variable in a local environment, similar to
304
      Bind value to a variable in a local environment, similar to
Lines 301-312 static void PrintObjectS3(SEXP s, SEXP env) Link Here
301
      evaluating the value, which might be a call object.
307
      evaluating the value, which might be a call object.
302
    */
308
    */
303
    SEXP xsym = install("x");
309
    SEXP xsym = install("x");
304
    SEXP mask = PROTECT(NewEnvironment(R_NilValue, R_NilValue, env));
310
    SEXP mask = PROTECT(NewEnvironment(R_NilValue, R_NilValue, data->env));
305
    defineVar(xsym, s, mask);
311
    defineVar(xsym, s, mask);
306
312
307
    /* Forward user-supplied arguments to print() */
313
    /* Forward user-supplied arguments to print() */
308
    SEXP fun = findVar(install("print"), R_BaseNamespace);
314
    SEXP fun = findVar(install("print"), R_BaseNamespace);
309
    SEXP args = PROTECT(cons(xsym, R_print.callArgs));
315
    SEXP args = PROTECT(cons(xsym, data->callArgs));
310
    SEXP call = PROTECT(lcons(fun, args));
316
    SEXP call = PROTECT(lcons(fun, args));
311
317
312
    eval(call, mask);
318
    eval(call, mask);
Lines 315-347 static void PrintObjectS3(SEXP s, SEXP env) Link Here
315
    UNPROTECT(3);
321
    UNPROTECT(3);
316
}
322
}
317
323
318
static void PrintObject(SEXP s, SEXP env)
324
static void PrintObject(SEXP s, R_PrintData *data)
319
{
325
{
320
    /* Save the tagbuffer to restore indexing tags after evaluation
326
    /* Save the tagbuffer to restore indexing tags after evaluation
321
       because calling into base::print() resets the buffer */
327
       because calling into base::print() resets the buffer */
322
    char save[TAGBUFLEN0];
328
    char save[TAGBUFLEN0];
323
    strcpy(save, tagbuf);
329
    strcpy(save, tagbuf);
324
330
325
    /* Save the R_print structure since it might be reset by print.default() */
326
    R_print_par_t pars = R_print;
327
328
    if (isMethodsDispatchOn() && IS_S4_OBJECT(s))
331
    if (isMethodsDispatchOn() && IS_S4_OBJECT(s))
329
        PrintObjectS4(s, env);
332
        PrintObjectS4(s, data);
330
    else
333
    else
331
        PrintObjectS3(s, env);
334
        PrintObjectS3(s, data);
332
335
333
    R_print = pars;
336
    R_print = *data;
334
    strcpy(tagbuf, save);
337
    strcpy(tagbuf, save);
335
}
338
}
336
339
337
static void PrintDispatch(SEXP s, SEXP env) {
340
static void PrintDispatch(SEXP s, R_PrintData *data) {
338
    if (isObject(s))
341
    if (isObject(s))
339
        PrintObject(s, env);
342
        PrintObject(s, data);
340
    else
343
    else
341
        PrintValueRec(s, env);
344
        PrintValueRec(s, data);
342
}
345
}
343
346
344
static void PrintGenericVector(SEXP s, SEXP env)
347
static void PrintGenericVector(SEXP s, R_PrintData *data)
345
{
348
{
346
    int i, taglen, ns, w, d, e, wr, dr, er, wi, di, ei;
349
    int i, taglen, ns, w, d, e, wr, dr, er, wi, di, ei;
347
    SEXP dims, t, names, tmp;
350
    SEXP dims, t, names, tmp;
Lines 352-358 static void PrintGenericVector(SEXP s, SEXP env) Link Here
352
	// special case: array-like list
355
	// special case: array-like list
353
	PROTECT(dims);
356
	PROTECT(dims);
354
	PROTECT(t = allocArray(STRSXP, dims));
357
	PROTECT(t = allocArray(STRSXP, dims));
355
	/* FIXME: check (ns <= R_print.max +1) ? ns : R_print.max; */
358
	/* FIXME: check (ns <= data->max +1) ? ns : data->max; */
356
	for (i = 0; i < ns; i++) {
359
	for (i = 0; i < ns; i++) {
357
	    switch(TYPEOF(PROTECT(tmp = VECTOR_ELT(s, i)))) {
360
	    switch(TYPEOF(PROTECT(tmp = VECTOR_ELT(s, i)))) {
358
	    case NILSXP:
361
	    case NILSXP:
Lines 394-402 static void PrintGenericVector(SEXP s, SEXP env) Link Here
394
		if (LENGTH(tmp) == 1) {
397
		if (LENGTH(tmp) == 1) {
395
		    const Rcomplex *x = COMPLEX_RO(tmp);
398
		    const Rcomplex *x = COMPLEX_RO(tmp);
396
		    if (ISNA(x[0].r) || ISNA(x[0].i))
399
		    if (ISNA(x[0].r) || ISNA(x[0].i))
397
			/* formatReal(NA) --> w=R_print.na_width, d=0, e=0 */
400
			/* formatReal(NA) --> w=data->na_width, d=0, e=0 */
398
			snprintf(pbuf, 115, "%s",
401
			snprintf(pbuf, 115, "%s",
399
				 EncodeReal0(NA_REAL, R_print.na_width, 0, 0, OutDec));
402
				 EncodeReal0(NA_REAL, data->na_width, 0, 0, OutDec));
400
		    else {
403
		    else {
401
			formatComplex(x, 1, &wr, &dr, &er, &wi, &di, &ei, 0);
404
			formatComplex(x, 1, &wr, &dr, &er, &wi, &di, &ei, 0);
402
			snprintf(pbuf, 115, "%s",
405
			snprintf(pbuf, 115, "%s",
Lines 446-452 static void PrintGenericVector(SEXP s, SEXP env) Link Here
446
	    const char *rn, *cn;
449
	    const char *rn, *cn;
447
	    GetMatrixDimnames(s, &rl, &cl, &rn, &cn);
450
	    GetMatrixDimnames(s, &rl, &cl, &rn, &cn);
448
	    /* as from 1.5.0: don't quote here as didn't in array case */
451
	    /* as from 1.5.0: don't quote here as didn't in array case */
449
	    printMatrix(t, 0, dims, 0, R_print.right, rl, cl,
452
	    printMatrix(t, 0, dims, 0, data->right, rl, cl,
450
			rn, cn);
453
			rn, cn);
451
	}
454
	}
452
	else {
455
	else {
Lines 462-468 static void PrintGenericVector(SEXP s, SEXP env) Link Here
462
	ptag = tagbuf + taglen;
465
	ptag = tagbuf + taglen;
463
466
464
	if(ns > 0) {
467
	if(ns > 0) {
465
	    int n_pr = (ns <= R_print.max +1) ? ns : R_print.max;
468
	    int n_pr = (ns <= data->max +1) ? ns : data->max;
466
	    /* '...max +1'  ==> will omit at least 2 ==> plural in msg below */
469
	    /* '...max +1'  ==> will omit at least 2 ==> plural in msg below */
467
	    for (i = 0; i < n_pr; i++) {
470
	    for (i = 0; i < n_pr; i++) {
468
		if (i > 0) Rprintf("\n");
471
		if (i > 0) Rprintf("\n");
Lines 497-503 static void PrintGenericVector(SEXP s, SEXP env) Link Here
497
			sprintf(ptag, "[[%d]]", i+1);
500
			sprintf(ptag, "[[%d]]", i+1);
498
		}
501
		}
499
                Rprintf("%s\n", tagbuf);
502
                Rprintf("%s\n", tagbuf);
500
                PrintDispatch(VECTOR_ELT(s, i), env);
503
                PrintDispatch(VECTOR_ELT(s, i), data);
501
                *ptag = '\0';
504
                *ptag = '\0';
502
	    }
505
	    }
503
	    Rprintf("\n");
506
	    Rprintf("\n");
Lines 517-530 static void PrintGenericVector(SEXP s, SEXP env) Link Here
517
		    char str[201];
520
		    char str[201];
518
		    const char *ss = translateChar(STRING_ELT(klass, 0));
521
		    const char *ss = translateChar(STRING_ELT(klass, 0));
519
		    snprintf(str, 200, ".__C__%s", ss);
522
		    snprintf(str, 200, ".__C__%s", ss);
520
		    if(findVar(install(str), env) != R_UnboundValue)
523
		    if(findVar(install(str), data->env) != R_UnboundValue)
521
			className = ss;
524
			className = ss;
522
		}
525
		}
523
	    }
526
	    }
524
	    if(className) {
527
	    if(className) {
525
		Rprintf("An object of class \"%s\"\n", className);
528
		Rprintf("An object of class \"%s\"\n", className);
526
		UNPROTECT(1); /* names */
529
		UNPROTECT(1); /* names */
527
		printAttributes(s, env, TRUE);
530
		printAttributes(s, data, TRUE);
528
		vmaxset(vmax);
531
		vmaxset(vmax);
529
		return;
532
		return;
530
	    }
533
	    }
Lines 536-548 static void PrintGenericVector(SEXP s, SEXP env) Link Here
536
	}
539
	}
537
	UNPROTECT(1); /* names */
540
	UNPROTECT(1); /* names */
538
    }
541
    }
539
    printAttributes(s, env, FALSE);
542
    printAttributes(s, data, FALSE);
540
} // PrintGenericVector
543
} // PrintGenericVector
541
544
542
545
543
// For pairlist()s only --- the predecessor of PrintGenericVector() above,
546
// For pairlist()s only --- the predecessor of PrintGenericVector() above,
544
// and hence very similar  (and no longer compatible!)
547
// and hence very similar  (and no longer compatible!)
545
static void printList(SEXP s, SEXP env)
548
static void printList(SEXP s, R_PrintData *data)
546
{
549
{
547
    int i, taglen;
550
    int i, taglen;
548
    SEXP dims, dimnames, t;
551
    SEXP dims, dimnames, t;
Lines 601-607 static void printList(SEXP s, SEXP env) Link Here
601
	if (LENGTH(dims) == 2) {
604
	if (LENGTH(dims) == 2) {
602
	    SEXP rl, cl;
605
	    SEXP rl, cl;
603
	    GetMatrixDimnames(s, &rl, &cl, &rn, &cn);
606
	    GetMatrixDimnames(s, &rl, &cl, &rn, &cn);
604
	    printMatrix(t, 0, dims, R_print.quote, R_print.right, rl, cl,
607
	    printMatrix(t, 0, dims, data->quote, data->right, rl, cl,
605
			rn, cn);
608
			rn, cn);
606
	}
609
	}
607
	else {
610
	else {
Lines 641-647 static void printList(SEXP s, SEXP env) Link Here
641
	    }
644
	    }
642
645
643
            Rprintf("%s\n", tagbuf);
646
            Rprintf("%s\n", tagbuf);
644
            PrintDispatch(CAR(s), env);
647
            PrintDispatch(CAR(s), data);
645
            *ptag = '\0';
648
            *ptag = '\0';
646
649
647
	    s = CDR(s);
650
	    s = CDR(s);
Lines 649-670 static void printList(SEXP s, SEXP env) Link Here
649
	}
652
	}
650
	if (s != R_NilValue) {
653
	if (s != R_NilValue) {
651
	    Rprintf("\n. \n\n");
654
	    Rprintf("\n. \n\n");
652
	    PrintValueRec(s,env);
655
	    PrintValueRec(s, data);
653
	}
656
	}
654
	Rprintf("\n");
657
	Rprintf("\n");
655
    }
658
    }
656
    printAttributes(s, env, FALSE);
659
    printAttributes(s, data, FALSE);
657
}
660
}
658
661
659
static void PrintExpression(SEXP s)
662
static void PrintExpression(SEXP s, R_PrintData *data)
660
{
663
{
661
    SEXP u;
664
    SEXP u;
662
    int i, n;
665
    int i, n;
663
666
664
    /* Save parameters as deparsing calls PrintDefaults() */
667
    u = PROTECT(deparse1w(s, 0, data->useSource | DEFAULTDEPARSE));
665
    R_print_par_t pars = R_print;
668
    R_print = *data; /* Deparsing calls PrintDefaults() */
666
    u = PROTECT(deparse1w(s, 0, R_print.useSource | DEFAULTDEPARSE));
667
    R_print = pars;
668
669
669
    n = LENGTH(u);
670
    n = LENGTH(u);
670
    for (i = 0; i < n; i++)
671
    for (i = 0; i < n; i++)
Lines 672-678 static void PrintExpression(SEXP s) Link Here
672
    UNPROTECT(1); /* u */
673
    UNPROTECT(1); /* u */
673
}
674
}
674
675
675
static void PrintSpecial(SEXP s)
676
static void PrintSpecial(SEXP s, R_PrintData *data)
676
{
677
{
677
    /* This is OK as .Internals are not visible to be printed */
678
    /* This is OK as .Internals are not visible to be printed */
678
    char *nm = PRIMNAME(s);
679
    char *nm = PRIMNAME(s);
Lines 694-703 static void PrintSpecial(SEXP s) Link Here
694
    if(s2 != R_UnboundValue) {
695
    if(s2 != R_UnboundValue) {
695
	SEXP t;
696
	SEXP t;
696
	PROTECT(s2);
697
	PROTECT(s2);
697
        /* Save parameters as deparsing calls PrintDefaults() */
698
        R_print_par_t pars = R_print;
699
	t = deparse1(s2, 0, DEFAULTDEPARSE);
698
	t = deparse1(s2, 0, DEFAULTDEPARSE);
700
        R_print = pars;
699
        R_print = *data; /* Deparsing calls PrintDefaults() */
700
701
	Rprintf("%s ", CHAR(STRING_ELT(t, 0))); /* translated */
701
	Rprintf("%s ", CHAR(STRING_ELT(t, 0))); /* translated */
702
	Rprintf(".Primitive(\"%s\")\n", PRIMNAME(s));
702
	Rprintf(".Primitive(\"%s\")\n", PRIMNAME(s));
703
	UNPROTECT(1);
703
	UNPROTECT(1);
Lines 710-716 static void PrintSpecial(SEXP s) Link Here
710
710
711
 * This is the "dispatching" function for  print.default()
711
 * This is the "dispatching" function for  print.default()
712
 */
712
 */
713
void attribute_hidden PrintValueRec(SEXP s, SEXP env)
713
void attribute_hidden PrintValueRec(SEXP s, R_PrintData *data)
714
{
714
{
715
    SEXP t;
715
    SEXP t;
716
716
Lines 742-759 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
742
    case NILSXP:
742
    case NILSXP:
743
	Rprintf("NULL\n");
743
	Rprintf("NULL\n");
744
	break;
744
	break;
745
    case SYMSXP: {
745
    case SYMSXP:
746
        /* Use deparse here to handle backtick quotification of "weird names".
746
        /* Use deparse here to handle backtick quotification of "weird names". */
747
           Save parameters as deparsing calls PrintDefaults(). */
748
        R_print_par_t pars = R_print;
749
	t = deparse1(s, 0, SIMPLEDEPARSE);
747
	t = deparse1(s, 0, SIMPLEDEPARSE);
750
        R_print = pars;
748
        R_print = *data; /* Deparsing calls PrintDefaults() */
751
	Rprintf("%s\n", CHAR(STRING_ELT(t, 0))); /* translated */
749
	Rprintf("%s\n", CHAR(STRING_ELT(t, 0))); /* translated */
752
	break;
750
	break;
753
    }
754
    case SPECIALSXP:
751
    case SPECIALSXP:
755
    case BUILTINSXP:
752
    case BUILTINSXP:
756
	PrintSpecial(s);
753
	PrintSpecial(s, data);
757
	break;
754
	break;
758
    case CHARSXP:
755
    case CHARSXP:
759
	Rprintf("<CHARSXP: ");
756
	Rprintf("<CHARSXP: ");
Lines 762-774 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
762
	return; /* skip attribute printing for CHARSXP; they are used */
759
	return; /* skip attribute printing for CHARSXP; they are used */
763
		/* in managing the CHARSXP cache. */
760
		/* in managing the CHARSXP cache. */
764
    case EXPRSXP:
761
    case EXPRSXP:
765
	PrintExpression(s);
762
	PrintExpression(s, data);
766
	break;
763
	break;
767
    case LANGSXP:
764
    case LANGSXP:
768
	PrintLanguage(s, R_print.useSource);
765
	PrintLanguage(s, data);
769
	break;
766
	break;
770
    case CLOSXP:
767
    case CLOSXP:
771
	PrintClosure(s, R_print.useSource);
768
	PrintClosure(s, data);
772
	break;
769
	break;
773
    case ENVSXP:
770
    case ENVSXP:
774
	Rprintf("%s\n", EncodeEnvironment(s));
771
	Rprintf("%s\n", EncodeEnvironment(s));
Lines 780-789 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
780
	Rprintf("<...>\n");
777
	Rprintf("<...>\n");
781
	break;
778
	break;
782
    case VECSXP:
779
    case VECSXP:
783
	PrintGenericVector(s, env); /* handles attributes/slots */
780
	PrintGenericVector(s, data); /* handles attributes/slots */
784
	return;
781
	return;
785
    case LISTSXP:
782
    case LISTSXP:
786
	printList(s,env);
783
	printList(s, data);
787
	break;
784
	break;
788
    case LGLSXP:
785
    case LGLSXP:
789
    case INTSXP:
786
    case INTSXP:
Lines 803-812 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
803
		    if (!isNull(nn))
800
		    if (!isNull(nn))
804
			title = translateChar(STRING_ELT(nn, 0));
801
			title = translateChar(STRING_ELT(nn, 0));
805
802
806
		    printNamedVector(s, VECTOR_ELT(t, 0), R_print.quote, title);
803
		    printNamedVector(s, VECTOR_ELT(t, 0), data->quote, title);
807
		}
804
		}
808
		else
805
		else
809
		    printVector(s, 1, R_print.quote);
806
		    printVector(s, 1, data->quote);
810
		UNPROTECT(1);
807
		UNPROTECT(1);
811
		vmaxset(vmax);
808
		vmaxset(vmax);
812
	    }
809
	    }
Lines 814-826 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
814
		SEXP rl, cl;
811
		SEXP rl, cl;
815
		const char *rn, *cn;
812
		const char *rn, *cn;
816
		GetMatrixDimnames(s, &rl, &cl, &rn, &cn);
813
		GetMatrixDimnames(s, &rl, &cl, &rn, &cn);
817
		printMatrix(s, 0, t, R_print.quote, R_print.right, rl, cl,
814
		printMatrix(s, 0, t, data->quote, data->right, rl, cl,
818
			    rn, cn);
815
			    rn, cn);
819
	    }
816
	    }
820
	    else {
817
	    else {
821
		SEXP dimnames;
818
		SEXP dimnames;
822
		PROTECT(dimnames = GetArrayDimnames(s));
819
		PROTECT(dimnames = GetArrayDimnames(s));
823
		printArray(s, t, R_print.quote, R_print.right, dimnames);
820
		printArray(s, t, data->quote, data->right, dimnames);
824
		UNPROTECT(1);
821
		UNPROTECT(1);
825
	    }
822
	    }
826
	}
823
	}
Lines 828-836 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
828
	    UNPROTECT(1);
825
	    UNPROTECT(1);
829
	    PROTECT(t = getAttrib(s, R_NamesSymbol));
826
	    PROTECT(t = getAttrib(s, R_NamesSymbol));
830
	    if (t != R_NilValue)
827
	    if (t != R_NilValue)
831
		printNamedVector(s, t, R_print.quote, NULL);
828
		printNamedVector(s, t, data->quote, NULL);
832
	    else
829
	    else
833
		printVector(s, 1, R_print.quote);
830
		printVector(s, 1, data->quote);
834
	}
831
	}
835
	UNPROTECT(1);
832
	UNPROTECT(1);
836
	break;
833
	break;
Lines 852-858 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
852
    default:
849
    default:
853
	UNIMPLEMENTED_TYPE("PrintValueRec", s);
850
	UNIMPLEMENTED_TYPE("PrintValueRec", s);
854
    }
851
    }
855
    printAttributes(s, env, FALSE);
852
    printAttributes(s, data, FALSE);
856
#ifdef Win32
853
#ifdef Win32
857
    WinUTF8out = FALSE;
854
    WinUTF8out = FALSE;
858
#endif
855
#endif
Lines 862-868 void attribute_hidden PrintValueRec(SEXP s, SEXP env) Link Here
862
   to avoid $a$battr("foo").  Need to save and restore, since
859
   to avoid $a$battr("foo").  Need to save and restore, since
863
   attributes might be lists with attributes or just have attributes ...
860
   attributes might be lists with attributes or just have attributes ...
864
 */
861
 */
865
static void printAttributes(SEXP s, SEXP env, Rboolean useSlots)
862
static void printAttributes(SEXP s, R_PrintData *data, Rboolean useSlots)
866
{
863
{
867
    SEXP a;
864
    SEXP a;
868
    char *ptag;
865
    char *ptag;
Lines 913-923 static void printAttributes(SEXP s, SEXP env, Rboolean useSlots) Link Here
913
		/* need special handling AND protection */
910
		/* need special handling AND protection */
914
		SEXP val;
911
		SEXP val;
915
		PROTECT(val = getAttrib(s, R_RowNamesSymbol));
912
		PROTECT(val = getAttrib(s, R_RowNamesSymbol));
916
		PrintValueRec(val, env);
913
		PrintValueRec(val, data);
917
		UNPROTECT(1);
914
		UNPROTECT(1);
918
		goto nextattr;
915
		goto nextattr;
919
	    }
916
	    }
920
            PrintDispatch(CAR(a), env);
917
            PrintDispatch(CAR(a), data);
921
	nextattr:
918
	nextattr:
922
	    *ptag = '\0';
919
	    *ptag = '\0';
923
	    a = CDR(a);
920
	    a = CDR(a);
Lines 936-942 void attribute_hidden PrintValueEnv(SEXP s, SEXP env) Link Here
936
    tagbuf[0] = '\0';
933
    tagbuf[0] = '\0';
937
    PROTECT(s);
934
    PROTECT(s);
938
935
939
    PrintDispatch(s, env);
936
    R_PrintData data;
937
    PrintInit(&data, env);
938
    PrintDispatch(s, &data);
940
939
941
    UNPROTECT(1);
940
    UNPROTECT(1);
942
}
941
}
Lines 961-967 void R_PV(SEXP s) Link Here
961
void attribute_hidden CustomPrintValue(SEXP s, SEXP env)
960
void attribute_hidden CustomPrintValue(SEXP s, SEXP env)
962
{
961
{
963
    tagbuf[0] = '\0';
962
    tagbuf[0] = '\0';
964
    PrintValueRec(s, env);
963
964
    R_PrintData data;
965
    PrintInit(&data, env);
966
    PrintValueRec(s, &data);
965
}
967
}
966
968
967
969
968
- 

Return to bug 17398