(ess-message "[ess-s-l:] (def** ) only ...")
(defvar S-syntax-table
(let ((S-syntax-table (make-syntax-table)))
(modify-syntax-entry ?\\ "\\" S-syntax-table)
(modify-syntax-entry ?+ "." S-syntax-table)
(modify-syntax-entry ?- "." S-syntax-table)
(modify-syntax-entry ?= "." S-syntax-table)
(modify-syntax-entry ?% "." S-syntax-table)
(modify-syntax-entry ?< "." S-syntax-table)
(modify-syntax-entry ?> "." S-syntax-table)
(modify-syntax-entry ?& "." S-syntax-table)
(modify-syntax-entry ?| "." S-syntax-table)
(modify-syntax-entry ?\' "\"" S-syntax-table)
(modify-syntax-entry ?\" "\"" S-syntax-table)
(modify-syntax-entry ?# "<" S-syntax-table)
(modify-syntax-entry ?\n ">" S-syntax-table)
(modify-syntax-entry ?. "_" S-syntax-table)
(modify-syntax-entry ?$ "_" S-syntax-table)
(modify-syntax-entry ?@ "_" S-syntax-table)
(modify-syntax-entry ?_ "_" S-syntax-table)
(modify-syntax-entry ?: "_" S-syntax-table)
(modify-syntax-entry ?* "." S-syntax-table)
(modify-syntax-entry ?< "." S-syntax-table)
(modify-syntax-entry ?> "." S-syntax-table)
(modify-syntax-entry ?/ "." S-syntax-table)
S-syntax-table)
"Syntax table for S code."
)
(defvar S-editing-alist
'((paragraph-start . (concat "\\s-*$\\|" page-delimiter))
(paragraph-separate . (concat "\\s-*$\\|" page-delimiter))
(paragraph-ignore-fill-prefix . t)
(require-final-newline . mode-require-final-newline)
(indent-line-function . 'ess-indent-line)
(parse-sexp-ignore-comments . t)
(ess-style . ess-default-style)
(ess-mode-syntax-table . S-syntax-table)
(add-log-current-defun-header-regexp . "^\\(.+\\)\\s-+<-[ \t\n]*function")
(ess-font-lock-keywords . 'ess-S-font-lock-keywords)
(ess-font-lock-defaults . (ess--extract-default-fl-keywords ess-S-font-lock-keywords))
(font-lock-defaults . '(ess-font-lock-defaults
nil nil ((?\. . "w") (?\_ . "w"))))
)
"General options for S and S+ source files.")
(defvar inferior-S-language-start
'(concat "options("
"STERM='" ess-STERM "'"
", str.dendrogram.last=\"'\""
(if ess-editor (concat ", editor='" ess-editor "'"))
(if ess-pager (concat ", pager='" ess-pager "', help.pager='" ess-pager "'"))
", show.error.locations=TRUE"
")")
"S language expression for startup -- default for all S dialects.")
(defconst S-common-cust-alist
'((ess-language . "S")
(inferior-ess-exit-command . "q()\n")
(inferior-ess-language-start . (eval inferior-S-language-start))
(comint-use-prompt-regexp . t)
(comint-process-echoes . t)
(inferior-ess-primary-prompt . "> ")
(inferior-ess-secondary-prompt . "+ ")
(comment-start . "#")
(ess-imenu-generic-expression . ess-imenu-S-generic-expression)
(comment-add . 1)
(comment-start-skip . "#+ *")
(comment-use-syntax . t)
(comment-column . 40)
(ess-no-skip-regexp . (concat "^ *@\\|" (default-value 'ess-no-skip-regexp)))
(inferior-ess-prompt . inferior-S-prompt)
(ess-get-help-topics-function . 'ess-get-S-help-topics-function)
(ess-getwd-command . "getwd()\n")
(ess-setwd-command . "setwd('%s')\n")
(ess-funargs-command . ".ess_funargs(\"%s\")\n")
(fill-nobreak-predicate . 'ess-inside-string-p)
(normal-auto-fill-function . 'ess-do-auto-fill)
)
"S-language common settings for all <dialect>-customize-alist s")
(defconst S+common-cust-alist
(append
'((ess-suffix . "S")
(ess-mode-syntax-table . S-syntax-table)
(ess-help-sec-regex . ess-help-S+-sec-regex)
(ess-help-sec-keys-alist . ess-help-S+sec-keys-alist)
(ess-change-sp-regexp . ess-S+-change-sp-regexp)
(ess-cmd-delay . (if (featurep 'xemacs)
(* 0.1 ess-S+-cmd-delay)
ess-S+-cmd-delay))
(ess-function-pattern . ess-S-function-pattern)
(ess-function-template . " <- \n#\nfunction()\n{\n\n}\n")
(ess-dump-filename-template . (ess-replace-regexp-in-string
"S$" ess-suffix
ess-dump-filename-template-proto))
(ess-traceback-command . "traceback()\n")
(ess-mode-editing-alist . S-editing-alist)
(ess-dumped-missing-re
. "\\(\\(<-\\|=\\)\nDumped\n\\'\\)\\|\\(\\(<-\\|=\\)\\(\\s \\|\n\\)*\\'\\)")
(ess-syntax-error-re
. "\\(Syntax error: .*\\) at line \\([0-9]*\\), file \\(.*\\)$")
(inferior-ess-objects-command . inferior-Splus-objects-command)
(ess-describe-object-at-point-commands . 'ess-S-describe-object-at-point-commands)
(inferior-ess-font-lock-keywords . 'inferior-S-font-lock-keywords)
(ess-editor . S-editor)
(ess-pager . S-pager)
)
S-common-cust-alist)
"Common settings for all S+<*>-customize-alist s"
)
(defconst ess-help-S+sec-keys-alist
'((?a . "ARGUMENTS:")
(?b . "BACKGROUND:")
(?B . "BUGS:")
(?d . "DESCRIPTION:")
(?D . "DETAILS:")
(?e . "EXAMPLES:")
(?n . "NOTE:")
(?O . "OPTIONAL ARGUMENTS:")
(?R . "REQUIRED ARGUMENTS:")
(?r . "REFERENCES:")
(?s . "SEE ALSO:")
(?S . "SIDE EFFECTS:")
(?u . "USAGE:")
(?v . "VALUE:"))
"Alist of (key . string) pairs for use in section searching.")
(defconst ess-help-S3-sec-keys-alist
'((?a . "ARGUMENTS:")
(?b . "BACKGROUND:")
(?B . "BUGS:")
(?d . "DESCRIPTION:")
(?D . "DETAILS:")
(?e . "EXAMPLES:")
(?n . "NOTE:")
(?r . "REFERENCES:")
(?s . "SEE ALSO:")
(?S . "SIDE EFFECTS:")
(?u . "USAGE:")
(?v . "VALUE:"))
"Help section keys for S ver.3.")
(defconst ess-help-S4-sec-keys-alist
'((?a . "ARGUMENTS:")
(?b . "BACKGROUND:")
(?B . "BUGS:")
(?d . "DESCRIPTION:")
(?D . "DETAILS:")
(?e . "EXAMPLES:")
(?n . "NOTE:")
(?r . "REFERENCES:")
(?s . "SEE ALSO:")
(?S . "SIDE EFFECTS:")
(?u . "USAGE:")
(?v . "VALUE:"))
"Help section keys for S4.")
(defconst ess-help-R-sec-keys-alist
'((?a . "\\s *Arguments:")
(?d . "\\s *Description:")
(?D . "\\s *Details:")
(?t . "\\s *Details:")
(?e . "\\s *Examples:")
(?n . "\\s *Note:")
(?r . "\\s *References:")
(?s . "\\s *See Also:")
(?u . "\\s *Usage:")
(?v . "\\s *Value[s]?")
)
"Alist of (key . string) pairs for use in help section searching.")
(defconst ess-help-S+-sec-regex "^[A-Z. ---]+:$"
"Reg(ular) Ex(pression) of section headers in help file.")
(defconst ess-help-R-sec-regex "^[A-Z][A-Za-z].+:$"
"Reg(ular) Ex(pression) of section headers in help file.")
(defvar ess-function-outline-file
(concat ess-etc-directory "/function-outline.S")
"The file name of the ess-function outline that is to be inserted at point,
when \\[ess-insert-function-outline] is used.
Placeholders (substituted `at runtime'): $A$ for `Author', $D$ for `Date'.")
(let ((outline-file (concat (getenv "HOME") "/S/function-outline.S")))
(if (file-exists-p outline-file)
(setq ess-function-outline-file outline-file)))
(defvar ess-S-assign-key [?\C-=]
"This key is mapped to insert `ess-S-assign' (by default '<-'),
when \\[ess-toggle-S-assign-key] is called.")
(defvar ess-S-assign-key-last nil
"This caches the previous value (binding) of `ess-S-assign-key'. It allows
\\[ess-toggle-S-assign-key] to toggle back to the previous definition.")
(defun S-comment-indent ()
"Indentation for S comments."
(if (or (looking-at "###")
(and (looking-at "#!") (= 1 (line-number-at-pos))))
(current-column)
(if (looking-at "##")
(let ((tem (ess-calculate-indent)))
(if (listp tem) (car tem) tem))
(skip-chars-backward " \t")
(max (if (bolp) 0 (1+ (current-column)))
comment-column))))
(defun ess-insert-function-outline ()
"Insert an S function definition `outline' at point.
Uses the file given by the variable `ess-function-outline-file'."
(interactive)
(let ((oldpos (point)))
(save-excursion
(insert-file-contents ess-function-outline-file)
(if (search-forward "$A$" nil t)
(replace-match (user-full-name) 'not-upcase 'literal))
(goto-char oldpos)
(if (search-forward "$D$" nil t)
(replace-match (ess-time-string 'clock) 'not-upcase 'literal)))
(goto-char (1+ oldpos))))
(defun ess-use-this-dir (&optional no-force-current)
"Synchronise the current directory of the S or R process to the one of the current
buffer. If that buffer has no associated *R* process, use \\[ess-force-buffer-current],
unless prefix argument NO-FORCE-CURRENT is non-nil."
(interactive "P")
(unless no-force-current (ess-force-buffer-current "R process to use: "))
(if ess-local-process-name
(let ((cmd (format "setwd('%s')\n" default-directory))
)
(unless (string= ess-language "S")
(error
"ESS setting working directory in *%s* not yet implemented for language %s"
ess-local-process-name ess-language))
(ess-command cmd)
(message "Directory of *%s* process set to %s"
ess-local-process-name default-directory))
(message "No *%s* process associated with this buffer." ess-dialect)))
(defun ess-fix-comments (&optional dont-query verbose)
"Fix ess-mode buffer so that single-line comments start with at least '##',
and ensure space before subsequent text."
(interactive "P")
(ess-replace-regexp-dump-to-src "#\\([A-Za-z0-9]\\)" "# \\1" nil verbose)
(ess-replace-regexp-dump-to-src "^\\([ \t]*#\\)\\([^#]\\)"
"\\1#\\2" dont-query verbose))
(defun ess-dump-to-src (&optional dont-query verbose)
"Make the changes in an S - dump() file to improve human readability."
(interactive "P")
(ess-replace-regexp-dump-to-src "^\"\\([a-z.][a-z.0-9]*\\)\" *<-\n"
"\n\\1 <- "
dont-query verbose 'ensure-ess))
(defun ess-num-var-round (&optional dont-query verbose)
"Is VERY useful for dump(.)'ed numeric variables; ROUND some of them by
replacing endings of 000000*.. and 999999*. Martin Maechler"
(interactive "P")
(save-excursion
(goto-char (point-min))
(let ((num 0)
(str "")
(rgxp "000000+[1-9]?[1-9]?\\>")
(to ""))
(if dont-query
(ess-rep-regexp rgxp to nil nil verbose)
(query-replace-regexp rgxp to nil))
(while (< num 9)
(setq str (concat (int-to-string num) "999999+[0-8]*"))
(if (and (numberp verbose) (> verbose 1))
(message (format "\nregexp: '%s'" str)))
(goto-char (point-min))
(ess-rep-regexp str (int-to-string (1+ num))
'fixedcase 'literal verbose)
(setq num (1+ num))))))
(defun ess-fix-dot (before-chars &optional dont-query verbose)
"Remove trailing decimal '.' (\"dot\"), before BEFORE; typically from S-plus"
(ess-replace-regexp-dump-to-src
(concat "\\([0-9]\\)\\.\\( *[" before-chars "]\\)")
"\\1\\2" dont-query verbose))
(defun ess-fix-dot-1 (&optional do-query verbose)
"Remove trailing decimal '.' (\"dot\"), before ':' or ']', i.e.,
in cases where it's ugly and nonsense. DO-QUERY(prefix) asks before replacing."
(interactive "P")
(ess-fix-dot "]:" (not do-query) verbose))
(defun ess-fix-dot-more (&optional dont-query verbose)
"Remove trailing decimal '.' (\"dot\", typically from S+) in more cases
than `ess-fix-dot-1'."
(interactive "P")
(ess-fix-dot-1 nil verbose)
(ess-fix-dot ",)" dont-query verbose))
(defun ess-fix-EQ-assign (&optional dont-query verbose not-all)
"Replace \"=\" by \"<-\" in places where it 'might make sense', e.g.,
for function assignments and lines not ending in \",\".
Be *careful* for list()s of functions and when argument not-all is
nil (as by default) !"
(interactive "P")
(ess-replace-regexp-dump-to-src
"^\\( *[a-z.][_a-z.0-9]*\\) *= *\\(function *(\\)"
"\\1 <- \\2" dont-query verbose)
(unless not-all
(ess-replace-regexp-dump-to-src
"^\\( *[a-z.][][, \"_a-z.0-9]*\\) *= *\\([a-z.0-9({]\\(.*[^,]\\)? *$\\)"
"\\1 <- \\2" nil
verbose)
))
(defun ess-MM-fix-src (&optional dont-query verbose)
"Clean up ess-source code which has been produced by dump(..), and other
code typically produced by other tools. Produces more readable code,
and one that is well formatted in emacs ess-mode."
(interactive "P")
(ess-dump-to-src dont-query)
(ess-fix-comments dont-query)
(ess-num-var-round dont-query verbose)
(ess-fix-dot-more dont-query verbose)
(ess-fix-EQ-assign dont-query verbose 'not-all)
)
(defun ess-fix-miscellaneous (&optional from verbose)
"Fix Miscellaneous S/R `ill-formation's from current \\[point].
Particularly use \"<-\"and put spaces around operators."
(interactive "d\nP")
(ess-if-verbose-write
(format "ess-fix-misc begin (from = %s, verbose = %s)\n" from verbose))
(save-excursion
(if (string= ess-dialect "R")
(progn
(require 'ess-r-d)
(R-fix-T-F from (not verbose))))
(ess-if-verbose-write "ess-fix-misc: after fix-T-F\n")
(goto-char from) (ess-rep-regexp ";\\( *\\)#" "\\1#" nil nil verbose)
(ess-if-verbose-write "ess-fix-misc: after ';' before #\n")
(ess-if-verbose-write "ess-fix-misc: before 'around \"<-\"' :\n")
(goto-char from)
(ess-rep-regexp "\\([^< \t\n]\\)\\(<<?-\\)" "\\1 \\2" nil nil verbose)
(goto-char from)(ess-rep-regexp "<-\\([^ \t\n]\\)" "<- \\1" nil nil verbose)
(goto-char from)
(ess-rep-regexp "\\([^-< \t\n]\\)\\([<>]\\)" "\\1 \\2" nil nil verbose)
(goto-char from)
(ess-rep-regexp "\\(>=?\\)\\([^= \t\n]\\)" "\\1 \\2" nil nil verbose)
(goto-char from)
(ess-rep-regexp "\\(<=?\\)\\([^-<= \t\n]\\)" "\\1 \\2" nil nil t)
(ess-if-verbose-write "ess-fix-misc: before \"=\" \"==\" .. :\n")
(goto-char from)
(ess-rep-regexp "\\([^=!<> ]\\)\\([=!]?\\)=" "\\1 \\2=" nil nil verbose)
(goto-char from) (ess-rep-regexp "=\\([^= ]\\)" "= \\1" nil nil verbose)
(goto-char from)
(ess-rep-regexp "{\\([.A-Za-z()]\\)" "{ \\1" 'fix nil verbose)
(ess-rep-regexp "\\([()]\\){" "\\1 {" 'fix nil verbose)
(goto-char from)
(ess-rep-regexp "\\([A-Za-z0-9()]\\)}" "\\1 }" 'fix nil verbose)
(ess-space-around "else" from verbose)
(ess-if-verbose-write "ess-fix-misc: after \"{ ... }\" :\n")
(goto-char from)
(ess-rep-regexp "){" ") {" 'fix nil verbose)
(goto-char from)
(ess-rep-regexp "^\\([^#{\n]*[^#{ \t\n]+[ \t]*\\)}[ \t]*$"
"\\1\n}" 'fix nil verbose)
(ess-if-verbose-write "ess-fix-misc __end__\n")
))
(defun ess-toggle-S-assign-key (force)
"Possibly bind the key in `ess-S-assign-key' to inserting `ess-S-assign'.
If `ess-S-assign-key' is \"_\", simply use \\[ess-toggle-underscore].
Otherwise, unless the prefix argument FORCE is set,
toggle between the new and the previous assignment."
(interactive "P")
(require 'ess-mode)
(require 'ess-inf)
(let ((current-action (lookup-key ess-mode-map ess-S-assign-key))
(insert-S-assign (lambda() (interactive)
(delete-horizontal-space) (insert ess-S-assign))))
(if (and (stringp ess-S-assign-key)
(string= ess-S-assign-key "_"))
(ess-toggle-underscore force)
(let* ((current-is-S-assign (eq current-action insert-S-assign))
(new-action (if force insert-S-assign
(if (or current-is-S-assign
(eq ess-S-assign-key-last insert-S-assign))
ess-S-assign-key-last
insert-S-assign))))
(message "[ess-toggle-S-assign-key:] current: '%s', new: '%s'"
current-action new-action)
(define-key ess-mode-map ess-S-assign-key new-action)
(define-key inferior-ess-mode-map ess-S-assign-key new-action)
(if (not (and force current-is-S-assign))
(setq ess-S-assign-key-last current-action))))))
(defvar polymode-mode)
(defun ess-smart-S-assign ()
"Smart \\[ess-smart-S-assign] key: insert `ess-S-assign', unless in string/comment.
If the underscore key is pressed a second time, the assignment
operator is removed and replaced by the underscore. `ess-S-assign',
typically \" <- \", can be customized. In ESS modes other than R/S,
the underscore is always inserted. "
(interactive)
(save-restriction
(ignore-errors
(when (and (eq major-mode 'inferior-ess-mode)
(> (point) (process-mark (get-buffer-process (current-buffer)))))
(narrow-to-region (process-mark (ess-get-process)) (point-max)))
(and ess-noweb-mode
(ess-noweb-in-code-chunk)
(ess-noweb-narrow-to-chunk))
(and (fboundp 'pm/narrow-to-span)
polymode-mode
(pm/narrow-to-span)))
(if (or
(ess-inside-string-or-comment-p (point))
(not (equal ess-language "S")))
(insert ess-smart-S-assign-key)
(ess-insert-S-assign))))
(defalias 'ess-smart-underscore 'ess-smart-S-assign)
(defun ess-insert-S-assign ()
"Insert the assignment operator `ess-S-assign', unless it is already there.
In that case, the it is removed and replaced by
`ess-smart-S-assign-key', \\[ess-smart-S-assign-key].
`ess-S-assign', typically \" <- \", can be customized."
(interactive)
(let ((assign-len (length ess-S-assign)))
(if (and
(>= (point) (+ assign-len (point-min)))
(save-excursion
(backward-char assign-len)
(looking-at ess-S-assign)))
(progn
(delete-char (- assign-len))
(insert ess-smart-S-assign-key))
(if (string= ess-smart-S-assign-key "_")
(delete-horizontal-space))
(insert ess-S-assign))))
(defun ess-toggle-S-assign (force)
"Set the `ess-smart-S-assign-key' (by default \"_\"
[underscore]) key to \\[ess-smart-S-assign] or back to
`ess-smart-S-assign-key'. Toggle the current definition, unless
FORCE is non-nil, where \\[ess-smart-S-assign] is set
unconditionally.
If you as per default have `ess-smart-S-assign-key' set to
underscore, note that using \"C-q _\" will always just insert the
underscore character."
(interactive "P")
(let ((current-key (lookup-key ess-mode-map ess-smart-S-assign-key))
(default-key (lookup-key ess-mode-map "_"))
)
(if (and (or default-key current-key)
(not force))
(progn
(define-key ess-mode-map "_" nil)
(define-key inferior-ess-mode-map "_" nil)
(define-key ess-mode-map ess-smart-S-assign-key nil)
(define-key inferior-ess-mode-map ess-smart-S-assign-key nil))
(define-key ess-mode-map ess-smart-S-assign-key
'ess-smart-S-assign)
(define-key inferior-ess-mode-map ess-smart-S-assign-key
'ess-smart-S-assign))))
(defalias 'ess-toggle-underscore 'ess-toggle-S-assign)
(ess-toggle-S-assign 'force-to-S-assign)
(defun ess-add-MM-keys ()
"Define MM's user keys, currently \\<ess-mode-map>\\[ess-insert-function-outline], and
\\<inferior-ess-mode-map>\\[ess-execute-screen-options]."
(interactive)
(require 'ess-mode)
(require 'ess-inf)
(define-key ess-mode-map "\C-cf" 'ess-insert-function-outline)
(define-key inferior-ess-mode-map "\C-cw" 'ess-execute-screen-options)
(define-key ess-mode-map [?\M--] 'ess-insert-S-assign)
(define-key inferior-ess-mode-map [?\M--] 'ess-insert-S-assign)
)
(defun ess-dump-args-and-go (Sfunc)
"Dump the function name, with arguments, to a buffer for editing.
Currently, this needs to:
1. set the buffer to the right mode, with the right settings
2. format the statement,
3. c/function/Sfunc/
and I need to relearn emacs lisp (but I had to, anyway."
(interactive "sFunction ? ")
(let* ((buffname "ess-complete.R")
(buf (ess-execute (format "args(%s)" Sfunc) t buffname)))
(pop-to-buffer buf)
(message "here yet?")
(while (search-forward "function" nil t)
(replace-match Sfunc nil t))
(ess-setq-vars-local ess-customize-alist)
(setq major-mode 'ess-mode)
(use-local-map ess-mode-map)
(set-syntax-table ess-mode-syntax-table)
))
(defvar ess-imenu-S-generic-expression
'(("Functions" "^\\(.+\\)[ \t\n]*<-[ \t\n]*function[ ]*(" 1)
("Classes" "^.*setClass(\\(.*\\)," 1)
("Coercions" "^.*setAs(\\([^,]+,[^,]*\\)," 1)
("Generics" "^.*setGeneric(\\([^,]*\\)," 1)
("Methods" "^.*set\\(Group\\|Replace\\)?Method(\\([^,]+,[^,]*\\)" 2)
("Package" "^.*\\(library\\|require\\)(\\(.*\\)" 2)
("Data" "^\\(.+\\)[ \t\n]-*<-[ \t\n]*\\(read\\|.*data\.frame\\).*(" 1)))
(defun ess-imenu-S (&optional arg)
"S Language Imenu support for ESS."
(interactive)
(setq imenu-generic-expression ess-imenu-generic-expression)
(imenu-add-to-menubar "Imenu-S"))
(defalias 'ess-imenu-R 'ess-imenu-S)
(defun ess-S-initialize-speedbar ()
"Extend to all extensions; see initialization, and edit."
(speedbar-add-supported-extension ".R")
(speedbar-add-supported-extension ".S")
(speedbar-add-supported-extension ".s")
(speedbar-add-supported-extension ".q"))
(eval-when-compile
(condition-case nil
(progn
(require 'speedbar)
(when (featurep 'speedbar)
(message "enabling speedbar support")
(defun S-speedbar-buttons (buffer)
"attempted hack."
(speedbar-with-writable))
(fset 'R-speedbar-buttons 'S-speedbar-buttons)
(defun S-speedbar-menu-items ( )
"Need to write.")
(ess-S-initialize-speedbar)))
(error nil)))
(provide 'ess-s-l)