File: strgraphwrap.s

package info (click to toggle)
hmisc 3.14-5-1
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 2,792 kB
  • ctags: 701
  • sloc: asm: 23,440; fortran: 600; ansic: 375; xml: 160; makefile: 1
file content (84 lines) | stat: -rw-r--r-- 3,056 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
strgraphwrap <-
  function (x, width = 0.9 * getOption("width"),
            indent = 0, exdent = 0,
            prefix = "", simplify = TRUE, units='user', cex=NULL)
{
    if (!is.character(x))
        x <- as.character(x)

    spc.len <- strwidth(" ", units=units, cex=cex)
    prefix.len <- strwidth(prefix, units = units, cex=cex)
    indentString <- paste(rep.int(" ", indent), collapse = "")
    indent <- indent * spc.len
    exdentString <- paste(rep.int(" ", exdent), collapse = "")
    exdent <- exdent * spc.len

    y <- list()
    z <- lapply(strsplit(x, "\n[ \t\n]*\n"), strsplit, "[ \t\n]")
    for (i in seq_along(z)) {
        yi <- character(0)
        for (j in seq_along(z[[i]])) {
            words <- z[[i]][[j]]
            nc <- strwidth(words, units=units, cex=cex)
            if (any(is.na(nc))) {
                nc0 <- strwidth(words, units=units, cex=cex)
                nc[is.na(nc)] <- nc0[is.na(nc)]
            }
            if (any(nc == 0)) {
                zLenInd <- which(nc == 0)
                zLenInd <- zLenInd[!(zLenInd %in% (grep("\\.$",
                  words) + 1))]
                if (length(zLenInd) > 0) {
                  words <- words[-zLenInd]
                  nc <- nc[-zLenInd]
                }
            }
            if (length(words) == 0) {
                yi <- c(yi, "", prefix)
                next
            }
            currentIndex <- 0
            lowerBlockIndex <- 1
            upperBlockIndex <- integer(0)
            lens <- cumsum(nc + spc.len)
            first <- TRUE
            maxLength <- width - prefix.len -
                indent
            while (length(lens) > 0) {
                k <- max(sum(lens <= maxLength), 1)
                if (first) {
                  first <- FALSE
                  maxLength <- maxLength + indent - exdent
                }
                currentIndex <- currentIndex + k
                if (nc[currentIndex] == 0)
                  upperBlockIndex <- c(upperBlockIndex, currentIndex -
                    1)
                else upperBlockIndex <- c(upperBlockIndex, currentIndex)
                if (length(lens) > k) {
                  if (nc[currentIndex + 1] == 0) {
                    currentIndex <- currentIndex + 1
                    k <- k + 1
                  }
                  lowerBlockIndex <- c(lowerBlockIndex, currentIndex +
                    1)
                }
                if (length(lens) > k)
                  lens <- lens[-(1:k)] - lens[k]
                else lens <- NULL
            }
            nBlocks <- length(upperBlockIndex)
            s <- paste(prefix, c(indentString, rep.int(exdentString,
                nBlocks - 1)), sep = "")
            for (k in (1:nBlocks)) s[k] <- paste(s[k], paste(words[lowerBlockIndex[k]:upperBlockIndex[k]],
                collapse = " "), sep = "")
            yi <- c(yi, s, prefix)
        }
        y <- if (length(yi))
            c(y, list(yi[-length(yi)]))
        else c(y, "")
    }
    if (simplify)
        y <- unlist(y)
    y
}