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

Collapse All | Expand All

(-)R-trunk-r69232/src/library/utils/R/str.R (-10 / +49 lines)
Lines 539-555 Link Here
539
	    ## if object is very long, drop the rest which won't be used anyway:
539
	    ## if object is very long, drop the rest which won't be used anyway:
540
	    max.len <- max(100, width %/% 3 + 1, if(!missing(vec.len)) vec.len)
540
	    max.len <- max(100, width %/% 3 + 1, if(!missing(vec.len)) vec.len)
541
	    if(le > max.len) object <- object[seq_len(max.len)]
541
	    if(le > max.len) object <- object[seq_len(max.len)]
542
	    encObj <- encodeString(object, quote= '"', na.encode= FALSE)
542
	    ole <- length(object)
543
					#O: encodeString(object)
543
	    if(missing(vec.len)) {
544
	    v.len <-
544
		encObj <- character(ole)
545
		if(missing(vec.len)) {
545
		## '5*ne..' is fudge factor
546
		    max(1,sum(cumsum(3 + if(le>0) nchar(encObj, type="w") else 0) <
546
		rhs <- width - (4 + 5*nest.lev + nchar(str1, type="w"))
547
			      width - (4 + 5*nest.lev + nchar(str1, type="w"))))
547
		subLen <- pmax.int(rhs - 5 * seq_len(ole), nchar.max - 1)
548
		}		      # '5*ne..' above is fudge factor
548
		## '5 *' is for cases where A) substr() of length 1 does
549
		else round(v.len)
549
		## not correspond to one printable character or B) when
550
	    ile <- min(le, v.len)
550
		## encodeString() does not catch a non-printable
551
		## character. The latter issue is not solved
552
		## completely. For example, consider
553
		## str(paste0(c(rep(intToUtf8(8203),635),"a"),collapse="")).
554
		slackLen <- 5 * subLen
555
		slack1 <- slackLen + 1
556
		subObj <- substr(object, 1, slackLen)
557
		encObj <- encodeString(subObj, quote= '"', na.encode= FALSE)
558
		ncEnc <- nchar(encObj, type="w")
559
		## another go at issue B) above
560
		idx <- which(ncEnc < subLen + 2 &
561
			     substr(object, slack1, slack1) != "")
562
		if (length(idx) > 0) {
563
		    encObj[idx] <- encodeString(object[idx], quote= '"',
564
						na.encode= FALSE)
565
		    ncEnc[idx] <- nchar(encObj[idx], type="w")
566
		}
567
		ncEnc <- pmax.int(2, ncEnc)
568
		v.len <- max(1, sum(cumsum(3 + if(le>0) ncEnc else 0) < rhs))
569
		ile <- min(ole, v.len)
570
		encObj <- encObj[seq_len(ile)]
571
	    } else {
572
		v.len <- round(v.len)
573
		ile <- min(ole, v.len)
574
		if(ile >= 1) {
575
		    subLen <- nchar.max - 1
576
		    slackLen <- 5 * subLen
577
		    slack1 <- slackLen + 1
578
		    obile <- object[seq_len(ile)]
579
		    subObj <- substr(obile, 1, slackLen)
580
		    encObj <- encodeString(subObj, quote= '"',
581
					   na.encode= FALSE)
582
		    idx <- which(substr(obile, slack1, slack1) != "")
583
		    idx <- idx[nchar(encObj[idx], type="w") < subLen + 2]
584
		    if (length(idx) > 0) {
585
			encObj[idx] <- encodeString(object[idx], quote= '"',
586
						    na.encode= FALSE)
587
		    }
588
		}
589
	    }
551
	    if(ile >= 1) ## truncate if LONG char:
590
	    if(ile >= 1) ## truncate if LONG char:
552
		object <- maybe_truncate(encObj[seq_len(ile)])
591
		object <- maybe_truncate(encObj)
553
					#O: encodeString(object, quote= '"', na.encode= FALSE)
592
					#O: encodeString(object, quote= '"', na.encode= FALSE)
554
	    formObj <- function(x) paste(as.character(x), collapse=" ")
593
	    formObj <- function(x) paste(as.character(x), collapse=" ")
555
	}
594
	}

Return to bug 16527