Showing 15 of 43 files from the diff.
Newly tracked file
R/RspDirective.R changed.
Newly tracked file
R/rstring.R changed.
Newly tracked file
R/RspParser.R changed.
Newly tracked file
R/RspComment.R changed.
Newly tracked file
R/rcat.R changed.
Newly tracked file
R/RspCode.R changed.
Newly tracked file
R/RspShSourceCode.R changed.
Newly tracked file
R/buildVignette.R changed.
Newly tracked file
R/RspString.R changed.
Newly tracked file
R/RspDocument.toR.R changed.
Newly tracked file
R/utils.R changed.
Newly tracked file
R/rfile.R changed.

@@ -150,7 +150,8 @@
Loading
150 150
  if (length(suffixSpecs) == 0L) {
151 151
    suffixSpecs <- ""
152 152
  }
153 -
  fmtstr <- "<%%@%s%s%s%s%%>"
153 +
  fmtstr <- "@%s%s%s%s"
154 +
  fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
154 155
  s <- sprintf(fmtstr, body, attrs, comment, suffixSpecs)
155 156
  RspString(s)
156 157
})
@@ -444,7 +445,8 @@
Loading
444 445
setMethodS3("asRspString", "RspUnparsedDirective", function(object, ...) {
445 446
  body <- unclass(object)
446 447
  suffixSpecs <- attr(object, "suffixSpecs")
447 -
  fmtstr <- "<%%@%s%s%%>"
448 +
  fmtstr <- "@%s%s"
449 +
  fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
448 450
  s <- sprintf(fmtstr, body, suffixSpecs)
449 451
  RspString(s)
450 452
})

@@ -110,7 +110,7 @@
Loading
110 110
        # Drop { ... } again
111 111
        codeTT <- codeTT[-1L]; codeTT <- codeTT[-length(codeTT)]
112 112
        codeTT <- hpaste(codeTT, collapse="", maxHead=100L, maxTail=30L)
113 -
        throw(sprintf("RSP code chunk (#%d):\n<%%= %s %%>\ndoes not contain a complete or valid R expression: %s", index, codeTT, ex))
113 +
        throw(sprintf("RSP code chunk (#%d):\n%s= %s %s\ndoes not contain a complete or valid R expression: %s", index, .rspBracketOpen, codeTT, .rspBracketClose, ex))
114 114
      })
115 115
    }
116 116

@@ -160,7 +160,8 @@
Loading
160 160
  verbose && enter(verbose, "rstring() for ", class(object)[1L])
161 161
162 162
  verbose && enter(verbose, "Coerce RSP document to source code")
163 -
  language <- getAttribute(object, "language", default="R")
163 +
#  language <- getAttribute(object, "language", default="R")
164 +
  language <- getMetadata(object, "language", default="R")
164 165
  language <- capitalize(tolower(language))
165 166
  className <- sprintf("Rsp%sSourceCodeFactory", language)
166 167
  ns <- getNamespace("R.rsp")

@@ -37,6 +37,14 @@
Loading
37 37
  escapeRspText <- function(text) {
38 38
    text <- deparse(text)
39 39
    text <- substring(text, first=2L, last=nchar(text)-1L)
40 +
    ## SHELL: Escape backticks
41 +
    text <- sapply(text, FUN=function(s) {
42 +
      gsub("`", "\\`", s, fixed = TRUE)
43 +
    })
44 +
    ## SHELL: Escape dollar signs
45 +
    text <- sapply(text, FUN=function(s) {
46 +
      gsub("$", "\\$", s, fixed = TRUE)
47 +
    })
40 48
    text
41 49
  } # escapeRspText()
42 50
@@ -47,7 +55,7 @@
Loading
47 55
    n <- length(code)
48 56
    codeE <- sapply(code, FUN=escapeRspText)
49 57
    codeE <- sprintf("printf \"%s\"", codeE)
50 -
    suffixR <- rep(" > /dev/null", times=n)
58 +
    suffixR <- rep(" 2> /dev/null", times=n)
51 59
    codeR <- sprintf("%s%s", codeT, suffixR)
