[ESS-bugs] ess-beginning-of-function - bug in {R and S}-mode
A.J. Rossini
blindglobe at gmail.com
Sat Jul 9 09:57:06 CEST 2005
quickly, since I'm on vacation for another 2 weeks:
1. yes, I was moving everything to ess-cust years ago;
2. please move it out, since we really don't want that customizable
(and I thought that Stephen and I think someone else did some reverse
engineering, moving things out of ess-cust, recently).
Martin, are you going to Seattle this year? I think Rich and I are.
Looks like I've been roped into going to Seattle next year (JSM
session on industrial open source).
best,
-tony
On 7/8/05, Martin Maechler <maechler at stat.math.ethz.ch> wrote:
> >>>>> "MM" == Martin Maechler <maechler at stat.math.ethz.ch>
> >>>>> on Thu, 7 Jul 2005 17:36:48 +0200 writes:
>
> >>>>> "StEgl" == Stephen Eglen <S.J.Eglen at damtp.cam.ac.uk>
> >>>>> on Wed, 6 Jul 2005 10:15:20 +0100 writes:
>
> >>> C-M-a and C-M-e and all other ess-function-* commands fail
> >>> for things like
> >>>
> >>> myfun <-
> >>> ## bla1
> >>> ## bla2
> >>> ## bla3
> >>> ## bla4
> >>> function(x) {
> >>> .........
> >>> .........
> >>> }
> >>>
> >>> as long as your (point) is inside the '## bla.' comment lines
> >>>
> >>> John Chambers has been using this syntax extensively,
> >>> and actually S4 has defined that the '## bla?" lines are made
> >>> into a ``dummy help page'' as long as no real help page exists.
> >>> and IIRC, this even works in S-plus {but not in R}.
>
> StEgl> sounds like a good way to get docstrings, in the same way that Emacs
> StEgl> does at the top of a function definition! I'd have slightly prefered
> StEgl> the look of something like:
>
> StEgl> myfun <- function(x) {
> StEgl> ## bla1
> StEgl> ##...
> StEgl> code
> StEgl> }
>
> MM> I still prefer this -- quite a bit ---
>
> StEgl> but if it is already in S and John C uses it, that's good enough for
> StEgl> me to start thinking about changing. (Is it likely that R will adopt
> StEgl> this convention for an informal doc string?)
>
> MM> This is really something that should be asked on R-devel;
> MM> or in particular to those in R-core who dare to fiddle with the
> MM> parser.
>
> MM> In R, currently, it does ``not really work''
> MM> because all the comments between "myfun" and " <- function(x)"
> MM> are lost as early as when *parsing* the things.
>
> StEgl> I'm unlikely to get a chance to look at this soon, but will put it on
> StEgl> my list of things to look at, as it sounds like a good thing to
> StEgl> encourage documentation in this way.
>
> MM> I felt an urgency to look at our {beginning / end} of function
> MM> parsing, because when working with S4 methods and classes, the
> MM> current ESS behavior is really a bit painful for someone who is
> MM> used to
> MM> M-C-a M-C-e or Stephen's own "C-x n d" == narrow-to-defun
> MM> which can be used in ess mode as well :
>
> MM> Code like the following appears ``every where''
>
> ------------------------------------------------------------------------
> setMethod("ranef", signature(object = "lmer"),
> function(object, accumulate = FALSE, ...) {
> val <- new("lmer.ranef",
> lapply(.Call("lmer_ranef", object, PACKAGE = "Matrix"),
> data.frame, check.names = FALSE),
> varFac = object at bVar,
> stdErr = .Call("lmer_sigma", object,
> object at method == "REML", PACKAGE = "Matrix"))
> if (!accumulate || length(val at varFac) == 1) return(val)
> ## check for nested factors
> L <- object at L
> if (any(sapply(seq(a = val), function(i) length(L[[Lind(i,i)]]@i))))
> error("Require nested grouping factors to accumulate random effects")
> val
> })
> ------------------------------------------------------------------------
>
> MM> but we only get an error when the function boundaries are
> MM> sought.
>
> MM> I thought I had above case ("setMethod.....") almost working,
> MM> but ``not quite'' and
> MM> I am now seeing that the definitions for
> MM> ess-beginning-of-function
> MM> ess-end-of-function
> MM> in ess-mode.el where really geared to S3 and can hardly work
> MM> with other languages.
> MM> As a matter of fact:
> MM> They (and hence the C-M-a and C-M-e keys)
> MM> must fail completely since no "ess-function-pattern" is
> MM> defined for other ESS - languages
>
> MM> My fix would even more make these even more dependent on S (R || S-plus)..
> MM> ...ugly...but I'd tend to commit that hack, since I really want something
> MM> working for myself when using setMethod(.), setGeneric(.), etc
> MM> all over the place.
>
> MM> After all, we have this in ess-cust.el
> MM> {just before the definition of
> MM> ess-R-function-pattern and ess-S-function-pattern
> MM> and I'm sure these used to be in ess-mode.el close to the
> MM> ess-beg/end-of-function definitions} :
>
> MM> ;; FIXME : This is just for the S dialects; need to define this for others,
> MM> ;; -----
> MM> ;; {however "XLS-mode" should just use standard lisp "beginning of function"}
>
> I've spent much (quite frustrating) time now hacking the
> ess-beginning-of-function such that it now seems to work with
> setMethod() et all.
>
> I need to clean up my hack before committing.
>
> But when doing this I really found that the patterns mentioned above,
> and ess-R-function-pattern
> ess-S-function-pattern
> now have become so complicated that they should not be
> customizable any more. I propose to move them from ess-cust.el
> to ess-mode.el {the only place where they are used} and make
> them simple (defvar .)'s instead of (defconst .)'s.
>
> Does anyone see a problem with this?
>
> [Tony, you were the one who at one time wanted everything moved
> to ess-cust.el, right ?]
>
> StEgl> Presumably this form of function definition also is not captured by
> StEgl> the imenu code?
>
> MM> {I have to admit that I almost never use the imenu stuff}
>
> I've now looked:
> - Yes, Stephen, the ``comments before "<-" ''
> also foul up the imenu parsing
>
> - At least *it* can deal with SetMethod() etc
> and since this morning {when I committed an enhancement},
> it can also deal with setReplaceMethod(.)
> or setAs(.)
>
> --------
>
> {Feedback welcome!}
>
> Martin
>
> _______________________________________________
> ESS-bugs ESS-bugs at stat.math.ethz.ch
> https://stat.ethz.ch/mailman/listinfo/ess-bugs
>
> _______________________________________________
> ESS-core list: https://stat.ethz.ch/mailman/listinfo/ess-core
>
--
best,
-tony
"Commit early,commit often, and commit in a repository from which we can easily
roll-back your mistakes" (AJR, 4Jan05).
A.J. Rossini
blindglobe at gmail.com
More information about the ESS-bugs
mailing list