Klimi's new dotfiles with stow.
25'ten fazla konu seçemezsiniz Konular bir harf veya rakamla başlamalı, kısa çizgiler ('-') içerebilir ve en fazla 35 karakter uzunluğunda olabilir.
 
 
 
 
 
 

2784 satır
115 KiB

;;; ess-r-mode.el --- R customization
;; Copyright (C) 1997--2010 A.J. Rossini, Richard M. Heiberger, Martin
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
;; Copyright (C) 2011--2017 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
;; Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.
;; Author: A.J. Rossini
;; Created: 12 Jun 1997
;; Maintainer: ESS-core <ESS-core@r-project.org>
;; Keywords: languages, statistics
;; This file is part of ESS.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; A copy of the GNU General Public License is available at
;; https://www.r-project.org/Licenses/
;;; Commentary:
;; This file defines all the R customizations for ESS. See ess-s-lang.el
;; for general S language customizations.
;;; Code:
(eval-when-compile
(require 'subr-x))
(require 'cl-lib)
(require 'compile)
(require 'ess-mode)
(require 'ess-help)
(require 'ess-s-lang)
(require 'ess-roxy)
(require 'ess-r-completion)
(require 'ess-r-syntax)
(require 'ess-r-package)
(require 'ess-trns)
(require 'ess-r-xref)
(when (>= emacs-major-version 26) (require 'ess-r-flymake)) ; Flymake rewrite in Emacs 26
(declare-function ess-rdired "ess-rdired" ())
(define-obsolete-variable-alias 'R-mode-hook 'ess-r-mode-hook "19.04")
(defcustom ess-r-mode-hook nil
"Hook run when entering `ess-r-mode'."
:options '(electric-layout-local-mode)
:type 'hook
:group 'ess-R)
(defcustom ess-r-fetch-ESSR-on-remotes nil
"If non-nil, fetch ESSR from the GitHub repository.
Otherwise source from local ESS installation. When 'ess-remote,
fetch only with `ess-remote'. When t, always fetch from remotes.
Change this variable when loading ESSR code on remotes fails
systematically.
Fetching happens once per new ESSR version. The archive is stored
in ~/.config/ESSR/ folder. You can download and place it there
manually if the remote has restricted network access."
:type '(choice (const nil :tag "Never")
(const 'ess-remote :tag "With ess-remote only")
(const t :tag "Always"))
:group 'ess-R)
;; Silence the byte compiler
(defvar add-log-current-defun-header-regexp)
;; TODO: Refactor so as to not rely on dynamic scoping. After that
;; refactor, also remove the file-local-variable byte-compile-warnings
;; (not lexical) at the bottom.
(defvar block)
(defvar containing-sexp)
(defvar indent-point)
(defvar infinite)
(defvar last-newline)
(defvar last-pos)
(defvar offset)
(defvar prefix-break)
(defvar prev-containing-sexp)
(defvar start-pos)
(defvar style)
(defvar type)
(define-obsolete-variable-alias 'ess-r-versions 'ess-r-runner-prefixes "ESS 19.04")
(defcustom ess-r-runner-prefixes
(let ((r-ver '("R-1" "R-2" "R-3" "R-devel" "R-patched")))
(if (eq system-type 'darwin) (append r-ver '("R32" "R64")) r-ver))
"List of partial strings for versions of R to access within ESS.
Each string specifies the start of a filename. If a filename
beginning with one of these strings is found on variable
`exec-path', a command for that version of R is made available.
For example, if the file \"R-1.8.1\" is found and this variable
includes the string \"R-1\", a function called `R-1.8.1' will be
available to run that version of R. If duplicate versions of the
same program are found (which happens if the same path is listed
on variable `exec-path' more than once), they are ignored by
calling `delete-dups'. Set this variable to nil to disable
searching for other versions of R. Setting this variable directly
does not take effect; use either \\[customize-option] or set the
value by using `ess-r-runners-reset'."
:group 'ess-R
:type '(repeat string)
:set #'ess-r-runners-reset
;; Use `custom-initialize-default' since we call
;; `ess-r-define-runners' at the end of this file directly.
:initialize #'custom-initialize-default)
;;*;; Mode definition
;;;*;;; UI (Keymaps / Menus)
(defvar ess-dev-map
(let (ess-dev-map)
(define-prefix-command 'ess-dev-map)
(define-key ess-dev-map "\C-s" #'ess-r-set-evaluation-env)
(define-key ess-dev-map "s" #'ess-r-set-evaluation-env)
(define-key ess-dev-map "T" #'ess-toggle-tracebug)
(define-key ess-dev-map "\C-l" #'ess-r-devtools-load-package)
(define-key ess-dev-map "l" #'ess-r-devtools-load-package)
(define-key ess-dev-map "`" #'ess-show-traceback)
(define-key ess-dev-map "~" #'ess-show-call-stack)
(define-key ess-dev-map "\C-w" #'ess-watch)
(define-key ess-dev-map "w" #'ess-watch)
(define-key ess-dev-map "\C-d" #'ess-debug-flag-for-debugging)
(define-key ess-dev-map "d" #'ess-debug-flag-for-debugging)
(define-key ess-dev-map "\C-u" #'ess-debug-unflag-for-debugging)
(define-key ess-dev-map "u" #'ess-debug-unflag-for-debugging)
(define-key ess-dev-map "" #'ess-debug-unflag-for-debugging)
(define-key ess-dev-map "\C-b" #'ess-bp-set)
(define-key ess-dev-map "b" #'ess-bp-set)
(define-key ess-dev-map "" #'ess-bp-set-conditional)
(define-key ess-dev-map "B" #'ess-bp-set-conditional)
(define-key ess-dev-map "\C-L" #'ess-bp-set-logger)
(define-key ess-dev-map "L" #'ess-bp-set-logger)
(define-key ess-dev-map "\C-o" #'ess-bp-toggle-state)
(define-key ess-dev-map "o" #'ess-bp-toggle-state)
(define-key ess-dev-map "\C-k" #'ess-bp-kill)
(define-key ess-dev-map "k" #'ess-bp-kill)
(define-key ess-dev-map "\C-K" #'ess-bp-kill-all)
(define-key ess-dev-map "K" #'ess-bp-kill-all)
(define-key ess-dev-map "\C-n" #'ess-bp-next)
(define-key ess-dev-map "n" #'ess-bp-next)
(define-key ess-dev-map "i" #'ess-debug-goto-input-event-marker)
(define-key ess-dev-map "I" #'ess-debug-goto-input-event-marker)
(define-key ess-dev-map "\C-p" #'ess-bp-previous)
(define-key ess-dev-map "p" #'ess-bp-previous)
(define-key ess-dev-map "\C-e" #'ess-debug-toggle-error-action)
(define-key ess-dev-map "e" #'ess-debug-toggle-error-action)
(define-key ess-dev-map "0" #'ess-electric-selection)
(define-key ess-dev-map "1" #'ess-electric-selection)
(define-key ess-dev-map "2" #'ess-electric-selection)
(define-key ess-dev-map "3" #'ess-electric-selection)
(define-key ess-dev-map "4" #'ess-electric-selection)
(define-key ess-dev-map "5" #'ess-electric-selection)
(define-key ess-dev-map "6" #'ess-electric-selection)
(define-key ess-dev-map "7" #'ess-electric-selection)
(define-key ess-dev-map "8" #'ess-electric-selection)
(define-key ess-dev-map "9" #'ess-electric-selection)
(define-key ess-dev-map "?" #'ess-tracebug-show-help)
ess-dev-map)
"Keymap for commands related to development and debugging.")
(defvar ess-r-package-check-map
(let (ess-r-package-check-map)
(define-prefix-command 'ess-r-package-check-map)
(define-key ess-r-package-check-map "\C-c" #'ess-r-devtools-check-package)
(define-key ess-r-package-check-map "c" #'ess-r-devtools-check-package)
(define-key ess-r-package-check-map "\C-w" #'ess-r-devtools-check-with-winbuilder)
(define-key ess-r-package-check-map "w" #'ess-r-devtools-check-with-winbuilder)
(define-key ess-r-package-check-map "h" #'ess-r-rhub-check-package)
ess-r-package-check-map)
"Keymap for R package checks.")
(defvar ess-r-package-dev-map
(let (ess-r-package-dev-map)
(define-prefix-command 'ess-r-package-dev-map)
(define-key ess-r-package-dev-map "\C-s" #'ess-r-set-evaluation-env)
(define-key ess-r-package-dev-map "s" #'ess-r-set-evaluation-env)
(define-key ess-r-package-dev-map "\C-a" #'ess-r-devtools-execute-command)
(define-key ess-r-package-dev-map "a" #'ess-r-devtools-execute-command)
(define-key ess-r-package-dev-map "\C-e" #'ess-r-devtools-execute-command)
(define-key ess-r-package-dev-map "e" #'ess-r-devtools-execute-command)
(define-key ess-r-package-dev-map "\C-b" #'ess-r-devtools-build)
(define-key ess-r-package-dev-map "b" #'ess-r-devtools-build)
(define-key ess-r-package-dev-map "\C-c" 'ess-r-package-check-map)
(define-key ess-r-package-dev-map "c" 'ess-r-package-check-map)
(define-key ess-r-package-dev-map "\C-d" #'ess-r-devtools-document-package)
(define-key ess-r-package-dev-map "d" #'ess-r-devtools-document-package)
(define-key ess-r-package-dev-map "g" #'ess-r-devtools-install-github)
(define-key ess-r-package-dev-map "\C-i" #'ess-r-devtools-install-package)
(define-key ess-r-package-dev-map "i" #'ess-r-devtools-install-package)
(define-key ess-r-package-dev-map "\C-l" #'ess-r-devtools-load-package)
(define-key ess-r-package-dev-map "l" #'ess-r-devtools-load-package)
(define-key ess-r-package-dev-map "\C-t" #'ess-r-devtools-test-package)
(define-key ess-r-package-dev-map "t" #'ess-r-devtools-test-package)
(define-key ess-r-package-dev-map "\C-u" #'ess-r-devtools-unload-package)
(define-key ess-r-package-dev-map "u" #'ess-r-devtools-unload-package)
ess-r-package-dev-map))
(easy-menu-define ess-roxygen-menu nil
"Roxygen submenu."
'("Roxygen"
:visible (and ess-dialect (string-match "^R" ess-dialect))
["Update/Generate Template" ess-roxy-update-entry t]
["Preview Rd" ess-roxy-preview-Rd t]
["Preview HTML" ess-roxy-preview-HTML t]
["Preview text" ess-roxy-preview-text t]
["Hide all" ess-roxy-hide-all t]
["Toggle Roxygen Prefix" ess-roxy-toggle-roxy-region t]))
(easy-menu-define ess-tracebug-menu nil
"Tracebug submenu."
'("Tracebug"
:visible (and ess-dialect (string-match "^R" ess-dialect))
;; :enable ess-local-process-name
["Active?" ess-toggle-tracebug
:style toggle
:selected (or (and (ess-process-live-p)
(ess-process-get 'tracebug))
ess-use-tracebug)]
["Show traceback" ess-show-traceback (ess-process-live-p)]
["Show call stack" ess-show-call-stack (ess-process-live-p)]
["Watch" ess-watch (and (ess-process-live-p)
(ess-process-get 'tracebug))]
["Error action cycle" ess-debug-toggle-error-action (and (ess-process-live-p)
(ess-process-get 'tracebug))]
"----"
["Flag for debugging" ess-debug-flag-for-debugging ess-local-process-name]
["Unflag for debugging" ess-debug-unflag-for-debugging ess-local-process-name]
"----"
["Set BP" ess-bp-set t]
["Set conditional BP" ess-bp-set-conditional t]
["Set logger BP" ess-bp-set-logger t]
["Kill BP" ess-bp-kill t]
["Kill all BPs" ess-bp-kill-all t]
["Next BP" ess-bp-next t]
["Previous BP" ess-bp-previous t]
"-----"
["About" ess-tracebug-show-help t]))
(easy-menu-define ess-r-package-menu nil
"Package Development submenu."
'("Package development"
:visible (and ess-dialect (string-match "^R" ess-dialect))
["Active?" ess-r-package-mode
:style toggle
:selected ess-r-package-mode]
["Select package for evaluation" ess-r-set-evaluation-env t]))
(easy-menu-add-item ess-mode-menu nil ess-roxygen-menu "end-dev")
(easy-menu-add-item ess-mode-menu nil ess-r-package-menu "end-dev")
(easy-menu-add-item ess-mode-menu nil ess-tracebug-menu "end-dev")
(easy-menu-add-item inferior-ess-mode-menu nil ess-r-package-menu "end-dev")
(easy-menu-add-item inferior-ess-mode-menu nil ess-tracebug-menu "end-dev")
(defvar ess-r-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-=") #'ess-cycle-assign)
(define-key map "\M-?" #'ess-complete-object-name)
(define-key map (kbd "C-c C-.") 'ess-rutils-map)
map))
(defvar ess-r-mode-syntax-table
(let ((table (copy-syntax-table S-syntax-table)))
;; Letting Emacs treat backquoted names and %ops% as strings solves
;; many problems with regard to nested strings and quotes
(modify-syntax-entry ?` "\"" table)
(modify-syntax-entry ?% "\"" table)
;; Underscore is valid in R symbols
(modify-syntax-entry ?_ "_" table)
(modify-syntax-entry ?: "." table)
(modify-syntax-entry ?@ "." table)
(modify-syntax-entry ?$ "." table)
table)
"Syntax table for `ess-r-mode'.")
(defvar ess-r-completion-syntax-table
(let ((table (copy-syntax-table ess-r-mode-syntax-table)))
(modify-syntax-entry ?. "_" table)
(modify-syntax-entry ?: "_" table)
(modify-syntax-entry ?$ "_" table)
(modify-syntax-entry ?@ "_" table)
table)
"Syntax table used for completion and help symbol lookup.
It makes underscores and dots word constituent chars.")
(defvar ess-r-namespaced-load-verbose t
"Whether to display information on namespaced loading.
When t, loading a file into a namespaced will output information
about which objects are exported and which stay hidden in the
namespace.")
(defun ess-r-font-lock-syntactic-face-function (state)
(if (nth 3 state)
;; string case
(let ((string-end (save-excursion
(ess-goto-char (nth 8 state))
(ess-forward-sexp)
(point))))
(cond
((eq (nth 3 state) ?%)
(if (eq (point) (1- string-end))
(when (cdr (assq 'ess-fl-keyword:operators ess-R-font-lock-keywords))
'ess-operator-face)
(if (cdr (assq 'ess-R-fl-keyword:%op% ess-R-font-lock-keywords))
'ess-%op%-face
'default)))
((save-excursion
(and (cdr (assq 'ess-R-fl-keyword:fun-defs ess-R-font-lock-keywords))
(ess-goto-char string-end)
(ess-looking-at "<-")
(ess-goto-char (match-end 0))
(ess-looking-at "function\\b" t)))
font-lock-function-name-face)
((save-excursion
(and (cdr (assq 'ess-fl-keyword:fun-calls ess-R-font-lock-keywords))
(ess-goto-char string-end)
(ess-looking-at "(")))
ess-function-call-face)
((eq (nth 3 state) ?`)
'default)
(t
font-lock-string-face)))
font-lock-comment-face))
(defvar ess-r--non-fn-kwds
'("in" "else" "break" "next" "repeat"))
(defvar-local ess-r--keyword-regexp nil)
(defun ess-r--find-fl-keyword (limit)
"Search for R keyword and set the match data.
To be used as part of `font-lock-defaults' keywords."
(unless ess-r--keyword-regexp
(let (fn-kwds non-fn-kwds)
(dolist (kw ess-R-keywords)
(if (member kw ess-r--non-fn-kwds)
(push kw non-fn-kwds)
(push kw fn-kwds)))
(setq ess-r--keyword-regexp
(concat "\\("
(regexp-opt non-fn-kwds 'words)
"\\)\\|\\("
(regexp-opt fn-kwds 'words)
"\\)"))))
(let (out)
(while (and (not out)
(re-search-forward ess-r--keyword-regexp limit t))
(save-match-data
(setq out (if (match-beginning 1)
;; Non-function-like keywords: Always fontified
;; except for `in` for which we check it's part
;; of a `for` construct. Ideally we'd check that
;; other keywords like `break` or `next` are
;; part of the right syntactic construct but
;; that requires robust and efficient detection
;; of complete expressions.
(if (string= (match-string 1) "in")
(save-excursion
(goto-char (match-beginning 1))
(and (ess-backward-up-list)
(forward-word -1)
(looking-at "for\\s-*(")))
t)
;; Function-like keywords: check if they are
;; followed by an open paren
(looking-at "\\s-*(")))))
out))
(define-obsolete-variable-alias 'R-customize-alist 'ess-r-customize-alist "ESS 18.10.2")
(defvar ess-r-customize-alist
(append
'((ess-local-customize-alist . 'ess-r-customize-alist)
(ess-dialect . "R")
(ess-suffix . "R")
(ess-traceback-command . ess-r-traceback-command)
(ess-call-stack-command . ess-r-call-stack-command)
(ess-mode-completion-syntax-table . ess-r-completion-syntax-table)
(ess-build-eval-message-function . #'ess-r-build-eval-message)
(ess-dump-filename-template . ess-r-dump-filename-template)
(ess-change-sp-regexp . ess-r-change-sp-regexp)
(ess-help-sec-regex . ess-help-r-sec-regex)
(ess-help-sec-keys-alist . ess-help-r-sec-keys-alist)
(ess-function-pattern . ess-r-function-pattern)
(ess-object-name-db-file . "ess-r-namedb.el")
(ess-smart-operators . ess-r-smart-operators)
(inferior-ess-program . inferior-ess-r-program)
(inferior-ess-objects-command . inferior-ess-r-objects-command)
(inferior-ess-search-list-command . "search()\n")
(inferior-ess-help-command . inferior-ess-r-help-command)
(inferior-ess-exit-command . "q()")
(ess-error-regexp-alist . ess-r-error-regexp-alist)
(ess-describe-object-at-point-commands . 'ess-r-describe-object-at-point-commands)
(ess-STERM . "iESS")
(ess-editor . ess-r-editor)
(ess-pager . ess-r-pager))
S-common-cust-alist)
"Variables to customize for R.")
(cl-defmethod ess-build-tags-command (&context (ess-dialect "R"))
"Return tags command for R."
"rtags('%s', recursive = TRUE, pattern = '\\\\.[RrSs](rw)?$',ofile = '%s')")
(defvar ess-r-traceback-command
"local({cat(geterrmessage(), \
'---------------------------------- \n', \
fill=TRUE); try(traceback(), silent=TRUE)})\n")
(defvar ess-r-call-stack-command "traceback(1)\n")
(defvar ess-r-dump-filename-template
(replace-regexp-in-string
"S$" "R" ess-dump-filename-template-proto))
(defvar ess-r-ac-sources
'(ac-source-R))
(defvar ess-r-company-backends
'((company-R-library company-R-args company-R-objects :separate)))
(defconst ess-help-r-sec-regex "^[A-Z][A-Za-z].+:$"
"Reg(ular) Ex(pression) of section headers in help file.")
(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.")
(defvar ess-r-error-regexp-alist '(R R1 R2 R3 R4 R-recover)
"List of symbols which are looked up in `compilation-error-regexp-alist-alist'.")
(dolist (l '(;; Takes precedence over R1 below in English locales, and allows spaces in file path
(R "\\(\\(?: at \\|(@\\)\\([^#()\n]+\\)[#:]\\([0-9]+\\)\\)" 2 3 nil 2 1)
;; valgrind style (stl_numeric.h:183)
(R1 "(\\([^ ):\n]+\\):\\([0-9]+\\)?)" 1 2 nil 2)
(R2 "(\\(\\w+ \\([^())\n]+\\)#\\([0-9]+\\)\\))" 2 3 nil 2 1)
;; Precedes R4 and allows spaces in file path, Starts at bol or with ": " (patterns 3,4,5,6,9)
(R3 "\\(?:^ *\\|: ?\\)\\([^-+[:digit:] \t\n]:?[^: \t\n]*\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\)?" 1 2 3 2 1)
;; Don't start with digit; no spaces
(R4 "\\([^-+ [:digit:]][^: \t\n]+\\):\\([0-9]+\\):\\([0-9]+\\):" 1 2 3 2 1)
(R-recover " *[0-9]+: +\\([^:\n\t]+?\\)#\\([0-9]+:\\)" 1 2 nil 2 1)))
(cl-pushnew l compilation-error-regexp-alist-alist))
(define-obsolete-variable-alias 'ess-r-versions-created 'ess-r-created-runners "ESS 18.10")
(defvar ess-r-created-runners nil
"List of R-versions found from `ess-r-runner-prefixes' on the system.")
;;;*;;; Mode init
(define-obsolete-variable-alias 'ess-R-post-run-hook 'ess-r-post-run-hook "ESS 18.10.2")
(defvar ess-r-post-run-hook nil
"Functions run in process buffer after the initialization of R process.")
;;;###autoload
(defun run-ess-r (&optional start-args)
"Call 'R', the 'GNU S' system from the R Foundation.
Optional prefix (\\[universal-argument]) allows to set command line arguments, such as
--vsize. This should be OS agnostic.
If you have certain command line arguments that should always be passed
to R, put them in the variable `inferior-R-args'.
START-ARGS can be a string representing an argument, a list of
such strings, or any other non-nil value. In the latter case, you
will be prompted to enter arguments interactively."
(interactive "P")
(ess-write-to-dribble-buffer ;; for debugging only
(format
"\n(R): ess-dialect=%s, buf=%s, start-arg=%s\n current-prefix-arg=%s\n"
ess-dialect (current-buffer) start-args current-prefix-arg))
(unless (or (file-remote-p default-directory)
(and ess-startup-directory
(file-remote-p ess-startup-directory))
;; TODO: Once we drop Emacs 26 support, can probably
;; just use the REMOTE argument of `executable-find'.
(executable-find inferior-ess-r-program))
(display-warning 'ess (format "%s could not be found on the system. Try running `run-ess-r-newest' instead, which searches your system for R." inferior-ess-r-program) :error)
(user-error "%s program not found" inferior-ess-r-program))
(let* ((r-always-arg
(if (or ess-microsoft-p (eq system-type 'cygwin))
"--ess "
;; else: "Unix alike"
(if (not ess-R-readline) "--no-readline ")))
(start-args
(cond ((stringp start-args)
start-args)
((and start-args
(listp start-args)
(cl-every 'stringp start-args))
(mapconcat 'identity start-args " "))
(start-args
(read-string
(concat "Starting Args"
(if r-always-arg
(concat " [other than '" r-always-arg "']"))
" ? ")))))
(r-start-args
(concat r-always-arg
inferior-R-args " " ; add space just in case
start-args))
(debug (string-match-p " -d \\| --debugger=" r-start-args))
use-dialog-box)
(when (or ess-microsoft-p
(eq system-type 'cygwin))
(setq use-dialog-box nil)
(when ess-microsoft-p ;; default-process-coding-system would break UTF locales on Unix
(setq default-process-coding-system '(undecided-dos . undecided-dos))))
(let ((inf-buf (inferior-ess r-start-args ess-r-customize-alist debug)))
(with-current-buffer inf-buf
(ess-process-put 'funargs-pre-cache ess-r--funargs-pre-cache)
(if debug
(progn
;; We need to use callback, because R might start with a gdb process
(ess-process-put 'callbacks '(inferior-ess-r--init-callback))
;; Trigger the callback
(process-send-string (get-buffer-process inf-buf) "r\n"))
(ess-wait-for-process)
(R-initialize-on-start)
(comint-goto-process-mark))
(ess-write-to-dribble-buffer
(format "(R): inferior-ess-language-start=%s\n"
inferior-ess-language-start)))
;; FIXME: Current ob-R expects current buffer set to process buffer
(set-buffer inf-buf))))
;;;###autoload
(defalias 'R #'run-ess-r)
(defun inferior-ess-r--adjust-startup-directory (dir dialect)
"Adjust startup directory DIR if DIALECT is R.
If in a package project, prefer the tests directory but only if
the package directory was selected in the first place."
(if (string= dialect "R")
(let* ((project-dir (cdr (ess-r-package-project)))
(tests-dir (expand-file-name (file-name-as-directory "tests")
project-dir)))
(if (and project-dir
(string= project-dir dir)
(string= default-directory tests-dir))
tests-dir
dir))
dir))
(defun inferior-ess-r--init-callback (_proc _name)
(R-initialize-on-start))
(defun R-initialize-on-start ()
"This function is run after the first R prompt.
Executed in process buffer."
(ess-command (format
"if(identical(getOption('pager'),
file.path(R.home(), 'bin', 'pager')))
options(pager='%s')\n"
inferior-ess-pager))
(ess-r-load-ESSR)
(when inferior-ess-language-start
(ess-command (concat inferior-ess-language-start "\n")))
;; tracebug
(when ess-use-tracebug (ess-tracebug 1))
(add-hook 'ess-presend-filter-functions 'ess-R-scan-for-library-call nil 'local)
(run-hooks 'ess-r-post-run-hook))
(defun ess-r--skip-function ()
;; Assumes the point is at function start
(if (looking-at-p ess-r-set-function-start)
(forward-list 1) ; get over the entire setXyz(...)
(forward-list 1) ; get over arguments
(if (looking-at-p "[ \t\n]*{")
(forward-sexp 1) ;; move over {...}
;; {..}-less case
(skip-chars-forward " \t\n")
(goto-char (cadr (ess-continuations-bounds))))))
;; `beginning-of-defun' protocol:
;; 1) assumes that defuns are at the top level (e.g. always moves to bol)
(defun ess-r-beginning-of-defun (&optional arg)
"Move to beginning a top level function.
ARG is as in `beginning-of-defun'."
(ess-r-beginning-of-function arg t))
;; `end-of-defun' protocol:
;; 1) Uses beginning-of-defun-function with negative arg
;; 2) Assumes that beginning-of-defun-function with -1 arg finds current defun
;; when point is just in front of the function
(defun ess-r-end-of-defun (&optional arg)
"End of top level function.
ARG is as in `end-of-defun'."
(ess-r-end-of-function arg t))
(defun ess-r-beginning-of-function (&optional arg top-level)
"Leave (and return) the point at the beginning of the current ESS function.
When ARG is positive, search for beginning of function backward,
otherwise forward. Value of ARG is currently ignored. Return the
new position, or nil if no-match. If TOP-LEVEL is non-nil, search
for top-level functions only."
(setq arg (or arg 1))
(let ((start-point (point))
done)
;; In case we are at the start of a function, skip past new lines.
(when (> arg 0)
;; Start search from a forward position in order to capture current
;; function start. But not when arg < 0; see end-of-defun protocol above.
(forward-line 2))
(while (and (not done)
(re-search-backward ess-r-function-pattern nil t arg))
(unless (ess-inside-string-or-comment-p)
(setq done
(if top-level
(= (car (syntax-ppss (match-beginning 0))) 0)
t))
(if (< arg 0)
;; move to match-end to avoid the infloop in re-search-backward
(goto-char (if done (match-beginning 0) (match-end 0)))
;; Backward regexp match stops at the minimal match (e.g. partial
;; function name), so we need a bit more work here.
(beginning-of-line)
(re-search-forward ess-r-function-pattern)
(goto-char (match-beginning 0))
(when (<= start-point (point))
(setq done nil)))))
(if done
(point)
(goto-char start-point)
nil)))
(defun ess-r-end-of-function (&optional arg top-level)
"Leave the point at the end of the current function.
When ARG is positive, search for end of function forward,
otherwise backward. Move to point and return point if search was
successful, otherwise nil. If TOP-LEVEL is non-nil, search for
top level functions only."
(setq arg (or arg 1))
(let* ((start-pos (point))
(search-fn (lambda (lim)
(let ((foundp nil))
(while (and (not foundp)
(re-search-forward ess-r-function-pattern nil t))
(when (< arg 0)
;; re-search-backward is a forward search
;; internally, so we need to bol in order to avoid
;; the infloop
(beginning-of-line))
(setq foundp
(unless (ess-inside-string-or-comment-p)
(if top-level
(= 0 (car (save-excursion (syntax-ppss (match-beginning 0)))))
(>= (point) lim)))))
(if foundp
(progn (goto-char (match-beginning 0))
(ess-r--skip-function))
(goto-char start-pos))))))
(ess-r-beginning-of-function 1 top-level)
(if (< (point) start-pos)
;; Moved back. We were either inside a function or after a function.
(progn
(ess-r--skip-function)
;; For negative ARG we are done.
(when (and (> arg 0)
(<= (point) start-pos))
(funcall search-fn start-pos)))
;; No function before point; search forward on positive ARG.
(when (> arg 0)
(funcall search-fn start-pos)))))
;;;###autoload
(define-derived-mode ess-r-mode ess-mode "ESS[R]"
"Major mode for editing R source. See `ess-mode' for more help."
:group 'ess-R
(ess-setq-vars-local ess-r-customize-alist)
(setq-local ess-font-lock-keywords 'ess-R-font-lock-keywords)
(setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
(setq-local paragraph-separate (concat "\\s-*$\\|" page-delimiter))
(setq-local paragraph-ignore-fill-prefix t)
(setq-local indent-line-function #'ess-r-indent-line)
(setq-local comment-indent-function #'ess-calculate-indent)
(setq-local add-log-current-defun-header-regexp "^\\(.+\\)\\s-+<-[ \t\n]*function")
(setq-local font-lock-syntactic-face-function #'ess-r-font-lock-syntactic-face-function)
(setq-local electric-layout-rules '((?{ . after)))
;; indentation
(add-hook 'hack-local-variables-hook #'ess-set-style nil t)
;; eldoc
(add-function :before-until (local 'eldoc-documentation-function)
#'ess-r-eldoc-function)
(when ess-use-eldoc (eldoc-mode))
;; auto-complete
(ess--setup-auto-complete ess-r-ac-sources)
;; company
(ess--setup-company ess-r-company-backends)
(setq-local prettify-symbols-alist ess-r-prettify-symbols)
(setq font-lock-defaults '(ess-build-font-lock-keywords nil nil ((?\. . "w") (?\_ . "w"))))
(remove-hook 'completion-at-point-functions 'ess-filename-completion 'local) ;; should be first
(add-hook 'completion-at-point-functions 'ess-r-object-completion nil 'local)
(add-hook 'completion-at-point-functions #'ess-r-package-completion nil 'local)
(add-hook 'completion-at-point-functions 'ess-filename-completion nil 'local)
(add-hook 'xref-backend-functions #'ess-r-xref-backend nil 'local)
(if (fboundp 'ess-add-toolbar) (ess-add-toolbar))
;; imenu is needed for `which-function'
(setq imenu-generic-expression ess-imenu-S-generic-expression)
(when ess-imenu-use-S
(imenu-add-to-menubar "Imenu-R"))
(setq-local beginning-of-defun-function #'ess-r-beginning-of-defun)
(setq-local end-of-defun-function #'ess-r-end-of-defun)
(ess-roxy-mode))
;;;###autoload
(defalias 'R-mode 'ess-r-mode)
;;;###autoload
(defalias 'r-mode 'ess-r-mode)
;;;###autoload
(add-to-list 'auto-mode-alist '("/R/.*\\.q\\'" . ess-r-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[rR]\\'" . ess-r-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[rR]profile\\'" . ess-r-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("NAMESPACE\\'" . ess-r-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("CITATION\\'" . ess-r-mode))
;;*;; Miscellaneous
(defun ess-R-arch-2-bit (arch)
"Translate R's architecture shortcuts/directory names to 'bits'.
ARCH \"32\" or \"64\" (for now)."
(if (string= arch "i386") "32"
;; else:
"64"))
(defun ess-rterm-arch-version (long-path &optional give-cons)
"Find a name for LONG-PATH, an absolute path to R on Windows.
Returns either Name, a string, or a (Name . Path) cons, such as
(\"R-2.12.1-64bit\" . \"C:/Program Files/R/R-2.12.1/bin/x64/Rterm.exe\")
\"R-x.y.z/bin/Rterm.exe\" will return \"R-x.y.z\", for R-2.11.x and older.
\"R-x.y.z/bin/i386/Rterm.exe\" will return \"R-x.y.z-32bit\", for R-2.12.x and newer.
\"R-x.y.z/bin/x64/Rterm.exe\" will return \"R-x.y.z-64bit\", for R-2.12.x and newer."
(let* ((dir (directory-file-name (file-name-directory long-path)))
(dir2 (directory-file-name (file-name-directory dir)))
(v-1up (file-name-nondirectory dir));; one level up
(v-2up (file-name-nondirectory dir2));; two levels up; don't want "bin" ...
(v-3up (file-name-nondirectory ;; three levels up; no "bin" for i386, x64 ...
(directory-file-name (file-name-directory dir2))))
(val (if (string= v-2up "bin")
(concat v-3up "-" (ess-R-arch-2-bit v-1up) "bit")
;; pre R-2.12.x, or when there's no extra arch-specific sub directory:
v-2up)))
(if give-cons
(cons val long-path)
val)))
(defun ess-r-define-runners (&optional verbose)
"Generate functions for starting other versions of R.
See `ess-r-runner-prefixes' for strings that determine which functions
are created. On MS Windows, this works using
`ess-rterm-version-paths' instead.
The functions will normally be placed on the menubar and stored
as `ess-r-created-runners' upon ESS initialization."
(when ess-r-runner-prefixes
(let ((versions
;; Find which versions of R we want. Remove the pathname, leaving just
;; the name of the executable.
(if ess-microsoft-p
(mapcar (lambda (v) (car (ess-rterm-arch-version v 'give-cons)))
ess-rterm-version-paths)
(delete-dups
(mapcar #'file-name-nondirectory
(apply #'nconc
(mapcar #'ess-find-exec-completions
ess-r-runner-prefixes)))))))
;; Iterate over each string in VERSIONS, creating a new defun each time.
(setq ess-r-created-runners versions)
(if verbose
(message "Recreated %d R versions known to ESS: %s"
(length versions) versions))
(if ess-microsoft-p
(cl-mapcar (lambda (v p) (ess-define-runner v "R" p)) versions ess-rterm-version-paths)
(mapc (lambda (v) (ess-define-runner v "R")) versions))
;; Add to menu
(when ess-r-created-runners
;; new-menu will be a list of 3-vectors, of the form:
;; ["R-1.8.1" R-1.8.1 t]
(let ((new-menu (mapcar (lambda(x) (vector x (intern x) t))
ess-r-created-runners)))
(easy-menu-add-item ess-mode-menu '("Start Process")
(cons "Other" new-menu))
(easy-menu-add-item inferior-ess-mode-menu '("Process")
(cons "R processes" new-menu)))))))
(defun ess-r-redefine-runners (&optional verbose)
"Regenerate runners, i.e. `M-x R-*` possibilities.
Call `fmakunbound' on all elements of `ess-r-created-runners', then define new runners."
(interactive "P")
(dolist (f ess-r-created-runners)
(fmakunbound (intern f)))
(setq ess-r-created-runners nil)
(ess-r-define-runners verbose))
(defun ess-r-runners-reset (sym val)
"Regenerate runners.
Set SYM to VAL and call `ess-r-redefine-runners'."
(set-default sym val)
(ess-r-redefine-runners))
(define-obsolete-function-alias
'ess-r-versions-create 'ess-r-define-runners "ESS 18.10")
(defvar ess-newest-R nil
"Stores the newest version of R that has been found.
Used as a cache, within `ess-find-newest-R'. Do not use this value
directly, but instead call the function \\[ess-find-newest-R].")
(defcustom ess-prefer-higher-bit t
"Non-nil means prefer higher bit architectures of R.
e.g. prefer 64 bit over 32 bit. This is currently used only
by the code on Windows for finding the newest version of R."
:group 'ess-R
:type 'boolean)
(defun ess-rterm-prefer-higher-bit ()
"Optionally remove 32bit Rterms from being candidate for `run-ess-r-newest'.
Return the list of candidates for being `run-ess-r-newest'. Filtering is
done iff `ess-prefer-higher-bit' is non-nil. This is used only by
Windows when running `ess-find-newest-R'."
(if ess-prefer-higher-bit
;; filter out 32 bit elements
(let ((filtered
(delq nil
(mapcar (lambda (x) (unless (string-match "/i386/Rterm.exe" x) x))
ess-rterm-version-paths))))
(if (null filtered)
;; if none survived filtering, keep the original list
ess-rterm-version-paths
filtered))
ess-rterm-version-paths))
(defun run-ess-r-newest (&optional start-args)
"Find the newest version of R available, and run it.
Subsequent calls to `run-ess-r-newest' will run that version,
rather than searching again for the newest version. Providing
START-ARGS (interactively, with \\[universal-argument]) will
prompt for command line arguments."
(interactive "P")
(unless ess-newest-R
(message "Finding all versions of R on your system...")
(setq ess-newest-R
(ess-find-newest-date
(mapcar #'ess-r-version-date
(if ess-microsoft-p
(ess-rterm-prefer-higher-bit)
(add-to-list 'ess-r-created-runners inferior-ess-r-program))))))
(let ((inferior-ess-r-program ess-newest-R))
(run-ess-r start-args)))
(defalias 'R-newest 'run-ess-r-newest)
;; (ess-r-version-date "R-2.5.1") (ess-r-version-date "R-patched")
;; (ess-r-version-date "R-1.2.1") (ess-r-version-date "R-1.8.1")
;; Windows:
;; (ess-r-version-date "C:/Program Files (x86)/R/R-2.11.1/bin/Rterm.exe")
;; Note that for R-devel, ver-string is something like
;; R version 2.6.0 Under development (unstable) (2007-07-14 r42234)
;; Antique examples are 'R 1.0.1 (April 14, 2000)' or 'R 1.5.1 (2002-06-17).'
(defun ess-r-version-date (rver)
"Return the date of the version of R named RVER.
The date is returned as a date string. If the version of R could
not be found from the output of the RVER program, \"-1\" is
returned."
(let ((date "-1")
(ver-string (shell-command-to-string
;; here, MS Windows (shell-command) needs a short name:
(concat (if (and ess-microsoft-p
;; silence byte compiler warns about w32-fns
(fboundp 'w32-short-file-name))
(w32-short-file-name rver)
rver)
" --version"))))
(when (string-match
"R \\(version \\)?[1-9][^\n]+ (\\(2[0-9-]+\\)\\( r[0-9]+\\)?)"
ver-string)
(setq date (match-string 2 ver-string)))
(cons date rver)))
(defun ess-current-R-version ()
"Get the version of R currently running in the ESS buffer as a string."
(ess-make-buffer-current)
(car (ess-get-words-from-vector "as.character(.ess.Rversion)\n")))
(defun ess-current-R-at-least (version)
"Is the version of R (in the ESS buffer) at least (\">=\") VERSION ?
Examples: (ess-current-R-at-least '2.7.0)
or (ess-current-R-at-least \"2.5.1\")"
(ess-make-buffer-current)
(string= "TRUE"
(car (ess-get-words-from-vector
(format "as.character(.ess.Rversion >= \"%s\")\n" version)))))
(defun ess-find-newest-date (rvers)
"Find the newest version of R given in the a-list RVERS.
Each element of RVERS is a dotted pair (date . R-version), where
date is given as e.g.\"2007-11-30\" so that we can compare dates
as strings. If a date is listed as \"-1\", that version of R
could not be found.
If the value returned is nil, no valid newest version of R could be found."
(let (new-r this-r
(new-time "0"))
(while rvers
(setq this-r (car rvers)
rvers (cdr rvers))
(when (string< new-time (car this-r))
(setq new-time (car this-r)
new-r (cdr this-r))))
new-r))
(defun ess-find-rterm (&optional ess-R-root-dir bin-Rterm-exe)
"Find the full path of all occurrences of Rterm.exe under the ESS-R-ROOT-DIR.
If ESS-R-ROOT-DIR is nil, construct it by looking for an
occurrence of Rterm.exe in the `exec-path'. If there are no
occurrences of Rterm.exe in the `exec-path', then use
`ess-program-files' (which evaluates to something like
\"c:/progra~1/R/\" in English locales) which is the default
location for the R distribution. If BIN-RTERM-EXE is nil, then
use \"bin/Rterm.exe\"."
(if (not ess-R-root-dir)
(let ((Rpath (executable-find "Rterm")))
(setq ess-R-root-dir
(expand-file-name
(if Rpath
(concat (file-name-directory Rpath) "../../")
(concat ess-program-files "/R/"))))
(ess-write-to-dribble-buffer
(format "(ess-find-rterm): ess-R-root-dir = '%s'\n" ess-R-root-dir))))
(if (not bin-Rterm-exe) (setq bin-Rterm-exe "bin/Rterm.exe"))
(when (file-directory-p ess-R-root-dir) ; otherwise file-name-all-.. errors
(setq ess-R-root-dir
(replace-regexp-in-string "[\\]" "/" ess-R-root-dir))
(let ((R-ver
(ess-drop-non-directories
(ess-flatten-list
(mapcar (lambda (r-prefix)
(file-name-all-completions r-prefix ess-R-root-dir))
(append '("rw") ess-r-runner-prefixes))))))
(mapcar (lambda (dir)
(let ((R-path
(concat ess-R-root-dir
(replace-regexp-in-string "[\\]" "/" dir)
bin-Rterm-exe)))
(if (file-exists-p R-path) R-path)))
R-ver))))
(cl-defmethod ess-font-lock-keywords (&context (major-mode ess-r-transcript-mode))
'ess-R-font-lock-keywords)
;;;###autoload
(define-derived-mode ess-r-transcript-mode ess-transcript-mode "ESS R Transcript"
"A Major mode for R transcript files."
:syntax-table ess-r-mode-syntax-table
:group 'ess
(ess-setq-vars-local ess-r-customize-alist)
(setq-local comint-prompt-regexp inferior-S-prompt)
(setq-local ess-font-lock-keywords 'ess-R-font-lock-keywords)
(setq-local paragraph-start (concat "\\s-*$\\|" page-delimiter))
(setq-local paragraph-separate (concat "\\s-*$\\|" page-delimiter))
(setq-local paragraph-ignore-fill-prefix t)
(setq-local indent-line-function #'ess-r-indent-line)
(setq-local add-log-current-defun-header-regexp "^\\(.+\\)\\s-+<-[ \t\n]*function")
(setq-local font-lock-syntactic-face-function #'ess-r-font-lock-syntactic-face-function)
(setq-local prettify-symbols-alist ess-r-prettify-symbols)
(setq font-lock-defaults '(ess-build-font-lock-keywords
nil nil ((?\. . "w") (?\_ . "w") (?' . ".")))))
(fset 'r-transcript-mode 'ess-r-transcript-mode)
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Rr]out" . ess-r-transcript-mode))
;;;###autoload
(add-to-list 'interpreter-mode-alist '("Rscript" . ess-r-mode))
;;;###autoload
(add-to-list 'interpreter-mode-alist '("r" . ess-r-mode))
(defun ess-r-fix-T-F (&optional from quietly)
"Change T/F into TRUE and FALSE cautiously.
Do not change in comments and strings. Start at FROM, which
defaults to point, and change to end of buffer. When QUIETLY, do
not issue messages."
(interactive "d\nP"); point and prefix (C-u)
(save-excursion
(goto-char from)
(ess-rep-regexp "\\(\\([][=,()]\\|<-\\) *\\)T\\>" "\\1TRUE"
'fixcase nil (not quietly))
(goto-char from)
(ess-rep-regexp "\\(\\([][=,()]\\|<-\\) *\\)F\\>" "\\1FALSE"
'fixcase nil (not quietly))))
(define-obsolete-function-alias 'R-fix-T-F 'ess-r-fix-T-F
"ESS 18.10")
(defvar ess--packages-cache nil
"Cache var to store package names.
Used by `ess-r-install-library'.")
(defvar ess--CRAN-mirror nil
"CRAN mirror name cache.")
(cl-defmethod ess-install-library--override (update package &context (ess-dialect "R"))
"Prompt and install R PACKAGE.
With argument UPDATE, update cached packages list."
(inferior-ess-r-force)
(when (equal "@CRAN@" (car (ess-get-words-from-vector "getOption('repos')[['CRAN']]\n")))
(ess-set-CRAN-mirror ess--CRAN-mirror)
(ess-wait-for-process (get-process ess-current-process-name))
(unless package (setq update t)))
(when (or update
(not ess--packages-cache))
(message "Fetching R packages ... ")
(setq ess--packages-cache
(ess-get-words-from-vector "print(rownames(available.packages()), max=1e6)\n")))
(let* ((ess-eval-visibly-p t)
(package (or package
(ess-completing-read "Package to install" ess--packages-cache))))
(process-send-string (get-process ess-current-process-name)
(format "install.packages('%s')\n" package))
(display-buffer (buffer-name (ess-get-process-buffer)))))
(defun ess-setRepositories ()
"Call setRepositories()."
(interactive)
(if (not (string-match "^R" ess-dialect))
(message "Sorry, not available for %s" ess-dialect)
(ess-eval-linewise "setRepositories(FALSE)\n")))
(defun ess-set-CRAN-mirror (&optional mirror)
"Set cran MIRROR."
(interactive)
(let ((mirror-cmd "local({r <- getOption('repos'); r['CRAN'] <- '%s';options(repos=r)})\n"))
(if mirror
(ess-command (format mirror-cmd mirror))
(when-let ((M1 (ess-get-words-from-vector "local({out <- getCRANmirrors(local.only=TRUE); print(paste(out$Name,'[',out$URL,']', sep=''))})\n"))
(mirror (ess-completing-read "Choose CRAN mirror" M1 nil t))
(url (car (cl-member mirror M1 :test #'string=))))
(setq ess--CRAN-mirror (progn (string-match "\\(.*\\)\\[\\(.*\\)\\]$" url)
(match-string 2 url)))
(ess-command (format mirror-cmd ess--CRAN-mirror)))))
(message "CRAN mirror: %s" (car (ess-get-words-from-vector "getOption('repos')[['CRAN']]\n"))))
(define-obsolete-function-alias 'ess-setCRANMiror 'ess-set-CRAN-mirror "ESS 18.10")
(defun ess-r-check-install-package (pkg)
"Check if package PKG is installed and offer to install if not."
(unless (ess-boolean-command (format "print(requireNamespace('%s', quietly = TRUE))\n" pkg))
(if (y-or-n-p (format "Package '%s' is not installed. Install? " pkg))
(ess-eval-linewise (format "install.packages('%s')\n" pkg))
(signal 'quit nil))))
(define-obsolete-function-alias 'ess-r-sos #'ess-help-web-search "ESS 19.04")
(cl-defmethod ess--help-web-search-override (cmd &context (ess-dialect "R"))
(ess-r-check-install-package "sos")
(ess-eval-linewise (format "sos::findFn(\"%s\", maxPages=10)" cmd)))
(defun ess-R-scan-for-library-call (string)
"Detect `library/require' call in STRING and update tracking vars.
Placed into `ess-presend-filter-functions' for R dialects."
(when (string-match-p "\\blibrary(\\|\\brequire(" string)
(ess--mark-search-list-as-changed))
string)
(cl-defmethod ess-installed-packages (&context (ess-dialect "R"))
;;; FIXME? .packages() does not cache; installed.packages() does but is slower first time
(ess-get-words-from-vector "print(.packages(T), max=1e6)\n"))
(cl-defmethod ess-load-library--override (pack &context (ess-dialect "R"))
"Load an R package."
(ess-eval-linewise (format "library('%s')\n" pack)))
(define-obsolete-function-alias 'ess-library 'ess-load-library "ESS[12.09-1]")
;;; smart-comma was a bad idea
(eval-after-load "eldoc"
'(eldoc-add-command "ess-smart-comma"))
;;*;; Interaction with R
;;;*;;; Evaluation
(defun ess-r-arg (param value &optional wrap)
(let ((value (if wrap
(concat "'" value "'")
value)))
(concat ", " param " = " value)))
(defun ess-r-build-args (visibly output namespace)
(let ((visibly (ess-r-arg "visibly" (if visibly "TRUE" "FALSE")))
(output (ess-r-arg "output" (if output "TRUE" "FALSE")))
(pkg (when namespace (ess-r-arg "package" namespace t)))
(verbose (when (and namespace
ess-r-namespaced-load-verbose)
(ess-r-arg "verbose" "TRUE"))))
(concat visibly output pkg verbose)))
(cl-defmethod ess-build-eval-command--override (string &context (ess-dialect "R")
&optional visibly output file &rest args)
"R method to build eval command."
(let* ((namespace (caar args))
(namespace (unless ess-debug-minor-mode
(or namespace (ess-r-get-evaluation-env))))
(cmd (if namespace ".ess.ns_eval" ".ess.eval"))
(file (when file (ess-r-arg "file" file t)))
(rargs (ess-r-build-args visibly output namespace)))
(concat cmd "(\"" string "\"" rargs file ")\n")))
(cl-defmethod ess-build-load-command (string &context (ess-dialect "R")
&optional visibly output file &rest _args)
(let* ((namespace (or file (ess-r-get-evaluation-env)))
(cmd (if namespace ".ess.ns_source" ".ess.source"))
(rargs (ess-r-build-args visibly output namespace)))
(concat cmd "('" string "'" rargs ")\n")))
(defun ess-r-build-eval-message (message)
(let ((env (cond (ess-debug-minor-mode
(substring-no-properties ess-debug-indicator 1))
((ess-r-get-evaluation-env)))))
(if env
(format "[%s] %s" env message)
message)))
(defvar-local ess-r-evaluation-env nil
"Environment into which code should be evaluated.
When this variable is nil, code is evaluated in the current
environment. Currently only packages can be set as evaluation
environments. Use `ess-r-set-evaluation-env' to set this
variable.")
(defun ess-r-get-evaluation-env ()
"Get current evaluation env."
(or ess-r-evaluation-env
(and ess-current-process-name
(ess-get-process-variable 'ess-r-evaluation-env))))
(defun ess-r-set-evaluation-env (&optional arg)
"Select a package namespace for evaluation of R code.
Call interactively with a prefix argument to disable evaluation
in a namespace. When calling from a function, ARG can be a
string giving the package to select, any other non-nil value to
disable, or nil to prompt for a package.
If `ess-r-prompt-for-attached-pkgs-only' is non-nil, prompt only for
attached packages."
(interactive "P")
(let ((env (cond ((stringp arg) arg)
((null arg) (ess-r--select-package-name))
(t "*none*"))))
(if (equal env "*none*")
(let ((cur-env (ess-r-get-evaluation-env)))
;; fixme: does not work if env is set at process level
(setq ess-r-evaluation-env nil)
(delq 'ess-r--evaluation-env-mode-line ess--local-mode-line-process-indicator)
(message (format "Evaluation in %s disabled" (propertize cur-env 'face font-lock-function-name-face))))
(setq ess-r-evaluation-env env)
(add-to-list 'ess--local-mode-line-process-indicator 'ess-r--evaluation-env-mode-line t)
(message (format "Evaluating in %s" (propertize env 'face font-lock-function-name-face))))
(force-mode-line-update)))
(defvar-local ess-r--evaluation-env-mode-line
'(:eval (let ((env (ess-r-get-evaluation-env)))
(if env
(format " %s"
(propertize (if (equal env (ess-r-package-name))
"pkg"
env)
'face 'mode-line-emphasis))
""))))
(put 'ess-r--evaluation-env-mode-line 'risky-local-variable t)
(defvar ess-r-namespaced-load-only-existing t
"Whether to load only objects already existing in a namespace.")
(cl-defmethod ess-load-file--override (file &context (ess-dialect "R"))
(cond
;; Namespaced evaluation
((ess-r-get-evaluation-env)
(ess-r-load-file-namespaced file))
;; Evaluation into current env via .ess.source()
(t
(let ((command (ess-build-load-command file nil t)))
(ess-send-string (ess-get-process) command)))))
(defun ess-r-load-file-namespaced (&optional file)
"Load FILE into a package namespace.
This prompts for a package when no package is currently
selected (see `ess-r-set-evaluation-env')."
(ess-force-buffer-current "R process to use: ")
(let* ((pkg-name (ess-r-get-evaluation-env))
(command (ess-build-load-command file nil t pkg-name)))
(ess-send-string (ess-get-process) command)))
(cl-defmethod ess-send-region--override (process start end visibly message type
&context (ess-dialect "R"))
(cond
;; Namespaced evaluation
((ess-r-get-evaluation-env)
(ess-r-send-region-namespaced process start end visibly message))
;; Evaluation into current env
(t
(ess-send-string process (buffer-substring start end) visibly message type))))
(defun ess-r-send-region-namespaced (proc start end &optional visibly message)
"Ask for for the package and devSource region into it."
(or (ess-r-get-evaluation-env)
(ess-r-set-evaluation-env))
(message (ess-r-build-eval-message (or message "Eval region")))
(ess-send-string proc (buffer-substring start end) visibly message))
;;;*;;; Help
(defun ess-r-namespaced-object-p (object)
(string-match "^[[:alnum:].]+::" object))
(defun ess-r-build-help-command--qualified (object)
(when (ess-r-namespaced-object-p object)
(let* ((pkg-name (substring object (match-beginning 0) (- (match-end 0) 2)))
(object (concat "'" (substring object (match-end 0)) "'"))
(pkg (ess-r-arg "package" pkg-name t)))
(concat ".ess.help(" object pkg ")\n"))))
(defun ess-r-build-help-command--get-package-dir (object)
;; Ugly hack to avoid tcl/tk dialogues
(let ((pkgs (ess-get-words-from-vector
(format "as.character(utils::help('%s'))\n" object))))
(when (> (length pkgs) 1)
(ess-completing-read "Choose location" pkgs nil t))))
(defun ess-r-build-help-command--unqualified (object)
(if (eq ess-help-type 'index)
;; we are in index page, qualify with namespace
(ess-r-build-help-command--qualified (format "%s::%s" ess-help-object object))
(let ((pkg-dir (ess-r-build-help-command--get-package-dir object))
(command (format inferior-ess-r-help-command object)))
(if pkg-dir
;; Invoking `print.help_files_with_topic'
(format "do.call(structure, c('%s', attributes(%s)))\n" pkg-dir command)
command))))
(cl-defmethod ess-build-help-command (object &context (ess-dialect "R"))
(or (ess-r-build-help-command--qualified object)
(ess-r-build-help-command--unqualified object)))
(defconst inferior-ess-r--input-help (format "^ *help *(%s)" ess-help-arg-regexp))
(defconst inferior-ess-r--input-?-help-regexp "^ *\\(?:\\(?1:[a-zA-Z ]*?\\?\\{1,2\\}\\) *\\(?2:.+\\)\\)")
(defconst inferior-ess-r--page-regexp (format "^ *page *(%s)" ess-help-arg-regexp))
(defun ess-help-r--process-help-input (proc string)
(let ((help-match (and (string-match inferior-ess-r--input-help string)
(match-string 2 string)))
(help-?-match (and (string-match inferior-ess-r--input-?-help-regexp string)
string))
(page-match (and (string-match inferior-ess-r--page-regexp string)
(match-string 2 string))))
(when (or help-match help-?-match page-match)
(cond (help-match
(ess-display-help-on-object help-match)
(process-send-string proc "\n"))
(help-?-match
(ess-help-r--display-help-? string help-?-match)
(process-send-string proc "\n"))
(page-match
(switch-to-buffer-other-window
(ess-command (concat page-match "\n")
(get-buffer-create (concat page-match ".rt"))))
(ess-r-transcript-mode)
(process-send-string proc "\n")))
t)))
(defun ess-help-r--display-help-? (string help-?-match)
(cond ((string-match "\\?\\?\\(.+\\)" help-?-match)
(ess--display-indexed-help-page (concat help-?-match "\n")
"^\\([^ \t\n]+::[^ \t\n]+\\)[ \t\n]+"
(format "*ess-apropos[%s](%s)*"
ess-current-process-name (match-string 1 help-?-match))
'appropos))
((string-match "^ *\\? *\\([^ \t]+\\)$" help-?-match)
(ess-display-help-on-object (match-string 1 help-?-match)))
;; Anything else we send to process almost unchanged
(t
(let ((help-?-match (and (string-match inferior-ess-r--input-?-help-regexp string)
(format "%s%s" (match-string 1 string)
(ess-help-r--sanitize-topic (match-string 2 string))))))
(ess-display-help-on-object help-?-match "%s\n")))))
(defun ess-help-r--sanitize-topic (string)
"Enclose help topic STRING into `` to avoid ?while ?if etc hangs."
(if (string-match "\\([^:]*:+\\)\\(.*\\)$" string) ; treat foo::bar correctly
(format "%s`%s`" (match-string 1 string) (match-string 2 string))
(format "`%s`" string)))
;;;*;;; Utils for inferior R process
(defun inferior-ess-r-input-sender (proc string)
(save-current-buffer
(or (ess-help-r--process-help-input proc string)
(inferior-ess-input-sender proc string))))
(defun ess-r-load-ESSR ()
"Load ESSR functionality."
(cond
((file-remote-p (ess-get-process-variable 'default-directory))
(if (eq ess-r-fetch-ESSR-on-remotes t)
(ess-r--fetch-ESSR-remote)
(ess-r--load-ESSR-remote)))
((and (bound-and-true-p ess-remote))
(if ess-r-fetch-ESSR-on-remotes
(ess-r--fetch-ESSR-remote)
(ess-r--load-ESSR-remote t)))
(t (ess-r--load-ESSR-local))))
(defun ess-r--load-ESSR-local ()
(let* ((src-dir (expand-file-name "ESSR/R" ess-etc-directory))
(cmd (format "local({
source('%s/.load.R', local=TRUE) #define load.ESSR
.ess.load.ESSR('%s')
})\n"
src-dir src-dir)))
(with-current-buffer (ess-command cmd)
(let ((msg (buffer-string)))
(when (> (length msg) 1)
(message (format "Messages while loading ESSR: %s" msg)))))))
(defun ess-r--load-ESSR-remote (&optional chunked)
(ess-command (format ".ess.ESSRversion <- '%s'\n" essr-version))
(with-temp-message "Loading ESSR into remote ..."
(let ((src-dir (expand-file-name "ESSR/R" ess-etc-directory)))
(dolist (file (directory-files src-dir t "\\.R$"))
(ess--inject-code-from-file file chunked)))))
(defun ess-r--fetch-ESSR-remote ()
(let ((loader (ess-file-content (expand-file-name "ESSR/LOADREMOTE" ess-etc-directory))))
(unless (ess-boolean-command (format loader essr-version) nil 0.1)
(let* ((errmsg (with-current-buffer " *ess-command-output*" (buffer-string)))
(src-dir (expand-file-name "ESSR/R" ess-etc-directory))
(files (directory-files src-dir t "\\.R$")))
(message (format "Couldn't load ESSR.rds. Injecting from local.\n Error: %s\n" errmsg))
(ess-r--load-ESSR-remote)))))
(cl-defmethod ess-quit--override (arg &context (ess-dialect "R"))
"With ARG, do not offer to save the workspace."
(let ((cmd (format "base::q('%s')\n" (if arg "no" "default")))
(sprocess (ess-get-process ess-current-process-name)))
(when (not sprocess) (error "No ESS process running"))
(ess-cleanup)
(ess-send-string sprocess cmd t)))
(defcustom inferior-ess-r-reload-hook nil
"Hook run when reloading the R inferior buffer."
:type 'hook
:group 'ess-R)
(cl-defmethod inferior-ess-reload--override (start-name start-args &context (ess-dialect "R"))
"Call `run-ess-r' with START-ARGS.
Then run `inferior-ess-r-reload-hook'."
(let ((inferior-ess-r-program start-name))
(run-ess-r start-args))
(run-hooks 'inferior-ess-r-reload-hook))
(defun inferior-ess-r-force (&optional prompt force no-autostart ask-if-1)
(setq-local ess-dialect "R")
(ess-force-buffer-current prompt force no-autostart ask-if-1))
;;*;; Editing Tools
;;;*;;; Indentation Engine
;; Written by Lionel Henry in mid 2015
(defun ess-r-indent-line ()
"Indent current line as ESS R code.
Return the amount the indentation changed by."
(when-let ((indent (ess-calculate-indent)))
(let ((case-fold-search nil)
(pos (- (point-max) (point)))
beg shift-amt)
(beginning-of-line)
(setq beg (point))
(skip-chars-forward " \t")
(setq shift-amt (- indent (current-column)))
(if (zerop shift-amt)
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
(delete-region beg (point))
(indent-to indent)
;; If initial point was within line's indentation,
;; position after the indentation.
;; Else stay at same point in text.
(when (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))))
shift-amt)))
(defun ess-r-indent-exp ()
(save-excursion
(when current-prefix-arg
(ess-climb-to-top-level))
(let* ((bounds (ess-continuations-bounds))
(end (cadr bounds))
(beg (if current-prefix-arg
(car bounds)
(forward-line)
(point))))
(indent-region beg end))))
(defun ess-indent-call (&optional start)
(save-excursion
(when (ess-escape-calls)
(setq start (or start (point)))
(skip-chars-forward "^[(")
(forward-char)
(ess-up-list)
(indent-region start (point)))))
(defun ess-offset (offset)
(setq offset (eval (intern (concat "ess-offset-" (symbol-name offset)))))
(when (and (not (eq offset nil))
(listp offset)
(or (numberp (cadr offset))
(eq (cadr offset) t)
(error "Malformed offset")))
(setq offset (cadr offset)))
(cond ((numberp offset)
offset)
((null offset)
0)
(t
ess-indent-offset)))
(defun ess-offset-type (offset)
(setq offset (eval (intern (concat "ess-offset-" (symbol-name offset)))))
(if (listp offset)
(car offset)
offset))
(defun ess-overridden-blocks ()
(append (when (memq 'fun-decl ess-align-blocks)
(list (car ess-prefixed-block-patterns)))
(when (memq 'control-flow ess-align-blocks)
(append (cdr ess-prefixed-block-patterns)
'("}?[ \t]*else")))))
(defun ess-calculate-indent ()
"Return appropriate indentation for current line as ESS code.
In usual case returns an integer: the column to indent to.
Returns nil if line starts inside a string, t if in a comment."
(save-excursion
(beginning-of-line)
(let* ((indent-point (point))
(state (syntax-ppss))
(containing-sexp (cadr state))
(prev-containing-sexp (car (last (butlast (nth 9 state))))))
(back-to-indentation)
(cond
;; Strings
((ess-inside-string-p)
(current-indentation))
;; Comments
((ess-calculate-indent--comments))
;; Indentation of commas
((looking-at ",")
(ess-calculate-indent--comma))
;; Arguments: Closing
((ess-call-closing-p)
(ess-calculate-indent--call-closing-delim))
;; Block: Contents (easy cases)
((ess-calculate-indent--block-relatively))
;; Block: Prefixed block
((ess-calculate-indent--prefixed-block-curly))
;; Continuations
((ess-calculate-indent--continued))
;; Block: Overridden contents
((ess-calculate-indent--aligned-block))
;; Block: Opening
((ess-block-opening-p)
(ess-calculate-indent--block-opening))
;; Bare line
((and (null containing-sexp)
(not (ess-unbraced-block-p)))
0)
;; Block: Closing
((ess-block-closing-p)
(ess-calculate-indent--block 0))
;; Block: Contents
((ess-block-p)
(ess-calculate-indent--block))
;; Arguments: Nested calls override
((ess-calculate-indent--nested-calls))
;; Arguments: Contents
(t
(ess-calculate-indent--args))))))
(defun ess-calculate-indent--comments ()
(when ess-indent-with-fancy-comments
(cond
;; ### or #!
((or (looking-at "###")
(and (looking-at "#!")
(= 1 (line-number-at-pos))))
0)
;; Single # comment
((looking-at "#[^#']")
comment-column))))
(defun ess-calculate-indent--comma ()
(when (ess-inside-call-p)
(let ((indent (save-excursion
(ess-calculate-indent--args)))
(unindent (progn (skip-chars-forward " \t")
;; return number of skipped chars
(skip-chars-forward ", \t"))))
(- indent unindent))))
(defun ess-calculate-indent--call-closing-delim ()
(cond ((save-excursion
(ess-skip-blanks-backward t)
(eq (char-before) ?,))
(ess-calculate-indent--args nil))
((save-excursion
(and (ess-ahead-operator-p)
(or (ess-ahead-definition-op-p)
(not ess-align-continuations-in-calls))))
(ess-calculate-indent--continued))
(t
(ess-calculate-indent--args 0))))
(defun ess-calculate-indent--block-opening ()
(cond
;; Block is an argument in a function call
((when containing-sexp
(ess-at-containing-sexp
(ess-behind-call-opening-p "[[(]")))
(ess-calculate-indent--block 0))
;; Top-level block
((null containing-sexp) 0)
;; Block is embedded in another block
((ess-at-containing-sexp
(+ (current-indentation)
(ess-offset 'block))))))
(defun ess-calculate-indent--aligned-block ()
;; Check for `else' opening
(if (and (memq 'control-flow ess-align-blocks)
(looking-at "else\\b")
(ess-climb-if-else))
(progn
(when (looking-at "else\\b")
(ess-skip-curly-backward))
(current-column))
;; Check for braced and unbraced blocks
(ess-save-excursion-when-nil
(let ((offset (if (looking-at "[{})]")
0 (ess-offset 'block))))
(when (and (cond
;; Unbraced blocks
((ess-climb-block-prefix))
;; Braced blocks
(containing-sexp
(when (ess-at-containing-sexp
(looking-at "{"))
(ess-escape-prefixed-block))))
(cl-some 'looking-at
(ess-overridden-blocks)))
(+ (current-column) offset))))))
(defun ess-calculate-indent--block-relatively ()
(ess-save-excursion-when-nil
(let ((offset (if (looking-at "[})]") 0 (ess-offset 'block)))
(start-line (line-number-at-pos)))
(cond
;; Braceless block continuations: only when not in a call
((ess-save-excursion-when-nil
(and (not (looking-at "{"))
(ess-goto-char (ess-unbraced-block-p))
(not (looking-at "function\\b"))
(or (null containing-sexp)
(ess-at-containing-sexp
(not (looking-at "("))))))
(ess-maybe-climb-broken-else 'same-line)
(ess-skip-curly-backward)
(+ (current-column)
(ess-offset 'block)))
;; Don't indent relatively other continuations
((ess-ahead-continuation-p)
nil)
;; If a block already contains an indented line, we can indent
;; relatively from that first line
((ess-save-excursion-when-nil
(and (not (looking-at "}"))
containing-sexp
(goto-char containing-sexp)
(looking-at "{")
(progn
(forward-line)
(back-to-indentation)
(/= (line-number-at-pos) start-line))
(not (looking-at "[ \t]*\\(#\\|$\\)"))
(save-excursion
(or (ess-jump-expression)
(ess-jump-continuations))
(< (line-number-at-pos) start-line))))
(current-column))
;; If a block is not part of a call, we can indent relatively
;; from the opening {. First check that enclosing { is first
;; thing on line
((and containing-sexp
(not (ess-unbraced-block-p))
(goto-char containing-sexp)
(ess-block-opening-p)
(equal (point) (save-excursion
(back-to-indentation)
(point))))
(+ (current-column) offset))))))
(defun ess-arg-block-p ()
(unless (or (null containing-sexp)
;; Unbraced blocks in a { block are not arg blocks
(and (ess-unbraced-block-p)
(ess-at-containing-sexp
(looking-at "{"))))
(cond
;; Unbraced body
((ess-at-indent-point
(and (ess-unbraced-block-p)
(goto-char containing-sexp)
(ess-behind-call-opening-p "[[(]")))
'body)
;; Indentation of opening brace as argument
((ess-at-containing-sexp
(ess-behind-call-opening-p "[[(]"))
'opening)
;; Indentation of body or closing brace as argument
((ess-at-containing-sexp
(and (or (looking-at "{")
(ess-behind-block-paren-p))
prev-containing-sexp
(goto-char prev-containing-sexp)
(ess-behind-call-opening-p "[[(]")))
'body))))
(defun ess-calculate-indent--block (&optional offset)
(let ((arg-block (ess-arg-block-p)))
(cond (arg-block
(ess-calculate-indent--arg-block offset arg-block))
(t
;; Block is not part of an arguments list. Climb over any
;; block opening (function declaration, etc) to indent from
;; starting indentation.
(or (ess-climb-block-prefix)
(and (goto-char containing-sexp)
(ess-climb-block-prefix)))
(+ (current-indentation) (or offset (ess-offset 'block)))))))
(defun ess-calculate-indent--arg-block (offset arg-block)
(let* ((block-type (cond ((or (ess-at-containing-sexp
(and (eq arg-block 'body)
(ess-climb-block-prefix "function")))
(ess-at-indent-point
(and (eq arg-block 'opening)
(ess-backward-sexp 2)
(looking-at "function\\b"))))
'fun-decl)
((ess-at-indent-point
(ess-unbraced-block-p))
'unbraced)
((ess-at-containing-sexp
(not (ess-ahead-attached-name-p)))
'bare-block)
(t)))
(call-pos (if (and (not (eq block-type 'unbraced))
(not (eq arg-block 'opening)))
(goto-char prev-containing-sexp)
(prog1 containing-sexp
(goto-char indent-point)))))
(ess-calculate-indent--args offset (ess-offset-type 'block)
call-pos indent-point block-type)))
;; This function is currently the speed bottleneck of the indentation
;; engine. This is due to the need to call (ess-maximum-args-indent)
;; to check if some previous arguments have been pushed off from their
;; natural indentation: we need to check the whole call. This is very
;; inefficient especially when indenting a region containing a large
;; function call (e.g. some dplyr's data cleaning code). Should be
;; solved by implementing a cache as in (syntax-ppss), though it's
;; probably not worth the work.
(defun ess-calculate-indent--args (&optional offset type call-pos to block)
(let* ((call-pos (or call-pos containing-sexp))
(max-col (prog1 (unless (eq type 'prev-line)
(ess-maximum-args-indent call-pos to))
(goto-char call-pos)))
(override (and ess-align-arguments-in-calls
(save-excursion
(ess-climb-object)
(cl-some 'looking-at
ess-align-arguments-in-calls))))
(type-sym (cond (block 'block)
((looking-at "[[:blank:]]*[([][[:blank:]]*\\($\\|#\\)")
'arguments-newline)
(t 'arguments)))
(type (or type
(and override 'open-delim)
(ess-offset-type type-sym)))
(offset (or offset
(and (not block) (eq type 'open-delim) 0)
(ess-offset type-sym)))
(indent
(cond
;; Indent from opening delimiter
((eq type 'open-delim)
(ess-calculate-indent--args-open-delim))
;; Indent from attached name
((eq type 'prev-call)
(ess-calculate-indent--args-prev-call))
;; Indent from previous line indentation
((eq type 'prev-line)
(ess-calculate-indent--args-prev-line))
(t
(error "Malformed offset")))))
(if max-col
(ess-adjust-argument-indent indent offset max-col block)
(+ indent offset))))
(defun ess-calculate-indent--args-open-delim ()
(forward-char)
(current-column))
(defun ess-calculate-indent--args-prev-call ()
;; Handle brackets chains such as ][ (cf data.table)
(ess-climb-chained-delims)
;; Handle call chains
(if ess-indent-from-chain-start
(while (and (ess-backward-sexp)
(when (looking-back "[[(][ \t,]*" (line-beginning-position))
(goto-char (match-beginning 0)))))
(ess-backward-sexp))
(when ess-indent-from-lhs
(ess-climb-lhs))
(if (and nil
(eq block 'fun-decl)
(not (eq arg-block 'opening))
(not (eq (ess-offset-type type-sym) 'open-delim)))
(+ (ess-offset 'block) (current-column))
(current-column)))
(defun ess-calculate-indent--args-prev-line ()
(ess-at-indent-point
(cond
;; Closing delimiters are actually not indented at
;; prev-line, but at opening-line
((looking-at "[]})]")
(ess-up-list -1)
(when (looking-at "{")
(ess-climb-block-prefix))
(current-indentation))
;; Function blocks need special treatment
((and (eq type 'prev-line)
(eq block 'fun-decl))
(goto-char containing-sexp)
(ess-climb-block-prefix)
(current-indentation))
;; Regular case
(t
;; Find next non-empty line to indent from
(while (and (= (forward-line -1) 0)
(looking-at "[ \t]*\\($\\|#\\)")))
(goto-char (ess-code-end-position))
;; Climb relevant structures
(unless (ess-climb-block-prefix)
(when (eq (char-before) ?,)
(forward-char -1))
(ess-climb-expression)
(ess-climb-continuations))
;; The following ensures that only the first line
;; counts. Otherwise consecutive statements would get
;; increasingly more indented.
(when (and block
containing-sexp
(not (eq block 'unbraced))
(save-excursion
(/= (line-number-at-pos)
(progn (goto-char containing-sexp)
(line-number-at-pos)))))
(setq offset 0))
(current-indentation)))))
;; Indentation of arguments needs to keep track of how previous
;; arguments are indented. If one of those has a smaller indentation,
;; we push off the current line from its natural indentation. For
;; block arguments, we still need to push off this column so we ignore
;; it.
(defun ess-adjust-argument-indent (base offset max-col push)
(if push
(+ (min base max-col) offset)
(min (+ base offset) max-col)))
;; When previous arguments are shifted to the left (can happen in
;; several situations) compared to their natural indentation, the
;; following lines should not get indented past them. The following
;; function checks the minimum indentation for all arguments of the
;; current function call or bracket indexing.
(defun ess-maximum-args-indent (&optional from to)
(let* ((to (or to (point)))
(to-line (line-number-at-pos to))
(from-line (progn
(goto-char (1+ (or from containing-sexp)))
(line-number-at-pos)))
max-col)
(while (< (line-number-at-pos) to-line)
(forward-line)
(back-to-indentation)
;; Ignore the line with the function call, the line to be
;; indented, and empty lines.
(unless (or (>= (line-number-at-pos) to-line)
(looking-at "[ \t]*\\($\\|#\\)"))
(let ((indent (cond
;; First line: minimum indent is right after (
((= (line-number-at-pos) from-line)
(save-excursion
(goto-char (1+ containing-sexp))
(current-column)))
;; Handle lines starting with a comma
((save-excursion
(looking-at ","))
(+ (current-indentation) 2))
(t
(current-indentation)))))
(setq max-col (min indent (or max-col indent))))))
max-col))
;; Move to leftmost side of a call (either the first letter of its
;; name or its closing delim)
(defun ess-move-to-leftmost-side ()
(when (or (looking-at "[({]")
(ess-behind-call-p))
(ess-save-excursion-when-nil
(let ((start-col (current-column)))
(skip-chars-forward "^{[(")
(forward-char)
(ess-up-list)
(forward-char -1)
(< (current-column) start-col)))))
(defun ess-max-col ()
(let ((max-col (point)))
(save-excursion
(while (< (point) indent-point)
(unless (and ess-indent-with-fancy-comments
(looking-at "### "))
(setq max-col (min max-col (current-column))))
(forward-line)
(back-to-indentation)))
max-col))
(defun ess-calculate-indent--prefixed-block-curly ()
(when (looking-at "{")
(ess-save-excursion-when-nil
(let ((block-type (ess-climb-block-prefix)))
(cond ((ess-save-excursion-when-nil
(and (memq 'fun-decl-opening ess-indent-from-lhs)
(string= block-type "function")
(ess-climb-operator)
(ess-behind-assignment-op-p)
(ess-climb-expression)))
(current-column))
((= (save-excursion
(back-to-indentation)
(point))
(point))
(ess-calculate-indent--continued)))))))
(defun ess-calculate-indent--continued ()
"If a continuation line, return an indent of this line, otherwise nil."
(save-excursion
(let* ((cascade (eq (ess-offset-type 'continued) 'cascade))
(climbed (ess-climb-continuations cascade))
max-col)
(when climbed
(cond
;; Overridden calls
((and ess-align-continuations-in-calls
(not (eq climbed 'def-op))
containing-sexp
(save-excursion
(goto-char containing-sexp)
(looking-at "[[(]")))
(setq max-col (ess-max-col))
(ess-move-to-leftmost-side)
(+ (min (current-column) max-col)
(if (eq climbed 'def-op)
(ess-offset 'continued)
0)))
;; Regular case
(t
(let ((first-indent (or (eq climbed 'def-op)
(save-excursion
(when (ess-ahead-closing-p)
(ess-climb-expression))
(not (ess-climb-continuations cascade))))))
;; Record all indentation levels between indent-point and
;; the line we climbed. Some lines may have been pushed off
;; their natural indentation. These become the new
;; reference.
(setq max-col (ess-max-col))
;; Indenting continuations from the front of closing
;; delimiters looks better
(when
(ess-ahead-closing-p)
(backward-char))
(+ (min (current-column) max-col)
(cond
((eq (ess-offset-type 'continued) 'cascade)
(ess-offset 'continued))
(first-indent
(ess-offset 'continued))
(t
0))))))))))
(defun ess-calculate-indent--nested-calls ()
(when ess-align-nested-calls
(let ((calls (mapconcat 'identity ess-align-nested-calls "\\|"))
match)
(save-excursion
(and containing-sexp
(looking-at (concat "\\(" calls "\\)("))
(setq match (match-string 1))
(goto-char containing-sexp)
(looking-at "(")
(ess-backward-sexp)
(looking-at (concat match "("))
(current-column))))))
;;;*;;; Call filling engine
;; Unroll arguments to a single line until closing marker is found.
(defun ess-fill--unroll-lines (bounds &optional jump-cont)
(let* ((last-pos (point-min))
(containing-sexp (ess-containing-sexp-position))
prefix-break)
(goto-char (car bounds))
(goto-char (ess-code-end-position))
(while (and (/= (point) last-pos)
(< (line-end-position)
(cadr bounds))
(not prefix-break))
(setq last-pos (point))
;; Check whether we ended up in a sub call. In this case, jump
;; over it, otherwise, join lines.
(let ((contained-sexp (ess-containing-sexp-position)))
(cond ((and contained-sexp
containing-sexp
(not (= containing-sexp contained-sexp)))
(goto-char (1+ contained-sexp))
(ess-up-list))
;; Jump over continued statements
((and jump-cont (ess-ahead-operator-p 'strict))
(ess-climb-token)
(ess-jump-continuations))
;; Jump over comments
((looking-at "#")
(forward-line)
(funcall indent-line-function))
(t
(join-line 1))))
(goto-char (ess-code-end-position)))
(goto-char (car bounds))))
(defvar ess-fill--orig-pos nil
"Original position of cursor.")
(defvar ess-fill--orig-state nil
"Backup of original code to cycle back to original state.")
(defvar ess-fill--second-state nil
"Backup of code produce by very first cycling.
If this is equal to orig-state, no need to cycle back to original
state.")
(defvar ess-fill--style-level nil
"Filling style used in last cycle.")
(defun ess-fill--substring (bounds)
(buffer-substring (car bounds) (marker-position (cadr bounds))))
;; Detect repeated commands
(defun ess-fill-style (type bounds)
(let ((max-level
;; This part will be simpler once we have the style alist
(cond ((eq type 'calls)
;; No third style either when ess-offset-arguments is
;; set to 'open-delim, or when ess-fill-calls-newlines
;; is nil and no numeric prefix is given
(if (and (not (eq (ess-offset-type 'arguments)
'open-delim))
(or ess-fill-calls-newlines
(numberp current-prefix-arg)))
3
2))
((eq type 'continuations)
2))))
(if (not (memq last-command '(fill-paragraph-or-region
fill-paragraph)))
(progn
;; Record original state on first cycling
(setq ess-fill--orig-state (ess-fill--substring bounds))
(setq ess-fill--orig-pos (point))
(setq ess-fill--second-state nil)
(setq ess-fill--style-level 1))
;; Also record state on second cycling
(when (and (= ess-fill--style-level 1)
(null ess-fill--second-state))
(setq ess-fill--second-state (ess-fill--substring bounds)))
(cond ((>= ess-fill--style-level max-level)
(let ((same-last-and-orig (string= (ess-fill--substring bounds)
ess-fill--orig-state))
(same-2nd-and-orig (string= ess-fill--orig-state
ess-fill--second-state)))
;; Avoid cycling to the same state twice
(cond ((and same-last-and-orig
same-2nd-and-orig)
(setq ess-fill--style-level 2))
((or same-last-and-orig
same-2nd-and-orig)
(setq ess-fill--style-level 1))
(t
(setq ess-fill--style-level 0)))))
(ess-fill--style-level
(setq ess-fill--style-level (1+ ess-fill--style-level))))))
ess-fill--style-level)
(defun ess-fill-args (&optional style)
(let ((start-pos (point-min))
(bounds (ess-args-bounds 'marker))
;; Set undo boundaries manually
(undo-inhibit-record-point t)
last-pos last-newline prefix-break
infinite)
(when (not bounds)
(error "Could not find function bounds"))
(setq style (or style (ess-fill-style 'calls bounds)))
(if (= style 0)
(progn
(delete-region (car bounds) (marker-position (cadr bounds)))
(insert ess-fill--orig-state)
;; Restore the point manually. (save-excursion) wouldn't
;; work here because we delete the text rather than just
;; modifying it.
(goto-char ess-fill--orig-pos)
(message "Back to original formatting"))
(when ess-blink-refilling
(ess-blink-region (nth 2 bounds)
(1+ (marker-position (cadr bounds)))))
(undo-boundary)
(save-excursion
(ess-fill--unroll-lines bounds t)
(cond
;; Some styles start with first argument on a newline
((and (memq style '(2 4))
ess-fill-calls-newlines
(not (looking-at "[ \t]*#")))
(newline-and-indent))
;; Third level, start a newline after N arguments
((and (= style 3)
(not (looking-at "[ \t]*#")))
(let ((i (if (numberp current-prefix-arg)
current-prefix-arg
1)))
(while (and (> i 0)
(ess-jump-arg)
(ess-jump-char ","))
(setq i (1- i))))
(newline-and-indent)))
(ess-fill-args--roll-lines)
;; Reindent surrounding context
(ess-indent-call (car bounds)))
;; Signal marker for garbage collection
(set-marker (cadr bounds) nil)
(undo-boundary))))
(defun ess-fill-args--roll-lines ()
(while (and (not (looking-at "[])]"))
(/= (point) (or last-pos 1))
(not infinite))
(setq prefix-break nil)
;; Record start-pos as future breaking point to avoid breaking
;; at `=' sign
(while (looking-at "[ \t]*[\n#]")
(forward-line)
(back-to-indentation))
(setq start-pos (point))
(while (and (< (current-column) fill-column)
(not (looking-at "[])]"))
(/= (point) (or last-pos 1))
;; Break after one pass if prefix is active
(not prefix-break))
(when (memq style '(2 3))
(setq prefix-break t))
(ess-jump-token ",")
(setq last-pos (point))
;; Jump expression and any continuations. Reindent all lines
;; that were jumped over
(let ((cur-line (line-number-at-pos))
end-line)
(cond ((ess-jump-arg)
(setq last-newline nil))
((ess-token-after= ",")
(setq last-newline nil)
(setq last-pos (1- (point)))))
(save-excursion
(when (< cur-line (line-number-at-pos))
(setq end-line (line-number-at-pos))
(ess-goto-line (1+ cur-line))
(while (and (<= (line-number-at-pos) end-line)
(/= (point) (point-max)))
(funcall indent-line-function)
(forward-line))))))
(when (or (>= (current-column) fill-column)
prefix-break
;; Ensures closing delim on a newline
(and (= style 4)
(looking-at "[ \t]*[])]")
(setq last-pos (point))))
(if (and last-pos (/= last-pos start-pos))
(goto-char last-pos)
(ess-jump-char ","))
(cond ((looking-at "[ \t]*[#\n]")
(forward-line)
(funcall indent-line-function)
(setq last-newline nil))
;; With levels 2 and 3, closing delim goes on a newline
((looking-at "[ \t]*[])]")
(when (and (memq style '(2 3 4))
ess-fill-calls-newlines
(not last-newline))
(newline-and-indent)
;; Prevent indenting infinitely
(setq last-newline t)))
((not last-newline)
(newline-and-indent)
(setq last-newline t))
(t
(setq infinite t))))))
(defun ess-fill-continuations (&optional style)
(let ((bounds (ess-continuations-bounds 'marker))
(undo-inhibit-record-point t)
(last-pos (point-min))
last-newline infinite)
(when (not bounds)
(error "Could not find statements bounds"))
(setq style (or style (ess-fill-style 'continuations bounds)))
(if (= style 0)
(progn
(delete-region (car bounds) (marker-position (cadr bounds)))
(insert ess-fill--orig-state)
(goto-char ess-fill--orig-pos)
(message "Back to original formatting"))
(when ess-blink-refilling
(ess-blink-region (car bounds) (marker-position (cadr bounds))))
(undo-boundary)
(save-excursion
(ess-fill--unroll-lines bounds)
(while (and (< (point) (cadr bounds))
(/= (point) (or last-pos 1))
(not infinite))
(setq last-pos (point))
(when (and (ess-jump-expression)
(indent-according-to-mode)
(not (> (current-column) fill-column)))
(setq last-newline nil))
(ess-jump-operator)
(if (or (and (> (current-column) fill-column)
(goto-char last-pos))
(= style 2))
(progn
(ess-jump-operator)
(unless (= (point) (cadr bounds))
(when last-newline
(setq infinite t))
(newline-and-indent)
(setq last-newline t)))
(setq last-newline nil)))
(ess-indent-call (car bounds)))
(set-marker (cadr bounds) nil)
(undo-boundary))))
;;;*;;; Inferior R mode
(defvar inferior-ess-r-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\M-\r" #'ess-dirs)
(define-key map (kbd "C-c C-=") #'ess-cycle-assign)
(define-key map (kbd "C-c C-.") 'ess-rutils-map)
map)
"Keymap for `inferior-ess-r-mode'.")
;; TOTHINK: Prevent string delimiting characters from messing up output in the
;; inferior buffer
(defvar inferior-ess-r-mode-syntax-table
(let ((table (copy-syntax-table ess-r-mode-syntax-table)))
(modify-syntax-entry ?% "." table)
(modify-syntax-entry ?\' "." table)
table)
"Syntax table for `inferior-ess-r-mode'.")
(define-derived-mode inferior-ess-r-mode inferior-ess-mode "iESS"
"Major mode for interacting with inferior R processes."
:group 'ess-proc
(ess-setq-vars-local ess-r-customize-alist)
(setq-local ess-font-lock-keywords 'inferior-ess-r-font-lock-keywords)
(setq-local comint-process-echoes (eql ess-eval-visibly t))
(setq-local comint-prompt-regexp inferior-S-prompt)
(setq comint-input-sender 'inferior-ess-r-input-sender)
(remove-hook 'completion-at-point-functions 'ess-filename-completion 'local) ;; should be first
(add-hook 'completion-at-point-functions 'ess-r-object-completion nil 'local)
(add-hook 'completion-at-point-functions 'ess-filename-completion nil 'local)
(add-hook 'xref-backend-functions #'ess-r-xref-backend nil 'local)
;; eldoc
(add-function :before-until (local 'eldoc-documentation-function)
#'ess-r-eldoc-function)
(when ess-use-eldoc (eldoc-mode))
;; auto-complete
(ess--setup-auto-complete ess-r-ac-sources t)
;; company
(ess--setup-company ess-r-company-backends t)
(setq comint-get-old-input #'inferior-ess-get-old-input)
(add-hook 'comint-input-filter-functions 'ess-search-path-tracker nil 'local))
;;;*;;; R Help mode
(defvar ess-r-help-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap button-buffer-map
ess-help-mode-map))
(define-key map "s<" #'beginning-of-buffer)
(define-key map "s>" #'end-of-buffer)
(define-key map "sa" #'ess-skip-to-help-section)
(define-key map "sd" #'ess-skip-to-help-section)
(define-key map "sD" #'ess-skip-to-help-section)
(define-key map "st" #'ess-skip-to-help-section)
(define-key map "se" #'ess-skip-to-help-section)
(define-key map "sn" #'ess-skip-to-help-section)
(define-key map "sr" #'ess-skip-to-help-section)
(define-key map "ss" #'ess-skip-to-help-section)
(define-key map "su" #'ess-skip-to-help-section)
(define-key map "sv" #'ess-skip-to-help-section)
map)
"Keymap for `ess-r-help-mode'.")
(cl-defmethod ess--help-major-mode (&context (ess-dialect "R"))
(ess-r-help-mode))
(define-derived-mode ess-r-help-mode ess-help-mode "R Help"
"Major mode for help buffers."
:group 'ess-help
(setq ess-dialect "R"
ess-help-sec-regex ess-help-r-sec-regex
ess-help-sec-keys-alist ess-help-r-sec-keys-alist ; TODO: Still necessary?
inferior-ess-help-command inferior-ess-r-help-command)
(ess-r-help-add-links))
(defun ess-r-help-usage-objects ()
"Return a list of objects in the usage section for the current help buffer.
In other words, if in the help buffer for \"qt\", return
'((\"dt\" \"x\" \"df\" \"ncp\" \"log\")
(\"pt\" \"q\" \"df\" \"ncp\" \"lower.tail\" \"log.p\")
(\"qt\" \"p\" \"df\" \"ncp\" \"lower.tail\" \"log.p\")
(\"rt\" \"n\" \"df\" \"ncp\")).
If the current buffer does not have a usage section, return nil."
(unless (derived-mode-p 'ess-r-help-mode)
(error "Not an R help buffer"))
(save-excursion
(save-restriction
(let (usage-objects)
(widen)
(goto-char (point-min))
;; Narrow the buffer to just the "Usage" section
(when-let ((usage-beg (re-search-forward "^Usage:" nil t))
(usage-end (re-search-forward "^[^[:space:]]" nil t)))
(forward-line -1)
(narrow-to-region usage-beg (point))
(goto-char (point-min))
;; Match objects until a parens
(while (re-search-forward (rx bol (0+ whitespace) (not (syntax comment-delimiter))
(group (1+ (not (any "(")))))
usage-end t)
(push (match-string-no-properties 1) usage-objects)
;; Skip past function arguments
(forward-list)))
(when usage-objects
;; Get arguments:
(setq usage-objects
(mapcar (lambda (u) (cons u (ess-get-words-from-vector (concat "names(formals(" u "))\n"))))
usage-objects)))
(nreverse usage-objects)))))
(define-button-type 'ess-r-help-link
'follow-link t
'action (lambda (_) (ess-r-help-button-action)))
(defun ess-r-help-button-action ()
"Display help for button at point."
(let ((text (get-text-property (point) 'ess-r-help-link-text)))
(ess-display-help-on-object text)))
(defun ess-r-help-add-links ()
"Add links to the help buffer."
(let ((help-topics (when (ess-process-live-p)
(ess-help-get-topics ess-local-process-name)))
(inhibit-read-only t)
(usage-objects (ess-flatten-list (ess-r-help-usage-objects))))
(save-excursion
;; Search for fancy quotes only. If users have
;; options(useFancyQuotes) set to something other than TRUE this
;; probably won't work. If it's FALSE, R outputs ascii ', but
;; searching through the whole buffer takes too long.
(while (re-search-forward "\\([^[:space:]]+?\\)’" nil t)
(let* ((text (match-string 1))
(text (if (string-match-p ".*()\\'" text)
(substring text nil (- (length text) 2))
text)))
(when (and (member text help-topics)
(not (member text usage-objects))
(not (member text usage-objects)))
(delete-region (match-beginning 0) (match-end 0))
(insert-text-button text
'ess-r-help-link-text text
'type 'ess-r-help-link
'help-echo (format "mouse-2, RET: Help on %s" text))))))))
(cl-defmethod ess--display-vignettes-override (all &context (ess-dialect "R"))
"Display R vignettes in ess-help-like buffer..
With (prefix) ALL non-nil, use `vignette(*, all=TRUE)`, i.e.,
from all installed packages, which can be very slow."
(inferior-ess-r-force)
(let* ((vslist (with-current-buffer
(ess-command
(format ".ess_vignettes(%s)\n" (if all "TRUE" "")))
(goto-char (point-min))
(when (re-search-forward "(list" nil t)
(goto-char (match-beginning 0))
(ignore-errors (eval (read (current-buffer)))))))
(proc-name ess-current-process-name)
(alist ess-local-customize-alist)
(remote (file-remote-p default-directory))
(buff (get-buffer-create (format "*[%s]vignettes*" ess-dialect)))
(inhibit-modification-hooks t)
(inhibit-read-only t))
(with-current-buffer buff
(setq buffer-read-only nil)
(delete-region (point-min) (point-max))
(ess-setq-vars-local (eval alist))
(setq ess-local-process-name proc-name)
(ess--help-major-mode)
(setq ess-help-sec-regex "^\\w+:$"
ess-help-type 'vignettes)
(set-buffer-modified-p 'nil)
(goto-char (point-min))
(dolist (el vslist)
(let ((pack (car el)))
(insert (format "\n\n%s:\n\n" (propertize pack 'face 'underline)))
(dolist (el2 (cdr el))
(let ((path (if remote
(with-no-warnings
;; Have to wrap this in with-no-warnings because
;; otherwise the byte compiler complains about
;; calling tramp-make-tramp-file-name with an
;; incorrect number of arguments on Both 26+ and 25 emacses.
(if (>= emacs-major-version 26)
(with-parsed-tramp-file-name default-directory nil
(tramp-make-tramp-file-name method user domain host port (nth 1 el2)))
(with-parsed-tramp-file-name default-directory nil
(tramp-make-tramp-file-name method user host (nth 1 el2)))))
(nth 1 el2))))
(insert-text-button "Pdf"
'mouse-face 'highlight
'action (if remote
#'ess--action-open-in-emacs
#'ess--action-R-open-vignette)
'follow-link t
'vignette (file-name-sans-extension (nth 2 el2))
'package pack
'help-echo (concat path "/doc/" (nth 2 el2)))
(insert " ")
(insert-text-button "Rnw"
'mouse-face 'highlight
'action #'ess--action-open-in-emacs
'follow-link t
'help-echo (concat path "/doc/" (nth 3 el2)))
(insert " ")
(insert-text-button "R"
'mouse-face 'highlight
'action #'ess--action-open-in-emacs
'follow-link t
'help-echo (concat path "/doc/" (nth 4 el2)))
(insert (format "\t%s\n" (nth 0 el2)))))))
(goto-char (point-min))
(insert (propertize "\t\t**** Vignettes ****\n" 'face 'bold-italic))
(unless (eobp) (delete-char 1))
(setq buffer-read-only t))
(ess-display-help buff)))
;; Support for listing R packages
(define-obsolete-variable-alias 'ess-rutils-buf 'ess-r-package-menu-buf "ESS 19.04")
(define-obsolete-variable-alias 'ess-rutils-mode-map 'ess-r-package-menu-mode-map "ESS 19.04")
(define-obsolete-function-alias 'ess-rutils-mode #'ess-r-package-menu-mode "ESS 19.04")
(defvar ess-rutils-map
(let ((map (define-prefix-command 'ess-rutils-map)))
(define-key map "l" #'ess-r-package-list-local-packages)
(define-key map "r" #'ess-r-package-list-available-packages)
(define-key map "u" #'ess-r-package-update-packages)
(define-key map "o" #'ess-rdired)
(define-key map "d" #'ess-change-directory)
(define-key map "H" #'ess-rutils-html-docs)
map))
(easy-menu-define ess-rutils-mode-menu inferior-ess-mode-menu
"Package management."
'("Package management"
["List local packages" ess-r-package-list-local-packages t]
["List available packages" ess-r-package-list-available-packages t]
["Update packages" ess-r-package-update-packages t]))
(easy-menu-add-item inferior-ess-mode-menu nil ess-rutils-mode-menu "Utils")
(easy-menu-add-item ess-mode-menu nil ess-rutils-mode-menu "Process")
(defvar ess-r-package-menu-buf "*R packages*"
"Name of buffer to display R packages in.")
(defvar ess-r-package-menu-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "l" #'ess-r-package-load)
(define-key map "i" #'ess-r-package-mark-install)
(define-key map "x" #'ess-r-package-execute-marks)
(define-key map "u" #'ess-r-package-unmark)
map)
"Keymap for `ess-rutils-mode'.")
(define-derived-mode ess-r-package-menu-mode tabulated-list-mode "R utils"
"Major mode for `ess-rutils-local-pkgs' and `ess-rutils-repos-pkgs'."
:group 'ess-R
(setq ess-dialect "R")
(setq mode-name (concat "R packages: " ess-local-process-name))
(setq tabulated-list-padding 2)
(setq tabulated-list-format
`[("Name" 10 t)
("Description" 50 nil)
("Version" 5 t)])
(tabulated-list-init-header))
(define-obsolete-function-alias 'ess-rutils-local-pkgs #'ess-r-package-list-local-packages "ESS 19.04")
(defun ess-r-package-list-local-packages ()
"List all packages in all libraries."
(interactive)
(ess-r-package--list-packages (concat ".ess.rutils.ops <- options(width = 10000);"
"print(installed.packages(fields=c(\"Title\"))[, c(\"Title\", \"Version\")]);"
"options(.ess.rutils.ops); rm(.ess.rutils.ops);"
"\n")))
(defun ess-r-package--list-packages (cmd)
"Use CMD to list packages."
(let ((process ess-local-process-name)
des-col-beginning des-col-end entries)
(with-current-buffer (ess-command cmd (get-buffer-create " *ess-rutils-pkgs*"))
(goto-char (point-min))
(delete-region (point) (1+ (point-at-eol)))
;; Now we have a buffer with package name, description, and
;; version. description and version are surrounded by quotes,
;; description is separated by whitespace.
(re-search-forward "\\>[[:space:]]+")
(setq des-col-beginning (current-column))
(goto-char (point-at-eol))
;; Unless someone has a quote character in their package version,
;; two quotes back will be the end of the package description.
(dotimes (_ 2) (search-backward "\""))
(re-search-backward "[[:space:]]*")
(setq des-col-end (current-column))
(beginning-of-line)
(while (not (eobp))
(beginning-of-line)
(let* ((name (string-trim (buffer-substring
(point)
(progn (forward-char (1- des-col-beginning))
(point)))))
(description (string-trim (buffer-substring
(progn (forward-char 1)
(point))
(progn (forward-char (- des-col-end des-col-beginning))
(point)))))
(version (buffer-substring
(progn (end-of-line)
(search-backward "\"")
(search-backward "\"")
(forward-char 1)
(point))
(progn (search-forward "\"")
(backward-char 1)
(point)))))
(push
(list name
`[(,name
help-echo "mouse-2, RET: help on this package"
action ess-rutils-help-on-package)
,description
,version])
entries)
(forward-line)))
(pop-to-buffer ess-rutils-buf)
(setq ess-local-process-name process)
(setq tabulated-list-entries entries)
(ess-r-package-menu-mode)
(tabulated-list-print))))
(define-obsolete-function-alias 'ess-rutils-loadpkg #'ess-r-package-load "ESS 19.04")
(defun ess-r-package-load ()
"Load package from a library."
(interactive)
(ess-execute (concat "library('" (tabulated-list-get-id)
"', character.only = TRUE)")
'buffer))
(defun ess-rutils-help-on-package (&optional _button)
"Display help on the package at point."
(interactive)
;; FIXME: Should go to a help buffer
(ess-execute (concat "help(" (tabulated-list-get-id) ", package = '"
(tabulated-list-get-id)"')")
'buffer))
(define-obsolete-function-alias 'ess-rutils-repos-pkgs #'ess-r-package-list-available-packages "ESS 19.04")
(defun ess-r-package-list-available-packages ()
"List available packages.
Use the repositories as listed by getOptions(\"repos\") in the
current R session."
(interactive)
(ess-r-package--list-packages (concat ".ess.rutils.ops <- options(width = 10000);"
"print(available.packages(fields=c(\"Title\"))[, c(\"Title\", \"Version\")]);"
"options(.ess.rutils.ops); rm(.ess.rutils.ops);"
"\n")))
(define-obsolete-function-alias 'ess-rutils-mark-install #'ess-r-package-mark-install "ESS 19.04")
(defun ess-r-package-mark-install ()
"Mark the current package for installing."
(interactive)
(tabulated-list-put-tag "i" t))
(define-obsolete-function-alias 'ess-rutils-unmark #'ess-r-package-unmark "ESS 19.04")
(defun ess-r-package-unmark ()
"Unmark the packages."
(interactive)
(tabulated-list-put-tag " " t))
(define-obsolete-function-alias 'ess-rutils-execute-marks #'ess-r-package-execute-marks "ESS 19.04")
(defun ess-r-package-execute-marks ()
"Perform all marked actions."
(interactive)
;; Install
(save-excursion
(let ((cmd "install.packages(c(")
pkgs)
(goto-char (point-min))
(while (not (eobp))
(when (looking-at-p "i")
(setq pkgs (concat "\"" (tabulated-list-get-id) "\", " pkgs))
(tabulated-list-put-tag " "))
(forward-line))
(if pkgs
(progn (setq pkgs (substring pkgs 0 (- (length pkgs) 2)))
(setq cmd (concat cmd pkgs "))"))
(ess-execute cmd 'buffer))
(message "No packages marked for install")))))
(define-obsolete-function-alias 'ess-rutils-update-pkgs #'ess-r-package-update-packages "ESS 19.04")
(defun ess-r-package-update-packages (lib repo)
"Update packages in library LIB and repo REPO.
This also uses checkBuilt=TRUE to rebuild installed packages if
needed."
(interactive
(list (ess-completing-read "Library to update: " (ess-get-words-from-vector
"as.character(.libPaths())\n"))
(ess-completing-read "Repo: " (ess-get-words-from-vector
"as.character(getOption(\"repos\"))\n"))))
(ess-execute (format "update.packages(lib.loc='%s', repos='%s', ask=FALSE, checkBuilt=TRUE)" lib repo) 'buffer))
(define-obsolete-function-alias 'ess-rutils-apropos #'ess-display-help-apropos "ESS 19.04")
;; Miscellaneous helper functions
(defun ess-rutils-rm-all ()
"Remove all R objects."
(interactive)
(when (y-or-n-p "Delete all objects? ")
(ess-execute "rm(list=ls())" 'buffer)))
(defun ess-rutils-load-wkspc (file)
"Load workspace FILE into R."
(interactive "fFile with workspace to load: ")
(ess-execute (concat "load('" file "')") 'buffer))
(defun ess-rutils-save-wkspc (file)
"Save FILE workspace as file.RData."
(interactive "FSave workspace to file (no extension): ")
(ess-execute (concat "save.image('" file ".RData')") 'buffer))
(defun ess-rutils-quit ()
"Kill the ess-rutils buffer and return to the iESS buffer."
(interactive)
(ess-switch-to-end-of-ESS)
(kill-buffer ess-rutils-buf))
(defun ess-rutils-html-docs (&optional remote)
"Use `browse-url' to navigate R html documentation.
Documentation is produced by a modified help.start(), that
returns the URL produced by GNU R's http server. If called with a
prefix, the modified help.start() is called with update=TRUE. The
optional REMOTE argument should be a string with a valid URL for
the 'R_HOME' directory on a remote server (defaults to NULL)."
(interactive)
(let* ((update (if current-prefix-arg "update=TRUE" "update=FALSE"))
(remote (if (or (and remote (not (string= "" remote))))
(concat "remote=" remote) "remote=NULL"))
(proc ess-local-process-name)
(rhtml (format ".ess_help_start(%s, %s)\n" update remote)))
(with-temp-buffer
(ess-command rhtml (current-buffer) nil nil nil (get-process proc))
(let* ((begurl (search-backward "http://"))
(endurl (search-forward "index.html"))
(url (buffer-substring-no-properties begurl endurl)))
(browse-url url)))))
(defun ess-rutils-rsitesearch (string)
"Search the R archives for STRING, and show results using `browse-url'.
If called with a prefix, options are offered (with completion)
for matches per page, sections of the archives to search,
displaying results in long or short formats, and sorting by any
given field. Options should be separated by value of
`crm-default-separator'."
(interactive "sSearch string: ")
(let ((site "https://search.r-project.org/cgi-bin/namazu.cgi?query=")
(okstring (replace-regexp-in-string " +" "+" string)))
(if current-prefix-arg
(let ((mpp (concat
"&max="
(completing-read
"Matches per page: "
'(("20" 1) ("30" 2) ("40" 3) ("50" 4) ("100" 5)))))
(format (concat
"&result="
(completing-read
"Format: " '(("normal" 1) ("short" 2))
nil t "normal" nil "normal")))
(sortby (concat
"&sort="
(completing-read
"Sort by: "
'(("score" 1) ("date:late" 2) ("date:early" 3)
("field:subject:ascending" 4)
("field:subject:decending" 5)
("field:from:ascending" 6) ("field:from:decending" 7)
("field:size:ascending" 8) ("field:size:decending" 9))
nil t "score" nil "score")))
(restrict (concat
"&idxname="
(mapconcat
'identity
(completing-read-multiple
"Limit search to: "
'(("Rhelp02a" 1) ("functions" 2)
("docs" 3) ("Rhelp01" 4))
nil t "Rhelp02a,functions,docs" nil
"Rhelp02a,functions,docs") "&idxname="))))
(browse-url (concat site okstring mpp format sortby restrict)))
(browse-url (concat site okstring "&max=20&result=normal&sort=score"
"&idxname=Rhelp02a&idxname=functions&idxname=docs")))))
(defun ess-rutils-help-search (string)
"Search for STRING using help.search()."
(interactive "sString to search for? ")
(let ((proc ess-local-process-name))
(pop-to-buffer "foobar")
(ess-command (concat "help.search('" string "')\n")
(current-buffer) nil nil nil (get-process proc))))
(make-obsolete 'ess-rutils-rhtml-fn "overwrite .ess_help_start instead." "ESS 18.10")
;; Create functions that can be called for running different versions
;; of R.
;; FIXME: Should be set in ess-custom
(setq ess-rterm-version-paths
(ess-flatten-list
(delete-dups
(if (not ess-directory-containing-R)
(if (getenv "ProgramW6432")
(let ((P-1 (getenv "ProgramFiles(x86)"))
(P-2 (getenv "ProgramW6432")))
(nconc
;; Always 32 on 64 bit OS, nil on 32 bit OS
(ess-find-rterm (concat P-1 "/R/") "bin/Rterm.exe")
(ess-find-rterm (concat P-1 "/R/") "bin/i386/Rterm.exe")
;; Keep this both for symmetry and because it can happen:
(ess-find-rterm (concat P-1 "/R/") "bin/x64/Rterm.exe")
;; Always 64 on 64 bit OS, nil on 32 bit OS
(ess-find-rterm (concat P-2 "/R/") "bin/Rterm.exe")
(ess-find-rterm (concat P-2 "/R/") "bin/i386/Rterm.exe")
(ess-find-rterm (concat P-2 "/R/") "bin/x64/Rterm.exe")))
(let ((PF (getenv "ProgramFiles")))
(nconc
;; Always 32 on 32 bit OS, depends on 32 or 64 process on 64 bit OS
(ess-find-rterm (concat PF "/R/") "bin/Rterm.exe")
(ess-find-rterm (concat PF "/R/") "bin/i386/Rterm.exe")
(ess-find-rterm (concat PF "/R/") "bin/x64/Rterm.exe"))))
(let ((PF ess-directory-containing-R))
(nconc
(ess-find-rterm (concat PF "/R/") "bin/Rterm.exe")
(ess-find-rterm (concat PF "/R/") "bin/i386/Rterm.exe")
(ess-find-rterm (concat PF "/R/") "bin/x64/Rterm.exe")))))))
(ess-r-define-runners)
;;*;; Provide and auto-loads
;;;###autoload
(add-to-list 'auto-mode-alist '("/Makevars\\(\\.win\\)?$" . makefile-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("DESCRIPTION$" . conf-colon-mode))
(provide 'ess-r-mode)
;;; Local variables:
;;; mode: emacs-lisp
;;; byte-compile-warnings: (not lexical)
;;; End:
;;; ess-r-mode.el ends here