52 60
    if (include) {
53 61
      # Output the last out

@@ -65,15 +65,15 @@
Loading
65 65
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
66 66
  # Escape '<%%' and '%%>'
67 67
  escapeP <- function(s) {
68 -
    s <- gsub("<%%", "---<<<---%%%---%%%---", s, fixed=TRUE)
69 -
    s <- gsub("%%>", "---%%%---%%%--->>>---", s, fixed=TRUE)
68 +
    s <- gsub(.rspBracketOpenEscape,  "---<<<---%%%---%%%---", s, fixed=TRUE)
69 +
    s <- gsub(.rspBracketCloseEscape, "---%%%---%%%--->>>---", s, fixed=TRUE)
70 70
    s
71 71
  } # escapeP()
72 72
73 73
  # Unescape '<%%' and '%%>'
74 74
  unescapeP <- function(s) {
75 -
    s <- gsub("---<<<---%%%---%%%---", "<%%", s, fixed=TRUE)
76 -
    s <- gsub("---%%%---%%%--->>>---", "%%>", s, fixed=TRUE)
75 +
    s <- gsub("---<<<---%%%---%%%---", .rspBracketOpenEscape,  s, fixed=TRUE)
76 +
    s <- gsub("---%%%---%%%--->>>---", .rspBracketCloseEscape, s, fixed=TRUE)
77 77
    s
78 78
  } # unescapeP()
79 79
@@ -117,23 +117,23 @@
Loading
117 117
    if (commentLength == -1L) {
118 118
      # <%-%>, <%--%>, <%---%>, <%----%>, ...
119 119
      # <%-[suffix]%>, <%--[suffix]%>, <%---[suffix]%>, ...
120 -
      patternL <- "(<%([-]+(\\[[^]]*\\])?%>))"
120 +
      patternL <- sprintf("(%s([-]+(\\[[^]]*\\])?%s))", .rspBracketOpen, .rspBracketClose)
121 121
      patternR <- NULL
122 122
    } else {
123 123
      # <%-- --%>, <%--\n--%>, <%-- text --%>, ...
124 124
      # <%--- ---%>, <%--- text ---%>, ...
125 -
      patternL <- sprintf("(<%%-{%d})([^-])", commentLength)
125 +
      patternL <- sprintf("(%s-{%d})([^-])", .rspBracketOpen, commentLength)
126 126
      hasPatternLTail <- TRUE
127 -
      patternR <- sprintf("(|[^-])(-{%d}(\\[[^]]*\\])?)%%>", commentLength)
127 +
      patternR <- sprintf("(|[^-])(-{%d}(\\[[^]]*\\])?)%s", commentLength, .rspBracketClose)
128 128
    }
129 129
    bodyClass <- RspComment
130 130
  } else if (what == "directive") {
131 -
    patternL <- "(<%@)()"
132 -
    patternR <- "()(|[+]|-(\\[[^]]*\\])?)%>"
131 +
    patternL <- sprintf("(%s@)()", .rspBracketOpen)
132 +
    patternR <- sprintf("()(|[+]|-(\\[[^]]*\\])?)%s", .rspBracketClose)
133 133
    bodyClass <- RspUnparsedDirective
134 134
  } else if (what == "expression") {
135 -
    patternL <- "(<%)()"
136 -
    patternR <- "()(|[+]|-(\\[[^]]*\\])?)%>"
135 +
    patternL <- sprintf("(%s)()", .rspBracketOpen)
136 +
    patternR <- sprintf("()(|[+]|-(\\[[^]]*\\])?)%s", .rspBracketClose)
137 137
    bodyClass <- RspUnparsedExpression
138 138
  }
139 139
@@ -177,7 +177,7 @@
Loading
177 177
      # Was it an escaped RSP start tag, i.e. '<%%'?
178 178
      if (what == "expression") {
179 179
        tagX <- substring(bfr, first=posL, last=posL+nL)
180 -
        if (tagX == "<%%")
180 +
        if (tagX == .rspBracketOpenEscape)
181 181
          break
182 182
      }
183 183
@@ -488,7 +488,7 @@
Loading
488 488
489 489
  count <- 0L
490 490
  posL <- -1L
