The R Project SVN R

Rev

Rev 51948 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 51948 Rev 54049
Line 1... Line 1...
1
/*
1
/*
2
 *  R : A Computer Langage for Statistical Data Analysis
2
 *  R : A Computer Langage for Statistical Data Analysis
3
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
3
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
4
 *  Copyright (C) 1998--2007  Robert Gentleman, Ross Ihaka and the
-
 
5
 *                            R Development Core Team
4
 *  Copyright (C) 1998--2011  The R Development Core Team
6
 *
5
 *
7
 *  This program is free software; you can redistribute it and/or modify
6
 *  This program is free software; you can redistribute it and/or modify
8
 *  it under the terms of the GNU General Public License as published by
7
 *  it under the terms of the GNU General Public License as published by
9
 *  the Free Software Foundation; either version 2 of the License, or
8
 *  the Free Software Foundation; either version 2 of the License, or
10
 *  (at your option) any later version.
9
 *  (at your option) any later version.
Line 522... Line 521...
522
	tmp = VECTOR_ELT(DE->work, col - 1);
521
	tmp = VECTOR_ELT(DE->work, col - 1);
523
	if (isNull(tmp)) return fw;
522
	if (isNull(tmp)) return fw;
524
	/* don't use NA labels */
523
	/* don't use NA labels */
525
	lab = STRING_ELT(DE->names, col - 1);
524
	lab = STRING_ELT(DE->names, col - 1);
526
	if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;
525
	if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;
527
	PrintDefaults(R_NilValue);
526
	PrintDefaults();
528
	for (i = 0; i < INTEGER(DE->lens)[col - 1]; i++) {
527
	for (i = 0; i < INTEGER(DE->lens)[col - 1]; i++) {
529
	    strp = EncodeElement(tmp, i, 0, '.');
528
	    strp = EncodeElement(tmp, i, 0, '.');
530
	    w1 = strlen(strp);
529
	    w1 = strlen(strp);
531
	    if (w1 > w) w = w1;
530
	    if (w1 > w) w = w1;
532
	}
531
	}
Line 617... Line 616...
617
   vector. Caller must check. */
616
   vector. Caller must check. */
618
 
617
 
619
static void printelt(DEstruct DE, SEXP invec, int vrow, int ssrow, int sscol)
618
static void printelt(DEstruct DE, SEXP invec, int vrow, int ssrow, int sscol)
620
{
619
{
621
    const char *strp;
620
    const char *strp;
622
    PrintDefaults(R_NilValue);
621
    PrintDefaults();
623
    if (TYPEOF(invec) == REALSXP) {
622
    if (TYPEOF(invec) == REALSXP) {
624
	strp = EncodeElement(invec, vrow, 0, '.');
623
	strp = EncodeElement(invec, vrow, 0, '.');
625
	printstring(DE, strp, strlen(strp), ssrow, sscol, 0);
624
	printstring(DE, strp, strlen(strp), ssrow, sscol, 0);
626
    }
625
    }
627
    else if (TYPEOF(invec) == STRSXP) {
626
    else if (TYPEOF(invec) == STRSXP) {
Line 1210... Line 1209...
1210
    SEXP tvec;
1209
    SEXP tvec;
1211
 
1210
 
1212
    if (wcol <= DE->xmaxused) {
1211
    if (wcol <= DE->xmaxused) {
1213
	tvec = VECTOR_ELT(DE->work, wcol - 1);
1212
	tvec = VECTOR_ELT(DE->work, wcol - 1);
1214
	if (!isNull(tvec) && wrow < INTEGER(DE->lens)[wcol - 1]) {
1213
	if (!isNull(tvec) && wrow < INTEGER(DE->lens)[wcol - 1]) {
1215
	    PrintDefaults(R_NilValue);
1214
	    PrintDefaults();
1216
	    if (TYPEOF(tvec) == REALSXP) {
1215
	    if (TYPEOF(tvec) == REALSXP) {
1217
		prev = EncodeElement(tvec, wrow, 0, '.');
1216
		prev = EncodeElement(tvec, wrow, 0, '.');
1218
	    } else if (TYPEOF(tvec) == STRSXP) {
1217
	    } else if (TYPEOF(tvec) == STRSXP) {
1219
		if (STRING_ELT(tvec, wrow) != DE->ssNA_STRING)
1218
		if (STRING_ELT(tvec, wrow) != DE->ssNA_STRING)
1220
		    prev = EncodeElement(tvec, wrow, 0, '.');
1219
		    prev = EncodeElement(tvec, wrow, 0, '.');
Line 1407... Line 1406...
1407
    DE->de = newdataeditor(DE, title);
1406
    DE->de = newdataeditor(DE, title);
1408
    if(!DE->de) return TRUE;
1407
    if(!DE->de) return TRUE;
1409
    DE->oldWIDTH = DE->oldHEIGHT = 0;
1408
    DE->oldWIDTH = DE->oldHEIGHT = 0;
1410
    DE->nboxchars = 5;
1409
    DE->nboxchars = 5;
1411
 
1410
 
1412
    DE->nboxchars = asInteger(GetOption(install("de.cellwidth"), R_GlobalEnv));
1411
    DE->nboxchars = asInteger(GetOption1(install("de.cellwidth")));
1413
    if (DE->nboxchars == NA_INTEGER || DE->nboxchars < 0) DE->nboxchars = 0;
1412
    if (DE->nboxchars == NA_INTEGER || DE->nboxchars < 0) DE->nboxchars = 0;
1414
    if (DE->nboxchars > 0) check(DE->de_mvw);
1413
    if (DE->nboxchars > 0) check(DE->de_mvw);
1415
    DE->box_w = ((DE->nboxchars >0)?DE->nboxchars:FIELDWIDTH)*(DE->p->fw) + 8;
1414
    DE->box_w = ((DE->nboxchars >0)?DE->nboxchars:FIELDWIDTH)*(DE->p->fw) + 8;
1416
    /* this used to presume 4 chars sufficed for row numbering */
1415
    /* this used to presume 4 chars sufficed for row numbering */
1417
    labdigs = max(3, 1+floor(log10((double)DE->ymaxused)));
1416
    labdigs = max(3, 1+floor(log10((double)DE->ymaxused)));