etc/R-ESS-bugs.R

   1 #### File showing off  things that go wrong -- with R-mode
   2
   3
   4 ### Here, the indentation is wrong:
   5
   6 a <- function(ch) {
   7     if(ch == Inf) {
   8         E.cond <- numeric(nb)
   9     }
  10     else {
  11         indic  <- ifelse(jinf+1 <= 1 & jsup >= 1,1,0)
  12         E.cond <- ch*(-pbinom(jinf,ni,prb) + 1-pbinom(js.n,ni,prb)) +
  13             ifelse(ni == 1, prb*indic,
  14                    mu*(pbinom(js.n-1,pmax(ni-1,1),prb)-
  15                        pbinom(jinf-1,pmax(ni-1,1),prb))) / sV -
  16 ### why is the following line wrongly indented by Emacs/ESS ?
  17                            mu/sV*(pbinom(js.n,ni,prb) - pbinom(jinf,ni,prb))
  18
  19         indic2 <- ifelse(jinf+1 <= 1 & jsup >= 1 & ni == 2,1,0)
  20
  21     }
  22 }
  23
  24
  25 ### Here, the beginning of function is not found correctly, and hence
  26 ###       all "ess-*-function" (C-M-a, C-M-e, ...) fail:
  27
  28 setMeneric <-
  29   ## It is clearly allowed to have comments here.
  30   ## S version 4, and John Chambers in particular like it.
  31   ##
  32   ## BUG: M-C-e or M-C-a fails from ``here'' --
  33   ## ---  effectively because of ess-beginning-of-function fails
  34   ## and that really relies on finding  ess-function-pattern;
  35   ## i.e., ess-R-function-pattern in ~/emacs/ess/lisp/ess-cust.el
  36   ##
  37     function(name, def = NULL, group = list(), valueClass = character(),
  38              where = topenv(parent.frame()), genericFunction = NULL)
  39 {
  40     ## comments in here are at least kept via "source" attribute
  41     if(exists(name, "package:base") &&
  42        typeof(get(name, "package:base")) != "closure") {
  43         FALSE
  44     }
  45     "ABC"
  46 }
  47
  48 ## this has one line more before 'function' than "typically:"
  49 setMethod("[", signature(x = "dgTMatrix", i = "numeric", j = "missing",
  50                          drop = "logical"),
  51           function (x, i, j, ..., drop) { ## select rows
  52               storage.mode(i) <- "integer"
  53               xi <- x@i + 1:1 # 1-indexing
  54               ## ...................
  55               if (drop && any(nd == 1)) drop(as(x,"matrix")) else x
  56           })
  57
  58 "dimnames<-.data.frame" <- function(x, value) {
  59     d <- dim(x)
  60     if(!is.list(value) || length(value) != 2
  61        || d[[1]] != length(value[[1]])
  62        || d[[2]] != length(value[[2]]))
  63         stop("invalid 'dimnames' given for data frame")
  64     row.names(x) <- as.character(value[[1]]) # checks validity
  65     names(x) <- as.character(value[[2]])
  66     x
  67 }
  68
  69 '[.foo' <- function(x, i, value)
  70 {
  71 ###
  72     y <- x
  73     y[i] <- value
  74     y
  75 }
  76
  77 '[[.bar' <- function(x, i, value)
  78 {
  79     ## bla bla bla
  80     y <- as.foo(x) ; y[[i]] <- value
  81     y
  82 }
  83
  84 "[<-.foobar" <- function(x,i,j,value) {
  85     ## just something
  86     x
  87 }
  88
  89 "names<-.foobar" <- function(x, value) {
  90     ## just something else
  91     x
  92 }
  93
  94 "[<-.data.frame" <- function(x, i, j, value)
  95 {
  96     nA <- nargs() # value is never missing, so 3 or 4.
  97
  98 ###..........
  99
 100     class(x) <- cl
 101     x
 102 }
 103
 104 "[[<-.data.frame"<- function(x, i, j, value)
 105 {
 106     cl <- oldClass(x)
 107     ## delete class: Version 3 idiom
 108     ## to avoid any special methods for [[<-
 109     class(x) <- NULL
 110
 111 ###...........
 112
 113     class(x) <- cl
 114     x
 115 }
 116
 117
 118 "$<-.data.frame"<- function(x, i, value)
 119 {
 120     cl <- oldClass(x)
 121     ## delete class: Version 3 idiom
 122     ## to avoid any special methods for [[<-
 123
 124 ###...........
 125
 126     class(x) <- cl
 127     return(x)
 128 }