491 -
  while ((pos <- regexpr("<%[-]+", object)) != -1L) {
491 +
  while ((pos <- regexpr(sprintf("%s[-]+", .rspBracketOpen), object)) != -1L) {
492 492
    # Nothing changed? (e.g. if there is an unclosed comment)
493 493
    if (identical(pos, posL)) {
494 494
      break

@@ -65,7 +65,10 @@
Loading
65 65
setMethodS3("asRspString", "RspComment", function(object, ...) {
66 66
  body <- unclass(object)
67 67
  suffixSpecs <- attr(object, "suffixSpecs")
68 -
  fmtstr <- "<%%%s%s%%>"
68 +
69 +
  fmtstr <- "%s%s"
70 +
  fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
71 +
  
69 72
  s <- sprintf(fmtstr, body, suffixSpecs)
70 73
  RspString(s)
71 74
})

@@ -49,14 +49,14 @@
Loading
49 49
50 50
51 51
escapeRspTags <- function(s) {
52 -
  s <- gsub("<%", "<%%", s, fixed=TRUE)
53 -
  s <- gsub("%>", "%%>", s, fixed=TRUE)
52 +
  s <- gsub(.rspBracketOpen,  .rspBracketOpenEscape,  s, fixed=TRUE)
53 +
  s <- gsub(.rspBracketClose, .rspBracketCloseEscape, s, fixed=TRUE)
54 54
  s
55 55
} # escapeRspTags()
56 56
57 57
unescapeRspTags <- function(s) {
58 -
  s <- gsub("<%%", "<%", s, fixed=TRUE)
59 -
  s <- gsub("%%>", "%>", s, fixed=TRUE)
58 +
  s <- gsub(.rspBracketOpenEscape,  .rspBracketOpen,  s, fixed=TRUE)
59 +
  s <- gsub(.rspBracketCloseEscape, .rspBracketClose, s, fixed=TRUE)
60 60
  s
61 61
} # unescapeRspTags()
62 62

@@ -56,6 +56,9 @@
Loading
56 56
#
57 57
#   parses and evaluates the RSP string and outputs the result to
58 58
#   standard output.
59 +
#   A CLI-friendly alternative to the above is:
60 +
#
61 +
#   \code{Rscript -e R.rsp::rcat "A random integer in [1,<\%=K\%>]: <\%=sample(1:K, size=1)\%>" --args --K=50}
59 62
# }
60 63
#
61 64
# \section{rsource()}{
@@ -154,7 +157,8 @@
Loading
154 157
  verbose && cat(verbose, "Arguments:")
155 158
  verbose && str(verbose, args)
156 159
157 -
  s <- rstring(..., envir=envir, args=args, output=outputP)
160 +
  s <- rstring(..., envir=envir, args=args, output=outputP,
161 +
               verbose=less(verbose, 10))
158 162
159 163
  verbose && cat(verbose, "Result:")
160 164
  verbose && str(verbose, s)
@@ -205,5 +209,6 @@
Loading
205 209
206 210
setMethodS3("rcat", "RspDocument", rcat.RspString)
207 211
setMethodS3("rcat", "RspRSourceCode", rcat.RspString)
212 +
setMethodS3("rcat", "RspShSourceCode", rcat.RspString)
208 213
setMethodS3("rcat", "function", rcat.RspString)
209 214
setMethodS3("rcat", "expression", rcat.RspString)

@@ -104,7 +104,7 @@
Loading
104 104
    fmtstr <- "%s"
105 105
  }
106 106
107 -
  fmtstr <- paste("<%%", fmtstr, "%%>", sep="")
107 +
  fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
108 108
  s <- sprintf(fmtstr, body)
109 109
  RspString(s)
110 110
})
@@ -160,7 +160,7 @@
Loading
160 160
    fmtstr <- "%s"
161 161
  }
162 162
163 -
  fmtstr <- paste("<%%", fmtstr, "%%>", sep="")
163 +
  fmtstr <- paste(escFmtStr(.rspBracketOpen), fmtstr, escFmtStr(.rspBracketClose), sep="")
164 164
  s <- sprintf(fmtstr, body)
165 165
  RspString(s)
166 166
})

@@ -6,7 +6,7 @@
Loading
6 6
# \description{
7 7
#  @classhierarchy
8 8
#
9 -
#  An RspShSourceCode object is an @see "RspSourceCode" holding R source code.
9 +
#  An RspShSourceCode object is an @see "RspSourceCode" holding shell code.
10 10
# }
11 11
#
12 12
# @synopsis

