Non puoi selezionare più di 25 argomenti
Gli argomenti devono iniziare con una lettera o un numero, possono includere trattini ('-') e possono essere lunghi fino a 35 caratteri.
2784 righe
115 KiB
2784 righe
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
|