@@ -48,7 +48,7 @@
Loading
48 48
#*/###########################################################################
49 49
buildVignette <- function(file, dir = ".", latex = TRUE, tangle = TRUE, quiet = TRUE, clean = TRUE, engine=NULL, buildPkg=NULL, ...) {
50 50
    if (getRversion() >= "3.1.0") {
51 -
      .Deprecated(new="tools::buildVignette")
51 +
      .Defunct(new="tools::buildVignette")
52 52
    }
53 53
54 54
    ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

@@ -147,7 +147,7 @@
Loading
147 147
# }
148 148
#*/#########################################################################
149 149
setMethodS3("getSource", "RspString", function(object, ...) {
150 -
  getAttribute(object, "source", default=as.character(NA))
150 +
  getAttribute(object, "source", default=NA_character_)
151 151
}, protected=TRUE, createGeneric=FALSE)
152 152
153 153

@@ -26,7 +26,16 @@
Loading
26 26
#   @seeclass
27 27
# }
28 28
#*/#########################################################################
29 -
setMethodS3("toR", "RspDocument", function(object, factory=RspRSourceCodeFactory(), ...) {
29 +
setMethodS3("toR", "RspDocument", function(object, factory=NULL, ...) {
30 +
  if (is.null(factory)) {
31 +
    language <- getMetadata(object, "language", default="R")
32 +
    language <- capitalize(tolower(language))
33 +
    className <- sprintf("Rsp%sSourceCodeFactory", language)
34 +
    ns <- getNamespace("R.rsp")
35 +
    clazz <- Class$forName(className, envir=ns)
36 +
    factory <- newInstance(clazz)
37 +
  }
38 +
  
30 39
  # Argument 'factory':
31 40
  factory <- Arguments$getInstanceOf(factory, "RspSourceCodeFactory")
32 41

@@ -23,3 +23,7 @@
Loading
23 23
  }
24 24
}
25 25
26 +
escFmtStr <- function(x) {
27 +
  gsub("%", "%%", x,  fixed = TRUE)
28 +
}
29 +

@@ -3,6 +3,7 @@
Loading
3 3
# @alias rfile.RspString
4 4
# @alias rfile.RspDocument
5 5
# @alias rfile.RspRSourceCode
6 +
# @alias rfile.RspShSourceCode
6 7
# @alias rfile.function
7 8
# @alias rfile.expression
8 9
#
@@ -52,9 +53,12 @@
Loading
52 53
#   Using @see "Rscript" and \code{rfile()}, it is possible to process
53 54
#   an RSP file from the command line.  For example,
54 55
#
55 -
#   \code{Rscript -e "R.rsp::rfile(file='RSP_refcard.tex.rsp', path=system.file('doc', package='R.rsp'))"}
56 +
#   \code{Rscript -e "R.rsp::rfile('RSP_refcard.tex.rsp')"}
56 57
#
57 58
#   parses and evaluates \file{RSP_refcard.tex.rsp} and output \file{RSP_refcard.pdf} in the current directory.
59 +
#   A CLI-friendly alternative to the above is:
60 +
#
61 +
#   \code{Rscript -e R.rsp::rfile RSP_refcard.tex.rsp}
58 62
# }
59 63
#
60 64
# \examples{
@@ -535,3 +539,139 @@
Loading
535 539
536 540
  res
537 541
}, protected=TRUE) # rfile()
542 +
543 +
544 +
545 +
setMethodS3("rfile", "RspShSourceCode", function(rcode, output, workdir=NULL, envir=parent.frame(), args="*", postprocess=TRUE, ..., verbose=FALSE) {
546 +
  # In-string variable substitute
547 +
  vsub <- function(pathname, ...) {
548 +
    gstr <- GString(pathname)
549 +
    str <- gstring(gstr, where=c("envir", "Sys.getenv", "getOption"),
550 +
                         envir=envir, inherits=FALSE)[1L]
551 +
    str <- wstring(str, envir=envir)
552 +
    str
553 +
  } # vsub()
554 +
555 +
556 +
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
557 +
  # Validate arguments
558 +
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
559 +
  # Argument 'workdir':
560 +
  if (is.null(workdir)) {
561 +
    if (isAbsolutePath(output)) {
562 +
      workdir <- getParent(output)
563 +
    } else {
564 +
      workdir <- "."
565 +
    }
566 +
  }
567 +
  workdir <- Arguments$getWritablePath(workdir)
568 +
  if (is.null(workdir)) workdir <- "."
569 +
570 +
  # Argument 'output':
571 +
  if (inherits(output, "connection")) {
572 +
  } else if (identical(output, "")) {
573 +
    output <- stdout()
574 +
  } else if (is.character(output)) {
575 +
    withoutGString({
576 +
      if (isAbsolutePath(output)) {
577 +
        output <- Arguments$getWritablePathname(output)
578 +
      } else {
579 +
        output <- Arguments$getWritablePathname(output, path=workdir)
580 +
        output <- getAbsolutePath(output)
581 +
      }
582 +
    })
583 +
  } else {
584 +
    throw("Argument 'output' of unknown type: ", class(output)[1L])
585 +
  }
586 +
587 +
  # Argument 'envir':
588 +
  stop_if_not(is.environment(envir))
589 +
590 +
  # Argument 'args':
591 +
  args <- cmdArgs(args=args)
592 +
593 +
  # Argument 'verbose':
594 +
  verbose <- Arguments$getVerbose(verbose)
595 +
  if (verbose) {
596 +
    pushState(verbose)
597 +
    on.exit(popState(verbose), add=TRUE)
598 +
  }
599 +
600 +
601 +
  verbose && enter(verbose, "Processing RSP R source code")
602 +
603 +
  if (verbose) {
604 +
    if (is.character(output)) {
605 +
      cat(verbose, "Output pathname: ", output)
606 +
    } else if (inherits(output, "connection")) {
607 +
      ci <- summary(output)
608 +
      printf(verbose, "Output '%s' connection: %s\n",
609 +
          class(ci)[1L], ci$description)
610 +
    }
611 +
  }
612 +
613 +
614 +
  verbose && enter(verbose, "Assigning RSP arguments")
615 +
  verbose && cat(verbose, "Environment: ", getName(envir))
616 +
  if (length(args) > 0L) {
617 +
    verbose && cat(verbose, "Arguments assigned: ", hpaste(names(args)))
618 +
    # Assign arguments to the parse/evaluation environment
619 +
    attachLocally(args, envir=envir)
620 +
  } else {
621 +
    verbose && cat(verbose, "Arguments assigned: <none>")
622 +
  }
623 +
  verbose && exit(verbose)
624 +
625 +
626 +
  verbose && enter(verbose, "Evaluating RSP R source code")
627 +
628 +
  # Change working directory
629 +
  opwd <- NULL
630 +
  if ((workdir != ".") && (workdir != getwd())) {
631 +
    opwd <- getwd()
632 +
    on.exit({ if (!is.null(opwd)) setwd(opwd) }, add=TRUE)
633 +
    verbose && cat(verbose, "Temporary working directory: ", getAbsolutePath(workdir))
634 +
    setwd(workdir)
635 +
  }
636 +
637 +
  res <- rcat(rcode, output=output, envir=envir, args=NULL, ..., verbose=less(verbose, 10))
638 +
639 +
  withoutGString({
640 +
    if (isFile(output)) {
641 +
      res <- RspFileProduct(output, attrs=getAttributes(res))
642 +
643 +
      # Rename output file via GString substitution of the filename?
644 +
      resG <- vsub(res)
645 +
      if (resG != res) {
646 +
        if (renameFile(res, resG, overwrite=TRUE)) {
647 +
          # FIXME: res <- newInstance(res, resG)
648 +
          res <- RspFileProduct(resG, attrs=getAttributes(res))
649 +
        } else {
650 +
          warning(sprintf("Failed to rename output file containing variable substitutions in its name (keeping the current one): ", sQuote(res), " -> ", sQuote(resG)))
651 +
        }
652 +
      }
653 +
      resG <- NULL; # Not needed anymore
654 +
    } else {
655 +
      res <- RspProduct(output, attrs=getAttributes(res))
656 +
    }
657 +
  }) # withoutGString()
658 +
659 +
  verbose && print(verbose, res)
660 +
  rcode <- output <- NULL; # Not needed anymore
661 +
662 +
  # Reset the working directory?
663 +
  if (!is.null(opwd)) {
664 +
    setwd(opwd)
665 +
    opwd <- NULL
666 +
  }
667 +
668 +
  verbose && exit(verbose)
669 +
670 +
  if (postprocess && hasProcessor(res)) {
671 +
    res <- process(res, workdir=workdir, ..., verbose=verbose)
672 +
  }
673 +
674 +
  verbose && exit(verbose)
675 +
676 +
  res
677 +
}, protected=TRUE) # rfile()
Files Coverage
R 57.74%
Project Totals (72 files) 57.74%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading